diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/test/test/luxc/generator/case.lux | 16 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/generator/function.lux | 15 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/generator/primitive.lux | 8 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/generator/procedure/common.jvm.lux | 174 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/generator/structure.lux | 9 |
5 files changed, 133 insertions, 89 deletions
diff --git a/new-luxc/test/test/luxc/generator/case.lux b/new-luxc/test/test/luxc/generator/case.lux index 9e6dbf928..9fec0d501 100644 --- a/new-luxc/test/test/luxc/generator/case.lux +++ b/new-luxc/test/test/luxc/generator/case.lux @@ -79,10 +79,11 @@ ($_ seq (test "Can generate pattern-matching." (|> (do Monad<Lux> - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate valueS - (#ls;AltP (#ls;SeqP path (#ls;ExecP (#ls;Bool true))) - (#ls;SeqP (#ls;BindP +0) (#ls;ExecP (#ls;Bool false))))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate valueS + (#ls;AltP (#ls;SeqP path (#ls;ExecP (#ls;Bool true))) + (#ls;SeqP (#ls;BindP +0) (#ls;ExecP (#ls;Bool false)))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (:! Bool valueG) @@ -91,9 +92,10 @@ false))) (test "Can bind values." (|> (do Monad<Lux> - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Nat to-bind) - (#ls;SeqP (#ls;BindP +1) (#ls;ExecP (#ls;Variable 1)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Nat to-bind) + (#ls;SeqP (#ls;BindP +1) (#ls;ExecP (#ls;Variable 1))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= to-bind (:! Nat valueG)) diff --git a/new-luxc/test/test/luxc/generator/function.lux b/new-luxc/test/test/luxc/generator/function.lux index 76ab600fe..3f938d9df 100644 --- a/new-luxc/test/test/luxc/generator/function.lux +++ b/new-luxc/test/test/luxc/generator/function.lux @@ -50,8 +50,9 @@ ($_ seq (test "Can read arguments." (|> (do Monad<Lux> - [runtime-bytecode @runtime;generate] - (@eval;eval (@expr;generate (#ls;Call argsS functionS)))) + [runtime-bytecode @runtime;generate + sampleI (@expr;generate (#ls;Call argsS functionS))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= arg-value (:! Nat valueG)) @@ -64,8 +65,9 @@ [#let [partial-arity (n.inc cut-off) preS (list;take partial-arity argsS) postS (list;drop partial-arity argsS)] - runtime-bytecode @runtime;generate] - (@eval;eval (@expr;generate (|> functionS (#ls;Call preS) (#ls;Call postS))))) + runtime-bytecode @runtime;generate + sampleI (@expr;generate (|> functionS (#ls;Call preS) (#ls;Call postS)))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= arg-value (:! Nat valueG)) @@ -85,8 +87,9 @@ functionS (<| (#ls;Function super-arity (list)) (#ls;Function sub-arity env) (#ls;Variable arg-var))] - runtime-bytecode @runtime;generate] - (@eval;eval (@expr;generate (#ls;Call argsS functionS)))) + runtime-bytecode @runtime;generate + sampleI (@expr;generate (#ls;Call argsS functionS))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= arg-value (:! Nat valueG)) diff --git a/new-luxc/test/test/luxc/generator/primitive.lux b/new-luxc/test/test/luxc/generator/primitive.lux index 15289b267..581a26bdb 100644 --- a/new-luxc/test/test/luxc/generator/primitive.lux +++ b/new-luxc/test/test/luxc/generator/primitive.lux @@ -29,7 +29,9 @@ (with-expansions [<tests> (do-template [<desc> <type> <synthesis> <sample> <test>] [(test (format "Can generate " <desc> ".") - (|> (@eval;eval (@;generate (<synthesis> <sample>))) + (|> (do macro;Monad<Lux> + [sampleI (@;generate (<synthesis> <sample>))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (<test> <sample> (:! <type> valueG)) @@ -45,7 +47,9 @@ ["text" Text #ls;Text %text% T/=])] ($_ seq (test "Can generate unit." - (|> (@eval;eval (@;generate #ls;Unit)) + (|> (do macro;Monad<Lux> + [sampleI (@;generate #ls;Unit)] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (is @runtime;unit (:! Text valueG)) diff --git a/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux index 1da4d7c62..1016d4957 100644 --- a/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux +++ b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux @@ -6,8 +6,8 @@ (data text/format [bit] ["R" result] - [bool "B/" Eq<Bool>] - [text "T/" Eq<Text>] + [bool "bool/" Eq<Bool>] + [text "text/" Eq<Text>] [number "n/" Interval<Nat> "i/" Interval<Int> "r/" Interval<Frac> "d/" Interval<Deg>] (coll ["a" array] [list])) @@ -29,9 +29,11 @@ subject r;nat] (with-expansions [<binary> (do-template [<name> <reference>] [(test <name> - (|> (@eval;eval (@;generate (#ls;Procedure <name> - (list (#ls;Nat subject) - (#ls;Nat param))))) + (|> (do macro;Monad<Lux> + [sampleI (@;generate (#ls;Procedure <name> + (list (#ls;Nat subject) + (#ls;Nat param))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= (<reference> param subject) (:! Nat valueG)) @@ -47,7 +49,9 @@ )] ($_ seq (test "bit count" - (|> (@eval;eval (@;generate (#ls;Procedure "bit count" (list (#ls;Nat subject))))) + (|> (do macro;Monad<Lux> + [sampleI (@;generate (#ls;Procedure "bit count" (list (#ls;Nat subject))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= (bit;count subject) (:! Nat valueG)) @@ -57,9 +61,11 @@ <binary> (test "bit shift-right" - (|> (@eval;eval (@;generate (#ls;Procedure "bit shift-right" - (list (#ls;Int (nat-to-int subject)) - (#ls;Nat param))))) + (|> (do macro;Monad<Lux> + [sampleI (@;generate (#ls;Procedure "bit shift-right" + (list (#ls;Int (nat-to-int subject)) + (#ls;Nat param))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (i.= (bit;signed-shift-right param (nat-to-int subject)) @@ -74,7 +80,9 @@ subject r;nat] (with-expansions [<nullary> (do-template [<name> <reference>] [(test <name> - (|> (@eval;eval (@;generate (#ls;Procedure <name> (list)))) + (|> (do macro;Monad<Lux> + [sampleI (@;generate (#ls;Procedure <name> (list)))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (n.= <reference> (:! Nat valueG)) @@ -87,7 +95,9 @@ ) <unary> (do-template [<name> <type> <prepare> <comp>] [(test <name> - (|> (@eval;eval (@;generate (#ls;Procedure <name> (list (#ls;Nat subject))))) + (|> (do macro;Monad<Lux> + [sampleI (@;generate (#ls;Procedure <name> (list (#ls;Nat subject))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (<comp> (<prepare> subject) (:! <type> valueG)) @@ -96,15 +106,16 @@ false)))] ["nat to-int" Int nat-to-int i.=] - ["nat to-char" Text text;from-code T/=] + ["nat to-char" Text text;from-code text/=] ) <binary> (do-template [<name> <reference> <outputT> <comp>] [(test <name> (|> (do Monad<Lux> - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure <name> - (list (#ls;Nat subject) - (#ls;Nat param)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure <name> + (list (#ls;Nat subject) + (#ls;Nat param))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (<comp> (<reference> param subject) (:! <outputT> valueG)) @@ -117,8 +128,8 @@ ["nat *" n.* Nat n.=] ["nat /" n./ Nat n.=] ["nat %" n.% Nat n.=] - ["nat =" n.= Bool B/=] - ["nat <" n.< Bool B/=] + ["nat =" n.= Bool bool/=] + ["nat <" n.< Bool bool/=] )] ($_ seq <nullary> @@ -131,7 +142,9 @@ subject r;int] (with-expansions [<nullary> (do-template [<name> <reference>] [(test <name> - (|> (@eval;eval (@;generate (#ls;Procedure <name> (list)))) + (|> (do macro;Monad<Lux> + [sampleI (@;generate (#ls;Procedure <name> (list)))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (i.= <reference> (:! Int valueG)) @@ -144,7 +157,9 @@ ) <unary> (do-template [<name> <type> <prepare> <comp>] [(test <name> - (|> (@eval;eval (@;generate (#ls;Procedure <name> (list (#ls;Int subject))))) + (|> (do macro;Monad<Lux> + [sampleI (@;generate (#ls;Procedure <name> (list (#ls;Int subject))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (<comp> (<prepare> subject) (:! <type> valueG)) @@ -158,10 +173,11 @@ <binary> (do-template [<name> <reference> <outputT> <comp>] [(test <name> (|> (do Monad<Lux> - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure <name> - (list (#ls;Int subject) - (#ls;Int param)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure <name> + (list (#ls;Int subject) + (#ls;Int param))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (<comp> (<reference> param subject) (:! <outputT> valueG)) @@ -174,8 +190,8 @@ ["int *" i.* Int i.=] ["int /" i./ Int i.=] ["int %" i.% Int i.=] - ["int =" i.= Bool B/=] - ["int <" i.< Bool B/=] + ["int =" i.= Bool bool/=] + ["int <" i.< Bool bool/=] )] ($_ seq <nullary> @@ -183,12 +199,44 @@ <binary> ))) -(context: "Frac procedures" +(context: "Frac procedures [Part 1]" + [param (|> r;frac (r;filter (|>. (f.= 0.0) not))) + subject r;frac] + (with-expansions [<binary> (do-template [<name> <reference> <outputT> <comp>] + [(test <name> + (|> (do Monad<Lux> + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure <name> + (list (#ls;Frac subject) + (#ls;Frac param))))] + (@eval;eval sampleI)) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<comp> (<reference> param subject) (:! <outputT> valueG)) + + _ + false)))] + + ["frac +" f.+ Frac f.=] + ["frac -" f.- Frac f.=] + ["frac *" f.* Frac f.=] + ["frac /" f./ Frac f.=] + ["frac %" f.% Frac f.=] + ["frac =" f.= Bool bool/=] + ["frac <" f.< Bool bool/=] + )] + ($_ seq + <binary> + ))) + +(context: "Frac procedures [Part 2]" [param (|> r;frac (r;filter (|>. (f.= 0.0) not))) subject r;frac] (with-expansions [<nullary> (do-template [<name> <test>] [(test <name> - (|> (@eval;eval (@;generate (#ls;Procedure <name> (list)))) + (|> (do macro;Monad<Lux> + [sampleI (@;generate (#ls;Procedure <name> (list)))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (<test> (:! Frac valueG)) @@ -206,8 +254,9 @@ <unary> (do-template [<name> <type> <prepare> <comp>] [(test <name> (|> (do Monad<Lux> - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure <name> (list (#ls;Frac subject)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure <name> (list (#ls;Frac subject))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (<comp> (<prepare> subject) (:! <type> valueG)) @@ -217,39 +266,17 @@ ["frac to-int" Int frac-to-int i.=] ["frac to-deg" Deg frac-to-deg d.=] - ) - <binary> (do-template [<name> <reference> <outputT> <comp>] - [(test <name> - (|> (do Monad<Lux> - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure <name> - (list (#ls;Frac subject) - (#ls;Frac param)))))) - (macro;run (init-compiler [])) - (case> (#R;Success valueG) - (<comp> (<reference> param subject) (:! <outputT> valueG)) - - _ - false)))] - - ["frac +" f.+ Frac f.=] - ["frac -" f.- Frac f.=] - ["frac *" f.* Frac f.=] - ["frac /" f./ Frac f.=] - ["frac %" f.% Frac f.=] - ["frac =" f.= Bool B/=] - ["frac <" f.< Bool B/=] - )] + )] ($_ seq <nullary> <unary> - <binary> (test "frac encode|decode" (|> (do Monad<Lux> - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (|> (#ls;Frac subject) - (list) (#ls;Procedure "frac encode") - (list) (#ls;Procedure "frac decode"))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (|> (#ls;Frac subject) + (list) (#ls;Procedure "frac encode") + (list) (#ls;Procedure "frac decode")))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (^multi (#R;Success valueG) [(:! (Maybe Frac) valueG) (#;Some value)]) @@ -265,7 +292,9 @@ subject r;deg] (with-expansions [<nullary> (do-template [<name> <reference>] [(test <name> - (|> (@eval;eval (@;generate (#ls;Procedure <name> (list)))) + (|> (do macro;Monad<Lux> + [sampleI (@;generate (#ls;Procedure <name> (list)))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (d.= <reference> (:! Deg valueG)) @@ -279,8 +308,9 @@ <unary> (do-template [<name> <type> <prepare> <comp>] [(test <name> (|> (do Monad<Lux> - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure <name> (list (#ls;Deg subject)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure <name> (list (#ls;Deg subject))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (<comp> (<prepare> subject) (:! <type> valueG)) @@ -293,10 +323,11 @@ <binary> (do-template [<name> <reference> <outputT> <comp>] [(test <name> (|> (do Monad<Lux> - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure <name> - (list (#ls;Deg subject) - (#ls;Deg param)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure <name> + (list (#ls;Deg subject) + (#ls;Deg param))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (<comp> (<reference> param subject) (:! <outputT> valueG)) @@ -309,16 +340,17 @@ ["deg *" d.* Deg d.=] ["deg /" d./ Deg d.=] ["deg %" d.% Deg d.=] - ["deg =" d.= Bool B/=] - ["deg <" d.< Bool B/=] + ["deg =" d.= Bool bool/=] + ["deg <" d.< Bool bool/=] ) <special> (do-template [<name> <reference> <outputT> <comp>] [(test <name> (|> (do Monad<Lux> - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Procedure <name> - (list (#ls;Deg subject) - (#ls;Nat special)))))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Procedure <name> + (list (#ls;Deg subject) + (#ls;Nat special))))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (<comp> (<reference> special subject) (:! <outputT> valueG)) diff --git a/new-luxc/test/test/luxc/generator/structure.lux b/new-luxc/test/test/luxc/generator/structure.lux index ab0c17ade..9fec0e078 100644 --- a/new-luxc/test/test/luxc/generator/structure.lux +++ b/new-luxc/test/test/luxc/generator/structure.lux @@ -63,7 +63,9 @@ [size (|> r;nat (:: @ map (|>. (n.% +10) (n.max +2)))) members (r;list size gen-primitive)] (test "Can generate tuple." - (|> (@eval;eval (@;generate (#ls;Tuple members))) + (|> (do macro;Monad<Lux> + [sampleI (@;generate (#ls;Tuple members))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (let [valueG (:! (a;Array Top) valueG)] @@ -80,8 +82,9 @@ member gen-primitive] (test "Can generate variant." (|> (do Monad<Lux> - [runtime-bytecode @runtime;generate] - (@eval;eval (@;generate (#ls;Variant tag last? member)))) + [runtime-bytecode @runtime;generate + sampleI (@;generate (#ls;Variant tag last? member))] + (@eval;eval sampleI)) (macro;run (init-compiler [])) (case> (#R;Success valueG) (let [valueG (:! (a;Array Top) valueG)] |