- Ported caching machinery for default compiler.

- Expanded binary format module.

5 files changed, 153 insertions, 33 deletions

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 0389a64f8..138d965c4 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -312,8 +312,8 @@
 ##   (#Rev Rev)
 ##   (#Frac Frac)
 ##   (#Text Text)
-##   (#Symbol Text Text)
-##   (#Tag Text Text)
+##   (#Symbol Ident)
+##   (#Tag Ident)
 ##   (#Form (List (w (Code' w))))
 ##   (#Tuple (List (w (Code' w))))
 ##   (#Record (List [(w (Code' w)) (w (Code' w))])))
diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux
index 040ae5e8b..d1d83853d 100644
--- a/stdlib/source/lux/data/format/binary.lux
+++ b/stdlib/source/lux/data/format/binary.lux
@@ -1,8 +1,9 @@
 (.module:
-  [lux #- nat int rev list]
+  [lux #- nat int rev list type]
   (lux (control [monad #+ do Monad]
                 ["p" parser]
-                ["ex" exception #+ exception:])
+                ["ex" exception #+ exception:]
+                [equivalence #+ Equivalence])
        (data [error]
              (text [encoding]
                    [format #+ %n])
@@ -131,15 +132,19 @@
               (write value)))})
 
 ## Utilities
-(def: #export unit
-  (Binary Any)
+(def: #export (ignore default)
+  (All [a] (-> a (Binary a)))
   {#read (function (_ input)
-           (#error.Success [input []]))
+           (#error.Success [input default]))
    #write (function (_ value)
             [+0
              (function (_ offset blob)
                blob)])})
 
+(def: #export any
+  (Binary Any)
+  (ignore []))
+
 (def: #export bool
   (Binary Bool)
   {#read (function (_ [offset blob])
@@ -199,9 +204,83 @@
              (p.lift (encoding.from-utf8 utf8)))
      #write (|>> encoding.to-utf8 write)}))
 
+(def: #export maybe
+  (All [a] (-> (Binary a) (Binary (Maybe a))))
+  (..alt ..any))
+
 (def: #export (list value)
   (All [a] (-> (Binary a) (Binary (List a))))
   (..rec
    (function (_ recur)
-     (..alt ..unit
+     (..alt ..any
             (..seq value recur)))))
+
+(def: #export ident
+  (Binary Ident)
+  (..seq ..text ..text))
+
+(def: #export type
+  (Binary Type)
+  (..rec
+   (function (_ type)
+     (let [pair (..seq type type)
+           indexed ..nat
+           quantified (..seq (..list type) type)]
+       ($_ ..alt
+           ## #Primitive
+           (..seq ..text (..list type))
+           ## #Sum
+           pair
+           ## #Product
+           pair
+           ## #Function
+           pair
+           ## #Parameter
+           indexed
+           ## #Var
+           indexed
+           ## #Ex
+           indexed
+           ## #UnivQ
+           quantified
+           ## #ExQ
+           quantified
+           ## #Apply
+           pair
+           ## #Named
+           (..seq ..ident type)
+           )))))
+
+(def: #export cursor
+  (Binary Cursor)
+  ($_ ..seq ..text ..nat ..nat))
+
+(def: #export code
+  (Binary Code)
+  (..rec
+   (function (_ code)
+     (let [sequence (..list code)
+           code' ($_ ..alt
+                     ## #Bool
+                     ..bool
+                     ## #Nat
+                     ..nat
+                     ## #Int
+                     ..int
+                     ## #Rev
+                     ..rev
+                     ## #Frac
+                     ..frac
+                     ## #Text
+                     ..text
+                     ## #Symbol
+                     ..ident
+                     ## #Tag
+                     ..ident
+                     ## #Form
+                     sequence
+                     ## #Tuple
+                     sequence
+                     ## #Record
+                     (..list (..seq code code)))]
+       (..seq ..cursor code')))))
diff --git a/stdlib/source/lux/lang/compiler/default/cache.lux b/stdlib/source/lux/lang/compiler/default/cache.lux
new file mode 100644
index 000000000..a878e1615
--- /dev/null
+++ b/stdlib/source/lux/lang/compiler/default/cache.lux
@@ -0,0 +1,33 @@
+(.module:
+  lux
+  (lux (data (format [binary #+ Binary]))))
+
+(def: definition
+  (Binary Definition)
+  ($_ binary.seq binary.type binary.code binary.any))
+
+(def: alias
+  (Binary [Text Text])
+  (binary.seq binary.text binary.text))
+
+## TODO: Remove #module-hash, #imports & #module-state ASAP.
+## TODO: Not just from this parser, but from the lux.Module type.
+(def: #export module
+  (Binary Module)
+  ($_ binary.seq
+      ## #module-hash
+      (binary.ignore +0)
+      ## #module-aliases
+      (binary.list ..alias)
+      ## #definitions
+      (binary.list (binary.seq binary.text ..definition))
+      ## #imports
+      (binary.list binary.text)
+      ## #tags
+      (binary.ignore (list))
+      ## #types
+      (binary.ignore (list))
+      ## #module-annotations
+      (binary.maybe binary.code)
+      ## #module-state
+      (binary.ignore #.Cached)))
diff --git a/stdlib/source/lux/lang/compiler/meta/archive.lux b/stdlib/source/lux/lang/compiler/meta/archive.lux
index fa3b91d7c..a3e9c0397 100644
--- a/stdlib/source/lux/lang/compiler/meta/archive.lux
+++ b/stdlib/source/lux/lang/compiler/meta/archive.lux
@@ -9,13 +9,14 @@
              text/format
              (coll (dictionary ["dict" unordered #+ Dict])))
        (lang [type #+ :share])
-       (type abstract))
-  [////])
+       (type abstract)
+       (world [file #+ File]))
+  [//// #+ Version])
 
 ## Key
 (type: #export Signature
   {#name Ident
-   #version Text})
+   #version Version})
 
 (def: Equivalence<Signature>
   (Equivalence Signature)
@@ -54,27 +55,35 @@
   (ex.report ["Key" (describe (..signature key))]
              ["Signature" (describe signature)]))
 
+(type: #export Reference Text)
+
+(type: #export Descriptor
+  {#hash Nat
+   #file File
+   #references (List Reference)
+   #state Module-State})
+
 (type: #export (Document d)
   {#key (Key d)
-   #hash Nat
-   #value d})
+   #descriptor Descriptor
+   #content d})
 
-(def: #export (open expected [actual value])
+(def: #export (open expected [actual _descriptor content])
   (All [d] (-> (Key d) (Document Any) (Error d)))
   (if (:: Equivalence<Key> = expected actual)
     (#error.Success (:share [e]
                             {(Key e)
                              expected}
                             {e
-                             value}))
+                             content}))
     (ex.throw invalid-key-for-document [expected actual])))
 
-(def: #export (close key signature hash value)
-  (All [d] (-> (Key d) Signature Nat d (Error (Document d))))
+(def: #export (close key signature descriptor content)
+  (All [d] (-> (Key d) Signature Descriptor d (Error (Document d))))
   (if (:: Equivalence<Signature> = (..signature key) signature)
     (#error.Success {#key key
-                     #hash hash
-                     #value value})
+                     #descriptor descriptor
+                     #content content})
     (ex.throw signature-does-not-match-key [key signature])))
 
 ## Archive
diff --git a/stdlib/source/lux/lang/compiler/meta/cache.lux b/stdlib/source/lux/lang/compiler/meta/cache.lux
index 153679ef0..1d47121f9 100644
--- a/stdlib/source/lux/lang/compiler/meta/cache.lux
+++ b/stdlib/source/lux/lang/compiler/meta/cache.lux
@@ -17,7 +17,7 @@
   [//io #+ Context Module]
   [//io/context]
   [//io/archive]
-  [//archive #+ Signature Key Document Archive]
+  [//archive #+ Signature Key Descriptor Document Archive]
   [/dependency #+ Dependency Graph])
 
 (exception: #export (cannot-delete-cached-file {file File})
@@ -94,17 +94,15 @@
 ## Load
 (def: signature
   (Binary Signature)
-  (let [name (binary.seq binary.text binary.text)
-        version binary.text]
-    (binary.seq name version)))
+  ($_ binary.seq binary.ident binary.text))
 
-(def: imports
-  (Binary (List Module))
-  (binary.list binary.text))
+(def: descriptor
+  (Binary Descriptor)
+  ($_ binary.seq binary.nat binary.text (binary.list binary.text) (binary.ignore #.Cached)))
 
 (def: document
-  (All [a] (-> (Binary a) (Binary [Signature Nat (List Module) a])))
-  (|>> ($_ binary.seq ..signature binary.nat ..imports)))
+  (All [a] (-> (Binary a) (Binary [Signature Descriptor a])))
+  (|>> ($_ binary.seq ..signature ..descriptor)))
 
 (def: (load-document System<m> contexts root key binary module)
   (All [m d] (-> (System m) (List File) File (Key d) (Binary d) Module
@@ -114,11 +112,12 @@
      [module' source-code] (//io/context.read System<m> contexts module)
      #let [current-hash (:: text.Hash<Text> hash source-code)]]
     (case (do error.Monad<Error>
-            [[signature document-hash imports content] (binary.read (..document binary) document')
+            [[signature descriptor content] (binary.read (..document binary) document')
+             #let [[document-hash _file references _state] descriptor]
              _ (ex.assert stale-document [module current-hash document-hash]
                           (n/= current-hash document-hash))
-             document (//archive.close key signature document-hash content)]
-            (wrap [[module imports] document]))
+             document (//archive.close key signature descriptor content)]
+            (wrap [[module references] document]))
       (#error.Success [dependency document])
       (wrap (#.Some [dependency document]))
       
@@ -136,8 +135,8 @@
                         [(monad.map @ (load-document System<m> contexts root key binary))
                          (:: @ map (list/fold (function (_ full-document archive)
                                                 (case full-document
-                                                  (#.Some [[module imports] document])
-                                                  (dict.put module [imports document] archive)
+                                                  (#.Some [[module references] document])
+                                                  (dict.put module [references document] archive)
                                                   
                                                   #.None
                                                   archive))