aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2018-07-10 19:37:30 -0400
committerEduardo Julian2018-07-10 19:37:30 -0400
commit631b52a83f7ee64c46a893cdd347289276afe210 (patch)
treeb4ea9b01d8be324838a535a33d6b69abc8485f47 /stdlib/source
parent9d89d791a8c65e6d2fa5ee9ff7ecae29ca9b7fdc (diff)
- Ported caching machinery for default compiler.
- Expanded binary format module.
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux.lux4
-rw-r--r--stdlib/source/lux/data/format/binary.lux91
-rw-r--r--stdlib/source/lux/lang/compiler/default/cache.lux33
-rw-r--r--stdlib/source/lux/lang/compiler/meta/archive.lux31
-rw-r--r--stdlib/source/lux/lang/compiler/meta/cache.lux27
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))