- Added tests for normal JS (non-procedure) behavior.

- Fixed a few bugs.

7 files changed, 490 insertions, 8 deletions

diff --git a/new-luxc/test/test/luxc/common.lux b/new-luxc/test/test/luxc/common.lux
index 5ec4b1259..b9f5af6bd 100644
--- a/new-luxc/test/test/luxc/common.lux
+++ b/new-luxc/test/test/luxc/common.lux
@@ -2,8 +2,13 @@
   lux
   (lux [io])
   (luxc (lang ["&." host]
-              [".L" init])))
+              [".L" init]
+              (translation [js]))))
 
 (def: #export (init-compiler _)
   (-> Top Compiler)
   (initL.compiler (io.run &host.init-host)))
+
+(def: #export (init-js _)
+  (-> Top Compiler)
+  (initL.compiler (io.run js.init)))
diff --git a/new-luxc/test/test/luxc/lang/translation/js/case.lux b/new-luxc/test/test/luxc/lang/translation/js/case.lux
new file mode 100644
index 000000000..ea527b86b
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/translation/js/case.lux
@@ -0,0 +1,107 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data ["e" error]
+             text/format
+             (coll [list]))
+       ["r" math/random "r/" Monad<Random>]
+       [macro]
+       (macro [code])
+       test)
+  (luxc [lang]
+        (lang ["ls" synthesis]
+              (translation (js ["/" case]
+                               [".T" expression]
+                               [".T" eval]
+                               [".T" runtime]))))
+  (test/luxc common))
+
+(def: struct-limit Nat +10)
+
+(def: (tail? size idx)
+  (-> Nat Nat Bool)
+  (n/= (n/dec size) idx))
+
+(def: gen-case
+  (r.Random [ls.Synthesis ls.Path])
+  (<| r.rec (function [gen-case])
+      (`` ($_ r.either
+              (r/wrap [(' []) (' ("lux case pop"))])
+              (~~ (do-template [<gen> <synth>]
+                    [(do r.Monad<Random>
+                       [value <gen>]
+                       (wrap [(<synth> value) (<synth> value)]))]
+
+                    [r.bool code.bool]
+                    [r.nat code.nat]
+                    [r.int code.int]
+                    [r.deg code.deg]
+                    [r.frac code.frac]
+                    [(r.text +5) code.text]))
+              (do r.Monad<Random>
+                [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2))))
+                 idx (|> r.nat (:: @ map (n/% size)))
+                 [subS subP] gen-case
+                 #let [caseS (` [(~+ (list.concat (list (list.repeat idx (' []))
+                                                        (list subS)
+                                                        (list.repeat (|> size n/dec (n/- idx)) (' [])))))])
+                       caseP (` ("lux case seq"
+                                 (~ (if (tail? size idx)
+                                      (` ("lux case tuple right" (~ (code.nat idx))))
+                                      (` ("lux case tuple left" (~ (code.nat idx))))))
+                                 (~ subP)))]]
+                (wrap [caseS caseP]))
+              (do r.Monad<Random>
+                [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max +2))))
+                 idx (|> r.nat (:: @ map (n/% size)))
+                 [subS subP] gen-case
+                 #let [caseS (` ((~ (code.nat idx)) (~ (code.bool (tail? size idx))) (~ subS)))
+                       caseP (` ("lux case seq"
+                                 (~ (if (tail? size idx)
+                                      (` ("lux case variant right" (~ (code.nat idx))))
+                                      (` ("lux case variant left" (~ (code.nat idx))))))
+                                 (~ subP)))]]
+                (wrap [caseS caseP]))
+              ))))
+
+(context: "Pattern-matching."
+  (<| (times +100)
+      (do @
+        [[valueS pathS] gen-case
+         to-bind r.nat]
+        ($_ seq
+            (test "Can translate pattern-matching."
+                  (|> (do macro.Monad<Meta>
+                        [_ runtimeT.translate
+                         sampleJS (/.translate-case expressionT.translate
+                                                    valueS
+                                                    (` ("lux case alt"
+                                                        ("lux case seq" (~ pathS)
+                                                         ("lux case exec" true))
+                                                        ("lux case seq" ("lux case bind" +0)
+                                                         ("lux case exec" false)))))]
+                        (evalT.eval sampleJS))
+                      (lang.with-current-module "")
+                      (macro.run (init-js []))
+                      (case> (#e.Success valueT)
+                             (:! Bool valueT)
+
+                             (#e.Error error)
+                             false)))
+            (test "Can bind values."
+                  (|> (do macro.Monad<Meta>
+                        [_ runtimeT.translate
+                         sampleJS (/.translate-case expressionT.translate
+                                                    (code.nat to-bind)
+                                                    (` ("lux case seq" ("lux case bind" +0)
+                                                        ("lux case exec" (0)))))]
+                        (evalT.eval sampleJS))
+                      (lang.with-current-module "")
+                      (macro.run (init-js []))
+                      (case> (#e.Success valueT)
+                             (n/= to-bind (:! Nat valueT))
+
+                             _
+                             false)))))))
diff --git a/new-luxc/test/test/luxc/lang/translation/js/function.lux b/new-luxc/test/test/luxc/lang/translation/js/function.lux
new file mode 100644
index 000000000..6cb1e64cc
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/translation/js/function.lux
@@ -0,0 +1,103 @@
+(.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>]
+       [macro]
+       (macro [code])
+       [host]
+       test)
+  (luxc [lang]
+        (lang ["ls" synthesis]
+              (translation (js [".T" expression]
+                               [".T" eval]
+                               [".T" runtime]))))
+  (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 macro.Monad<Meta>
+                        [_ runtimeT.translate
+                         sampleJS (expressionT.translate (` ("lux call" (~ functionS) (~+ argsS))))]
+                        (evalT.eval sampleJS))
+                      (lang.with-current-module "")
+                      (macro.run (init-js []))
+                      (case> (#e.Success valueT)
+                             (n/= arg-value (:! Nat valueT))
+
+                             (#e.Error error)
+                             false)))
+            (test "Can partially apply functions."
+                  (or (n/= +1 arity)
+                      (|> (do macro.Monad<Meta>
+                            [#let [partial-arity (n/inc cut-off)
+                                   preS (list.take partial-arity argsS)
+                                   postS (list.drop partial-arity argsS)]
+                             _ runtimeT.translate
+                             sampleJS (expressionT.translate (` ("lux call"
+                                                                 ("lux call" (~ functionS) (~+ preS))
+                                                                 (~+ postS))))]
+                            (evalT.eval sampleJS))
+                          (lang.with-current-module "")
+                          (macro.run (init-js []))
+                          (case> (#e.Success valueT)
+                                 (n/= arg-value (:! Nat valueT))
+
+                                 (#e.Error error)
+                                 false))))
+            (test "Can read environment."
+                  (or (n/= +1 arity)
+                      (|> (do macro.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))))))]
+                             _ runtimeT.translate
+                             sampleJS (expressionT.translate (` ("lux call" (~ functionS) (~+ argsS))))]
+                            (evalT.eval sampleJS))
+                          (lang.with-current-module "")
+                          (macro.run (init-js []))
+                          (case> (#e.Success valueT)
+                                 (n/= arg-value (:! Nat valueT))
+
+                                 (#e.Error error)
+                                 (exec (log! error)
+                                   false)))))
+            ))))
diff --git a/new-luxc/test/test/luxc/lang/translation/js/primitive.lux b/new-luxc/test/test/luxc/lang/translation/js/primitive.lux
new file mode 100644
index 000000000..91828eb3b
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/translation/js/primitive.lux
@@ -0,0 +1,64 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data text/format
+             ["e" error]
+             [bool "bool/" Eq<Bool>]
+             [text "text/" Eq<Text>])
+       ["r" math/random]
+       [macro]
+       (macro [code])
+       test)
+  (luxc [lang]
+        (lang [".L" host]
+              ["ls" synthesis]
+              (translation (js [".T" expression]
+                               [".T" runtime]
+                               [".T" eval]))))
+  (test/luxc common))
+
+(context: "Primitives."
+  (<| (times +100)
+      (do @
+        [%bool% r.bool
+         %nat% r.nat
+         %int% r.int
+         %deg% r.deg
+         %frac% r.frac
+         %text% (r.text +5)]
+        (`` ($_ seq
+                (test "Can translate unit."
+                      (|> (do macro.Monad<Meta>
+                            [_ runtimeT.translate
+                             sampleI (expressionT.translate (' []))]
+                            (evalT.eval sampleI))
+                          (lang.with-current-module "")
+                          (macro.run (init-js []))
+                          (case> (#e.Success valueT)
+                                 (is hostL.unit (:! Text valueT))
+
+                                 _
+                                 false)))
+                (~~ (do-template [<desc> <type> <synthesis> <sample> <test>]
+                      [(test (format "Can translate " <desc> ".")
+                             (|> (do macro.Monad<Meta>
+                                   [_ runtimeT.translate
+                                    sampleI (expressionT.translate (<synthesis> <sample>))]
+                                   (evalT.eval sampleI))
+                                 (lang.with-current-module "")
+                                 (macro.run (init-js []))
+                                 (case> (#e.Success valueT)
+                                        (<test> <sample> (:! <type> valueT))
+
+                                        (#e.Error error)
+                                        false)))]
+
+                      ["bool" Bool code.bool %bool% bool/=]
+                      ["nat"  Nat  code.nat  %nat%  n/=]
+                      ["int"  Int  code.int  %int%  i/=]
+                      ["deg"  Deg  code.deg  %deg%  d/=]
+                      ["frac" Frac code.frac %frac% f/=]
+                      ["text" Text code.text %text% text/=]))
+                )))))
diff --git a/new-luxc/test/test/luxc/lang/translation/js/reference.lux b/new-luxc/test/test/luxc/lang/translation/js/reference.lux
new file mode 100644
index 000000000..80ccd3123
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/translation/js/reference.lux
@@ -0,0 +1,82 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data ["e" error]
+             [text])
+       ["r" math/random]
+       [macro]
+       (macro [code])
+       test)
+  (luxc [lang]
+        (lang ["_." module]
+              ["ls" synthesis]
+              (translation (js [".T" statement]
+                               [".T" eval]
+                               [".T" expression]
+                               [".T" case]
+                               [".T" runtime]))))
+  (test/luxc common))
+
+(def: upper-alpha-ascii
+  (r.Random Nat)
+  (|> r.nat (:: r.Functor<Random> map (|>> (n/% +91) (n/max +65)))))
+
+(def: ident-part
+  (r.Random Text)
+  (|> (r.text' upper-alpha-ascii +5)
+      (r.filter (function [sample]
+                  (not (or (text.contains? "/" sample)
+                           (text.contains? "[" sample)
+                           (text.contains? "]" sample)))))))
+
+(context: "Definitions."
+  (<| (times +100)
+      (do @
+        [module-name ident-part
+         def-name ident-part
+         def-value r.int]
+        ($_ seq
+            (test "Can refer to definitions."
+                  (|> (do macro.Monad<Meta>
+                        [_ runtimeT.translate
+                         valueJS (expressionT.translate (code.int def-value))
+                         _ (_module.with-module +0 module-name
+                             (statementT.translate-def def-name Int valueJS (' {})))
+                         sampleJS (expressionT.translate (code.symbol [module-name def-name]))]
+                        (evalT.eval sampleJS))
+                      (lang.with-current-module "")
+                      (macro.run (init-js []))
+                      (case> (#e.Success valueT)
+                             (i/= def-value (:! Int valueT))
+
+                             (#e.Error error)
+                             (exec (log! error)
+                               false))))
+            ))))
+
+(context: "Variables."
+  (<| (times +100)
+      (do @
+        [module-name (|> (r.text +5) (r.filter (|>> (text.contains? "/") not)))
+         register (|> r.nat (:: @ map (n/% +100)))
+         value r.int]
+        ($_ seq
+            (test "Can refer to local variables/registers."
+                  (|> (do macro.Monad<Meta>
+                        [_ runtimeT.translate
+                         sampleJS (caseT.translate-let expressionT.translate
+                                                       register
+                                                       (code.int value)
+                                                       (` ((~ (code.int (nat-to-int register))))))]
+                        (evalT.eval sampleJS))
+                      (lang.with-current-module "")
+                      (macro.run (init-js []))
+                      (case> (#e.Success outputT)
+                             (i/= value (:! Int outputT))
+
+                             (#e.Error error)
+                             (exec (log! error)
+                               false))))
+            ))))
diff --git a/new-luxc/test/test/luxc/lang/translation/js/structure.lux b/new-luxc/test/test/luxc/lang/translation/js/structure.lux
new file mode 100644
index 000000000..fde45c1cb
--- /dev/null
+++ b/new-luxc/test/test/luxc/lang/translation/js/structure.lux
@@ -0,0 +1,113 @@
+(.module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data ["e" error]
+             [maybe]
+             [bool "bool/" Eq<Bool>]
+             [text "text/" Eq<Text>]
+             text/format
+             (coll [array]
+                   [list]))
+       ["r" math/random "r/" Monad<Random>]
+       [macro]
+       (macro [code])
+       [host]
+       test)
+  (luxc [lang]
+        (lang [".L" host]
+              ["ls" synthesis]
+              (translation (js [".T" expression]
+                               [".T" runtime]
+                               [".T" eval]))))
+  (test/luxc common))
+
+(host.import java/lang/Long)
+
+(def: gen-primitive
+  (r.Random ls.Synthesis)
+  (r.either (r.either (r.either (r/wrap (' []))
+                                (r/map code.bool r.bool))
+                      (r.either (r/map code.nat r.nat)
+                                (r/map code.int r.int)))
+            (r.either (r.either (r/map code.deg r.deg)
+                                (r/map code.frac r.frac))
+                      (r/map code.text (r.text +5)))))
+
+(def: (corresponds? [prediction sample])
+  (-> [ls.Synthesis Top] Bool)
+  (case prediction
+    [_ (#.Tuple #.Nil)]
+    (text/= hostL.unit (:! Text sample))
+
+    (^template [<tag> <type> <test>]
+      [_ (<tag> prediction')]
+      (case (host.try (<test> prediction' (:! <type> sample)))
+        (#e.Success result)
+        result
+
+        (#e.Error error)
+        false))
+    ([#.Bool Bool bool/=]
+     [#.Nat  Nat n/=]
+     [#.Int  Int i/=]
+     [#.Deg  Deg d/=]
+     [#.Frac Frac f/=]
+     [#.Text Text text/=])
+
+    _
+    false
+    ))
+
+(context: "Tuples."
+  (<| (times +100)
+      (do @
+        [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+         members (r.list size gen-primitive)]
+        (test "Can translate tuple."
+              (|> (do macro.Monad<Meta>
+                    [_ runtimeT.translate
+                     sampleI (expressionT.translate (code.tuple members))]
+                    (evalT.eval sampleI))
+                  (lang.with-current-module "")
+                  (macro.run (init-js []))
+                  (case> (#e.Success valueT)
+                         (let [valueT (:! (Array Top) valueT)]
+                           (and (n/= size (array.size valueT))
+                                (list.every? corresponds? (list.zip2 members (array.to-list valueT)))))
+
+                         (#e.Error error)
+                         false))))))
+
+(context: "Variants."
+  (<| (times +100)
+      (do @
+        [num-tags (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
+         tag (|> r.nat (:: @ map (n/% num-tags)))
+         #let [last? (n/= (n/dec num-tags) tag)]
+         member gen-primitive]
+        (test "Can translate variant."
+              (|> (do macro.Monad<Meta>
+                    [_ runtimeT.translate
+                     sampleI (expressionT.translate (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ member))))]
+                    (evalT.eval sampleI))
+                  (lang.with-current-module "")
+                  (macro.run (init-js []))
+                  (case> (#e.Success valueT)
+                         (let [valueT (:! (Array Top) valueT)]
+                           (and (n/= +3 (array.size valueT))
+                                (let [_tag (:! Long (maybe.assume (array.read +0 valueT)))
+                                      _last? (array.read +1 valueT)
+                                      _value (:! Top (maybe.assume (array.read +2 valueT)))]
+                                  (and (n/= tag (|> _tag (:! Nat)))
+                                       (case _last?
+                                         (#.Some _last?')
+                                         (and last? (text/= "" (:! Text _last?')))
+
+                                         #.None
+                                         (not last?))
+                                       (corresponds? [member _value])))))
+
+                         (#e.Error error)
+                         false))))))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index ce15be88f..2404dde73 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -19,13 +19,21 @@
                                ["_.S" function]
                                ["_.S" procedure]
                                ["_.S" loop])
-                    (translation (jvm ["_.T" primitive]
-                                      ["_.T" structure]
-                                      ["_.T" case]
-                                      ["_.T" function]
-                                      ["_.T" reference]
-                                      (procedure ["_.T" common]
-                                                 ["_.T" host]))))
+                    (translation (jvm ["_.T_jvm" primitive]
+                                      ["_.T_jvm" structure]
+                                      ["_.T_jvm" case]
+                                      ["_.T_jvm" function]
+                                      ["_.T_jvm" reference]
+                                      (procedure ["_.T_jvm" common]
+                                                 ["_.T_jvm" host]))
+                                 (js ["_.T_js" primitive]
+                                     ["_.T_js" structure]
+                                     ["_.T_js" case]
+                                     ["_.T_js" function]
+                                     ["_.T_js" reference]
+                                     ## (procedure ["_.T_js" common]
+                                     ##            ["_.T_js" host])
+                                     )))
               )))
 
 (program: args