- Ported pattern-matching tests.

- Ported function tests.

3 files changed, 192 insertions, 154 deletions

diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux
index a62d2efa9..4967c0f8c 100644
--- a/stdlib/source/spec/compositor.lux
+++ b/stdlib/source/spec/compositor.lux
@@ -28,46 +28,24 @@
         (generation.State+ anchor expression statement)
         what)))
 
-## (def: #export (runner generate-runtime translate bundle state)
-##   (-> (Operation Any) Phase Bundle (IO State)
-##       Runner)
-##   (function (_ valueS)
-##     (|> (do phase.Monad<Operation>
-##           [_ generate-runtime
-##            program (translate valueS)]
-##           (translation.evaluate! "runner" program))
-##         translation.with-buffer
-##         (phase.run [bundle (io.run state)]))))
-
 (def: (runner (^slots [#platform.runtime #platform.phase #platform.host]) state)
   (Instancer Runner)
   (function (_ evaluation-name expressionS)
     (do error.monad
       [expressionG (<| (phase.run state)
+                       generation.with-buffer
                        (do phase.monad
                          [_ runtime]
                          (phase expressionS)))]
       (:: host evaluate! evaluation-name expressionG))))
 
-## (def: #export (definer generate-runtime translate bundle state)
-##   (-> (Operation Any) Phase Bundle (IO State) Definer)
-##   (function (_ lux-name valueS)
-##     (|> (do phase.Monad<Operation>
-##           [_ generate-runtime
-##            valueH (translate valueS)
-##            [host-name host-value] (translation.define! lux-name valueH)
-##            _ (translation.learn lux-name host-name)
-##            program (translate (synthesis.constant lux-name))]
-##           (translation.evaluate! "definer" program))
-##         translation.with-buffer
-##         (phase.run [bundle (io.run state)]))))
-
 (def: (definer (^slots [#platform.runtime #platform.phase #platform.host])
                state)
   (Instancer Definer)
   (function (_ lux-name expressionS)
     (do error.monad
       [definitionG (<| (phase.run state)
+                       generation.with-buffer
                        (do phase.monad
                          [_ runtime
                           expressionG (phase expressionS)
diff --git a/new-luxc/test/test/luxc/lang/translation/case.lux b/stdlib/source/spec/compositor/generation/case.lux
index 0cee2818a..1c398d301 100644
--- a/new-luxc/test/test/luxc/lang/translation/case.lux
+++ b/stdlib/source/spec/compositor/generation/case.lux
@@ -1,52 +1,57 @@
 (.module:
   [lux (#- case)
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
    [control
-    [monad (#+ do)]
-    pipe]
+    [pipe (#+ case>)]]
    [data
-    ["." error]
-    [text ("text/." Equivalence<Text>)
+    ["." error (#+ Error)]
+    ["." text ("#@." equivalence)
      format]
     [collection
-     ["." list ("list/." Functor<List> Fold<List>)]]]
+     ["." list ("#@." fold)]]]
    [math
     ["r" random (#+ Random)]]
-   [compiler
-    [default
+   [tool
+    [compiler
      ["." reference]
+     ["." analysis]
+     ["." synthesis (#+ Path Synthesis)]
      ["." phase
-      ["." analysis]
-      ["." synthesis (#+ Path Synthesis)
-       ["." case]
-       ["." expression]]
-      ["." extension/synthesis]]]]
-   test]
-  [test
-   [luxc
-    ["." common (#+ Runner)]]]
-  [//
-   ["&" function]])
+      ["#/." synthesis
+       ["." case]]
+      ["." extension/synthesis]]]]]
+  ["." ///])
 
 (def: limit Nat 10)
 
 (def: size
   (Random Nat)
-  (|> r.nat (:: r.Monad<Random> map (|>> (n/% ..limit) (n/max 2)))))
+  (|> r.nat (:: r.monad map (|>> (n/% ..limit) (n/max 2)))))
 
 (def: (tail? size idx)
   (-> Nat Nat Bit)
   (n/= (dec size) idx))
 
+(def: #export (verify expected)
+  (-> Frac (Error Any) Bit)
+  (|>> (case> (#error.Success actual)
+              (f/= expected (:coerce Frac actual))
+
+              (#error.Failure error)
+              false)))
+
 (def: case
   (Random [Synthesis Path])
   (<| r.rec (function (_ case))
       (`` ($_ r.either
-              (do r.Monad<Random>
+              (do r.monad
                 [value r.i64]
                 (wrap [(synthesis.i64 value)
                        synthesis.path/pop]))
               (~~ (template [<gen> <synth> <path>]
-                    [(do r.Monad<Random>
+                    [(do r.monad
                        [value <gen>]
                        (wrap [(<synth> value)
                               (<path> value)]))]
@@ -55,7 +60,7 @@
                     [r.i64         synthesis.i64  synthesis.path/i64]
                     [r.frac        synthesis.f64  synthesis.path/f64]
                     [(r.unicode 5) synthesis.text synthesis.path/text]))
-              (do r.Monad<Random>
+              (do r.monad
                 [size ..size
                  idx (|> r.nat (:: @ map (n/% size)))
                  [subS subP] case
@@ -70,7 +75,7 @@
                                    (synthesis.member/left idx))
                                  subP)]]
                 (wrap [caseS caseP]))
-              (do r.Monad<Random>
+              (do r.monad
                 [size ..size
                  idx (|> r.nat (:: @ map (n/% size)))
                  [subS subP] case
@@ -88,42 +93,45 @@
               ))))
 
 (def: (let-spec run)
-  (-> Runner Test)
-  (do r.Monad<Random>
-    [value &.safe-frac]
-    (test "Specialized \"let\"."
-          (|> (run (synthesis.branch/let [(synthesis.f64 value)
-                                          0
-                                          (synthesis.variable/local 0)]))
-              (&.check value)))))
+  (-> ///.Runner Test)
+  (do r.monad
+    [value r.safe-frac]
+    (_.test (%name (name-of synthesis.branch/let))
+            (|> (synthesis.branch/let [(synthesis.f64 value)
+                                       0
+                                       (synthesis.variable/local 0)])
+                (run "let-spec")
+                (verify value)))))
 
 (def: (if-spec run)
-  (-> Runner Test)
-  (do r.Monad<Random>
-    [on-true &.safe-frac
-     on-false (|> &.safe-frac (r.filter (|>> (f/= on-true) not)))
+  (-> ///.Runner Test)
+  (do r.monad
+    [on-true r.safe-frac
+     on-false (|> r.safe-frac (r.filter (|>> (f/= on-true) not)))
      verdict r.bit]
-    (test "Specialized \"if\"."
-          (|> (run (synthesis.branch/if [(synthesis.bit verdict)
-                                         (synthesis.f64 on-true)
-                                         (synthesis.f64 on-false)]))
-              (&.check (if verdict on-true on-false))))))
+    (_.test (%name (name-of synthesis.branch/if))
+            (|> (synthesis.branch/if [(synthesis.bit verdict)
+                                      (synthesis.f64 on-true)
+                                      (synthesis.f64 on-false)])
+                (run "if-spec")
+                (verify (if verdict on-true on-false))))))
 
 (def: (case-spec run)
-  (-> Runner Test)
-  (do r.Monad<Random>
+  (-> ///.Runner Test)
+  (do r.monad
     [[inputS pathS] ..case
-     on-success &.safe-frac
-     on-failure (|> &.safe-frac (r.filter (|>> (f/= on-success) not)))]
-    (test "Case."
-          (|> (run (synthesis.branch/case
-                    [inputS
-                     ($_ synthesis.path/alt
-                         ($_ synthesis.path/seq
-                             pathS
-                             (synthesis.path/then (synthesis.f64 on-success)))
-                         (synthesis.path/then (synthesis.f64 on-failure)))]))
-              (&.check on-success)))))
+     on-success r.safe-frac
+     on-failure (|> r.safe-frac (r.filter (|>> (f/= on-success) not)))]
+    (_.test (%name (name-of synthesis.branch/case))
+            (|> (synthesis.branch/case
+                 [inputS
+                  ($_ synthesis.path/alt
+                      ($_ synthesis.path/seq
+                          pathS
+                          (synthesis.path/then (synthesis.f64 on-success)))
+                      (synthesis.path/then (synthesis.f64 on-failure)))])
+                (run "case-spec")
+                (verify on-success)))))
 
 (def: special-input
   Synthesis
@@ -140,7 +148,7 @@
                   (function (_ head tail)
                     (synthesis.variant [0 #1 (synthesis.tuple (list head tail))])))
         _list_ (: (-> (List Synthesis) Synthesis)
-                  (list/fold _cons_ _nil_))]
+                  (list@fold _cons_ _nil_))]
     (let [__tuple__ (: (-> (List Synthesis) Synthesis)
                        (|>> list.reverse _list_ [9 #0] synthesis.variant _code_))
           __form__ (: (-> (List Synthesis) Synthesis)
@@ -157,7 +165,7 @@
                        (_code_ (synthesis.variant [7 #0 (synthesis.tuple (list (synthesis.text module)
                                                                                (synthesis.text short)))]))))
           __list__ (: (-> (List Synthesis) Synthesis)
-                      (list/fold (function (_ head tail)
+                      (list@fold (function (_ head tail)
                                    (__form__ (list (__tag__ ["" "Cons"]) head tail)))
                                  (__tag__ ["" "Nil"])))
           __apply__ (: (-> Synthesis Synthesis Synthesis)
@@ -222,7 +230,7 @@
       (<| error.assume
           (phase.run [extension/synthesis.bundle
                       synthesis.init])
-          (case.path expression.synthesize
+          (case.path phase/synthesis.phase
                      special-pattern)
           (analysis.bit #1))
       ($_ synthesis.path/seq
@@ -230,87 +238,47 @@
           ## THEN
           (synthesis.path/then (synthesis.bit #0)))))
 
+## TODO: Get rid of this ASAP
 (def: (special-spec run)
-  (-> Runner Test)
-  (do r.Monad<Random>
-    []
-    ($_ seq
-        (test "==="
-              (and (text/= (synthesis.%path special-path)
+  (-> ///.Runner Test)
+  ($_ _.and
+      (_.test "==="
+              (and (text@= (synthesis.%path special-path)
                            (synthesis.%path special-pattern-path))
-                   (:: synthesis.Equivalence<Path> = special-path special-pattern-path)))
-        (test "CODE"
-              (|> (run special-input)
+                   (:: synthesis.path-equivalence = special-path special-pattern-path)))
+      (_.test "CODE"
+              (|> special-input
+                  (run "special-input")
                   (case> (#error.Success output)
-                         (exec (log! (|> output (:coerce (List Code)) (%list %code)))
-                           #1)
+                         true
                          
-                         (#error.Error error)
-                         (exec (log! error)
-                           #0))))
-        (test "PATTERN-MATCHING 0"
-              (|> (run (synthesis.branch/case [special-input
-                                               special-path]))
+                         (#error.Failure error)
+                         false)))
+      (_.test "PATTERN-MATCHING 0"
+              (|> (synthesis.branch/case [special-input
+                                          special-path])
+                  (run "special-path")
                   (case> (#error.Success output)
-                         (exec (log! (format "output 0 = " (%b (:coerce Bit output))))
-                           #1)
+                         true
                          
-                         (#error.Error error)
-                         (exec (log! error)
-                           #0))))
-        (test "PATTERN-MATCHING 1"
-              (|> (run (synthesis.branch/case [special-input
-                                               special-pattern-path]))
+                         (#error.Failure error)
+                         false)))
+      (_.test "PATTERN-MATCHING 1"
+              (|> (synthesis.branch/case [special-input
+                                          special-pattern-path])
+                  (run "special-pattern-path")
                   (case> (#error.Success output)
-                         (exec (log! (format "output 1 = " (%b (:coerce Bit output))))
-                           #1)
+                         true
                          
-                         (#error.Error error)
-                         (exec (log! error)
-                           #0))))
-        )))
-
-(def: (pattern-matching-spec run)
-  (-> Runner Test)
-  ($_ seq
-      (special-spec run)
-      ## (let-spec run)
-      ## (if-spec run)
-      ## (case-spec run)
+                         (#error.Failure error)
+                         false)))
       ))
 
-(context: "[JVM] Pattern-matching."
-  (<| (times 100)
-      (pattern-matching-spec common.run-jvm)))
-
-## (context: "[JS] Pattern-matching."
-##   (<| (times 100)
-##       (pattern-matching-spec common.run-js)))
-
-## (context: "[Lua] Pattern-matching."
-##   (<| (times 100)
-##       (pattern-matching-spec common.run-lua)))
-
-## (context: "[Ruby] Pattern-matching."
-##   (<| (times 100)
-##       (pattern-matching-spec common.run-ruby)))
-
-## (context: "[Python] Function."
-##   (<| (times 100)
-##       (pattern-matching-spec common.run-python)))
-
-## (context: "[R] Pattern-matching."
-##   (<| (times 100)
-##       (pattern-matching-spec common.run-r)))
-
-## (context: "[Scheme] Pattern-matching."
-##   (<| (times 100)
-##       (pattern-matching-spec common.run-scheme)))
-
-## (context: "[Common Lisp] Pattern-matching."
-##   (<| (times 100)
-##       (pattern-matching-spec common.run-common-lisp)))
-
-## (context: "[PHP] Pattern-matching."
-##   (<| (times 100)
-##       (pattern-matching-spec common.run-php)))
+(def: #export (spec run)
+  (-> ///.Runner Test)
+  ($_ _.and
+      (..special-spec run)
+      (..let-spec run)
+      (..if-spec run)
+      (..case-spec run)
+      ))
diff --git a/stdlib/source/spec/compositor/generation/function.lux b/stdlib/source/spec/compositor/generation/function.lux
new file mode 100644
index 000000000..c9f8f5f56
--- /dev/null
+++ b/stdlib/source/spec/compositor/generation/function.lux
@@ -0,0 +1,92 @@
+(.module:
+  [lux (#- function)
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    [pipe (#+ case>)]]
+   [data
+    ["." maybe]
+    ["." error (#+ Error)]
+    [text
+     format]
+    [collection
+     ["." list ("#@." functor)]]]
+   [math
+    ["r" random (#+ Random) ("#@." monad)]]
+   [tool
+    [compiler
+     [analysis (#+ Arity)]
+     ["." reference (#+ Register)]
+     ["." synthesis (#+ Synthesis)]]]]
+  ["." // #_
+   ["#." case]
+   ["/#" //]])
+
+(def: max-arity Arity 10)
+
+(def: arity
+  (Random Arity)
+  (|> r.nat (r@map (|>> (n/% max-arity) (n/max 1)))))
+
+(def: (local arity)
+  (-> Arity (Random Register))
+  (|> r.nat (r@map (|>> (n/% arity) inc))))
+
+(def: function
+  (Random [Arity Register Synthesis])
+  (do r.monad
+    [arity ..arity
+     local (..local arity)]
+    (wrap [arity local
+           (synthesis.function/abstraction
+            {#synthesis.environment (list)
+             #synthesis.arity arity
+             #synthesis.body (synthesis.variable/local local)})])))
+
+(def: #export (spec run)
+  (-> ///.Runner Test)
+  (do r.monad
+    [[arity local functionS] ..function
+     partial-arity (|> r.nat (:: @ map (|>> (n/% arity) (n/max 1))))
+     inputs (r.list arity r.safe-frac)
+     #let [expectation (maybe.assume (list.nth (dec local) inputs))
+           inputsS (list@map (|>> synthesis.f64) inputs)]]
+    ($_ _.and
+        (_.test "Can read arguments."
+                (|> (synthesis.function/apply {#synthesis.function functionS
+                                               #synthesis.arguments inputsS})
+                    (run "with-local")
+                    (//case.verify expectation)))
+        (_.test "Can partially apply functions."
+                (or (n/= 1 arity)
+                    (let [preS (list.take partial-arity inputsS)
+                          postS (list.drop partial-arity inputsS)
+                          partialS (synthesis.function/apply {#synthesis.function functionS
+                                                              #synthesis.arguments preS})]
+                      (|> (synthesis.function/apply {#synthesis.function partialS
+                                                     #synthesis.arguments postS})
+                          (run "partial-application")
+                          (//case.verify expectation)))))
+        (_.test "Can read environment."
+                (or (n/= 1 arity)
+                    (let [environment (|> partial-arity
+                                          (list.n/range 1)
+                                          (list@map (|>> #reference.Local)))
+                          variableS (if (n/<= partial-arity local)
+                                      (synthesis.variable/foreign (dec local))
+                                      (synthesis.variable/local (|> local (n/- partial-arity))))
+                          inner-arity (n/- partial-arity arity)
+                          innerS (synthesis.function/abstraction
+                                  {#synthesis.environment environment
+                                   #synthesis.arity inner-arity
+                                   #synthesis.body variableS})
+                          outerS (synthesis.function/abstraction
+                                  {#synthesis.environment (list)
+                                   #synthesis.arity partial-arity
+                                   #synthesis.body innerS})]
+                      (|> (synthesis.function/apply {#synthesis.function outerS
+                                                     #synthesis.arguments inputsS})
+                          (run "with-foreign")
+                          (//case.verify expectation)))))
+        )))