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))))
+            ))))