diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/test/test/luxc/common.lux | 25 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/case.lux | 8 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/common.lux | 213 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/function.lux | 8 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/primitive.lux | 14 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/reference.lux | 11 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/structure.lux | 89 |
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))) |