aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
authorEduardo Julian2020-05-05 00:47:58 -0400
committerEduardo Julian2020-05-05 00:47:58 -0400
commit724372e2b023bccbb93e1fa40e3c92ed2ee7e36c (patch)
treeb15130eb6e8fea2f4d1586085524517d92af0b4b /stdlib
parenta419ec66895e07fbb54ecc59f92e154126a10ac5 (diff)
Fixed bugs while parsing modules' cached data.
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux.lux4
-rw-r--r--stdlib/source/lux/control/parser/binary.lux141
-rw-r--r--stdlib/source/lux/data/format/binary.lux147
-rw-r--r--stdlib/source/lux/data/name.lux13
-rw-r--r--stdlib/source/lux/data/number/nat.lux8
-rw-r--r--stdlib/source/lux/macro/template.lux3
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux33
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux.lux12
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive.lux30
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive/artifact.lux29
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux16
11 files changed, 238 insertions, 198 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 265b8e979..70eb486f3 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -420,11 +420,11 @@
#1)
## (type: Alias
-## Name)
+## [Text Text])
("lux def" Alias
("lux check type"
(#Named ["lux" "Alias"]
- Name))
+ (#Product Text Text)))
(record$ #Nil)
#1)
diff --git a/stdlib/source/lux/control/parser/binary.lux b/stdlib/source/lux/control/parser/binary.lux
index dc1b95ac7..137094340 100644
--- a/stdlib/source/lux/control/parser/binary.lux
+++ b/stdlib/source/lux/control/parser/binary.lux
@@ -18,7 +18,9 @@
[collection
["." list]
["." row (#+ Row)]
- ["." set (#+ Set)]]]]
+ ["." set (#+ Set)]]]
+ [macro
+ ["." template]]]
["." // ("#@." monad)])
(type: #export Offset Nat)
@@ -26,10 +28,10 @@
(type: #export Parser
(//.Parser [Offset Binary]))
-(exception: #export (binary-was-not-fully-read {length Nat} {read Nat})
+(exception: #export (binary-was-not-fully-read {binary-length Nat} {bytes-read Nat})
(exception.report
- ["Binary length" (%.nat length)]
- ["Read bytes" (%.nat read)]))
+ ["Binary length" (%.nat binary-length)]
+ ["Bytes read" (%.nat bytes-read)]))
(def: #export (run parser input)
(All [a] (-> (Parser a) Binary (Try a)))
@@ -81,18 +83,23 @@
(exception: #export (invalid-tag {range Nat} {byte Nat})
(exception.report
- ["Range" (%.nat range)]
- ["Byte" (%.nat byte)]))
+ ["Tag range" (%.nat range)]
+ ["Tag value" (%.nat byte)]))
-(def: #export (or left right)
- (All [l r] (-> (Parser l) (Parser r) (Parser (| l r))))
+(template: (!variant <case>+)
(do //.monad
[flag (: (Parser Nat)
..bits/8)]
- (case flag
- 0 (:: @ map (|>> #.Left) left)
- 1 (:: @ map (|>> #.Right) right)
- _ (//.lift (exception.throw ..invalid-tag [2 flag])))))
+ (`` (case flag
+ (^template [<number> <tag> <parser>]
+ <number> (:: @ map (|>> <tag>) <parser>))
+ ((~~ (template.splice <case>+)))
+ _ (//.lift (exception.throw ..invalid-tag [(~~ (template.count <case>+)) flag]))))))
+
+(def: #export (or left right)
+ (All [l r] (-> (Parser l) (Parser r) (Parser (| l r))))
+ (!variant [[0 #.Left left]
+ [1 #.Right right]]))
(def: #export (rec body)
(All [a] (-> (-> (Parser a) (Parser a)) (Parser a)))
@@ -104,13 +111,20 @@
(Parser Any)
(//@wrap []))
+(exception: #export (not-a-bit {value Nat})
+ (exception.report
+ ["Expected values" "either 0 or 1"]
+ ["Actual value" (%.nat value)]))
+
(def: #export bit
(Parser Bit)
(do //.monad
- [choice (..or ..any ..any)]
- (wrap (case choice
- (#.Left _) #0
- (#.Right _) #1))))
+ [value (: (Parser Nat)
+ ..bits/8)]
+ (case value
+ 0 (wrap #0)
+ 1 (wrap #1)
+ _ (//.lift (exception.throw ..not-a-bit [value])))))
(template [<name> <bits> <size>]
[(def: #export <name>
@@ -118,10 +132,12 @@
(do //.monad
[size (//@map .nat <bits>)]
(function (_ [offset binary])
- (do try.monad
- [#let [end (n.+ size offset)]
- output (binary.slice offset (.dec end) binary)]
- (wrap [[end binary] output])))))]
+ (case size
+ 0 (#try.Success [[offset binary] (binary.create 0)])
+ _ (do try.monad
+ [#let [end (n.+ size offset)]
+ output (binary.slice offset (.dec end) binary)]
+ (wrap [[end binary] output]))))))]
[binary/8 ..bits/8 ..size/8]
[binary/16 ..bits/16 ..size/16]
@@ -148,7 +164,8 @@
[(def: #export (<name> valueP)
(All [v] (-> (Parser v) (Parser (Row v))))
(do //.monad
- [count (//@map .nat <bits>)]
+ [count (: (Parser Nat)
+ <bits>)]
(loop [index 0
output (:share [v]
{(Parser v)
@@ -175,16 +192,15 @@
(def: #export (list value)
(All [a] (-> (Parser a) (Parser (List a))))
(..rec
- (function (_ recur)
- (..or ..any
- (//.and value recur)))))
+ (|>> (//.and value)
+ (..or ..any))))
(exception: #export set-elements-are-not-unique)
(def: #export (set hash value)
(All [a] (-> (Hash a) (Parser a) (Parser (Set a))))
(do //.monad
- [raw (list value)
+ [raw (..list value)
#let [output (set.from-list hash raw)]
_ (//.assert (exception.construct ..set-elements-are-not-unique [])
(n.= (list.size raw)
@@ -202,30 +218,17 @@
(let [pair (//.and type type)
indexed ..nat
quantified (//.and (..list type) type)]
- ($_ ..or
- ## #Primitive
- (//.and ..text (..list type))
- ## #Sum
- pair
- ## #Product
- pair
- ## #Function
- pair
- ## #Parameter
- indexed
- ## #Var
- indexed
- ## #Ex
- indexed
- ## #UnivQ
- quantified
- ## #ExQ
- quantified
- ## #Apply
- pair
- ## #Named
- (//.and ..name type)
- )))))
+ (!variant [[0 #.Primitive (//.and ..text (..list type))]
+ [1 #.Sum pair]
+ [2 #.Product pair]
+ [3 #.Function pair]
+ [4 #.Parameter indexed]
+ [5 #.Var indexed]
+ [6 #.Ex indexed]
+ [7 #.UnivQ quantified]
+ [8 #.ExQ quantified]
+ [9 #.Apply pair]
+ [10 #.Named (//.and ..name type)]])))))
(def: #export cursor
(Parser Cursor)
@@ -234,29 +237,17 @@
(def: #export code
(Parser Code)
(..rec
- (function (_ code)
- (let [sequence (..list code)
- code' ($_ ..or
- ## #Bit
- ..bit
- ## #Nat
- ..nat
- ## #Int
- ..int
- ## #Rev
- ..rev
- ## #Frac
- ..frac
- ## #Text
- ..text
- ## #Identifier
- ..name
- ## #Tag
- ..name
- ## #Form
- sequence
- ## #Tuple
- sequence
- ## #Record
- (..list (//.and code code)))]
- (//.and ..cursor code')))))
+ (function (_ recur)
+ (let [sequence (..list recur)]
+ (//.and ..cursor
+ (!variant [[0 #.Bit ..bit]
+ [1 #.Nat ..nat]
+ [2 #.Int ..int]
+ [3 #.Rev ..rev]
+ [4 #.Frac ..frac]
+ [5 #.Text ..text]
+ [6 #.Identifier ..name]
+ [7 #.Tag ..name]
+ [8 #.Form sequence]
+ [9 #.Tuple sequence]
+ [10 #.Record (..list (//.and recur recur))]]))))))
diff --git a/stdlib/source/lux/data/format/binary.lux b/stdlib/source/lux/data/format/binary.lux
index fd812a31a..90e3cc468 100644
--- a/stdlib/source/lux/data/format/binary.lux
+++ b/stdlib/source/lux/data/format/binary.lux
@@ -7,6 +7,7 @@
[monad (#+ Monad do)]
[equivalence (#+ Equivalence)]]
[control
+ [pipe (#+ case>)]
["." function]
["." try (#+ Try)]
["<>" parser ("#@." monad)
@@ -82,25 +83,18 @@
(All [l r] (-> (Writer l) (Writer r) (Writer (| l r))))
(function (_ altV)
(case altV
- (#.Left leftV)
- (let [[leftS leftT] (left leftV)]
- [(.inc leftS)
- (function (_ [offset binary])
- (|> binary
- (binary.write/8 offset 0)
- try.assume
- [(.inc offset)]
- leftT))])
-
- (#.Right rightV)
- (let [[rightS rightT] (right rightV)]
- [(.inc rightS)
- (function (_ [offset binary])
- (|> binary
- (binary.write/8 offset 1)
- try.assume
- [(.inc offset)]
- rightT))])
+ (^template [<number> <tag> <writer>]
+ (<tag> caseV)
+ (let [[caseS caseT] (<writer> caseV)]
+ [(.inc caseS)
+ (function (_ [offset binary])
+ (|> binary
+ (binary.write/8 offset <number>)
+ try.assume
+ [(.inc offset)]
+ caseT))]))
+ ([0 #.Left left]
+ [1 #.Right right])
)))
(def: #export (and pre post)
@@ -119,13 +113,7 @@
(def: #export bit
(Writer Bit)
- (function (_ value)
- [1
- (function (_ [offset binary])
- [(n.+ 1 offset)
- (|> binary
- (binary.write/8 offset (if value 1 0))
- try.assume)])]))
+ (|>> (case> #0 0 #1 1) ..bits/8))
(template [<name> <type>]
[(def: #export <name> (Writer <type>) ..bits/64)]
@@ -224,34 +212,34 @@
(def: #export type
(Writer Type)
(..rec
- (function (_ type)
- (let [pair (..and type type)
+ (function (_ recur)
+ (let [pair (..and recur recur)
indexed ..nat
- quantified (..and (..list type) type)]
- ($_ ..or
- ## #Primitive
- (..and ..text (..list type))
- ## #Sum
- pair
- ## #Product
- pair
- ## #Function
- pair
- ## #Parameter
- indexed
- ## #Var
- indexed
- ## #Ex
- indexed
- ## #UnivQ
- quantified
- ## #ExQ
- quantified
- ## #Apply
- pair
- ## #Named
- (..and ..name type)
- )))))
+ quantified (..and (..list recur) recur)]
+ (function (_ altV)
+ (case altV
+ (^template [<number> <tag> <writer>]
+ (<tag> caseV)
+ (let [[caseS caseT] (<writer> caseV)]
+ [(.inc caseS)
+ (function (_ [offset binary])
+ (|> binary
+ (binary.write/8 offset <number>)
+ try.assume
+ [(.inc offset)]
+ caseT))]))
+ ([0 #.Primitive (..and ..text (..list recur))]
+ [1 #.Sum pair]
+ [2 #.Product pair]
+ [3 #.Function pair]
+ [4 #.Parameter indexed]
+ [5 #.Var indexed]
+ [6 #.Ex indexed]
+ [7 #.UnivQ quantified]
+ [8 #.ExQ quantified]
+ [9 #.Apply pair]
+ [10 #.Named (..and ..name recur)])
+ ))))))
(def: #export cursor
(Writer Cursor)
@@ -260,29 +248,30 @@
(def: #export code
(Writer Code)
(..rec
- (function (_ code)
- (let [sequence (..list code)
- code' ($_ ..or
- ## #Bit
- ..bit
- ## #Nat
- ..nat
- ## #Int
- ..int
- ## #Rev
- ..rev
- ## #Frac
- ..frac
- ## #Text
- ..text
- ## #Identifier
- ..name
- ## #Tag
- ..name
- ## #Form
- sequence
- ## #Tuple
- sequence
- ## #Record
- (..list (..and code code)))]
- (..and ..cursor code')))))
+ (function (_ recur)
+ (let [sequence (..list recur)]
+ (..and ..cursor
+ (function (_ altV)
+ (case altV
+ (^template [<number> <tag> <writer>]
+ (<tag> caseV)
+ (let [[caseS caseT] (<writer> caseV)]
+ [(.inc caseS)
+ (function (_ [offset binary])
+ (|> binary
+ (binary.write/8 offset <number>)
+ try.assume
+ [(.inc offset)]
+ caseT))]))
+ ([0 #.Bit ..bit]
+ [1 #.Nat ..nat]
+ [2 #.Int ..int]
+ [3 #.Rev ..rev]
+ [4 #.Frac ..frac]
+ [5 #.Text ..text]
+ [6 #.Identifier ..name]
+ [7 #.Tag ..name]
+ [8 #.Form sequence]
+ [9 #.Tuple sequence]
+ [10 #.Record (..list (..and recur recur))])
+ )))))))
diff --git a/stdlib/source/lux/data/name.lux b/stdlib/source/lux/data/name.lux
index 88eb25c99..897690144 100644
--- a/stdlib/source/lux/data/name.lux
+++ b/stdlib/source/lux/data/name.lux
@@ -20,20 +20,25 @@
[short short]
)
-(structure: #export equivalence (Equivalence Name)
+(structure: #export equivalence
+ (Equivalence Name)
+
(def: (= [xmodule xname] [ymodule yname])
(and (text@= xmodule ymodule)
(text@= xname yname))))
(structure: #export order
(Order Name)
+
(def: &equivalence ..equivalence)
(def: (< [moduleP shortP] [moduleS shortS])
(if (text@= moduleP moduleS)
(:: text.order < shortP shortS)
(:: text.order < moduleP moduleS))))
-(structure: #export codec (Codec Text Name)
+(structure: #export codec
+ (Codec Text Name)
+
(def: (encode [module short])
(case module
"" short
@@ -52,7 +57,9 @@
_
(#.Left (text@compose "Invalid format for Name: " input))))))
-(structure: #export hash (Hash Name)
+(structure: #export hash
+ (Hash Name)
+
(def: &equivalence ..equivalence)
(def: (hash [module name])
diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/data/number/nat.lux
index 4066d7b2f..9f370fb51 100644
--- a/stdlib/source/lux/data/number/nat.lux
+++ b/stdlib/source/lux/data/number/nat.lux
@@ -308,7 +308,9 @@
_ #.None))
(template [<struct> <base> <to-character> <to-value> <error>]
- [(structure: #export <struct> (Codec Text Nat)
+ [(structure: #export <struct>
+ (Codec Text Nat)
+
(def: (encode value)
(loop [input value
output ""]
@@ -343,6 +345,8 @@
[hex 16 hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Nat: "]
)
-(structure: #export hash (Hash Nat)
+(structure: #export hash
+ (Hash Nat)
+
(def: &equivalence ..equivalence)
(def: hash function.identity))
diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux
index 5c163aabd..ef4332a45 100644
--- a/stdlib/source/lux/macro/template.lux
+++ b/stdlib/source/lux/macro/template.lux
@@ -22,6 +22,9 @@
(syntax: #export (splice {parts (s.tuple (p.some s.any))})
(wrap parts))
+(syntax: #export (count {parts (s.tuple (p.some s.any))})
+ (wrap (list (code.nat (list.size parts)))))
+
(syntax: #export (with-locals {locals (s.tuple (p.some s.local-identifier))}
body)
(do @
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 9a4c6f20c..58a2d4b32 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -7,16 +7,17 @@
[control
["." try (#+ Try)]
[concurrency
- ["." promise (#+ Promise) ("#@." monad)]]]
+ ["." promise (#+ Promise) ("#@." monad)]]
+ ["<>" parser
+ ["<b>" binary (#+ Parser)]]]
[data
- [binary (#+ Binary)]
+ ["." binary (#+ Binary)]
["." bit]
["." product]
["." text
["%" format (#+ format)]]
[collection
- ["." list]
- ["." row ("#@." functor)]]
+ ["." row]]
[format
["_" binary (#+ Writer)]]]
[world
@@ -75,6 +76,11 @@
(_.and descriptor.writer
(document.writer $.writer)))
+ (def: parser
+ (Parser [Descriptor (Document .Module)])
+ (<>.and descriptor.parser
+ (document.parser $.parser)))
+
(def: (cache-module platform host target-dir module-file-name module-id extension [[descriptor document] output])
(All <type-vars>
(-> <Platform> Host Path Path archive.ID Text [[Descriptor (Document Any)] Output]
@@ -93,6 +99,22 @@
(document.check //init.key document))]
(ioW.cache system host target-dir module-id
(_.run ..writer [descriptor document])))))
+
+ (def: (load-cache system host target-dir archive)
+ (All <type-vars>
+ (-> (file.System Promise) Host Path Archive (Promise (Try Archive))))
+ (do (try.with promise.monad)
+ [all-loaded-caches (|> (archive.reservations archive)
+ (monad.map @ (function (_ [module-name module-id])
+ (do @
+ [data (ioW.load system host target-dir module-id)
+ payload (promise@wrap (<b>.run ..parser data))]
+ (wrap [module-name payload])))))]
+ (promise@wrap (monad.fold try.monad
+ (function (_ [module descriptor+document] archive)
+ (archive.add module descriptor+document archive))
+ archive
+ all-loaded-caches))))
## TODO: Inline ASAP
(def: initialize-buffer!
@@ -131,7 +153,8 @@
extender)]
(do (try.with promise.monad)
[_ (ioW.enable (get@ #&file-system platform) host target)
- archive (ioW.thaw (get@ #&file-system platform) host target)]
+ archive (ioW.thaw (get@ #&file-system platform) host target)
+ archive (load-cache (get@ #&file-system platform) host target archive)]
(|> (do ///phase.monad
[_ ..initialize-buffer!
_ (..compile-runtime! platform)
diff --git a/stdlib/source/lux/tool/compiler/language/lux.lux b/stdlib/source/lux/tool/compiler/language/lux.lux
index ed3b0ed9b..f823c1eaf 100644
--- a/stdlib/source/lux/tool/compiler/language/lux.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux.lux
@@ -15,9 +15,11 @@
($_ _.and _.bit _.type _.code _.any))
name (: (Writer Name)
(_.and _.text _.text))
- alias name
+ alias (: (Writer Alias)
+ (_.and _.text _.text))
global (: (Writer Global)
- (_.or alias definition))
+ (_.or alias
+ definition))
tag (: (Writer [Nat (List Name) Bit Type])
($_ _.and
_.nat
@@ -53,9 +55,11 @@
($_ <>.and <b>.bit <b>.type <b>.code <b>.any))
name (: (Parser Name)
(<>.and <b>.text <b>.text))
- alias name
+ alias (: (Parser Alias)
+ (<>.and <b>.text <b>.text))
global (: (Parser Global)
- (<>.or alias definition))
+ (<b>.or alias
+ definition))
tag (: (Parser [Nat (List Name) Bit Type])
($_ <>.and
<b>.nat
diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux
index a0a4b5bf2..49358065b 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive.lux
@@ -149,6 +149,18 @@
(#.Some _) (#.Some module)
#.None #.None)))))
+ (def: #export reserved
+ (-> Archive (List Module))
+ (|>> :representation
+ dictionary.keys))
+
+ (def: #export reservations
+ (-> Archive (List [Module ID]))
+ (|>> :representation
+ dictionary.entries
+ (list@map (function (_ [module [id _]])
+ [module id]))))
+
(def: #export (merge additions archive)
(-> Archive Archive (Try Archive))
(monad.fold try.monad
@@ -164,8 +176,8 @@
archive
(dictionary.entries (:representation additions))))
- (type: Reservations (List [Module ID]))
- (type: Frozen [Version Reservations])
+ (type: Reservation [Module ID])
+ (type: Frozen [Version (List Reservation)])
(def: reader
(Parser ..Frozen)
@@ -182,10 +194,10 @@
(|> archive
:representation
dictionary.entries
- (list@map (function (_ [module [id _]])
- [module id]))
- (list.sort (function (_ [moduleL idL] [moduleR idR])
- (n.< idL idR)))
+ (list.search-all (function (_ [module [id descriptor+document]])
+ (case descriptor+document
+ (#.Some _) (#.Some [module id])
+ #.None #.None)))
[version]
(binary.run ..writer)))
@@ -197,7 +209,7 @@
(exception: #export corrupt-data)
(def: (correct-modules? reservations)
- (-> Reservations Bit)
+ (-> (List Reservation) Bit)
(n.= (list.size reservations)
(|> reservations
(list@map product.left)
@@ -205,7 +217,7 @@
set.size)))
(def: (correct-ids? reservations)
- (-> Reservations Bit)
+ (-> (List Reservation) Bit)
(n.= (list.size reservations)
(|> reservations
(list@map product.right)
@@ -213,7 +225,7 @@
set.size)))
(def: (correct-reservations? reservations)
- (-> Reservations Bit)
+ (-> (List Reservation) Bit)
(and (correct-modules? reservations)
(correct-ids? reservations)))
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
index 7f3e1654d..28f01bbcb 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive/artifact.lux
@@ -9,8 +9,8 @@
["." product]
["." text]
[collection
- ["." list ("#@." functor fold)]
- ["." row (#+ Row)]
+ ["." list]
+ ["." row (#+ Row) ("#@." functor fold)]
["." dictionary (#+ Dictionary)]]
[format
["." binary (#+ Writer)]]]
@@ -75,23 +75,22 @@
(def: #export writer
(Writer Registry)
- (let [writer|artifacts (binary.list (binary.maybe binary.text))]
+ (let [writer|artifacts (binary.row/64 (binary.maybe binary.text))]
(|>> :representation
(get@ #artifacts)
- row.to-list
- (list@map (get@ #name))
+ (row@map (get@ #name))
writer|artifacts)))
(def: #export parser
(Parser Registry)
- (|> (<b>.list (<b>.maybe <b>.text))
- (:: <>.monad map (list@fold (function (_ artifact registry)
- (product.right
- (case artifact
- #.None
- (..resource registry)
-
- (#.Some name)
- (..definition name registry))))
- ..empty))))
+ (|> (<b>.row/64 (<b>.maybe <b>.text))
+ (:: <>.monad map (row@fold (function (_ artifact registry)
+ (product.right
+ (case artifact
+ #.None
+ (..resource registry)
+
+ (#.Some name)
+ (..definition name registry))))
+ ..empty))))
)
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index ee7af993b..a40c8427f 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -122,7 +122,15 @@
(def: #export (cache system host root module-id content)
(-> (System Promise) Host Path archive.ID Binary (Promise (Try Any)))
(do (try.with promise.monad)
- [artifact (: (Promise (Try (File Promise)))
- (file.get-file promise.monad system
- (..module-descriptor system host root module-id)))]
- (!.use (:: artifact over-write) content)))
+ [file (: (Promise (Try (File Promise)))
+ (file.get-file promise.monad system
+ (..module-descriptor system host root module-id)))]
+ (!.use (:: file over-write) content)))
+
+(def: #export (load system host root module-id)
+ (-> (System Promise) Host Path archive.ID (Promise (Try Binary)))
+ (do (try.with promise.monad)
+ [file (: (Promise (Try (File Promise)))
+ (file.get-file promise.monad system
+ (..module-descriptor system host root module-id)))]
+ (!.use (:: file content) [])))