WIP: Turning compiler tests into a re-usable specification.

10 files changed, 273 insertions, 217 deletions

diff --git a/.gitignore b/.gitignore
index e83967470..a5e435077 100644
--- a/.gitignore
+++ b/.gitignore
@@ -19,29 +19,35 @@ pom.xml.asc
 /new-luxc/source/lux.lux
 /new-luxc/source/lux
 /new-luxc/source/program
+/new-luxc/source/spec
 
 /lux-js/target
 /lux-js/source/lux.lux
 /lux-js/source/lux
 /lux-js/source/program
+/lux-js/source/spec
 
 /lux-python/target
 /lux-python/source/lux.lux
 /lux-python/source/lux
 /lux-python/source/program
+/lux-python/source/spec
 
 /lux-lua/target
 /lux-lua/source/lux.lux
 /lux-lua/source/lux
 /lux-lua/source/program
+/lux-lua/source/spec
 
 /lux-ruby/target
 /lux-ruby/source/lux.lux
 /lux-ruby/source/lux
 /lux-ruby/source/program
+/lux-ruby/source/spec
 
 /lux-php/target
 /lux-php/source/lux.lux
 /lux-php/source/lux
 /lux-php/source/program
+/lux-php/source/spec
 
diff --git a/new-luxc/project.clj b/new-luxc/project.clj
index 1b858000d..f3864bf06 100644
--- a/new-luxc/project.clj
+++ b/new-luxc/project.clj
@@ -31,7 +31,6 @@
   
   :manifest {"lux" ~version}
   :source-paths ["source"]
-  :test-paths ["test"]
   :lux {:program "program"
-        :test "tests"}
+        :test "test/program"}
   )
diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux
index db8716697..0fea18acd 100644
--- a/new-luxc/source/luxc/lang/translation/jvm/function.lux
+++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux
@@ -300,7 +300,7 @@
                               (generation.with-anchor [@begin 1]
                                 (translate bodyS)))
      [functionD instanceI] (with-function @begin function-class env arity bodyI)
