diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/binary.lux | 91 | ||||
| -rw-r--r-- | stdlib/source/lux/lang/compiler/default/cache.lux | 33 | ||||
| -rw-r--r-- | stdlib/source/lux/lang/compiler/meta/archive.lux | 31 | ||||
| -rw-r--r-- | stdlib/source/lux/lang/compiler/meta/cache.lux | 27 |
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)) |