Fixes and adaptations for the JavaScript compiler.

7 files changed, 130 insertions, 43 deletions

diff --git a/stdlib/source/lux/tool/compiler/phase/extension/analysis/js.lux b/stdlib/source/lux/tool/compiler/phase/extension/analysis/js.lux
index d8285532b..d04e04ec9 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/js.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/js.lux
@@ -15,7 +15,7 @@
    [target
     ["_" js]]]
   ["." // #_
-   ["#." lux (#+ custom)]
+   ["/" lux (#+ custom)]
    ["/#" //
     ["#." bundle]
     ["/#" // ("#@." monad)
@@ -103,6 +103,57 @@
           (///bundle.install "delete" array::delete)
           )))
 
+(def: object::new
+  Handler
+  (custom
+   [($_ <>.and <c>.any (<c>.tuple (<>.some <c>.any)))
+    (function (_ extension phase [constructorC inputsC])
+      (do ////.monad
+        [constructorA (typeA.with-type Any
+                        (phase constructorC))
+         inputsA (monad.map @ (|>> phase (typeA.with-type Any)) inputsC)
+         _ (typeA.infer .Any)]
+        (wrap (#/////analysis.Extension extension (list& constructorA inputsA)))))]))
+
+(def: object::get
+  Handler
+  (custom
+   [($_ <>.and <c>.text <c>.any)
+    (function (_ extension phase [fieldC objectC])
+      (do ////.monad
+        [objectA (typeA.with-type Any
+                   (phase objectC))
+         _ (typeA.infer .Any)]
+        (wrap (#/////analysis.Extension extension (list (/////analysis.text fieldC)
+                                                        objectA)))))]))
+
+(def: object::do
+  Handler
+  (custom
+   [($_ <>.and <c>.text <c>.any (<c>.tuple (<>.some <c>.any)))
+    (function (_ extension phase [methodC objectC inputsC])
+      (do ////.monad
+        [objectA (typeA.with-type Any
+                   (phase objectC))
+         inputsA (monad.map @ (|>> phase (typeA.with-type Any)) inputsC)
+         _ (typeA.infer .Any)]
+        (wrap (#/////analysis.Extension extension (list& (/////analysis.text methodC)
+                                                         objectA
+                                                         inputsA)))))]))
+
+(def: bundle::object
+  Bundle
+  (<| (///bundle.prefix "object")
+      (|> ///bundle.empty
+          (///bundle.install "new" object::new)
+          (///bundle.install "get" object::get)
+          (///bundle.install "do" object::do)
+          (///bundle.install "null" (/.nullary Any))
+          (///bundle.install "null?" (/.unary Any Bit))
+          (///bundle.install "undefined" (/.nullary Any))
+          (///bundle.install "undefined?" (/.unary Any Bit))
+          )))
+
 (def: js::constant
   Handler
   (custom
@@ -124,23 +175,12 @@
          _ (typeA.infer Any)]
         (wrap (#/////analysis.Extension extension (list& abstractionA inputsA)))))]))
 
-(def: js::undefined?
-  Handler
-  (custom
-   [<c>.any
-    (function (_ extension phase [valueC])
-      (do ////.monad
-        [valueA (typeA.with-type Any
-                  (phase valueC))
-         _ (typeA.infer Bit)]
-        (wrap (#/////analysis.Extension extension (list valueA)))))]))
-
 (def: #export bundle
   Bundle
   (<| (///bundle.prefix "js")
       (|> ///bundle.empty
           (///bundle.install "constant" js::constant)
           (///bundle.install "apply" js::apply)
-          (///bundle.install "undefined?" js::undefined?)
           (dictionary.merge bundle::array)
+          (dictionary.merge bundle::object)
           )))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux
index 843db713d..65c355ecf 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/common-lisp/runtime.lux
@@ -190,8 +190,8 @@
           test-recursion! (_.if sum-flag
                             ## Must iterate.
                             ($_ _.progn
-                                (_.setq sum sum-value)
-                                (_.setq wantedTag (_.- sum-tag wantedTag)))
+                                (_.setq wantedTag (_.- sum-tag wantedTag))
+                                (_.setq sum sum-value))
                             no-match!)]
       (<| (_.progn (_.setq sum-tag (_.nth/2 [(_.int +0) sum])))
           (_.progn (_.setq sum-flag (_.nth/2 [(_.int +1) sum])))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
index c2e0f667e..9e066b88d 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
@@ -220,21 +220,20 @@
     ([/////synthesis.path/seq _.then]
      [/////synthesis.path/alt alternation])))
 
-(def: (pattern-matching stack-init generate pathP)
-  (-> Expression Phase Path (Operation Statement))
+(def: (pattern-matching generate pathP)
+  (-> Phase Path (Operation Statement))
   (do ////.monad
     [pattern-matching! (pattern-matching' generate pathP)]
     (wrap ($_ _.then
               (_.do-while _.false
                           pattern-matching!)
-              (_.statement (//runtime.io//log stack-init))
               (_.throw (_.string case.pattern-matching-error))))))
 
 (def: #export (case generate [valueS pathP])
   (-> Phase [Synthesis Path] (Operation Computation))
   (do ////.monad
     [stack-init (generate valueS)
-     path! (pattern-matching stack-init generate pathP)
+     path! (pattern-matching generate pathP)
      #let [closure (<| (_.closure (list))
                        ($_ _.then
                            (_.declare @temp)
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux
index 3cf3c6c07..bb3d6138d 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/host.lux
@@ -3,6 +3,7 @@
    [abstract
     ["." monad (#+ do)]]
    [control
+    ["." function]
     ["<>" parser
      ["<s>" synthesis (#+ Parser)]]]
    [data
@@ -70,6 +71,55 @@
           (bundle.install "delete" (binary array::delete))
           )))
 
+(def: object::new
+  (..custom
+   [($_ <>.and <s>.any (<>.some <s>.any))
+    (function (_ extension phase [constructorS inputsS])
+      (do /////.monad
+        [constructorG (phase constructorS)
+         inputsG (monad.map @ phase inputsS)]
+        (wrap (_.new constructorG inputsG))))]))
+
+(def: object::get
+  Handler
+  (custom
+   [($_ <>.and <s>.text <s>.any)
+    (function (_ extension phase [fieldS objectS])
+      (do /////.monad
+        [objectG (phase objectS)]
+        (wrap (_.the fieldS objectG))))]))
+
+(def: object::do
+  Handler
+  (custom
+   [($_ <>.and <s>.text <s>.any (<>.some <s>.any))
+    (function (_ extension phase [methodS objectS inputsS])
+      (do /////.monad
+        [objectG (phase objectS)
+         inputsG (monad.map @ phase inputsS)]
+        (wrap (_.do methodS inputsG objectG))))]))
+
+(template [<!> <?> <unit>]
+  [(def: <!> (Nullary Expression) (function.constant <unit>))
+   (def: <?> (Unary Expression) (_.= <unit>))]
+
+  [object::null object::null? _.null]
+  [object::undefined object::undefined? _.undefined]
+  )
+
+(def: object
+  Bundle
+  (<| (bundle.prefix "object")
+      (|> bundle.empty
+          (bundle.install "new" object::new)
+          (bundle.install "get" object::get)
+          (bundle.install "do" object::do)
+          (bundle.install "null" (nullary object::null))
+          (bundle.install "null?" (unary object::null?))
+          (bundle.install "undefined" (nullary object::undefined))
+          (bundle.install "undefined?" (unary object::undefined?))
+          )))
+
 (def: js::constant
   (..custom
    [<s>.text
@@ -87,20 +137,12 @@
          inputsG (monad.map @ phase inputsS)]
         (wrap (_.apply/* abstractionG inputsG))))]))
 
-(def: js::undefined?
-  (..custom
-   [<s>.any
-    (function (_ extension phase valueS)
-      (|> valueS
-          phase
-          (:: /////.monad map (_.= _.undefined))))]))
-
 (def: #export bundle
   Bundle
   (<| (bundle.prefix "js")
       (|> bundle.empty
           (bundle.install "constant" js::constant)
           (bundle.install "apply" js::apply)
-          (bundle.install "undefined?" js::undefined?)
           (dictionary.merge ..array)
+          (dictionary.merge ..object)
           )))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
index 9be09d142..54a15b036 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
@@ -215,19 +215,22 @@
         extact-match! (_.return sum-value)
         test-recursion! (_.if is-last?
                           ## Must recurse.
-                          (_.return (sum//get sum-value (_.- sum-tag wanted-tag) wants-last))
+                          ($_ _.then
+                              (_.set wanted-tag (_.- sum-tag wanted-tag))
+                              (_.set sum sum-value))
                           no-match!)
         extrac-sub-variant! (_.return (..variant (_.- wanted-tag sum-tag) sum-flag sum-value))]
-    (_.cond (list [(_.= wanted-tag sum-tag)
-                   (_.if (_.= wants-last sum-flag)
-                     extact-match!
-                     test-recursion!)]
-                  [(_.< wanted-tag sum-tag)
-                   test-recursion!]
-                  [(_.and (_.> wanted-tag sum-tag)
-                          (_.= ..unit wants-last))
-                   extrac-sub-variant!])
-            no-match!)))
+    (<| (_.while (_.boolean true))
+        (_.cond (list [(_.= wanted-tag sum-tag)
+                       (_.if (_.= wants-last sum-flag)
+                         extact-match!
+                         test-recursion!)]
+                      [(_.< wanted-tag sum-tag)
+                       test-recursion!]
+                      [(_.and (_.> wanted-tag sum-tag)
+                              (_.= ..unit wants-last))
+                       extrac-sub-variant!])
+                no-match!))))
 
 (def: runtime//structure
   Statement
@@ -656,7 +659,10 @@
                        end!)]
                   [(|> print _.type-of (_.= (_.string "undefined")) _.not)
                    ($_ _.then
-                       (_.statement (_.apply/1 print (_.apply/1 (_.var "JSON.stringify") message)))
+                       (_.statement (_.apply/1 print (_.? (_.= (_.string "string")
+                                                               (_.type-of message))
+                                                          message
+                                                          (_.apply/1 (_.var "JSON.stringify") message))))
                        end!)])
             end!)))
 
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux
index a5a22917e..4af1c01ac 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux
@@ -218,7 +218,7 @@
         is-last? (_.= (_.string "") sum-flag)
         test-recursion! (_.if is-last?
                           ## Must recurse.
-                          (_.return (sum//get sum-value (_.- sum-tag wantedTag) wantsLast))
+                          (_.return (sum//get sum-value wantsLast (_.- sum-tag wantedTag)))
                           no-match!)]
     ($_ _.then
         (_.echo (_.string "sum//get ")) (_.echo (_.count/1 sum))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux
index 7d55f0faf..4a617e29c 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/scheme/runtime.lux
@@ -192,8 +192,8 @@
           test-recursion (_.if is-last?
                            ## Must recurse.
                            (sum//get sum-value
-                                     (|> wanted-tag (_.-/2 sum-tag))
-                                     last?)
+                                     last?
+                                     (|> wanted-tag (_.-/2 sum-tag)))
                            no-match)]
       (<| (_.let (list [sum-tag (_.car/1 sum)]
                        [sum-value (_.cdr/1 sum)]))