Now caching the documents generated after compiling each module.

8 files changed, 236 insertions, 64 deletions

diff --git a/stdlib/source/lux/tool/compiler/default/cache.lux b/stdlib/source/lux/tool/compiler/default/cache.lux
deleted file mode 100644
index 1770b4a82..000000000
--- a/stdlib/source/lux/tool/compiler/default/cache.lux
+++ /dev/null
@@ -1,35 +0,0 @@
-(.module:
-  [lux #*
-   [data
-    [format
-     ["_" binary (#+ Format)]]]])
-
-(def: definition
-  (Format Definition)
-  ($_ _.and _.type _.code _.any))
-
-(def: alias
-  (Format [Text Text])
-  (_.and _.text _.text))
-
-## TODO: Remove #module-hash, #imports & #module-state ASAP.
-## TODO: Not just from this parser, but from the lux.Module type.
-(def: #export module
-  (Format Module)
-  ($_ _.and
-      ## #module-hash
-      (_.ignore 0)
-      ## #module-aliases
-      (_.list ..alias)
-      ## #definitions
-      (_.list (_.and _.text ..definition))
-      ## #imports
-      (_.list _.text)
-      ## #tags
-      (_.ignore (list))
-      ## #types
-      (_.ignore (list))
-      ## #module-annotations
-      (_.maybe _.code)
-      ## #module-state
-      (_.ignore #.Cached)))
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 0d31b1f2d..9a4c6f20c 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -16,7 +16,9 @@
      ["%" format (#+ format)]]
     [collection
      ["." list]
-     ["." row ("#@." functor)]]]
+     ["." row ("#@." functor)]]
+    [format
+     ["_" binary (#+ Writer)]]]
    [world
     ["." file (#+ Path)]]]
   ["." // #_
@@ -25,6 +27,7 @@
     ["#." phase]
     [language
      [lux
+      ["$" /]
       ["." syntax]
       ["#." analysis
        [macro (#+ Expander)]]
@@ -37,7 +40,8 @@
         ["." module]]]]]
     [meta
      ["." archive (#+ Archive)
-      [descriptor (#+ Module)]]
+      ["." descriptor (#+ Descriptor Module)]
+      ["." document (#+ Document)]]
      [io
       ["." context]
       ["ioW" archive]]]]]
@@ -66,9 +70,14 @@
                   <State+> (as-is (///directive.State+ anchor expression directive))
                   <Bundle> (as-is (///generation.Bundle anchor expression directive))]
 
-  (def: (cache-module platform host target-dir module-file-name module-id extension output)
+  (def: writer
+    (Writer [Descriptor (Document .Module)])
+    (_.and descriptor.writer
+           (document.writer $.writer)))
+
+  (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 Output
+      (-> <Platform> Host Path Path archive.ID Text [[Descriptor (Document Any)] Output]
           (Promise (Try Any))))
     (let [system (get@ #&file-system platform)
           write-artifact! (: (-> [Text Binary] (Action Any))
@@ -79,12 +88,11 @@
          _ (|> output
                row.to-list
                (monad.map ..monad write-artifact!)
-               (: (Action (List Any))))]
-        (wrap [])
-        ## (&io.write target-dir
-        ##            (format module-name "/" cache.descriptor-name)
-        ##            (encoding.to-utf8 (%.code (cache/description.write module-file-name module))))
-        )))
+               (: (Action (List Any))))
+         document (:: promise.monad wrap
+                      (document.check //init.key document))]
+        (ioW.cache system host target-dir module-id
+                   (_.run ..writer [descriptor document])))))
   
   ## TODO: Inline ASAP
   (def: initialize-buffer!
@@ -220,7 +228,7 @@
                       (#.Left more)
                       (continue! archive state more)
 
-                      (#.Right [descriptor+document output])
+                      (#.Right payload)
                       (do (try.with promise.monad)
                         [_ (..cache-module platform
                                            host
@@ -228,7 +236,8 @@
                                            (get@ #///.file input)
                                            module-id
                                            extension
-                                           output)]
+                                           payload)
+                         #let [[descriptor+document output] payload]]
                         (case (archive.add module descriptor+document archive)
                           (#try.Success archive)
                           (wrap [archive state])
diff --git a/stdlib/source/lux/tool/compiler/language/lux.lux b/stdlib/source/lux/tool/compiler/language/lux.lux
new file mode 100644
index 000000000..ed3b0ed9b
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/language/lux.lux
@@ -0,0 +1,86 @@
+(.module:
+  [lux #*
+   [control
+    ["<>" parser
+     ["<b>" binary (#+ Parser)]]]
+   [data
+    [format
+     ["_" binary (#+ Writer)]]]])
+
+## TODO: Remove #module-hash, #imports & #module-state ASAP.
+## TODO: Not just from this parser, but from the lux.Module type.
+(def: #export writer
+  (Writer .Module)
+  (let [definition (: (Writer Definition)
+                      ($_ _.and _.bit _.type _.code _.any))
+        name (: (Writer Name)
+                (_.and _.text _.text))
+        alias name
+        global (: (Writer Global)
+                  (_.or alias definition))
+        tag (: (Writer [Nat (List Name) Bit Type])
+               ($_ _.and
+                   _.nat
+                   (_.list name)
+                   _.bit
+                   _.type))
+        type (: (Writer [(List Name) Bit Type])
+                ($_ _.and
+                    (_.list name)
+                    _.bit
+                    _.type))]
+    ($_ _.and
+        ## #module-hash
+        _.nat
+        ## #module-aliases
+        (_.list alias)
+        ## #definitions
+        (_.list (_.and _.text global))
+        ## #imports
+        (_.list _.text)
+        ## #tags
+        (_.list (_.and _.text tag))
+        ## #types
+        (_.list (_.and _.text type))
+        ## #module-annotations
+        (_.maybe _.code)
+        ## #module-state
+        _.any)))
+
+(def: #export parser
+  (Parser .Module)
+  (let [definition (: (Parser Definition)
+                      ($_ <>.and <b>.bit <b>.type <b>.code <b>.any))
+        name (: (Parser Name)
+                (<>.and <b>.text <b>.text))
+        alias name
+        global (: (Parser Global)
+                  (<>.or alias definition))
+        tag (: (Parser [Nat (List Name) Bit Type])
+               ($_ <>.and
+                   <b>.nat
+                   (<b>.list name)
+                   <b>.bit
+                   <b>.type))
+        type (: (Parser [(List Name) Bit Type])
+                ($_ <>.and
+                    (<b>.list name)
+                    <b>.bit
+                    <b>.type))]
+    ($_ <>.and
+        ## #module-hash
+        <b>.nat
+        ## #module-aliases
+        (<b>.list alias)
+        ## #definitions
+        (<b>.list (<>.and <b>.text global))
+        ## #imports
+        (<b>.list <b>.text)
+        ## #tags
+        (<b>.list (<>.and <b>.text tag))
+        ## #types
+        (<b>.list (<>.and <b>.text type))
+        ## #module-annotations
+        (<b>.maybe <b>.code)
+        ## #module-state
+        (:: <>.monad wrap #.Cached))))
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
index 2d4559275..7f3e1654d 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
@@ -1,11 +1,19 @@
 (.module:
   [lux #*
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["<>" parser
+     ["<b>" binary (#+ Parser)]]]
    [data
+    ["." product]
     ["." text]
     [collection
-     ["." list]
+     ["." list ("#@." functor fold)]
      ["." row (#+ Row)]
-     ["." dictionary (#+ Dictionary)]]]
+     ["." dictionary (#+ Dictionary)]]
+    [format
+     ["." binary (#+ Writer)]]]
    [type
     abstract]])
 
@@ -17,6 +25,7 @@
 
 (abstract: #export Registry
   {}
+  
   {#artifacts (Row Artifact)
    #resolver (Dictionary Text ID)}
 
@@ -63,4 +72,26 @@
     (|> (:representation registry)
         (get@ #resolver)
         (dictionary.get name)))
+
+  (def: #export writer
+    (Writer Registry)
+    (let [writer|artifacts (binary.list (binary.maybe binary.text))]
+      (|>> :representation
+           (get@ #artifacts)
+           row.to-list
+           (list@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))))
   )
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux
index c6e1e7841..24562367a 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive/descriptor.lux
@@ -1,12 +1,18 @@
 (.module:
   [lux (#- Module)
+   [control
+    ["<>" parser
+     ["<b>" binary (#+ Parser)]]]
    [data
+    ["." text]
     [collection
-     [set (#+ Set)]]]
+     [set (#+ Set)]]
+    [format
+     ["." binary (#+ Writer)]]]
    [world
     [file (#+ Path)]]]
   [//
-   [artifact (#+ Registry)]])
+   ["." artifact (#+ Registry)]])
 
 (type: #export Module Text)
 
@@ -17,3 +23,25 @@
    #state Module-State
    #references (Set Module)
    #registry Registry})
+
+(def: #export writer
+  (Writer Descriptor)
+  ($_ binary.and
+      binary.text
+      binary.text
+      binary.nat
+      binary.any
+      (binary.set binary.text)
+      artifact.writer
+      ))
+
+(def: #export parser
+  (Parser Descriptor)
+  ($_ <>.and
+      <b>.text
+      <b>.text
+      <b>.nat
+      (:: <>.monad wrap #.Cached)
+      (<b>.set text.hash <b>.text)
+      artifact.parser
+      ))
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/lux/tool/compiler/meta/archive/document.lux
index e6d5c0dfe..19b8576a1 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive/document.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive/document.lux
@@ -1,11 +1,17 @@
 (.module:
   [lux (#- Module)
+   [abstract
+    [monad (#+ do)]]
    [control
     ["." try (#+ Try)]
-    ["ex" exception (#+ exception:)]]
+    ["." exception (#+ exception:)]
+    ["<>" parser
+     ["<b>" binary (#+ Parser)]]]
    [data
     [collection
-     ["." dictionary (#+ Dictionary)]]]
+     ["." dictionary (#+ Dictionary)]]
+    [format
+     ["." binary (#+ Writer)]]]
    [type (#+ :share)
     abstract]]
   [//
@@ -14,8 +20,9 @@
    [descriptor (#+ Module)]])
 
 (exception: #export (invalid-signature {expected Signature} {actual Signature})
-  (ex.report ["Expected" (signature.description expected)]
-             ["Actual" (signature.description actual)]))
+  (exception.report
+   ["Expected" (signature.description expected)]
+   ["Actual" (signature.description actual)]))
 
 (abstract: #export (Document d)
   {}
@@ -34,15 +41,32 @@
                                key}
                               {e
                                document//content}))
-        (ex.throw invalid-signature [(key.signature key)
-                                     document//signature]))))
+        (exception.throw ..invalid-signature [(key.signature key)
+                                              document//signature]))))
 
   (def: #export (write key content)
     (All [d] (-> (Key d) d (Document d)))
     (:abstraction {#signature (key.signature key)
                    #content content}))
 
+  (def: #export (check key document)
+    (All [d] (-> (Key d) (Document Any) (Try (Document d))))
+    (do try.monad
+      [_ (..read key document)]
+      (wrap (:assume document))))
+
   (def: #export signature
     (-> (Document Any) Signature)
     (|>> :representation (get@ #signature)))
+
+  (def: #export (writer content)
+    (All [d] (-> (Writer d) (Writer (Document d))))
+    (let [writer (binary.and signature.writer
+                             content)]
+      (|>> :representation writer)))
+
+  (def: #export parser
+    (All [d] (-> (Parser d) (Parser (Document d))))
+    (|>> (<>.and signature.parser)
+         (:: <>.monad map (|>> :abstraction))))
   )
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/lux/tool/compiler/meta/archive/signature.lux
index 551c54579..3d795ff50 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive/signature.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive/signature.lux
@@ -2,10 +2,15 @@
   [lux #*
    [abstract
     ["." equivalence (#+ Equivalence)]]
+   [control
+    ["<>" parser
+     ["<b>" binary (#+ Parser)]]]
    [data
     ["." name]
     ["." text
-     ["%" format (#+ format)]]]]
+     ["%" format (#+ format)]]
+    [format
+     ["." binary (#+ Writer)]]]]
   [////
    [version (#+ Version)]])
 
@@ -20,3 +25,13 @@
 (def: #export (description signature)
   (-> Signature Text)
   (format (%.name (get@ #name signature)) " " (get@ #version signature)))
+
+(def: #export writer
+  (Writer Signature)
+  (binary.and (binary.and binary.text binary.text)
+              binary.text))
+
+(def: #export parser
+  (Parser Signature)
+  (<>.and (<>.and <b>.text <b>.text)
+          <b>.text))
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index e71641727..ee7af993b 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -38,7 +38,7 @@
           (:: system separator)
           //.lux-context))
 
-(def: #export (document system host root module-id)
+(def: (module system host root module-id)
   (-> (System Promise) Host Path archive.ID Path)
   (format (..lux-archive system host root)
           (:: system separator)
@@ -46,7 +46,7 @@
 
 (def: #export (artifact system host root module-id name extension)
   (-> (System Promise) Host Path archive.ID Text Text Path)
-  (format (document system host root module-id)
+  (format (..module system host root module-id)
           (:: system separator)
           name
           extension))
@@ -54,13 +54,13 @@
 (def: #export (prepare system host root module-id)
   (-> (System Promise) Host Path archive.ID (Promise (Try Any)))
   (do promise.monad
-    [#let [document (..document system host root module-id)]
-     document-exists? (file.exists? promise.monad system document)]
-    (if document-exists?
+    [#let [module (..module system host root module-id)]
+     module-exists? (file.exists? promise.monad system module)]
+    (if module-exists?
       (wrap (#try.Success []))
       (do @
         [_ (file.get-directory @ system (..lux-archive system host root))
-         outcome (!.use (:: system create-directory) document)]
+         outcome (!.use (:: system create-directory) module)]
         (case outcome
           (#try.Success output)
           (wrap (#try.Success []))
@@ -112,3 +112,17 @@
       
       (#try.Failure error)
       (wrap (#try.Success archive.empty)))))
+
+(def: (module-descriptor system host root module-id)
+  (-> (System Promise) Host Path archive.ID Path)
+  (format (..module system host root module-id)
+          (:: system separator)
+          "module-descriptor"))
+
+(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)))