diff options
Diffstat (limited to 'new-luxc/test/test/luxc/lang/translation/function.lux')
-rw-r--r-- | new-luxc/test/test/luxc/lang/translation/function.lux | 99 |
1 files changed, 99 insertions, 0 deletions
diff --git a/new-luxc/test/test/luxc/lang/translation/function.lux b/new-luxc/test/test/luxc/lang/translation/function.lux new file mode 100644 index 000000000..1896adff3 --- /dev/null +++ b/new-luxc/test/test/luxc/lang/translation/function.lux @@ -0,0 +1,99 @@ +(;module: + lux + (lux [io] + (control [monad #+ do] + pipe) + (data [product] + [maybe] + ["e" error] + (coll ["a" array] + [list "list/" Functor<List>])) + ["r" math/random "r/" Monad<Random>] + [meta] + (meta [code]) + [host] + test) + (luxc (lang ["ls" synthesis] + (translation [";T" expression] + ["@;" 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 (` ("lux function" (~ (code;nat arity)) [] + ((~ (code;int (nat-to-int (n.inc arg)))))))]] + (wrap [arity arg functionS]))) + +(context: "Function." + (<| (times +100) + (do @ + [[arity arg functionS] gen-function + cut-off (|> r;nat (:: @ map (n.% arity))) + args (r;list arity r;nat) + #let [arg-value (maybe;assume (list;nth arg args)) + argsS (list/map code;nat args) + last-arg (n.dec arity) + cut-off (|> cut-off (n.min (n.dec last-arg)))]] + ($_ seq + (test "Can read arguments." + (|> (do meta;Monad<Meta> + [runtime-bytecode @runtime;generate + sampleI (expressionT;generate (` ("lux call" (~ functionS) (~@ argsS))))] + (@eval;eval sampleI)) + (meta;run (init-compiler [])) + (case> (#e;Success valueT) + (n.= arg-value (:! Nat valueT)) + + (#e;Error error) + false))) + (test "Can partially apply functions." + (or (n.= +1 arity) + (|> (do meta;Monad<Meta> + [#let [partial-arity (n.inc cut-off) + preS (list;take partial-arity argsS) + postS (list;drop partial-arity argsS)] + runtime-bytecode @runtime;generate + sampleI (expressionT;generate (` ("lux call" + ("lux call" (~ functionS) (~@ preS)) + (~@ postS))))] + (@eval;eval sampleI)) + (meta;run (init-compiler [])) + (case> (#e;Success valueT) + (n.= arg-value (:! Nat valueT)) + + (#e;Error error) + false)))) + (test "Can read environment." + (or (n.= +1 arity) + (|> (do meta;Monad<Meta> + [#let [env (|> (list;n.range +0 cut-off) + (list/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 (` ("lux function" (~ (code;nat super-arity)) [] + ("lux function" (~ (code;nat sub-arity)) [(~@ (list/map code;int env))] + ((~ (code;int arg-var))))))] + runtime-bytecode @runtime;generate + sampleI (expressionT;generate (` ("lux call" (~ functionS) (~@ argsS))))] + (@eval;eval sampleI)) + (meta;run (init-compiler [])) + (case> (#e;Success valueT) + (n.= arg-value (:! Nat valueT)) + + (#e;Error error) + false)))) + )))) |