Got the JS compiler to compile fully.

4 files changed, 70 insertions, 90 deletions

diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
index 6f3d288ef..59557b6de 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
@@ -367,8 +367,8 @@
         Synthesis
         (/////generation.Operation anchor expression directive Any)))
   (do phase.monad
-    [artifact-id (/////generation.learn /////program.name)
-     programG (generate archive programS)]
+    [programG (generate archive programS)
+     artifact-id (/////generation.learn /////program.name)]
     (/////generation.save! false [(%.nat module-id) (%.nat artifact-id)] (program [module-id artifact-id] programG))))
 
 (def: (def::program program)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux
index 6ef13f3a3..fa9307f90 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux
@@ -107,16 +107,21 @@
 
 (def: (io//exit codeG)
   (Unary Expression)
-  (let [@@process (_.var "process")
-        @@window (_.var "window")
-        @@location (_.var "location")]
-    ($_ _.or
-        ($_ _.and
-            (_.not (_.= _.undefined (_.type-of @@process)))
-            (_.the "exit" @@process)
-            (_.do "exit" (list (//runtime.i64//to-number codeG)) @@process))
-        (_.do "close" (list) @@window)
-        (_.do "reload" (list) @@location))))
+  (let [exit-node-js! (let [@@process (_.var "process")]
+                        (|> (_.not (_.= _.undefined (_.type-of @@process)))
+                            (_.and (_.the "exit" @@process))
+                            (_.and (_.do "exit" (list (//runtime.i64//to-number codeG)) @@process))))
+        close-browser-window! (let [@@window (_.var "window")]
+                                (|> (_.not (_.= _.undefined (_.type-of @@window)))
+                                    (_.and (_.the "close" @@window))
+                                    (_.and (_.do "close" (list) @@window))))
+        reload-page! (let [@@location (_.var "location")]
+                       (|> (_.not (_.= _.undefined (_.type-of @@location)))
+                           (_.and (_.the "reload" @@location))
+                           (_.and (_.do "reload" (list) @@location))))]
+    (|> exit-node-js!
+        (_.or close-browser-window!)
+        (_.or reload-page!))))
 
 (def: (io//current-time _)
   (Nullary Expression)
diff --git a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
index 25c7065ca..0105d0ccd 100644
--- a/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
+++ b/stdlib/source/lux/tool/compiler/meta/cache/dependency.lux
@@ -4,7 +4,9 @@
     ["." monad (#+ do)]]
    [control
     ["." try (#+ Try)]
-    ["." function]]
+    ["." state]
+    ["." function
+     ["." memo (#+ Memo)]]]
    [data
     ["." maybe ("#@." functor)]
     ["." text
@@ -37,17 +39,6 @@
   (-> Graph (List Module))
   dictionary.keys)
 
-## (def: (remove module dependency)
-##   (-> Module Graph Graph)
-##   (case (..descendants module dependency)
-##     (#.Some [ancestors descendants])
-##     (list@fold remove
-##                (dictionary.remove module dependency)
-##                (set.to-list descendants))
-
-##     #.None
-##     dependency))
-
 (type: Dependency
   {#module Module
    #imports Ancestry})
@@ -58,62 +49,48 @@
                (dictionary.put module imports graph))
              ..empty))
 
-## (def: #export (prune archive graph)
-##   (-> Archive Graph Graph)
-##   (list@fold (function (_ module graph)
-##                (if (archive.archived? archive module)
-##                  graph
-##                  (..remove module graph)))
-##              graph
-##              (dictionary.keys graph)))
+(def: (ancestry archive)
+  (-> Archive Graph)
+  (let [memo (: (Memo Module Ancestry)
+                (function (_ recur module)
+                  (do {! state.monad}
+                    [#let [parents (case (archive.find module archive)
+                                     (#try.Success [descriptor document])
+                                     (get@ #descriptor.references descriptor)
+                                     
+                                     (#try.Failure error)
+                                     ..fresh)]
+                     ancestors (monad.map ! recur (set.to-list parents))]
+                    (wrap (list@fold set.union parents ancestors)))))
+        ancestry (memo.open memo)]
+    (list@fold (function (_ module memory)
+                 (if (dictionary.contains? module memory)
+                   memory
+                   (let [[memory _] (ancestry [memory module])]
+                     memory)))
+               ..empty
+               (archive.archived archive))))
 
-(def: (dependency? context target source)
+(def: (dependency? ancestry target source)
   (-> Graph Module Module Bit)
-  (let [ancestry (: (-> Module Ancestry)
-                    (function (_ module)
-                      (|> context
-                          (dictionary.get module)
-                          (maybe.default ..fresh))))]
-    (loop [rejected ..fresh
-           candidates (ancestry target)]
-      (if (set.empty? candidates)
-        false
-        (or (set.member? candidates source)
-            (let [rejected (set.union rejected candidates)]
-              (recur rejected
-                     (|> candidates
-                         set.to-list
-                         (list@fold (function (_ candidate new-batch)
-                                      (|> candidate
-                                          ancestry
-                                          (set.difference rejected)
-                                          (set.union new-batch)))
-                                    ..fresh)))))))))
+  (let [target-ancestry (|> ancestry
+                            (dictionary.get target)
+                            (maybe.default ..fresh))]
+    (set.member? target-ancestry source)))
 
 (type: #export Order
   (List [Module [archive.ID [Descriptor (Document .Module)]]]))
 
 (def: #export (load-order key archive)
   (-> (Key .Module) Archive (Try Order))
-  (|> archive
-      archive.archived
-      (monad.map try.monad
-                 (function (_ module)
-                   (do try.monad
-                     [[descriptor document] (archive.find module archive)]
-                     (wrap {#module module
-                            #imports (get@ #descriptor.references descriptor)}))))
-      (:: try.monad map
-          (function (_ dependencies)
-            (let [context (..graph dependencies)]
-              (|> context
-                  ..modules
-                  (list.sort (..dependency? context))
-                  (monad.map try.monad
-                             (function (_ module)
-                               (do try.monad
-                                 [module-id (archive.id module archive)
-                                  [descriptor document] (archive.find module archive)
-                                  document (document.check key document)]
-                                 (wrap [module [module-id [descriptor document]]]))))))))
-      (:: try.monad join)))
+  (let [ancestry (..ancestry archive)]
+    (|> ancestry
+        dictionary.keys
+        (list.sort (..dependency? ancestry))
+        (monad.map try.monad
+                   (function (_ module)
+                     (do try.monad
+                       [module-id (archive.id module archive)
+                        [descriptor document] (archive.find module archive)
+                        document (document.check key document)]
+                       (wrap [module [module-id [descriptor document]]])))))))
diff --git a/stdlib/source/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
index 20756c0cf..88a7ddef0 100644
--- a/stdlib/source/lux/tool/compiler/meta/packager/script.lux
+++ b/stdlib/source/lux/tool/compiler/meta/packager/script.lux
@@ -34,6 +34,8 @@
     ["." archive
      ["." descriptor (#+ Module)]
      ["." artifact]]
+    [cache
+     ["." dependency]]
     ["." io #_
      ["#" archive]]
     [//
@@ -89,18 +91,14 @@
                       monad}
                      {(! (Try (Directory !)))
                       (:assume (!.use (:: file-system directory) [(get@ #static.target static)]))})
-       order (|> archive
-                 archive.archived
-                 (monad.map try.monad (function (_ module)
-                                        (do try.monad
-                                          [[descriptor document] (archive.find module archive)
-                                           module-id (archive.id module archive)]
-                                          (wrap (|> descriptor
-                                                    (get@ #descriptor.registry)
-                                                    artifact.artifacts
-                                                    row.to-list
-                                                    (list@map (|>> (get@ #artifact.id)))
-                                                    [module-id])))))
-                 (:: monad wrap))]
-      (:: @ map (|>> to-code encoding.to-utf8)
-          (monad.fold @ (..write-module monad file-system static sequence) header order)))))
+       order (:: monad wrap (dependency.load-order $.key archive))]
+      (|> order
+          (list@map (function (_ [module [module-id [descriptor document]]])
+                      [module-id
+                       (|> descriptor
+                           (get@ #descriptor.registry)
+                           artifact.artifacts
+                           row.to-list
+                           (list@map (|>> (get@ #artifact.id))))]))
+          (monad.fold @ (..write-module monad file-system static sequence) header)
+          (:: @ map (|>> to-code encoding.to-utf8))))))