diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/library/lux/meta/compiler/meta/io/archive.lux | 218 |
1 files changed, 64 insertions, 154 deletions
diff --git a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux index 02a205b27..37f0435ab 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux @@ -89,135 +89,57 @@ (archive.archived archive)))] (in (has .#modules modules (fresh_analysis_state host configuration))))) -(type Definitions (Dictionary Text Any)) -(type Analysers (Dictionary Text analysis.Handler)) -(type Synthesizers (Dictionary Text synthesis.Handler)) -(type Translators (Dictionary Text translation.Handler)) -(type Declarations (Dictionary Text declaration.Handler)) - -(type Bundles - [Analysers - Synthesizers - Translators - Declarations]) - -(def empty_bundles - Bundles - [(dictionary.empty text.hash) - (dictionary.empty text.hash) - (dictionary.empty text.hash) - (dictionary.empty text.hash)]) +(type Definitions + (Dictionary Text Any)) (def (loaded_document extension host @module expected actual document) (All (_ expression declaration) (-> Text (translation.Host expression declaration) module.ID (Sequence [Artifact (Set unit.ID)]) (Dictionary Text Binary) (Document .Module) - (Try [(Document .Module) Bundles Output]))) + (Try [(Document .Module) Output]))) (do [! try.monad] - [[definitions bundles] (is (Try [Definitions Bundles Output]) - (loop (again [input (sequence.list expected) - definitions (is Definitions - (dictionary.empty text.hash)) - bundles ..empty_bundles - output (is Output sequence.empty)]) - (let [[analysers synthesizers translators declarations] bundles] - (when input - {.#Item [[[@artifact artifact_category mandatory_artifact?] artifact_dependencies] input']} - (when (do ! - [data (try.of_maybe (dictionary.value (format (%.nat @artifact) extension) actual)) - .let [context [@module @artifact] - declaration (at host ingest context data)]] - (when artifact_category - {category.#Anonymous} - (do ! - [.let [output (sequence.suffix [@artifact {.#None} data] output)] - _ (at host re_learn context {.#None} declaration)] - (in [definitions - [analysers - synthesizers - translators - declarations] - output])) - - {category.#Definition [name function_artifact]} - (let [output (sequence.suffix [@artifact {.#None} data] output)] - (if (text#= $/program.name name) - (in [definitions - [analysers - synthesizers - translators - declarations] - output]) - (do ! - [value (at host re_load context {.#None} declaration)] - (in [(dictionary.has name value definitions) - [analysers - synthesizers - translators - declarations] - output])))) - - {category.#Analyser extension} - (do ! - [.let [output (sequence.suffix [@artifact {.#None} data] output)] - value (at host re_load context {.#None} declaration)] - (in [definitions - [(dictionary.has extension (as analysis.Handler value) analysers) - synthesizers - translators - declarations] - output])) - - {category.#Synthesizer extension} - (do ! - [.let [output (sequence.suffix [@artifact {.#None} data] output)] - value (at host re_load context {.#None} declaration)] - (in [definitions - [analysers - (dictionary.has extension (as synthesis.Handler value) synthesizers) - translators - declarations] - output])) - - {category.#Translator extension} - (do ! - [.let [output (sequence.suffix [@artifact {.#None} data] output)] - value (at host re_load context {.#None} declaration)] - (in [definitions - [analysers - synthesizers - (dictionary.has extension (as translation.Handler value) translators) - declarations] - output])) - - {category.#Declaration extension} - (do ! - [.let [output (sequence.suffix [@artifact {.#None} data] output)] - value (at host re_load context {.#None} declaration)] - (in [definitions - [analysers - synthesizers - translators - (dictionary.has extension (as declaration.Handler value) declarations)] - output])) + [[definitions output] (is (Try [Definitions Output]) + (loop (again [input (sequence.list expected) + definitions (is Definitions + (dictionary.empty text.hash)) + output (is Output sequence.empty)]) + (when input + {.#Item [[[@artifact artifact_category mandatory_artifact?] artifact_dependencies] input']} + (when (do ! + [data (try.of_maybe (dictionary.value (format (%.nat @artifact) extension) actual)) + .let [context [@module @artifact] + declaration (at host ingest context data)]] + (when artifact_category + {category.#Anonymous} + (do ! + [.let [output (sequence.suffix [@artifact {.#None} data] output)] + _ (at host re_learn context {.#None} declaration)] + (in [definitions + output])) + + {category.#Definition [name function_artifact]} + (let [output (sequence.suffix [@artifact {.#None} data] output)] + (if (text#= $/program.name name) + (in [definitions + output]) + (do ! + [value (at host re_load context {.#None} declaration)] + (in [(dictionary.has name value definitions) + output])))) - {category.#Custom name} - (do ! - [.let [output (sequence.suffix [@artifact {.#Some name} data] output)] - _ (at host re_learn context {.#Some name} declaration)] - (in [definitions - [analysers - synthesizers - translators - declarations] - output])))) - {try.#Success [definitions' bundles' output']} - (again input' definitions' bundles' output') + {category.#Custom name} + (do ! + [.let [output (sequence.suffix [@artifact {.#Some name} data] output)] + _ (at host re_learn context {.#Some name} declaration)] + (in [definitions + output])))) + {try.#Success [definitions' output']} + (again input' definitions' output') - failure - failure) - - {.#End} - {try.#Success [definitions bundles output]})))) + failure + failure) + + {.#End} + {try.#Success [definitions output]}))) content (document.content $.key document) definitions (monad.each ! (function (_ [def_name [exported? def_global]]) (when def_global @@ -238,24 +160,23 @@ (in (list)))) (the .#definitions content))] (in [(document.document $.key (has .#definitions (list#conjoint definitions) content)) - bundles]))) + output]))) (def (load_definitions fs context @module host_environment entry) (All (_ expression declaration) (-> (file.System Async) Context module.ID (translation.Host expression declaration) (archive.Entry .Module) - (Async (Try [(archive.Entry .Module) Bundles])))) + (Async (Try (archive.Entry .Module))))) (do (try.with async.monad) [actual (is (Async (Try (Dictionary Text Binary))) (cache/module.artifacts async.monad fs context @module)) .let [expected (registry.artifacts (the archive.#registry entry))] - [document bundles output] (|> (the [archive.#module module.#document] entry) - (loaded_document (the context.#artifact_extension context) host_environment @module expected actual) - async#in)] - (in [(|> entry - (has [archive.#module module.#document] document) - (has archive.#output output)) - bundles]))) + [document output] (|> (the [archive.#module module.#document] entry) + (loaded_document (the context.#artifact_extension context) host_environment @module expected actual) + async#in)] + (in (|> entry + (has [archive.#module module.#document] document) + (has archive.#output output))))) (def pseudo_module Text @@ -319,20 +240,19 @@ (All (_ expression declaration) (-> (translation.Host expression declaration) (file.System Async) Context Purge (dependency.Order .Module) - (Async (Try (List [[descriptor.Module (archive.Entry .Module)] Bundles]))))) + (Async (Try (List [descriptor.Module (archive.Entry .Module)]))))) (do [! (try.with async.monad)] [... 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 entry]]) (do ! - [[entry bundles] (with_expansions [<it> (..load_definitions fs context @module host_environment entry)] - (for @.old (as (Async (Try [(archive.Entry .Module) Bundles])) - <it>) - <it>))] - (in (with_expansions [<it> [[module_name entry] - bundles]] - (for @.old (as [[descriptor.Module (archive.Entry .Module)] Bundles] + [entry (with_expansions [<it> (..load_definitions fs context @module host_environment entry)] + (for @.old (as (Async (Try (archive.Entry .Module))) + <it>) + <it>))] + (in (with_expansions [<it> [module_name entry]] + (for @.old (as [descriptor.Module (archive.Entry .Module)] <it>) <it>)))))))] (in it))) @@ -340,7 +260,7 @@ (def (load_every_reserved_module customs configuration host_environment fs context import contexts archive) (All (_ expression declaration) (-> (List Custom) Configuration (translation.Host expression declaration) (file.System Async) Context Import (List //.Context) Archive - (Async (Try [Archive .Lux Bundles])))) + (Async (Try [Archive .Lux])))) (do [! (try.with async.monad)] [pre_loaded_caches (..pre_loaded_caches customs fs context import contexts archive) load_order (async#in (load_order archive pre_loaded_caches)) @@ -352,26 +272,17 @@ (async#in (do [! try.monad] [archive (monad.mix ! - (function (_ [[module entry] _bundle] archive) + (function (_ [module entry] archive) (archive.has module entry archive)) archive loaded_caches) analysis_state (..analysis_state (the context.#host context) configuration archive)] - (in [archive - analysis_state - (list#mix (function (_ [_ [+analysers +synthesizers +translators +declarations]] - [analysers synthesizers translators declarations]) - [(dictionary.composite +analysers analysers) - (dictionary.composite +synthesizers synthesizers) - (dictionary.composite +translators translators) - (dictionary.composite +declarations declarations)]) - ..empty_bundles - loaded_caches)]))))) + (in [archive analysis_state]))))) (def .public (thaw customs configuration host_environment fs context import contexts) (All (_ expression declaration) (-> (List Custom) Configuration (translation.Host expression declaration) (file.System Async) Context Import (List //.Context) - (Async (Try [Archive .Lux Bundles])))) + (Async (Try [Archive .Lux])))) (do async.monad [binary (at fs read (cache/archive.descriptor fs context))] (when binary @@ -382,5 +293,4 @@ {try.#Failure error} (in {try.#Success [archive.empty - (fresh_analysis_state (the context.#host context) configuration) - ..empty_bundles]})))) + (fresh_analysis_state (the context.#host context) configuration)]})))) |