aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--commands.md4
-rw-r--r--stdlib/source/lux/data/collection/set.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux33
-rw-r--r--stdlib/source/lux/tool/compiler/meta/archive.lux24
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io.lux9
-rw-r--r--stdlib/source/lux/tool/compiler/meta/io/archive.lux126
-rw-r--r--stdlib/source/lux/world/file.lux3
-rw-r--r--stdlib/source/program/compositor.lux9
8 files changed, 159 insertions, 57 deletions
diff --git a/commands.md b/commands.md
index acb180eef..c8262e479 100644
--- a/commands.md
+++ b/commands.md
@@ -329,8 +329,8 @@ cd ~/lux/lux-jvm/ && java -jar target/program.jar repl --source ~/lux/stdlib/sou
```
cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux
-cd ~/lux/stdlib/ && lein clean && cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux
-cd ~/lux/stdlib/ && lein clean && cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --library ~/lux/stdlib/target/library.tar --target ~/lux/stdlib/target --module test/lux
+cd ~/lux/stdlib/ && cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux
+cd ~/lux/stdlib/ && cd ~/lux/lux-jvm/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --library ~/lux/stdlib/target/library.tar --target ~/lux/stdlib/target --module test/lux
cd ~/lux/lux-jvm/ && java -jar target/program.jar export --source ~/lux/stdlib/source --target ~/lux/stdlib/target
cd ~/lux/stdlib/target/ && java -jar program.jar
diff --git a/stdlib/source/lux/data/collection/set.lux b/stdlib/source/lux/data/collection/set.lux
index f8df4e479..dfefcb1df 100644
--- a/stdlib/source/lux/data/collection/set.lux
+++ b/stdlib/source/lux/data/collection/set.lux
@@ -52,12 +52,16 @@
(//.select (//.keys filter)
base))
-(structure: #export equivalence (All [a] (Equivalence (Set a)))
+(structure: #export equivalence
+ (All [a] (Equivalence (Set a)))
+
(def: (= (^@ reference [hash _]) sample)
(:: (list.equivalence (get@ #hash.&equivalence hash)) =
(..to-list reference) (..to-list sample))))
-(structure: #export hash (All [a] (Hash (Set a)))
+(structure: #export hash
+ (All [a] (Hash (Set a)))
+
(def: &equivalence ..equivalence)
(def: (hash (^@ set [hash _]))
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 8faf83c46..0b811a7b7 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -48,14 +48,14 @@
["." artifact (#+ Registry)]
["." descriptor (#+ Descriptor Module)]
["." document (#+ Document)]]
- [io
+ [io (#+ Context)
["." context]
["ioW" archive]]]]]
[program
[compositor
["." cli (#+ Compilation Library)]
["." static (#+ Static)]
- ["." import]]])
+ ["." import (#+ Import)]]])
(type: #export (Platform anchor expression directive)
{#&file-system (file.System Promise)
@@ -138,9 +138,11 @@
[[registry payload] (///directive.lift-generation
(..compile-runtime! platform))
#let [descriptor,document [(..runtime-descriptor registry) ..runtime-document]]
- archive (///phase.lift (do try.monad
- [[_ archive] (archive.reserve archive.runtime-module archive)]
- (archive.add archive.runtime-module descriptor,document archive)))]
+ archive (///phase.lift (if (archive.reserved? archive archive.runtime-module)
+ (archive.add archive.runtime-module descriptor,document archive)
+ (do try.monad
+ [[_ archive] (archive.reserve archive.runtime-module archive)]
+ (archive.add archive.runtime-module descriptor,document archive))))]
(wrap [archive [descriptor,document payload]])))
(def: (initialize-state extender
@@ -177,7 +179,8 @@
(///phase.run' state)
(:: try.monad map product.left)))
- (def: #export (initialize static module expander host-analysis platform generation-bundle host-directive-bundle program extender)
+ (def: #export (initialize static module expander host-analysis platform generation-bundle host-directive-bundle program extender
+ import compilation-sources)
(All [<type-vars>]
(-> Static
Module
@@ -188,6 +191,7 @@
(///directive.Bundle <type-vars>)
(Program expression directive)
Extender
+ Import (List Context)
(Promise (Try [<State+> Archive]))))
(do (try.with promise.monad)
[#let [state (//init.state (get@ #static.host static)
@@ -201,7 +205,7 @@
program
extender)]
_ (ioW.enable (get@ #&file-system platform) static)
- [archive analysis-state bundles] (ioW.thaw (get@ #host platform) (get@ #&file-system platform) static)
+ [archive analysis-state bundles] (ioW.thaw (get@ #host platform) (get@ #&file-system platform) static import compilation-sources)
state (promise@wrap (initialize-state extender bundles analysis-state state))]
(if (archive.archived? archive archive.runtime-module)
(wrap [state archive])
@@ -275,7 +279,11 @@
#.None])
#.None
- (case (archive.reserve module archive)
+ (case (if (archive.reserved? archive module)
+ (do try.monad
+ [module-id (archive.id module archive)]
+ (wrap [module-id archive]))
+ (archive.reserve module archive))
(#try.Success [module-id archive])
(do @
[_ (stm.write [archive state] current)
@@ -353,9 +361,9 @@
try.assume
product.left))
- (def: #export (compile libraries static expander platform compilation context)
+ (def: #export (compile import static expander platform compilation context)
(All [<type-vars>]
- (-> (List Library) Static Expander <Platform> Compilation <Context> <Return>))
+ (-> Import Static Expander <Platform> Compilation <Context> <Return>))
(let [[compilation-sources compilation-libraries compilation-target compilation-module] compilation
base-compiler (:share [<type-vars>]
{<Context>
@@ -364,14 +372,13 @@
(:assume
((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list)))})]
(do (try.with promise.monad)
- [libraries (import.import (get@ #&file-system platform) compilation-libraries)
- #let [parallel-compiler (..parallel
+ [#let [parallel-compiler (..parallel
context
(function (_ import! module-id [archive state] module)
(do (try.with promise.monad)
[#let [state (..set-current-module module state)]
input (context.read (get@ #&file-system platform)
- libraries
+ import
compilation-sources
(get@ #static.host-module-extension static)
module)]
diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux
index 827dfd013..1aea7327f 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive.lux
@@ -38,28 +38,28 @@
(exception: #export (unknown-document {module Module}
{known-modules (List Module)})
(exception.report
- ["Module" module]
- ["Known Modules" (exception.enumerate function.identity known-modules)]))
+ ["Module" (%.text module)]
+ ["Known Modules" (exception.enumerate %.text known-modules)]))
(exception: #export (cannot-replace-document {module Module}
{old (Document Any)}
{new (Document Any)})
(exception.report
- ["Module" module]
+ ["Module" (%.text module)]
["Old key" (signature.description (document.signature old))]
["New key" (signature.description (document.signature new))]))
(exception: #export (module-has-already-been-reserved {module Module})
(exception.report
- ["Module" module]))
+ ["Module" (%.text module)]))
(exception: #export (module-must-be-reserved-before-it-can-be-added {module Module})
(exception.report
- ["Module" module]))
+ ["Module" (%.text module)]))
(exception: #export (module-is-only-reserved {module Module})
(exception.report
- ["Module" module]))
+ ["Module" (%.text module)]))
(type: #export ID
Nat)
@@ -144,7 +144,7 @@
(def: #export (archived? archive module)
(-> Archive Module Bit)
- (case (find module archive)
+ (case (..find module archive)
(#try.Success _)
yes
@@ -161,6 +161,16 @@
(#.Some _) (#.Some module)
#.None #.None)))))
+ (def: #export (reserved? archive module)
+ (-> Archive Module Bit)
+ (let [(^slots [#..resolver]) (:representation archive)]
+ (case (dictionary.get module resolver)
+ (#.Some [id _])
+ yes
+
+ #.None
+ no)))
+
(def: #export reserved
(-> Archive (List Module))
(|>> :representation
diff --git a/stdlib/source/lux/tool/compiler/meta/io.lux b/stdlib/source/lux/tool/compiler/meta/io.lux
index 11faee222..41481d0fa 100644
--- a/stdlib/source/lux/tool/compiler/meta/io.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io.lux
@@ -5,12 +5,15 @@
[world
[file (#+ Path System)]]])
-(type: #export Context Path)
+(type: #export Context
+ Path)
-(type: #export Code Text)
+(type: #export Code
+ Text)
(def: #export (sanitize system)
(All [m] (-> (System m) Text Text))
(text.replace-all "/" (:: system separator)))
-(def: #export lux-context "lux")
+(def: #export lux-context
+ "lux")
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index eef5907d2..77d7b4689 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -2,6 +2,7 @@
[lux (#- Module)
["@" target (#+ Host)]
[abstract
+ [predicate (#+ Predicate)]
["." monad (#+ do)]]
[control
["." try (#+ Try)]
@@ -20,13 +21,18 @@
[collection
["." list ("#@." functor fold)]
["." dictionary (#+ Dictionary)]
- ["." row (#+ Row)]]]
+ ["." row (#+ Row)]
+ ["." set]]
+ [number
+ ["n" nat]]]
[world
["." file (#+ Path File Directory)]]]
[program
[compositor
+ [import (#+ Import)]
["." static (#+ Static)]]]
- ["." //
+ ["." // (#+ Context)
+ ["#." context]
["/#" //
["." archive (#+ Archive)
["." artifact (#+ Artifact)]
@@ -34,14 +40,15 @@
["." document (#+ Document)]]
[cache
["." dependency]]
- [//
+ ["/#" // (#+ Input)
[language
["$" lux
["." version]
["." analysis]
["." synthesis]
["." generation]
- ["." directive]]]]]])
+ ["." directive]
+ ["#/." program]]]]]])
(exception: #export (cannot-prepare {archive Path}
{module-id archive.ID}
@@ -244,13 +251,19 @@
directives]]))
(#artifact.Definition name)
- (do @
- [value (:: host re-load context directive)]
- (wrap [(dictionary.put name value definitions)
+ (if (text@= $/program.name name)
+ (wrap [definitions
[analysers
synthesizers
generators
- directives]]))
+ directives]])
+ (do @
+ [value (:: host re-load context directive)]
+ (wrap [(dictionary.put name value definitions)
+ [analysers
+ synthesizers
+ generators
+ directives]])))
(#artifact.Analyser extension)
(do @
@@ -321,21 +334,76 @@
[document bundles] (promise@wrap (loaded-document (get@ #static.artifact-extension static) host-environment module-id expected actual document))]
(wrap [[descriptor document] bundles])))
-(def: (load-every-reserved-module host-environment system static archive)
+(def: (purge! system static [module-name module-id])
+ (-> (file.System Promise) Static [Module archive.ID] (Promise (Try Any)))
+ (do {@ (try.with promise.monad)}
+ [cache (!.use (:: system directory) [(..module system static module-id)])
+ artifacts (!.use (:: cache files) [])
+ _ (monad.map @ (function (_ artifact)
+ (!.use (:: artifact delete) []))
+ artifacts)]
+ (!.use (:: cache discard) [])))
+
+(def: (valid-cache? expected actual)
+ (-> Descriptor Input Bit)
+ (and (text@= (get@ #descriptor.name expected)
+ (get@ #////.module actual))
+ (text@= (get@ #descriptor.file expected)
+ (get@ #////.file actual))
+ (n.= (get@ #descriptor.hash expected)
+ (get@ #////.hash actual))))
+
+(type: Purge
+ (Dictionary Module archive.ID))
+
+(def: initial-purge
+ (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]])
+ Purge)
+ (|>> (list.search-all (function (_ [valid-cache? [module-name [module-id _]]])
+ (if valid-cache?
+ #.None
+ (#.Some [module-name module-id]))))
+ (dictionary.from-list text.hash)))
+
+(def: (full-purge caches load-order)
+ (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]])
+ dependency.Order
+ Purge)
+ (list@fold (function (_ [module-name [module-id [descriptor document]]] purge)
+ (let [purged? (: (Predicate Module)
+ (function (_ module)
+ (dictionary.contains? module purge)))]
+ (if (purged? module-name)
+ purge
+ (if (|> descriptor
+ (get@ #descriptor.references)
+ set.to-list
+ (list.any? purged?))
+ (dictionary.put module-name module-id purge)
+ purge))))
+ (..initial-purge caches)
+ load-order))
+
+(def: (load-every-reserved-module host-environment system static import contexts archive)
(All [expression directive]
- (-> (generation.Host expression directive) (file.System Promise) Static Archive
- (Promise (Try [Archive
- .Lux
- Bundles]))))
+ (-> (generation.Host expression directive) (file.System Promise) Static Import (List Context) Archive
+ (Promise (Try [Archive .Lux Bundles]))))
(do {@ (try.with promise.monad)}
[pre-loaded-caches (|> archive
archive.reservations
(monad.map @ (function (_ [module-name module-id])
(do @
[data (..read-module-descriptor system static module-id)
- descriptor,document (promise@wrap (<b>.run ..parser data))]
- (wrap [module-name [module-id descriptor,document]])))))
+ [descriptor document] (promise@wrap (<b>.run ..parser data))]
+ (if (text@= archive.runtime-module module-name)
+ (wrap [true
+ [module-name [module-id [descriptor document]]]])
+ (do @
+ [input (//context.read system import contexts (get@ #static.host-module-extension static) module-name)]
+ (wrap [(..valid-cache? descriptor input)
+ [module-name [module-id [descriptor document]]]])))))))
load-order (|> pre-loaded-caches
+ (list@map product.right)
(monad.fold try.monad
(function (_ [module [module-id descriptor,document]] archive)
(archive.add module descriptor,document archive))
@@ -343,15 +411,21 @@
(:: try.monad map (dependency.load-order $.key))
(:: try.monad join)
promise@wrap)
- loaded-caches (monad.map @ (function (_ [module-name [module-id descriptor,document]])
- (do @
- [[descriptor,document bundles] (..load-definitions system static module-id host-environment descriptor,document)]
- (wrap [[module-name descriptor,document]
- bundles])))
- load-order)]
+ #let [purge (..full-purge pre-loaded-caches load-order)]
+ _ (|> purge
+ dictionary.entries
+ (monad.map @ (..purge! system static)))
+ loaded-caches (|> load-order
+ (list.filter (function (_ [module-name [module-id [descriptor document]]])
+ (not (dictionary.contains? module-name purge))))
+ (monad.map @ (function (_ [module-name [module-id descriptor,document]])
+ (do @
+ [[descriptor,document bundles] (..load-definitions system static module-id host-environment descriptor,document)]
+ (wrap [[module-name descriptor,document]
+ bundles])))))]
(promise@wrap
- (do try.monad
- [archive (monad.fold try.monad
+ (do {@ try.monad}
+ [archive (monad.fold @
(function (_ [[module descriptor,document] _bundle] archive)
(archive.add module descriptor,document archive))
archive
@@ -368,9 +442,9 @@
..empty-bundles
loaded-caches)])))))
-(def: #export (thaw host-environment system static)
+(def: #export (thaw host-environment system static import contexts)
(All [expression directive]
- (-> (generation.Host expression directive) (file.System Promise) Static
+ (-> (generation.Host expression directive) (file.System Promise) Static Import (List Context)
(Promise (Try [Archive .Lux Bundles]))))
(do promise.monad
[file (!.use (:: system file) (..general-descriptor system static))]
@@ -379,7 +453,7 @@
(do (try.with promise.monad)
[binary (!.use (:: file content) [])
archive (promise@wrap (archive.import ///.version binary))]
- (..load-every-reserved-module host-environment system static archive))
+ (..load-every-reserved-module host-environment system static import contexts archive))
(#try.Failure error)
(wrap (#try.Success [archive.empty
diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux
index f3fffe1c9..709704e95 100644
--- a/stdlib/source/lux/world/file.lux
+++ b/stdlib/source/lux/world/file.lux
@@ -30,7 +30,8 @@
[macro
["." template]]])
-(type: #export Path Text)
+(type: #export Path
+ Text)
(capability: #export (Can-Open ! capability)
(can-open Path (! (Try (capability !)))))
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index dc8be4f83..695d8a9d9 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -55,7 +55,8 @@
["." / #_
["#." cli (#+ Service)]
["#." static (#+ Static)]
- ["#." export]])
+ ["#." export]
+ ["#." import]])
(def: (or-crash! failure-description action)
(All [a]
@@ -117,17 +118,19 @@
(<| (or-crash! "Compilation failed:")
(do (try.with promise.monad)
[#let [[compilation-sources compilation-libraries compilation-target compilation-module] compilation]
+ import (/import.import (get@ #platform.&file-system platform) compilation-libraries)
[state archive] (:share [<parameters>]
{(Platform <parameters>)
platform}
{(Promise (Try [(directive.State+ <parameters>)
Archive]))
- (:assume (platform.initialize static compilation-module expander host-analysis platform generation-bundle host-directive-bundle program extender))})
+ (:assume (platform.initialize static compilation-module expander host-analysis platform generation-bundle host-directive-bundle program extender
+ import compilation-sources))})
[archive state] (:share [<parameters>]
{(Platform <parameters>)
platform}
{(Promise (Try [Archive (directive.State+ <parameters>)]))
- (:assume (platform.compile compilation-libraries static expander platform compilation [archive state]))})
+ (:assume (platform.compile import static expander platform compilation [archive state]))})
_ (ioW.freeze (get@ #platform.&file-system platform) static archive)
program-context (promise@wrap ($/program.context archive))
_ (promise.future (..package! io.monad file.system packager,package static archive program-context))]
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-02 20:57:40 +0000