More JS machinery.

6 files changed, 78 insertions, 49 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 d04e04ec9..0b9c4de2f 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/analysis/js.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/analysis/js.lux
@@ -175,12 +175,24 @@
          _ (typeA.infer Any)]
         (wrap (#/////analysis.Extension extension (list& abstractionA inputsA)))))]))
 
+(def: js::type-of
+  Handler
+  (custom
+   [<c>.any
+    (function (_ extension phase objectC)
+      (do ////.monad
+        [objectA (typeA.with-type Any
+                   (phase objectC))
+         _ (typeA.infer .Text)]
+        (wrap (#/////analysis.Extension extension (list objectA)))))]))
+
 (def: #export bundle
   Bundle
   (<| (///bundle.prefix "js")
       (|> ///bundle.empty
           (///bundle.install "constant" js::constant)
           (///bundle.install "apply" js::apply)
+          (///bundle.install "type-of" js::type-of)
           (dictionary.merge bundle::array)
           (dictionary.merge bundle::object)
           )))
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 9e066b88d..3a5e8f2d3 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/case.lux
@@ -125,7 +125,7 @@
 (def: (alternation pre! post!)
   (-> Statement Statement Statement)
   ($_ _.then
-      (_.do-while _.false
+      (_.do-while (_.boolean false)
                   ($_ _.then
                       ..save-cursor!
                       pre!))
@@ -225,7 +225,7 @@
   (do ////.monad
     [pattern-matching! (pattern-matching' generate pathP)]
     (wrap ($_ _.then
-              (_.do-while _.false
+              (_.do-while (_.boolean false)
                           pattern-matching!)
               (_.throw (_.string case.pattern-matching-error))))))
 
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux
index c9dc64547..f2d22f57b 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/extension/common.lux
@@ -3,21 +3,41 @@
    [host (#+ import:)]
    [abstract
     ["." monad (#+ do)]]
+   [control
+    ["<>" parser
+     ["<s>" synthesis (#+ Parser)]]]
    [data
     ["." product]
+    ["." error]
     [collection
+     ["." list ("#@." functor)]
      ["." dictionary]]]
    [target
-    ["_" js (#+ Expression)]]]
+    ["_" js (#+ Literal Expression Statement)]]]
   ["." /// #_
    ["#." runtime (#+ Operation Phase Handler Bundle)]
    ["#." primitive]
-   [//
+   ["/#" // #_
     [extension (#+ Nullary Unary Binary Trinary
                    nullary unary binary trinary)]
-    [//
-     [extension
-      ["." bundle]]]]])
+    ["/#" //
+     ["." extension
+      ["." bundle]]
+     [//
+      [synthesis (#+ %synthesis)]]]]])
+
+(def: #export (custom [parser handler])
+  (All [s]
+    (-> [(Parser s)
+         (-> Text Phase s (Operation Expression))]
+        Handler))
+  (function (_ extension-name phase input)
+    (case (<s>.run input parser)
+      (#error.Success input')
+      (handler extension-name phase input')
+
+      (#error.Failure error)
+      (/////.throw extension.invalid-syntax [extension-name %synthesis input]))))
 
 ## [Procedures]
 ## [[Bits]]
@@ -99,10 +119,37 @@
       (_.do "getTime" (list))
       ///runtime.i64//from-number))
 
+## TODO: Get rid of this ASAP
+(def: lux::syntax-char-case!
+  (..custom [($_ <>.and
+                 <s>.any
+                 <s>.any
+                 (<>.some (<s>.tuple ($_ <>.and
+                                         (<s>.tuple (<>.many <s>.i64))
+                                         <s>.any))))
+             (function (_ extension-name phase [input else conditionals])
+               (do /////.monad
+                 [inputG (phase input)
+                  elseG (phase else)
+                  conditionalsG (: (Operation (List [(List Literal)
+                                                     Statement]))
+                                   (monad.map @ (function (_ [chars branch])
+                                                  (do @
+                                                    [branchG (phase branch)]
+                                                    (wrap [(list@map (|>> .int _.int) chars)
+                                                           (_.return branchG)])))
+                                              conditionals))]
+                 (wrap (_.apply/* (_.closure (list)
+                                             (_.switch (_.the ///runtime.i64-low-field inputG)
+                                                       conditionalsG
+                                                       (#.Some (_.return elseG))))
+                                  (list)))))]))
+
 ## [Bundles]
 (def: lux-procs
   Bundle
   (|> bundle.empty
+      (bundle.install "syntax char case!" lux::syntax-char-case!)
       (bundle.install "is" (binary (product.uncurry _.=)))
       (bundle.install "try" (unary ///runtime.lux//try))))
 
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 bb3d6138d..423f0a58d 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
@@ -13,7 +13,7 @@
    [target
     ["_" js (#+ Expression)]]]
   ["." // #_
-   ["#." common]
+   ["#." common (#+ custom)]
    ["/#" // #_
     ["#." runtime (#+ Operation Phase Handler Bundle
                       with-vars)]
@@ -23,22 +23,7 @@
                     nullary unary binary trinary)]
      ["/#" //
       ["." extension
-       ["." bundle]]
-      [//
-       [synthesis (#+ %synthesis)]]]]]])
-
-(def: #export (custom [parser handler])
-  (All [s]
-    (-> [(Parser s)
-         (-> Text Phase s (Operation Expression))]
-        Handler))
-  (function (_ extension-name phase input)
-    (case (<s>.run input parser)
-      (#error.Success input')
-      (handler extension-name phase input')
-
-      (#error.Failure error)
-      (/////.throw extension.invalid-syntax [extension-name %synthesis input]))))
+       ["." bundle]]]]]])
 
 (def: array::new
   (Unary Expression)
@@ -72,7 +57,7 @@
           )))
 
 (def: object::new
-  (..custom
+  (custom
    [($_ <>.and <s>.any (<>.some <s>.any))
     (function (_ extension phase [constructorS inputsS])
       (do /////.monad
@@ -121,7 +106,7 @@
           )))
 
 (def: js::constant
-  (..custom
+  (custom
    [<s>.text
     (function (_ extension phase name)
       (do /////.monad
@@ -129,7 +114,7 @@
         (wrap (_.var name))))]))
 
 (def: js::apply
-  (..custom
+  (custom
    [($_ <>.and <s>.any (<>.some <s>.any))
     (function (_ extension phase [abstractionS inputsS])
       (do /////.monad
@@ -143,6 +128,7 @@
       (|> bundle.empty
           (bundle.install "constant" js::constant)
           (bundle.install "apply" js::apply)
+          (bundle.install "type-of" (unary _.type-of))
           (dictionary.merge ..array)
           (dictionary.merge ..object)
           )))
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/primitive.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/primitive.lux
index 6b1e32a36..da1052d28 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/primitive.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/primitive.lux
@@ -10,29 +10,13 @@
   ["." // #_
    ["#." runtime]])
 
-(def: #export bit
-  (-> Bit Computation)
-  _.boolean)
+(def: #export bit _.boolean)
 
 (def: #export (i64 value)
   (-> (I64 Any) Computation)
   (//runtime.i64//new (|> value //runtime.high .int _.i32)
                       (|> value //runtime.low .int _.i32)))
 
-(def: #export f64
-  (-> Frac Computation)
-  (|>> (cond> [(f/= frac.positive-infinity)]
-              [(new> _.positive-infinity [])]
-              
-              [(f/= frac.negative-infinity)]
-              [(new> _.negative-infinity [])]
-              
-              [(f/= frac.not-a-number)]
-              [(new> _.not-a-number [])]
-              
-              ## else
-              [_.number])))
+(def: #export f64 _.number)
 
-(def: #export text
-  (-> Text Computation)
-  _.string)
+(def: #export text _.string)
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 54a15b036..6bd6565dd 100644
--- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux
@@ -240,8 +240,8 @@
       @sum//get
       ))
 
-(def: #export i64-high-field Text "_lux_high")
 (def: #export i64-low-field Text "_lux_low")
+(def: #export i64-high-field Text "_lux_high")
 
 (runtime: (i64//new high low)
   (_.return (_.object (list [..i64-high-field high]
@@ -494,9 +494,9 @@
           (_.define -subject? (negative? subject))
           (_.define -parameter? (negative? parameter))
           (_.cond (list [(_.and -subject? (_.not -parameter?))
-                         (_.return _.true)]
+                         (_.return (_.boolean true))]
                         [(_.and (_.not -subject?) -parameter?)
-                         (_.return _.false)])
+                         (_.return (_.boolean false))])
                   (_.return (negative? (i64//- parameter subject))))))))
 
 (def: (i64//<= param subject)