diff options
| -rw-r--r-- | documentation/research/web_framework.md | 1 | ||||
| -rw-r--r-- | luxc/src/lux/compiler/jvm/proc/common.clj | 8 | ||||
| -rw-r--r-- | stdlib/source/lux.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/control/parser/binary.lux | 141 | ||||
| -rw-r--r-- | stdlib/source/lux/data/format/binary.lux | 147 | ||||
| -rw-r--r-- | stdlib/source/lux/data/name.lux | 13 | ||||
| -rw-r--r-- | stdlib/source/lux/data/number/nat.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/lux/macro/template.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/default/platform.lux | 33 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/language/lux.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/meta/archive.lux | 30 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/meta/archive/artifact.lux | 29 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/meta/io/archive.lux | 16 |
13 files changed, 243 insertions, 202 deletions
diff --git a/documentation/research/web_framework.md b/documentation/research/web_framework.md index 332d6fae5..503f0cde0 100644 --- a/documentation/research/web_framework.md +++ b/documentation/research/web_framework.md @@ -24,6 +24,7 @@ # Exemplar +1. [Mint: The programming language for writing single page applications.](https://www.mint-lang.com/) 1. [root: A recursive UI resolver](https://github.com/den1k/root) 1. https://www.http4k.org/blog/meet_http4k/ 1. Django diff --git a/luxc/src/lux/compiler/jvm/proc/common.clj b/luxc/src/lux/compiler/jvm/proc/common.clj index cb5f48c74..d7023bae0 100644 --- a/luxc/src/lux/compiler/jvm/proc/common.clj +++ b/luxc/src/lux/compiler/jvm/proc/common.clj @@ -40,7 +40,7 @@ ^:private compile-i64-xor Opcodes/LXOR ) -(do-template [<name> <op>] +(do-template [<op> <name>] (defn <name> [compile ?values special-args] (|do [:let [(&/$Cons ?input (&/$Cons ?shift (&/$Nil))) ?values] ^MethodVisitor *writer* &/get-writer @@ -55,9 +55,9 @@ &&/wrap-long)]] (return nil))) - ^:private compile-i64-left-shift Opcodes/LSHL - ^:private compile-i64-arithmetic-right-shift Opcodes/LSHR - ^:private compile-i64-logical-right-shift Opcodes/LUSHR + Opcodes/LSHL ^:private compile-i64-left-shift + Opcodes/LSHR ^:private compile-i64-arithmetic-right-shift + Opcodes/LUSHR ^:private compile-i64-logical-right-shift ) (defn ^:private compile-lux-is [compile ?values special-args] 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) []))) |