diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/test/test/luxc/common.lux | 9 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/case.lux | 11 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/common.lux | 425 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/function.lux | 12 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/primitive.lux | 43 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/reference.lux | 17 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/structure.lux | 74 |
7 files changed, 259 insertions, 332 deletions
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux index 20fb07e03..cc8302aa3 100644 --- a/new-luxc/test/test/luxc/common.lux +++ b/new-luxc/test/test/luxc/common.lux @@ -14,7 +14,11 @@ [js] (js [".T_js" expression] [".T_js" eval] - [".T_js" runtime]))))) + [".T_js" runtime]) + [lua] + (lua [".T_lua" expression] + [".T_lua" eval] + [".T_lua" runtime]))))) (do-template [<name> <host>] [(def: #export <name> @@ -25,6 +29,7 @@ [init-jvm &host.init-host] [init-js js.init] + [init-lua lua.init] ) (def: (run-synthesis translate-runtime translate-expression eval init) @@ -41,3 +46,5 @@ (def: #export run-jvm (run-synthesis runtimeT_jvm.translate expressionT_jvm.translate evalT_jvm.eval init-jvm)) (def: #export run-js (run-synthesis runtimeT_js.translate expressionT_js.translate evalT_js.eval init-js)) + +(def: #export run-lua (run-synthesis runtimeT_lua.translate expressionT_lua.translate evalT_lua.eval init-lua)) diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux index 9bc7a69da..e2ad48613 100644 --- a/new-luxc/test/test/luxc/lang/translation/case.lux +++ b/new-luxc/test/test/luxc/lang/translation/case.lux @@ -19,7 +19,11 @@ (js ["/_js" case] [".T_js" expression] [".T_js" eval] - [".T_js" runtime])))) + [".T_js" runtime]) + (lua ["/_lua" case] + [".T_lua" expression] + [".T_lua" eval] + [".T_lua" runtime])))) (test/luxc common)) (def: struct-limit Nat +10) @@ -123,3 +127,8 @@ (<| (times +100) (pattern-matching-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js /_js.translate-case))) + +(context: "[Lua] Pattern-matching." + (<| (times +100) + (pattern-matching-spec expressionT_lua.translate evalT_lua.eval runtimeT_lua.translate init-lua + /_lua.translate-case))) diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux index a120059ce..2f735a0d1 100644 --- a/new-luxc/test/test/luxc/lang/translation/common.lux +++ b/new-luxc/test/test/luxc/lang/translation/common.lux @@ -23,7 +23,10 @@ [".T_jvm" runtime]) (js [".T_js" eval] [".T_js" expression] - [".T_js" runtime])))) + [".T_js" runtime]) + (lua [".T_lua" eval] + [".T_lua" expression] + [".T_lua" runtime])))) (test/luxc common)) (def: (bit-spec translate-expression eval translate-runtime init) @@ -37,9 +40,9 @@ [(test <name> (|> (do macro.Monad<Meta> [_ translate-runtime - sampleJS (translate-expression (` (<name> (~ (code.nat subject)) - (~ (code.nat param)))))] - (eval sampleJS)) + sampleO (translate-expression (` (<name> (~ (code.nat subject)) + (~ (code.nat param)))))] + (eval sampleO)) (lang.with-current-module "") (macro.run (io.run init)) (case> (#e.Success valueT) @@ -59,8 +62,8 @@ (test "lux bit count" (|> (do macro.Monad<Meta> [_ translate-runtime - sampleJS (translate-expression (` ("lux bit count" (~ (code.nat subject)))))] - (eval sampleJS)) + sampleO (translate-expression (` ("lux bit count" (~ (code.nat subject)))))] + (eval sampleO)) (lang.with-current-module "") (macro.run (io.run init)) (case> (#e.Success valueT) @@ -73,10 +76,10 @@ (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)) + sampleO (translate-expression (` ("lux bit shift-right" + (~ (code.int (nat-to-int subject))) + (~ (code.nat param)))))] + (eval sampleO)) (lang.with-current-module "") (macro.run (io.run init)) (case> (#e.Success valueT) @@ -100,8 +103,8 @@ [(test <name> (|> (do macro.Monad<Meta> [_ translate-runtime - sampleJS (translate-expression (` (<name>)))] - (eval sampleJS)) + sampleO (translate-expression (` (<name>)))] + (eval sampleO)) (lang.with-current-module "") (macro.run (io.run init)) (case> (#e.Success valueT) @@ -117,8 +120,8 @@ [(test <name> (|> (do macro.Monad<Meta> [_ translate-runtime - sampleJS (translate-expression (` (<name> (~ (code.nat subject)))))] - (eval sampleJS)) + sampleO (translate-expression (` (<name> (~ (code.nat subject)))))] + (eval sampleO)) (lang.with-current-module "") (macro.run (io.run init)) (case> (#e.Success valueT) @@ -129,14 +132,14 @@ (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)] + ["lux nat char" Text text.from-code text/= (n/% (bit.shift-left +8 +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)) + sampleO (translate-expression (` (<name> (~ (code.nat subject)) (~ (code.nat param)))))] + (eval sampleO)) (lang.with-current-module "") (macro.run (io.run init)) (case> (#e.Success valueT) @@ -162,67 +165,64 @@ (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)) + (`` ($_ seq + (~~ (do-template [<name> <reference>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-expression (` (<name>)))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (i/= <reference> (:! Int valueT)) - (#e.Error error) - false)))] + (#e.Error error) + 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> - )))) + ["lux int min" int/bottom] + ["lux int max" int/top] + )) + (~~ (do-template [<name> <type> <prepare> <comp>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-expression (` (<name> (~ (code.int subject)))))] + (eval sampleO)) + (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/=] + )) + (~~ (do-template [<name> <reference> <outputT> <comp>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-expression (` (<name> (~ (code.int subject)) (~ (code.int param)))))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (<comp> (<reference> param subject) (:! <outputT> valueT)) + + (#e.Error error) + 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/=] + )) + )))) (def: (frac-spec|0 translate-expression eval translate-runtime init) (All [a] @@ -235,8 +235,8 @@ [(test <name> (|> (do macro.Monad<Meta> [_ translate-runtime - sampleJS (translate-expression (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))] - (eval sampleJS)) + sampleO (translate-expression (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))] + (eval sampleO)) (lang.with-current-module "") (macro.run (io.run init)) (case> (#e.Success valueT) @@ -262,62 +262,59 @@ (-> (-> 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) + [subject r.frac] + (`` ($_ seq + (~~ (do-template [<name> <test>] + [(test <name> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-expression (` (<name>)))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init)) + (case> (#e.Success valueT) + (<test> (:! Frac valueT)) - _ - false))) - )))) + _ + 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"))] + )) + (~~ (do-template [<forward> <backward> <test>] + [(test <forward> + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-expression (` (<backward> (<forward> (~ (code.frac subject))))))] + (eval sampleO)) + (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)])) + (test "frac encode|decode" + (|> (do macro.Monad<Meta> + [_ translate-runtime + sampleO (translate-expression (` ("lux frac decode" ("lux frac encode" (~ (code.frac subject))))))] + (eval sampleO)) + (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] @@ -357,8 +354,8 @@ [(test <name> (|> (do macro.Monad<Meta> [_ translate-runtime - sampleJS (translate-expression (` (<name>)))] - (eval sampleJS)) + sampleO (translate-expression (` (<name>)))] + (eval sampleO)) (lang.with-current-module "") (macro.run (io.run init)) (case> (#e.Success valueT) @@ -374,8 +371,8 @@ [(test <forward> (|> (do macro.Monad<Meta> [_ translate-runtime - sampleJS (translate-expression (` (<backward> (<forward> (~ (code.deg subject))))))] - (eval sampleJS)) + sampleO (translate-expression (` (<backward> (<forward> (~ (code.deg subject))))))] + (eval sampleO)) (lang.with-current-module "") (macro.run (io.run init)) (case> (#e.Success valueV) @@ -390,8 +387,8 @@ [(test <name> (|> (do macro.Monad<Meta> [_ translate-runtime - sampleJS (translate-expression (` (<name> (~ (code.deg subject)) (~ (code.deg param)))))] - (eval sampleJS)) + sampleO (translate-expression (` (<name> (~ (code.deg subject)) (~ (code.deg param)))))] + (eval sampleO)) (lang.with-current-module "") (macro.run (io.run init)) (case> (#e.Success valueT) @@ -412,8 +409,8 @@ [(test <name> (|> (do macro.Monad<Meta> [_ translate-runtime - sampleJS (translate-expression (` (<name> (~ (code.deg subject)) (~ (code.nat special)))))] - (eval sampleJS)) + sampleO (translate-expression (` (<name> (~ (code.deg subject)) (~ (code.nat special)))))] + (eval sampleO)) (lang.with-current-module "") (macro.run (io.run init)) (case> (#e.Success valueT) @@ -525,7 +522,7 @@ (case> (#e.Success valueV) (:! Bool valueV) - _ + (#e.Error error) false))) (test "Can replace sub-text once." (|> (run (` ("lux text =" @@ -537,7 +534,7 @@ (case> (#e.Success valueV) (:! Bool valueV) - _ + (#e.Error error) false))) (test "Can replace sub-text all times." (|> (run (` ("lux text =" @@ -549,7 +546,7 @@ (case> (#e.Success valueV) (:! Bool valueV) - _ + (#e.Error error) false))) (let [test-clip (function [from to expected] (|> (run (` ("lux text clip" @@ -592,7 +589,7 @@ (case> (#e.Success valueV) (n/= size (:! Nat valueV)) - _ + (#e.Error error) false))) (test "Can get element from array (if it exists)." (and (|> (run (` ("lux array get" (~ array0S) (~ (code.nat idx))))) @@ -643,14 +640,10 @@ ["lux math acos"] ["lux math asin"] ["lux math atan"] - ["lux math cosh"] - ["lux math sinh"] - ["lux math tanh"] ["lux math exp"] ["lux math log"] ["lux math ceil"] - ["lux math floor"] - ["lux math round"])) + ["lux math floor"])) (~~ (do-template [<name>] [(test (format "Can apply '" <name> "' procedure.") (|> (run (` (<name> (~ (code.frac subject)) (~ (code.frac param))))) @@ -660,7 +653,6 @@ (#e.Error error) false)))] - ["lux math atan2"] ["lux math pow"])) )))) @@ -806,110 +798,37 @@ false))) )))) -## 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))) - -## 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))) - -## 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))) - -## Text -(context: "[JVM] Text procedures" - (<| (times +100) - (text-spec run-jvm))) - -(context: "[JS] Text procedures" - (<| (times +100) - (text-spec run-js))) - -## Array -(context: "[JVM] Array procedures" - (<| (times +100) - (array-spec run-jvm))) - -(context: "[JS] Array procedures" - (<| (times +100) - (array-spec run-js))) - -## Math -(context: "[JVM] Math procedures" - (<| (times +100) - (math-spec run-jvm))) - -(context: "[JS] Math procedures" - (<| (times +100) - (math-spec run-js))) - -## I/O -(context: "[JVM] I/O procedures" - (<| (times +100) - (io-spec run-jvm))) - -(context: "[JS] I/O procedures" - (<| (times +100) - (io-spec run-js))) - -## Atom -(context: "[JVM] Atom procedures" - (<| (times +100) - (atom-spec run-jvm))) - -(context: "[JS] Atom procedures" - (<| (times +100) - (atom-spec run-js))) - -## Box -(context: "[JVM] Box procedures" - (<| (times +100) - (box-spec run-jvm))) - -(context: "[JS] Box procedures" +(def: (all-specs translate-expression eval translate-runtime init run) + (All [a] + (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) + (-> Synthesis (e.Error Top)) + Test)) + ($_ seq + (bit-spec translate-expression eval translate-runtime init) + (nat-spec translate-expression eval translate-runtime init) + (int-spec translate-expression eval translate-runtime init) + (deg-spec translate-expression eval translate-runtime init) + (frac-spec translate-expression eval translate-runtime init) + (text-spec run) + (array-spec run) + (math-spec run) + (io-spec run) + (atom-spec run) + (box-spec run) + (process-spec run) + )) + +(context: "[JVM] Common procedures." (<| (times +100) - (box-spec run-js))) + (all-specs expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm + run-jvm))) -## Process -(context: "[JVM] Process procedures" +(context: "[JS] Common procedures." (<| (times +100) - (process-spec run-jvm))) + (all-specs expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js + run-js))) -(context: "[JS] Process procedures" +(context: "[Lua] Common procedures." (<| (times +100) - (process-spec run-js))) + (all-specs expressionT_lua.translate evalT_lua.eval runtimeT_lua.translate init-lua + run-lua))) diff --git a/new-luxc/test/test/luxc/lang/translation/function.lux b/new-luxc/test/test/luxc/lang/translation/function.lux index 777cea55c..cbf8b3dbd 100644 --- a/new-luxc/test/test/luxc/lang/translation/function.lux +++ b/new-luxc/test/test/luxc/lang/translation/function.lux @@ -20,7 +20,10 @@ [".T_jvm" runtime]) (js [".T_js" eval] [".T_js" expression] - [".T_js" runtime])))) + [".T_js" runtime]) + (lua [".T_lua" eval] + [".T_lua" expression] + [".T_lua" runtime])))) (test/luxc common)) (def: arity-limit Nat +10) @@ -103,8 +106,7 @@ (n/= arg-value (:! Nat valueT)) (#e.Error error) - (exec (log! error) - false))))) + false)))) ))) (context: "[JVM] Function." @@ -114,3 +116,7 @@ (context: "[JS] Function." (<| (times +100) (function-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) + +(context: "[Lua] Function." + (<| (times +100) + (function-spec expressionT_lua.translate evalT_lua.eval runtimeT_lua.translate init-lua))) diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux index 1f5552bce..d94806601 100644 --- a/new-luxc/test/test/luxc/lang/translation/primitive.lux +++ b/new-luxc/test/test/luxc/lang/translation/primitive.lux @@ -13,22 +13,11 @@ 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])))) + [synthesis #+ Synthesis])) (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)) +(def: (spec run) + (-> (-> Synthesis (e.Error Top)) Test) (do r.Monad<Random> [%bool% r.bool %nat% r.nat @@ -38,25 +27,15 @@ %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)) + (|> (run (' [])) (case> (#e.Success valueT) - (is hostL.unit (:! Text valueT)) + (text/= hostL.unit (:! Text valueT)) - _ + (#e.Error error) 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)) + (|> (run (<synthesis> <sample>)) (case> (#e.Success valueT) (<test> <sample> (:! <type> valueT)) @@ -73,8 +52,12 @@ (context: "[JVM] Primitives." (<| (times +100) - (spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm))) + (spec run-jvm))) (context: "[JS] Primitives." (<| (times +100) - (spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) + (spec run-js))) + +(context: "[Lua] Primitives." + (<| (times +100) + (spec run-lua))) diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux index c831fb33a..130a42ed3 100644 --- a/new-luxc/test/test/luxc/lang/translation/reference.lux +++ b/new-luxc/test/test/luxc/lang/translation/reference.lux @@ -21,7 +21,12 @@ [".T_js" eval] [".T_js" expression] [".T_js" case] - [".T_js" runtime])))) + [".T_js" runtime]) + (lua [".T_lua" statement] + [".T_lua" eval] + [".T_lua" expression] + [".T_lua" case] + [".T_lua" runtime])))) (test/luxc common)) (def: upper-alpha-ascii @@ -111,3 +116,13 @@ (<| (times +100) (variables-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js caseT_js.translate-let))) + +(context: "[Lua] Definitions." + (<| (times +100) + (definitions-spec expressionT_lua.translate evalT_lua.eval runtimeT_lua.translate init-lua + statementT_lua.translate-def))) + +(context: "[Lua] Variables." + (<| (times +100) + (variables-spec expressionT_lua.translate evalT_lua.eval runtimeT_lua.translate init-lua + caseT_lua.translate-let))) diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux index 7443c3317..21a338196 100644 --- a/new-luxc/test/test/luxc/lang/translation/structure.lux +++ b/new-luxc/test/test/luxc/lang/translation/structure.lux @@ -17,30 +17,28 @@ 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])))) + [synthesis #+ Synthesis])) (test/luxc common)) (host.import java/lang/Integer) (host.import java/lang/Long) +(def: upper-alpha + (r.Random Nat) + (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65))))) + (def: gen-primitive - (r.Random ls.Synthesis) + (r.Random 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))))) + (r/map code.text (r.text' upper-alpha +5))))) (def: (corresponds? [prediction sample]) - (-> [ls.Synthesis Top] Bool) + (-> [Synthesis Top] Bool) (case prediction [_ (#.Tuple #.Nil)] (text/= hostL.unit (:! Text sample)) @@ -64,50 +62,31 @@ false )) -(def: (tuples-spec translate-expression eval translate-runtime init) - (All [a] - (-> (-> ls.Synthesis (Meta a)) - (-> a (Meta Top)) - (Meta Top) - (IO Compiler) - Test)) +(def: (tuples-spec run) + (-> (-> Synthesis (e.Error Top)) 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)) + (|> (run (code.tuple members)) (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)) + (exec (log! error) + false)))))) + +(def: (variants-spec run) + (-> (-> Synthesis (e.Error Top)) 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)) + (|> (run (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ member)))) (case> (#e.Success valueT) (let [valueT (:! (Array Top) valueT)] (and (n/= +3 (array.size valueT)) @@ -124,20 +103,29 @@ (corresponds? [member _value]))))) (#e.Error error) - false))))) + (exec (log! error) + false)))))) (context: "[JVM] Tuples." (<| (times +100) - (tuples-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm))) + (tuples-spec run-jvm))) (context: "[JVM] Variants." (<| (times +100) - (variants-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm))) + (variants-spec run-jvm))) (context: "[JS] Tuples." (<| (times +100) - (tuples-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) + (tuples-spec run-js))) (context: "[JS] Variants." (<| (times +100) - (variants-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) + (variants-spec run-js))) + +(context: "[Lua] Tuples." + (<| (times +100) + (tuples-spec run-lua))) + +(context: "[Lua] Variants." + (<| (times +100) + (variants-spec run-lua))) |