- Ported caching machinery for default compiler.

- Expanded binary format module.

6 files changed, 153 insertions, 172 deletions

diff --git a/new-luxc/source/luxc/cache/description.lux b/new-luxc/source/luxc/cache/description.lux
deleted file mode 100644
index 7706d03b1..000000000
--- a/new-luxc/source/luxc/cache/description.lux
+++ /dev/null
@@ -1,139 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["p" parser "parser/" Monad<Parser>]
-                ["ex" exception #+ exception:])
-       (data [product]
-             ["e" error #+ Error]
-             [text "text/" Eq<Text>]
-             text/format
-             (coll [list "list/" Functor<List>]))
-       (macro [code]
-              ["s" syntax #+ Syntax])
-       [lang]))
-
-(exception: #export (invalid-lux-version {version Text})
-  (ex.report ["Expected: " lang.version]
-             ["  Actual: " version]))
-
-(def: (write-type type)
-  (-> Type Code)
-  (case type
-    (#.Primitive name params)
-    (` ("Primitive"
-        (~ (code.text name))
-        (~+ (list/map write-type params))))
-    
-    (^template [<tag> <description>]
-      (<tag> left right)
-      (` (<description> (~ (write-type left)) (~ (write-type right)))))
-    ([#.Sum "Sum"]
-     [#.Product "Product"]
-     [#.Function "Function"]
-     [#.Apply "Apply"])
-    
-    (^template [<tag> <description>]
-      (<tag> id)
-      (` (<description> (~ (code.nat id)))))
-    ([#.Parameter "Parameter"]
-     [#.Var "Var"]
-     [#.Ex "Ex"])
-
-    (^template [<tag> <description>]
-      (<tag> env body)
-      (` (<description> (~ (code.tuple (list/map write-type env)))
-                        (~ (write-type body)))))
-    ([#.UnivQ "UnivQ"]
-     [#.ExQ "ExQ"])
-    
-    (#.Named name anonymous)
-    (` ("Named" (~ (code.symbol name)) (~ (write-type anonymous))))))
-
-(def: read-type
-  (Syntax Type)
-  (let [tagged (: (All [a] (-> Text (Syntax a) (Syntax a)))
-                  (function (_ tag syntax)
-                    (s.form (p.after (s.this (code.text tag)) syntax))))
-        binary (: (-> Text (Syntax Type) (Syntax [Type Type]))
-                  (function (_ tag read-type)
-                    (tagged tag (p.seq read-type read-type))))
-        indexed (: (-> Text (Syntax Nat))
-                   (function (_ tag)
-                     (tagged tag s.nat)))
-        quantified (: (-> Text (Syntax Type) (Syntax [(List Type) Type]))
-                      (function (_ tag read-type)
-                        (tagged tag (p.seq (s.tuple (p.some read-type))
-                                           read-type))))]
-    (p.rec
-     (function (_ read-type)
-       ($_ p.alt
-           (tagged "Primitive" (p.seq s.text (p.some read-type)))
-           (binary "Sum" read-type)
-           (binary "Product" read-type)
-           (binary "Function" read-type)
-           (indexed "Parameter")
-           (indexed "Var")
-           (indexed "Ex")
-           (quantified "UnivQ" read-type)
-           (quantified "ExQ" read-type)
-           (binary "Apply" read-type)
-           (tagged "Named" (p.seq s.symbol read-type))
-           )))))
-
-(def: (write-definition [type annotations value])
-  (-> Definition Code)
-  (` {"type" (~ (write-type type))
-      "annotations" (~ annotations)}))
-
-(def: read-definition
-  (Syntax Definition)
-  (s.record ($_ p.seq
-                (p.after (s.this (` "type")) read-type)
-                (p.after (s.this (` "annotations")) s.any)
-                (parser/wrap []))))
-
-(def: (write-aliases aliases)
-  (-> (List [Text Text]) Code)
-  (|> aliases (list/map (product.both code.text code.text)) code.record))
-
-(def: read-aliases
-  (Syntax (List [Text Text]))
-  (s.record (p.some (p.seq s.text s.text))))
-
-(def: #export (write lux-file module)
-  (-> Text Module Code)
-  (` {"lux version" (~ (code.text lang.version))
-      "lux file" (~ (code.text lux-file))
-      "hash" (~ (code.nat (get@ #.module-hash module)))
-      "aliases" (~ (write-aliases (get@ #.module-aliases module)))
-      "definitions" (~ (code.record (list/map (product.both code.text write-definition)
-                                              (get@ #.definitions module))))
-      "imports" (~ (code.tuple (list/map code.text (get@ #.imports module))))
-      "annotations" (~ (case (get@ #.module-annotations module)
-                         #.None
-                         (' "None")
-
-                         (#.Some annotations)
-                         (` ("Some" (~ annotations)))))
-      }))
-
-(def: #export (read description)
-  (-> Code (Error [Text Module]))
-  (<| (s.run (list description))
-      (s.record (do p.Monad<Parser>
-                  [lux-version (p.after (s.this (` "lux version")) s.text)
-                   _ (p.assert (ex.construct invalid-lux-version lux-version)
-                               (text/= lang.version lux-version))]
-                  ($_ p.seq
-                      (p.after (s.this (` "lux file")) s.text)
-                      ($_ p.seq
-                          (p.after (s.this (` "hash")) s.nat)
-                          (p.after (s.this (` "aliases")) read-aliases)
-                          (p.after (s.this (` "definitions")) (s.record (p.some (p.seq s.text read-definition))))
-                          (p.after (s.this (` "imports")) (s.tuple (p.some s.text)))
-                          (parser/wrap (list))
-                          (parser/wrap (list))
-                          (p.after (s.this (` "annotations")) (p.alt (s.this (` "None"))
-                                                                     (s.form (p.after (s.this (` "Some"))
-                                                                                      s.any))))
-                          (parser/wrap #.Cached)))))))
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))