Now caching the reservations from the archive.

4 files changed, 136 insertions, 39 deletions

diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 1f68030bd..0d31b1f2d 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -98,16 +98,6 @@
       (-> <Platform> (///generation.Operation anchor expression directive Any)))
     (get@ #runtime))
 
-  (def: (ensure-target! platform target host)
-    (All <type-vars>
-      (-> <Platform> Path Host (Promise (Try Any))))
-    (let [system (get@ #&file-system platform)
-          mkdir (: (-> Path (Promise (Try Any)))
-                   (file.get-directory promise.monad system))]
-      (do (try.with promise.monad)
-        [_ (mkdir target)]
-        (mkdir (ioW.archive system host target)))))
-  
   (def: #export (initialize target host module expander host-analysis platform generation-bundle host-directive-bundle program extender)
     (All <type-vars>
       (-> Path
@@ -120,7 +110,7 @@
           (///directive.Bundle anchor expression directive)
           (-> expression directive)
           Extender
-          (Promise (Try [<State+> (Buffer directive)]))))
+          (Promise (Try [<State+> Archive (Buffer directive)]))))
     (let [state (//init.state host
                               module
                               expander
@@ -132,11 +122,13 @@
                               program
                               extender)]
       (do (try.with promise.monad)
-        [_ (..ensure-target! platform target host)]
+        [_ (ioW.enable (get@ #&file-system platform) host target)
+         archive (ioW.thaw (get@ #&file-system platform) host target)]
         (|> (do ///phase.monad
               [_ ..initialize-buffer!
-               _ (..compile-runtime! platform)]
-              ///generation.buffer)
+               _ (..compile-runtime! platform)
+               buffer ///generation.buffer]
+              (wrap [archive buffer]))
             ///directive.lift-generation
             (///phase.run' state)
             promise@wrap)))
@@ -197,11 +189,7 @@
                      compilation (compiler (:coerce ///.Input input))]
                 (do @
                   [#let [dependencies (get@ #///.dependencies compilation)]
-                   archive+state (monad.fold @
-                                             import!
-                                             [archive state]
-                                             (list.filter (bit.complement (archive.archived? archive))
-                                                          dependencies))
+                   archive+state (monad.fold @ import! [archive state] dependencies)
                    #let [## TODO: Inline ASAP
                          [archive state] (:share <type-vars>
                                                  {<Platform>
@@ -220,7 +208,7 @@
                            state
 
                            _
-                           ## TODO: The "///analysis.set-current-module" below shouldn't be necessary. Remove it ASAP.
+                           ## 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)
@@ -249,5 +237,7 @@
                           (promise@wrap (#try.Failure error)))))
 
                     (#try.Failure error)
-                    (promise@wrap (#try.Failure error)))))))))))
+                    (do (try.with promise.monad)
+                      [_ (ioW.freeze (get@ #&file-system platform) host target archive)]
+                      (promise@wrap (#try.Failure error))))))))))))
   )
diff --git a/stdlib/source/lux/tool/compiler/meta.lux b/stdlib/source/lux/tool/compiler/meta.lux
new file mode 100644
index 000000000..dfa57dd4c
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/meta.lux
@@ -0,0 +1,6 @@
+(.module:
+  [lux #*]
+  [//
+   [version (#+ Version)]])
+
+(def: #export version Version "0.1.0")
diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux
index 6db7cc0bb..a0a4b5bf2 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive.lux
@@ -6,14 +6,23 @@
    [control
     ["." try (#+ Try)]
     ["." exception (#+ exception:)]
-    ["." function]]
+    ["." function]
+    ["<>" parser
+     ["<b>" binary (#+ Parser)]]]
    [data
+    [binary (#+ Binary)]
     ["." product]
     ["." name]
-    ["." text]
+    ["." text ("#@." equivalence)
+     ["%" format (#+ format)]]
+    [format
+     ["." binary (#+ Writer)]]
+    [number
+     ["n" nat]]
     [collection
-     ["." list]
-     ["." dictionary (#+ Dictionary)]]]
+     ["." list ("#@." functor fold)]
+     ["." dictionary (#+ Dictionary)]
+     ["." set]]]
    [type
     abstract]
    [world
@@ -22,7 +31,9 @@
    ["." signature (#+ Signature)]
    ["." key (#+ Key)]
    ["." descriptor (#+ Module Descriptor)]
-   ["." document (#+ Document)]])
+   ["." document (#+ Document)]
+   [///
+    [version (#+ Version)]]])
 
 (exception: #export (unknown-document {module Module}
                                       {known-modules (List Module)})
@@ -152,4 +163,71 @@
                     (#try.Success archive')))
                 archive
                 (dictionary.entries (:representation additions))))
+
+  (type: Reservations (List [Module ID]))
+  (type: Frozen [Version Reservations])
+  
+  (def: reader
+    (Parser ..Frozen)
+    (<>.and <b>.text
+            (<b>.list (<>.and <b>.text <b>.nat))))
+
+  (def: writer
+    (Writer ..Frozen)
+    (binary.and binary.text
+                (binary.list (binary.and binary.text binary.nat))))
+  
+  (def: #export (export version archive)
+    (-> Version Archive Binary)
+    (|> archive
+        :representation
+        dictionary.entries
+        (list@map (function (_ [module [id _]])
+                    [module id]))
+        (list.sort (function (_ [moduleL idL] [moduleR idR])
+                     (n.< idL idR)))
+        [version]
+        (binary.run ..writer)))
+
+  (exception: #export (version-mismatch {expected Version} {actual Version})
+    (exception.report
+     ["Expected" (%.text expected)]
+     ["Actual" (%.text actual)]))
+
+  (exception: #export corrupt-data)
+
+  (def: (correct-modules? reservations)
+    (-> Reservations Bit)
+    (n.= (list.size reservations)
+         (|> reservations
+             (list@map product.left)
+             (set.from-list text.hash)
+             set.size)))
+
+  (def: (correct-ids? reservations)
+    (-> Reservations Bit)
+    (n.= (list.size reservations)
+         (|> reservations
+             (list@map product.right)
+             (set.from-list n.hash)
+             set.size)))
+
+  (def: (correct-reservations? reservations)
+    (-> Reservations Bit)
+    (and (correct-modules? reservations)
+         (correct-ids? reservations)))
+
+  (def: #export (import expected binary)
+    (-> Version Binary (Try Archive))
+    (do try.monad
+      [[actual reservations] (<b>.run ..reader binary)
+       _ (exception.assert ..version-mismatch [expected actual]
+                           (text@= expected actual))
+       _ (exception.assert ..corrupt-data []
+                           (correct-reservations? reservations))]
+      (wrap (|> reservations
+                (list@fold (function (_ [module id] archive)
+                             (dictionary.put module [id #.None] archive))
+                           (:representation ..empty))
+                :abstraction))))
   )
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index 2a5713f4f..e71641727 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -15,10 +15,10 @@
     ["." text
      ["%" format (#+ format)]]]
    [world
-    ["." file (#+ Path File System)]]]
+    ["." file (#+ Path File Directory System)]]]
   ["." // (#+ Module)
-   [//
-    ["." archive]]])
+   ["/#" //
+    ["." archive (#+ Archive)]]])
 
 (exception: #export (cannot-prepare {archive Path}
                                     {module-id archive.ID}
@@ -78,14 +78,37 @@
                                 (..artifact system host root module-id name extension)))]
     (!.use (:: artifact over-write) content)))
 
-(def: #export (module system host root document)
-  (-> (System Promise) Host Path Path (Maybe Module))
-  (case (text.split-with (..archive system host root) document)
-    (#.Some ["" post])
-    (let [raw (text.replace-all (:: system separator) "/" post)]
-      (if (text.starts-with? "/" raw)
-        (text.clip' 1 raw)
-        (#.Some raw)))
+(def: #export (enable system host root)
+  (-> (System Promise) Host Path (Promise (Try Any)))
+  (do (try.with promise.monad)
+    [_ (: (Promise (Try (Directory Promise)))
+          (file.get-directory promise.monad system root))
+     _ (: (Promise (Try (Directory Promise)))
+          (file.get-directory promise.monad system (..archive system host root)))]
+    (wrap [])))
+
+(def: (general-descriptor system host root)
+  (-> (System Promise) Host Path Path)
+  (format (..archive system host root)
+          (:: system separator)
+          "general-descriptor"))
+
+(def: #export (freeze system host root archive)
+  (-> (System Promise) Host Path Archive (Promise (Try Any)))
+  (do (try.with promise.monad)
+    [file (: (Promise (Try (File Promise)))
+             (file.get-file promise.monad system (..general-descriptor system host root)))]
+    (!.use (:: file over-write) (archive.export ///.version archive))))
 
-    _
-    #.None))
+(def: #export (thaw system host root)
+  (-> (System Promise) Host Path (Promise (Try Archive)))
+  (do promise.monad
+    [file (!.use (:: system file) (..general-descriptor system host root))]
+    (case file
+      (#try.Success file)
+      (do (try.with promise.monad)
+        [binary (!.use (:: file content) [])]
+        (:: promise.monad wrap (archive.import ///.version binary)))
+      
+      (#try.Failure error)
+      (wrap (#try.Success archive.empty)))))