aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/test/test/luxc/common.lux62
-rw-r--r--new-luxc/test/test/luxc/lang/translation/case.lux78
-rw-r--r--new-luxc/test/test/luxc/lang/translation/common.lux247
-rw-r--r--new-luxc/test/test/luxc/lang/translation/function.lux103
-rw-r--r--new-luxc/test/test/luxc/lang/translation/primitive.lux16
-rw-r--r--new-luxc/test/test/luxc/lang/translation/reference.lux126
-rw-r--r--new-luxc/test/test/luxc/lang/translation/structure.lux4
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)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-14 03:52:15 +0000