diff options
Diffstat (limited to 'new-luxc/test/test')
| -rw-r--r-- | new-luxc/test/test/luxc/common.lux | 2 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/analysis/host.jvm.lux | 30 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/analysis/type.lux | 2 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/case.lux | 194 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/common.lux | 12 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/js.lux | 2 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/jvm.lux | 26 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/lang/translation/primitive.lux | 2 |
8 files changed, 213 insertions, 57 deletions
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux index f694d81bd..a68e2824c 100644 --- a/new-luxc/test/test/luxc/common.lux +++ b/new-luxc/test/test/luxc/common.lux @@ -52,7 +52,7 @@ (type: #export Runner (-> Synthesis (Error Any))) (type: #export Definer (-> Name Synthesis (Error Any))) -(do-template [<name> <host>] +(template [<name> <host>] [(def: #export <name> (IO State) (:: io.Monad<IO> map translation.state <host>))] diff --git a/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux b/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux index 9d09216b8..f9905c8bc 100644 --- a/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux +++ b/new-luxc/test/test/luxc/lang/analysis/host.jvm.lux @@ -31,7 +31,7 @@ [/// ["_." primitive]]) -(do-template [<name> <success> <failure>] +(template [<name> <success> <failure>] [(def: (<name> procedure params output-type) (-> Text (List Code) Type Bit) (|> (do Monad<Meta> @@ -52,7 +52,7 @@ [failure #0 #1] ) -(do-template [<name> <success> <failure>] +(template [<name> <success> <failure>] [(def: (<name> syntax output-type) (-> Code Type Bit) (|> (do Monad<Meta> @@ -74,7 +74,7 @@ ) (context: "Conversions [double + float]." - (with-expansions [<conversions> (do-template [<procedure> <from> <to>] + (with-expansions [<conversions> (template [<procedure> <from> <to>] [(test (format <procedure> " SUCCESS") (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>)) (test (format <procedure> " FAILURE") @@ -92,7 +92,7 @@ ))) (context: "Conversions [int]." - (with-expansions [<conversions> (do-template [<procedure> <from> <to>] + (with-expansions [<conversions> (template [<procedure> <from> <to>] [(test (format <procedure> " SUCCESS") (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>)) (test (format <procedure> " FAILURE") @@ -110,7 +110,7 @@ ))) (context: "Conversions [long]." - (with-expansions [<conversions> (do-template [<procedure> <from> <to>] + (with-expansions [<conversions> (template [<procedure> <from> <to>] [(test (format <procedure> " SUCCESS") (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>)) (test (format <procedure> " FAILURE") @@ -127,7 +127,7 @@ ))) (context: "Conversions [char + byte + short]." - (with-expansions [<conversions> (do-template [<procedure> <from> <to>] + (with-expansions [<conversions> (template [<procedure> <from> <to>] [(test (format <procedure> " SUCCESS") (success <procedure> (list (' ("lux coerce" (+0 <from> (+0)) []))) <to>)) (test (format <procedure> " FAILURE") @@ -144,9 +144,9 @@ <conversions> ))) -(do-template [<domain> <boxed> <type>] +(template [<domain> <boxed> <type>] [(context: (format "Arithmetic " "[" <domain> "].") - (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>] + (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>] [(test <procedure> (success <procedure> (list (' ("lux coerce" (+0 <subject> (+0)) [])) @@ -164,7 +164,7 @@ ))) (context: (format "Order " "[" <domain> "].") - (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>] + (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>] [(test <procedure> (success <procedure> (list (' ("lux coerce" (+0 <subject> (+0)) [])) @@ -179,7 +179,7 @@ ))) (context: (format "Bitwise " "[" <domain> "].") - (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>] + (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>] [(test <procedure> (success <procedure> (list (' ("lux coerce" (+0 <subject> (+0)) [])) @@ -202,9 +202,9 @@ ["long" "java.lang.Long" hostAE.Long] ) -(do-template [<domain> <boxed> <type>] +(template [<domain> <boxed> <type>] [(context: (format "Arithmetic " "[" <domain> "].") - (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>] + (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>] [(test <procedure> (success <procedure> (list (' ("lux coerce" (+0 <subject> (+0)) [])) @@ -222,7 +222,7 @@ ))) (context: (format "Order " "[" <domain> "].") - (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>] + (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>] [(test <procedure> (success <procedure> (list (' ("lux coerce" (+0 <subject> (+0)) [])) @@ -241,9 +241,9 @@ ["double" "java.lang.Double" hostAE.Double] ) -(do-template [<domain> <boxed> <type>] +(template [<domain> <boxed> <type>] [(context: (format "Order " "[" <domain> "].") - (with-expansions [<instructions> (do-template [<procedure> <subject> <param> <output>] + (with-expansions [<instructions> (template [<procedure> <subject> <param> <output>] [(test <procedure> (success <procedure> (list (' ("lux coerce" (+0 <subject> (+0)) [])) diff --git a/new-luxc/test/test/luxc/lang/analysis/type.lux b/new-luxc/test/test/luxc/lang/analysis/type.lux index 707565fca..dc1a0fea9 100644 --- a/new-luxc/test/test/luxc/lang/analysis/type.lux +++ b/new-luxc/test/test/luxc/lang/analysis/type.lux @@ -29,7 +29,7 @@ (def: check (r.Random [Code Type Code]) - (with-expansions [<triples> (do-template [<random> <type> <code>] + (with-expansions [<triples> (template [<random> <type> <code>] [(do r.Monad<Random> [value <random>] (wrap [(` <type>) diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/new-luxc/test/test/luxc/lang/translation/case.lux index 801d9f1d7..0cee2818a 100644 --- a/new-luxc/test/test/luxc/lang/translation/case.lux +++ b/new-luxc/test/test/luxc/lang/translation/case.lux @@ -4,16 +4,22 @@ [monad (#+ do)] pipe] [data + ["." error] + [text ("text/." Equivalence<Text>) + format] [collection - ["." list]]] + ["." list ("list/." Functor<List> Fold<List>)]]] [math ["r" random (#+ Random)]] [compiler [default ["." reference] - [phase + ["." phase ["." analysis] - ["." synthesis (#+ Path Synthesis)]]]] + ["." synthesis (#+ Path Synthesis) + ["." case] + ["." expression]] + ["." extension/synthesis]]]] test] [test [luxc @@ -39,7 +45,7 @@ [value r.i64] (wrap [(synthesis.i64 value) synthesis.path/pop])) - (~~ (do-template [<gen> <synth> <path>] + (~~ (template [<gen> <synth> <path>] [(do r.Monad<Random> [value <gen>] (wrap [(<synth> value) @@ -58,10 +64,11 @@ (list.concat (list (list.repeat idx unitS) (list subS) (list.repeat (|> size dec (n/- idx)) unitS)))) - caseP (synthesis.path/seq [(if (tail? size idx) - (synthesis.member/right idx) - (synthesis.member/left idx)) - subP])]] + caseP ($_ synthesis.path/seq + (if (tail? size idx) + (synthesis.member/right idx) + (synthesis.member/left idx)) + subP)]] (wrap [caseS caseP])) (do r.Monad<Random> [size ..size @@ -72,11 +79,11 @@ {#analysis.lefts idx #analysis.right? right? #analysis.value subS}) - caseP (synthesis.path/seq - [(if right? - (synthesis.side/right idx) - (synthesis.side/left idx)) - subP])]] + caseP ($_ synthesis.path/seq + (if right? + (synthesis.side/right idx) + (synthesis.side/left idx)) + subP)]] (wrap [caseS caseP])) )))) @@ -111,17 +118,166 @@ (test "Case." (|> (run (synthesis.branch/case [inputS - (synthesis.path/alt [(synthesis.path/seq [pathS - (synthesis.path/then (synthesis.f64 on-success))]) - (synthesis.path/then (synthesis.f64 on-failure))])])) + ($_ synthesis.path/alt + ($_ synthesis.path/seq + pathS + (synthesis.path/then (synthesis.f64 on-success))) + (synthesis.path/then (synthesis.f64 on-failure)))])) (&.check on-success))))) +(def: special-input + Synthesis + (let [_cursor_ (: Synthesis + (synthesis.tuple (list (synthesis.text "lux") + (synthesis.i64 +901) + (synthesis.i64 +13)))) + _code_ (: (-> Synthesis Synthesis) + (function (_ content) + (synthesis.tuple (list _cursor_ content)))) + _nil_ (: Synthesis + (synthesis.variant [0 #0 (synthesis.text "")])) + _cons_ (: (-> Synthesis Synthesis Synthesis) + (function (_ head tail) + (synthesis.variant [0 #1 (synthesis.tuple (list head tail))]))) + _list_ (: (-> (List Synthesis) Synthesis) + (list/fold _cons_ _nil_))] + (let [__tuple__ (: (-> (List Synthesis) Synthesis) + (|>> list.reverse _list_ [9 #0] synthesis.variant _code_)) + __form__ (: (-> (List Synthesis) Synthesis) + (|>> list.reverse _list_ [8 #0] synthesis.variant _code_)) + __text__ (: (-> Text Synthesis) + (function (_ value) + (_code_ (synthesis.variant [5 #0 (synthesis.text value)])))) + __identifier__ (: (-> Name Synthesis) + (function (_ [module short]) + (_code_ (synthesis.variant [6 #0 (synthesis.tuple (list (synthesis.text module) + (synthesis.text short)))])))) + __tag__ (: (-> Name Synthesis) + (function (_ [module short]) + (_code_ (synthesis.variant [7 #0 (synthesis.tuple (list (synthesis.text module) + (synthesis.text short)))])))) + __list__ (: (-> (List Synthesis) Synthesis) + (list/fold (function (_ head tail) + (__form__ (list (__tag__ ["" "Cons"]) head tail))) + (__tag__ ["" "Nil"]))) + __apply__ (: (-> Synthesis Synthesis Synthesis) + (function (_ func arg) + (__form__ (list func arg))))] + (|> _nil_ + (_cons_ (__apply__ (__identifier__ ["" "form$"]) + (__list__ (list (__apply__ (__identifier__ ["" "tag$"]) + (__tuple__ (list (__text__ "lux") + (__text__ "Cons")))) + (__identifier__ ["" "export?-meta"]) + (__identifier__ ["" "tail"]))))) + (_cons_ (__tuple__ (list (__identifier__ ["" "tail"])))) + )))) + +(def: special-path + Path + (let [_nil_ (synthesis.path/side (#.Left 0)) + _cons_ (synthesis.path/side (#.Right 0)) + _head_ (synthesis.path/member (#.Left 0)) + _tail_ (synthesis.path/member (#.Right 0)) + _tuple_ (synthesis.path/side (#.Left 9))] + ($_ synthesis.path/alt + ($_ synthesis.path/seq + _cons_ + _head_ + _head_ (synthesis.path/bind 2) synthesis.path/pop + _tail_ _tuple_ _cons_ + _head_ (synthesis.path/bind 3) synthesis.path/pop + _tail_ (synthesis.path/bind 4) synthesis.path/pop + synthesis.path/pop synthesis.path/pop synthesis.path/pop synthesis.path/pop + _tail_ _cons_ + _head_ (synthesis.path/bind 5) synthesis.path/pop + _tail_ _nil_ + ## THEN + (synthesis.path/then (synthesis.bit #1))) + ($_ synthesis.path/seq + (synthesis.path/bind 2) + ## THEN + (synthesis.path/then (synthesis.bit #0)))))) + +(def: special-pattern + analysis.Pattern + (let [## [_ (#Tuple (#Cons arg args'))] + head (<| analysis.pattern/tuple (list (analysis.pattern/bind 2)) + analysis.pattern/variant [9 #0] + analysis.pattern/variant [0 #1] + analysis.pattern/tuple (list (analysis.pattern/bind 3) + (analysis.pattern/bind 4))) + ## (#Cons body #Nil) + tail (<| analysis.pattern/variant [0 #1] + analysis.pattern/tuple (list (analysis.pattern/bind 5)) + analysis.pattern/variant [0 #0] + (analysis.pattern/unit))] + ## (#Cons <head> <tail>) + (<| analysis.pattern/variant [0 #1] + (analysis.pattern/tuple (list head tail))))) + +(def: special-pattern-path + Path + ($_ synthesis.path/alt + (<| error.assume + (phase.run [extension/synthesis.bundle + synthesis.init]) + (case.path expression.synthesize + special-pattern) + (analysis.bit #1)) + ($_ synthesis.path/seq + (synthesis.path/bind 2) + ## THEN + (synthesis.path/then (synthesis.bit #0))))) + +(def: (special-spec run) + (-> Runner Test) + (do r.Monad<Random> + [] + ($_ seq + (test "===" + (and (text/= (synthesis.%path special-path) + (synthesis.%path special-pattern-path)) + (:: synthesis.Equivalence<Path> = special-path special-pattern-path))) + (test "CODE" + (|> (run special-input) + (case> (#error.Success output) + (exec (log! (|> output (:coerce (List Code)) (%list %code))) + #1) + + (#error.Error error) + (exec (log! error) + #0)))) + (test "PATTERN-MATCHING 0" + (|> (run (synthesis.branch/case [special-input + special-path])) + (case> (#error.Success output) + (exec (log! (format "output 0 = " (%b (:coerce Bit output)))) + #1) + + (#error.Error error) + (exec (log! error) + #0)))) + (test "PATTERN-MATCHING 1" + (|> (run (synthesis.branch/case [special-input + special-pattern-path])) + (case> (#error.Success output) + (exec (log! (format "output 1 = " (%b (:coerce Bit output)))) + #1) + + (#error.Error error) + (exec (log! error) + #0)))) + ))) + (def: (pattern-matching-spec run) (-> Runner Test) ($_ seq - (let-spec run) - (if-spec run) - (case-spec run))) + (special-spec run) + ## (let-spec run) + ## (if-spec run) + ## (case-spec run) + )) (context: "[JVM] Pattern-matching." (<| (times 100) diff --git a/new-luxc/test/test/luxc/lang/translation/common.lux b/new-luxc/test/test/luxc/lang/translation/common.lux index 3005a7588..1e671aa96 100644 --- a/new-luxc/test/test/luxc/lang/translation/common.lux +++ b/new-luxc/test/test/luxc/lang/translation/common.lux @@ -31,7 +31,7 @@ (do r.Monad<Random> [param r.i64 subject r.i64] - (with-expansions [<binary> (do-template [<name> <reference> <param-expr>] + (with-expansions [<binary> (template [<name> <reference> <param-expr>] [(test <name> (|> (run (#synthesis.Extension <name> (list (synthesis.i64 subject) (synthesis.i64 param)))) @@ -70,7 +70,7 @@ [param (|> r.i64 (r.filter (|>> ("lux i64 =" 0) not))) subject r.i64] (`` ($_ seq - (~~ (do-template [<name> <type> <prepare> <comp> <subject-expr>] + (~~ (template [<name> <type> <prepare> <comp> <subject-expr>] [(test <name> (|> (run (#synthesis.Extension <name> (list (synthesis.i64 subject)))) (case> (#error.Success valueT) @@ -86,7 +86,7 @@ (n/% (i64.left-shift 8 1)) (:coerce Int))] )) - (~~ (do-template [<name> <reference> <outputT> <comp>] + (~~ (template [<name> <reference> <outputT> <comp>] [(test <name> (|> (run (#synthesis.Extension <name> (list (synthesis.i64 subject) (synthesis.i64 param)))) @@ -116,7 +116,7 @@ [param (|> ..simple-frac (r.filter (|>> (f/= +0.0) not))) subject ..simple-frac] (`` ($_ seq - (~~ (do-template [<name> <reference> <comp>] + (~~ (template [<name> <reference> <comp>] [(test <name> (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject) (synthesis.f64 param)))) @@ -128,7 +128,7 @@ ["lux f64 /" f// f/=] ["lux f64 %" f/% f/=] )) - (~~ (do-template [<name> <text>] + (~~ (template [<name> <text>] [(test <name> (|> (run (#synthesis.Extension <name> (list (synthesis.f64 subject) (synthesis.f64 param)))) @@ -142,7 +142,7 @@ ["lux f64 =" f/=] ["lux f64 <" f/<] )) - (~~ (do-template [<name> <reference>] + (~~ (template [<name> <reference>] [(test <name> (|> (run (#synthesis.Extension <name> (list))) (&.check <reference>)))] diff --git a/new-luxc/test/test/luxc/lang/translation/js.lux b/new-luxc/test/test/luxc/lang/translation/js.lux index 8175e82fc..83108c594 100644 --- a/new-luxc/test/test/luxc/lang/translation/js.lux +++ b/new-luxc/test/test/luxc/lang/translation/js.lux @@ -30,7 +30,7 @@ (type: Check (-> (e.Error Any) Bit)) -(do-template [<name> <type> <pre> <=>] +(template [<name> <type> <pre> <=>] [(def: (<name> angle) (-> <type> Check) (|>> (case> (#e.Success valueV) diff --git a/new-luxc/test/test/luxc/lang/translation/jvm.lux b/new-luxc/test/test/luxc/lang/translation/jvm.lux index f31496b08..7c97b1e78 100644 --- a/new-luxc/test/test/luxc/lang/translation/jvm.lux +++ b/new-luxc/test/test/luxc/lang/translation/jvm.lux @@ -29,7 +29,7 @@ (do @ [int-sample (|> r.int (:: @ map (i/% 128))) #let [frac-sample (int-to-frac int-sample)]] - (with-expansions [<2step> (do-template [<step1> <step2> <tag> <sample> <cast> <test>] + (with-expansions [<2step> (template [<step1> <step2> <tag> <sample> <cast> <test>] [(test (format <step1> " / " <step2>) (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (|> (~ (<tag> <sample>)) <step1> <step2> (`)))] @@ -61,7 +61,7 @@ [int-sample (|> r.int (:: @ map (|>> (i/% 128) int/abs))) #let [frac-sample (int-to-frac int-sample)]] (`` ($_ seq - (~~ (do-template [<step1> <step2> <step3> <tag> <sample> <cast> <test>] + (~~ (template [<step1> <step2> <step3> <tag> <sample> <cast> <test>] [(test (format <step1> " / " <step2> " / " <step3>) (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (|> (~ (<tag> <sample>)) <step1> <step2> <step3> (`)))] @@ -88,7 +88,7 @@ [int-sample (|> r.int (:: @ map (|>> (i/% 128) int/abs))) #let [frac-sample (int-to-frac int-sample)]] (`` ($_ seq - (~~ (do-template [<step1> <step2> <step3> <step4> <tag> <sample> <cast> <test>] + (~~ (template [<step1> <step2> <step3> <step4> <tag> <sample> <cast> <test>] [(test (format <step1> " / " <step2> " / " <step3>) (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (|> (~ (<tag> <sample>)) <step1> <step2> <step3> <step4> (`)))] @@ -121,13 +121,13 @@ (r.Random Frac) (|> gen-int (r/map int-to-frac))) -(do-template [<domain> <generator> <tag> <type> <test> <augmentation> <+> <-> <*> </> <%> <pre> <post>] +(template [<domain> <generator> <tag> <type> <test> <augmentation> <+> <-> <*> </> <%> <pre> <post>] [(context: (format "Arithmetic [" <domain> "]") (<| (times +100) (do @ [param <generator> #let [subject (<augmentation> param)]] - (with-expansions [<tests> (do-template [<procedure> <reference>] + (with-expansions [<tests> (template [<procedure> <reference>] [(test <procedure> (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (<post> ((code.text <procedure>) @@ -159,14 +159,14 @@ ["double" gen-frac code.frac Frac f/= (f/* 10.0) f/+ f/- f/* f// f/% id id] ) -(do-template [<domain> <post> <convert>] +(template [<domain> <post> <convert>] [(context: (format "Bit-wise [" <domain> "] { Combiners ]") (<| (times +100) (do @ [param gen-nat subject gen-nat] (`` ($_ seq - (~~ (do-template [<procedure> <reference>] + (~~ (template [<procedure> <reference>] [(test <procedure> (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (<post> ((code.text <procedure>) @@ -192,7 +192,7 @@ ["long" id id] ) -(do-template [<domain> <post> <convert>] +(template [<domain> <post> <convert>] [(context: (format "Bit-wise [" <domain> "] { Shifters }") (<| (times +100) (do @ @@ -200,7 +200,7 @@ subject gen-nat #let [shift (n/% +10 param)]] (`` ($_ seq - (~~ (do-template [<procedure> <reference> <type> <test> <pre-subject> <pre>] + (~~ (template [<procedure> <reference> <type> <test> <pre-subject> <pre>] [(test <procedure> (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (<post> ((code.text <procedure>) @@ -226,13 +226,13 @@ ["long" id id] ) -(do-template [<domain> <generator> <tag> <=> <<> <pre>] +(template [<domain> <generator> <tag> <=> <<> <pre>] [(context: (format "Order [" <domain> "]") (<| (times +100) (do @ [param <generator> subject <generator>] - (with-expansions [<tests> (do-template [<procedure> <reference>] + (with-expansions [<tests> (template [<procedure> <reference>] [(test <procedure> (|> (do macro.Monad<Meta> [sampleI (expressionT.translate ((code.text <procedure>) @@ -287,7 +287,7 @@ valueF gen-frac valueD r.frac valueC gen-int] - (with-expansions [<array> (do-template [<class> <type> <value> <test> <input> <post>] + (with-expansions [<array> (template [<class> <type> <value> <test> <input> <post>] [(test <class> (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (|> (jvm//array//new +0 <class> size) @@ -335,7 +335,7 @@ valueF gen-frac valueD r.frac valueC gen-int] - (with-expansions [<array> (do-template [<class> <type> <value> <test> <input> <post>] + (with-expansions [<array> (template [<class> <type> <value> <test> <input> <post>] [(test <class> (|> (do macro.Monad<Meta> [sampleI (expressionT.translate (|> (jvm//array//new +0 <class> size) diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux index ee8e53d5e..f3c6c8fc3 100644 --- a/new-luxc/test/test/luxc/lang/translation/primitive.lux +++ b/new-luxc/test/test/luxc/lang/translation/primitive.lux @@ -34,7 +34,7 @@ |f64| r.frac |text| (r.ascii 5)] (`` ($_ seq - (~~ (do-template [<desc> <type> <synthesis> <sample> <test>] + (~~ (template [<desc> <type> <synthesis> <sample> <test>] [(test (format "Can translate " <desc> ".") (|> (run (<synthesis> <sample>)) (case> (#error.Success valueT) |