aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test/test/luxc/generator/procedure/common.jvm.lux
diff options
context:
space:
mode:
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.lux214
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>
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-22 13:09:20 +0000