diff options
Diffstat (limited to 'new-luxc/test/test/luxc/generator/procedure/common.jvm.lux')
-rw-r--r-- | new-luxc/test/test/luxc/generator/procedure/common.jvm.lux | 214 |
1 files changed, 212 insertions, 2 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 index 96cf8ae97..1b150561c 100644 --- a/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux +++ b/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux @@ -1,14 +1,14 @@ (;module: lux (lux [io] - (control monad + (control [monad #+ do] pipe) (data text/format [bit] ["R" result] [bool "B/" Eq<Bool>] [text "T/" Eq<Text>] - [number "n/" Interval<Nat>] + [number "n/" Interval<Nat> "i/" Interval<Int> "r/" Interval<Frac> "d/" Interval<Deg>] (coll ["a" array] [list])) ["r" math/random "r/" Monad<Random>] @@ -125,3 +125,213 @@ <unary> <binary> ))) + +(context: "Int procedures" + [param (|> r;int (r;filter (|>. (i.= 0) not))) + subject r;int] + (with-expansions [<nullary> (do-template [<name> <reference>] + [(test <name> + (|> (@eval;eval (@;generate (#ls;Procedure <name> (list)))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (i.= <reference> (:! Int valueG)) + + _ + false)))] + + ["int min" i/bottom] + ["int max" i/top] + ) + <unary> (do-template [<name> <type> <prepare> <comp>] + [(test <name> + (|> (@eval;eval (@;generate (#ls;Procedure <name> (list (#ls;Int subject))))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<comp> (<prepare> subject) (:! <type> valueG)) + + _ + false)))] + + ["int to-nat" Nat int-to-nat n.=] + ["int to-frac" Frac int-to-frac f.=] + ) + <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)))))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<comp> (<reference> param subject) (:! <outputT> valueG)) + + _ + false)))] + + ["int +" i.+ Int i.=] + ["int -" i.- Int i.=] + ["int *" i.* Int i.=] + ["int /" i./ Int i.=] + ["int %" i.% Int i.=] + ["int =" i.= Bool B/=] + ["int <" i.< Bool B/=] + )] + ($_ seq + <nullary> + <unary> + <binary> + ))) + +(context: "Frac procedures" + [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)))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<test> (:! Frac valueG)) + + _ + false)))] + + ["frac min" (f.= r/bottom)] + ["frac max" (f.= r/top)] + ["frac not-a-number" number;not-a-number?] + ["frac positive-infinity" (f.= number;positive-infinity)] + ["frac negative-infinity" (f.= number;negative-infinity)] + ["frac smallest" (f.= (_lux_proc [ "frac" "smallest-value"] []))] + ) + <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)))))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<comp> (<prepare> subject) (:! <type> valueG)) + + _ + false)))] + + ["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"))))) + (macro;run (init-compiler [])) + (case> (^multi (#R;Success valueG) + [(:! (Maybe Frac) valueG) (#;Some value)]) + (f.= subject value) + + _ + false))) + ))) + +(context: "Deg procedures" + [param (|> r;deg (r;filter (|>. (d.= .0) not))) + special r;nat + subject r;deg] + (with-expansions [<nullary> (do-template [<name> <reference>] + [(test <name> + (|> (@eval;eval (@;generate (#ls;Procedure <name> (list)))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (d.= <reference> (:! Deg valueG)) + + _ + false)))] + + ["deg min" d/bottom] + ["deg max" d/top] + ) + <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)))))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<comp> (<prepare> subject) (:! <type> valueG)) + + _ + false)))] + + ["deg to-frac" Frac deg-to-frac f.=] + ) + <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)))))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<comp> (<reference> param subject) (:! <outputT> valueG)) + + _ + false)))] + + ["deg +" d.+ Deg d.=] + ["deg -" d.- Deg d.=] + ["deg *" d.* Deg d.=] + ["deg /" d./ Deg d.=] + ["deg %" d.% Deg d.=] + ["deg =" d.= Bool B/=] + ["deg <" d.< Bool B/=] + ) + <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)))))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (<comp> (<reference> special subject) (:! <outputT> valueG)) + + _ + false)))] + + ["deg scale" d.scale Deg d.=] + ["deg reciprocal" d.reciprocal Deg d.=] + )] + ($_ seq + <nullary> + <unary> + <binary> + <special> + ))) |