Fixed bugs while parsing modules' cached data.

5 files changed, 83 insertions, 37 deletions

diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 9a4c6f20c..58a2d4b32 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -7,16 +7,17 @@
    [control
     ["." try (#+ Try)]
     [concurrency
-     ["." promise (#+ Promise) ("#@." monad)]]]
+     ["." promise (#+ Promise) ("#@." monad)]]
+    ["<>" parser
+     ["<b>" binary (#+ Parser)]]]
    [data
-    [binary (#+ Binary)]
+    ["." binary (#+ Binary)]
     ["." bit]
     ["." product]
     ["." text
      ["%" format (#+ format)]]
     [collection
-     ["." list]
-     ["." row ("#@." functor)]]
+     ["." row]]
     [format
      ["_" binary (#+ Writer)]]]
    [world
@@ -75,6 +76,11 @@
     (_.and descriptor.writer
            (document.writer $.writer)))
 
+  (def: parser
+    (Parser [Descriptor (Document .Module)])
+    (<>.and descriptor.parser
+            (document.parser $.parser)))
+
   (def: (cache-module platform host target-dir module-file-name module-id extension [[descriptor document] output])
     (All <type-vars>
       (-> <Platform> Host Path Path archive.ID Text [[Descriptor (Document Any)] Output]
@@ -93,6 +99,22 @@
                       (document.check //init.key document))]
         (ioW.cache system host target-dir module-id
                    (_.run ..writer [descriptor document])))))
+
+  (def: (load-cache system host target-dir archive)
+    (All <type-vars>
+      (-> (file.System Promise) Host Path Archive (Promise (Try Archive))))
+    (do (try.with promise.monad)
+      [all-loaded-caches (|> (archive.reservations archive)
+                             (monad.map @ (function (_ [module-name module-id])
+                                            (do @
+                                              [data (ioW.load system host target-dir module-id)
+                                               payload (promise@wrap (<b>.run ..parser data))]
+                                              (wrap [module-name payload])))))]
+      (promise@wrap (monad.fold try.monad
+                                (function (_ [module descriptor+document] archive)
+                                  (archive.add module descriptor+document archive))
+                                archive
+                                all-loaded-caches))))
   
   ## TODO: Inline ASAP
   (def: initialize-buffer!
@@ -131,7 +153,8 @@
                               extender)]
       (do (try.with promise.monad)
         [_ (ioW.enable (get@ #&file-system platform) host target)
-         archive (ioW.thaw (get@ #&file-system platform) host target)]
+         archive (ioW.thaw (get@ #&file-system platform) host target)
+         archive (load-cache (get@ #&file-system platform) host target archive)]
         (|> (do ///phase.monad
               [_ ..initialize-buffer!
                _ (..compile-runtime! platform)
diff --git a/stdlib/source/lux/tool/compiler/language/lux.lux b/stdlib/source/lux/tool/compiler/language/lux.lux
index ed3b0ed9b..f823c1eaf 100644
--- a/stdlib/source/lux/tool/compiler/language/lux.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux.lux
@@ -15,9 +15,11 @@
                       ($_ _.and _.bit _.type _.code _.any))
         name (: (Writer Name)
                 (_.and _.text _.text))
-        alias name
+        alias (: (Writer Alias)
+                 (_.and _.text _.text))
         global (: (Writer Global)
-                  (_.or alias definition))
+                  (_.or alias
+                        definition))
         tag (: (Writer [Nat (List Name) Bit Type])
                ($_ _.and
                    _.nat
@@ -53,9 +55,11 @@
                       ($_ <>.and <b>.bit <b>.type <b>.code <b>.any))
         name (: (Parser Name)
                 (<>.and <b>.text <b>.text))
-        alias name
+        alias (: (Parser Alias)
+                 (<>.and <b>.text <b>.text))
         global (: (Parser Global)
-                  (<>.or alias definition))
+                  (<b>.or alias
+                          definition))
         tag (: (Parser [Nat (List Name) Bit Type])
                ($_ <>.and
                    <b>.nat
diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux
index a0a4b5bf2..49358065b 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive.lux
@@ -149,6 +149,18 @@
                               (#.Some _) (#.Some module)
                               #.None #.None)))))
 
+  (def: #export reserved
+    (-> Archive (List Module))
+    (|>> :representation
+         dictionary.keys))
+
+  (def: #export reservations
+    (-> Archive (List [Module ID]))
+    (|>> :representation
+         dictionary.entries
+         (list@map (function (_ [module [id _]])
+                     [module id]))))
+
   (def: #export (merge additions archive)
     (-> Archive Archive (Try Archive))
     (monad.fold try.monad
@@ -164,8 +176,8 @@
                 archive
                 (dictionary.entries (:representation additions))))
 
-  (type: Reservations (List [Module ID]))
-  (type: Frozen [Version Reservations])
+  (type: Reservation [Module ID])
+  (type: Frozen [Version (List Reservation)])
   
   (def: reader
     (Parser ..Frozen)
@@ -182,10 +194,10 @@
     (|> archive
         :representation
         dictionary.entries
-        (list@map (function (_ [module [id _]])
-                    [module id]))
-        (list.sort (function (_ [moduleL idL] [moduleR idR])
-                     (n.< idL idR)))
+        (list.search-all (function (_ [module [id descriptor+document]])
+                           (case descriptor+document
+                             (#.Some _) (#.Some [module id])
+                             #.None #.None)))
         [version]
         (binary.run ..writer)))
 
@@ -197,7 +209,7 @@
   (exception: #export corrupt-data)
 
   (def: (correct-modules? reservations)
-    (-> Reservations Bit)
+    (-> (List Reservation) Bit)
     (n.= (list.size reservations)
          (|> reservations
              (list@map product.left)
@@ -205,7 +217,7 @@
              set.size)))
 
   (def: (correct-ids? reservations)
-    (-> Reservations Bit)
+    (-> (List Reservation) Bit)
     (n.= (list.size reservations)
          (|> reservations
              (list@map product.right)
@@ -213,7 +225,7 @@
              set.size)))
 
   (def: (correct-reservations? reservations)
-    (-> Reservations Bit)
+    (-> (List Reservation) Bit)
     (and (correct-modules? reservations)
          (correct-ids? reservations)))
 
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
index 7f3e1654d..28f01bbcb 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
@@ -9,8 +9,8 @@
     ["." product]
     ["." text]
     [collection
-     ["." list ("#@." functor fold)]
-     ["." row (#+ Row)]
+     ["." list]
+     ["." row (#+ Row) ("#@." functor fold)]
      ["." dictionary (#+ Dictionary)]]
     [format
      ["." binary (#+ Writer)]]]
@@ -75,23 +75,22 @@
 
   (def: #export writer
     (Writer Registry)
-    (let [writer|artifacts (binary.list (binary.maybe binary.text))]
+    (let [writer|artifacts (binary.row/64 (binary.maybe binary.text))]
       (|>> :representation
            (get@ #artifacts)
-           row.to-list
-           (list@map (get@ #name))
+           (row@map (get@ #name))
            writer|artifacts)))
 
   (def: #export parser
     (Parser Registry)
-    (|> (<b>.list (<b>.maybe <b>.text))
-        (:: <>.monad map (list@fold (function (_ artifact registry)
-                                      (product.right
-                                       (case artifact
-                                         #.None
-                                         (..resource registry)
-                                         
-                                         (#.Some name)
-                                         (..definition name registry))))
-                                    ..empty))))
+    (|> (<b>.row/64 (<b>.maybe <b>.text))
+        (:: <>.monad map (row@fold (function (_ artifact registry)
+                                     (product.right
+                                      (case artifact
+                                        #.None
+                                        (..resource registry)
+                                        
+                                        (#.Some name)
+                                        (..definition name registry))))
+                                   ..empty))))
   )
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index ee7af993b..a40c8427f 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -122,7 +122,15 @@
 (def: #export (cache system host root module-id content)
   (-> (System Promise) Host Path archive.ID Binary (Promise (Try Any)))
   (do (try.with promise.monad)
-    [artifact (: (Promise (Try (File Promise)))
-                 (file.get-file promise.monad system
-                                (..module-descriptor system host root module-id)))]
-    (!.use (:: artifact over-write) content)))
+    [file (: (Promise (Try (File Promise)))
+             (file.get-file promise.monad system
+                            (..module-descriptor system host root module-id)))]
+    (!.use (:: file over-write) content)))
+
+(def: #export (load system host root module-id)
+  (-> (System Promise) Host Path archive.ID (Promise (Try Binary)))
+  (do (try.with promise.monad)
+    [file (: (Promise (Try (File Promise)))
+             (file.get-file promise.monad system
+                            (..module-descriptor system host root module-id)))]
+    (!.use (:: file content) [])))