Various bug fixes for JS compilation.

5 files changed, 228 insertions, 203 deletions

diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 0b811a7b7..f162cc157 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -372,73 +372,73 @@
                                    (:assume
                                     ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list)))})]
         (do (try.with promise.monad)
-          [#let [parallel-compiler (..parallel
-                                    context
-                                    (function (_ import! module-id [archive state] module)
-                                      (do (try.with promise.monad)
-                                        [#let [state (..set-current-module module state)]
-                                         input (context.read (get@ #&file-system platform)
-                                                             import
-                                                             compilation-sources
-                                                             (get@ #static.host-module-extension static)
-                                                             module)]
-                                        (loop [[archive state] [archive state]
-                                               compilation (base-compiler (:coerce ///.Input input))
-                                               all-dependencies (: (List Module)
-                                                                   (list))]
-                                          (do {@ (try.with promise.monad)}
-                                            [#let [new-dependencies (get@ #///.dependencies compilation)
-                                                   all-dependencies (list@compose new-dependencies all-dependencies)
-                                                   continue! (:share [<type-vars>]
-                                                                     {<Platform>
-                                                                      platform}
-                                                                     {(-> <Context> (///.Compilation <State+> .Module Any) (List Module)
-                                                                          (Action [Archive <State+>]))
-                                                                      (:assume
-                                                                       recur)})]
-                                             [archive state] (case new-dependencies
-                                                               #.Nil
-                                                               (wrap [archive state])
+          [#let [compiler (..parallel
+                           context
+                           (function (_ import! module-id [archive state] module)
+                             (do (try.with promise.monad)
+                               [#let [state (..set-current-module module state)]
+                                input (context.read (get@ #&file-system platform)
+                                                    import
+                                                    compilation-sources
+                                                    (get@ #static.host-module-extension static)
+                                                    module)]
+                               (loop [[archive state] [archive state]
+                                      compilation (base-compiler (:coerce ///.Input input))
+                                      all-dependencies (: (List Module)
+                                                          (list))]
+                                 (do {@ (try.with promise.monad)}
+                                   [#let [new-dependencies (get@ #///.dependencies compilation)
+                                          all-dependencies (list@compose new-dependencies all-dependencies)
+                                          continue! (:share [<type-vars>]
+                                                            {<Platform>
+                                                             platform}
+                                                            {(-> <Context> (///.Compilation <State+> .Module Any) (List Module)
+                                                                 (Action [Archive <State+>]))
+                                                             (:assume
+                                                              recur)})]
+                                    [archive state] (case new-dependencies
+                                                      #.Nil
+                                                      (wrap [archive state])
 
-                                                               (#.Cons _)
-                                                               (do @
-                                                                 [archive,document+ (|> new-dependencies
-                                                                                        (list@map import!)
-                                                                                        (monad.seq ..monad))
-                                                                  #let [archive (|> archive,document+
-                                                                                    (list@map product.left)
-                                                                                    (list@fold archive.merge archive))]]
-                                                                 (wrap [archive (try.assume
-                                                                                 (..updated-state archive state))])))]
-                                            (case ((get@ #///.process compilation)
-                                                   ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP.
-                                                   ## TODO: The context shouldn't need to be re-set either.
-                                                   (|> (///directive.set-current-module module)
-                                                       (///phase.run' state)
-                                                       try.assume
-                                                       product.left)
-                                                   archive)
-                                              (#try.Success [state more|done])
-                                              (case more|done
-                                                (#.Left more)
-                                                (continue! [archive state] more all-dependencies)
+                                                      (#.Cons _)
+                                                      (do @
+                                                        [archive,document+ (|> new-dependencies
+                                                                               (list@map import!)
+                                                                               (monad.seq ..monad))
+                                                         #let [archive (|> archive,document+
+                                                                           (list@map product.left)
+                                                                           (list@fold archive.merge archive))]]
+                                                        (wrap [archive (try.assume
+                                                                        (..updated-state archive state))])))]
+                                   (case ((get@ #///.process compilation)
+                                          ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP.
+                                          ## TODO: The context shouldn't need to be re-set either.
+                                          (|> (///directive.set-current-module module)
+                                              (///phase.run' state)
+                                              try.assume
+                                              product.left)
+                                          archive)
+                                     (#try.Success [state more|done])
+                                     (case more|done
+                                       (#.Left more)
+                                       (continue! [archive state] more all-dependencies)
 
-                                                (#.Right [[descriptor document] output])
-                                                (do (try.with promise.monad)
-                                                  [#let [_ (log! (..module-compilation-log state))
-                                                         descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]
-                                                   _ (..cache-module static platform module-id [[descriptor document] output])]
-                                                  (case (archive.add module [descriptor document] archive)
-                                                    (#try.Success archive)
-                                                    (wrap [archive
-                                                           (..with-reset-log state)])
-                                                    
-                                                    (#try.Failure error)
-                                                    (promise@wrap (#try.Failure error)))))
+                                       (#.Right [[descriptor document] output])
+                                       (do (try.with promise.monad)
+                                         [#let [_ (log! (..module-compilation-log state))
+                                                descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]
+                                          _ (..cache-module static platform module-id [[descriptor document] output])]
+                                         (case (archive.add module [descriptor document] archive)
+                                           (#try.Success archive)
+                                           (wrap [archive
+                                                  (..with-reset-log state)])
+                                           
+                                           (#try.Failure error)
+                                           (promise@wrap (#try.Failure error)))))
 
-                                              (#try.Failure error)
-                                              (do (try.with promise.monad)
-                                                [_ (ioW.freeze (get@ #&file-system platform) static archive)]
-                                                (promise@wrap (#try.Failure error)))))))))]]
-          (parallel-compiler compilation-module))))
+                                     (#try.Failure error)
+                                     (do (try.with promise.monad)
+                                       [_ (ioW.freeze (get@ #&file-system platform) static archive)]
+                                       (promise@wrap (#try.Failure error)))))))))]]
+          (compiler compilation-module))))
     ))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
index 1dc91abe2..700411c5f 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/case.lux
@@ -3,7 +3,7 @@
    [abstract
     ["." monad (#+ do)]]
    [control
-    ["ex" exception (#+ exception:)]]
+    ["." exception (#+ exception:)]]
    [data
     ["." maybe]
     ["." text]
@@ -138,125 +138,145 @@
           ..restore-cursor!
           post!)))
 
-(def: (pattern-matching' generate archive)
-  (-> Phase Archive
-      (-> Path (Operation Statement)))
-  (function (recur pathP)
-    (.case pathP
-      (#/////synthesis.Then bodyS)
-      (do ///////phase.monad
-        [body! (generate archive bodyS)]
-        (wrap (_.return body!)))
-
-      #/////synthesis.Pop
-      (///////phase@wrap pop-cursor!)
-
-      (#/////synthesis.Bind register)
-      (///////phase@wrap (_.define (..register register) ..peek-cursor))
-
-      (#/////synthesis.Bit-Fork when thenP elseP)
-      (do {@ ///////phase.monad}
-        [then! (recur thenP)
-         else! (.case elseP
-                 (#.Some elseP)
-                 (recur elseP)
-
-                 #.None
-                 (wrap ..fail-pm!))]
-        (wrap (.if when
-                (_.if ..peek-cursor
-                  then!
-                  else!)
-                (_.if ..peek-cursor
-                  else!
-                  then!))))
-
-      (#/////synthesis.I64-Fork cons)
-      (do {@ ///////phase.monad}
-        [clauses (monad.map @ (function (_ [match then])
-                                (do @
-                                  [then! (recur then)]
-                                  (wrap [(//runtime.i64//= (//primitive.i64 (.int match))
-                                                           ..peek-cursor)
-                                         then!])))
-                            (#.Cons cons))]
-        (wrap (_.cond clauses ..fail-pm!)))
-
-      (^template [<tag> <format> <type>]
-        (<tag> cons)
-        (do {@ ///////phase.monad}
-          [cases (monad.map @ (function (_ [match then])
-                                (:: @ map (|>> [(list (<format> match))]) (recur then)))
-                            (#.Cons cons))]
-          (wrap (_.switch ..peek-cursor
-                          cases
-                          (#.Some ..fail-pm!)))))
-      ([#/////synthesis.F64-Fork //primitive.f64 Frac]
-       [#/////synthesis.Text-Fork //primitive.text Text])
-
-      (^template [<complex> <simple> <choice>]
-        (^ (<complex> idx))
-        (///////phase@wrap (<choice> false idx))
-
-        (^ (<simple> idx nextP))
-        (|> nextP
-            recur
-            (:: ///////phase.monad map (_.then (<choice> true idx)))))
-      ([/////synthesis.side/left  /////synthesis.simple-left-side  ..left-choice]
-       [/////synthesis.side/right /////synthesis.simple-right-side ..right-choice])
-
-      (^ (/////synthesis.member/left 0))
-      (///////phase@wrap (push-cursor! (_.at (_.i32 +0) ..peek-cursor)))
-
-      ## Extra optimization
+(def: (optimized-pattern-matching recur generate archive pathP)
+  (-> (-> Path (Operation Statement)) Phase Archive
+      (-> Path (Operation (Maybe Statement))))
+  (.case pathP
+    (^template [<simple> <choice>]
+      (^ (<simple> idx nextP))
+      (|> nextP
+          recur
+          (:: ///////phase.monad map (|>> (_.then (<choice> true idx)) #.Some))))
+    ([/////synthesis.simple-left-side  ..left-choice]
+     [/////synthesis.simple-right-side ..right-choice])
+
+    (^ (/////synthesis.member/left 0))
+    (///////phase@wrap (#.Some (push-cursor! (_.at (_.i32 +0) ..peek-cursor))))
+
+    ## Extra optimization
+    (^ (/////synthesis.path/seq
+        (/////synthesis.member/left 0)
+        (/////synthesis.!bind-top register thenP)))
+    (do ///////phase.monad
+      [then! (recur thenP)]
+      (wrap (#.Some ($_ _.then
+                        (_.define (..register register) (_.at (_.i32 +0) ..peek-cursor))
+                        then!))))
+
+    ## Extra optimization
+    (^template [<pm> <getter>]
       (^ (/////synthesis.path/seq
-          (/////synthesis.member/left 0)
+          (<pm> lefts)
           (/////synthesis.!bind-top register thenP)))
       (do ///////phase.monad
         [then! (recur thenP)]
-        (///////phase@wrap ($_ _.then
-                               (_.define (..register register) (_.at (_.i32 +0) ..peek-cursor))
-                               then!)))
-
-      (^template [<pm> <getter>]
-        (^ (<pm> lefts))
-        (///////phase@wrap (push-cursor! (<getter> (_.i32 (.int lefts)) ..peek-cursor)))
-
-        ## Extra optimization
-        (^ (/////synthesis.path/seq
-            (<pm> lefts)
-            (/////synthesis.!bind-top register thenP)))
-        (do ///////phase.monad
-          [then! (recur thenP)]
-          (///////phase@wrap ($_ _.then
-                                 (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek-cursor))
-                                 then!))))
-      ([/////synthesis.member/left  //runtime.tuple//left]
-       [/////synthesis.member/right //runtime.tuple//right])
-
-      (^ (/////synthesis.!bind-top register thenP))
+        (wrap (#.Some ($_ _.then
+                          (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek-cursor))
+                          then!)))))
+    ([/////synthesis.member/left  //runtime.tuple//left]
+     [/////synthesis.member/right //runtime.tuple//right])
+
+    (^ (/////synthesis.!bind-top register thenP))
+    (do ///////phase.monad
+      [then! (recur thenP)]
+      (wrap (#.Some ($_ _.then
+                        (_.define (..register register) ..peek-and-pop-cursor)
+                        then!))))
+
+    (^ (/////synthesis.!multi-pop nextP))
+    (.let [[extra-pops nextP'] (////synthesis/case.count-pops nextP)]
       (do ///////phase.monad
-        [then! (recur thenP)]
-        (///////phase@wrap ($_ _.then
-                               (_.define (..register register) ..peek-and-pop-cursor)
-                               then!)))
-
-      (^ (/////synthesis.!multi-pop nextP))
-      (.let [[extra-pops nextP'] (////synthesis/case.count-pops nextP)]
-        (do ///////phase.monad
-          [next! (recur nextP')]
-          (///////phase@wrap ($_ _.then
-                                 (multi-pop-cursor! (n.+ 2 extra-pops))
-                                 next!))))
-
-      (^template [<tag> <combinator>]
-        (^ (<tag> leftP rightP))
-        (do ///////phase.monad
-          [left! (recur leftP)
-           right! (recur rightP)]
-          (wrap (<combinator> left! right!))))
-      ([/////synthesis.path/seq _.then]
-       [/////synthesis.path/alt alternation]))))
+        [next! (recur nextP')]
+        (wrap (#.Some ($_ _.then
+                          (multi-pop-cursor! (n.+ 2 extra-pops))
+                          next!)))))
+
+    _
+    (///////phase@wrap #.None)))
+
+(def: (pattern-matching' generate archive)
+  (-> Phase Archive
+      (-> Path (Operation Statement)))
+  (function (recur pathP)
+    (do ///////phase.monad
+      [outcome (optimized-pattern-matching recur generate archive pathP)]
+      (.case outcome
+        (#.Some outcome)
+        (wrap outcome)
+
+        #.None
+        (.case pathP
+          #/////synthesis.Pop
+          (///////phase@wrap pop-cursor!)
+
+          (#/////synthesis.Bind register)
+          (///////phase@wrap (_.define (..register register) ..peek-cursor))
+
+          (#/////synthesis.Bit-Fork when thenP elseP)
+          (do {@ ///////phase.monad}
+            [then! (recur thenP)
+             else! (.case elseP
+                     (#.Some elseP)
+                     (recur elseP)
+
+                     #.None
+                     (wrap ..fail-pm!))]
+            (wrap (.if when
+                    (_.if ..peek-cursor
+                      then!
+                      else!)
+                    (_.if ..peek-cursor
+                      else!
+                      then!))))
+
+          (#/////synthesis.I64-Fork cons)
+          (do {@ ///////phase.monad}
+            [clauses (monad.map @ (function (_ [match then])
+                                    (do @
+                                      [then! (recur then)]
+                                      (wrap [(//runtime.i64//= (//primitive.i64 (.int match))
+                                                               ..peek-cursor)
+                                             then!])))
+                                (#.Cons cons))]
+            (wrap (_.cond clauses ..fail-pm!)))
+
+          (^template [<tag> <format> <type>]
+            (<tag> cons)
+            (do {@ ///////phase.monad}
+              [cases (monad.map @ (function (_ [match then])
+                                    (:: @ map (|>> [(list (<format> match))]) (recur then)))
+                                (#.Cons cons))]
+              (wrap (_.switch ..peek-cursor
+                              cases
+                              (#.Some ..fail-pm!)))))
+          ([#/////synthesis.F64-Fork //primitive.f64 Frac]
+           [#/////synthesis.Text-Fork //primitive.text Text])
+
+          (#/////synthesis.Then bodyS)
+          (do ///////phase.monad
+            [body! (generate archive bodyS)]
+            (wrap (_.return body!)))
+
+          (^template [<complex> <choice>]
+            (^ (<complex> idx))
+            (///////phase@wrap (<choice> false idx)))
+          ([/////synthesis.side/left  ..left-choice]
+           [/////synthesis.side/right ..right-choice])
+
+          (^template [<pm> <getter>]
+            (^ (<pm> lefts))
+            (///////phase@wrap (push-cursor! (<getter> (_.i32 (.int lefts)) ..peek-cursor))))
+          ([/////synthesis.member/left  //runtime.tuple//left]
+           [/////synthesis.member/right //runtime.tuple//right])
+
+          (^template [<tag> <combinator>]
+            (^ (<tag> leftP rightP))
+            (do ///////phase.monad
+              [left! (recur leftP)
+               right! (recur rightP)]
+              (wrap (<combinator> left! right!))))
+          ([/////synthesis.path/seq _.then]
+           [/////synthesis.path/alt ..alternation]))))))
 
 (def: (pattern-matching generate archive pathP)
   (-> Phase Archive Path (Operation Statement))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux
index 01312ba83..096993996 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js/loop.lux
@@ -24,16 +24,23 @@
 
 (def: #export (scope generate archive [start initsS+ bodyS])
   (Generator (Scope Synthesis))
-  (do {@ ///////phase.monad}
-    [initsO+ (monad.map @ (generate archive) initsS+)
-     bodyO (/////generation.with-anchor @scope
-             (generate archive bodyS))
-     #let [closure (_.function @scope
-                     (|> initsS+
-                         list.enumerate
-                         (list@map (|>> product.left (n.+ start) //case.register)))
-                     (_.return bodyO))]]
-    (wrap (_.apply/* closure initsO+))))
+  (case initsS+
+    ## function/false/non-independent loop
+    #.Nil
+    (generate archive bodyS)
+
+    ## true loop
+    _
+    (do {@ ///////phase.monad}
+      [initsO+ (monad.map @ (generate archive) initsS+)
+       bodyO (/////generation.with-anchor @scope
+               (generate archive bodyS))
+       #let [closure (_.function @scope
+                       (|> initsS+
+                           list.enumerate
+                           (list@map (|>> product.left (n.+ start) //case.register)))
+                       (_.return bodyO))]]
+      (wrap (_.apply/* closure initsO+)))))
 
 (def: #export (recur generate archive argsS+)
   (Generator (List Synthesis))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux
index aa9d8f5a5..8fc87bcc2 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/function.lux
@@ -59,19 +59,17 @@
                 [locals /.locals]
                 (wrap (|> functionS
                           (//loop.optimization true locals argsS)
-                          (maybe@map (: (-> Synthesis Synthesis)
-                                        (function (_ synthesis)
-                                          (case synthesis
-                                            (^ (<| /.loop/scope [start inits]
-                                                   /.loop/scope [start' inits']
-                                                   output))
+                          (maybe@map (: (-> [Nat (List Synthesis) Synthesis] Synthesis)
+                                        (function (_ [start inits iteration])
+                                          (case iteration
+                                            (^ (/.loop/scope [start' inits' output]))
                                             (if (and (n.= start start')
                                                      (list.empty? inits'))
                                               (/.loop/scope [start inits output])
-                                              synthesis)
+                                              (/.loop/scope [start inits iteration]))
 
                                             _
-                                            synthesis))))
+                                            (/.loop/scope [start inits iteration])))))
                           (maybe.default <apply>))))
               (wrap <apply>))
 
@@ -274,10 +272,10 @@
     (wrap (if currying?
             (/.function/abstraction abstraction)
             (case (//loop.optimization false 1 (list) abstraction)
-              (#.Some loop-body)
+              (#.Some [startL initsL bodyL])
               (/.function/abstraction {#/.environment environment
                                        #/.arity (get@ #/.arity abstraction)
-                                       #/.body loop-body})
+                                       #/.body (/.loop/scope [startL initsL bodyL])})
               
               #.None
               (/.function/abstraction abstraction))))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux
index ecd1889cb..e2e4e4db5 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis/loop.lux
@@ -198,7 +198,7 @@
           (maybe@map (|>> [name] #/.Extension))))))
 
 (def: #export (optimization true-loop? offset inits functionS)
-  (-> Bit Register (List Synthesis) Abstraction (Maybe Synthesis))
+  (-> Bit Register (List Synthesis) Abstraction (Maybe [Register (List Synthesis) Synthesis]))
   (|> (get@ #/.body functionS)
       (body-optimization true-loop? offset (get@ #/.environment functionS) (get@ #/.arity functionS))
-      (maybe@map (|>> [offset inits] /.loop/scope))))
+      (maybe@map (|>> [offset inits]))))