Including runtime machinery in the cache.

4 files changed, 107 insertions, 66 deletions

diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 7707a154c..86a1dea87 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -15,7 +15,8 @@
     ["." text
      ["%" format (#+ format)]]
     [collection
-     ["." row]]
+     ["." row]
+     ["." set]]
     [format
      ["_" binary (#+ Writer)]]]
    [world
@@ -27,15 +28,19 @@
     [language
      [lux
       ["$" /]
+      ["#." version]
       ["." syntax]
       ["#." analysis
        [macro (#+ Expander)]]
       ["#." generation (#+ Buffer)]
       ["#." directive]
       [phase
-       [extension (#+ Extender)]]]]
+       [extension (#+ Extender)]
+       [analysis
+        ["." module]]]]]
     [meta
      ["." archive (#+ Archive)
+      ["." artifact (#+ Registry)]
       ["." descriptor (#+ Descriptor Module)]
       ["." document (#+ Document)]]
      [io
@@ -49,7 +54,7 @@
   {#&file-system (file.System Promise)
    #host (///generation.Host expression directive)
    #phase (///generation.Phase anchor expression directive)
-   #runtime (///generation.Operation anchor expression directive Any)
+   #runtime (///generation.Operation anchor expression directive [Registry Output])
    #write (-> directive Binary)})
 
 ## TODO: Get rid of this
@@ -71,9 +76,9 @@
     (_.and descriptor.writer
            (document.writer $.writer)))
 
-  (def: (cache-module platform host target-dir module-file-name module-id extension [[descriptor document] output])
+  (def: (cache-module platform host target-dir module-id extension [[descriptor document] output])
     (All <type-vars>
-      (-> <Platform> Host Path Path archive.ID Text [[Descriptor (Document Any)] Output]
+      (-> <Platform> Host Path archive.ID Text [[Descriptor (Document Any)] Output]
           (Promise (Try Any))))
     (let [system (get@ #&file-system platform)
           write-artifact! (: (-> [Text Binary] (Action Any))
@@ -97,10 +102,41 @@
     (///generation.set-buffer ///generation.empty-buffer))
 
   ## TODO: Inline ASAP
-  (def: compile-runtime!
+  (def: (compile-runtime! platform)
     (All <type-vars>
-      (-> <Platform> (///generation.Operation anchor expression directive Any)))
-    (get@ #runtime))
+      (-> <Platform> (///generation.Operation anchor expression directive [Registry Output])))
+    (do ///phase.monad
+      [_ ..initialize-buffer!]
+      (get@ #runtime platform)))
+
+  (def: (runtime-descriptor registry)
+    (-> Registry Descriptor)
+    {#descriptor.hash 0
+     #descriptor.name archive.runtime-module
+     #descriptor.file ""
+     #descriptor.references (set.new text.hash)
+     #descriptor.state #.Compiled
+     #descriptor.registry registry})
+  
+  (def: runtime-document
+    (Document .Module)
+    (document.write $.key (module.new 0)))
+
+  (def: (process-runtime analysis-state archive platform)
+    (All <type-vars>
+      (-> .Lux Archive <Platform>
+          (///directive.Operation anchor expression directive
+                                  [Archive [[Descriptor (Document .Module)] Output]])))
+    (do ///phase.monad
+      [_ (///directive.lift-analysis
+          (///analysis.install analysis-state))
+       [registry payload] (///directive.lift-generation
+                           (..compile-runtime! platform))
+       #let [descriptor,document [(..runtime-descriptor registry) ..runtime-document]]
+       archive (///phase.lift (do try.monad
+                                [[_ archive] (archive.reserve archive.runtime-module archive)]
+                                (archive.add archive.runtime-module descriptor,document archive)))]
+      (wrap [archive [descriptor,document payload]])))
 
   (def: #export (initialize extension target host module expander host-analysis platform generation-bundle host-directive-bundle program extender)
     (All <type-vars>
@@ -115,7 +151,7 @@
           (///directive.Bundle anchor expression directive)
           (-> expression directive)
           Extender
-          (Promise (Try [<State+> Archive (Buffer directive)]))))
+          (Promise (Try [<State+> Archive]))))
     (let [state (//init.state host
                               module
                               expander
@@ -128,18 +164,12 @@
                               extender)]
       (do (try.with promise.monad)
         [_ (ioW.enable (get@ #&file-system platform) host target)
-         [archive analysis-state] (ioW.thaw extension (get@ #host platform) (get@ #&file-system platform) host target)]
-        (|> (do ///phase.monad
-              [_ (///directive.lift-analysis
-                  (///analysis.install analysis-state))]
-              (///directive.lift-generation
-               (do ///phase.monad
-                 [_ ..initialize-buffer!
-                  _ (..compile-runtime! platform)
-                  buffer ///generation.buffer]
-                 (wrap [archive buffer]))))
-            (///phase.run' state)
-            promise@wrap))))
+         [archive analysis-state] (ioW.thaw extension (get@ #host platform) (get@ #&file-system platform) host target)
+         [state [archive payload]] (|> (process-runtime analysis-state archive platform)
+                                       (///phase.run' state)
+                                       promise@wrap)
+         _ (..cache-module platform host target 0 extension payload)]
+        (wrap [state archive]))))
 
   (def: #export (compile target partial-host-extension expander platform host configuration archive extension state)
     (All <type-vars>
@@ -204,13 +234,7 @@
 
                       (#.Right payload)
                       (do (try.with promise.monad)
-                        [_ (..cache-module platform
-                                           host
-                                           target
-                                           (get@ #///.file input)
-                                           module-id
-                                           extension
-                                           payload)
+                        [_ (..cache-module platform host target module-id extension payload)
                          #let [[descriptor+document output] payload]]
                         (case (archive.add module descriptor+document archive)
                           (#try.Success archive)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux
index 9fae1fa1e..a4022d942 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/module.lux
@@ -5,7 +5,7 @@
    [control
     pipe
     ["." try]
-    ["ex" exception (#+ exception:)]]
+    ["." exception (#+ exception:)]]
    [data
     ["." text ("#@." equivalence)
      ["%" format (#+ format)]]
@@ -24,35 +24,41 @@
 (type: #export Tag Text)
 
 (exception: #export (unknown-module {module Text})
-  (ex.report ["Module" module]))
+  (exception.report
+   ["Module" module]))
 
 (exception: #export (cannot-declare-tag-twice {module Text} {tag Text})
-  (ex.report ["Module" module]
-             ["Tag" tag]))
+  (exception.report
+   ["Module" module]
+   ["Tag" tag]))
 
 (template [<name>]
   [(exception: #export (<name> {tags (List Text)} {owner Type})
-     (ex.report ["Tags" (text.join-with " " tags)]
-                ["Type" (%.type owner)]))]
+     (exception.report
+      ["Tags" (text.join-with " " tags)]
+      ["Type" (%.type owner)]))]
 
   [cannot-declare-tags-for-unnamed-type]
   [cannot-declare-tags-for-foreign-type]
   )
 
 (exception: #export (cannot-define-more-than-once {name Name})
-  (ex.report ["Definition" (%.name name)]))
+  (exception.report
+   ["Definition" (%.name name)]))
 
 (exception: #export (can-only-change-state-of-active-module {module Text} {state Module-State})
-  (ex.report ["Module" module]
-             ["Desired state" (case state
-                                #.Active   "Active"
-                                #.Compiled "Compiled"
-                                #.Cached   "Cached")]))
+  (exception.report
+   ["Module" module]
+   ["Desired state" (case state
+                      #.Active   "Active"
+                      #.Compiled "Compiled"
+                      #.Cached   "Cached")]))
 
 (exception: #export (cannot-set-module-annotations-more-than-once {module Text} {old Code} {new Code})
-  (ex.report ["Module" module]
-             ["Old annotations" (%.code old)]
-             ["New annotations" (%.code new)]))
+  (exception.report
+   ["Module" module]
+   ["Old annotations" (%.code old)]
+   ["New annotations" (%.code new)]))
 
 (def: #export (new hash)
   (-> Nat Module)
diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux
index 49358065b..2f84ad4dd 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive.lux
@@ -63,19 +63,21 @@
 
 (type: #export ID Nat)
 
+(def: #export runtime-module Module "")
+
 (abstract: #export Archive
   {}
   
   (Dictionary Module [ID (Maybe [Descriptor (Document Any)])])
 
-  (def: #export empty
-    Archive
-    (:abstraction (dictionary.new text.hash)))
-
   (def: next
     (-> Archive ID)
     (|>> :representation dictionary.size))
 
+  (def: #export empty
+    Archive
+    (:abstraction (dictionary.new text.hash)))
+
   (def: #export (id module archive)
     (-> Module Archive (Try ID))
     (case (dictionary.get module (:representation archive))
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index c6865ebc1..7843b9435 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -186,25 +186,34 @@
     (-> Text (generation.Host expression directive) archive.ID (Row Artifact) (Dictionary Text Binary) (Document .Module)
         (Try (Document .Module))))
   (do try.monad
-    [values (|> expected
-                row.to-list
-                (monad.fold @ (function (_ [artifact-id artifact-name] values)
-                                (do @
-                                  [data (try.from-maybe (dictionary.get (format (%.nat artifact-id) extension) actual))
-                                   #let [context [module-id artifact-id]
-                                         directive (:: host ingest context data)]]
-                                  (case artifact-name
-                                    #.None
-                                    (do @
-                                      [_ (:: host re-learn context directive)]
-                                      (wrap values))
-                                    
-                                    (#.Some artifact-name)
-                                    (do @
-                                      [value (:: host re-load context directive)]
-                                      (wrap (dictionary.put artifact-name value values))))))
-                            (: (Dictionary Text Any)
-                               (dictionary.new text.hash))))
+    [values (: (Try (Dictionary Text Any))
+               (loop [input (row.to-list expected)
+                      values (: (Dictionary Text Any)
+                                (dictionary.new text.hash))]
+                 (case input
+                   (#.Cons [[artifact-id artifact-name] input'])
+                   (case (do @
+                           [data (try.from-maybe (dictionary.get (format (%.nat artifact-id) extension) actual))
+                            #let [context [module-id artifact-id]
+                                  directive (:: host ingest context data)]]
+                           (case artifact-name
+                             #.None
+                             (do @
+                               [_ (:: host re-learn context directive)]
+                               (wrap values))
+                             
+                             (#.Some artifact-name)
+                             (do @
+                               [value (:: host re-load context directive)]
+                               (wrap (dictionary.put artifact-name value values)))))
+                     (#try.Success values')
+                     (recur input' values')
+
+                     failure
+                     failure)
+                   
+                   #.None
+                   (#try.Success values))))
      content (document.read $.key document)
      definitions (monad.map @ (function (_ [def-name def-global])
                                 (case def-global