diff options
Diffstat (limited to '')
| -rw-r--r-- | new-luxc/test/test/luxc/common.lux | 5 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/generator/function.lux | 96 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/synthesizer/function.lux | 2 | ||||
| -rw-r--r-- | new-luxc/test/test/luxc/synthesizer/loop.lux | 2 | ||||
| -rw-r--r-- | new-luxc/test/tests.lux | 3 |
5 files changed, 102 insertions, 6 deletions
diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux index 161675075..7c1444e01 100644 --- a/new-luxc/test/test/luxc/common.lux +++ b/new-luxc/test/test/luxc/common.lux @@ -4,7 +4,8 @@ ["r" math/random "r/" Monad<Random>] (data ["R" result]) [macro] - (macro [code])) + (macro [code]) + [io]) (luxc ["&" base] [analyser] ["&;" host])) @@ -32,4 +33,4 @@ #;expected #;None #;seed +0 #;scope-type-vars (list) - #;host (:! Void (&host;init-host []))}) + #;host (:! Void (io;run &host;init-host))}) diff --git a/new-luxc/test/test/luxc/generator/function.lux b/new-luxc/test/test/luxc/generator/function.lux new file mode 100644 index 000000000..76ab600fe --- /dev/null +++ b/new-luxc/test/test/luxc/generator/function.lux @@ -0,0 +1,96 @@ +(;module: + lux + (lux [io] + (control [monad #+ do] + pipe) + (data text/format + [product] + ["R" result] + [bool "B/" Eq<Bool>] + [text "T/" Eq<Text>] + (coll ["a" array] + [list "L/" Functor<List>] + ["S" set])) + ["r" math/random "r/" Monad<Random>] + [macro #+ Monad<Lux>] + (macro [code]) + [host] + test) + (luxc (lang ["ls" synthesis]) + [analyser] + [synthesizer] + (generator ["@;" expr] + ["@;" eval] + ["@;" runtime] + ["@;" common])) + (test/luxc common)) + +(def: arity-limit Nat +10) + +(def: arity + (r;Random ls;Arity) + (|> r;nat (r/map (|>. (n.% arity-limit) (n.max +1))))) + +(def: gen-function + (r;Random [ls;Arity Nat ls;Synthesis]) + (do r;Monad<Random> + [arity arity + arg (|> r;nat (:: @ map (n.% arity))) + #let [functionS (#ls;Function arity (list) (#ls;Variable (nat-to-int (n.inc arg))))]] + (wrap [arity arg functionS]))) + +(context: "Function." + [[arity arg functionS] gen-function + cut-off (|> r;nat (:: @ map (n.% arity))) + args (r;list arity r;nat) + #let [arg-value (assume (list;nth arg args)) + argsS (L/map (|>. #ls;Nat) args) + last-arg (n.dec arity) + cut-off (|> cut-off (n.min (n.dec last-arg)))]] + ($_ seq + (test "Can read arguments." + (|> (do Monad<Lux> + [runtime-bytecode @runtime;generate] + (@eval;eval (@expr;generate (#ls;Call argsS functionS)))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (n.= arg-value (:! Nat valueG)) + + (#R;Error error) + false))) + (test "Can partially apply functions." + (or (n.= +1 arity) + (|> (do Monad<Lux> + [#let [partial-arity (n.inc cut-off) + preS (list;take partial-arity argsS) + postS (list;drop partial-arity argsS)] + runtime-bytecode @runtime;generate] + (@eval;eval (@expr;generate (|> functionS (#ls;Call preS) (#ls;Call postS))))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (n.= arg-value (:! Nat valueG)) + + (#R;Error error) + false)))) + (test "Can read environment." + (or (n.= +1 arity) + (|> (do Monad<Lux> + [#let [env (|> (list;n.range +0 cut-off) + (L/map (|>. n.inc nat-to-int))) + super-arity (n.inc cut-off) + arg-var (if (n.<= cut-off arg) + (|> arg n.inc nat-to-int (i.* -1)) + (|> arg n.inc (n.- super-arity) nat-to-int)) + sub-arity (|> arity (n.- super-arity)) + functionS (<| (#ls;Function super-arity (list)) + (#ls;Function sub-arity env) + (#ls;Variable arg-var))] + runtime-bytecode @runtime;generate] + (@eval;eval (@expr;generate (#ls;Call argsS functionS)))) + (macro;run (init-compiler [])) + (case> (#R;Success valueG) + (n.= arg-value (:! Nat valueG)) + + (#R;Error error) + false)))) + )) diff --git a/new-luxc/test/test/luxc/synthesizer/function.lux b/new-luxc/test/test/luxc/synthesizer/function.lux index 7257307dc..6791eceb4 100644 --- a/new-luxc/test/test/luxc/synthesizer/function.lux +++ b/new-luxc/test/test/luxc/synthesizer/function.lux @@ -142,7 +142,7 @@ ($_ seq (test "Can synthesize function application." (|> (synthesizer;synthesize (la;apply argsA funcA)) - (case> (#ls;Call funcS argsS) + (case> (#ls;Call argsS funcS) (and (corresponds? funcA funcS) (list;every? (product;uncurry corresponds?) (list;zip2 argsA argsS))) diff --git a/new-luxc/test/test/luxc/synthesizer/loop.lux b/new-luxc/test/test/luxc/synthesizer/loop.lux index 45b86ede6..849df78d4 100644 --- a/new-luxc/test/test/luxc/synthesizer/loop.lux +++ b/new-luxc/test/test/luxc/synthesizer/loop.lux @@ -157,7 +157,7 @@ (and (n.= arity (list;size _inits)) (not (&&loop;contains-self-reference? _body))) - (#ls;Call (#ls;Function _arity _env _bodyS) argsS) + (#ls;Call argsS (#ls;Function _arity _env _bodyS)) (&&loop;contains-self-reference? _bodyS) _ diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux index d07822069..30fab3878 100644 --- a/new-luxc/test/tests.lux +++ b/new-luxc/test/tests.lux @@ -21,11 +21,10 @@ (generator ["_;G" primitive] ["_;G" structure] ["_;G" case] + ["_;G" function] (procedure ["_;G" common])) )) - ## (luxc (generator ["_;G" function])) ) -## [Program] (program: args (test;run)) |