aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/test/test/luxc/lang/translation/js/procedure/common.jvm.lux405
-rw-r--r--new-luxc/test/test/luxc/lang/translation/jvm/procedure/common.jvm.lux4
2 files changed, 407 insertions, 2 deletions
diff --git a/new-luxc/test/test/luxc/lang/translation/js/procedure/common.jvm.lux b/new-luxc/test/test/luxc/lang/translation/js/procedure/common.jvm.lux
new file mode 100644
index 000000000..1c52d9e7b
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/translation/js/procedure/common.jvm.lux
@@ -0,0 +1,405 @@
+(.module:
+ lux
+ (lux [io]
+ (control [monad #+ do]
+ pipe)
+ (data text/format
+ [bit]
+ ["e" error]
+ [bool "bool/" Eq<Bool>]
+ [text "text/" Eq<Text>]
+ [number "nat/" Interval<Nat> "int/" Number<Int> Interval<Int> "frac/" Number<Frac> Interval<Frac> "deg/" Interval<Deg>]
+ (coll ["a" array]
+ [list]))
+ ["r" math/random]
+ [macro]
+ (macro [code])
+ [host]
+ test)
+ (luxc [lang]
+ (lang ["ls" synthesis]
+ (translation (js [".T" expression]
+ [".T" eval]
+ [".T" runtime]))))
+ (test/luxc common))
+
+(context: "Bit procedures"
+ (<| (times +100)
+ (do @
+ [param r.nat
+ subject r.nat]
+ (with-expansions [<binary> (do-template [<name> <reference> <param-expr>]
+ [(test <name>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<name> (~ (code.nat subject))
+ (~ (code.nat param)))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (n/= (<reference> param subject) (:! Nat valueT))
+
+ (#e.Error error)
+ false)
+ (let [param <param-expr>])))]
+
+ ["lux bit and" bit.and param]
+ ["lux bit or" bit.or param]
+ ["lux bit xor" bit.xor param]
+ ["lux bit shift-left" bit.shift-left (n/% +64 param)]
+ ["lux bit unsigned-shift-right" bit.shift-right (n/% +64 param)]
+ )]
+ ($_ seq
+ (test "lux bit count"
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` ("lux bit count" (~ (code.nat subject)))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (n/= (bit.count subject) (:! Nat valueT))
+
+ (#e.Error error)
+ false)))
+
+ <binary>
+ (test "lux bit shift-right"
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` ("lux bit shift-right"
+ (~ (code.int (nat-to-int subject)))
+ (~ (code.nat param)))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (i/= (bit.signed-shift-right param (nat-to-int subject))
+ (:! Int valueT))
+
+ (#e.Error error)
+ false)
+ (let [param (n/% +64 param)])))
+ )))))
+
+(context: "Nat procedures"
+ (<| (times +100)
+ (do @
+ [param (|> r.nat (r.filter (|>> (n/= +0) not)))
+ subject r.nat]
+ (`` ($_ seq
+ (~~ (do-template [<name> <reference>]
+ [(test <name>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<name>)))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (n/= <reference> (:! Nat valueT))
+
+ (#e.Error error)
+ false)))]
+
+ ["lux nat min" nat/bottom]
+ ["lux nat max" nat/top]
+ ))
+ (~~ (do-template [<name> <type> <prepare> <comp> <subject-expr>]
+ [(test <name>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<name> (~ (code.nat subject)))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (<comp> (<prepare> subject) (:! <type> valueT))
+
+ (#e.Error error)
+ false)
+ (let [subject <subject-expr>])))]
+
+ ["lux nat to-int" Int nat-to-int i/= subject]
+ ["lux nat char" Text text.from-code text/= (n/% (bit.shift-left +32 +1) subject)]
+ ))
+ (~~ (do-template [<name> <reference> <outputT> <comp>]
+ [(test <name>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<name> (~ (code.nat subject)) (~ (code.nat param)))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (<comp> (<reference> param subject) (:! <outputT> valueT))
+
+ _
+ false)))]
+
+ ["lux nat +" n/+ Nat n/=]
+ ["lux nat -" n/- Nat n/=]
+ ["lux nat *" n/* Nat n/=]
+ ["lux nat /" n// Nat n/=]
+ ["lux nat %" n/% Nat n/=]
+ ["lux nat =" n/= Bool bool/=]
+ ["lux nat <" n/< Bool bool/=]
+ ))
+ )))))
+
+(context: "Int procedures"
+ (<| (times +100)
+ (do @
+ [param (|> r.int (r.filter (|>> (i/= 0) not)))
+ subject r.int]
+ (with-expansions [<nullary> (do-template [<name> <reference>]
+ [(test <name>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<name>)))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (i/= <reference> (:! Int valueT))
+
+ (#e.Error error)
+ false)))]
+
+ ["lux int min" int/bottom]
+ ["lux int max" int/top]
+ )
+ <unary> (do-template [<name> <type> <prepare> <comp>]
+ [(test <name>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<name> (~ (code.int subject)))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (<comp> (<prepare> subject) (:! <type> valueT))
+
+ (#e.Error error)
+ false)))]
+
+ ["lux int to-nat" Nat int-to-nat n/=]
+ ["lux int to-frac" Frac int-to-frac f/=]
+ )
+ <binary> (do-template [<name> <reference> <outputT> <comp>]
+ [(test <name>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<name> (~ (code.int subject)) (~ (code.int param)))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (<comp> (<reference> param subject) (:! <outputT> valueT))
+
+ _
+ false)))]
+
+ ["lux int +" i/+ Int i/=]
+ ["lux int -" i/- Int i/=]
+ ["lux int *" i/* Int i/=]
+ ["lux int /" i// Int i/=]
+ ["lux int %" i/% Int i/=]
+ ["lux int =" i/= Bool bool/=]
+ ["lux int <" i/< Bool bool/=]
+ )]
+ ($_ seq
+ <nullary>
+ <unary>
+ <binary>
+ )))))
+
+(context: "Frac procedures [Part 1]"
+ (<| (times +100)
+ (do @
+ [param (|> r.frac (r.filter (|>> (f/= 0.0) not)))
+ subject r.frac]
+ (with-expansions [<binary> (do-template [<name> <reference> <outputT> <comp>]
+ [(test <name>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<name> (~ (code.frac subject)) (~ (code.frac param)))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (<comp> (<reference> param subject) (:! <outputT> valueT))
+
+ _
+ false)))]
+
+ ["lux frac +" f/+ Frac f/=]
+ ["lux frac -" f/- Frac f/=]
+ ["lux frac *" f/* Frac f/=]
+ ["lux frac /" f// Frac f/=]
+ ["lux frac %" f/% Frac f/=]
+ ["lux frac =" f/= Bool bool/=]
+ ["lux frac <" f/< Bool bool/=]
+ )]
+ ($_ seq
+ <binary>
+ )))))
+
+(context: "Frac procedures [Part 2]"
+ (<| (times +100)
+ (do @
+ [param (|> r.frac (r.filter (|>> (f/= 0.0) not)))
+ subject r.frac]
+ (with-expansions [<nullary> (do-template [<name> <test>]
+ [(test <name>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<name>)))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (<test> (:! Frac valueT))
+
+ _
+ false)))]
+
+ ["lux frac min" (f/= frac/bottom)]
+ ["lux frac max" (f/= frac/top)]
+ ["lux frac not-a-number" number.not-a-number?]
+ ["lux frac positive-infinity" (f/= number.positive-infinity)]
+ ["lux frac negative-infinity" (f/= number.negative-infinity)]
+ ["lux frac smallest" (f/= ("lux frac smallest"))]
+ )
+ <unary> (do-template [<forward> <backward> <test>]
+ [(test <forward>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<backward> (<forward> (~ (code.frac subject))))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (|> valueT (:! Frac) (f/- subject) frac/abs <test>)
+
+ (#e.Error error)
+ false)))]
+
+ ["lux frac to-int" "lux int to-frac" (f/< 1.0)]
+ ["lux frac to-deg" "lux deg to-frac" (f/<= 0.000000001)])]
+ ($_ seq
+ <nullary>
+ <unary>
+ (test "frac encode|decode"
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` ("lux frac decode" ("lux frac encode" (~ (code.frac subject))))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (^multi (#e.Success valueT)
+ [(:! (Maybe Frac) valueT) (#.Some value)])
+ (f/= subject value)
+
+ _
+ false)))
+ )))))
+
+(def: deg-threshold
+ {#.doc "1/(2^30)"}
+ Deg
+ .000000001)
+
+(def: (above-threshold value)
+ (-> Deg Deg)
+ (if (d/< deg-threshold value)
+ (d/+ deg-threshold value)
+ value))
+
+(def: (deg-difference reference sample)
+ (-> Deg Deg Deg)
+ (if (d/> reference sample)
+ (d/- reference sample)
+ (d/- sample reference)))
+
+(context: "Deg procedures"
+ (<| (times +100)
+ (do @
+ [param (|> r.deg (:: @ map above-threshold))
+ special r.nat
+ subject (|> r.deg (:: @ map above-threshold))]
+ (`` ($_ seq
+ (~~ (do-template [<name> <reference>]
+ [(test <name>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<name>)))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (d/= <reference> (:! Deg valueT))
+
+ _
+ false)))]
+
+ ["lux deg min" deg/bottom]
+ ["lux deg max" deg/top]
+ ))
+ (~~ (do-template [<forward> <backward> <type>]
+ [(test <forward>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<backward> (<forward> (~ (code.deg subject))))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueV)
+ (d/<= deg-threshold (deg-difference subject (:! <type> valueV)))
+
+ _
+ false)))]
+
+ ["lux deg to-frac" "lux frac to-deg" Deg]
+ ))
+ (~~ (do-template [<name> <reference> <outputT> <comp>]
+ [(test <name>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<name> (~ (code.deg subject)) (~ (code.deg param)))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (<comp> (<reference> param subject) (:! <outputT> valueT))
+
+ _
+ false)))]
+
+ ["lux deg +" d/+ Deg d/=]
+ ["lux deg -" d/- Deg d/=]
+ ["lux deg *" d/* Deg d/=]
+ ["lux deg /" d// Deg d/=]
+ ["lux deg %" d/% Deg d/=]
+ ["lux deg =" d/= Bool bool/=]
+ ["lux deg <" d/< Bool bool/=]
+ ))
+ (~~ (do-template [<name> <reference> <outputT> <comp>]
+ [(test <name>
+ (|> (do macro.Monad<Meta>
+ [_ runtimeT.translate
+ sampleJS (expressionT.translate (` (<name> (~ (code.deg subject)) (~ (code.nat special)))))]
+ (evalT.eval sampleJS))
+ (lang.with-current-module "")
+ (macro.run (init-js []))
+ (case> (#e.Success valueT)
+ (<comp> (<reference> special subject) (:! <outputT> valueT))
+
+ _
+ false)))]
+
+ ["lux deg scale" d/scale Deg d/=]
+ ["lux deg reciprocal" d/reciprocal Deg d/=]
+ ))
+ )))))
diff --git a/new-luxc/test/test/luxc/lang/translation/jvm/procedure/common.jvm.lux b/new-luxc/test/test/luxc/lang/translation/jvm/procedure/common.jvm.lux
index 8e4fd362f..d81058e17 100644
--- a/new-luxc/test/test/luxc/lang/translation/jvm/procedure/common.jvm.lux
+++ b/new-luxc/test/test/luxc/lang/translation/jvm/procedure/common.jvm.lux
@@ -50,7 +50,7 @@
["lux bit unsigned-shift-right" bit.shift-right]
)]
($_ seq
- (test "bit count"
+ (test "lux bit count"
(|> (do macro.Monad<Meta>
[sampleI (expressionT.translate (` ("lux bit count" (~ (code.nat subject)))))]
(@eval.eval sampleI))
@@ -63,7 +63,7 @@
false)))
<binary>
- (test "bit shift-right"
+ (test "lux bit shift-right"
(|> (do macro.Monad<Meta>
[sampleI (expressionT.translate (` ("lux bit shift-right"
(~ (code.int (nat-to-int subject)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 14:09:48 +0000