From 5d2512af61ac17bca25a4790ea01c24f7d2415da Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 29 Jun 2020 00:11:01 -0400 Subject: Added the missing cache invalidation to the new compiler. --- commands.md | 4 +- stdlib/source/lux/data/collection/set.lux | 8 +- .../source/lux/tool/compiler/default/platform.lux | 33 +++--- stdlib/source/lux/tool/compiler/meta/archive.lux | 24 ++-- stdlib/source/lux/tool/compiler/meta/io.lux | 9 +- .../source/lux/tool/compiler/meta/io/archive.lux | 126 ++++++++++++++++----- stdlib/source/lux/world/file.lux | 3 +- stdlib/source/program/compositor.lux | 9 +- 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 [] (-> Static Module @@ -188,6 +191,7 @@ (///directive.Bundle ) (Program expression directive) Extender + Import (List Context) (Promise (Try [ 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 [] - (-> (List Library) Static Expander Compilation )) + (-> Import Static Expander Compilation )) (let [[compilation-sources compilation-libraries compilation-target compilation-module] compilation base-compiler (:share [] { @@ -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 (.run ..parser data))] - (wrap [module-name [module-id descriptor,document]]))))) + [descriptor document] (promise@wrap (.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 [] {(Platform ) platform} {(Promise (Try [(directive.State+ ) 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 [] {(Platform ) platform} {(Promise (Try [Archive (directive.State+ )])) - (: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))] -- cgit v1.2.3