diff options
Diffstat (limited to '')
21 files changed, 1121 insertions, 1801 deletions
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux index b9f5af6bd..c2082dc81 100644 --- a/new-luxc/test/test/luxc/common.lux +++ b/new-luxc/test/test/luxc/common.lux @@ -1,14 +1,18 @@ (.module: lux - (lux [io]) + (lux (control [monad #+ do]) + [io #+ IO]) (luxc (lang ["&." host] [".L" init] (translation [js])))) -(def: #export (init-compiler _) - (-> Top Compiler) - (initL.compiler (io.run &host.init-host))) +(do-template [<name> <host>] + [(def: #export <name> + (IO Compiler) + (do io.Monad<IO> + [host <host>] + (wrap (initL.compiler host))))] -(def: #export (init-js _) - (-> Top Compiler) - (initL.compiler (io.run js.init))) + [init-jvm &host.init-host] + [init-js js.init] + ) diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux new file mode 100644 index 000000000..9bc7a69da --- /dev/null +++ b/new-luxc/test/test/luxc/lang/translation/case.lux @@ -0,0 +1,125 @@ +(.module: + lux + (lux [io #+ IO] + (control [monad #+ do] + pipe) + (data ["e" error] + text/format + (coll [list])) + ["r" math/random "r/" Monad<Random>] + [macro] + (macro [code]) + test) + (luxc [lang] + (lang ["ls" synthesis] + (translation (jvm ["/_jvm" case] + [".T_jvm" expression] + [".T_jvm" eval] + [".T_jvm" runtime]) + (js ["/_js" case] + [".T_js" expression] + [".T_js" eval] + [".T_js" runtime])))) + (test/luxc common)) + +(def: struct-limit Nat +10) + +(def: (tail? size idx) + (-> Nat Nat Bool) + (n/= (n/dec size) idx)) + +(def: gen-case + (r.Random [ls.Synthesis ls.Path]) + (<| r.rec (function [gen-case]) + (`` ($_ r.either + (r/wrap [(' []) (' ("lux case pop"))]) + (~~ (do-template [<gen> <synth>] + [(do r.Monad<Random> + [value <gen>] + (wrap [(<synth> value) (<synth> value)]))] + + [r.bool code.bool] + [r.nat code.nat] + [r.int code.int] + [r.deg code.deg] + [r.frac code.frac] + [(r.text +5) code.text])) + (do r.Monad<Random> + [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2)))) + idx (|> r.nat (:: @ map (n/% size))) + [subS subP] gen-case + #let [caseS (` [(~+ (list.concat (list (list.repeat idx (' [])) + (list subS) + (list.repeat (|> size n/dec (n/- idx)) (' [])))))]) + caseP (` ("lux case seq" + (~ (if (tail? size idx) + (` ("lux case tuple right" (~ (code.nat idx)))) + (` ("lux case tuple left" (~ (code.nat idx)))))) + (~ subP)))]] + (wrap [caseS caseP])) + (do r.Monad<Random> + [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2)))) + idx (|> r.nat (:: @ map (n/% size))) + [subS subP] gen-case + #let [caseS (` ((~ (code.nat idx)) (~ (code.bool (tail? size idx))) (~ subS))) + caseP (` ("lux case seq" + (~ (if (tail? size idx) + (` ("lux case variant right" (~ (code.nat idx)))) + (` ("lux case variant left" (~ (code.nat idx)))))) + (~ subP)))]] + (wrap [caseS caseP])) + )))) + +(def: (pattern-matching-spec translate-expression eval translate-runtime init + translate-case) + (All [a] + (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) + (-> (-> ls.Synthesis (Meta a)) ls.Synthesis ls.Path (Meta a)) + Test)) + (do r.Monad<Random> + [[valueS pathS] gen-case + to-bind r.nat] + ($_ seq + (test "Can translate pattern-matching." + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-case translate-expression + valueS + (` ("lux case alt" + ("lux case seq" (~ pathS) + ("lux case exec" true)) + ("lux case seq" ("lux case bind" +0) + ("lux case exec" false)))))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (:! Bool valueT) + + (#e.Error error) + false))) + (test "Can bind values." + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-case translate-expression + (code.nat to-bind) + (` ("lux case seq" ("lux case bind" +0) + ("lux case exec" (0)))))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (n/= to-bind (:! Nat valueT)) + + (#e.Error error) + false)))))) + +(context: "[JVM] Pattern-matching." + (<| (times +100) + (pattern-matching-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm + /_jvm.translate-case))) + +(context: "[JS] Pattern-matching." + (<| (times +100) + (pattern-matching-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js + /_js.translate-case))) diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux new file mode 100644 index 000000000..7b7445737 --- /dev/null +++ b/new-luxc/test/test/luxc/lang/translation/common.lux @@ -0,0 +1,473 @@ +(.module: + lux + (lux [io #+ IO] + (control [monad #+ do] + pipe) + (data text/format + [bit] + ["e" error] + [bool "bool/" Eq<Bool>] + [text "text/" Eq<Text>] + [number "nat/" Interval<Nat> "int/" Number<Int> Interval<Int> "frac/" Number<Frac> Interval<Frac> "deg/" Interval<Deg>] + (coll ["a" array] + [list])) + ["r" math/random] + [macro] + (macro [code]) + [host] + test) + (luxc [lang] + (lang ["ls" synthesis] + (translation (jvm [".T_jvm" eval] + [".T_jvm" expression] + [".T_jvm" runtime]) + (js [".T_js" eval] + [".T_js" expression] + [".T_js" runtime])))) + (test/luxc common)) + +(def: (bit-spec translate-expression eval translate-runtime init) + (All [a] + (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) + Test)) + (do r.Monad<Random> + [param r.nat + subject r.nat] + (with-expansions [<binary> (do-template [<name> <reference> <param-expr>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<name> (~ (code.nat subject)) + (~ (code.nat param)))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (n/= (<reference> param subject) (:! Nat valueT)) + + (#e.Error error) + false) + (let [param <param-expr>])))] + + ["lux bit and" bit.and param] + ["lux bit or" bit.or param] + ["lux bit xor" bit.xor param] + ["lux bit shift-left" bit.shift-left (n/% +64 param)] + ["lux bit unsigned-shift-right" bit.shift-right (n/% +64 param)] + )] + ($_ seq + (test "lux bit count" + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` ("lux bit count" (~ (code.nat subject)))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (n/= (bit.count subject) (:! Nat valueT)) + + (#e.Error error) + false))) + + <binary> + (test "lux bit shift-right" + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` ("lux bit shift-right" + (~ (code.int (nat-to-int subject))) + (~ (code.nat param)))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (i/= (bit.signed-shift-right param (nat-to-int subject)) + (:! Int valueT)) + + (#e.Error error) + false) + (let [param (n/% +64 param)]))) + )))) + +(def: (nat-spec translate-expression eval translate-runtime init) + (All [a] + (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) + Test)) + (do r.Monad<Random> + [param (|> r.nat (r.filter (|>> (n/= +0) not))) + subject r.nat] + (`` ($_ seq + (~~ (do-template [<name> <reference>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<name>)))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (n/= <reference> (:! Nat valueT)) + + (#e.Error error) + false)))] + + ["lux nat min" nat/bottom] + ["lux nat max" nat/top] + )) + (~~ (do-template [<name> <type> <prepare> <comp> <subject-expr>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<name> (~ (code.nat subject)))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (<comp> (<prepare> subject) (:! <type> valueT)) + + (#e.Error error) + false) + (let [subject <subject-expr>])))] + + ["lux nat to-int" Int nat-to-int i/= subject] + ["lux nat char" Text text.from-code text/= (n/% (bit.shift-left +32 +1) subject)] + )) + (~~ (do-template [<name> <reference> <outputT> <comp>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<name> (~ (code.nat subject)) (~ (code.nat param)))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (<comp> (<reference> param subject) (:! <outputT> valueT)) + + _ + false)))] + + ["lux nat +" n/+ Nat n/=] + ["lux nat -" n/- Nat n/=] + ["lux nat *" n/* Nat n/=] + ["lux nat /" n// Nat n/=] + ["lux nat %" n/% Nat n/=] + ["lux nat =" n/= Bool bool/=] + ["lux nat <" n/< Bool bool/=] + )) + )))) + +(def: (int-spec translate-expression eval translate-runtime init) + (All [a] + (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) + Test)) + (do r.Monad<Random> + [param (|> r.int (r.filter (|>> (i/= 0) not))) + subject r.int] + (with-expansions [<nullary> (do-template [<name> <reference>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<name>)))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (i/= <reference> (:! Int valueT)) + + (#e.Error error) + false)))] + + ["lux int min" int/bottom] + ["lux int max" int/top] + ) + <unary> (do-template [<name> <type> <prepare> <comp>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<name> (~ (code.int subject)))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (<comp> (<prepare> subject) (:! <type> valueT)) + + (#e.Error error) + false)))] + + ["lux int to-nat" Nat int-to-nat n/=] + ["lux int to-frac" Frac int-to-frac f/=] + ) + <binary> (do-template [<name> <reference> <outputT> <comp>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<name> (~ (code.int subject)) (~ (code.int param)))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (<comp> (<reference> param subject) (:! <outputT> valueT)) + + _ + false)))] + + ["lux int +" i/+ Int i/=] + ["lux int -" i/- Int i/=] + ["lux int *" i/* Int i/=] + ["lux int /" i// Int i/=] + ["lux int %" i/% Int i/=] + ["lux int =" i/= Bool bool/=] + ["lux int <" i/< Bool bool/=] + )] + ($_ seq + <nullary> + <unary> + <binary> + )))) + +(def: (frac-spec|0 translate-expression eval translate-runtime init) + (All [a] + (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) + Test)) + (do r.Monad<Random> + [param (|> r.frac (r.filter (|>> (f/= 0.0) not))) + subject r.frac] + (with-expansions [<binary> (do-template [<name> <reference> <outputT> <comp>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (<comp> (<reference> param subject) (:! <outputT> valueT)) + + _ + false)))] + + ["lux frac +" f/+ Frac f/=] + ["lux frac -" f/- Frac f/=] + ["lux frac *" f/* Frac f/=] + ["lux frac /" f// Frac f/=] + ["lux frac %" f/% Frac f/=] + ["lux frac =" f/= Bool bool/=] + ["lux frac <" f/< Bool bool/=] + )] + ($_ seq + <binary> + )))) + +(def: (frac-spec|1 translate-expression eval translate-runtime init) + (All [a] + (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) + Test)) + (do r.Monad<Random> + [param (|> r.frac (r.filter (|>> (f/= 0.0) not))) + subject r.frac] + (with-expansions [<nullary> (do-template [<name> <test>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<name>)))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (<test> (:! Frac valueT)) + + _ + false)))] + + ["lux frac min" (f/= frac/bottom)] + ["lux frac max" (f/= frac/top)] + ["lux frac not-a-number" number.not-a-number?] + ["lux frac positive-infinity" (f/= number.positive-infinity)] + ["lux frac negative-infinity" (f/= number.negative-infinity)] + ["lux frac smallest" (f/= ("lux frac smallest"))] + ) + <unary> (do-template [<forward> <backward> <test>] + [(test <forward> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<backward> (<forward> (~ (code.frac subject))))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (|> valueT (:! Frac) (f/- subject) frac/abs <test>) + + (#e.Error error) + false)))] + + ["lux frac to-int" "lux int to-frac" (f/< 1.0)] + ["lux frac to-deg" "lux deg to-frac" (f/<= 0.000000001)])] + ($_ seq + <nullary> + <unary> + (test "frac encode|decode" + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` ("lux frac decode" ("lux frac encode" (~ (code.frac subject))))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (^multi (#e.Success valueT) + [(:! (Maybe Frac) valueT) (#.Some value)]) + (f/= subject value) + + _ + false))) + )))) + +(def: (frac-spec translate-expression eval translate-runtime init) + (All [a] + (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) + Test)) + ($_ seq + (frac-spec|0 translate-expression eval translate-runtime init) + (frac-spec|1 translate-expression eval translate-runtime init))) + +(def: deg-threshold + {#.doc "1/(2^30)"} + Deg + .000000001) + +(def: (above-threshold value) + (-> Deg Deg) + (if (d/< deg-threshold value) + (d/+ deg-threshold value) + value)) + +(def: (deg-difference reference sample) + (-> Deg Deg Deg) + (if (d/> reference sample) + (d/- reference sample) + (d/- sample reference))) + +(def: (deg-spec translate-expression eval translate-runtime init) + (All [a] + (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) + Test)) + (do r.Monad<Random> + [param (|> r.deg (:: @ map above-threshold)) + special r.nat + subject (|> r.deg (:: @ map above-threshold))] + (`` ($_ seq + (~~ (do-template [<name> <reference>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<name>)))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (d/= <reference> (:! Deg valueT)) + + _ + false)))] + + ["lux deg min" deg/bottom] + ["lux deg max" deg/top] + )) + (~~ (do-template [<forward> <backward> <type>] + [(test <forward> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<backward> (<forward> (~ (code.deg subject))))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueV) + (d/<= deg-threshold (deg-difference subject (:! <type> valueV))) + + _ + false)))] + + ["lux deg to-frac" "lux frac to-deg" Deg] + )) + (~~ (do-template [<name> <reference> <outputT> <comp>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<name> (~ (code.deg subject)) (~ (code.deg param)))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (<comp> (<reference> param subject) (:! <outputT> valueT)) + + _ + false)))] + + ["lux deg +" d/+ Deg d/=] + ["lux deg -" d/- Deg d/=] + ["lux deg *" d/* Deg d/=] + ["lux deg /" d// Deg d/=] + ["lux deg %" d/% Deg d/=] + ["lux deg =" d/= Bool bool/=] + ["lux deg <" d/< Bool bool/=] + )) + (~~ (do-template [<name> <reference> <outputT> <comp>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleJS (translate-expression (` (<name> (~ (code.deg subject)) (~ (code.nat special)))))] + (eval sampleJS)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (<comp> (<reference> special subject) (:! <outputT> valueT)) + + _ + false)))] + + ["lux deg scale" d/scale Deg d/=] + ["lux deg reciprocal" d/reciprocal Deg d/=] + )) + )))) + +## Bit +(context: "[JVM] Bit procedures" + (<| (times +100) + (bit-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm))) + +(context: "[JS] Bit procedures" + (<| (times +100) + (bit-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) + +## Nat +(context: "[JVM] Nat procedures" + (<| (times +100) + (nat-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm))) + +(context: "[JS] Nat procedures" + (<| (times +100) + (nat-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) + +## Int +(context: "[JVM] Int procedures" + (<| (times +100) + (int-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm))) + +(context: "[JS] Int procedures" + (<| (times +100) + (int-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) + +## Frac +(context: "[JVM] Frac procedures" + (<| (times +100) + (frac-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm))) + +(context: "[JS] Frac procedures" + (<| (times +100) + (frac-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) + +## Deg +(context: "[JVM] Deg procedures" + (<| (times +100) + (deg-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm))) + +(context: "[JS] Deg procedures" + (<| (times +100) + (deg-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) diff --git a/new-luxc/test/test/luxc/lang/translation/function.lux b/new-luxc/test/test/luxc/lang/translation/function.lux new file mode 100644 index 000000000..777cea55c --- /dev/null +++ b/new-luxc/test/test/luxc/lang/translation/function.lux @@ -0,0 +1,116 @@ +(.module: + lux + (lux [io #+ IO] + (control [monad #+ do] + pipe) + (data [product] + [maybe] + ["e" error] + (coll ["a" array] + [list "list/" Functor<List>])) + ["r" math/random "r/" Monad<Random>] + [macro] + (macro [code]) + [host] + test) + (luxc [lang] + (lang ["ls" synthesis] + (translation (jvm [".T_jvm" eval] + [".T_jvm" expression] + [".T_jvm" runtime]) + (js [".T_js" eval] + [".T_js" expression] + [".T_js" runtime])))) + (test/luxc common)) + +(def: arity-limit Nat +10) + +(def: arity + (r.Random ls.Arity) + (|> r.nat (r/map (|>> (n/% arity-limit) (n/max +1))))) + +(def: gen-function + (r.Random [ls.Arity Nat ls.Synthesis]) + (do r.Monad<Random> + [arity arity + arg (|> r.nat (:: @ map (n/% arity))) + #let [functionS (` ("lux function" (~ (code.nat arity)) [] + ((~ (code.int (nat-to-int (n/inc arg)))))))]] + (wrap [arity arg functionS]))) + +(def: (function-spec translate-expression eval translate-runtime init) + (All [a] + (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) + Test)) + (do r.Monad<Random> + [[arity arg functionS] gen-function + cut-off (|> r.nat (:: @ map (n/% arity))) + args (r.list arity r.nat) + #let [arg-value (maybe.assume (list.nth arg args)) + argsS (list/map code.nat args) + last-arg (n/dec arity) + cut-off (|> cut-off (n/min (n/dec last-arg)))]] + ($_ seq + (test "Can read arguments." + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-expression (` ("lux call" (~ functionS) (~+ argsS))))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (n/= arg-value (:! Nat valueT)) + + (#e.Error error) + false))) + (test "Can partially apply functions." + (or (n/= +1 arity) + (|> (do macro.Monad<Meta> + [#let [partial-arity (n/inc cut-off) + preS (list.take partial-arity argsS) + postS (list.drop partial-arity argsS)] + _ translate-runtime + sampleO (translate-expression (` ("lux call" + ("lux call" (~ functionS) (~+ preS)) + (~+ postS))))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (n/= arg-value (:! Nat valueT)) + + (#e.Error error) + false)))) + (test "Can read environment." + (or (n/= +1 arity) + (|> (do macro.Monad<Meta> + [#let [env (|> (list.n/range +0 cut-off) + (list/map (|>> n/inc nat-to-int))) + super-arity (n/inc cut-off) + arg-var (if (n/<= cut-off arg) + (|> arg n/inc nat-to-int (i/* -1)) + (|> arg n/inc (n/- super-arity) nat-to-int)) + sub-arity (|> arity (n/- super-arity)) + functionS (` ("lux function" (~ (code.nat super-arity)) [] + ("lux function" (~ (code.nat sub-arity)) [(~+ (list/map code.int env))] + ((~ (code.int arg-var))))))] + _ translate-runtime + sampleO (translate-expression (` ("lux call" (~ functionS) (~+ argsS))))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (n/= arg-value (:! Nat valueT)) + + (#e.Error error) + (exec (log! error) + false))))) + ))) + +(context: "[JVM] Function." + (<| (times +100) + (function-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm))) + +(context: "[JS] Function." + (<| (times +100) + (function-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) diff --git a/new-luxc/test/test/luxc/lang/translation/js/case.lux b/new-luxc/test/test/luxc/lang/translation/js/case.lux deleted file mode 100644 index ea527b86b..000000000 --- a/new-luxc/test/test/luxc/lang/translation/js/case.lux +++ /dev/null @@ -1,107 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data ["e" error] - text/format - (coll [list])) - ["r" math/random "r/" Monad<Random>] - [macro] - (macro [code]) - test) - (luxc [lang] - (lang ["ls" synthesis] - (translation (js ["/" case] - [".T" expression] - [".T" eval] - [".T" runtime])))) - (test/luxc common)) - -(def: struct-limit Nat +10) - -(def: (tail? size idx) - (-> Nat Nat Bool) - (n/= (n/dec size) idx)) - -(def: gen-case - (r.Random [ls.Synthesis ls.Path]) - (<| r.rec (function [gen-case]) - (`` ($_ r.either - (r/wrap [(' []) (' ("lux case pop"))]) - (~~ (do-template [<gen> <synth>] - [(do r.Monad<Random> - [value <gen>] - (wrap [(<synth> value) (<synth> value)]))] - - [r.bool code.bool] - [r.nat code.nat] - [r.int code.int] - [r.deg code.deg] - [r.frac code.frac] - [(r.text +5) code.text])) - (do r.Monad<Random> - [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2)))) - idx (|> r.nat (:: @ map (n/% size))) - [subS subP] gen-case - #let [caseS (` [(~+ (list.concat (list (list.repeat idx (' [])) - (list subS) - (list.repeat (|> size n/dec (n/- idx)) (' [])))))]) - caseP (` ("lux case seq" - (~ (if (tail? size idx) - (` ("lux case tuple right" (~ (code.nat idx)))) - (` ("lux case tuple left" (~ (code.nat idx)))))) - (~ subP)))]] - (wrap [caseS caseP])) - (do r.Monad<Random> - [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2)))) - idx (|> r.nat (:: @ map (n/% size))) - [subS subP] gen-case - #let [caseS (` ((~ (code.nat idx)) (~ (code.bool (tail? size idx))) (~ subS))) - caseP (` ("lux case seq" - (~ (if (tail? size idx) - (` ("lux case variant right" (~ (code.nat idx)))) - (` ("lux case variant left" (~ (code.nat idx)))))) - (~ subP)))]] - (wrap [caseS caseP])) - )))) - -(context: "Pattern-matching." - (<| (times +100) - (do @ - [[valueS pathS] gen-case - to-bind r.nat] - ($_ seq - (test "Can translate pattern-matching." - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (/.translate-case expressionT.translate - valueS - (` ("lux case alt" - ("lux case seq" (~ pathS) - ("lux case exec" true)) - ("lux case seq" ("lux case bind" +0) - ("lux case exec" false)))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (:! Bool valueT) - - (#e.Error error) - false))) - (test "Can bind values." - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (/.translate-case expressionT.translate - (code.nat to-bind) - (` ("lux case seq" ("lux case bind" +0) - ("lux case exec" (0)))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (n/= to-bind (:! Nat valueT)) - - _ - false))))))) diff --git a/new-luxc/test/test/luxc/lang/translation/js/function.lux b/new-luxc/test/test/luxc/lang/translation/js/function.lux deleted file mode 100644 index 6cb1e64cc..000000000 --- a/new-luxc/test/test/luxc/lang/translation/js/function.lux +++ /dev/null @@ -1,103 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data [product] - [maybe] - ["e" error] - (coll ["a" array] - [list "list/" Functor<List>])) - ["r" math/random "r/" Monad<Random>] - [macro] - (macro [code]) - [host] - test) - (luxc [lang] - (lang ["ls" synthesis] - (translation (js [".T" expression] - [".T" eval] - [".T" runtime])))) - (test/luxc common)) - -(def: arity-limit Nat +10) - -(def: arity - (r.Random ls.Arity) - (|> r.nat (r/map (|>> (n/% arity-limit) (n/max +1))))) - -(def: gen-function - (r.Random [ls.Arity Nat ls.Synthesis]) - (do r.Monad<Random> - [arity arity - arg (|> r.nat (:: @ map (n/% arity))) - #let [functionS (` ("lux function" (~ (code.nat arity)) [] - ((~ (code.int (nat-to-int (n/inc arg)))))))]] - (wrap [arity arg functionS]))) - -(context: "Function." - (<| (times +100) - (do @ - [[arity arg functionS] gen-function - cut-off (|> r.nat (:: @ map (n/% arity))) - args (r.list arity r.nat) - #let [arg-value (maybe.assume (list.nth arg args)) - argsS (list/map code.nat args) - last-arg (n/dec arity) - cut-off (|> cut-off (n/min (n/dec last-arg)))]] - ($_ seq - (test "Can read arguments." - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` ("lux call" (~ functionS) (~+ argsS))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (n/= arg-value (:! Nat valueT)) - - (#e.Error error) - false))) - (test "Can partially apply functions." - (or (n/= +1 arity) - (|> (do macro.Monad<Meta> - [#let [partial-arity (n/inc cut-off) - preS (list.take partial-arity argsS) - postS (list.drop partial-arity argsS)] - _ runtimeT.translate - sampleJS (expressionT.translate (` ("lux call" - ("lux call" (~ functionS) (~+ preS)) - (~+ postS))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (n/= arg-value (:! Nat valueT)) - - (#e.Error error) - false)))) - (test "Can read environment." - (or (n/= +1 arity) - (|> (do macro.Monad<Meta> - [#let [env (|> (list.n/range +0 cut-off) - (list/map (|>> n/inc nat-to-int))) - super-arity (n/inc cut-off) - arg-var (if (n/<= cut-off arg) - (|> arg n/inc nat-to-int (i/* -1)) - (|> arg n/inc (n/- super-arity) nat-to-int)) - sub-arity (|> arity (n/- super-arity)) - functionS (` ("lux function" (~ (code.nat super-arity)) [] - ("lux function" (~ (code.nat sub-arity)) [(~+ (list/map code.int env))] - ((~ (code.int arg-var))))))] - _ runtimeT.translate - sampleJS (expressionT.translate (` ("lux call" (~ functionS) (~+ argsS))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (n/= arg-value (:! Nat valueT)) - - (#e.Error error) - (exec (log! error) - false))))) - )))) diff --git a/new-luxc/test/test/luxc/lang/translation/js/primitive.lux b/new-luxc/test/test/luxc/lang/translation/js/primitive.lux deleted file mode 100644 index 91828eb3b..000000000 --- a/new-luxc/test/test/luxc/lang/translation/js/primitive.lux +++ /dev/null @@ -1,64 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data text/format - ["e" error] - [bool "bool/" Eq<Bool>] - [text "text/" Eq<Text>]) - ["r" math/random] - [macro] - (macro [code]) - test) - (luxc [lang] - (lang [".L" host] - ["ls" synthesis] - (translation (js [".T" expression] - [".T" runtime] - [".T" eval])))) - (test/luxc common)) - -(context: "Primitives." - (<| (times +100) - (do @ - [%bool% r.bool - %nat% r.nat - %int% r.int - %deg% r.deg - %frac% r.frac - %text% (r.text +5)] - (`` ($_ seq - (test "Can translate unit." - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleI (expressionT.translate (' []))] - (evalT.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (is hostL.unit (:! Text valueT)) - - _ - false))) - (~~ (do-template [<desc> <type> <synthesis> <sample> <test>] - [(test (format "Can translate " <desc> ".") - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleI (expressionT.translate (<synthesis> <sample>))] - (evalT.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (<test> <sample> (:! <type> valueT)) - - (#e.Error error) - false)))] - - ["bool" Bool code.bool %bool% bool/=] - ["nat" Nat code.nat %nat% n/=] - ["int" Int code.int %int% i/=] - ["deg" Deg code.deg %deg% d/=] - ["frac" Frac code.frac %frac% f/=] - ["text" Text code.text %text% text/=])) - ))))) diff --git a/new-luxc/test/test/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/test/test/luxc/lang/translation/js/procedure/common.jvm.lux deleted file mode 100644 index 1c52d9e7b..000000000 --- a/new-luxc/test/test/luxc/lang/translation/js/procedure/common.jvm.lux +++ /dev/null @@ -1,405 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data text/format - [bit] - ["e" error] - [bool "bool/" Eq<Bool>] - [text "text/" Eq<Text>] - [number "nat/" Interval<Nat> "int/" Number<Int> Interval<Int> "frac/" Number<Frac> Interval<Frac> "deg/" Interval<Deg>] - (coll ["a" array] - [list])) - ["r" math/random] - [macro] - (macro [code]) - [host] - test) - (luxc [lang] - (lang ["ls" synthesis] - (translation (js [".T" expression] - [".T" eval] - [".T" runtime])))) - (test/luxc common)) - -(context: "Bit procedures" - (<| (times +100) - (do @ - [param r.nat - subject r.nat] - (with-expansions [<binary> (do-template [<name> <reference> <param-expr>] - [(test <name> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<name> (~ (code.nat subject)) - (~ (code.nat param)))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (n/= (<reference> param subject) (:! Nat valueT)) - - (#e.Error error) - false) - (let [param <param-expr>])))] - - ["lux bit and" bit.and param] - ["lux bit or" bit.or param] - ["lux bit xor" bit.xor param] - ["lux bit shift-left" bit.shift-left (n/% +64 param)] - ["lux bit unsigned-shift-right" bit.shift-right (n/% +64 param)] - )] - ($_ seq - (test "lux bit count" - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` ("lux bit count" (~ (code.nat subject)))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (n/= (bit.count subject) (:! Nat valueT)) - - (#e.Error error) - false))) - - <binary> - (test "lux bit shift-right" - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` ("lux bit shift-right" - (~ (code.int (nat-to-int subject))) - (~ (code.nat param)))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (i/= (bit.signed-shift-right param (nat-to-int subject)) - (:! Int valueT)) - - (#e.Error error) - false) - (let [param (n/% +64 param)]))) - ))))) - -(context: "Nat procedures" - (<| (times +100) - (do @ - [param (|> r.nat (r.filter (|>> (n/= +0) not))) - subject r.nat] - (`` ($_ seq - (~~ (do-template [<name> <reference>] - [(test <name> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<name>)))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (n/= <reference> (:! Nat valueT)) - - (#e.Error error) - false)))] - - ["lux nat min" nat/bottom] - ["lux nat max" nat/top] - )) - (~~ (do-template [<name> <type> <prepare> <comp> <subject-expr>] - [(test <name> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<name> (~ (code.nat subject)))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (<comp> (<prepare> subject) (:! <type> valueT)) - - (#e.Error error) - false) - (let [subject <subject-expr>])))] - - ["lux nat to-int" Int nat-to-int i/= subject] - ["lux nat char" Text text.from-code text/= (n/% (bit.shift-left +32 +1) subject)] - )) - (~~ (do-template [<name> <reference> <outputT> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<name> (~ (code.nat subject)) (~ (code.nat param)))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (<comp> (<reference> param subject) (:! <outputT> valueT)) - - _ - false)))] - - ["lux nat +" n/+ Nat n/=] - ["lux nat -" n/- Nat n/=] - ["lux nat *" n/* Nat n/=] - ["lux nat /" n// Nat n/=] - ["lux nat %" n/% Nat n/=] - ["lux nat =" n/= Bool bool/=] - ["lux nat <" n/< Bool bool/=] - )) - ))))) - -(context: "Int procedures" - (<| (times +100) - (do @ - [param (|> r.int (r.filter (|>> (i/= 0) not))) - subject r.int] - (with-expansions [<nullary> (do-template [<name> <reference>] - [(test <name> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<name>)))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (i/= <reference> (:! Int valueT)) - - (#e.Error error) - false)))] - - ["lux int min" int/bottom] - ["lux int max" int/top] - ) - <unary> (do-template [<name> <type> <prepare> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<name> (~ (code.int subject)))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (<comp> (<prepare> subject) (:! <type> valueT)) - - (#e.Error error) - false)))] - - ["lux int to-nat" Nat int-to-nat n/=] - ["lux int to-frac" Frac int-to-frac f/=] - ) - <binary> (do-template [<name> <reference> <outputT> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<name> (~ (code.int subject)) (~ (code.int param)))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (<comp> (<reference> param subject) (:! <outputT> valueT)) - - _ - false)))] - - ["lux int +" i/+ Int i/=] - ["lux int -" i/- Int i/=] - ["lux int *" i/* Int i/=] - ["lux int /" i// Int i/=] - ["lux int %" i/% Int i/=] - ["lux int =" i/= Bool bool/=] - ["lux int <" i/< Bool bool/=] - )] - ($_ seq - <nullary> - <unary> - <binary> - ))))) - -(context: "Frac procedures [Part 1]" - (<| (times +100) - (do @ - [param (|> r.frac (r.filter (|>> (f/= 0.0) not))) - subject r.frac] - (with-expansions [<binary> (do-template [<name> <reference> <outputT> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (<comp> (<reference> param subject) (:! <outputT> valueT)) - - _ - false)))] - - ["lux frac +" f/+ Frac f/=] - ["lux frac -" f/- Frac f/=] - ["lux frac *" f/* Frac f/=] - ["lux frac /" f// Frac f/=] - ["lux frac %" f/% Frac f/=] - ["lux frac =" f/= Bool bool/=] - ["lux frac <" f/< Bool bool/=] - )] - ($_ seq - <binary> - ))))) - -(context: "Frac procedures [Part 2]" - (<| (times +100) - (do @ - [param (|> r.frac (r.filter (|>> (f/= 0.0) not))) - subject r.frac] - (with-expansions [<nullary> (do-template [<name> <test>] - [(test <name> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<name>)))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (<test> (:! Frac valueT)) - - _ - false)))] - - ["lux frac min" (f/= frac/bottom)] - ["lux frac max" (f/= frac/top)] - ["lux frac not-a-number" number.not-a-number?] - ["lux frac positive-infinity" (f/= number.positive-infinity)] - ["lux frac negative-infinity" (f/= number.negative-infinity)] - ["lux frac smallest" (f/= ("lux frac smallest"))] - ) - <unary> (do-template [<forward> <backward> <test>] - [(test <forward> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<backward> (<forward> (~ (code.frac subject))))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (|> valueT (:! Frac) (f/- subject) frac/abs <test>) - - (#e.Error error) - false)))] - - ["lux frac to-int" "lux int to-frac" (f/< 1.0)] - ["lux frac to-deg" "lux deg to-frac" (f/<= 0.000000001)])] - ($_ seq - <nullary> - <unary> - (test "frac encode|decode" - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` ("lux frac decode" ("lux frac encode" (~ (code.frac subject))))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (^multi (#e.Success valueT) - [(:! (Maybe Frac) valueT) (#.Some value)]) - (f/= subject value) - - _ - false))) - ))))) - -(def: deg-threshold - {#.doc "1/(2^30)"} - Deg - .000000001) - -(def: (above-threshold value) - (-> Deg Deg) - (if (d/< deg-threshold value) - (d/+ deg-threshold value) - value)) - -(def: (deg-difference reference sample) - (-> Deg Deg Deg) - (if (d/> reference sample) - (d/- reference sample) - (d/- sample reference))) - -(context: "Deg procedures" - (<| (times +100) - (do @ - [param (|> r.deg (:: @ map above-threshold)) - special r.nat - subject (|> r.deg (:: @ map above-threshold))] - (`` ($_ seq - (~~ (do-template [<name> <reference>] - [(test <name> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<name>)))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (d/= <reference> (:! Deg valueT)) - - _ - false)))] - - ["lux deg min" deg/bottom] - ["lux deg max" deg/top] - )) - (~~ (do-template [<forward> <backward> <type>] - [(test <forward> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<backward> (<forward> (~ (code.deg subject))))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueV) - (d/<= deg-threshold (deg-difference subject (:! <type> valueV))) - - _ - false)))] - - ["lux deg to-frac" "lux frac to-deg" Deg] - )) - (~~ (do-template [<name> <reference> <outputT> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<name> (~ (code.deg subject)) (~ (code.deg param)))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (<comp> (<reference> param subject) (:! <outputT> valueT)) - - _ - false)))] - - ["lux deg +" d/+ Deg d/=] - ["lux deg -" d/- Deg d/=] - ["lux deg *" d/* Deg d/=] - ["lux deg /" d// Deg d/=] - ["lux deg %" d/% Deg d/=] - ["lux deg =" d/= Bool bool/=] - ["lux deg <" d/< Bool bool/=] - )) - (~~ (do-template [<name> <reference> <outputT> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (expressionT.translate (` (<name> (~ (code.deg subject)) (~ (code.nat special)))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (<comp> (<reference> special subject) (:! <outputT> valueT)) - - _ - false)))] - - ["lux deg scale" d/scale Deg d/=] - ["lux deg reciprocal" d/reciprocal Deg d/=] - )) - ))))) diff --git a/new-luxc/test/test/luxc/lang/translation/js/reference.lux b/new-luxc/test/test/luxc/lang/translation/js/reference.lux deleted file mode 100644 index 80ccd3123..000000000 --- a/new-luxc/test/test/luxc/lang/translation/js/reference.lux +++ /dev/null @@ -1,82 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data ["e" error] - [text]) - ["r" math/random] - [macro] - (macro [code]) - test) - (luxc [lang] - (lang ["_." module] - ["ls" synthesis] - (translation (js [".T" statement] - [".T" eval] - [".T" expression] - [".T" case] - [".T" runtime])))) - (test/luxc common)) - -(def: upper-alpha-ascii - (r.Random Nat) - (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65))))) - -(def: ident-part - (r.Random Text) - (|> (r.text' upper-alpha-ascii +5) - (r.filter (function [sample] - (not (or (text.contains? "/" sample) - (text.contains? "[" sample) - (text.contains? "]" sample))))))) - -(context: "Definitions." - (<| (times +100) - (do @ - [module-name ident-part - def-name ident-part - def-value r.int] - ($_ seq - (test "Can refer to definitions." - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - valueJS (expressionT.translate (code.int def-value)) - _ (_module.with-module +0 module-name - (statementT.translate-def def-name Int valueJS (' {}))) - sampleJS (expressionT.translate (code.symbol [module-name def-name]))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (i/= def-value (:! Int valueT)) - - (#e.Error error) - (exec (log! error) - false)))) - )))) - -(context: "Variables." - (<| (times +100) - (do @ - [module-name (|> (r.text +5) (r.filter (|>> (text.contains? "/") not))) - register (|> r.nat (:: @ map (n/% +100))) - value r.int] - ($_ seq - (test "Can refer to local variables/registers." - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleJS (caseT.translate-let expressionT.translate - register - (code.int value) - (` ((~ (code.int (nat-to-int register))))))] - (evalT.eval sampleJS)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success outputT) - (i/= value (:! Int outputT)) - - (#e.Error error) - (exec (log! error) - false)))) - )))) diff --git a/new-luxc/test/test/luxc/lang/translation/js/structure.lux b/new-luxc/test/test/luxc/lang/translation/js/structure.lux deleted file mode 100644 index fde45c1cb..000000000 --- a/new-luxc/test/test/luxc/lang/translation/js/structure.lux +++ /dev/null @@ -1,113 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data ["e" error] - [maybe] - [bool "bool/" Eq<Bool>] - [text "text/" Eq<Text>] - text/format - (coll [array] - [list])) - ["r" math/random "r/" Monad<Random>] - [macro] - (macro [code]) - [host] - test) - (luxc [lang] - (lang [".L" host] - ["ls" synthesis] - (translation (js [".T" expression] - [".T" runtime] - [".T" eval])))) - (test/luxc common)) - -(host.import java/lang/Long) - -(def: gen-primitive - (r.Random ls.Synthesis) - (r.either (r.either (r.either (r/wrap (' [])) - (r/map code.bool r.bool)) - (r.either (r/map code.nat r.nat) - (r/map code.int r.int))) - (r.either (r.either (r/map code.deg r.deg) - (r/map code.frac r.frac)) - (r/map code.text (r.text +5))))) - -(def: (corresponds? [prediction sample]) - (-> [ls.Synthesis Top] Bool) - (case prediction - [_ (#.Tuple #.Nil)] - (text/= hostL.unit (:! Text sample)) - - (^template [<tag> <type> <test>] - [_ (<tag> prediction')] - (case (host.try (<test> prediction' (:! <type> sample))) - (#e.Success result) - result - - (#e.Error error) - false)) - ([#.Bool Bool bool/=] - [#.Nat Nat n/=] - [#.Int Int i/=] - [#.Deg Deg d/=] - [#.Frac Frac f/=] - [#.Text Text text/=]) - - _ - false - )) - -(context: "Tuples." - (<| (times +100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) - members (r.list size gen-primitive)] - (test "Can translate tuple." - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleI (expressionT.translate (code.tuple members))] - (evalT.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (let [valueT (:! (Array Top) valueT)] - (and (n/= size (array.size valueT)) - (list.every? corresponds? (list.zip2 members (array.to-list valueT))))) - - (#e.Error error) - false)))))) - -(context: "Variants." - (<| (times +100) - (do @ - [num-tags (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) - tag (|> r.nat (:: @ map (n/% num-tags))) - #let [last? (n/= (n/dec num-tags) tag)] - member gen-primitive] - (test "Can translate variant." - (|> (do macro.Monad<Meta> - [_ runtimeT.translate - sampleI (expressionT.translate (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ member))))] - (evalT.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-js [])) - (case> (#e.Success valueT) - (let [valueT (:! (Array Top) valueT)] - (and (n/= +3 (array.size valueT)) - (let [_tag (:! Long (maybe.assume (array.read +0 valueT))) - _last? (array.read +1 valueT) - _value (:! Top (maybe.assume (array.read +2 valueT)))] - (and (n/= tag (|> _tag (:! Nat))) - (case _last? - (#.Some _last?') - (and last? (text/= "" (:! Text _last?'))) - - #.None - (not last?)) - (corresponds? [member _value]))))) - - (#e.Error error) - false)))))) diff --git a/new-luxc/test/test/luxc/lang/translation/jvm/procedure/host.jvm.lux b/new-luxc/test/test/luxc/lang/translation/jvm.lux index 0db10f82a..a0c8a5ed5 100644 --- a/new-luxc/test/test/luxc/lang/translation/jvm/procedure/host.jvm.lux +++ b/new-luxc/test/test/luxc/lang/translation/jvm.lux @@ -20,9 +20,8 @@ (lang [".L" host] ["ls" synthesis] (translation (jvm [".T" expression] - ["@." eval] - ["@." runtime] - ["@." common])))) + [".T" eval] + [".T" runtime])))) (test/luxc common)) (context: "Conversions [Part 1]" @@ -34,9 +33,9 @@ [(test (format <step1> " / " <step2>) (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (|> (~ (<tag> <sample>)) <step1> <step2> (`)))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success valueT) (<test> <sample> (:! <cast> valueT)) @@ -66,9 +65,9 @@ [(test (format <step1> " / " <step2> " / " <step3>) (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (|> (~ (<tag> <sample>)) <step1> <step2> <step3> (`)))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success valueT) (<test> <sample> (:! <cast> valueT)) @@ -93,9 +92,9 @@ [(test (format <step1> " / " <step2> " / " <step3>) (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (|> (~ (<tag> <sample>)) <step1> <step2> <step3> <step4> (`)))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success valueT) (<test> <sample> (:! <cast> valueT)) @@ -134,9 +133,9 @@ [sampleI (expressionT.translate (` (<post> ((~ (code.text <procedure>)) (<pre> (~ (<tag> subject))) (<pre> (~ (<tag> param)))))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success valueT) (<test> (<reference> param subject) (:! <type> valueT)) @@ -173,9 +172,9 @@ [sampleI (expressionT.translate (` (<post> ((~ (code.text <procedure>)) (<convert> (~ (code.nat subject))) (<convert> (~ (code.nat param)))))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success valueT) (n/= (<reference> param subject) (:! Nat valueT)) @@ -207,9 +206,9 @@ [sampleI (expressionT.translate (` (<post> ((~ (code.text <procedure>)) (<convert> (~ (<pre> subject))) ("jvm convert long-to-int" (~ (code.nat shift)))))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success valueT) (<test> (<reference> shift (<pre-subject> subject)) (:! <type> valueT)) @@ -239,9 +238,9 @@ [sampleI (expressionT.translate (` ((~ (code.text <procedure>)) (<pre> (~ (<tag> subject))) (<pre> (~ (<tag> param))))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success valueT) (bool/= (<reference> param subject) (:! Bool valueT)) @@ -297,9 +296,9 @@ (~) <post> (`)))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputZ) (<test> <value> (:! <type> outputZ)) @@ -347,9 +346,9 @@ (~) <post> (`)))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (<test> <value> (:! <type> outputT)) @@ -375,9 +374,9 @@ ("jvm array read" "#Array" (~ (code.nat idx))) ("jvm array read" "java.lang.Double" (~ (code.nat idx))) (`)))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (f/= valueD (:! Frac outputT)) @@ -386,9 +385,9 @@ (test "jvm array length" (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (` ("jvm array length" ("jvm array new" +0 "java.lang.Object" (~ (code.nat size))))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (n/= size (:! Nat outputT)) @@ -437,9 +436,9 @@ (test "jvm object null" (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (` ("jvm object null?" ("jvm object null"))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (:! Bool outputT) @@ -448,9 +447,9 @@ (test "jvm object null?" (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (` ("jvm object null?" (~ (code.int sample)))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (not (:! Bool outputT)) @@ -459,9 +458,9 @@ (test "jvm object synchronized" (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (` ("jvm object synchronized" (~ (code.int monitor)) (~ (code.int sample)))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (i/= sample (:! Int outputT)) @@ -469,14 +468,14 @@ false))) (test "jvm object throw" (|> (do macro.Monad<Meta> - [_ @runtime.translate + [_ runtimeT.translate sampleI (expressionT.translate (` ("lux try" ("lux function" +1 [] ("jvm object throw" ("jvm member invoke constructor" "java.lang.Throwable" (~ exception-message$)))))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (case (:! (e.Error Top) outputT) (#e.Error error) @@ -490,9 +489,9 @@ (test "jvm object class" (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (` ("jvm object class" (~ (code.text class)))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (|> outputT (:! Class) (Class::getName []) (text/= class)) @@ -501,9 +500,9 @@ (test "jvm object instance?" (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (` ("jvm object instance?" (~ (code.text instance-class)) (~ instance))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (:! Bool outputT) @@ -533,9 +532,9 @@ (test "jvm member static get" (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (` ("jvm convert int-to-long" ("jvm member static get" "java.util.GregorianCalendar" "AD" "int"))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (i/= GregorianCalendar::AD (:! Int outputT)) @@ -545,9 +544,9 @@ (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (` ("jvm member static put" "java.awt.datatransfer.DataFlavor" "allHtmlFlavor" "java.awt.datatransfer.DataFlavor" ("jvm member static get" "java.awt.datatransfer.DataFlavor" "allHtmlFlavor" "java.awt.datatransfer.DataFlavor"))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (is hostL.unit (:! Text outputT)) @@ -556,9 +555,9 @@ (test "jvm member virtual get" (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (` ("jvm member virtual get" "org.omg.CORBA.ValueMember" "name" "java.lang.String" (~ value-memberS))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (text/= sample-string (:! Text outputT)) @@ -569,9 +568,9 @@ [sampleI (expressionT.translate (` ("jvm member virtual get" "org.omg.CORBA.ValueMember" "name" "java.lang.String" ("jvm member virtual put" "org.omg.CORBA.ValueMember" "name" "java.lang.String" (~ (code.text other-sample-string)) (~ value-memberS)))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (text/= other-sample-string (:! Text outputT)) @@ -598,9 +597,9 @@ [sampleI (expressionT.translate (` ("jvm member invoke static" "java.lang.Long" "decode" "java.lang.Long" (~ coded-intS))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (i/= sample (:! Int outputT)) @@ -611,9 +610,9 @@ [sampleI (expressionT.translate (` ("jvm object cast" "boolean" "java.lang.Boolean" ("jvm member invoke virtual" "java.lang.Object" "equals" "boolean" (~ (code.int sample)) (~ object-longS)))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (:! Bool outputT) @@ -624,9 +623,9 @@ [sampleI (expressionT.translate (` ("jvm object cast" "boolean" "java.lang.Boolean" ("jvm member invoke interface" "java.util.Collection" "add" "boolean" (~ array-listS) (~ object-longS)))))] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (:! Bool outputT) @@ -635,9 +634,9 @@ (test "jvm member invoke constructor" (|> (do macro.Monad<Meta> [sampleI (expressionT.translate array-listS)] - (@eval.eval sampleI)) + (evalT.eval sampleI)) (lang.with-current-module "") - (macro.run (init-compiler [])) + (macro.run (io.run init-jvm)) (case> (#e.Success outputT) (host.instance? ArrayList (:! Object outputT)) diff --git a/new-luxc/test/test/luxc/lang/translation/jvm/case.lux b/new-luxc/test/test/luxc/lang/translation/jvm/case.lux deleted file mode 100644 index 2df52d78b..000000000 --- a/new-luxc/test/test/luxc/lang/translation/jvm/case.lux +++ /dev/null @@ -1,108 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data ["e" error] - text/format - (coll [list])) - ["r" math/random "r/" Monad<Random>] - [macro] - (macro [code]) - test) - (luxc [lang] - (lang ["ls" synthesis] - (translation (jvm ["@" case] - [".T" expression] - ["@." eval] - ["@." runtime] - ["@." common])))) - (test/luxc common)) - -(def: struct-limit Nat +10) - -(def: (tail? size idx) - (-> Nat Nat Bool) - (n/= (n/dec size) idx)) - -(def: gen-case - (r.Random [ls.Synthesis ls.Path]) - (<| r.rec (function [gen-case]) - (`` ($_ r.either - (r/wrap [(' []) (' ("lux case pop"))]) - (~~ (do-template [<gen> <synth>] - [(do r.Monad<Random> - [value <gen>] - (wrap [(<synth> value) (<synth> value)]))] - - [r.bool code.bool] - [r.nat code.nat] - [r.int code.int] - [r.deg code.deg] - [r.frac code.frac] - [(r.text +5) code.text])) - (do r.Monad<Random> - [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2)))) - idx (|> r.nat (:: @ map (n/% size))) - [subS subP] gen-case - #let [caseS (` [(~+ (list.concat (list (list.repeat idx (' [])) - (list subS) - (list.repeat (|> size n/dec (n/- idx)) (' [])))))]) - caseP (` ("lux case seq" - (~ (if (tail? size idx) - (` ("lux case tuple right" (~ (code.nat idx)))) - (` ("lux case tuple left" (~ (code.nat idx)))))) - (~ subP)))]] - (wrap [caseS caseP])) - (do r.Monad<Random> - [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2)))) - idx (|> r.nat (:: @ map (n/% size))) - [subS subP] gen-case - #let [caseS (` ((~ (code.nat idx)) (~ (code.bool (tail? size idx))) (~ subS))) - caseP (` ("lux case seq" - (~ (if (tail? size idx) - (` ("lux case variant right" (~ (code.nat idx)))) - (` ("lux case variant left" (~ (code.nat idx)))))) - (~ subP)))]] - (wrap [caseS caseP])) - )))) - -(context: "Pattern-matching." - (<| (times +100) - (do @ - [[valueS pathS] gen-case - to-bind r.nat] - ($_ seq - (test "Can translate pattern-matching." - (|> (do macro.Monad<Meta> - [runtime-bytecode @runtime.translate - sampleI (@.translate-case expressionT.translate - valueS - (` ("lux case alt" - ("lux case seq" (~ pathS) - ("lux case exec" true)) - ("lux case seq" ("lux case bind" +0) - ("lux case exec" false)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (:! Bool valueT) - - (#e.Error error) - false))) - (test "Can bind values." - (|> (do macro.Monad<Meta> - [runtime-bytecode @runtime.translate - sampleI (@.translate-case expressionT.translate - (code.nat to-bind) - (` ("lux case seq" ("lux case bind" +0) - ("lux case exec" (0)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (n/= to-bind (:! Nat valueT)) - - _ - false))))))) diff --git a/new-luxc/test/test/luxc/lang/translation/jvm/function.lux b/new-luxc/test/test/luxc/lang/translation/jvm/function.lux deleted file mode 100644 index d9ee7ac71..000000000 --- a/new-luxc/test/test/luxc/lang/translation/jvm/function.lux +++ /dev/null @@ -1,103 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data [product] - [maybe] - ["e" error] - (coll ["a" array] - [list "list/" Functor<List>])) - ["r" math/random "r/" Monad<Random>] - [macro] - (macro [code]) - [host] - test) - (luxc [lang] - (lang ["ls" synthesis] - (translation (jvm [".T" expression] - ["@." eval] - ["@." runtime] - ["@." common])))) - (test/luxc common)) - -(def: arity-limit Nat +10) - -(def: arity - (r.Random ls.Arity) - (|> r.nat (r/map (|>> (n/% arity-limit) (n/max +1))))) - -(def: gen-function - (r.Random [ls.Arity Nat ls.Synthesis]) - (do r.Monad<Random> - [arity arity - arg (|> r.nat (:: @ map (n/% arity))) - #let [functionS (` ("lux function" (~ (code.nat arity)) [] - ((~ (code.int (nat-to-int (n/inc arg)))))))]] - (wrap [arity arg functionS]))) - -(context: "Function." - (<| (times +100) - (do @ - [[arity arg functionS] gen-function - cut-off (|> r.nat (:: @ map (n/% arity))) - args (r.list arity r.nat) - #let [arg-value (maybe.assume (list.nth arg args)) - argsS (list/map code.nat args) - last-arg (n/dec arity) - cut-off (|> cut-off (n/min (n/dec last-arg)))]] - ($_ seq - (test "Can read arguments." - (|> (do macro.Monad<Meta> - [runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` ("lux call" (~ functionS) (~+ argsS))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (n/= arg-value (:! Nat valueT)) - - (#e.Error error) - false))) - (test "Can partially apply functions." - (or (n/= +1 arity) - (|> (do macro.Monad<Meta> - [#let [partial-arity (n/inc cut-off) - preS (list.take partial-arity argsS) - postS (list.drop partial-arity argsS)] - runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` ("lux call" - ("lux call" (~ functionS) (~+ preS)) - (~+ postS))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (n/= arg-value (:! Nat valueT)) - - (#e.Error error) - false)))) - (test "Can read environment." - (or (n/= +1 arity) - (|> (do macro.Monad<Meta> - [#let [env (|> (list.n/range +0 cut-off) - (list/map (|>> n/inc nat-to-int))) - super-arity (n/inc cut-off) - arg-var (if (n/<= cut-off arg) - (|> arg n/inc nat-to-int (i/* -1)) - (|> arg n/inc (n/- super-arity) nat-to-int)) - sub-arity (|> arity (n/- super-arity)) - functionS (` ("lux function" (~ (code.nat super-arity)) [] - ("lux function" (~ (code.nat sub-arity)) [(~+ (list/map code.int env))] - ((~ (code.int arg-var))))))] - runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` ("lux call" (~ functionS) (~+ argsS))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (n/= arg-value (:! Nat valueT)) - - (#e.Error error) - false)))) - )))) diff --git a/new-luxc/test/test/luxc/lang/translation/jvm/primitive.lux b/new-luxc/test/test/luxc/lang/translation/jvm/primitive.lux deleted file mode 100644 index 9d51490e2..000000000 --- a/new-luxc/test/test/luxc/lang/translation/jvm/primitive.lux +++ /dev/null @@ -1,65 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data text/format - ["e" error] - [bool "B/" Eq<Bool>] - [text "T/" Eq<Text>]) - ["r" math/random] - [macro] - (macro [code]) - test) - (luxc [lang] - (lang [".L" host] - ["ls" synthesis] - (translation (jvm [".T" expression] - ["@." runtime] - ["@." eval] - ["@." common])))) - (test/luxc common)) - -(context: "Primitives." - (<| (times +100) - (do @ - [%bool% r.bool - %nat% r.nat - %int% r.int - %deg% r.deg - %frac% r.frac - %text% (r.text +5)] - (with-expansions - [<tests> (do-template [<desc> <type> <synthesis> <sample> <test>] - [(test (format "Can translate " <desc> ".") - (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (<synthesis> <sample>))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (<test> <sample> (:! <type> valueT)) - - (#e.Error error) - false)))] - - ["bool" Bool code.bool %bool% B/=] - ["nat" Nat code.nat %nat% n/=] - ["int" Int code.int %int% i/=] - ["deg" Deg code.deg %deg% d/=] - ["frac" Frac code.frac %frac% f/=] - ["text" Text code.text %text% T/=])] - ($_ seq - (test "Can translate unit." - (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (' []))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (is hostL.unit (:! Text valueT)) - - _ - false))) - <tests> - ))))) diff --git a/new-luxc/test/test/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/test/test/luxc/lang/translation/jvm/procedure/common.jvm.lux deleted file mode 100644 index d81058e17..000000000 --- a/new-luxc/test/test/luxc/lang/translation/jvm/procedure/common.jvm.lux +++ /dev/null @@ -1,385 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data text/format - [bit] - ["e" error] - [bool "bool/" Eq<Bool>] - [text "text/" Eq<Text>] - [number "nat/" Interval<Nat> "int/" Interval<Int> "real/" Interval<Frac> "deg/" Interval<Deg>] - (coll ["a" array] - [list])) - ["r" math/random] - [macro] - (macro [code]) - [host] - test) - (luxc [lang] - (lang ["ls" synthesis] - (translation (jvm [".T" expression] - ["@." eval] - ["@." runtime] - ["@." common])))) - (test/luxc common)) - -(context: "Bit procedures" - (<| (times +100) - (do @ - [param r.nat - subject r.nat] - (with-expansions [<binary> (do-template [<name> <reference>] - [(test <name> - (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (` (<name> (~ (code.nat subject)) - (~ (code.nat param)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (n/= (<reference> param subject) (:! Nat valueT)) - - _ - false)))] - - ["lux bit and" bit.and] - ["lux bit or" bit.or] - ["lux bit xor" bit.xor] - ["lux bit shift-left" bit.shift-left] - ["lux bit unsigned-shift-right" bit.shift-right] - )] - ($_ seq - (test "lux bit count" - (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (` ("lux bit count" (~ (code.nat subject)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (n/= (bit.count subject) (:! Nat valueT)) - - _ - false))) - - <binary> - (test "lux bit shift-right" - (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (` ("lux bit shift-right" - (~ (code.int (nat-to-int subject))) - (~ (code.nat param)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (i/= (bit.signed-shift-right param (nat-to-int subject)) - (:! Int valueT)) - - _ - false))) - ))))) - -(context: "Nat procedures" - (<| (times +100) - (do @ - [param (|> r.nat (r.filter (|>> (n/= +0) not))) - subject r.nat] - (`` ($_ seq - (~~ (do-template [<name> <reference>] - [(test <name> - (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (` (<name>)))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (n/= <reference> (:! Nat valueT)) - - _ - false)))] - - ["lux nat min" nat/bottom] - ["lux nat max" nat/top] - )) - (~~ (do-template [<name> <type> <prepare> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (` (<name> (~ (code.nat subject)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (<comp> (<prepare> subject) (:! <type> valueT)) - - _ - false)))] - - ["lux nat to-int" Int nat-to-int i/=] - ["lux nat char" Text text.from-code text/=] - )) - (~~ (do-template [<name> <reference> <outputT> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` (<name> (~ (code.nat subject)) (~ (code.nat param)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (<comp> (<reference> param subject) (:! <outputT> valueT)) - - _ - false)))] - - ["lux nat +" n/+ Nat n/=] - ["lux nat -" n/- Nat n/=] - ["lux nat *" n/* Nat n/=] - ["lux nat /" n// Nat n/=] - ["lux nat %" n/% Nat n/=] - ["lux nat =" n/= Bool bool/=] - ["lux nat <" n/< Bool bool/=] - )) - ))))) - -(context: "Int procedures" - (<| (times +100) - (do @ - [param (|> r.int (r.filter (|>> (i/= 0) not))) - subject r.int] - (with-expansions [<nullary> (do-template [<name> <reference>] - [(test <name> - (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (` (<name>)))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (i/= <reference> (:! Int valueT)) - - _ - false)))] - - ["lux int min" int/bottom] - ["lux int max" int/top] - ) - <unary> (do-template [<name> <type> <prepare> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (` (<name> (~ (code.int subject)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (<comp> (<prepare> subject) (:! <type> valueT)) - - _ - false)))] - - ["lux int to-nat" Nat int-to-nat n/=] - ["lux int to-frac" Frac int-to-frac f/=] - ) - <binary> (do-template [<name> <reference> <outputT> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` (<name> (~ (code.int subject)) (~ (code.int param)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (<comp> (<reference> param subject) (:! <outputT> valueT)) - - _ - false)))] - - ["lux int +" i/+ Int i/=] - ["lux int -" i/- Int i/=] - ["lux int *" i/* Int i/=] - ["lux int /" i// Int i/=] - ["lux int %" i/% Int i/=] - ["lux int =" i/= Bool bool/=] - ["lux int <" i/< Bool bool/=] - )] - ($_ seq - <nullary> - <unary> - <binary> - ))))) - -(context: "Frac procedures [Part 1]" - (<| (times +100) - (do @ - [param (|> r.frac (r.filter (|>> (f/= 0.0) not))) - subject r.frac] - (with-expansions [<binary> (do-template [<name> <reference> <outputT> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (<comp> (<reference> param subject) (:! <outputT> valueT)) - - _ - false)))] - - ["lux frac +" f/+ Frac f/=] - ["lux frac -" f/- Frac f/=] - ["lux frac *" f/* Frac f/=] - ["lux frac /" f// Frac f/=] - ["lux frac %" f/% Frac f/=] - ["lux frac =" f/= Bool bool/=] - ["lux frac <" f/< Bool bool/=] - )] - ($_ seq - <binary> - ))))) - -(context: "Frac procedures [Part 2]" - (<| (times +100) - (do @ - [param (|> r.frac (r.filter (|>> (f/= 0.0) not))) - subject r.frac] - (with-expansions [<nullary> (do-template [<name> <test>] - [(test <name> - (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (` (<name>)))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (<test> (:! Frac valueT)) - - _ - false)))] - - ["lux frac min" (f/= real/bottom)] - ["lux frac max" (f/= real/top)] - ["lux frac not-a-number" number.not-a-number?] - ["lux frac positive-infinity" (f/= number.positive-infinity)] - ["lux frac negative-infinity" (f/= number.negative-infinity)] - ["lux frac smallest" (f/= ("lux frac smallest"))] - ) - <unary> (do-template [<name> <type> <prepare> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` (<name> (~ (code.frac subject)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (<comp> (<prepare> subject) (:! <type> valueT)) - - _ - false)))] - - ["lux frac to-int" Int frac-to-int i/=] - ["lux frac to-deg" Deg frac-to-deg d/=] - )] - ($_ seq - <nullary> - <unary> - (test "frac encode|decode" - (|> (do macro.Monad<Meta> - [runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` ("lux frac decode" ("lux frac encode" (~ (code.frac subject))))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (^multi (#e.Success valueT) - [(:! (Maybe Frac) valueT) (#.Some value)]) - (f/= subject value) - - _ - false))) - ))))) - -(def: (above-threshold value) - (-> Deg Deg) - (let [threshold .000000001 #( 1/(2^30) )#] - (if (d/< threshold value) - (d/+ threshold value) - value))) - -(context: "Deg procedures" - (<| (times +100) - (do @ - [param (|> r.deg (:: @ map above-threshold)) - special r.nat - subject (|> r.deg (:: @ map above-threshold))] - (`` ($_ seq - (~~ (do-template [<name> <reference>] - [(test <name> - (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (` (<name>)))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (d/= <reference> (:! Deg valueT)) - - _ - false)))] - - ["lux deg min" deg/bottom] - ["lux deg max" deg/top] - )) - (~~ (do-template [<name> <type> <prepare> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` (<name> (~ (code.deg subject)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (<comp> (<prepare> subject) (:! <type> valueT)) - - _ - false)))] - - ["lux deg to-frac" Frac deg-to-frac f/=] - )) - (~~ (do-template [<name> <reference> <outputT> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` (<name> (~ (code.deg subject)) (~ (code.deg param)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (<comp> (<reference> param subject) (:! <outputT> valueT)) - - _ - false)))] - - ["lux deg +" d/+ Deg d/=] - ["lux deg -" d/- Deg d/=] - ["lux deg *" d/* Deg d/=] - ["lux deg /" d// Deg d/=] - ["lux deg %" d/% Deg d/=] - ["lux deg =" d/= Bool bool/=] - ["lux deg <" d/< Bool bool/=] - )) - (~~ (do-template [<name> <reference> <outputT> <comp>] - [(test <name> - (|> (do macro.Monad<Meta> - [runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` (<name> (~ (code.deg subject)) (~ (code.nat special)))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (<comp> (<reference> special subject) (:! <outputT> valueT)) - - _ - false)))] - - ["lux deg scale" d/scale Deg d/=] - ["lux deg reciprocal" d/reciprocal Deg d/=] - )) - ))))) diff --git a/new-luxc/test/test/luxc/lang/translation/jvm/reference.lux b/new-luxc/test/test/luxc/lang/translation/jvm/reference.lux deleted file mode 100644 index 8de6c4fa5..000000000 --- a/new-luxc/test/test/luxc/lang/translation/jvm/reference.lux +++ /dev/null @@ -1,76 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data ["e" error] - [text]) - ["r" math/random] - [macro] - (macro [code]) - test) - (luxc [lang] - (lang ["_." module] - (host ["$" jvm] - (jvm ["$i" inst])) - ["ls" synthesis] - (translation (jvm [".T" statement] - [".T" eval] - [".T" expression] - [".T" case] - [".T" runtime])))) - (test/luxc common)) - -(def: ident-part - (r.Random Text) - (|> (r.text +5) - (r.filter (function [sample] - (not (or (text.contains? "/" sample) - (text.contains? "[" sample) - (text.contains? "]" sample))))))) - -(context: "Definitions." - (<| (times +100) - (do @ - [module-name ident-part - def-name ident-part - def-value r.int - #let [valueI (|>> ($i.long def-value) ($i.wrap #$.Long))]] - ($_ seq - (test "Can refer to definitions." - (|> (do macro.Monad<Meta> - [_ (_module.with-module +0 module-name - (statementT.translate-def def-name Int valueI (' {}))) - sampleI (expressionT.translate (code.symbol [module-name def-name]))] - (evalT.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (i/= def-value (:! Int valueT)) - - (#e.Error error) - false))) - )))) - -(context: "Variables." - (<| (times +100) - (do @ - [module-name (|> (r.text +5) (r.filter (|>> (text.contains? "/") not))) - register (|> r.nat (:: @ map (n/% +100))) - value r.int] - ($_ seq - (test "Can refer to local variables/registers." - (|> (do macro.Monad<Meta> - [sampleI (caseT.translate-let expressionT.translate - register - (code.int value) - (` ((~ (code.int (nat-to-int register))))))] - (evalT.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success outputT) - (i/= value (:! Int outputT)) - - (#e.Error error) - false))) - )))) diff --git a/new-luxc/test/test/luxc/lang/translation/jvm/structure.lux b/new-luxc/test/test/luxc/lang/translation/jvm/structure.lux deleted file mode 100644 index 2fc377bd6..000000000 --- a/new-luxc/test/test/luxc/lang/translation/jvm/structure.lux +++ /dev/null @@ -1,113 +0,0 @@ -(.module: - lux - (lux [io] - (control [monad #+ do] - pipe) - (data ["e" error] - [maybe] - [bool "bool/" Eq<Bool>] - [text "text/" Eq<Text>] - text/format - (coll [array] - [list])) - ["r" math/random "r/" Monad<Random>] - [macro] - (macro [code]) - [host] - test) - (luxc [lang] - (lang [".L" host] - ["ls" synthesis] - (translation (jvm [".T" expression] - ["@." eval] - ["@." runtime] - ["@." common])))) - (test/luxc common)) - -(host.import java/lang/Integer) - -(def: gen-primitive - (r.Random ls.Synthesis) - (r.either (r.either (r.either (r/wrap (' [])) - (r/map code.bool r.bool)) - (r.either (r/map code.nat r.nat) - (r/map code.int r.int))) - (r.either (r.either (r/map code.deg r.deg) - (r/map code.frac r.frac)) - (r/map code.text (r.text +5))))) - -(def: (corresponds? [prediction sample]) - (-> [ls.Synthesis Top] Bool) - (case prediction - [_ (#.Tuple #.Nil)] - (is hostL.unit (:! Text sample)) - - (^template [<tag> <type> <test>] - [_ (<tag> prediction')] - (case (host.try (<test> prediction' (:! <type> sample))) - (#e.Success result) - result - - (#e.Error error) - false)) - ([#.Bool Bool bool/=] - [#.Nat Nat n/=] - [#.Int Int i/=] - [#.Deg Deg d/=] - [#.Frac Frac f/=] - [#.Text Text text/=]) - - _ - false - )) - -(context: "Tuples." - (<| (times +100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) - members (r.list size gen-primitive)] - (test "Can translate tuple." - (|> (do macro.Monad<Meta> - [sampleI (expressionT.translate (code.tuple members))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (let [valueT (:! (Array Top) valueT)] - (and (n/= size (array.size valueT)) - (list.every? corresponds? (list.zip2 members (array.to-list valueT))))) - - _ - false)))))) - -(context: "Variants." - (<| (times +100) - (do @ - [num-tags (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) - tag (|> r.nat (:: @ map (n/% num-tags))) - #let [last? (n/= (n/dec num-tags) tag)] - member gen-primitive] - (test "Can translate variant." - (|> (do macro.Monad<Meta> - [runtime-bytecode @runtime.translate - sampleI (expressionT.translate (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ member))))] - (@eval.eval sampleI)) - (lang.with-current-module "") - (macro.run (init-compiler [])) - (case> (#e.Success valueT) - (let [valueT (:! (Array Top) valueT)] - (and (n/= +3 (array.size valueT)) - (let [_tag (:! Integer (maybe.assume (array.read +0 valueT))) - _last? (array.read +1 valueT) - _value (:! Top (maybe.assume (array.read +2 valueT)))] - (and (n/= tag (|> _tag host.int-to-long int-to-nat)) - (case _last? - (#.Some _last?') - (and last? (text/= "" (:! Text _last?'))) - - #.None - (not last?)) - (corresponds? [member _value]))))) - - _ - false)))))) diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux new file mode 100644 index 000000000..1f5552bce --- /dev/null +++ b/new-luxc/test/test/luxc/lang/translation/primitive.lux @@ -0,0 +1,80 @@ +(.module: + lux + (lux [io #+ IO] + (control [monad #+ do] + pipe) + (data text/format + ["e" error] + [bool "bool/" Eq<Bool>] + [text "text/" Eq<Text>]) + ["r" math/random] + [macro] + (macro [code]) + test) + (luxc [lang] + (lang [".L" host] + ["ls" synthesis] + (translation (jvm [".T_jvm" expression] + [".T_jvm" runtime] + [".T_jvm" eval]) + (js [".T_js" expression] + [".T_js" runtime] + [".T_js" eval])))) + (test/luxc common)) + +(def: (spec translate-expression eval translate-runtime init) + (All [a] + (-> (-> ls.Synthesis (Meta a)) + (-> a (Meta Top)) + (Meta Top) + (IO Compiler) + Test)) + (do r.Monad<Random> + [%bool% r.bool + %nat% r.nat + %int% r.int + %deg% r.deg + %frac% r.frac + %text% (r.text +5)] + (`` ($_ seq + (test "Can translate unit." + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-expression (' []))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (is hostL.unit (:! Text valueT)) + + _ + false))) + (~~ (do-template [<desc> <type> <synthesis> <sample> <test>] + [(test (format "Can translate " <desc> ".") + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-expression (<synthesis> <sample>))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (<test> <sample> (:! <type> valueT)) + + (#e.Error error) + false)))] + + ["bool" Bool code.bool %bool% bool/=] + ["nat" Nat code.nat %nat% n/=] + ["int" Int code.int %int% i/=] + ["deg" Deg code.deg %deg% d/=] + ["frac" Frac code.frac %frac% f/=] + ["text" Text code.text %text% text/=])) + )))) + +(context: "[JVM] Primitives." + (<| (times +100) + (spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm))) + +(context: "[JS] Primitives." + (<| (times +100) + (spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux new file mode 100644 index 000000000..c831fb33a --- /dev/null +++ b/new-luxc/test/test/luxc/lang/translation/reference.lux @@ -0,0 +1,113 @@ +(.module: + lux + (lux [io #+ IO] + (control [monad #+ do] + pipe) + (data ["e" error] + [text]) + ["r" math/random] + [macro] + (macro [code]) + test) + (luxc [lang] + (lang ["_." module] + ["ls" synthesis] + (translation (jvm [".T_jvm" statement] + [".T_jvm" eval] + [".T_jvm" expression] + [".T_jvm" case] + [".T_jvm" runtime]) + (js [".T_js" statement] + [".T_js" eval] + [".T_js" expression] + [".T_js" case] + [".T_js" runtime])))) + (test/luxc common)) + +(def: upper-alpha-ascii + (r.Random Nat) + (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65))))) + +(def: ident-part + (r.Random Text) + (|> (r.text' upper-alpha-ascii +5) + (r.filter (function [sample] + (not (or (text.contains? "/" sample) + (text.contains? "[" sample) + (text.contains? "]" sample))))))) + +(def: (definitions-spec translate-expression eval translate-runtime init + translate-def) + (All [a] + (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) + (-> Text Type a Code (Meta Unit)) + Test)) + (do r.Monad<Random> + [module-name ident-part + def-name ident-part + def-value r.int] + ($_ seq + (test "Can refer to definitions." + (|> (do macro.Monad<Meta> + [_ translate-runtime + valueO (translate-expression (code.int def-value)) + _ (_module.with-module +0 module-name + (translate-def def-name Int valueO (' {}))) + sampleO (translate-expression (code.symbol [module-name def-name]))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (i/= def-value (:! Int valueT)) + + (#e.Error error) + false))) + ))) + +(def: (variables-spec translate-expression eval translate-runtime init + translate-let) + (All [a] + (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) + (-> (-> ls.Synthesis (Meta a)) Nat ls.Synthesis ls.Synthesis (Meta a)) + Test)) + (do r.Monad<Random> + [module-name (|> (r.text +5) (r.filter (|>> (text.contains? "/") not))) + register (|> r.nat (:: @ map (n/% +100))) + value r.int] + ($_ seq + (test "Can refer to local variables/registers." + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-let translate-expression + register + (code.int value) + (` ((~ (code.int (nat-to-int register))))))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success outputT) + (i/= value (:! Int outputT)) + + (#e.Error error) + false))) + ))) + +(context: "[JVM] Definitions." + (<| (times +100) + (definitions-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm + statementT_jvm.translate-def))) + +(context: "[JVM] Variables." + (<| (times +100) + (variables-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm + caseT_jvm.translate-let))) + +(context: "[JS] Definitions." + (<| (times +100) + (definitions-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js + statementT_js.translate-def))) + +(context: "[JS] Variables." + (<| (times +100) + (variables-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js + caseT_js.translate-let))) diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux new file mode 100644 index 000000000..7443c3317 --- /dev/null +++ b/new-luxc/test/test/luxc/lang/translation/structure.lux @@ -0,0 +1,143 @@ +(.module: + lux + (lux [io #+ IO] + (control [monad #+ do] + pipe) + (data ["e" error] + [maybe] + [bool "bool/" Eq<Bool>] + [text "text/" Eq<Text>] + text/format + (coll [array] + [list])) + ["r" math/random "r/" Monad<Random>] + [macro] + (macro [code]) + [host] + test) + (luxc [lang] + (lang [".L" host] + ["ls" synthesis] + (translation (jvm [".T_jvm" expression] + [".T_jvm" runtime] + [".T_jvm" eval]) + (js [".T_js" expression] + [".T_js" runtime] + [".T_js" eval])))) + (test/luxc common)) + +(host.import java/lang/Integer) +(host.import java/lang/Long) + +(def: gen-primitive + (r.Random ls.Synthesis) + (r.either (r.either (r.either (r/wrap (' [])) + (r/map code.bool r.bool)) + (r.either (r/map code.nat r.nat) + (r/map code.int r.int))) + (r.either (r.either (r/map code.deg r.deg) + (r/map code.frac r.frac)) + (r/map code.text (r.text +5))))) + +(def: (corresponds? [prediction sample]) + (-> [ls.Synthesis Top] Bool) + (case prediction + [_ (#.Tuple #.Nil)] + (text/= hostL.unit (:! Text sample)) + + (^template [<tag> <type> <test>] + [_ (<tag> prediction')] + (case (host.try (<test> prediction' (:! <type> sample))) + (#e.Success result) + result + + (#e.Error error) + false)) + ([#.Bool Bool bool/=] + [#.Nat Nat n/=] + [#.Int Int i/=] + [#.Deg Deg d/=] + [#.Frac Frac f/=] + [#.Text Text text/=]) + + _ + false + )) + +(def: (tuples-spec translate-expression eval translate-runtime init) + (All [a] + (-> (-> ls.Synthesis (Meta a)) + (-> a (Meta Top)) + (Meta Top) + (IO Compiler) + Test)) + (do r.Monad<Random> + [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + members (r.list size gen-primitive)] + (test "Can translate tuple." + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-expression (code.tuple members))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (let [valueT (:! (Array Top) valueT)] + (and (n/= size (array.size valueT)) + (list.every? corresponds? (list.zip2 members (array.to-list valueT))))) + + (#e.Error error) + false))))) + +(def: (variants-spec translate-expression eval translate-runtime init) + (All [a] + (-> (-> ls.Synthesis (Meta a)) + (-> a (Meta Top)) + (Meta Top) + (IO Compiler) + Test)) + (do r.Monad<Random> + [num-tags (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2)))) + tag (|> r.nat (:: @ map (n/% num-tags))) + #let [last? (n/= (n/dec num-tags) tag)] + member gen-primitive] + (test "Can translate variant." + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-expression (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ member))))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (let [valueT (:! (Array Top) valueT)] + (and (n/= +3 (array.size valueT)) + (let [_tag (:! Integer (maybe.assume (array.read +0 valueT))) + _last? (array.read +1 valueT) + _value (:! Top (maybe.assume (array.read +2 valueT)))] + (and (n/= tag (|> _tag host.int-to-long (:! Nat))) + (case _last? + (#.Some _last?') + (and last? (text/= "" (:! Text _last?'))) + + #.None + (not last?)) + (corresponds? [member _value]))))) + + (#e.Error error) + false))))) + +(context: "[JVM] Tuples." + (<| (times +100) + (tuples-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm))) + +(context: "[JVM] Variants." + (<| (times +100) + (variants-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm))) + +(context: "[JS] Tuples." + (<| (times +100) + (tuples-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) + +(context: "[JS] Variants." + (<| (times +100) + (variants-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux index e6d6490e6..d33bcebd8 100644 --- a/new-luxc/test/tests.lux +++ b/new-luxc/test/tests.lux @@ -19,22 +19,13 @@ ["_.S" function] ["_.S" procedure] ["_.S" loop]) - (translation (jvm ["_.T_jvm" primitive] - ["_.T_jvm" structure] - ["_.T_jvm" case] - ["_.T_jvm" function] - ["_.T_jvm" reference] - (procedure ["_.T_jvm" common] - ["_.T_jvm" host])) - (js ["_.T_js" primitive] - ["_.T_js" structure] - ["_.T_js" case] - ["_.T_js" function] - ["_.T_js" reference] - (procedure ["_.T_js" common] - ## ["_.T_js" host] - ) - ))) + (translation ["_.T" primitive] + ["_.T" reference] + ["_.T" structure] + ["_.T" case] + ["_.T" function] + ["_.T" common] + ["_.T" jvm])) ))) (program: args |