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