aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test
diff options
context:
space:
mode:
Diffstat (limited to 'new-luxc/test')
-rw-r--r--new-luxc/test/test/luxc/common.lux25
-rw-r--r--new-luxc/test/test/luxc/lang/translation/case.lux8
-rw-r--r--new-luxc/test/test/luxc/lang/translation/common.lux213
-rw-r--r--new-luxc/test/test/luxc/lang/translation/function.lux8
-rw-r--r--new-luxc/test/test/luxc/lang/translation/primitive.lux14
-rw-r--r--new-luxc/test/test/luxc/lang/translation/reference.lux11
-rw-r--r--new-luxc/test/test/luxc/lang/translation/structure.lux89
7 files changed, 104 insertions, 264 deletions
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux
index 35ec86c1b..7a6cabe73 100644
--- a/new-luxc/test/test/luxc/common.lux
+++ b/new-luxc/test/test/luxc/common.lux
@@ -39,11 +39,16 @@
## [".T_r" eval]
## [".T_r" runtime]
## [".T_r" statement])
- [scheme]
- (scheme [".T_scheme" expression]
- [".T_scheme" eval]
- [".T_scheme" runtime]
- [".T_scheme" statement])
+ ## [scheme]
+ ## (scheme [".T_scheme" expression]
+ ## [".T_scheme" eval]
+ ## [".T_scheme" runtime]
+ ## [".T_scheme" statement])
+ [common-lisp]
+ (common-lisp [".T_common-lisp" expression]
+ [".T_common-lisp" eval]
+ [".T_common-lisp" runtime]
+ [".T_common-lisp" statement])
))))
(type: #export Runner (-> Synthesis (e.Error Top)))
@@ -62,7 +67,8 @@
## [init-ruby ruby.init]
## [init-python python.init]
## [init-r r.init]
- [init-scheme scheme.init]
+ ## [init-scheme scheme.init]
+ [init-common-lisp common-lisp.init]
)
(def: (runner translate-runtime translate-expression eval init)
@@ -109,5 +115,8 @@
## (def: #export run-r (runner runtimeT_r.translate expressionT_r.translate evalT_r.eval init-r))
## (def: #export def-r (definer runtimeT_r.translate expressionT_r.translate evalT_r.eval init-r statementT_r.translate-def))
-(def: #export run-scheme (runner runtimeT_scheme.translate expressionT_scheme.translate evalT_scheme.eval init-scheme))
-(def: #export def-scheme (definer runtimeT_scheme.translate expressionT_scheme.translate evalT_scheme.eval init-scheme statementT_scheme.translate-def))
+## (def: #export run-scheme (runner runtimeT_scheme.translate expressionT_scheme.translate evalT_scheme.eval init-scheme))
+## (def: #export def-scheme (definer runtimeT_scheme.translate expressionT_scheme.translate evalT_scheme.eval init-scheme statementT_scheme.translate-def))
+
+(def: #export run-common-lisp (runner runtimeT_common-lisp.translate expressionT_common-lisp.translate evalT_common-lisp.eval init-common-lisp))
+(def: #export def-common-lisp (definer runtimeT_common-lisp.translate expressionT_common-lisp.translate evalT_common-lisp.eval init-common-lisp statementT_common-lisp.translate-def))
diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux
index 75736d223..bca451332 100644
--- a/new-luxc/test/test/luxc/lang/translation/case.lux
+++ b/new-luxc/test/test/luxc/lang/translation/case.lux
@@ -120,6 +120,10 @@
## (<| (times +100)
## (pattern-matching-spec run-r)))
-(context: "[Scheme] Function."
+## (context: "[Scheme] Pattern-matching."
+## (<| (times +100)
+## (pattern-matching-spec run-scheme)))
+
+(context: "[Common Lisp] Pattern-matching."
(<| (times +100)
- (pattern-matching-spec run-scheme)))
+ (pattern-matching-spec run-common-lisp)))
diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux
index 8734336aa..ad10fb8bd 100644
--- a/new-luxc/test/test/luxc/lang/translation/common.lux
+++ b/new-luxc/test/test/luxc/lang/translation/common.lux
@@ -44,15 +44,6 @@
["lux bit unsigned-shift-right" bit.shift-right (n/% +64 param)]
)]
($_ seq
- (test "lux bit count"
- (|> (run (` ("lux bit count" (~ (code.nat subject)))))
- (case> (#e.Success valueT)
- (n/= (bit.count subject) (:! Nat valueT))
-
- (#e.Error error)
- (exec (log! error)
- false))))
-
<binary>
(test "lux bit shift-right"
(|> (run (` ("lux bit shift-right"
@@ -68,59 +59,6 @@
(let [param (n/% +64 param)])))
))))
-(def: (nat-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [param (|> r.nat (r.filter (|>> (n/= +0) not)))
- subject r.nat]
- (`` ($_ seq
- (~~ (do-template [<name> <reference>]
- [(test <name>
- (|> (run (` (<name>)))
- (case> (#e.Success valueT)
- (n/= <reference> (:! Nat valueT))
-
- (#e.Error error)
- (exec (log! error)
- false))))]
-
- ["lux nat min" nat/bottom]
- ["lux nat max" nat/top]
- ))
- (~~ (do-template [<name> <type> <prepare> <comp> <subject-expr>]
- [(test <name>
- (|> (run (` (<name> (~ (code.nat subject)))))
- (case> (#e.Success valueT)
- (<comp> (<prepare> subject) (:! <type> valueT))
-
- (#e.Error error)
- (exec (log! 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 +8 +1) subject)]
- ))
- (~~ (do-template [<name> <reference> <outputT> <comp>]
- [(test <name>
- (|> (run (` (<name> (~ (code.nat subject)) (~ (code.nat param)))))
- (case> (#e.Success valueT)
- (<comp> (<reference> param subject) (:! <outputT> valueT))
-
- (#e.Error error)
- (exec (log! error)
- 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/=]
- ))
- ))))
-
(def: (int-spec run)
(-> Runner Test)
(do r.Monad<Random>
@@ -142,7 +80,7 @@
["lux int min" int/bottom]
["lux int max" int/top]
))
- (~~ (do-template [<name> <type> <prepare> <comp>]
+ (~~ (do-template [<name> <type> <prepare> <comp> <subject-expr>]
[(test <name>
(|> (run (` (<name> (~ (code.int subject)))))
(case> (#e.Success valueT)
@@ -150,10 +88,14 @@
(#e.Error error)
(exec (log! error)
- false))))]
+ false))
+ (let [subject <subject-expr>])))]
- ["lux int to-nat" Nat int-to-nat n/=]
- ["lux int to-frac" Frac int-to-frac f/=]
+ ["lux int to-frac" Frac int-to-frac f/= subject]
+ ["lux int char" Text (|>> (:! Nat) text.from-code) text/= (|> subject
+ (:! Nat)
+ (n/% (bit.shift-left +8 +1))
+ (:! Int))]
))
(~~ (do-template [<name> <reference> <outputT> <comp>]
[(test <name>
@@ -233,16 +175,7 @@
(exec (log! error)
false))))]
- ["lux frac to-int" "lux int to-frac" (f/< 1.0)]
- ["lux frac to-deg" "lux deg to-frac" (f/<= 0.000000001)]))
- (test "frac encode|decode"
- (|> (run (` ("lux frac decode" ("lux frac encode" (~ (code.frac subject))))))
- (case> (^multi (#e.Success valueT)
- [(:! (Maybe Frac) valueT) (#.Some value)])
- (f/= subject value)
-
- _
- false)))
+ ["lux frac to-int" "lux int to-frac" (f/< 1.0)]))
))))
(def: (frac-spec run)
@@ -251,85 +184,6 @@
(frac-spec|0 run)
(frac-spec|1 run)))
-(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)))
-
-(def: (deg-spec run)
- (-> Runner Test)
- (do r.Monad<Random>
- [param (|> r.deg (:: @ map above-threshold))
- special r.nat
- subject (|> r.deg (:: @ map above-threshold))]
- (`` ($_ seq
- (~~ (do-template [<name> <reference>]
- [(test <name>
- (|> (run (` (<name>)))
- (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>
- (|> (run (` (<backward> (<forward> (~ (code.deg subject))))))
- (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>
- (|> (run (` (<name> (~ (code.deg subject)) (~ (code.deg param)))))
- (case> (#e.Success valueT)
- (<comp> (<reference> param subject) (:! <outputT> valueT))
-
- (#e.Error error)
- (exec (log! error)
- 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>
- (|> (run (` (<name> (~ (code.deg subject)) (~ (code.nat special)))))
- (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/=]
- ))
- ))))
-
(def: lower-alpha
(r.Random Nat)
(|> r.nat (:: r.Functor<Random> map (|>> (n/% +26) (n/+ +97)))))
@@ -424,7 +278,9 @@
_
false))))
(test "Text hashing is consistent."
- (|> (run (` ("lux nat =" ("lux text hash" (~ sample0S)) ("lux text hash" (~ sample0S)))))
+ (|> (run (` ("lux int ="
+ ("lux text hash" (~ sample0S))
+ ("lux text hash" (~ sample0S)))))
(case> (#e.Success valueV)
(:! Bool valueV)
@@ -696,37 +552,24 @@
(do r.Monad<Random>
[delay (|> r.nat (:: @ map (n/% +10)))
message (r.text +5)]
- ($_ seq
- (test "Can execute I/O operations in parallel."
- (|> (run (` ("lux process future"
- ("lux function" +1 []
- ("lux io log" (~ (code.text (format "EXECUTE: " message))))))))
- (case> (#e.Success valueV)
- true
-
- (#e.Error error)
- (exec (log! error)
- false))))
- (test "Can schedule I/O operations for future execution."
- (|> (run (` ("lux process schedule"
- (~ (code.nat delay))
- ("lux function" +1 []
- ("lux io log" (~ (code.text (format "SCHEDULE: " message))))))))
- (case> (#e.Success valueV)
- true
-
- (#e.Error error)
- (exec (log! error)
- false))))
- ))))
+ (test "Can schedule I/O operations for future execution."
+ (|> (run (` ("lux process schedule"
+ (~ (code.nat delay))
+ ("lux function" +1 []
+ ("lux io log" (~ (code.text (format "SCHEDULE: " message))))))))
+ (case> (#e.Success valueV)
+ true
+
+ (#e.Error error)
+ (exec (log! error)
+ false)))))
+ ))
(def: (all-specs run)
(-> Runner Test)
($_ seq
(bit-spec run)
- (nat-spec run)
(int-spec run)
- (deg-spec run)
(frac-spec run)
(text-spec run)
(array-spec run)
@@ -761,6 +604,10 @@
## (<| (times +100)
## (all-specs run-r)))
-(context: "[Scheme] Common procedures."
+## (context: "[Scheme] Common procedures."
+## (<| (times +100)
+## (all-specs run-scheme)))
+
+(context: "[Common Lisp] Common procedures."
(<| (times +100)
- (all-specs run-scheme)))
+ (all-specs run-common-lisp)))
diff --git a/new-luxc/test/test/luxc/lang/translation/function.lux b/new-luxc/test/test/luxc/lang/translation/function.lux
index 0a3d8ca62..e8f99e09e 100644
--- a/new-luxc/test/test/luxc/lang/translation/function.lux
+++ b/new-luxc/test/test/luxc/lang/translation/function.lux
@@ -111,6 +111,10 @@
## (<| (times +100)
## (function-spec run-r)))
-(context: "[Scheme] Function."
+## (context: "[Scheme] Function."
+## (<| (times +100)
+## (function-spec run-scheme)))
+
+(context: "[Common Lisp] Function."
(<| (times +100)
- (function-spec run-scheme)))
+ (function-spec run-common-lisp)))
diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux
index d36a02eb7..d832a6ccf 100644
--- a/new-luxc/test/test/luxc/lang/translation/primitive.lux
+++ b/new-luxc/test/test/luxc/lang/translation/primitive.lux
@@ -16,9 +16,9 @@
[synthesis #+ Synthesis]))
(test/luxc common))
-(def: ascii
+(def: upper-alpha-ascii
(r.Random Nat)
- (|> r.nat (:: r.Functor<Random> map (|>> (n/% +256) (n/max +1)))))
+ (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65)))))
(def: (spec run)
(-> (-> Synthesis (e.Error Top)) Test)
@@ -28,7 +28,7 @@
%int% r.int
%deg% r.deg
%frac% r.frac
- %text% (r.text' ascii +5)]
+ %text% (r.text' upper-alpha-ascii +5)]
(`` ($_ seq
(test "Can translate unit."
(|> (run (' []))
@@ -80,6 +80,10 @@
## (<| (times +100)
## (spec run-r)))
-(context: "[Scheme] Primitives."
+## (context: "[Scheme] Primitives."
+## (<| (times +100)
+## (spec run-scheme)))
+
+(context: "[Common Lisp] Primitives."
(<| (times +100)
- (spec run-scheme)))
+ (spec run-common-lisp)))
diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux
index 7cef493e6..8579663b4 100644
--- a/new-luxc/test/test/luxc/lang/translation/reference.lux
+++ b/new-luxc/test/test/luxc/lang/translation/reference.lux
@@ -18,7 +18,8 @@
## (ruby [".T_ruby" statement])
## (python [".T_python" statement])
## (r [".T_r" statement])
- (scheme [".T_scheme" statement]))))
+ ## (scheme [".T_scheme" statement])
+ (common-lisp [".T_common-lisp" statement]))))
(test/luxc common))
(def: upper-alpha-ascii
@@ -92,6 +93,10 @@
## (<| (times +100)
## (references-spec run-r def-r)))
-(context: "[Scheme] References."
+## (context: "[Scheme] References."
+## (<| (times +100)
+## (references-spec run-scheme def-scheme)))
+
+(context: "[Common Lisp] References."
(<| (times +100)
- (references-spec run-scheme def-scheme)))
+ (references-spec run-common-lisp def-common-lisp)))
diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux
index 5f2439394..a28a877dd 100644
--- a/new-luxc/test/test/luxc/lang/translation/structure.lux
+++ b/new-luxc/test/test/luxc/lang/translation/structure.lux
@@ -9,7 +9,7 @@
[text "text/" Eq<Text>]
text/format
(coll [array]
- [list]))
+ [list "list/" Functor<List>]))
["r" math/random "r/" Monad<Random>]
[macro]
(macro [code])
@@ -22,56 +22,19 @@
(host.import java/lang/Integer)
-(def: upper-alpha
- (r.Random Nat)
- (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65)))))
-
-(def: gen-primitive
- (r.Random Synthesis)
- (r.either (r.either (r.either (r/wrap (' []))
- (r/map code.bool r.bool))
- (r.either (r/map code.nat r.nat)
- (r/map code.int r.int)))
- (r.either (r.either (r/map code.deg r.deg)
- (r/map code.frac r.frac))
- (r/map code.text (r.text' upper-alpha +5)))))
-
-(def: (corresponds? [prediction sample])
- (-> [Synthesis Top] Bool)
- (case prediction
- [_ (#.Tuple #.Nil)]
- (text/= hostL.unit (:! Text sample))
-
- (^template [<tag> <type> <test>]
- [_ (<tag> prediction')]
- (case (host.try (<test> prediction' (:! <type> sample)))
- (#e.Success result)
- result
-
- (#e.Error error)
- false))
- ([#.Bool Bool bool/=]
- [#.Nat Nat n/=]
- [#.Int Int i/=]
- [#.Deg Deg d/=]
- [#.Frac Frac f/=]
- [#.Text Text text/=])
-
- _
- false
- ))
-
(def: (tuples-spec run)
(-> (-> Synthesis (e.Error Top)) Test)
(do r.Monad<Random>
[size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
- members (r.list size gen-primitive)]
+ tuple-in (r.list size r.int)]
(test "Can translate tuple."
- (|> (run (code.tuple members))
- (case> (#e.Success valueT)
- (let [valueT (:! (Array Top) valueT)]
- (and (n/= size (array.size valueT))
- (list.every? corresponds? (list.zip2 members (array.to-list valueT)))))
+ (|> (run (code.tuple (list/map code.int tuple-in)))
+ (case> (#e.Success tuple-out)
+ (let [tuple-out (:! (Array Top) tuple-out)]
+ (and (n/= size (array.size tuple-out))
+ (list.every? (function (_ [left right])
+ (i/= left (:! Int right)))
+ (list.zip2 tuple-in (array.to-list tuple-out)))))
(#e.Error error)
(exec (log! error)
@@ -81,25 +44,25 @@
(-> (-> Synthesis (e.Error Top)) Test)
(do r.Monad<Random>
[num-tags (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
- tag (|> r.nat (:: @ map (n/% num-tags)))
- #let [last? (n/= (n/dec num-tags) tag)]
- member gen-primitive]
+ tag-in (|> r.nat (:: @ map (n/% num-tags)))
+ #let [last?-in (n/= (n/dec num-tags) tag-in)]
+ value-in r.int]
(test "Can translate variant."
- (|> (run (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ member))))
+ (|> (run (` ((~ (code.nat tag-in)) (~ (code.bool last?-in)) (~ (code.int value-in)))))
(case> (#e.Success valueT)
(let [valueT (:! (Array Top) valueT)]
(and (n/= +3 (array.size valueT))
- (let [_tag (:! Integer (maybe.assume (array.read +0 valueT)))
- _last? (array.read +1 valueT)
- _value (:! Top (maybe.assume (array.read +2 valueT)))
- same-tag? (n/= tag (|> _tag host.int-to-long (:! Nat)))
- same-flag? (case _last?
- (#.Some _last?')
- (and last? (text/= "" (:! Text _last?')))
+ (let [tag-out (:! Integer (maybe.assume (array.read +0 valueT)))
+ last?-out (array.read +1 valueT)
+ value-out (:! Top (maybe.assume (array.read +2 valueT)))
+ same-tag? (n/= tag-in (|> tag-out host.int-to-long (:! Nat)))
+ same-flag? (case last?-out
+ (#.Some last?-out')
+ (and last?-in (text/= "" (:! Text last?-out')))
#.None
- (not last?))
- same-value? (corresponds? [member _value])]
+ (not last?-in))
+ same-value? (i/= value-in (:! Int value-out))]
(and same-tag?
same-flag?
same-value?))))
@@ -138,6 +101,10 @@
## (<| (times +100)
## (structure-spec run-r)))
-(context: "[Scheme] Structures."
+## (context: "[Scheme] Structures."
+## (<| (times +100)
+## (structure-spec run-scheme)))
+
+(context: "[Common Lisp] Structures."
(<| (times +100)
- (structure-spec run-scheme)))
+ (structure-spec run-common-lisp)))