diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/test/test/luxc/generator/procedure/common.jvm.lux | 127 | ||||
| -rw-r--r-- | new-luxc/test/tests.lux | 7 |
2 files changed, 133 insertions, 1 deletions
diff --git a/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux new file mode 100644 index 000000000..96cf8ae97 --- /dev/null +++ b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux @@ -0,0 +1,127 @@ +(;module: + lux + (lux [io] + (control monad + pipe) + (data text/format + [bit] + ["R" result] + [bool "B/" Eq<Bool>] + [text "T/" Eq<Text>] + [number "n/" Interval<Nat>] + (coll ["a" array] + [list])) + ["r" math/random "r/" Monad<Random>] + [macro #+ Monad<Lux>] + [host #+ jvm-import] + test) + (luxc (lang ["ls" synthesis]) + [analyser] + [synthesizer] + (generator ["@" expr] + ["@;" eval] + ["@;" runtime] + ["@;" common])) + (test/luxc common)) + +(context: "Bit procedures" + [param r;nat + 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))))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (n.= (<reference> param subject) (:! Nat valueG)) + + _ + false)))] + + ["bit and" bit;and] + ["bit or" bit;or] + ["bit xor" bit;xor] + ["bit shift-left" bit;shift-left] + ["bit unsigned-shift-right" bit;unsigned-shift-right] + )] + ($_ seq + (test "bit count" + (|> (@eval;eval (@;generate (#ls;Procedure "bit count" (list (#ls;Nat subject))))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (n.= (bit;count subject) (:! Nat valueG)) + + _ + false))) + + <binary> + (test "bit shift-right" + (|> (@eval;eval (@;generate (#ls;Procedure "bit shift-right" + (list (#ls;Int (nat-to-int subject)) + (#ls;Nat param))))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (i.= (bit;shift-right param (nat-to-int subject)) + (:! Int valueG)) + + _ + false))) + ))) + +(context: "Nat procedures" + [param (|> r;nat (r;filter (|>. (n.= +0) not))) + subject r;nat] + (with-expansions [<nullary> (do-template [<name> <reference>] + [(test <name> + (|> (@eval;eval (@;generate (#ls;Procedure <name> (list)))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (n.= <reference> (:! Nat valueG)) + + _ + false)))] + + ["nat min" n/bottom] + ["nat max" n/top] + ) + <unary> (do-template [<name> <type> <prepare> <comp>] + [(test <name> + (|> (@eval;eval (@;generate (#ls;Procedure <name> (list (#ls;Nat subject))))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<comp> (<prepare> subject) (:! <type> valueG)) + + _ + false)))] + + ["nat to-int" Int nat-to-int i.=] + ["nat to-char" Text text;from-code T/=] + ) + <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)))))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<comp> (<reference> param subject) (:! <outputT> valueG)) + + _ + false)))] + + ["nat +" n.+ Nat n.=] + ["nat -" n.- Nat n.=] + ["nat *" n.* Nat n.=] + ["nat /" n./ Nat n.=] + ["nat %" n.% Nat n.=] + ["nat =" n.= Bool B/=] + ["nat <" n.< Bool B/=] + )] + ($_ seq + <nullary> + <unary> + <binary> + ))) diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux index 92644ff48..695c72174 100644 --- a/new-luxc/test/tests.lux +++ b/new-luxc/test/tests.lux @@ -20,7 +20,12 @@ ["_;S" procedure] ["_;S" loop]) (generator ["_;G" primitive] - ["_;G" structure])))) + ["_;G" structure] + (procedure ["_;G" common])) + )) + ## (luxc (generator ["_;G" function]) + ## ) + ) ## [Program] (program: args |