aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--new-luxc/test/test/luxc/common.lux5
-rw-r--r--new-luxc/test/test/luxc/generator/function.lux96
-rw-r--r--new-luxc/test/test/luxc/synthesizer/function.lux2
-rw-r--r--new-luxc/test/test/luxc/synthesizer/loop.lux2
-rw-r--r--new-luxc/test/tests.lux3
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))