diff options
| -rw-r--r-- | stdlib/source/lux/compiler/meta/archive.lux | 168 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/meta/archive/descriptor.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/meta/archive/document.lux | 51 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/meta/archive/key.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/lux/compiler/meta/archive/signature.lux | 23 |
5 files changed, 152 insertions, 111 deletions
diff --git a/stdlib/source/lux/compiler/meta/archive.lux b/stdlib/source/lux/compiler/meta/archive.lux index 457e3b874..f36a0b754 100644 --- a/stdlib/source/lux/compiler/meta/archive.lux +++ b/stdlib/source/lux/compiler/meta/archive.lux @@ -1,5 +1,5 @@ (.module: - [lux #* + [lux (#- Module) [control ["ex" exception (#+ exception:)] ["." equivalence (#+ Equivalence)] @@ -10,120 +10,66 @@ ["." text format] [collection - ["dict" dictionary (#+ Dictionary)]]] + ["." dictionary (#+ Dictionary)]]] [type (#+ :share) abstract] [world [file (#+ File)]]] [/// - [default - ["." init (#+ Version)]]]) - -## Key -(type: #export Signature - {#name Name - #version Version}) - -(def: Equivalence<Signature> - (Equivalence Signature) - (equivalence.product name.Equivalence<Name> text.Equivalence<Text>)) - -(def: (describe signature) - (-> Signature Text) - (format (%name (get@ #name signature)) " " (get@ #version signature))) - -(abstract: #export (Key k) - {} - - Signature - - (structure: #export Equivalence<Key> - (All [k] (Equivalence (Key k))) - (def: (= reference sample) - (:: Equivalence<Signature> = (:representation reference) (:representation sample)))) - - (def: #export default - (Key Nothing) - (:abstraction {#name ["" ""] - #version init.version})) - - (def: #export signature - (-> (Key Any) Signature) - (|>> :representation)) - ) - -## Document -(exception: #export (invalid-key-for-document {expected (Key Any)} {actual (Key Any)}) - (ex.report ["Expected" (describe (..signature expected))] - ["Actual" (describe (..signature actual))])) - -(exception: #export (signature-does-not-match-key {key (Key Any)} {signature Signature}) - (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) - #descriptor Descriptor - #content d}) - -(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 - content})) - (ex.throw invalid-key-for-document [expected actual]))) - -(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 - #descriptor descriptor - #content content}) - (ex.throw signature-does-not-match-key [key signature]))) + [default (#+ Version)]] + [/ + ["." signature (#+ Signature)] + ["." key (#+ Key)] + ["." descriptor (#+ Module Descriptor)] + ["." document (#+ Document)]]) ## Archive -(exception: #export (cannot-replace-document-in-archive {name Text} {old (Document Any)} {new (Document Any)}) - (ex.report ["Module's name" name] - ["Old document's key" (describe (..signature (get@ #key old)))] - ["New document's key" (describe (..signature (get@ #key new)))])) - -(abstract: #export Archive - {} - - (Dictionary Text (Ex [d] (Document d))) - - (def: #export empty - Archive - (:abstraction (dict.new text.Hash<Text>))) - - (def: #export (add name document archive) - (-> Text (Ex [d] (Document d)) Archive (Error Archive)) - (case (dict.get name (:representation archive)) - (#.Some existing) - (if (is? document existing) - (#error.Success archive) - (ex.throw cannot-replace-document-in-archive [name existing document])) - - #.None - (#error.Success (:abstraction (dict.put name document - (:representation archive)))))) - - (def: #export (merge additions archive) - (-> Archive Archive (Error Archive)) - (monad.fold error.Monad<Error> - (function (_ [name' document'] archive') - (..add name' document' archive')) - archive - (dict.entries (:representation additions)))) - ) +(exception: #export (unknown-document {name Module}) + (ex.report ["Module" name])) + +(exception: #export (cannot-replace-document {name Module} + {old (Document Any)} + {new (Document Any)}) + (ex.report ["Module" name] + ["Old key" (signature.description (document.signature old))] + ["New key" (signature.description (document.signature new))])) + +(with-expansions [<Document> (as-is (type (Ex [d] (Document d))))] + (abstract: #export Archive + {} + + (Dictionary Text <Document>) + + (def: #export empty + Archive + (:abstraction (dictionary.new text.Hash<Text>))) + + (def: #export (add name document archive) + (-> Module <Document> Archive (Error Archive)) + (case (dictionary.get name (:representation archive)) + (#.Some existing) + (if (is? document existing) + (#error.Success archive) + (ex.throw cannot-replace-document [name existing document])) + + #.None + (#error.Success (:abstraction (dictionary.put name document + (:representation archive)))))) + + (def: #export (find name archive) + (-> Module Archive (Error <Document>)) + (case (dictionary.get name (:representation archive)) + (#.Some document) + (#error.Success document) + + #.None + (ex.throw unknown-document [name]))) + + (def: #export (merge additions archive) + (-> Archive Archive (Error Archive)) + (monad.fold error.Monad<Error> + (function (_ [name' document'] archive') + (..add name' document' archive')) + archive + (dictionary.entries (:representation additions)))) + )) diff --git a/stdlib/source/lux/compiler/meta/archive/descriptor.lux b/stdlib/source/lux/compiler/meta/archive/descriptor.lux new file mode 100644 index 000000000..6c7e6744e --- /dev/null +++ b/stdlib/source/lux/compiler/meta/archive/descriptor.lux @@ -0,0 +1,13 @@ +(.module: + [lux (#- Module) + [world + [file (#+ File)]]]) + +(type: #export Module Text) + +(type: #export Descriptor + {#hash Nat + #name Module + #file File + #references (List Module) + #state Module-State}) diff --git a/stdlib/source/lux/compiler/meta/archive/document.lux b/stdlib/source/lux/compiler/meta/archive/document.lux new file mode 100644 index 000000000..237b092da --- /dev/null +++ b/stdlib/source/lux/compiler/meta/archive/document.lux @@ -0,0 +1,51 @@ +(.module: + [lux (#- Module) + [control + ["ex" exception (#+ exception:)]] + [data + ["." error (#+ Error)] + [collection + ["." dictionary (#+ Dictionary)]]] + [type (#+ :share) + abstract]] + [// + ["." signature (#+ Signature)] + ["." key (#+ Key)] + ["." descriptor (#+ Module Descriptor)]]) + +## Document +(exception: #export (invalid-key {module Module} {expected (Key Any)} {actual (Key Any)}) + (ex.report ["Module" module] + ["Expected" (signature.description (get@ #key.signature expected))] + ["Actual" (signature.description (get@ #key.signature actual))])) + +(abstract: #export (Document d) + {} + + {#key (Key d) + #descriptor Descriptor + #content d} + + (def: #export (read key document) + (All [d] (-> (Key d) (Document Any) (Error d))) + (let [[document//key document//descriptor document//content] (:representation document)] + (if (:: signature.Equivalence<Signature> = + (get@ #key.signature key) + (get@ #key.signature document//key)) + (#error.Success (:share [e] + {(Key e) + key} + {e + document//content})) + (ex.throw invalid-key [(get@ #descriptor.name document//descriptor) key document//key])))) + + (def: #export (write key descriptor content) + (All [d] (-> (Key d) Descriptor d (Document d))) + (:abstraction {#key key + #descriptor descriptor + #content content})) + + (def: #export signature + (-> (Document Any) Signature) + (|>> :representation (get@ #key) (get@ #key.signature))) + ) diff --git a/stdlib/source/lux/compiler/meta/archive/key.lux b/stdlib/source/lux/compiler/meta/archive/key.lux new file mode 100644 index 000000000..1758facf4 --- /dev/null +++ b/stdlib/source/lux/compiler/meta/archive/key.lux @@ -0,0 +1,8 @@ +(.module: + [lux #*] + [// + [signature (#+ Signature)]]) + +(type: #export (Key k) + {#signature Signature + #default k}) diff --git a/stdlib/source/lux/compiler/meta/archive/signature.lux b/stdlib/source/lux/compiler/meta/archive/signature.lux new file mode 100644 index 000000000..5332b79c3 --- /dev/null +++ b/stdlib/source/lux/compiler/meta/archive/signature.lux @@ -0,0 +1,23 @@ +(.module: + [lux #* + [control + ["." equivalence (#+ Equivalence)]] + [data + ["." name] + ["." text + format]]] + [//// + [default (#+ Version)]]) + +## Key +(type: #export Signature + {#name Name + #version Version}) + +(def: #export Equivalence<Signature> + (Equivalence Signature) + (equivalence.product name.Equivalence<Name> text.Equivalence<Text>)) + +(def: #export (description signature) + (-> Signature Text) + (format (%name (get@ #name signature)) " " (get@ #version signature))) |