aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--stdlib/source/lux/compiler/meta/archive.lux168
-rw-r--r--stdlib/source/lux/compiler/meta/archive/descriptor.lux13
-rw-r--r--stdlib/source/lux/compiler/meta/archive/document.lux51
-rw-r--r--stdlib/source/lux/compiler/meta/archive/key.lux8
-rw-r--r--stdlib/source/lux/compiler/meta/archive/signature.lux23
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)))