aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/test/test/luxc/generator/procedure/common.jvm.lux127
-rw-r--r--new-luxc/test/tests.lux7
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