-     _ (generation.save! ["" function-class]
+     _ (generation.save! true ["" function-class]
                          [function-class
                           (def.class #$.V1_6 #$.Public $.finalC
                                      function-class (list)
diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux
index 0936b51dd..de4445d5f 100644
--- a/new-luxc/source/program.lux
+++ b/new-luxc/source/program.lux
@@ -57,7 +57,7 @@
       (@.array-write 0 _object-class)
       (@.array-write 1 _object-class)))
 
-(def: (expander macro inputs lux)
+(def: #export (expander macro inputs lux)
   Expander
   (do error.monad
     [apply-method (|> macro
@@ -72,7 +72,7 @@
                   (@.array-write 1 (:coerce java/lang/Object lux)))
               apply-method))))
 
-(def: jvm
+(def: #export jvm
   (IO (Platform IO _.Anchor _.Inst _.Definition))
   (do io.monad
     [host jvm.host]
@@ -82,7 +82,7 @@
            #platform.phase expression.translate
            #platform.runtime runtime.translate})))
 
-(def: (program programI)
+(def: #export (program programI)
   (-> _.Inst _.Definition)
   (let [nilI runtime.noneI
         num-inputsI (|>> ($i.ALOAD 0) $i.ARRAYLENGTH)
@@ -147,10 +147,13 @@
                                     $i.POP
                                     $i.RETURN))))]))
 
+(def: #export bundle
+  (dictionary.merge common.bundle
+                    host.bundle))
+
 (program: [{service /cli.service}]
   (/.compiler ..expander
               ..jvm
-              (dictionary.merge common.bundle
-                                host.bundle)
+              ..bundle
               ..program
               service))
diff --git a/new-luxc/source/test/program.lux b/new-luxc/source/test/program.lux
new file mode 100644
index 000000000..40eb214c2
--- /dev/null
+++ b/new-luxc/source/test/program.lux
@@ -0,0 +1,56 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." io]
+    [parser
+     [cli (#+ program:)]]]
+   [math
+    ["r" random]]]
+  [spec
+   ["." compositor (#+ Runner)
+    [generation
+     ["." primitive]
+     ["." structure]]]]
+  {1
+   ["." /]}
+  ## [test
+  ##  [luxc
+  ##   [lang
+  ##    [translation
+  ##     ## ["_.T" function]
+  ##     ## ["_.T" reference]
+  ##     ## ["_.T" case]
+  ##     ## ["_.T" common]
+  ##     ## ["_.T" jvm]
+  ##     ## ["_.T" js]
+  ##     ## ["_.T" lua]
+  ##     ## ["_.T" ruby]
+  ##     ## ["_.T" python]
+  ##     ## ["_.T" r]
+  ##     ## ["_.T" scheme]
+  ##     ## ["_.T" common-lisp]
+  ##     ## ["_.T" php]
+  ##     ]]]]
+  )
+
+(def: (test runner)
+  (-> Runner Test)
+  ($_ _.and
+      (primitive.spec runner)
+      (structure.spec runner)
+      ))
+
+(program: args
+  (<| io.io
+      _.run!
+      (_.times 100)
+      (do r.monad
+        [_ (wrap [])
+         #let [platform (io.run /.jvm)]])
+      (..test (compositor.runner platform
+                                 /.bundle
+                                 /.expander
+                                 /.program))))
diff --git a/new-luxc/test/test/luxc/lang/translation/primitive.lux b/new-luxc/test/test/luxc/lang/translation/primitive.lux
deleted file mode 100644
index f3c6c8fc3..000000000
--- a/new-luxc/test/test/luxc/lang/translation/primitive.lux
+++ /dev/null
@@ -1,87 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    ["." error]
-    [bit ("bit/." Equivalence<Bit>)]
-    ["." number]
-    [text ("text/." Equivalence<Text>)
-     format]]
-   [math
-    ["r" random]]
-   [compiler
-    [default
-     [phase
-      ["." synthesis]]]]
-   test]
-  [test
-   [luxc
-    common]])
-
-(def: (f/=' reference subject)
-  (-> Frac Frac Bit)
-  (or (f/= reference subject)
-      (and (number.not-a-number? reference)
-           (number.not-a-number? subject))))
-
-(def: (spec run)
-  (-> Runner Test)
-  (do r.Monad<Random>
-    [|bit| r.bit
-     |i64| r.i64
-     |f64| r.frac
-     |text| (r.ascii 5)]
-    (`` ($_ seq
-            (~~ (template [<desc> <type> <synthesis> <sample> <test>]
-                  [(test (format "Can translate " <desc> ".")
-                         (|> (run (<synthesis> <sample>))
-                             (case> (#error.Success valueT)
-                                    (<test> <sample> (:coerce <type> valueT))
-
-                                    (#error.Error error)
-                                    false)))]
-
-                  ["bit"  Bit  synthesis.bit  |bit|  bit/=]
-                  ["int"  Int  synthesis.i64  |i64|  i/=]
-                  ["frac" Frac synthesis.f64  |f64|  f/=']
-                  ["text" Text synthesis.text |text| text/=]
-                  ))
-            ))))
-
-(context: "[JVM] Primitives."
-  (<| (times 100)
-      (spec run-jvm)))
-
-## (context: "[JS] Primitives."
-##   (<| (times 100)
-##       (spec run-js)))
-
-## (context: "[Lua] Primitives."
-##   (<| (times 100)
-##       (spec run-lua)))
-
-## (context: "[Ruby] Primitives."
-##   (<| (times 100)
-##       (spec run-ruby)))
-
-## (context: "[Python] Primitives."
-##   (<| (times 100)
-##       (spec run-python)))
-
-## (context: "[R] Primitives."
-##   (<| (times 100)
-##       (spec run-r)))
-
-## (context: "[Scheme] Primitives."
-##   (<| (times 100)
-##       (spec run-scheme)))
-
-## (context: "[Common Lisp] Primitives."
-##   (<| (times 100)
-##       (spec run-common-lisp)))
-
-## (context: "[PHP] Primitives."
-##   (<| (times 100)
-##       (spec run-php)))
diff --git a/new-luxc/test/test/luxc/lang/translation/structure.lux b/new-luxc/test/test/luxc/lang/translation/structure.lux
deleted file mode 100644
index c92b132e2..000000000
--- a/new-luxc/test/test/luxc/lang/translation/structure.lux
+++ /dev/null
@@ -1,122 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    ["." error]
-    ["." maybe]
-    [text ("text/." Equivalence<Text>)
-     format]
-    [collection
-     ["." array (#+ Array)]
-     ["." list ("list/." Functor<List>)]]]
-   [math
-    ["r" random]]
-   ["." host (#+ import:)]
-   [compiler
-    [default
-     [phase
-      ["." analysis]
-      ["." synthesis]]]]
-   test]
-  [test
-   [luxc
-    common]])
-
-(import: java/lang/Integer)
-
-(def: (tuples-spec run)
-  (-> Runner Test)
-  (do r.Monad<Random>
-    [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
-     tuple-in (r.list size r.i64)]
-    (test "Can translate tuple."
-          (|> (run (synthesis.tuple (list/map (|>> synthesis.i64) tuple-in)))
-              (case> (#error.Success tuple-out)
-                     (let [tuple-out (:coerce (Array Any) tuple-out)]
-                       (and (n/= size (array.size tuple-out))
-                            (list.every? (function (_ [left right])
-                                           (i/= left (:coerce Int right)))
-                                         (list.zip2 tuple-in (array.to-list tuple-out)))))
-
-                     (#error.Error error)
-                     (exec (log! error)
-                       #0))))))
-
-(def: (variants-spec run)
-  (-> Runner Test)
-  (do r.Monad<Random>
-    [num-tags (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
-     tag-in (|> r.nat (:: @ map (n/% num-tags)))
-     #let [last?-in (|> num-tags dec (n/= tag-in))]
-     value-in r.i64]
-    (test "Can translate variant."
-          (|> (run (synthesis.variant {#analysis.lefts (if last?-in
-                                                         (dec tag-in)
-                                                         tag-in)
-                                       #analysis.right? last?-in
-                                       #analysis.value (synthesis.i64 value-in)}))
-              (case> (#error.Success valueT)
-                     (let [valueT (:coerce (Array Any) valueT)]
-                       (and (n/= 3 (array.size valueT))
-                            (let [tag-out (:coerce Integer (maybe.assume (array.read 0 valueT)))
-                                  last?-out (array.read 1 valueT)
-                                  value-out (:coerce Any (maybe.assume (array.read 2 valueT)))
-                                  same-tag? (|> tag-out host.int-to-long (:coerce Nat) (n/= tag-in))
-                                  same-flag? (case last?-out
-                                               (#.Some last?-out')
-                                               (and last?-in (text/= "" (:coerce Text last?-out')))
-
-                                               #.None
-                                               (not last?-in))
-                                  same-value? (|> value-out (:coerce Int) (i/= value-in))]
-                              (and same-tag?
-                                   same-flag?
-                                   same-value?))))
-
-                     (#error.Error error)
-                     (exec (log! error)
-                       #0))))))
-
-(def: (structure-spec run)
-  (-> Runner Test)
-  ($_ seq
-      (tuples-spec run)
-      (variants-spec run)))
-
-(context: "[JVM] Structures."
-  (<| (times 100)
-      (structure-spec run-jvm)))
-
-## (context: "[JS] Structures."
-##   (<| (times 100)
-##       (structure-spec run-js)))
-
-## (context: "[Lua] Structures."
-##   (<| (times 100)
-##       (structure-spec run-lua)))
-
-## (context: "[Ruby] Structures."
-##   (<| (times 100)
-##       (structure-spec run-ruby)))
-
-## (context: "[Python] Structures."
-##   (<| (times 100)
-##       (structure-spec run-python)))
-
-## (context: "[R] Structures."
-##   (<| (times 100)
-##       (structure-spec run-r)))
-
-## (context: "[Scheme] Structures."
-##   (<| (times 100)
-##       (structure-spec run-scheme)))
-
-## (context: "[Common Lisp] Structures."
-##   (<| (times 100)
-##       (structure-spec run-common-lisp)))
-
-## (context: "[PHP] Structures."
-##   (<| (times 100)
-##       (structure-spec run-php)))
diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux
new file mode 100644
index 000000000..bb90b0cdf
--- /dev/null
+++ b/stdlib/source/spec/compositor.lux
@@ -0,0 +1,69 @@
+(.module:
+  [lux #*
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." io (#+ IO)]]
+   [data
+    ["." error (#+ Error)]]
+   [tool
+    [compiler
+     ["." synthesis (#+ Synthesis)]
+     ["." statement]
+     ["." phase
+      ["." macro (#+ Expander)]
+      ["." generation (#+ Operation Bundle)]
+      [extension
+       ["." bundle]]]
+     [default
+      ["." platform (#+ Platform)]]]]])
+
+(type: #export Runner (-> Text Synthesis (Error Any)))
+(type: #export Definer (-> Name Synthesis (Error Any)))
+
+(def: #export (runner platform bundle expander program)
+  (All [anchor expression statement]
+    (-> (Platform IO anchor expression statement)
+        (Bundle anchor expression statement)
+        Expander
+        (-> expression statement)
+        Runner))
+  (function (_ evaluation-name expressionS)
+    (io.run
+     (do io.monad
+       [?state (platform.initialize expander platform bundle program)]
+       (wrap (do error.monad
+               [[bundle' state] ?state
+                expressionG (<| (phase.run (get@ [#statement.generation
+                                                  #statement.state]
+                                                 state))
+                                (do phase.monad
+                                  [_ (get@ #platform.runtime platform)]
+                                  ((get@ #platform.phase platform) expressionS)))]
+               (:: (get@ #platform.host platform) evaluate! evaluation-name
+                   expressionG)))))
+    ))
+
+## (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: #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)]))))
diff --git a/stdlib/source/spec/compositor/generation/primitive.lux b/stdlib/source/spec/compositor/generation/primitive.lux
new file mode 100644
index 000000000..788085836
--- /dev/null
+++ b/stdlib/source/spec/compositor/generation/primitive.lux
@@ -0,0 +1,47 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    [pipe (#+ case>)]]
+   [data
+    ["." error]
+    ["." bit ("#@." equivalence)]
+    [number
+     ["." frac]]
+    ["." text ("#@." equivalence)
+     format]]
+   [math
+    ["r" random]]
+   [tool
+    [compiler
+     ["." synthesis]]]]
+  ["." ///])
+
+(def: (f/=' reference subject)
+  (-> Frac Frac Bit)
+  (or (f/= reference subject)
+      (and (frac.not-a-number? reference)
+           (frac.not-a-number? subject))))
+
+(def: #export (spec run)
+  (-> ///.Runner Test)
+  (`` ($_ _.and
+          (~~ (template [<evaluation-name> <synthesis> <gen> <test>]
+                [(do r.monad
+                   [expected <gen>]
+                   (_.test (%name (name-of <synthesis>))
+                           (|> (run <evaluation-name> (<synthesis> expected))
+                               (case> (#error.Success actual)
+                                      (<test> expected (:assume actual))
+
+                                      (#error.Failure error)
+                                      false))))]
+
+                ["bit" synthesis.bit  r.bit  bit@=]
+                ["i64" synthesis.i64  r.i64  "lux i64 ="]
+                ["f64" synthesis.f64  r.frac  f/=']
+                ["text" synthesis.text (r.ascii 5) text@=]
+                ))
+          )))
diff --git a/stdlib/source/spec/compositor/generation/structure.lux b/stdlib/source/spec/compositor/generation/structure.lux
new file mode 100644
index 000000000..00334596c
--- /dev/null
+++ b/stdlib/source/spec/compositor/generation/structure.lux
@@ -0,0 +1,85 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    [pipe (#+ case>)]]
+   [data
+    ["." error]
+    ["." maybe]
+    ["." text ("#@." equivalence)
+     format]
+    [collection
+     ["." array (#+ Array)]
+     ["." list ("#@." functor)]]]
+   [math
+    ["r" random]]
+   ["." host (#+ import:)]
+   [tool
+    [compiler
+     ["." analysis]
+     ["." synthesis]]]]
+  ["." ///])
+
+(import: #long java/lang/Integer)
+
+(def: (variant run)
+  (-> ///.Runner Test)
+  (do r.monad
+    [num-tags (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
+     tag-in (|> r.nat (:: @ map (n/% num-tags)))
+     #let [last?-in (|> num-tags dec (n/= tag-in))]
+     value-in r.i64]
+    (_.test (%name (name-of synthesis.variant))
+            (|> (synthesis.variant {#analysis.lefts (if last?-in
+                                                      (dec tag-in)
+                                                      tag-in)
+                                    #analysis.right? last?-in
+                                    #analysis.value (synthesis.i64 value-in)})
+                (run "variant")
+                (case> (#error.Success valueT)
+                       (let [valueT (:coerce (Array Any) valueT)]
+                         (and (n/= 3 (array.size valueT))
+                              (let [tag-out (:coerce java/lang/Integer (maybe.assume (array.read 0 valueT)))
+                                    last?-out (array.read 1 valueT)
+                                    value-out (:coerce Any (maybe.assume (array.read 2 valueT)))
+                                    same-tag? (|> tag-out host.int-to-long (:coerce Nat) (n/= tag-in))
+                                    same-flag? (case last?-out
+                                                 (#.Some last?-out')
+                                                 (and last?-in (text@= "" (:coerce Text last?-out')))
+
+                                                 #.None
+                                                 (not last?-in))
+                                    same-value? (|> value-out (:coerce Int) (i/= value-in))]
+                                (and same-tag?
+                                     same-flag?
+                                     same-value?))))
+
+                       (#error.Failure error)
+                       false)))))
+
+(def: (tuple run)
+  (-> ///.Runner Test)
+  (do r.monad
+    [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
+     tuple-in (r.list size r.i64)]
+    (_.test (%name (name-of synthesis.tuple))
+            (|> (synthesis.tuple (list@map (|>> synthesis.i64) tuple-in))
+                (run "tuple")
+                (case> (#error.Success tuple-out)
+                       (let [tuple-out (:coerce (Array Any) tuple-out)]
+                         (and (n/= size (array.size tuple-out))
+                              (list.every? (function (_ [left right])
+                                             (i/= left (:coerce Int right)))
+                                           (list.zip2 tuple-in (array.to-list tuple-out)))))
+
+                       (#error.Failure error)
+                       false)))))
+
+(def: #export (spec runner)
+  (-> ///.Runner Test)
+  ($_ _.and
+      (..variant runner)
+      (..tuple runner)
+      ))