diff options
Diffstat (limited to 'new-luxc/test')
| -rw-r--r-- | new-luxc/test/test/luxc/common.lux | 62 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/case.lux | 78 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/common.lux | 247 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/function.lux | 103 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/primitive.lux | 16 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/reference.lux | 126 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/structure.lux | 4 |
7 files changed, 234 insertions, 402 deletions
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux index 5021dc258..40e06ae84 100644 --- a/new-luxc/test/test/luxc/common.lux +++ b/new-luxc/test/test/luxc/common.lux @@ -3,27 +3,40 @@ (lux (control [monad #+ do]) [io #+ IO] (data ["e" error]) - [macro]) + [macro] + (macro [code])) (luxc [lang] (lang ["&." host] [".L" init] + [".L" module] [synthesis #+ Synthesis] (translation (jvm [".T_jvm" expression] [".T_jvm" eval] - [".T_jvm" runtime]) + [".T_jvm" runtime] + [".T_jvm" statement]) [js] (js [".T_js" expression] [".T_js" eval] - [".T_js" runtime]) + [".T_js" runtime] + [".T_js" statement]) [lua] (lua [".T_lua" expression] [".T_lua" eval] - [".T_lua" runtime]) - + [".T_lua" runtime] + [".T_lua" statement]) [ruby] (ruby [".T_ruby" expression] - [".T_ruby" eval] - [".T_ruby" runtime]))))) + [".T_ruby" eval] + [".T_ruby" runtime] + [".T_ruby" statement]) + [python] + (python [".T_python" expression] + [".T_python" eval] + [".T_python" runtime] + [".T_python" statement]))))) + +(type: #export Runner (-> Synthesis (e.Error Top))) +(type: #export Definer (-> Ident Synthesis (e.Error Top))) (do-template [<name> <host>] [(def: #export <name> @@ -36,11 +49,12 @@ [init-js js.init] [init-lua lua.init] [init-ruby ruby.init] + [init-python python.init] ) -(def: (run-synthesis translate-runtime translate-expression eval init) +(def: (runner translate-runtime translate-expression eval init) (All [a] (-> (Meta Top) (-> Synthesis (Meta a)) (-> a (Meta Top)) (IO Compiler) - (-> Synthesis (e.Error Top)))) + Runner)) (function [synthesis] (|> (do macro.Monad<Meta> [_ translate-runtime @@ -49,10 +63,32 @@ (lang.with-current-module "") (macro.run (io.run init))))) -(def: #export run-jvm (run-synthesis runtimeT_jvm.translate expressionT_jvm.translate evalT_jvm.eval init-jvm)) +(def: (definer translate-runtime translate-expression eval init translate-def) + (All [a] (-> (Meta Top) (-> Synthesis (Meta a)) (-> a (Meta Top)) (IO Compiler) + (-> Text Type a Code (Meta Top)) + Definer)) + (function [[module-name def-name] synthesis] + (|> (do macro.Monad<Meta> + [_ translate-runtime + valueO (translate-expression synthesis) + _ (moduleL.with-module +0 module-name + (translate-def def-name Top valueO (' {}))) + sampleO (translate-expression (code.symbol [module-name def-name]))] + (eval sampleO)) + (lang.with-current-module "") + (macro.run (io.run init))))) + +(def: #export run-jvm (runner runtimeT_jvm.translate expressionT_jvm.translate evalT_jvm.eval init-jvm)) +(def: #export def-jvm (definer runtimeT_jvm.translate expressionT_jvm.translate evalT_jvm.eval init-jvm statementT_jvm.translate-def)) + +(def: #export run-js (runner runtimeT_js.translate expressionT_js.translate evalT_js.eval init-js)) +(def: #export def-js (definer runtimeT_js.translate expressionT_js.translate evalT_js.eval init-js statementT_js.translate-def)) -(def: #export run-js (run-synthesis runtimeT_js.translate expressionT_js.translate evalT_js.eval init-js)) +(def: #export run-lua (runner runtimeT_lua.translate expressionT_lua.translate evalT_lua.eval init-lua)) +(def: #export def-lua (definer runtimeT_lua.translate expressionT_lua.translate evalT_lua.eval init-lua statementT_lua.translate-def)) -(def: #export run-lua (run-synthesis runtimeT_lua.translate expressionT_lua.translate evalT_lua.eval init-lua)) +(def: #export run-ruby (runner runtimeT_ruby.translate expressionT_ruby.translate evalT_ruby.eval init-ruby)) +(def: #export def-ruby (definer runtimeT_ruby.translate expressionT_ruby.translate evalT_ruby.eval init-ruby statementT_ruby.translate-def)) -(def: #export run-ruby (run-synthesis runtimeT_ruby.translate expressionT_ruby.translate evalT_ruby.eval init-ruby)) +(def: #export run-python (runner runtimeT_python.translate expressionT_python.translate evalT_python.eval init-python)) +(def: #export def-python (definer runtimeT_python.translate expressionT_python.translate evalT_python.eval init-python statementT_python.translate-def)) diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux index cc33d03d3..05b1cd768 100644 --- a/new-luxc/test/test/luxc/lang/translation/case.lux +++ b/new-luxc/test/test/luxc/lang/translation/case.lux @@ -11,23 +11,7 @@ (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]) - (lua ["/_lua" case] - [".T_lua" expression] - [".T_lua" eval] - [".T_lua" runtime]) - (ruby ["/_ruby" case] - [".T_ruby" expression] - [".T_ruby" eval] - [".T_ruby" runtime])))) + (lang ["ls" synthesis])) (test/luxc common)) (def: struct-limit Nat +10) @@ -36,6 +20,10 @@ (-> Nat Nat Bool) (n/= (n/dec size) idx)) +(def: upper-alpha-ascii + (r.Random Nat) + (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65))))) + (def: gen-case (r.Random [ls.Synthesis ls.Path]) (<| r.rec (function [gen-case]) @@ -51,7 +39,7 @@ [r.int code.int] [r.deg code.deg] [r.frac code.frac] - [(r.text +5) code.text])) + [(r.text' upper-alpha-ascii +5) code.text])) (do r.Monad<Random> [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2)))) idx (|> r.nat (:: @ map (n/% size))) @@ -78,44 +66,28 @@ (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)) +(def: (pattern-matching-spec run) + (-> (-> ls.Synthesis (e.Error Top)) 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)) + (|> (run (` ("lux case" (~ valueS) + ("lux case alt" + ("lux case seq" (~ pathS) + ("lux case exec" true)) + ("lux case seq" ("lux case bind" +0) + ("lux case exec" false)))))) (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)) + (|> (run (` ("lux case" (~ (code.nat to-bind)) + ("lux case seq" ("lux case bind" +0) + ("lux case exec" (0)))))) (case> (#e.Success valueT) (n/= to-bind (:! Nat valueT)) @@ -124,20 +96,20 @@ (context: "[JVM] Pattern-matching." (<| (times +100) - (pattern-matching-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm - /_jvm.translate-case))) + (pattern-matching-spec run-jvm))) (context: "[JS] Pattern-matching." (<| (times +100) - (pattern-matching-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js - /_js.translate-case))) + (pattern-matching-spec run-js))) (context: "[Lua] Pattern-matching." (<| (times +100) - (pattern-matching-spec expressionT_lua.translate evalT_lua.eval runtimeT_lua.translate init-lua - /_lua.translate-case))) + (pattern-matching-spec run-lua))) (context: "[Ruby] Pattern-matching." (<| (times +100) - (pattern-matching-spec expressionT_ruby.translate evalT_ruby.eval runtimeT_ruby.translate init-ruby - /_ruby.translate-case))) + (pattern-matching-spec run-ruby))) + +(context: "[Python] Function." + (<| (times +100) + (pattern-matching-spec run-python))) diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux index 72dbeb1da..23afaac36 100644 --- a/new-luxc/test/test/luxc/lang/translation/common.lux +++ b/new-luxc/test/test/luxc/lang/translation/common.lux @@ -17,37 +17,18 @@ [host] test) (luxc [lang] - (lang [synthesis #+ Synthesis] - (translation (jvm [".T_jvm" eval] - [".T_jvm" expression] - [".T_jvm" runtime]) - (js [".T_js" eval] - [".T_js" expression] - [".T_js" runtime]) - (lua [".T_lua" eval] - [".T_lua" expression] - [".T_lua" runtime]) - (ruby [".T_ruby" eval] - [".T_ruby" expression] - [".T_ruby" runtime])))) + (lang [synthesis #+ Synthesis])) (test/luxc common)) -(def: (bit-spec translate-expression eval translate-runtime init) - (All [a] - (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) - Test)) +(def: (bit-spec run) + (-> Runner 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 - sampleO (translate-expression (` (<name> (~ (code.nat subject)) - (~ (code.nat param)))))] - (eval sampleO)) - (lang.with-current-module "") - (macro.run (io.run init)) + (|> (run (` (<name> (~ (code.nat subject)) + (~ (code.nat param))))) (case> (#e.Success valueT) (n/= (<reference> param subject) (:! Nat valueT)) @@ -63,12 +44,7 @@ )] ($_ seq (test "lux bit count" - (|> (do macro.Monad<Meta> - [_ translate-runtime - sampleO (translate-expression (` ("lux bit count" (~ (code.nat subject)))))] - (eval sampleO)) - (lang.with-current-module "") - (macro.run (io.run init)) + (|> (run (` ("lux bit count" (~ (code.nat subject))))) (case> (#e.Success valueT) (n/= (bit.count subject) (:! Nat valueT)) @@ -77,14 +53,9 @@ <binary> (test "lux bit shift-right" - (|> (do macro.Monad<Meta> - [_ translate-runtime - 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)) + (|> (run (` ("lux bit shift-right" + (~ (code.int (nat-to-int subject))) + (~ (code.nat param))))) (case> (#e.Success valueT) (i/= (bit.signed-shift-right param (nat-to-int subject)) (:! Int valueT)) @@ -94,22 +65,15 @@ (let [param (n/% +64 param)]))) )))) -(def: (nat-spec translate-expression eval translate-runtime init) - (All [a] - (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) - Test)) +(def: (nat-spec run) + (-> Runner 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 - sampleO (translate-expression (` (<name>)))] - (eval sampleO)) - (lang.with-current-module "") - (macro.run (io.run init)) + (|> (run (` (<name>))) (case> (#e.Success valueT) (n/= <reference> (:! Nat valueT)) @@ -121,12 +85,7 @@ )) (~~ (do-template [<name> <type> <prepare> <comp> <subject-expr>] [(test <name> - (|> (do macro.Monad<Meta> - [_ translate-runtime - sampleO (translate-expression (` (<name> (~ (code.nat subject)))))] - (eval sampleO)) - (lang.with-current-module "") - (macro.run (io.run init)) + (|> (run (` (<name> (~ (code.nat subject))))) (case> (#e.Success valueT) (<comp> (<prepare> subject) (:! <type> valueT)) @@ -139,12 +98,7 @@ )) (~~ (do-template [<name> <reference> <outputT> <comp>] [(test <name> - (|> (do macro.Monad<Meta> - [_ translate-runtime - sampleO (translate-expression (` (<name> (~ (code.nat subject)) (~ (code.nat param)))))] - (eval sampleO)) - (lang.with-current-module "") - (macro.run (io.run init)) + (|> (run (` (<name> (~ (code.nat subject)) (~ (code.nat param))))) (case> (#e.Success valueT) (<comp> (<reference> param subject) (:! <outputT> valueT)) @@ -161,22 +115,17 @@ )) )))) -(def: (int-spec translate-expression eval translate-runtime init) - (All [a] - (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) - Test)) +(def: (int-spec run) + (-> Runner Test) (do r.Monad<Random> [param (|> r.int (r.filter (|>> (i/= 0) not))) - subject r.int] + subject r.int + #let [_ (log! (format " param = " (%i param) "\n" + "subject = " (%i subject) "\n"))]] (`` ($_ 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)) + (|> (run (` (<name>))) (case> (#e.Success valueT) (i/= <reference> (:! Int valueT)) @@ -188,12 +137,7 @@ )) (~~ (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)) + (|> (run (` (<name> (~ (code.int subject))))) (case> (#e.Success valueT) (<comp> (<prepare> subject) (:! <type> valueT)) @@ -205,17 +149,13 @@ )) (~~ (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)) + (exec (log! <name>) + (|> (run (` (<name> (~ (code.int subject)) (~ (code.int param))))) + (case> (#e.Success valueT) + (<comp> (<reference> param subject) (:! <outputT> valueT)) - (#e.Error error) - false)))] + (#e.Error error) + false))))] ["lux int +" i/+ Int i/=] ["lux int -" i/- Int i/=] @@ -227,21 +167,14 @@ )) )))) -(def: (frac-spec|0 translate-expression eval translate-runtime init) - (All [a] - (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) - Test)) +(def: (frac-spec|0 run) + (-> Runner 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 - sampleO (translate-expression (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))] - (eval sampleO)) - (lang.with-current-module "") - (macro.run (io.run init)) + (|> (run (` (<name> (~ (code.frac subject)) (~ (code.frac param))))) (case> (#e.Success valueT) (<comp> (<reference> param subject) (:! <outputT> valueT)) @@ -260,21 +193,14 @@ <binary> )))) -(def: (frac-spec|1 translate-expression eval translate-runtime init) - (All [a] - (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) - Test)) +(def: (frac-spec|1 run) + (-> Runner Test) (do r.Monad<Random> [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)) + (|> (run (` (<name>))) (case> (#e.Success valueT) (<test> (:! Frac valueT)) @@ -290,12 +216,7 @@ )) (~~ (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)) + (|> (run (` (<backward> (<forward> (~ (code.frac subject)))))) (case> (#e.Success valueT) (|> valueT (:! Frac) (f/- subject) frac/abs <test>) @@ -305,12 +226,7 @@ ["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)) + (|> (run (` ("lux frac decode" ("lux frac encode" (~ (code.frac subject)))))) (case> (^multi (#e.Success valueT) [(:! (Maybe Frac) valueT) (#.Some value)]) (f/= subject value) @@ -319,13 +235,11 @@ false))) )))) -(def: (frac-spec translate-expression eval translate-runtime init) - (All [a] - (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) - Test)) +(def: (frac-spec run) + (-> Runner Test) ($_ seq - (frac-spec|0 translate-expression eval translate-runtime init) - (frac-spec|1 translate-expression eval translate-runtime init))) + (frac-spec|0 run) + (frac-spec|1 run))) (def: deg-threshold {#.doc "~ 1/(2^30)"} @@ -344,10 +258,8 @@ (d/- reference sample) (d/- sample reference))) -(def: (deg-spec translate-expression eval translate-runtime init) - (All [a] - (-> (-> Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) - Test)) +(def: (deg-spec run) + (-> Runner Test) (do r.Monad<Random> [param (|> r.deg (:: @ map above-threshold)) special r.nat @@ -355,12 +267,7 @@ (`` ($_ 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)) + (|> (run (` (<name>))) (case> (#e.Success valueT) (d/= <reference> (:! Deg valueT)) @@ -372,12 +279,7 @@ )) (~~ (do-template [<forward> <backward> <type>] [(test <forward> - (|> (do macro.Monad<Meta> - [_ translate-runtime - sampleO (translate-expression (` (<backward> (<forward> (~ (code.deg subject))))))] - (eval sampleO)) - (lang.with-current-module "") - (macro.run (io.run init)) + (|> (run (` (<backward> (<forward> (~ (code.deg subject)))))) (case> (#e.Success valueV) (d/<= deg-threshold (deg-difference subject (:! <type> valueV))) @@ -388,12 +290,7 @@ )) (~~ (do-template [<name> <reference> <outputT> <comp>] [(test <name> - (|> (do macro.Monad<Meta> - [_ translate-runtime - sampleO (translate-expression (` (<name> (~ (code.deg subject)) (~ (code.deg param)))))] - (eval sampleO)) - (lang.with-current-module "") - (macro.run (io.run init)) + (|> (run (` (<name> (~ (code.deg subject)) (~ (code.deg param))))) (case> (#e.Success valueT) (<comp> (<reference> param subject) (:! <outputT> valueT)) @@ -410,12 +307,7 @@ )) (~~ (do-template [<name> <reference> <outputT> <comp>] [(test <name> - (|> (do macro.Monad<Meta> - [_ translate-runtime - sampleO (translate-expression (` (<name> (~ (code.deg subject)) (~ (code.nat special)))))] - (eval sampleO)) - (lang.with-current-module "") - (macro.run (io.run init)) + (|> (run (` (<name> (~ (code.deg subject)) (~ (code.nat special))))) (case> (#e.Success valueT) (<comp> (<reference> special subject) (:! <outputT> valueT)) @@ -441,7 +333,7 @@ upper-alpha)) (def: (text-spec run) - (-> (-> Synthesis (e.Error Top)) Test) + (-> Runner Test) (do r.Monad<Random> [sample-size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) sample0 (r.text' lower-alpha sample-size) @@ -579,7 +471,7 @@ ))) (def: (array-spec run) - (-> (-> Synthesis (e.Error Top)) Test) + (-> Runner Test) (do r.Monad<Random> [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +1)))) idx (|> r.nat (:: @ map (n/% size))) @@ -623,7 +515,7 @@ ))) (def: (math-spec run) - (-> (-> Synthesis (e.Error Top)) Test) + (-> Runner Test) (do r.Monad<Random> [subject r.frac param r.frac] @@ -660,9 +552,9 @@ )))) (def: (io-spec run) - (-> (-> Synthesis (e.Error Top)) Test) + (-> Runner Test) (do r.Monad<Random> - [message (r.text +5)] + [message (r.text' alpha +5)] ($_ seq (test "Can log messages." (|> (run (` ("lux io log" (~ (code.text (format "LOG: " message)))))) @@ -699,7 +591,7 @@ ))) (def: (atom-spec run) - (-> (-> Synthesis (e.Error Top)) Test) + (-> Runner Test) (do r.Monad<Random> [pre r.nat post (|> r.nat (r.filter (|>> (n/= pre) not))) @@ -740,7 +632,7 @@ ))) (def: (box-spec run) - (-> (-> Synthesis (e.Error Top)) Test) + (-> Runner Test) (do r.Monad<Random> [pre r.nat post (|> r.nat (r.filter (|>> (n/= pre) not))) @@ -767,7 +659,7 @@ ))) (def: (process-spec run) - (-> (-> Synthesis (e.Error Top)) Test) + (-> Runner Test) ($_ seq (test "Can query the concurrency level of the machine." (|> (run (` ("lux process concurrency-level"))) @@ -801,17 +693,14 @@ false))) )))) -(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)) +(def: (all-specs run) + (-> Runner 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) + (bit-spec run) + (nat-spec run) + (int-spec run) + (deg-spec run) + (frac-spec run) (text-spec run) (array-spec run) (math-spec run) @@ -823,20 +712,20 @@ (context: "[JVM] Common procedures." (<| (times +100) - (all-specs expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm - run-jvm))) + (all-specs run-jvm))) (context: "[JS] Common procedures." (<| (times +100) - (all-specs expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js - run-js))) + (all-specs run-js))) (context: "[Lua] Common procedures." (<| (times +100) - (all-specs expressionT_lua.translate evalT_lua.eval runtimeT_lua.translate init-lua - run-lua))) + (all-specs run-lua))) (context: "[Ruby] Common procedures." (<| (times +100) - (all-specs expressionT_ruby.translate evalT_ruby.eval runtimeT_ruby.translate init-ruby - run-ruby))) + (all-specs run-ruby))) + +(context: "[Python] Common procedures." + (<| (times +100) + (all-specs run-python))) diff --git a/new-luxc/test/test/luxc/lang/translation/function.lux b/new-luxc/test/test/luxc/lang/translation/function.lux index c25632916..d7505bf37 100644 --- a/new-luxc/test/test/luxc/lang/translation/function.lux +++ b/new-luxc/test/test/luxc/lang/translation/function.lux @@ -15,19 +15,7 @@ [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]) - (lua [".T_lua" eval] - [".T_lua" expression] - [".T_lua" runtime]) - (ruby [".T_ruby" eval] - [".T_ruby" expression] - [".T_ruby" runtime])))) + (lang ["ls" synthesis])) (test/luxc common)) (def: arity-limit Nat +10) @@ -45,10 +33,8 @@ ((~ (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)) +(def: (function-spec run) + (-> (-> ls.Synthesis (e.Error Top)) Test) (do r.Monad<Random> [[arity arg functionS] gen-function cut-off (|> r.nat (:: @ map (n/% arity))) @@ -59,12 +45,7 @@ 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)) + (|> (run (` ("lux call" (~ functionS) (~+ argsS)))) (case> (#e.Success valueT) (n/= arg-value (:! Nat valueT)) @@ -73,61 +54,55 @@ 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)) + (let [partial-arity (n/inc cut-off) + preS (list.take partial-arity argsS) + postS (list.drop partial-arity argsS)] + (|> (run (` ("lux call" + ("lux call" (~ functionS) (~+ preS)) + (~+ postS)))) + (case> (#e.Success valueT) + (n/= arg-value (:! Nat valueT)) - (#e.Error error) - (exec (log! error) - false))))) + (#e.Error error) + (exec (log! 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)) + (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))))))] + (|> (run (` ("lux call" (~ functionS) (~+ argsS)))) + (case> (#e.Success valueT) + (n/= arg-value (:! Nat valueT)) - (#e.Error error) - (exec (log! error) - false))))) + (#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))) + (function-spec run-jvm))) (context: "[JS] Function." (<| (times +100) - (function-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js))) + (function-spec run-js))) (context: "[Lua] Function." (<| (times +100) - (function-spec expressionT_lua.translate evalT_lua.eval runtimeT_lua.translate init-lua))) + (function-spec run-lua))) (context: "[Ruby] Function." (<| (times +100) - (function-spec expressionT_ruby.translate evalT_ruby.eval runtimeT_ruby.translate init-ruby))) + (function-spec run-ruby))) + +(context: "[Python] Function." + (<| (times +100) + (function-spec run-python))) diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux index 8dc48db6f..6d74d4fca 100644 --- a/new-luxc/test/test/luxc/lang/translation/primitive.lux +++ b/new-luxc/test/test/luxc/lang/translation/primitive.lux @@ -16,6 +16,10 @@ [synthesis #+ Synthesis])) (test/luxc common)) +(def: ascii + (r.Random Nat) + (|> r.nat (:: r.Functor<Random> map (|>> (n/% +256) (n/max +1))))) + (def: (spec run) (-> (-> Synthesis (e.Error Top)) Test) (do r.Monad<Random> @@ -24,7 +28,7 @@ %int% r.int %deg% r.deg %frac% r.frac - %text% (r.text +5)] + %text% (r.text' ascii +5)] (`` ($_ seq (test "Can translate unit." (|> (run (' [])) @@ -32,7 +36,8 @@ (text/= hostL.unit (:! Text valueT)) (#e.Error error) - false))) + (exec (log! error) + false)))) (~~ (do-template [<desc> <type> <synthesis> <sample> <test>] [(test (format "Can translate " <desc> ".") (|> (run (<synthesis> <sample>)) @@ -40,7 +45,8 @@ (<test> <sample> (:! <type> valueT)) (#e.Error error) - false)))] + (exec (log! error) + false))))] ["bool" Bool code.bool %bool% bool/=] ["nat" Nat code.nat %nat% n/=] @@ -65,3 +71,7 @@ (context: "[Ruby] Primitives." (<| (times +100) (spec run-ruby))) + +(context: "[Python] Primitives." + (<| (times +100) + (spec run-python))) diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux index 919e35ab2..05f3d8a84 100644 --- a/new-luxc/test/test/luxc/lang/translation/reference.lux +++ b/new-luxc/test/test/luxc/lang/translation/reference.lux @@ -12,27 +12,11 @@ (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]) - (lua [".T_lua" statement] - [".T_lua" eval] - [".T_lua" expression] - [".T_lua" case] - [".T_lua" runtime]) - (ruby [".T_ruby" statement] - [".T_ruby" eval] - [".T_ruby" expression] - [".T_ruby" case] - [".T_ruby" runtime]) - ))) + (translation (jvm [".T_jvm" statement]) + (js [".T_js" statement]) + (lua [".T_lua" statement]) + (ruby [".T_ruby" statement]) + (python [".T_python" statement])))) (test/luxc common)) (def: upper-alpha-ascii @@ -47,94 +31,56 @@ (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)) +(def: (definitions-spec define) + (-> Definer Test) (do r.Monad<Random> - [module-name ident-part - def-name ident-part + [def-name (r.seq ident-part 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)) + (test "Can refer to definitions." + (|> (define def-name (code.int def-value)) + (case> (#e.Success valueT) + (i/= def-value (:! Int valueT)) - (#e.Error error) - false))) - ))) + (#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)) +(def: (variables-spec run) + (-> Runner 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)) + (test "Can refer to local variables/registers." + (|> (run (` ("lux let" (~ (code.nat register)) (~ (code.int value)) + ((~ (code.int (nat-to-int register))))))) + (case> (#e.Success outputT) + (i/= value (:! Int outputT)) - (#e.Error error) - false))) - ))) + (#e.Error error) + (exec (log! error) + false)))))) -(def: (references-spec translate-expression eval translate-runtime init - translate-def translate-let) - (All [a] - (-> (-> ls.Synthesis (Meta a)) (-> a (Meta Top)) (Meta Top) (IO Compiler) - (-> Text Type a Code (Meta Unit)) - (-> (-> ls.Synthesis (Meta a)) Nat ls.Synthesis ls.Synthesis (Meta a)) - Test)) - (seq (definitions-spec translate-expression eval translate-runtime init - translate-def) - (variables-spec translate-expression eval translate-runtime init - translate-let))) +(def: (references-spec run define) + (-> Runner Definer Test) + (seq (definitions-spec define) + (variables-spec run))) (context: "[JVM] References." (<| (times +100) - (references-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm - statementT_jvm.translate-def - caseT_jvm.translate-let))) + (references-spec run-jvm def-jvm))) (context: "[JS] References." (<| (times +100) - (references-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js - statementT_js.translate-def - caseT_js.translate-let))) + (references-spec run-js def-js))) (context: "[Lua] References." (<| (times +100) - (references-spec expressionT_lua.translate evalT_lua.eval runtimeT_lua.translate init-lua - statementT_lua.translate-def - caseT_lua.translate-let))) + (references-spec run-lua def-lua))) (context: "[Ruby] References." (<| (times +100) - (references-spec expressionT_ruby.translate evalT_ruby.eval runtimeT_ruby.translate init-ruby - statementT_ruby.translate-def - caseT_ruby.translate-let))) + (references-spec run-ruby def-ruby))) + +(context: "[Python] References." + (<| (times +100) + (references-spec run-python def-python))) diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux index cf2b8a729..bd2cdcbb4 100644 --- a/new-luxc/test/test/luxc/lang/translation/structure.lux +++ b/new-luxc/test/test/luxc/lang/translation/structure.lux @@ -127,3 +127,7 @@ (context: "[Ruby] Structures." (<| (times +100) (structure-spec run-ruby))) + +(context: "[Python] Structures." + (<| (times +100) + (structure-spec run-python))) |