Ported reference tests.

5 files changed, 121 insertions, 144 deletions

diff --git a/new-luxc/source/test/program.lux b/new-luxc/source/test/program.lux
index 40eb214c2..687c8ca2a 100644
--- a/new-luxc/source/test/program.lux
+++ b/new-luxc/source/test/program.lux
@@ -7,13 +7,16 @@
     ["." io]
     [parser
      [cli (#+ program:)]]]
+   [data
+    ["." error]]
    [math
     ["r" random]]]
   [spec
-   ["." compositor (#+ Runner)
+   ["." compositor (#+ Runner Definer)
     [generation
      ["." primitive]
-     ["." structure]]]]
+     ["." structure]
+     ["." reference]]]]
   {1
    ["." /]}
   ## [test
@@ -21,7 +24,6 @@
   ##   [lang
   ##    [translation
   ##     ## ["_.T" function]
-  ##     ## ["_.T" reference]
   ##     ## ["_.T" case]
   ##     ## ["_.T" common]
   ##     ## ["_.T" jvm]
@@ -36,11 +38,12 @@
   ##     ]]]]
   )
 
-(def: (test runner)
-  (-> Runner Test)
+(def: (test runner definer)
+  (-> Runner Definer Test)
   ($_ _.and
       (primitive.spec runner)
       (structure.spec runner)
+      (reference.spec runner definer)
       ))
 
 (program: args
@@ -49,8 +52,15 @@
       (_.times 100)
       (do r.monad
         [_ (wrap [])
-         #let [platform (io.run /.jvm)]])
-      (..test (compositor.runner platform
-                                 /.bundle
-                                 /.expander
-                                 /.program))))
+         #let [?runner,definer (io.run (do io.monad
+                                         [platform /.jvm]
+                                         (compositor.executors platform
+                                                               /.bundle
+                                                               /.expander
+                                                               /.program)))]]
+        (case ?runner,definer
+          (#error.Success [runner definer])
+          (..test runner definer)
+
+          (#error.Failure error)
+          (_.fail error)))))
diff --git a/new-luxc/test/test/luxc/lang/translation/reference.lux b/new-luxc/test/test/luxc/lang/translation/reference.lux
deleted file mode 100644
index 18205a560..000000000
--- a/new-luxc/test/test/luxc/lang/translation/reference.lux
+++ /dev/null
@@ -1,86 +0,0 @@
-(.module:
-  [lux #*
-   [control
-    [monad (#+ do)]
-    pipe]
-   [data
-    ["." number]]
-   [compiler
-    [default
-     ["." reference]
-     [phase
-      ["." synthesis]]]]
-   [math
-    ["r" random (#+ Random)]]
-   test]
-  [test
-   [luxc
-    ["." common (#+ Runner Definer)]]]
-  [//
-   ["&" function]])
-
-(def: name
-  (Random Name)
-  (let [name-part (r.ascii/upper-alpha 5)]
-    [(r.and name-part name-part)]))
-
-(def: (definitions-spec define)
-  (-> Definer Test)
-  (do r.Monad<Random>
-    [name ..name
-     value &.safe-frac]
-    (test "Can refer to definitions."
-          (|> (define name (synthesis.f64 value))
-              (&.check value)))))
-
-(def: (variables-spec run)
-  (-> Runner Test)
-  (do r.Monad<Random>
-    [register (|> r.nat (:: @ map (n/% 100)))
-     value &.safe-frac]
-    (test "Can refer to local variables/registers."
-          (|> (run (synthesis.branch/let [(synthesis.f64 value)
-                                          register
-                                          (synthesis.variable/local register)]))
-              (&.check value)))))
-
-(def: (references-spec run define)
-  (-> Runner Definer Test)
-  (seq (definitions-spec define)
-       (variables-spec run)))
-
-(context: "[JVM] References."
-  (<| (times 100)
-      (references-spec common.run-jvm common.def-jvm)))
-
-## (context: "[JS] References."
-##   (<| (times 100)
-##       (references-spec common.run-js common.def-js)))
-
-## (context: "[Lua] References."
-##   (<| (times 100)
-##       (references-spec common.run-lua common.def-lua)))
-
-## (context: "[Ruby] References."
-##   (<| (times 100)
-##       (references-spec common.run-ruby common.def-ruby)))
-
-## (context: "[Python] References."
-##   (<| (times 100)
-##       (references-spec common.run-python common.def-python)))
-
-## (context: "[R] References."
-##   (<| (times 100)
-##       (references-spec common.run-r common.def-r)))
-
-## (context: "[Scheme] References."
-##   (<| (times 100)
-##       (references-spec common.run-scheme common.def-scheme)))
-
-## (context: "[Common Lisp] References."
-##   (<| (times 100)
-##       (references-spec common.run-common-lisp common.def-common-lisp)))
-
-## (context: "[PHP] References."
-##   (<| (times 100)
-##       (references-spec common.run-php common.def-php)))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
deleted file mode 100644
index 04362d4d1..000000000
--- a/new-luxc/test/tests.lux
+++ /dev/null
@@ -1,28 +0,0 @@
-(.module:
-  [lux
-   [cli (#+ program:)]
-   ["." test]]
-  [test
-   [luxc
-    [lang
-     [translation
-      ["_.T" primitive]
-      ["_.T" structure]
-      ["_.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]
-      ]]]]
-  )
-
-(program: args
-  (test.run))
diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux
index bb90b0cdf..a62d2efa9 100644
--- a/stdlib/source/spec/compositor.lux
+++ b/stdlib/source/spec/compositor.lux
@@ -8,6 +8,7 @@
     ["." error (#+ Error)]]
    [tool
     [compiler
+     ["." reference]
      ["." synthesis (#+ Synthesis)]
      ["." statement]
      ["." phase
@@ -21,28 +22,11 @@
 (type: #export Runner (-> Text Synthesis (Error Any)))
 (type: #export Definer (-> Name Synthesis (Error Any)))
 
-(def: #export (runner platform bundle expander program)
+(type: #export (Instancer what)
   (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)))))
-    ))
+        (generation.State+ anchor expression statement)
+        what)))
 
 ## (def: #export (runner generate-runtime translate bundle state)
 ##   (-> (Operation Any) Phase Bundle (IO State)
@@ -55,6 +39,16 @@
 ##         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)
+                       (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)
@@ -67,3 +61,34 @@
 ##           (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)
+                       (do phase.monad
+                         [_ runtime
+                          expressionG (phase expressionS)
+                          [host-name host-value host-statement] (generation.define! lux-name expressionG)
+                          _ (generation.learn lux-name host-name)]
+                         (phase (synthesis.constant lux-name))))]
+      (:: host evaluate! "definer" definitionG))))
+
+(def: #export (executors platform bundle expander program)
+  (All [anchor expression statement]
+    (-> (Platform IO anchor expression statement)
+        (Bundle anchor expression statement)
+        Expander
+        (-> expression statement)
+        (IO (Error [Runner Definer]))))
+  (do io.monad
+    [?state (platform.initialize expander platform bundle program)]
+    (wrap (do error.monad
+            [[bundle' state] ?state
+             #let [state (get@ [#statement.generation
+                                #statement.state]
+                               state)]]
+            (wrap [(..runner platform state)
+                   (..definer platform state)])))))
diff --git a/stdlib/source/spec/compositor/generation/reference.lux b/stdlib/source/spec/compositor/generation/reference.lux
new file mode 100644
index 000000000..35de4e8ef
--- /dev/null
+++ b/stdlib/source/spec/compositor/generation/reference.lux
@@ -0,0 +1,56 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    [pipe (#+ case>)]]
+   [data
+    ["." error]]
+   [tool
+    [compiler
+     ["." reference]
+     ["." synthesis]]]
+   [math
+    ["r" random (#+ Random)]]]
+  ["." ///])
+
+(def: name
+  (Random Name)
+  (let [name-part (r.ascii/upper-alpha 5)]
+    [(r.and name-part name-part)]))
+
+(def: (definition define)
+  (-> ///.Definer Test)
+  (do r.monad
+    [name ..name
+     expected r.safe-frac]
+    (_.test "Definitions."
+            (|> (define name (synthesis.f64 expected))
+                (case> (#error.Success actual)
+                       (f/= expected (:coerce Frac actual))
+
+                       (#error.Failure error)
+                       false)))))
+
+(def: (variable run)
+  (-> ///.Runner Test)
+  (do r.monad
+    [register (|> r.nat (:: @ map (n/% 100)))
+     expected r.safe-frac]
+    (_.test "Local variables."
+            (|> (synthesis.branch/let [(synthesis.f64 expected)
+                                       register
+                                       (synthesis.variable/local register)])
+                (run "variable")
+                (case> (#error.Success actual)
+                       (f/= expected (:coerce Frac actual))
+
+                       (#error.Failure error)
+                       false)))))
+
+(def: #export (spec runner definer)
+  (-> ///.Runner ///.Definer Test)
+  ($_ _.and
+      (..definition definer)
+      (..variable runner)))