diff options
Diffstat (limited to '')
16 files changed, 440 insertions, 234 deletions
diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux index 45430e7e9..bd3d68711 100644 --- a/stdlib/source/library/lux/target/python.lux +++ b/stdlib/source/library/lux/target/python.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" Location Code Label not or and list if int comment exec try} + [lux {"-" Location Code not or and list if int comment exec try} ["@" target] ["[0]" ffi] [abstract @@ -99,7 +99,6 @@ [Literal Computation] [Access Location] [Loop Statement] - [Label Code] ) (template [<var> <brand>] diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 787866710..d9d794a7b 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -54,6 +54,7 @@ [import {"+" Import}] ["[0]" context {"+" Context}] ["[0]" cache + ["[1]/[0]" archive] ["[1]/[0]" module] ["[1]/[0]" artifact]] [cli {"+" Compilation Library} @@ -110,9 +111,10 @@ (let [system (value@ #&file_system platform) write_artifact! (: (-> [artifact.ID (Maybe Text) Binary] (Action Any)) (function (_ [artifact_id custom content]) - (cache/artifact.write! system context module_id artifact_id content)))] + (cache/artifact.cache! system context module_id artifact_id content)))] (do [! ..monad] - [_ (cache/module.enable! system context module_id) + [_ (: (Async (Try Any)) + (cache/module.enable! async.monad system context module_id)) _ (for [@.python (|> entry (value@ archive.#output) sequence.list @@ -131,7 +133,7 @@ (with@ module.#document document)) (value@ archive.#registry entry)] (_.result ..writer) - (ioW.cache system context module_id))))) + (cache/module.cache! system context module_id))))) ... TODO: Inline ASAP (def: initialize_buffer! @@ -264,7 +266,8 @@ (value@ #host platform) (value@ #phase platform) generation_bundle)] - _ (cache.enable! (value@ #&file_system platform) context) + _ (: (Async (Try Any)) + (cache.enable! async.monad (value@ #&file_system platform) context)) [archive analysis_state bundles] (ioW.thaw compilation_configuration (value@ #host platform) (value@ #&file_system platform) context import compilation_sources) .let [with_missing_extensions (: (All (_ <type_vars>) @@ -720,7 +723,7 @@ {try.#Failure error} (do ! - [_ (ioW.freeze (value@ #&file_system platform) context archive)] + [_ (cache/archive.cache! (value@ #&file_system platform) context archive)] (async#in {try.#Failure error})))))))) (exception: .public (invalid_custom_compiler [definition Symbol diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux index e074f1f92..7312fb9de 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux @@ -1,100 +1,105 @@ (.using - [library - [lux "*" - ["[0]" ffi] - [abstract - ["[0]" monad {"+" do}]] - [control - ["<>" parser - ["<c>" code {"+" Parser}]]] - [data - [collection - ["[0]" array {"+" Array}] - ["[0]" dictionary] - ["[0]" list]]] - ["[0]" type - ["[0]" check]] - ["@" target - ["_" php]]]] + [library + [lux "*" + ["[0]" ffi] + [abstract + ["[0]" monad {"+" do}]] + [control + ["<>" parser + ["<c>" code {"+" Parser}]]] + [data + [collection + ["[0]" array {"+" Array}] + ["[0]" dictionary] + ["[0]" list]]] + ["[0]" type + ["[0]" check]] + ["@" target + ["_" php]]]] + [// + ["/" lux {"+" custom}] [// - ["/" lux {"+" custom}] + ["[0]" bundle] [// - ["[0]" bundle] + ["[0]" analysis "_" + ["[1]/[0]" type]] [// - ["[0]" analysis "_" - ["[1]/[0]" type]] - [// - ["[0]" analysis {"+" Analysis Operation Phase Handler Bundle}] - [/// - ["[0]" phase]]]]]]) + ["[0]" analysis {"+" Analysis Operation Phase Handler Bundle}] + [/// + ["[0]" phase]]]]]]) (def: array::new Handler (custom [<c>.any (function (_ extension phase archive lengthC) - (do phase.monad - [lengthA (analysis/type.with_type Nat - (phase archive lengthC)) - [var_id varT] (analysis/type.with_env check.var) - _ (analysis/type.infer (type (Array varT)))] - (in {analysis.#Extension extension (list lengthA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [lengthA (analysis/type.with_type Nat + (phase archive lengthC)) + _ (analysis/type.infer (type (Array :var:)))] + (in {analysis.#Extension extension (list lengthA)}))))])) (def: array::length Handler (custom [<c>.any (function (_ extension phase archive arrayC) - (do phase.monad - [[var_id varT] (analysis/type.with_env check.var) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer Nat)] - (in {analysis.#Extension extension (list arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [arrayA (analysis/type.with_type (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer Nat)] + (in {analysis.#Extension extension (list arrayA)}))))])) (def: array::read Handler (custom [(<>.and <c>.any <c>.any) (function (_ extension phase archive [indexC arrayC]) - (do phase.monad - [indexA (analysis/type.with_type Nat - (phase archive indexC)) - [var_id varT] (analysis/type.with_env check.var) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer varT)] - (in {analysis.#Extension extension (list indexA arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + arrayA (analysis/type.with_type (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer :var:)] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) (def: array::write Handler (custom [($_ <>.and <c>.any <c>.any <c>.any) (function (_ extension phase archive [indexC valueC arrayC]) - (do phase.monad - [indexA (analysis/type.with_type Nat - (phase archive indexC)) - [var_id varT] (analysis/type.with_env check.var) - valueA (analysis/type.with_type varT - (phase archive valueC)) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer (type (Array varT)))] - (in {analysis.#Extension extension (list indexA valueA arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + valueA (analysis/type.with_type :var: + (phase archive valueC)) + arrayA (analysis/type.with_type (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer (type (Array :var:)))] + (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) (def: array::delete Handler (custom [($_ <>.and <c>.any <c>.any) (function (_ extension phase archive [indexC arrayC]) - (do phase.monad - [indexA (analysis/type.with_type Nat - (phase archive indexC)) - [var_id varT] (analysis/type.with_env check.var) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer (type (Array varT)))] - (in {analysis.#Extension extension (list indexA arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + arrayA (analysis/type.with_type (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer (type (Array :var:)))] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) (def: bundle::array Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux index 3dd40cd28..659191e2f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux @@ -1,100 +1,105 @@ (.using - [library - [lux "*" - ["[0]" ffi] - [abstract - ["[0]" monad {"+" do}]] - [control - ["<>" parser - ["<c>" code {"+" Parser}]]] - [data - [collection - ["[0]" array {"+" Array}] - ["[0]" dictionary] - ["[0]" list]]] - ["[0]" type - ["[0]" check]] - ["@" target - ["_" scheme]]]] + [library + [lux "*" + ["[0]" ffi] + [abstract + ["[0]" monad {"+" do}]] + [control + ["<>" parser + ["<c>" code {"+" Parser}]]] + [data + [collection + ["[0]" array {"+" Array}] + ["[0]" dictionary] + ["[0]" list]]] + ["[0]" type + ["[0]" check]] + ["@" target + ["_" scheme]]]] + [// + ["/" lux {"+" custom}] [// - ["/" lux {"+" custom}] + ["[0]" bundle] [// - ["[0]" bundle] + ["[0]" analysis "_" + ["[1]/[0]" type]] [// - ["[0]" analysis "_" - ["[1]/[0]" type]] - [// - ["[0]" analysis {"+" Analysis Operation Phase Handler Bundle}] - [/// - ["[0]" phase]]]]]]) + ["[0]" analysis {"+" Analysis Operation Phase Handler Bundle}] + [/// + ["[0]" phase]]]]]]) (def: array::new Handler (custom [<c>.any (function (_ extension phase archive lengthC) - (do phase.monad - [lengthA (analysis/type.with_type Nat - (phase archive lengthC)) - [var_id varT] (analysis/type.with_env check.var) - _ (analysis/type.infer (type (Array varT)))] - (in {analysis.#Extension extension (list lengthA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [lengthA (analysis/type.with_type Nat + (phase archive lengthC)) + _ (analysis/type.infer (type (Array :var:)))] + (in {analysis.#Extension extension (list lengthA)}))))])) (def: array::length Handler (custom [<c>.any (function (_ extension phase archive arrayC) - (do phase.monad - [[var_id varT] (analysis/type.with_env check.var) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer Nat)] - (in {analysis.#Extension extension (list arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [arrayA (analysis/type.with_type (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer Nat)] + (in {analysis.#Extension extension (list arrayA)}))))])) (def: array::read Handler (custom [(<>.and <c>.any <c>.any) (function (_ extension phase archive [indexC arrayC]) - (do phase.monad - [indexA (analysis/type.with_type Nat - (phase archive indexC)) - [var_id varT] (analysis/type.with_env check.var) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer varT)] - (in {analysis.#Extension extension (list indexA arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + arrayA (analysis/type.with_type (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer :var:)] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) (def: array::write Handler (custom [($_ <>.and <c>.any <c>.any <c>.any) (function (_ extension phase archive [indexC valueC arrayC]) - (do phase.monad - [indexA (analysis/type.with_type Nat - (phase archive indexC)) - [var_id varT] (analysis/type.with_env check.var) - valueA (analysis/type.with_type varT - (phase archive valueC)) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer (type (Array varT)))] - (in {analysis.#Extension extension (list indexA valueA arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + valueA (analysis/type.with_type :var: + (phase archive valueC)) + arrayA (analysis/type.with_type (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer (type (Array :var:)))] + (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) (def: array::delete Handler (custom [($_ <>.and <c>.any <c>.any) (function (_ extension phase archive [indexC arrayC]) - (do phase.monad - [indexA (analysis/type.with_type Nat - (phase archive indexC)) - [var_id varT] (analysis/type.with_env check.var) - arrayA (analysis/type.with_type (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.infer (type (Array varT)))] - (in {analysis.#Extension extension (list indexA arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.with_type Nat + (phase archive indexC)) + arrayA (analysis/type.with_type (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.infer (type (Array :var:)))] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) (def: bundle::array Bundle diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache.lux b/stdlib/source/library/lux/tool/compiler/meta/cache.lux index d9ed86253..6b4194359 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache.lux @@ -2,11 +2,9 @@ [library [lux "*" [abstract - [monad {"+" do}]] + [monad {"+" Monad do}]] [control - ["[0]" try {"+" Try}] - [concurrency - ["[0]" async {"+" Async}]]] + ["[0]" try {"+" Try}]] [data [text ["%" format {"+" format}]]] @@ -25,14 +23,12 @@ / (version.format //.version)))) (def: .public (enabled? fs context) - (-> (file.System Async) Context (Async Bit)) - (|> context - (..path fs) - (# fs directory?))) + (All (_ !) (-> (file.System !) Context (! Bit))) + (# fs directory? (..path fs context))) -(def: .public (enable! fs context) - (-> (file.System Async) Context (Async (Try Any))) - (do [! async.monad] +(def: .public (enable! ! fs context) + (All (_ !) (-> (Monad !) (file.System !) Context (! (Try Any)))) + (do ! [? (..enabled? fs context)] (if ? (in {try.#Success []}) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/archive.lux new file mode 100644 index 000000000..28abd457a --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/archive.lux @@ -0,0 +1,24 @@ +(.using + [library + [lux "*" + [control + [try {"+" Try}]] + [data + [text + ["%" format]]] + [world + ["[0]" file]]]] + ["[0]" // + ["/[1]" // + [context {"+" Context}] + ["[0]" archive {"+" Archive}]]]) + +(def: .public (descriptor fs context) + (All (_ !) (-> (file.System !) Context file.Path)) + (%.format (//.path fs context) + (# fs separator) + "descriptor")) + +(def: .public (cache! fs context it) + (All (_ !) (-> (file.System !) Context Archive (! (Try Any)))) + (# fs write (archive.export ///.version it) (..descriptor fs context))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux index d294bc51a..fd63495d1 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux @@ -28,12 +28,12 @@ (%.nat @artifact) (value@ context.#artifact_extension context))) -(def: .public (read! fs context @module @artifact) +(def: .public (cache fs context @module @artifact) (All (_ !) (-> (file.System !) Context module.ID artifact.ID (! (Try Binary)))) (# fs read (..path fs context @module @artifact))) -(def: .public (write! fs context @module @artifact content) +(def: .public (cache! fs context @module @artifact content) (All (_ !) (-> (file.System !) Context module.ID artifact.ID Binary (! (Try Any)))) (# fs write content (..path fs context @module @artifact))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux index b4c122ec6..143b3bce9 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux @@ -1,17 +1,21 @@ (.using [library [lux "*" + ["@" target] [abstract - [monad {"+" do}]] + ["[0]" monad {"+" Monad do}]] [control [pipe {"+" case>}] ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] - [concurrency - ["[0]" async {"+" Async}]]] + ["[0]" exception {"+" exception:}]] [data - [text - ["%" format {"+" format}]]] + [binary {"+" Binary}] + ["[0]" product] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor)] + ["[0]" dictionary {"+" Dictionary}]]] [world ["[0]" file]]]] ["[0]" // @@ -38,9 +42,9 @@ (All (_ !) (-> (file.System !) Context module.ID (! Bit))) (# fs directory? (..path fs context @module))) -(def: .public (enable! fs context @module) - (-> (file.System Async) Context module.ID (Async (Try Any))) - (do [! async.monad] +(def: .public (enable! ! fs context @module) + (All (_ !) (-> (Monad !) (file.System !) Context module.ID (! (Try Any)))) + (do ! [.let [path (..path fs context @module)] module_exists? (# fs directory? path)] (if module_exists? @@ -49,7 +53,7 @@ @module error])] (do ! - [? (//.enable! fs context)] + [? (//.enable! ! fs context)] (case ? {try.#Failure error} (in <failure>) @@ -62,3 +66,36 @@ success success)))))))))) + +(def: file + file.Path + "descriptor") + +(def: .public (descriptor fs context @module) + (All (_ !) (-> (file.System !) Context module.ID file.Path)) + (format (..path fs context @module) + (# fs separator) + ..file)) + +(def: .public (cache! fs context @module content) + (All (_ !) (-> (file.System !) Context module.ID Binary (! (Try Any)))) + (# fs write content (..descriptor fs context @module))) + +(def: .public (cache fs context @module) + (All (_ !) (-> (file.System !) Context module.ID (! (Try Binary)))) + (# fs read (..descriptor fs context @module))) + +(def: .public (artifacts ! fs context @module) + (All (_ !) (-> (Monad !) (file.System !) Context module.ID (! (Try (Dictionary Text Binary))))) + (do [! (try.with !)] + [files (# fs directory_files (..path fs context @module)) + pairs (|> files + (list#each (function (_ file) + [(file.name fs file) file])) + (list.only (|>> product.left (text#= ..file) not)) + (monad.each ! (function (_ [name path]) + (|> path + (# fs read) + (# ! each (|>> [name]))))))] + (in (dictionary.of_list text.hash (for [@.old (:as (List [Text Binary]) pairs)] + pairs))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index 5c6340f86..346a05e56 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -6,9 +6,7 @@ [predicate {"+" Predicate}] ["[0]" monad {"+" do}]] [control - [pipe {"+" case>}] ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] [concurrency ["[0]" async {"+" Async} ("[1]#[0]" monad)]] ["<>" parser @@ -45,6 +43,7 @@ ["[0]" descriptor {"+" Descriptor}] ["[0]" document {"+" Document}]]] ["[0]" cache + ["[1]/[0]" archive] ["[1]/[0]" module] ["[0]" dependency "_" ["[1]" module]]] @@ -57,33 +56,6 @@ ["[0]" directive] ["[1]/[0]" program]]]]]]) -(def: (general_descriptor fs context) - (-> (file.System Async) Context file.Path) - (format (cache.path fs context) - (# fs separator) - "general_descriptor")) - -(def: .public (freeze fs context archive) - (-> (file.System Async) Context Archive (Async (Try Any))) - (# fs write (archive.export ///.version archive) (..general_descriptor fs context))) - -(def: module_descriptor_file - "module_descriptor") - -(def: (module_descriptor fs context module_id) - (-> (file.System Async) Context module.ID file.Path) - (format (cache/module.path fs context module_id) - (# fs separator) - ..module_descriptor_file)) - -(def: .public (cache fs context module_id content) - (-> (file.System Async) Context module.ID Binary (Async (Try Any))) - (# fs write content (..module_descriptor fs context module_id))) - -(def: (read_module_descriptor fs context module_id) - (-> (file.System Async) Context module.ID (Async (Try Binary))) - (# fs read (..module_descriptor fs context module_id))) - (def: module_parser (Parser (module.Module .Module)) ($_ <>.and @@ -115,21 +87,6 @@ (archive.archived archive)))] (in (with@ .#modules modules (fresh_analysis_state host configuration))))) -(def: (cached_artifacts fs context module_id) - (-> (file.System Async) Context module.ID (Async (Try (Dictionary Text Binary)))) - (let [! (try.with async.monad)] - (|> (cache/module.path fs context module_id) - (# fs directory_files) - (# ! each (|>> (list#each (function (_ file) - [(file.name fs file) file])) - (list.only (|>> product.left (text#= ..module_descriptor_file) not)) - (monad.each ! (function (_ [name path]) - (|> path - (# fs read) - (# ! each (|>> [name]))))) - (# ! each (dictionary.of_list text.hash)))) - (# ! conjoint)))) - (type: Definitions (Dictionary Text Any)) (type: Analysers (Dictionary Text analysis.Handler)) (type: Synthesizers (Dictionary Text synthesis.Handler)) @@ -149,7 +106,7 @@ (dictionary.empty text.hash) (dictionary.empty text.hash)]) -(def: (loaded_document extension host module_id expected actual document) +(def: (loaded_document extension host @module expected actual document) (All (_ expression directive) (-> Text (generation.Host expression directive) module.ID (Sequence [Artifact (Set unit.ID)]) (Dictionary Text Binary) (Document .Module) (Try [(Document .Module) Bundles Output]))) @@ -162,15 +119,15 @@ output (: Output sequence.empty)] (let [[analysers synthesizers generators directives] bundles] (case input - {.#Item [[[artifact_id artifact_category mandatory_artifact?] artifact_dependencies] input']} + {.#Item [[[@artifact artifact_category mandatory_artifact?] artifact_dependencies] input']} (case (do ! - [data (try.of_maybe (dictionary.value (format (%.nat artifact_id) extension) actual)) - .let [context [module_id artifact_id] + [data (try.of_maybe (dictionary.value (format (%.nat @artifact) extension) actual)) + .let [context [@module @artifact] directive (# host ingest context data)]] (case artifact_category {category.#Anonymous} (do ! - [.let [output (sequence.suffix [artifact_id {.#None} data] output)] + [.let [output (sequence.suffix [@artifact {.#None} data] output)] _ (# host re_learn context {.#None} directive)] (in [definitions [analysers @@ -180,7 +137,7 @@ output])) {category.#Definition [name function_artifact]} - (let [output (sequence.suffix [artifact_id {.#None} data] output)] + (let [output (sequence.suffix [@artifact {.#None} data] output)] (if (text#= $/program.name name) (in [definitions [analysers @@ -199,7 +156,7 @@ {category.#Analyser extension} (do ! - [.let [output (sequence.suffix [artifact_id {.#None} data] output)] + [.let [output (sequence.suffix [@artifact {.#None} data] output)] value (# host re_load context {.#None} directive)] (in [definitions [(dictionary.has extension (:as analysis.Handler value) analysers) @@ -210,7 +167,7 @@ {category.#Synthesizer extension} (do ! - [.let [output (sequence.suffix [artifact_id {.#None} data] output)] + [.let [output (sequence.suffix [@artifact {.#None} data] output)] value (# host re_load context {.#None} directive)] (in [definitions [analysers @@ -221,7 +178,7 @@ {category.#Generator extension} (do ! - [.let [output (sequence.suffix [artifact_id {.#None} data] output)] + [.let [output (sequence.suffix [@artifact {.#None} data] output)] value (# host re_load context {.#None} directive)] (in [definitions [analysers @@ -232,7 +189,7 @@ {category.#Directive extension} (do ! - [.let [output (sequence.suffix [artifact_id {.#None} data] output)] + [.let [output (sequence.suffix [@artifact {.#None} data] output)] value (# host re_load context {.#None} directive)] (in [definitions [analysers @@ -243,7 +200,7 @@ {category.#Custom name} (do ! - [.let [output (sequence.suffix [artifact_id {.#Some name} data] output)] + [.let [output (sequence.suffix [@artifact {.#Some name} data] output)] _ (# host re_learn context {.#Some name} directive)] (in [definitions [analysers @@ -287,26 +244,27 @@ (in [(document.document $.key (with@ .#definitions definitions content)) bundles]))) -(def: (load_definitions fs context module_id host_environment entry) +(def: (load_definitions fs context @module host_environment entry) (All (_ expression directive) (-> (file.System Async) Context module.ID (generation.Host expression directive) (archive.Entry .Module) (Async (Try [(archive.Entry .Module) Bundles])))) (do (try.with async.monad) - [actual (cached_artifacts fs context module_id) + [actual (: (Async (Try (Dictionary Text Binary))) + (cache/module.artifacts async.monad fs context @module)) .let [expected (registry.artifacts (value@ archive.#registry entry))] [document bundles output] (|> (value@ [archive.#module module.#document] entry) - (loaded_document (value@ context.#artifact_extension context) host_environment module_id expected actual) + (loaded_document (value@ context.#artifact_extension context) host_environment @module expected actual) async#in)] (in [(|> entry (with@ [archive.#module module.#document] document) (with@ archive.#output output)) bundles]))) -(def: (purge! fs context [module_name module_id]) +(def: (purge! fs context [module_name @module]) (-> (file.System Async) Context [descriptor.Module module.ID] (Async (Try Any))) (do [! (try.with async.monad)] - [.let [cache (cache/module.path fs context module_id)] + [.let [cache (cache/module.path fs context @module)] _ (|> cache (# fs directory_files) (# ! each (monad.each ! (# fs delete))) @@ -331,17 +289,17 @@ (def: initial_purge (-> (List [Bit Cache]) Purge) - (|>> (list.all (function (_ [valid_cache? [module_name [module_id _]]]) + (|>> (list.all (function (_ [valid_cache? [module_name [@module _]]]) (if valid_cache? {.#None} - {.#Some [module_name module_id]}))) + {.#Some [module_name @module]}))) (dictionary.of_list text.hash))) (def: (full_purge caches load_order) (-> (List [Bit Cache]) (dependency.Order .Module) Purge) - (list#mix (function (_ [module_name [module_id entry]] purge) + (list#mix (function (_ [module_name [@module entry]] purge) (let [purged? (: (Predicate descriptor.Module) (dictionary.key? purge))] (if (purged? module_name) @@ -350,7 +308,7 @@ (value@ [archive.#module module.#descriptor descriptor.#references]) set.list (list.any? purged?)) - (dictionary.has module_name module_id purge) + (dictionary.has module_name @module purge) purge)))) (..initial_purge caches) load_order)) @@ -359,13 +317,14 @@ Text "(Lux Caching System)") -(def: (valid_cache fs context import contexts [module_name module_id]) +(def: (valid_cache fs context import contexts [module_name @module]) (-> (file.System Async) Context Import (List //.Context) [descriptor.Module module.ID] (Async (Try [Bit Cache]))) - (with_expansions [<cache> [module_name [module_id [module registry]]]] + (with_expansions [<cache> [module_name [@module [module registry]]]] (do [! (try.with async.monad)] - [data (..read_module_descriptor fs context module_id) + [data (: (Async (Try Binary)) + (cache/module.cache fs context @module)) [module registry] (async#in (<binary>.result ..parser data))] (if (text#= descriptor.runtime module_name) (in [true <cache>]) @@ -389,7 +348,7 @@ (Try (dependency.Order .Module))) (|> pre_loaded_caches (monad.mix try.monad - (function (_ [_ [module [module_id [|module| registry]]]] archive) + (function (_ [_ [module [@module [|module| registry]]]] archive) (archive.has module [archive.#module |module| archive.#output (: Output sequence.empty) @@ -408,9 +367,9 @@ [... TODO: Stop needing to wrap this expression in an unnecessary "do" expression. it (|> load_order (list.only (|>> product.left (dictionary.key? purge) not)) - (monad.each ! (function (_ [module_name [module_id entry]]) + (monad.each ! (function (_ [module_name [@module entry]]) (do ! - [[entry bundles] (..load_definitions fs context module_id host_environment entry)] + [[entry bundles] (..load_definitions fs context @module host_environment entry)] (in [[module_name entry] bundles])))))] (in it))) @@ -451,7 +410,7 @@ (-> Configuration (generation.Host expression directive) (file.System Async) Context Import (List //.Context) (Async (Try [Archive .Lux Bundles])))) (do async.monad - [binary (# fs read (..general_descriptor fs context))] + [binary (# fs read (cache/archive.descriptor fs context))] (case binary {try.#Success binary} (do (try.with async.monad) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index cad7bf352..70e392965 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -46,6 +46,8 @@ ["[0]" cli {"+" Service}] ["[0]" import] ["[0]" export] + ["[0]" cache "_" + ["[1]" archive]] [archive {"+" Archive} ["[0]" unit] [module @@ -170,7 +172,7 @@ (Async (Try [Archive (directive.State+ <parameters>)])) (:expected (platform.compile lux_compiler phase_wrapper import file_context expander platform compilation [archive state]))) - _ (ioW.freeze (value@ platform.#&file_system platform) file_context archive) + _ (cache.cache! (value@ platform.#&file_system platform) file_context archive) program_context (async#in ($/program.context archive)) host_dependencies (..load_host_dependencies (value@ platform.#&file_system platform) compilation_host_dependencies) _ (..package! (for [@.old (file.async file.default) diff --git a/stdlib/source/test/lux/target/python.lux b/stdlib/source/test/lux/target/python.lux index b68adfedd..8ff0e74a2 100644 --- a/stdlib/source/test/lux/target/python.lux +++ b/stdlib/source/test/lux/target/python.lux @@ -579,6 +579,94 @@ false))) ))) +(def: test|loop + Test + (do [! random.monad] + [base (# ! each (n.% 100) random.nat) + factor (# ! each (|>> (n.% 10) ++) random.nat) + extra (# ! each (|>> (n.% 10) ++) random.nat) + .let [expected (n.* factor base)] + $iteration (# ! each (|>> %.nat (format "iteration_") /.var) random.nat) + $temp (# ! each (|>> %.nat (format "temp_") /.var) random.nat)] + ($_ _.and + (_.cover [/.while] + (and (|> (..statement + (function (_ $output) + ($_ /.then + (/.set (list $output) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int factor)) $iteration) + ($_ /.then + (/.set (list $output) (/.+ (/.int (.int base)) + $output)) + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + ) + {.#None})))) + (:as Nat) + (n.= expected)) + (|> (..statement + (function (_ $output) + ($_ /.then + (/.set (list $temp) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int factor)) $iteration) + ($_ /.then + (/.set (list $temp) (/.+ (/.int (.int base)) + $temp)) + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + ) + {.#Some (/.set (list $output) $temp)})))) + (:as Nat) + (n.= expected)))) + (_.cover [/.for_in] + (|> (..statement + (function (_ $output) + ($_ /.then + (/.set (list $output) (/.int +0)) + (/.for_in $iteration + (/.list (list.repeated factor (/.int (.int base)))) + (/.set (list $output) (/.+ $iteration + $output)))))) + (:as Nat) + (n.= expected))) + (_.cover [/.pass] + (|> (..statement + (function (_ $output) + ($_ /.then + (/.set (list $output) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration) + ($_ /.then + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + (/.if (/.> (/.int (.int extra)) $iteration) + (/.set (list $output) (/.+ (/.int (.int base)) + $output)) + /.pass)) + {.#None})))) + (:as Nat) + (n.= expected))) + (_.cover [/.continue] + (|> (..statement + (function (_ $output) + ($_ /.then + (/.set (list $output) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration) + ($_ /.then + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + (/.if (/.> (/.int (.int extra)) $iteration) + (/.set (list $output) (/.+ (/.int (.int base)) + $output)) + /.continue)) + {.#None})))) + (:as Nat) + (n.= expected))) + ))) + (def: test|statement Test (do [! random.monad] @@ -636,6 +724,8 @@ ..test|exception (_.for [/.Location] ..test|location) + (_.for [/.Loop] + ..test|loop) ))) (def: random_expression diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive.lux b/stdlib/source/test/lux/tool/compiler/meta/archive.lux index 62dbff389..3afb5c406 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive.lux @@ -39,7 +39,7 @@ ["[1][0]" module] ["[1][0]" unit]]) -(def: (descriptor module hash) +(def: .public (descriptor module hash) (-> /descriptor.Module Nat /descriptor.Descriptor) [/descriptor.#name module /descriptor.#file (format module ".lux") diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache.lux b/stdlib/source/test/lux/tool/compiler/meta/cache.lux index a92a50ea7..c826d030a 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache.lux @@ -15,6 +15,7 @@ [\\library ["[0]" /]] ["[0]" / "_" + ["[1][0]" archive] ["[1][0]" module] ["[1][0]" artifact] ["$/[1]" // "_" @@ -45,6 +46,7 @@ post/0 post/1)))) + /archive.test /module.test /artifact.test )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux b/stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux new file mode 100644 index 000000000..03a0d376b --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux @@ -0,0 +1,84 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" try ("[1]#[0]" functor)] + [concurrency + ["[0]" async]]] + [data + ["[0]" binary ("[1]#[0]" equivalence)] + [collection + ["[0]" sequence]]] + [math + ["[0]" random] + [number + ["n" nat]]] + [world + ["[0]" file]]]] + [\\library + ["[0]" / + ["/[1]" // + ["/[1]" // + ["[0]" archive + ["[0]" signature] + ["[0]" key] + ["[0]" registry] + ["[0]" module + ["[0]" document]]]]]]] + ["$" // "_" + [// + ["[1][0]" context] + ["[1][0]" archive + ["[2][0]" signature]]]]) + +(def: .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [.let [/ "/" + fs (file.mock /)] + context $context.random + module/0 (random.ascii/lower 1) + module/1 (random.ascii/lower 2) + content/0 random.nat + content/1 (random.only (|>> (n.= content/0) not) random.nat) + hash random.nat + signature $signature.random + .let [key (key.key signature content/0) + [archive expected] (|> (do try.monad + [[@module/0 archive] (archive.reserve module/0 archive.empty) + [@module/1 archive] (archive.reserve module/1 archive) + .let [entry/0 [archive.#module [module.#id @module/0 + module.#descriptor ($archive.descriptor module/0 hash) + module.#document (document.document key content/0)] + archive.#output sequence.empty + archive.#registry registry.empty] + entry/1 [archive.#module [module.#id @module/1 + module.#descriptor ($archive.descriptor module/1 hash) + module.#document (document.document key content/1)] + archive.#output sequence.empty + archive.#registry registry.empty]] + archive (archive.has module/0 entry/0 archive) + archive (archive.has module/1 entry/1 archive)] + (in [archive (archive.export ///.version archive)])) + try.trusted)]] + ($_ _.and + (in (do async.monad + [pre/0 (# fs file? (/.descriptor fs context)) + enabled? (//.enable! fs context) + cached? (/.cache! fs context archive) + actual (# fs read (/.descriptor fs context)) + post/0 (# fs file? (/.descriptor fs context))] + (_.cover' [/.descriptor /.cache!] + (and (not pre/0) + (|> (do try.monad + [_ enabled? + _ cached?] + actual) + (try#each (binary#= expected)) + (try.else false)) + post/0)))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux b/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux index a9140b6a6..d3ba700a2 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux @@ -38,10 +38,10 @@ (in (do async.monad [pre (# fs file? (/.path fs context @module @artifact)) _ (//module.enable! fs context @module) - write! (/.write! fs context @module @artifact expected) + write! (/.cache! fs context @module @artifact expected) post (# fs file? (/.path fs context @module @artifact)) - read! (/.read! fs context @module @artifact)] - (_.cover' [/.path /.write! /.read!] + read! (/.cache fs context @module @artifact)] + (_.cover' [/.path /.cache! /.cache] (and (not pre) (case write! {try.#Success _} true diff --git a/stdlib/source/unsafe/lux/data/binary.lux b/stdlib/source/unsafe/lux/data/binary.lux index 91726c57a..3f542ce73 100644 --- a/stdlib/source/unsafe/lux/data/binary.lux +++ b/stdlib/source/unsafe/lux/data/binary.lux @@ -282,11 +282,11 @@ (and ("lux i64 =" limit (..size sample)) (loop [index 0] (if ("lux i64 =" limit index) + true (and ("lux i64 =" (..bytes/1 index reference) (..bytes/1 index sample)) - (again (++ index))) - true)))))])) + (again (++ index))))))))])) ... TODO: Turn into a template ASAP. (inline: .public (copy! bytes source_offset source target_offset target) |