diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/function.lux | 12 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/primitive.lux | 51 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/reference.lux | 4 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/structure.lux | 48 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/analyser/type.lux | 16 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/generator/reference.lux | 5 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/synthesizer/case/special.lux | 36 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/synthesizer/common.lux | 33 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/synthesizer/function.lux | 42 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/synthesizer/loop.lux | 53 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/synthesizer/primitive.lux | 17 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/synthesizer/procedure.lux | 7 |
12 files changed, 138 insertions, 186 deletions
diff --git a/new-luxc/test/test/luxc/analyser/function.lux b/new-luxc/test/test/luxc/analyser/function.lux index 6fbafd1eb..379c4acf4 100644 --- a/new-luxc/test/test/luxc/analyser/function.lux +++ b/new-luxc/test/test/luxc/analyser/function.lux @@ -44,7 +44,7 @@ (def: (flatten-apply analysis) (-> la;Analysis [la;Analysis (List la;Analysis)]) (case analysis - (#la;Apply head func) + (^code ("lux apply" (~ head) (~ func))) (let [[func' tail] (flatten-apply func)] [func' (#;Cons head tail)]) @@ -130,25 +130,25 @@ ($_ seq (test "Can analyse monomorphic type application." (|> (@common;with-unknown-type - (@;analyse-apply analyse funcT (#la;Unit) inputsC)) + (@;analyse-apply analyse funcT (' []) inputsC)) (check-apply outputT full-args))) (test "Can partially apply functions." (|> (@common;with-unknown-type - (@;analyse-apply analyse funcT (#la;Unit) + (@;analyse-apply analyse funcT (' []) (list;take partial-args inputsC))) (check-apply partialT partial-args))) (test "Can apply polymorphic functions." (|> (@common;with-unknown-type - (@;analyse-apply analyse polyT (#la;Unit) inputsC)) + (@;analyse-apply analyse polyT (' []) inputsC)) (check-apply poly-inputT full-args))) (test "Polymorphic partial application propagates found type-vars." (|> (@common;with-unknown-type - (@;analyse-apply analyse polyT (#la;Unit) + (@;analyse-apply analyse polyT (' []) (list;take (n.inc var-idx) inputsC))) (check-apply partial-polyT1 (n.inc var-idx)))) (test "Polymorphic partial application preserves quantification for type-vars." (|> (@common;with-unknown-type - (@;analyse-apply analyse polyT (#la;Unit) + (@;analyse-apply analyse polyT (' []) (list;take var-idx inputsC))) (check-apply partial-polyT2 var-idx))) )))) diff --git a/new-luxc/test/test/luxc/analyser/primitive.lux b/new-luxc/test/test/luxc/analyser/primitive.lux index 3d2e4ada6..8c483428b 100644 --- a/new-luxc/test/test/luxc/analyser/primitive.lux +++ b/new-luxc/test/test/luxc/analyser/primitive.lux @@ -34,27 +34,34 @@ %deg% r;deg %frac% r;frac %text% (r;text +5)] - (with-expansions - [<tests> (do-template [<desc> <type> <tag> <value> <analyser>] - [(test (format "Can analyse " <desc> ".") - (|> (@common;with-unknown-type - (<analyser> <value>)) - (meta;run (init-compiler [])) - (case> (#e;Success [_type (<tag> value)]) - (and (type/= <type> _type) - (is <value> value)) + (`` ($_ seq + (test "Can analyse unit." + (|> (@common;with-unknown-type + @;analyse-unit) + (meta;run (init-compiler [])) + (case> (^ (#e;Success [_type (^code [])])) + (type/= Unit _type) - _ - false)) - )] + _ + false)) + ) + (~~ (do-template [<desc> <type> <tag> <value> <analyser>] + [(test (format "Can analyse " <desc> ".") + (|> (@common;with-unknown-type + (<analyser> <value>)) + (meta;run (init-compiler [])) + (case> (#e;Success [_type [_ (<tag> value)]]) + (and (type/= <type> _type) + (is <value> value)) - ["unit" Unit #~;Unit [] (function [value] @;analyse-unit)] - ["bool" Bool #~;Bool %bool% @;analyse-bool] - ["nat" Nat #~;Nat %nat% @;analyse-nat] - ["int" Int #~;Int %int% @;analyse-int] - ["deg" Deg #~;Deg %deg% @;analyse-deg] - ["frac" Frac #~;Frac %frac% @;analyse-frac] - ["text" Text #~;Text %text% @;analyse-text] - )] - ($_ seq - <tests>))))) + _ + false)) + )] + + ["bool" Bool #;Bool %bool% @;analyse-bool] + ["nat" Nat #;Nat %nat% @;analyse-nat] + ["int" Int #;Int %int% @;analyse-int] + ["deg" Deg #;Deg %deg% @;analyse-deg] + ["frac" Frac #;Frac %frac% @;analyse-frac] + ["text" Text #;Text %text% @;analyse-text] + ))))))) diff --git a/new-luxc/test/test/luxc/analyser/reference.lux b/new-luxc/test/test/luxc/analyser/reference.lux index 89d68484f..e9d66838a 100644 --- a/new-luxc/test/test/luxc/analyser/reference.lux +++ b/new-luxc/test/test/luxc/analyser/reference.lux @@ -31,7 +31,7 @@ (@common;with-unknown-type (@;analyse-reference ["" var-name])))) (meta;run (init-compiler [])) - (case> (#e;Success [_type (#~;Variable idx)]) + (case> (^ (#e;Success [_type (^code ((~ [_ (#;Int var)])))])) (type/= ref-type _type) _ @@ -44,7 +44,7 @@ (@common;with-unknown-type (@;analyse-reference [module-name var-name]))) (meta;run (init-compiler [])) - (case> (#e;Success [_type (#~;Definition idx)]) + (case> (#e;Success [_type [_ (#;Symbol def-name)]]) (type/= ref-type _type) _ diff --git a/new-luxc/test/test/luxc/analyser/structure.lux b/new-luxc/test/test/luxc/analyser/structure.lux index 40896c334..5f88aea37 100644 --- a/new-luxc/test/test/luxc/analyser/structure.lux +++ b/new-luxc/test/test/luxc/analyser/structure.lux @@ -26,36 +26,6 @@ (.. common) (test/luxc common)) -(def: (flatten-tuple analysis) - (-> la;Analysis (List la;Analysis)) - (case analysis - (#la;Product left right) - (#;Cons left (flatten-tuple right)) - - _ - (list analysis))) - -(def: (flatten-variant analysis) - (-> la;Analysis (Maybe [Nat Bool la;Analysis])) - (case analysis - (#la;Sum variant) - (loop [so-far +0 - variantA variant] - (case variantA - (#;Left valueA) - (case valueA - (#la;Sum choice) - (recur (n.inc so-far) choice) - - _ - (#;Some [so-far false valueA])) - - (#;Right valueA) - (#;Some [(n.inc so-far) true valueA]))) - - _ - #;None)) - (context: "Sums" (<| (times +100) (do @ @@ -79,7 +49,7 @@ (@;analyse-sum analyse choice valueC))) (meta;run (init-compiler [])) (case> (^multi (#e;Success [_ sumA]) - [(flatten-variant sumA) + [(la;unfold-variant sumA) (#;Some [tag last? valueA])]) (and (n.= tag choice) (bool/= last? (n.= (n.dec size) choice))) @@ -97,7 +67,7 @@ (@;analyse-sum analyse choice valueC)))))) (meta;run (init-compiler [])) (case> (^multi (#e;Success [_ sumA]) - [(flatten-variant sumA) + [(la;unfold-variant sumA) (#;Some [tag last? valueA])]) (and (n.= tag choice) (bool/= last? (n.= (n.dec size) choice))) @@ -156,7 +126,7 @@ (@;analyse-product analyse (list/map product;right primitives))) (meta;run (init-compiler [])) (case> (#e;Success tupleA) - (n.= size (list;size (flatten-tuple tupleA))) + (n.= size (list;size (la;unfold-tuple tupleA))) _ false))) @@ -167,7 +137,7 @@ (case> (#e;Success [_type tupleA]) (and (type/= (type;tuple (list/map product;left primitives)) _type) - (n.= size (list;size (flatten-tuple tupleA)))) + (n.= size (list;size (la;unfold-tuple tupleA)))) _ false))) @@ -191,7 +161,7 @@ (@;analyse-product analyse (list/map product;right primitives))))))) (meta;run (init-compiler [])) (case> (#e;Success [_ tupleA]) - (n.= size (list;size (flatten-tuple tupleA))) + (n.= size (list;size (la;unfold-tuple tupleA))) _ false))) @@ -222,7 +192,7 @@ (|> analysis (meta;run (init-compiler [])) (case> (^multi (#e;Success [_ _ sumT sumA]) - [(flatten-variant sumA) + [(la;unfold-variant sumA) (#;Some [tag last? valueA])]) (and (type/= variantT sumT) (n.= tag choice) @@ -236,7 +206,7 @@ (|> analysis (meta;run (init-compiler [])) (case> (^multi (#e;Success [_ _ productT productA]) - [(flatten-tuple productA) + [(la;unfold-tuple productA) membersA]) (and (type/= tupleT productT) (n.= size (list;size membersA))) @@ -301,7 +271,7 @@ (@;analyse-tagged-sum analyse [module-name other-choice-tag] other-choiceC))))) (meta;run (init-compiler [])) (case> (^multi (#e;Success [_ _ sumA]) - [(flatten-variant sumA) + [(la;unfold-variant sumA) (#;Some [tag last? valueA])]) (and (n.= tag other-choice) (bool/= last? (n.= (n.dec size) other-choice))) @@ -357,7 +327,7 @@ (@;analyse-record analyse recordC))))) (meta;run (init-compiler [])) (case> (^multi (#e;Success [_ _ productA]) - [(flatten-tuple productA) + [(la;unfold-tuple productA) membersA]) (n.= size (list;size membersA)) diff --git a/new-luxc/test/test/luxc/analyser/type.lux b/new-luxc/test/test/luxc/analyser/type.lux index eb414bf04..978e450b6 100644 --- a/new-luxc/test/test/luxc/analyser/type.lux +++ b/new-luxc/test/test/luxc/analyser/type.lux @@ -61,15 +61,15 @@ (case> (#e;Success [_ [analysisT analysisA]]) (and (type/= codeT analysisT) (case [exprC analysisA] - (^template [<expected> <actual> <test>] - [[_ (<expected> expected)] (<actual> actual)] + (^template [<tag> <test>] + [[_ (<tag> expected)] [_ (<tag> actual)]] (<test> expected actual)) - ([#;Bool #~;Bool bool/=] - [#;Nat #~;Nat n.=] - [#;Int #~;Int i.=] - [#;Deg #~;Deg d.=] - [#;Frac #~;Frac f.=] - [#;Text #~;Text text/=]) + ([#;Bool bool/=] + [#;Nat n.=] + [#;Int i.=] + [#;Deg d.=] + [#;Frac f.=] + [#;Text text/=]) _ false)) diff --git a/new-luxc/test/test/luxc/generator/reference.lux b/new-luxc/test/test/luxc/generator/reference.lux index a8bed89e1..dd522839b 100644 --- a/new-luxc/test/test/luxc/generator/reference.lux +++ b/new-luxc/test/test/luxc/generator/reference.lux @@ -3,7 +3,8 @@ (lux [io] (control [monad #+ do] pipe) - (data ["e" error]) + (data ["e" error] + [text]) ["r" math/random] [meta] (meta [code]) @@ -38,7 +39,7 @@ (context: "Definitions." (<| (times +100) (do @ - [module-name (r;text +5) + [module-name (|> (r;text +5) (r;filter (|>. (text;contains? "/") not))) def-name (r;text +5) def-value r;int #let [valueI (|>. ($i;long def-value) ($i;wrap #$;Long))]] diff --git a/new-luxc/test/test/luxc/synthesizer/case/special.lux b/new-luxc/test/test/luxc/synthesizer/case/special.lux index 63a921b68..30e64fc77 100644 --- a/new-luxc/test/test/luxc/synthesizer/case/special.lux +++ b/new-luxc/test/test/luxc/synthesizer/case/special.lux @@ -3,16 +3,12 @@ (lux [io] (control [monad #+ do] pipe) - (data [product] - [number] - text/format - (coll [list "L/" Functor<List> Fold<List>] - ["D" dict] - ["s" set])) + (meta [code]) ["r" math/random "r/" Monad<Random>] test) (luxc (lang ["la" analysis] - ["ls" synthesis]) + ["ls" synthesis] + [";L" variable #+ Variable]) [synthesizer]) (../.. common)) @@ -20,10 +16,10 @@ (<| (times +100) (do @ [maskedA gen-primitive - temp r;nat - #let [maskA (#la;Case maskedA - (list [(#la;BindP temp) - (#la;Variable (#;Local temp))]))]] + temp (|> r;nat (:: @ map (n.% +100))) + #let [maskA (` ("lux case" (~ maskedA) + {("lux case bind" (~ (code;nat temp))) + (~ (la;var (variableL;local temp)))}))]] (test "Dummy variables created to mask expressions get eliminated during synthesis." (|> (synthesizer;synthesize maskA) (corresponds? maskedA)))))) @@ -34,9 +30,9 @@ [registerA r;nat inputA gen-primitive outputA gen-primitive - #let [letA (#la;Case inputA - (list [(#la;BindP registerA) - outputA]))]] + #let [letA (` ("lux case" (~ inputA) + {("lux case bind" (~ (code;nat registerA))) + (~ outputA)}))]] (test "Can detect and reify simple 'let' expressions." (|> (synthesizer;synthesize letA) (case> (^ [_ (#;Form (list [_ (#;Text "lux let")] [_ (#;Nat registerS)] inputS outputS))]) @@ -55,12 +51,12 @@ thenA gen-primitive elseA gen-primitive #let [ifA (if then|else - (#la;Case inputA - (list [(#la;BoolP true) thenA] - [(#la;BoolP false) elseA])) - (#la;Case inputA - (list [(#la;BoolP false) elseA] - [(#la;BoolP true) thenA])))]] + (` ("lux case" (~ inputA) + {true (~ thenA) + false (~ elseA)})) + (` ("lux case" (~ inputA) + {false (~ elseA) + true (~ thenA)})))]] (test "Can detect and reify simple 'if' expressions." (|> (synthesizer;synthesize ifA) (case> (^ [_ (#;Form (list [_ (#;Text "lux if")] inputS thenS elseS))]) diff --git a/new-luxc/test/test/luxc/synthesizer/common.lux b/new-luxc/test/test/luxc/synthesizer/common.lux index 35e7a71ba..a74c64402 100644 --- a/new-luxc/test/test/luxc/synthesizer/common.lux +++ b/new-luxc/test/test/luxc/synthesizer/common.lux @@ -2,35 +2,36 @@ lux (lux (data [bool "bool/" Eq<Bool>] [text "text/" Eq<Text>]) + (meta [code]) ["r" math/random "r/" Monad<Random>]) (luxc (lang ["la" analysis] ["ls" synthesis]))) (def: #export gen-primitive (r;Random la;Analysis) - (r;either (r;either (r;either (r/wrap #la;Unit) - (r/map (|>. #la;Bool) r;bool)) - (r;either (r/map (|>. #la;Nat) r;nat) - (r/map (|>. #la;Int) r;int))) - (r;either (r;either (r/map (|>. #la;Deg) r;deg) - (r/map (|>. #la;Frac) r;frac)) - (r/map (|>. #la;Text) (r;text +5))))) + (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 +5))))) (def: #export (corresponds? analysis synthesis) (-> la;Analysis ls;Synthesis Bool) (case [analysis synthesis] - [#la;Unit [_ (#;Tuple #;Nil)]] + (^ [(^code []) (^code [])]) true - (^template [<analysis> <synthesis> <test>] - [(<analysis> valueA) [_ (<synthesis> valueS)]] + (^template [<tag> <test>] + [[_ (<tag> valueA)] [_ (<tag> valueS)]] (<test> valueA valueS)) - ([#la;Bool #;Bool bool/=] - [#la;Nat #;Nat n.=] - [#la;Int #;Int i.=] - [#la;Deg #;Deg d.=] - [#la;Frac #;Frac f.=] - [#la;Text #;Text text/=]) + ([#;Bool bool/=] + [#;Nat n.=] + [#;Int i.=] + [#;Deg d.=] + [#;Frac f.=] + [#;Text text/=]) _ false)) diff --git a/new-luxc/test/test/luxc/synthesizer/function.lux b/new-luxc/test/test/luxc/synthesizer/function.lux index f38a2fab5..cab0da847 100644 --- a/new-luxc/test/test/luxc/synthesizer/function.lux +++ b/new-luxc/test/test/luxc/synthesizer/function.lux @@ -10,29 +10,15 @@ (coll [list "list/" Functor<List> Fold<List>] [dict #+ Dict] [set])) + (meta [code]) ["r" math/random "r/" Monad<Random>] test) (luxc (lang ["la" analysis] - ["ls" synthesis]) - [synthesizer] - (synthesizer ["&&;" function])) + ["ls" synthesis] + [";L" variable #+ Variable]) + [synthesizer]) (.. common)) -(def: (reference var) - (-> ls;Variable Ref) - (if (&&function;captured? var) - (#;Captured (|> var (i.* -1) int-to-nat n.dec)) - (#;Local (int-to-nat var)))) - -(def: (make-scope env) - (-> (List ls;Variable) Scope) - {#;name (list) - #;inner +0 - #;locals {#;counter +0 #;mappings (list)} - #;captured {#;counter +0 - #;mappings (list/map (|>. reference [Void] [""]) - env)}}) - (def: gen-function//constant (r;Random [Nat la;Analysis la;Analysis]) (r;rec @@ -44,7 +30,7 @@ [[num-args outputA subA] gen-function//constant] (wrap [(n.inc num-args) outputA - (#la;Function (make-scope (list)) subA)])) + (` ("lux function" [] (~ subA)))])) (do @ [outputA gen-primitive] (wrap [+0 outputA outputA]))))))) @@ -58,8 +44,8 @@ (do r;Monad<Random> [num-locals (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10)))) #let [indices (list;n.range +0 (n.dec num-locals)) - absolute-env (list/map &&function;to-local indices) - relative-env (list/map &&function;to-captured indices)] + absolute-env (list/map variableL;local indices) + relative-env (list/map variableL;captured indices)] [total-args prediction bodyA] (: (r;Random [Nat Int la;Analysis]) (loop [num-args +1 global-env relative-env] @@ -80,14 +66,16 @@ [total-args prediction bodyA] (recur (n.inc num-args) (list/map (function [pick] (maybe;assume (list;nth pick global-env))) picks))] - (wrap [total-args prediction (#la;Function (make-scope (list/map &&function;to-captured picks)) - bodyA)])) + (wrap [total-args prediction (` ("lux function" [(~@ (list/map (|>. variableL;captured code;int) picks))] + (~ bodyA)))])) (do @ [chosen (pick (list;size global-env))] (wrap [num-args (maybe;assume (dict;get chosen resolver)) - (#la;Variable (#;Captured chosen))])))))))] - (wrap [total-args prediction (#la;Function (make-scope absolute-env) bodyA)]) + (la;var (variableL;captured chosen))])))))))] + (wrap [total-args prediction (` ("lux function" + [(~@ (list/map code;int absolute-env))] + (~ bodyA)))]) )) (def: gen-function//local @@ -98,12 +86,12 @@ (do r;Monad<Random> [nest?' r;bool [total-args prediction bodyA] (recur (n.inc num-args) nest?')] - (wrap [total-args prediction (#la;Function (make-scope (list)) bodyA)])) + (wrap [total-args prediction (` ("lux function" [] (~ bodyA)))])) (do r;Monad<Random> [chosen (|> r;nat (:: @ map (|>. (n.% +100) (n.max +2))))] (wrap [num-args (|> chosen (n.+ (n.dec num-args)) nat-to-int) - (#la;Variable (#;Local chosen))]))))) + (la;var (variableL;local chosen))]))))) (context: "Function definition." (<| (times +100) diff --git a/new-luxc/test/test/luxc/synthesizer/loop.lux b/new-luxc/test/test/luxc/synthesizer/loop.lux index 165408fb6..fd8c95ce1 100644 --- a/new-luxc/test/test/luxc/synthesizer/loop.lux +++ b/new-luxc/test/test/luxc/synthesizer/loop.lux @@ -7,6 +7,7 @@ (coll [list "list/" Functor<List> Fold<List>] ["s" set]) text/format) + (meta [code]) ["r" math/random "r/" Monad<Random>] test) (luxc (lang ["la" analysis] @@ -53,49 +54,39 @@ (-> Nat la;Analysis (r;Random la;Analysis)) (r;either (r;either (r/wrap output) (do r;Monad<Random> - [inputA (|> r;nat (:: @ map (|>. #la;Nat))) + [inputA (|> r;nat (:: @ map code;nat)) num-cases (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1)))) tests (|> (r;set number;Hash<Nat> num-cases r;nat) - (:: @ map (|>. s;to-list (list/map (|>. #la;NatP))))) - #let [bad-bodies (list;repeat num-cases #la;Unit)] + (:: @ map (|>. s;to-list (list/map code;nat)))) + #let [bad-bodies (list;repeat num-cases (' []))] good-body (gen-body arity output) where-to-set (|> r;nat (:: @ map (n.% num-cases))) #let [bodies (list;concat (list (list;take where-to-set bad-bodies) (list good-body) (list;drop (n.inc where-to-set) bad-bodies)))]] - (wrap (#la;Case inputA - (list;zip2 tests bodies))))) + (wrap (` ("lux case" (~ inputA) + (~ (code;record (list;zip2 tests bodies)))))))) (r;either (do r;Monad<Random> [valueS r;bool output' (gen-body (n.inc arity) output)] - (wrap (#la;Case (#la;Bool valueS) (list [(#la;BindP arity) output'])))) + (wrap (` ("lux case" (~ (code;bool valueS)) + {("lux case bind" (~ (code;nat arity))) (~ output')})))) (do r;Monad<Random> [valueS r;bool then|else r;bool output' (gen-body arity output) - #let [thenA (if then|else output' #la;Unit) - elseA (if (not then|else) output' #la;Unit)]] - (wrap (#la;Case (#la;Bool valueS) - (list [(#la;BoolP then|else) thenA] - [(#la;BoolP (not then|else)) elseA]))))) + #let [thenA (if then|else output' (' [])) + elseA (if (not then|else) output' (' []))]] + (wrap (` ("lux case" (~ (code;bool valueS)) + {(~ (code;bool then|else)) (~ thenA) + (~ (code;bool (not then|else))) (~ elseA)}))))) )) -(def: (make-apply func args) - (-> la;Analysis (List la;Analysis) la;Analysis) - (list/fold (function [arg' func'] - (#la;Apply arg' func')) - func - args)) - (def: (make-function arity body) (-> ls;Arity la;Analysis la;Analysis) (case arity +0 body - _ (#la;Function {#;name (list) - #;inner +0 - #;locals {#;counter +0 #;mappings (list)} - #;captured {#;counter +0 #;mappings (list)}} - (make-function (n.dec arity) body)))) + _ (` ("lux function" [] (~ (make-function (n.dec arity) body)))))) (def: gen-recursion (r;Random [Bool Nat la;Analysis]) @@ -103,14 +94,12 @@ [arity (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1)))) recur? r;bool outputS (if recur? - (wrap (make-apply (#la;Variable (#;Local +0)) - (list;repeat arity #la;Unit))) + (wrap (la;apply (list;repeat arity (' [])) (la;var 0))) (do @ [plus-or-minus? r;bool how-much (|> r;nat (:: @ map (|>. (n.% arity) (n.max +1)))) #let [shift (if plus-or-minus? n.+ n.-)]] - (wrap (make-apply (#la;Variable (#;Local +0)) - (list;repeat (shift how-much arity) #la;Unit))))) + (wrap (la;apply (list;repeat (shift how-much arity) (' [])) (la;var 0))))) bodyS (gen-body arity outputS)] (wrap [recur? arity (make-function arity bodyS)]))) @@ -120,15 +109,15 @@ [arity (|> r;nat (:: @ map (|>. (n.% +10) (n.max +1)))) recur? r;bool self-ref? r;bool - #let [selfA (#la;Variable (#;Local +0)) - argA (if self-ref? selfA #la;Unit)] + #let [selfA (la;var 0) + argA (if self-ref? selfA (' []))] outputS (if recur? - (wrap (make-apply selfA (list;repeat arity argA))) + (wrap (la;apply (list;repeat arity argA) selfA)) (do @ [plus-or-minus? r;bool how-much (|> r;nat (:: @ map (|>. (n.% arity) (n.max +1)))) #let [shift (if plus-or-minus? n.+ n.-)]] - (wrap (make-apply selfA (list;repeat (shift how-much arity) #la;Unit))))) + (wrap (la;apply (list;repeat (shift how-much arity) (' [])) selfA)))) bodyS (gen-body arity outputS)] (wrap [(and recur? (not self-ref?)) arity @@ -156,7 +145,7 @@ [[prediction arity analysis] gen-recursion] ($_ seq (test "Can reify loops." - (case (synthesizer;synthesize (make-apply analysis (list;repeat arity #la;Unit))) + (case (synthesizer;synthesize (la;apply (list;repeat arity (' [])) analysis)) (^ [_ (#;Form (list [_ (#;Text "lux loop")] [_ (#;Nat in_register)] [_ (#;Tuple _inits)] _body))]) (and (n.= arity (list;size _inits)) (not (&&loop;contains-self-reference? _body))) diff --git a/new-luxc/test/test/luxc/synthesizer/primitive.lux b/new-luxc/test/test/luxc/synthesizer/primitive.lux index e8484697d..fb37f6104 100644 --- a/new-luxc/test/test/luxc/synthesizer/primitive.lux +++ b/new-luxc/test/test/luxc/synthesizer/primitive.lux @@ -4,6 +4,7 @@ (control [monad #+ do] pipe) (data text/format) + (meta [code]) ["r" math/random] test) (luxc (lang ["la" analysis] @@ -22,8 +23,8 @@ %text% (r;text +5)] (`` ($_ seq (test (format "Can synthesize unit.") - (|> (synthesizer;synthesize (#la;Unit [])) - (case> [_ (#;Tuple #;Nil)] + (|> (synthesizer;synthesize (' [])) + (case> (^code []) true _ @@ -37,9 +38,9 @@ _ false)))] - ["bool" #la;Bool #;Bool %bool%] - ["nat" #la;Nat #;Nat %nat%] - ["int" #la;Int #;Int %int%] - ["deg" #la;Deg #;Deg %deg%] - ["frac" #la;Frac #;Frac %frac%] - ["text" #la;Text #;Text %text%]))))))) + ["bool" code;bool #;Bool %bool%] + ["nat" code;nat #;Nat %nat%] + ["int" code;int #;Int %int%] + ["deg" code;deg #;Deg %deg%] + ["frac" code;frac #;Frac %frac%] + ["text" code;text #;Text %text%]))))))) diff --git a/new-luxc/test/test/luxc/synthesizer/procedure.lux b/new-luxc/test/test/luxc/synthesizer/procedure.lux index 1753dcc47..68010adeb 100644 --- a/new-luxc/test/test/luxc/synthesizer/procedure.lux +++ b/new-luxc/test/test/luxc/synthesizer/procedure.lux @@ -3,8 +3,7 @@ (lux [io] (control [monad #+ do] pipe) - (data [bool "B/" Eq<Bool>] - [text "T/" Eq<Text>] + (data [text "text/" Eq<Text>] [product] (coll [list])) ["r" math/random "r/" Monad<Random>] @@ -23,9 +22,9 @@ argsA (r;list num-args gen-primitive)] ($_ seq (test "Can synthesize procedure calls." - (|> (synthesizer;synthesize (#la;Procedure nameA argsA)) + (|> (synthesizer;synthesize (la;procedure nameA argsA)) (case> (^ [_ (#;Form (list& [_ (#;Text procedure)] argsS))]) - (and (T/= nameA procedure) + (and (text/= nameA procedure) (list;every? (product;uncurry corresponds?) (list;zip2 argsA argsS))) |