diff options
Diffstat (limited to '')
22 files changed, 509 insertions, 282 deletions
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 4cb5319cd..4f14a2ada 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1499,6 +1499,18 @@ {#None}} plist)) +(def:''' .private (plist#with k v plist) + (All (_ a) + (-> Text a ($' PList a) ($' PList a))) + ({{#Item [k' v'] plist'} + (if (text#= k k') + (list& [k v] plist') + (list& [k' v'] (plist#with k v plist'))) + + {#End} + (list [k v])} + plist)) + (def:''' .private (text#composite x y) (-> Text Text Text) ("lux text concat" x y)) @@ -2522,6 +2534,68 @@ {#None} (failure "Wrong syntax for function"))) +(def:' .private Parser + Type + {#Named [..prelude_module "Parser"] + (..type (All (_ a) + (-> (List Code) (Maybe [(List Code) a]))))}) + +(def:' .private (parsed parser tokens) + (All (_ a) (-> (Parser a) (List Code) (Maybe a))) + (case (parser tokens) + (^ {#Some [(list) it]}) + {#Some it} + + _ + {#None})) + +(def:' .private (andP leftP rightP tokens) + (All (_ l r) + (-> (Parser l) + (Parser r) + (Parser [l r]))) + (do maybe_monad + [left (leftP tokens) + .let [[tokens left] left] + right (rightP tokens) + .let [[tokens right] right]] + (in [tokens [left right]]))) + +(def:' .private (someP itP tokens) + (All (_ a) + (-> (Parser a) + (Parser (List a)))) + (case (itP tokens) + {#Some [tokens head]} + (do maybe_monad + [it (someP itP tokens) + .let [[tokens tail] it]] + (in [tokens (list& head tail)])) + + {#None} + {#Some [tokens (list)]})) + +(def:' .private (tupleP itP tokens) + (All (_ a) + (-> (Parser a) (Parser a))) + (case tokens + (^ (list& [_ {#Tuple tuple}] tokens')) + (do maybe_monad + [it (parsed itP tuple)] + (in [tokens' it])) + + _ + {#None})) + +(def:' .private (bindingP tokens) + (Parser [Text Code]) + (case tokens + (^ (list& [_ {#Symbol ["" name]}] value &rest)) + {#Some [&rest [name value]]} + + _ + {#None})) + (def:' .private (endP tokens) (-> (List Code) (Maybe Any)) (case tokens @@ -2532,7 +2606,7 @@ {#None})) (def:' .private (anyP tokens) - (-> (List Code) (Maybe [(List Code) Code])) + (Parser Code) (case tokens (^ (list& code tokens')) {#Some [tokens' code]} @@ -4433,24 +4507,35 @@ [#Tuple]))) (macro: .public (with_expansions tokens) - (case tokens - (^ (list& [_ {#Tuple bindings}] bodies)) - (case bindings - (^ (list& [_ {#Symbol ["" var_name]}] expr bindings')) - (do meta_monad - [expansion (single_expansion expr)] - (in (with_expansions' var_name expansion - (` (.with_expansions - [(~+ bindings')] - (~+ bodies)))))) - - {#End} - (in_meta bodies) - - _ - (failure "Wrong syntax for with_expansions")) + (case (parsed (andP (tupleP (someP bindingP)) (someP anyP)) tokens) + {#Some [bindings bodies]} + (loop [bindings bindings + map (: (PList (List Code)) + (list))] + (let [normal (: (-> Code (List Code)) + (function (_ it) + (list#mix (function (_ [binding expansion] it) + (list#conjoint (list#each (with_expansions' binding expansion) it))) + (list it) + map)))] + (case bindings + {#Item [var_name expr] &rest} + (do meta_monad + [expansion (case (normal expr) + (^ (list expr)) + (single_expansion expr) - _ + _ + (failure ($_ text#composite + "Incorrect expansion in with_expansions" + " | Binding: " (text#encoded var_name) + " | Expression: " (code#encoded expr))))] + (again &rest (plist#with var_name expansion map))) + + {#End} + (# meta_monad #in (list#conjoint (list#each normal bodies)))))) + + {#None} (failure "Wrong syntax for with_expansions"))) (def: (flat_alias type) @@ -4714,21 +4799,12 @@ _ (failure (..wrong_syntax_error (symbol ..:of))))) -(def: (tupleP tokens) - (-> (List Code) (Maybe [(List Code) (List Code)])) - (case tokens - (^ (list& [_ {#Tuple tuple}] tokens')) - {#Some [tokens' tuple]} - - _ - {#None})) - (def: (templateP tokens) (-> (List Code) (Maybe [Code Text (List Text) (List Code)])) (do maybe_monad [% (declarationP tokens) .let' [[tokens [export_policy name parameters]] %] - % (tupleP tokens) + % (tupleP (someP anyP) tokens) .let' [[tokens templates] %] _ (endP tokens)] (in [export_policy name parameters templates]))) diff --git a/stdlib/source/library/lux/macro.lux b/stdlib/source/library/lux/macro.lux index 9d5a4eb60..55bcbbfd8 100644 --- a/stdlib/source/library/lux/macro.lux +++ b/stdlib/source/library/lux/macro.lux @@ -1,22 +1,22 @@ (.using - [library - [lux {"-" symbol} - [abstract - ["[0]" monad {"+" do}]] - [data - ["[0]" text ("[1]#[0]" monoid)] - [collection - ["[0]" list ("[1]#[0]" monoid monad)]]] - [macro - ["[0]" code]] - [math - [number - ["[0]" nat] - ["[0]" int]]]]] + [library + [lux {"-" symbol} + [abstract + ["[0]" monad {"+" do}]] + [data + ["[0]" text ("[1]#[0]" monoid)] + [collection + ["[0]" list ("[1]#[0]" monoid monad)]]] + [math + [number + ["[0]" nat] + ["[0]" int]]]]] + [/ + ["[0]" code] ["[0]" // "_" ["[1]" meta ["[0]" location] - ["[0]" symbol ("[1]#[0]" codec)]]]) + ["[0]" symbol ("[1]#[0]" codec)]]]]) (def: .public (single_expansion syntax) (-> Code (Meta (List Code))) @@ -176,3 +176,26 @@ [log_expansion! ..expansion] [log_full_expansion! ..full_expansion] ) + +(macro: .public (times tokens) + (case tokens + (^ (list& [_ {.#Nat times}] terms)) + (loop [times times + before terms] + (case times + 0 + (# //.monad in before) + + _ + (do [! //.monad] + [after (|> before + (monad.each ! ..single_expansion) + (# ! each list#conjoint))] + (again (-- times) after)))) + + _ + (//.failure (..wrong_syntax_error (.symbol ..times))))) + +(macro: .public (final it) + (let [! //.monad] + (# ! each list#conjoint (monad.each ! ..expansion it)))) diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index 8f32b5108..c44dd5e7e 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -2,6 +2,7 @@ [library [lux "*" ["@" target {"+" Target}] + ["[0]" meta] [abstract ["[0]" monad {"+" do}]] [control @@ -17,7 +18,6 @@ ["[0]" dictionary] ["[0]" set] ["[0]" sequence ("[1]#[0]" functor)]]] - ["[0]" meta] [world ["[0]" file]]]] ["[0]" // "_" @@ -38,7 +38,7 @@ ["[0]P" synthesis] ["[0]P" directive] ["[0]P" analysis - ["[0]" module]] + ["[0]A" module]] ["[0]" extension {"+" Extender} ["[0]E" analysis] ["[0]E" synthesis] @@ -46,10 +46,10 @@ ["[0]D" lux]]]]]] [meta ["[0]" archive {"+" Archive} - ["[0]" descriptor] ["[0]" registry {"+" Registry}] - ["[0]" document]]]] - ]) + ["[0]" module] + ["[0]" descriptor] + ["[0]" document]]]]]) (def: .public (state target module expander host_analysis host generate generation_bundle) (All (_ anchor expression directive) @@ -129,8 +129,8 @@ _ (///directive.set_current_module module)] (///directive.lifted_analysis (do [! ///phase.monad] - [_ (module.create hash module) - _ (monad.each ! module.import dependencies) + [_ (moduleA.create hash module) + _ (monad.each ! moduleA.import dependencies) .let [source (///analysis.source (value@ ///.#module input) (value@ ///.#code input))] _ (///analysis.set_source_code source)] (in [source [///generation.empty_buffer @@ -142,7 +142,7 @@ (///directive.Operation anchor expression directive [.Module (Payload directive)]))) (do ///phase.monad [_ (///directive.lifted_analysis - (module.set_compiled module)) + (moduleA.set_compiled module)) analysis_module (<| (: (Operation .Module)) ///directive.lifted_analysis extension.lifted @@ -256,8 +256,9 @@ descriptor.#references (set.of_list text.hash dependencies) descriptor.#state {.#Compiled}]]] (in [state - {.#Right [descriptor - (document.document key analysis_module) + {.#Right [[module.#id (try.else module.runtime (archive.id module archive)) + module.#descriptor descriptor + module.#document (document.document key analysis_module)] (sequence#each (function (_ [artifact_id custom directive]) [artifact_id custom (write_directive directive)]) final_buffer) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index b7fb40f56..96c638d52 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" Module} + [lux "*" [type {"+" :sharing}] ["@" target] ["[0]" debug] @@ -48,12 +48,13 @@ [phase ["[0]" extension {"+" Extender}] [analysis - ["[0]" module]]]]] + ["[0]A" module]]]]] [meta ["[0]" archive {"+" Output Archive} ["[0]" registry {"+" Registry}] ["[0]" artifact] - ["[0]" descriptor {"+" Descriptor Module}] + ["[0]" module] + ["[0]" descriptor {"+" Descriptor}] ["[0]" document {"+" Document}]] [io {"+" Context} ["[0]" context] @@ -89,16 +90,18 @@ <Bundle> (as_is (///generation.Bundle <type_vars>))] (def: writer - (Writer [Descriptor (Document .Module) Registry]) + (Writer [(module.Module .Module) Registry]) ($_ _.and - descriptor.writer - (document.writer $.writer) + ($_ _.and + _.nat + descriptor.writer + (document.writer $.writer)) registry.writer )) - (def: (cache_module static platform module_id [descriptor document output registry]) + (def: (cache_module static platform module_id entry) (All (_ <type_vars>) - (-> Static <Platform> archive.ID (archive.Entry Any) + (-> Static <Platform> module.ID (archive.Entry Any) (Async (Try Any)))) (let [system (value@ #&file_system platform) write_artifact! (: (-> [artifact.ID (Maybe Text) Binary] (Action Any)) @@ -106,19 +109,25 @@ (ioW.write system static module_id artifact_id content)))] (do [! ..monad] [_ (ioW.prepare system static module_id) - _ (for [@.python (|> output + _ (for [@.python (|> entry + (value@ archive.#output) sequence.list (list.sub 128) (monad.each ! (monad.each ! write_artifact!)) (: (Action (List (List Any)))))] - (|> output + (|> entry + (value@ archive.#output) sequence.list (monad.each ..monad write_artifact!) (: (Action (List Any))))) document (# async.monad in - (document.marked? $.key document))] - (ioW.cache system static module_id - (_.result ..writer [descriptor document registry]))))) + (document.marked? $.key (value@ [archive.#module module.#document] entry)))] + (|> [(|> entry + (value@ archive.#module) + (with@ module.#document document)) + (value@ archive.#registry entry)] + (_.result ..writer) + (ioW.cache system static module_id))))) ... TODO: Inline ASAP (def: initialize_buffer! @@ -144,7 +153,13 @@ (def: runtime_document (Document .Module) - (document.document $.key (module.empty 0))) + (document.document $.key (moduleA.empty 0))) + + (def: runtime_module + (module.Module .Module) + [module.#id module.runtime + module.#descriptor runtime_descriptor + module.#document runtime_document]) (def: (process_runtime archive platform) (All (_ <type_vars>) @@ -154,12 +169,13 @@ (do ///phase.monad [[registry payload] (///directive.lifted_generation (..compile_runtime! platform)) + .let [entry [..runtime_module payload registry]] archive (///phase.lifted (if (archive.reserved? archive archive.runtime_module) - (archive.has archive.runtime_module [..runtime_descriptor ..runtime_document payload registry] archive) + (archive.has archive.runtime_module entry archive) (do try.monad [[_ archive] (archive.reserve archive.runtime_module archive)] - (archive.has archive.runtime_module [..runtime_descriptor ..runtime_document payload registry] archive))))] - (in [archive [..runtime_descriptor ..runtime_document payload registry]]))) + (archive.has archive.runtime_module entry archive))))] + (in [archive entry]))) (def: (initialize_state extender [analysers @@ -226,7 +242,7 @@ import compilation_sources) (All (_ <type_vars>) (-> Static - Module + descriptor.Module Expander ///analysis.Bundle <Platform> @@ -278,7 +294,7 @@ (def: (module_compilation_log module) (All (_ <type_vars>) - (-> Module <State+> Text)) + (-> descriptor.Module <State+> Text)) (|>> (value@ [extension.#state ///directive.#generation ///directive.#state @@ -299,11 +315,11 @@ sequence.empty)) (def: empty - (Set Module) + (Set descriptor.Module) (set.empty text.hash)) (type: Mapping - (Dictionary Module (Set Module))) + (Dictionary descriptor.Module (Set descriptor.Module))) (type: Dependence (Record @@ -317,8 +333,8 @@ #depended_by empty])) (def: (depend module import dependence) - (-> Module Module Dependence Dependence) - (let [transitive_dependency (: (-> (-> Dependence Mapping) Module (Set Module)) + (-> descriptor.Module descriptor.Module Dependence Dependence) + (let [transitive_dependency (: (-> (-> Dependence Mapping) descriptor.Module (Set descriptor.Module)) (function (_ lens module) (|> dependence lens @@ -326,7 +342,7 @@ (maybe.else ..empty)))) transitive_depends_on (transitive_dependency (value@ #depends_on) import) transitive_depended_by (transitive_dependency (value@ #depended_by) module) - update_dependence (: (-> [Module (Set Module)] [Module (Set Module)] + update_dependence (: (-> [descriptor.Module (Set descriptor.Module)] [descriptor.Module (Set descriptor.Module)] (-> Mapping Mapping)) (function (_ [source forward] [target backward]) (function (_ mapping) @@ -349,8 +365,8 @@ [import transitive_depended_by]))))) (def: (circular_dependency? module import dependence) - (-> Module Module Dependence Bit) - (let [dependence? (: (-> Module (-> Dependence Mapping) Module Bit) + (-> descriptor.Module descriptor.Module Dependence Bit) + (let [dependence? (: (-> descriptor.Module (-> Dependence Mapping) descriptor.Module Bit) (function (_ from relationship to) (let [targets (|> dependence relationship @@ -360,24 +376,24 @@ (or (dependence? import (value@ #depends_on) module) (dependence? module (value@ #depended_by) import)))) - (exception: .public (module_cannot_import_itself [module Module]) + (exception: .public (module_cannot_import_itself [module descriptor.Module]) (exception.report ["Module" (%.text module)])) - (exception: .public (cannot_import_circular_dependency [importer Module - importee Module]) + (exception: .public (cannot_import_circular_dependency [importer descriptor.Module + importee descriptor.Module]) (exception.report ["Importer" (%.text importer)] ["importee" (%.text importee)])) - (exception: .public (cannot_import_twice [importer Module - duplicates (Set Module)]) + (exception: .public (cannot_import_twice [importer descriptor.Module + duplicates (Set descriptor.Module)]) (exception.report ["Importer" (%.text importer)] ["Duplicates" (%.list %.text (set.list duplicates))])) (def: (verify_dependencies importer importee dependence) - (-> Module Module Dependence (Try Any)) + (-> descriptor.Module descriptor.Module Dependence (Try Any)) (cond (text#= importer importee) (exception.except ..module_cannot_import_itself [importer]) @@ -440,8 +456,8 @@ <Return> (as_is (Async <Result>)) <Signal> (as_is (Resolver <Result>)) <Pending> (as_is [<Return> <Signal>]) - <Importer> (as_is (-> Module Module <Return>)) - <Compiler> (as_is (-> Module <Importer> archive.ID <Context> Module <Return>))] + <Importer> (as_is (-> descriptor.Module descriptor.Module <Return>)) + <Compiler> (as_is (-> descriptor.Module <Importer> module.ID <Context> descriptor.Module <Return>))] (def: (parallel initial) (All (_ <type_vars>) (-> <Context> @@ -451,7 +467,7 @@ <Context> initial - (Var (Dictionary Module <Pending>)) + (Var (Dictionary descriptor.Module <Pending>)) (:expected (stm.var (dictionary.empty text.hash)))) dependence (: (Var Dependence) (stm.var ..independence))] @@ -463,7 +479,7 @@ initial (Async [<Return> (Maybe [<Context> - archive.ID + module.ID <Signal>])]) (:expected (stm.commit! @@ -543,8 +559,10 @@ (do [! try.monad] [modules (monad.each ! (function (_ module) (do ! - [[descriptor document output] (archive.find module archive) - lux_module (document.content $.key document)] + [entry (archive.find module archive) + lux_module (|> entry + (value@ [archive.#module module.#document]) + (document.content $.key))] (in [module lux_module]))) (archive.archived archive)) .let [additions (|> modules @@ -571,7 +589,7 @@ (def: (set_current_module module state) (All (_ <type_vars>) - (-> Module <State+> <State+>)) + (-> descriptor.Module <State+> <State+>)) (|> (///directive.set_current_module module) (///phase.result' state) try.trusted @@ -581,8 +599,8 @@ ... This currently assumes that all imports will be specified once in a single .using form. ... This might not be the case in the future. (def: (with_new_dependencies new_dependencies all_dependencies) - (-> (List Module) (Set Module) [(Set Module) (Set Module)]) - (let [[all_dependencies duplicates _] (: [(Set Module) (Set Module) Bit] + (-> (List descriptor.Module) (Set descriptor.Module) [(Set descriptor.Module) (Set descriptor.Module)]) + (let [[all_dependencies duplicates _] (: [(Set descriptor.Module) (Set descriptor.Module) Bit] (list#mix (function (_ new [all duplicates seen_prelude?]) (if (set.member? all new) (if (text#= .prelude_module new) @@ -591,14 +609,14 @@ [all duplicates true]) [all (set.has new duplicates) seen_prelude?]) [(set.has new all) duplicates seen_prelude?])) - (: [(Set Module) (Set Module) Bit] + (: [(Set descriptor.Module) (Set descriptor.Module) Bit] [all_dependencies ..empty (set.empty? all_dependencies)]) new_dependencies))] [all_dependencies duplicates])) (def: (after_imports import! module duplicates new_dependencies [archive state]) (All (_ <type_vars>) - (-> <Importer> Module (Set Module) (List Module) <Context> <Return>)) + (-> <Importer> descriptor.Module (Set descriptor.Module) (List descriptor.Module) <Context> <Return>)) (do [! (try.with async.monad)] [] (if (set.empty? duplicates) @@ -622,7 +640,7 @@ (def: (next_compilation module [archive state] compilation) (All (_ <type_vars>) - (-> Module <Context> (///.Compilation <State+> .Module Any) + (-> descriptor.Module <Context> (///.Compilation <State+> .Module Any) (Try [<State+> (Either (///.Compilation <State+> .Module Any) (archive.Entry Any))]))) ((value@ ///.#process compilation) @@ -655,7 +673,7 @@ module)] (loop [[archive state] [archive (..set_current_module module state)] compilation (compiler input) - all_dependencies (: (Set Module) + all_dependencies (: (Set descriptor.Module) (set.of_list text.hash (list)))] (do ! [.let [new_dependencies (value@ ///.#dependencies compilation) @@ -669,12 +687,12 @@ <Platform> platform - (-> <Context> (///.Compilation <State+> .Module Any) (Set Module) + (-> <Context> (///.Compilation <State+> .Module Any) (Set descriptor.Module) (Action [Archive <State+>])) (:expected again))] (continue! [archive state] more all_dependencies)) - {.#Right [descriptor document output]} + {.#Right entry} (do ! [_ (let [report (..module_compilation_log module state)] (with_expansions [<else> (in (debug.log! report))] @@ -685,9 +703,9 @@ {.#Some console} (console.write_line report console))] <else>))) - .let [descriptor (with@ descriptor.#references all_dependencies descriptor)] - _ (..cache_module static platform module_id [descriptor document output])] - (case (archive.has module [descriptor document output] archive) + .let [entry (with@ [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] + _ (..cache_module static platform module_id entry)] + (case (archive.has module entry archive) {try.#Success archive} (in [archive (..with_reset_log state)]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux index 7342e46ed..b561975c1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -32,11 +32,12 @@ [meta ["[0]" archive {"+" Archive} ["[0]" descriptor] + ["[0]" module] ["[0]" artifact] ["[0]" registry {"+" Registry}]]]]]) (type: .public Context - [archive.ID artifact.ID]) + [module.ID artifact.ID]) (type: .public (Buffer directive) (Sequence [artifact.ID (Maybe Text) directive])) @@ -283,7 +284,7 @@ registry (if (text#= (value@ #module state) _module) {try.#Success (value@ #registry state)} (do try.monad - [[descriptor document output registry] (archive.find _module archive)] + [[_module output registry] (archive.find _module archive)] {try.#Success registry}))] (case (registry.id _name registry) {.#None} @@ -296,7 +297,7 @@ (def: .public (module_id module archive) (All (_ anchor expression directive) - (-> descriptor.Module Archive (Operation anchor expression directive archive.ID))) + (-> descriptor.Module Archive (Operation anchor expression directive module.ID))) (function (_ (^@ stateE [bundle state])) (do try.monad [module_id (archive.id module archive)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index 92be3af3c..74f526332 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -33,7 +33,7 @@ ["[1][0]" analysis] ["/[1]" // "_" [analysis - ["[0]" module]] + ["[0]A" module]] ["/[1]" // "_" ["[1][0]" analysis [macro {"+" Expander}] @@ -47,7 +47,8 @@ ["[0]" phase] [meta ["[0]" archive {"+" Archive} - ["[0]" artifact]] + ["[0]" artifact] + ["[0]" module]] ["[0]" cache "_" ["[1]/[0]" artifact]]]]]]]) @@ -241,7 +242,7 @@ [type valueT value] (..definition archive full_name {.#None} valueC) [_ _ exported?] (evaluate! archive Bit exported?C) _ (/////directive.lifted_analysis - (module.define short_name {.#Definition [(:as Bit exported?) type value]})) + (moduleA.define short_name {.#Definition [(:as Bit exported?) type value]})) _ (..refresh expander host_analysis) _ (..announce_definition! short_name type)] (in /////directive.no_requirements)) @@ -283,13 +284,13 @@ [true slots])] _ (case labels {.#End} - (module.define short_name {.#Definition [exported? type value]}) + (moduleA.define short_name {.#Definition [exported? type value]}) {.#Item labels} - (module.define short_name {.#Type [exported? (:as .Type value) (if record? - {.#Right labels} - {.#Left labels})]})) - _ (module.declare_tags record? labels exported? (:as .Type value))] + (moduleA.define short_name {.#Type [exported? (:as .Type value) (if record? + {.#Right labels} + {.#Left labels})]})) + _ (moduleA.declare_tags record? labels exported? (:as .Type value))] (in labels))) _ (..refresh expander host_analysis) _ (..announce_definition! short_name type) @@ -311,10 +312,10 @@ [_ (/////directive.lifted_analysis (monad.each ! (function (_ [module alias]) (do ! - [_ (module.import module)] + [_ (moduleA.import module)] (case alias "" (in []) - _ (module.alias alias module)))) + _ (moduleA.alias alias module)))) imports))] (in [/////directive.#imports imports /////directive.#referrals (list)])))])) @@ -344,7 +345,7 @@ (^or {.#Definition _} {.#Type _}) - (module.define alias {.#Alias original}) + (moduleA.define alias {.#Alias original}) (^or {.#Tag _} {.#Slot _}) @@ -490,7 +491,7 @@ (def: (define_program archive module_id generate program programS) (All (_ anchor expression directive output) (-> Archive - archive.ID + module.ID (/////generation.Phase anchor expression directive) (Program expression directive) Synthesis diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux index 6d10d0316..6ca49597b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux @@ -41,7 +41,7 @@ (function (_ module) (do ! [id (archive.id module archive) - [descriptor document output registry] (archive.find module archive)] + [_module output registry] (archive.find module archive)] (in [[module id] registry])))))] (case (list.one (function (_ [[module module_id] registry]) (do maybe.monad diff --git a/stdlib/source/library/lux/tool/compiler/meta.lux b/stdlib/source/library/lux/tool/compiler/meta.lux index ff683a921..bf357179c 100644 --- a/stdlib/source/library/lux/tool/compiler/meta.lux +++ b/stdlib/source/library/lux/tool/compiler/meta.lux @@ -6,4 +6,4 @@ (def: .public version Version - 00,01,00) + 00,02,00) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index faa7e8765..9f34caa2d 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -1,42 +1,43 @@ (.using - [library - [lux "*" - [abstract - ["[0]" equivalence {"+" Equivalence}] - ["[0]" monad {"+" do}]] - [control - ["[0]" maybe] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}] - ["[0]" function] - ["<>" parser - ["<[0]>" binary {"+" Parser}]]] - [data - [binary {"+" Binary}] - ["[0]" product] - ["[0]" text - ["%" format {"+" format}]] - [format - ["[0]" binary {"+" Writer}]] - [collection - ["[0]" list ("[1]#[0]" functor mix)] - ["[0]" dictionary {"+" Dictionary}] - ["[0]" set] - ["[0]" sequence {"+" Sequence}]]] - [math - [number - ["n" nat ("[1]#[0]" equivalence)]]] - [type - abstract]]] - [/ - ["[0]" artifact] - ["[0]" registry {"+" Registry}] - ["[0]" signature {"+" Signature}] - ["[0]" key {"+" Key}] - ["[0]" descriptor {"+" Descriptor}] - ["[0]" document {"+" Document}] - [/// - [version {"+" Version}]]]) + [library + [lux {"-" Module} + [abstract + ["[0]" equivalence {"+" Equivalence}] + ["[0]" monad {"+" do}]] + [control + ["[0]" maybe] + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}] + ["[0]" function] + ["<>" parser + ["<[0]>" binary {"+" Parser}]]] + [data + [binary {"+" Binary}] + ["[0]" product] + ["[0]" text + ["%" format {"+" format}]] + [format + ["[0]" binary {"+" Writer}]] + [collection + ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" dictionary {"+" Dictionary}] + ["[0]" set] + ["[0]" sequence {"+" Sequence}]]] + [math + [number + ["n" nat ("[1]#[0]" equivalence)]]] + [type + abstract]]] + [/ + ["[0]" artifact] + ["[0]" registry {"+" Registry}] + ["[0]" signature {"+" Signature}] + ["[0]" key {"+" Key}] + ["[0]" descriptor {"+" Descriptor}] + ["[0]" document {"+" Document}] + ["[0]" module {"+" Module}] + [/// + [version {"+" Version}]]]) (type: .public Output (Sequence [artifact.ID (Maybe Text) Binary])) @@ -65,27 +66,23 @@ [module_is_only_reserved] ) -(type: .public ID - Nat) - (def: .public runtime_module descriptor.Module "") (type: .public (Entry a) (Record - [#descriptor Descriptor - #document (Document a) + [#module (Module a) #output Output #registry Registry])) (abstract: .public Archive (Record - [#next ID - #resolver (Dictionary descriptor.Module [ID (Maybe (Entry Any))])]) + [#next module.ID + #resolver (Dictionary descriptor.Module [module.ID (Maybe (Entry Any))])]) (def: next - (-> Archive ID) + (-> Archive module.ID) (|>> :representation (value@ #next))) (def: .public empty @@ -94,7 +91,7 @@ #resolver (dictionary.empty text.hash)])) (def: .public (id module archive) - (-> descriptor.Module Archive (Try ID)) + (-> descriptor.Module Archive (Try module.ID)) (let [(^open "/[0]") (:representation archive)] (case (dictionary.value module /#resolver) {.#Some [id _]} @@ -105,7 +102,7 @@ (dictionary.keys /#resolver)])))) (def: .public (reserve module archive) - (-> descriptor.Module Archive (Try [ID Archive])) + (-> descriptor.Module Archive (Try [module.ID Archive])) (let [(^open "/[0]") (:representation archive)] (case (dictionary.value module /#resolver) {.#Some _} @@ -129,17 +126,18 @@ (revised@ ..#resolver (dictionary.has module [id {.#Some entry}])) :abstraction)} - {.#Some [id {.#Some [existing_descriptor existing_document existing_output]}]} - (if (same? existing_document (value@ #document entry)) + {.#Some [id {.#Some [existing_module existing_output existing_registry]}]} + (if (same? (value@ module.#document existing_module) + (value@ [#module module.#document] entry)) ... TODO: Find out why this code allows for the same module to be added more than once. It looks fishy... {try.#Success archive} - (exception.except ..cannot_replace_document [module existing_document (value@ #document entry)])) + (exception.except ..cannot_replace_document [module (value@ module.#document existing_module) (value@ [#module module.#document] entry)])) {.#None} (exception.except ..module_must_be_reserved_before_it_can_be_added [module])))) (def: .public entries - (-> Archive (List [descriptor.Module [ID (Entry Any)]])) + (-> Archive (List [descriptor.Module [module.ID (Entry Any)]])) (|>> :representation (value@ #resolver) dictionary.entries @@ -195,7 +193,7 @@ dictionary.keys)) (def: .public reservations - (-> Archive (List [descriptor.Module ID])) + (-> Archive (List [descriptor.Module module.ID])) (|>> :representation (value@ #resolver) dictionary.entries @@ -221,10 +219,10 @@ :abstraction))) (type: Reservation - [descriptor.Module ID]) + [descriptor.Module module.ID]) (type: Frozen - [Version ID (List Reservation)]) + [Version module.ID (List Reservation)]) (def: reader (Parser ..Frozen) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/module.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/module.lux new file mode 100644 index 000000000..9e6280b25 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/module.lux @@ -0,0 +1,19 @@ +(.using + [library + [lux {"-" Module}]] + [// + [descriptor {"+" Descriptor}] + [document {"+" Document}]]) + +(type: .public ID + Nat) + +(def: .public runtime + ID + 0) + +(type: .public (Module a) + (Record + [#id ID + #descriptor Descriptor + #document (Document a)])) 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 0716cae4e..9971d71a1 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux @@ -30,7 +30,6 @@ [meta ["[0]" archive {"+" Archive} ["[0]" artifact] - ["[0]" descriptor] ["[0]" registry {"+" Registry}]]]]]]]) (def: (path_references references) @@ -192,7 +191,7 @@ (Dictionary artifact.Dependency (Set artifact.Dependency))]) (|> archive archive.entries - (list#each (function (_ [module [module_id [descriptor document output registry]]]) + (list#each (function (_ [module [module_id [_module output registry]]]) (|> registry registry.artifacts sequence.list 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 9a3f9c9cb..c6c1a7e5e 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux @@ -19,6 +19,7 @@ [/// ["[0]" archive {"+" Output Archive} [key {"+" Key}] + ["[0]" module] ["[0]" descriptor {"+" Descriptor}] ["[0]" document {"+" Document}]]]) @@ -57,8 +58,8 @@ (function (_ again module) (do [! state.monad] [.let [parents (case (archive.find module archive) - {try.#Success [descriptor document output registry]} - (value@ descriptor.#references descriptor) + {try.#Success [module output registry]} + (value@ [module.#descriptor descriptor.#references] module) {try.#Failure error} ..fresh)] @@ -81,7 +82,7 @@ (set.member? target_ancestry source))) (type: .public (Order a) - (List [descriptor.Module [archive.ID (archive.Entry a)]])) + (List [descriptor.Module [module.ID (archive.Entry a)]])) (def: .public (load_order key archive) (All (_ a) (-> (Key a) Archive (Try (Order a)))) @@ -94,5 +95,5 @@ (do try.monad [module_id (archive.id module archive) entry (archive.find module archive) - document (document.marked? key (value@ archive.#document entry))] - (in [module [module_id (with@ archive.#document document entry)]]))))))) + document (document.marked? key (value@ [archive.#module module.#document] entry))] + (in [module [module_id (with@ [archive.#module module.#document] document entry)]]))))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/io.lux b/stdlib/source/library/lux/tool/compiler/meta/io.lux index 23523f2e8..e0262eba8 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io.lux @@ -17,4 +17,5 @@ (text.replaced "/" (# system separator))) (def: .public lux_context + Context "lux") 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 79ff9881e..e89b45756 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -37,6 +37,7 @@ ["/[1]" // ["[0]" archive {"+" Output Archive} ["[0]" registry {"+" Registry}] + ["[0]" module] ["[0]" descriptor {"+" Descriptor}] ["[0]" document {"+" Document}] ["[0]" artifact {"+" Artifact Dependency} @@ -54,7 +55,7 @@ ["[1]/[0]" program]]]]]]) (exception: .public (cannot_prepare [archive file.Path - module_id archive.ID + module_id module.ID error Text]) (exception.report ["Archive" archive] @@ -80,13 +81,13 @@ (%.nat version.version))) (def: (module fs static module_id) - (All (_ !) (-> (file.System !) Static archive.ID file.Path)) + (All (_ !) (-> (file.System !) Static module.ID file.Path)) (format (..versioned_lux_archive fs static) (# fs separator) (%.nat module_id))) (def: .public (artifact fs static module_id artifact_id) - (All (_ !) (-> (file.System !) Static archive.ID artifact.ID file.Path)) + (All (_ !) (-> (file.System !) Static module.ID artifact.ID file.Path)) (format (..module fs static module_id) (# fs separator) (%.nat artifact_id) @@ -101,7 +102,7 @@ (# fs make_directory path)))) (def: .public (prepare fs static module_id) - (-> (file.System Async) Static archive.ID (Async (Try Any))) + (-> (file.System Async) Static module.ID (Async (Try Any))) (do [! async.monad] [.let [module (..module fs static module_id)] module_exists? (# fs directory? module)] @@ -121,7 +122,7 @@ error]))))))))) (def: .public (write fs static module_id artifact_id content) - (-> (file.System Async) Static archive.ID artifact.ID Binary (Async (Try Any))) + (-> (file.System Async) Static module.ID artifact.ID Binary (Async (Try Any))) (# fs write content (..artifact fs static module_id artifact_id))) (def: .public (enable fs static) @@ -144,24 +145,30 @@ "module_descriptor") (def: (module_descriptor fs static module_id) - (-> (file.System Async) Static archive.ID file.Path) + (-> (file.System Async) Static module.ID file.Path) (format (..module fs static module_id) (# fs separator) ..module_descriptor_file)) (def: .public (cache fs static module_id content) - (-> (file.System Async) Static archive.ID Binary (Async (Try Any))) + (-> (file.System Async) Static module.ID Binary (Async (Try Any))) (# fs write content (..module_descriptor fs static module_id))) (def: (read_module_descriptor fs static module_id) - (-> (file.System Async) Static archive.ID (Async (Try Binary))) + (-> (file.System Async) Static module.ID (Async (Try Binary))) (# fs read (..module_descriptor fs static module_id))) -(def: parser - (Parser [Descriptor (Document .Module) Registry]) +(def: module_parser + (Parser (module.Module .Module)) ($_ <>.and + <binary>.nat descriptor.parser - (document.parser $.parser) + (document.parser $.parser))) + +(def: parser + (Parser [(module.Module .Module) Registry]) + ($_ <>.and + ..module_parser registry.parser)) (def: (fresh_analysis_state host) @@ -174,14 +181,16 @@ [modules (: (Try (List [descriptor.Module .Module])) (monad.each ! (function (_ module) (do ! - [[descriptor document output] (archive.find module archive) - content (document.content $.key document)] + [entry (archive.find module archive) + content (|> entry + (value@ [archive.#module module.#document]) + (document.content $.key))] (in [module content]))) (archive.archived archive)))] (in (with@ .#modules modules (fresh_analysis_state host))))) (def: (cached_artifacts fs static module_id) - (-> (file.System Async) Static archive.ID (Async (Try (Dictionary Text Binary)))) + (-> (file.System Async) Static module.ID (Async (Try (Dictionary Text Binary)))) (let [! (try.with async.monad)] (|> (..module fs static module_id) (# fs directory_files) @@ -216,7 +225,7 @@ (def: (loaded_document extension host module_id expected actual document) (All (_ expression directive) - (-> Text (generation.Host expression directive) archive.ID (Sequence [Artifact (Set Dependency)]) (Dictionary Text Binary) (Document .Module) + (-> Text (generation.Host expression directive) module.ID (Sequence [Artifact (Set Dependency)]) (Dictionary Text Binary) (Document .Module) (Try [(Document .Module) Bundles Output]))) (do [! try.monad] [[definitions bundles] (: (Try [Definitions Bundles Output]) @@ -352,23 +361,24 @@ (in [(document.document $.key (with@ .#definitions definitions content)) bundles]))) -(def: (load_definitions fs static module_id host_environment descriptor document registry) +(def: (load_definitions fs static module_id host_environment entry) (All (_ expression directive) - (-> (file.System Async) Static archive.ID (generation.Host expression directive) - Descriptor (Document .Module) Registry + (-> (file.System Async) Static module.ID (generation.Host expression directive) + (archive.Entry .Module) (Async (Try [(archive.Entry .Module) Bundles])))) (do (try.with async.monad) [actual (cached_artifacts fs static module_id) - .let [expected (registry.artifacts registry)] - [document bundles output] (async#in (loaded_document (value@ static.#artifact_extension static) host_environment module_id expected actual document))] - (in [[archive.#descriptor descriptor - archive.#document document - archive.#output output - archive.#registry registry] + .let [expected (registry.artifacts (value@ archive.#registry entry))] + [document bundles output] (|> (value@ [archive.#module module.#document] entry) + (loaded_document (value@ static.#artifact_extension static) host_environment module_id expected actual) + async#in)] + (in [(|> entry + (with@ [archive.#module module.#document] document) + (with@ archive.#output output)) bundles]))) (def: (purge! fs static [module_name module_id]) - (-> (file.System Async) Static [descriptor.Module archive.ID] (Async (Try Any))) + (-> (file.System Async) Static [descriptor.Module module.ID] (Async (Try Any))) (do [! (try.with async.monad)] [.let [cache (..module fs static module_id)] _ (|> cache @@ -387,10 +397,10 @@ (value@ ////.#hash actual)))) (type: Cache - [descriptor.Module [archive.ID [Descriptor (Document .Module) Registry]]]) + [descriptor.Module [module.ID [(module.Module .Module) Registry]]]) (type: Purge - (Dictionary descriptor.Module archive.ID)) + (Dictionary descriptor.Module module.ID)) (def: initial_purge (-> (List [Bit Cache]) @@ -405,13 +415,13 @@ (-> (List [Bit Cache]) (cache/module.Order .Module) Purge) - (list#mix (function (_ [module_name [module_id [descriptor document]]] purge) + (list#mix (function (_ [module_name [module_id entry]] purge) (let [purged? (: (Predicate descriptor.Module) (dictionary.key? purge))] (if (purged? module_name) purge - (if (|> descriptor - (value@ descriptor.#references) + (if (|> entry + (value@ [archive.#module module.#descriptor descriptor.#references]) set.list (list.any? purged?)) (dictionary.has module_name module_id purge) @@ -425,17 +435,17 @@ (def: (valid_cache fs static import contexts [module_name module_id]) (-> (file.System Async) Static Import (List Context) - [descriptor.Module archive.ID] + [descriptor.Module module.ID] (Async (Try [Bit Cache]))) - (with_expansions [<cache> [module_name [module_id [descriptor document registry]]]] + (with_expansions [<cache> [module_name [module_id [module registry]]]] (do [! (try.with async.monad)] [data (..read_module_descriptor fs static module_id) - [descriptor document registry] (async#in (<binary>.result ..parser data))] + [module registry] (async#in (<binary>.result ..parser data))] (if (text#= archive.runtime_module module_name) (in [true <cache>]) (do ! [input (//context.read fs ..pseudo_module import contexts (value@ static.#host_module_extension static) module_name)] - (in [(..valid_cache? descriptor input) <cache>])))))) + (in [(..valid_cache? (value@ module.#descriptor module) input) <cache>])))))) (def: (pre_loaded_caches fs static import contexts archive) (-> (file.System Async) Static Import (List Context) Archive @@ -453,8 +463,12 @@ (Try (cache/module.Order .Module))) (|> pre_loaded_caches (monad.mix try.monad - (function (_ [_ [module [module_id [descriptor document registry]]]] archive) - (archive.has module [descriptor document (: Output sequence.empty) registry] archive)) + (function (_ [_ [module [module_id [|module| registry]]]] archive) + (archive.has module + [archive.#module |module| + archive.#output (: Output sequence.empty) + archive.#registry registry] + archive)) archive) (# try.monad each (cache/module.load_order $.key)) (# try.monad conjoint))) @@ -468,9 +482,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 [descriptor document _ registry]]]) + (monad.each ! (function (_ [module_name [module_id entry]]) (do ! - [[entry bundles] (..load_definitions fs static module_id host_environment descriptor document registry)] + [[entry bundles] (..load_definitions fs static module_id host_environment entry)] (in [[module_name entry] bundles])))))] (in it))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux index 741ee6591..811739223 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux @@ -16,9 +16,10 @@ ["[0]" cache "_" ["[1]/[0]" module]] ["[0]" archive {"+" Archive} - ["[0]" descriptor] ["[0]" artifact] - ["[0]" registry]] + ["[0]" registry] + ["[0]" module] + ["[0]" descriptor]] [// [language [lux @@ -32,12 +33,13 @@ (List [Text Binary]))))) (type: .public Order - (List [archive.ID (List artifact.ID)])) + (List [module.ID (List artifact.ID)])) (def: .public order (-> (cache/module.Order Any) Order) - (list#each (function (_ [module [module_id [_descriptor _document _output registry]]]) - (|> registry + (list#each (function (_ [module [module_id entry]]) + (|> entry + (value@ archive.#registry) registry.artifacts sequence.list (list#each (|>> product.left (value@ artifact.#id))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux index 34e0cfd46..d056970b8 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -32,6 +32,7 @@ ["[0]" // {"+" Packager} [// ["[0]" archive {"+" Output} + ["[0]" module] ["[0]" descriptor {"+" Module}] ["[0]" artifact]] ["[0]" cache "_" @@ -139,7 +140,7 @@ manifest))) (def: (write_class static module artifact custom content sink) - (-> Static archive.ID artifact.ID (Maybe Text) Binary java/util/jar/JarOutputStream + (-> Static module.ID artifact.ID (Maybe Text) Binary java/util/jar/JarOutputStream (Try java/util/jar/JarOutputStream)) (let [class_path (|> custom (maybe#each (|>> name.internal name.read)) @@ -154,7 +155,7 @@ (java/util/zip/ZipOutputStream::closeEntry)))))) (def: (write_module static necessary_dependencies [module output] sink) - (-> Static (Set Context) [archive.ID Output] java/util/jar/JarOutputStream + (-> Static (Set Context) [module.ID Output] java/util/jar/JarOutputStream (Try java/util/jar/JarOutputStream)) (let [! try.monad] (monad.mix try.monad @@ -257,8 +258,8 @@ order (cache/module.load_order $.key archive) .let [buffer (java/io/ByteArrayOutputStream::new (.int ..mebi_byte))] sink (|> order - (list#each (function (_ [module [module_id [descriptor document output registry]]]) - [module_id output])) + (list#each (function (_ [module [module_id entry]]) + [module_id (value@ archive.#output entry)])) (monad.mix ! (..write_module static necessary_dependencies) (java/util/jar/JarOutputStream::new buffer (..manifest program)))) [entries duplicates sink] (|> host_dependencies diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux index 243ee7653..294e31ecc 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux @@ -79,14 +79,14 @@ (-> archive.ID file.Path) (|>> %.nat (text.suffix ".rb"))) -(def: (write_module mapping necessary_dependencies [module [module_id [descriptor document output registry]]] sink) +(def: (write_module mapping necessary_dependencies [module [module_id entry]] sink) (-> (Dictionary Module archive.ID) (Set Context) [Module [archive.ID [Descriptor (Document .Module) Output Registry]]] (List [archive.ID [Text Binary]]) (Try (List [archive.ID [Text Binary]]))) (do [! try.monad] [bundle (: (Try (Maybe _.Statement)) - (..bundle_module module module_id necessary_dependencies output))] + (..bundle_module module module_id necessary_dependencies (value@ archive.#output entry)))] (case bundle {.#None} (in sink) @@ -105,7 +105,7 @@ (def: module_id_mapping (-> (Order .Module) (Dictionary Module archive.ID)) - (|>> (list#each (function (_ [module [module_id [descriptor document output]]]) + (|>> (list#each (function (_ [module [module_id entry]]) [module module_id])) (dictionary.of_list text.hash))) @@ -124,7 +124,7 @@ imports (|> order (list.only (|>> product.right product.left (set.member? included_modules))) list.reversed - (list#each (function (_ [module [module_id [descriptor document output registry]]]) + (list#each (function (_ [module [module_id entry]]) (let [relative_path (_.do "gsub" (list (_.string main_file) (_.string (..module_file module_id))) {.#None} diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux index 2d61f9191..0f6007e75 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux @@ -71,8 +71,8 @@ [.let [necessary_dependencies (cache/artifact.necessary_dependencies archive)] order (cache/module.load_order $.key archive)] (|> order - (list#each (function (_ [module [module_id [descriptor document output registry]]]) - [module_id output])) + (list#each (function (_ [module [module_id entry]]) + [module_id (value@ archive.#output entry)])) (monad.mix ! (..write_module necessary_dependencies sequence) header) (# ! each (|>> scope code diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index 1f28f0e21..ef7463d4e 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -1,36 +1,37 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" try ("[1]#[0]" functor)] - [parser - ["<[0]>" code]]] - [data - ["[0]" bit ("[1]#[0]" equivalence)] - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list]]] - [math - ["[0]" random {"+" Random}] - [number - ["[0]" nat]]] - ["[0]" meta - ["[0]" location] - ["[0]" symbol]]]] - [\\library - ["[0]" / - [syntax {"+" syntax:}] - ["[0]" code ("[1]#[0]" equivalence)] - ["[0]" template]]] - ["[0]" / "_" - ["[1][0]" code] - ["[1][0]" local] - ["[1][0]" syntax] - ["[1][0]" template]]) + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" static] + [abstract + [monad {"+" do}]] + [control + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" code]]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list]]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" functor)] + [number + ["n" nat]]] + ["[0]" meta + ["[0]" location] + ["[0]" symbol]]]] + [\\library + ["[0]" / + [syntax {"+" syntax:}] + ["[0]" code ("[1]#[0]" equivalence)] + ["[0]" template]]] + ["[0]" / "_" + ["[1][0]" code] + ["[1][0]" local] + ["[1][0]" syntax] + ["[1][0]" template]]) (template: (!expect <pattern> <value>) [(case <value> @@ -42,7 +43,7 @@ [(template.text [<definition>]) {.#Definition [true .Macro <definition>]}])]) (syntax: (pow/2 [number <code>.any]) - (in (list (` (nat.* (~ number) (~ number)))))) + (in (list (` (n.* (~ number) (~ number)))))) (syntax: (pow/4 [number <code>.any]) (in (list (` (..pow/2 (..pow/2 (~ number))))))) @@ -100,19 +101,25 @@ .#eval (:as (-> Type Code (Meta Any)) []) .#host []]]))) -(def: expander +(syntax: (iterated [cycle <code>.nat + it <code>.any]) + (in (list (case cycle + 0 it + _ (` (..iterated (~ (code.nat (-- cycle))) (~ it))))))) + +(def: test|expansion Test (do [! random.monad] [[seed symbol_prefix lux] ..random_lux pow/1 (# ! each code.nat random.nat) - repetitions (# ! each (nat.% 10) random.nat) + repetitions (# ! each (n.% 10) random.nat) .let [single_expansion (` (..pow/2 (..pow/2 (~ pow/1)))) - expansion (` (nat.* (..pow/2 (~ pow/1)) - (..pow/2 (~ pow/1)))) - full_expansion (` (nat.* (nat.* (~ pow/1) (~ pow/1)) - (nat.* (~ pow/1) (~ pow/1))))]] + expansion (` (n.* (..pow/2 (~ pow/1)) + (..pow/2 (~ pow/1)))) + full_expansion (` (n.* (n.* (~ pow/1) (~ pow/1)) + (n.* (~ pow/1) (~ pow/1))))]] (`` ($_ _.and (~~ (template [<expander> <logger> <expansion>] [(_.cover [<expander>] @@ -137,10 +144,36 @@ [/.full_expansion /.log_full_expansion! full_expansion] )) (_.cover [/.one_expansion] - (bit#= (not (nat.= 1 repetitions)) + (bit#= (not (n.= 1 repetitions)) (|> (/.one_expansion (` (..repeated (~ (code.nat repetitions)) (~ pow/1)))) (meta.result lux) (!expect {try.#Failure _})))) + (_.cover [/.final] + (with_expansions [<expected> (static.random_nat) + <cycles> (static.random code.nat + (random#each (|>> (n.% 5) ++) random.nat)) + <actual> (/.final (..iterated <cycles> <expected>))] + (case (' <actual>) + [_ {.#Nat actual}] + (n.= <expected> actual) + + _ + false))) + (_.cover [/.times] + (with_expansions [<expected> (static.random_nat) + <max> (static.random code.nat + (random#each (|>> (n.% 10) (n.+ 2)) random.nat)) + <cycles> (static.random code.nat + (random#each (|>> (n.% <max>) ++) random.nat)) + <actual> (/.times <cycles> (..iterated <max> <expected>))] + (let [expected_remaining (n.- <cycles> <max>)] + (case (` <actual>) + (^code (..iterated (~ [_ {.#Nat actual_remaining}]) (~ [_ {.#Nat actual}]))) + (and (n.= expected_remaining actual_remaining) + (n.= <expected> actual)) + + _ + false)))) )))) (def: .public test @@ -173,7 +206,7 @@ actual)))))) )) - ..expander + ..test|expansion /code.test /local.test diff --git a/stdlib/source/test/lux/static.lux b/stdlib/source/test/lux/static.lux index c8425f21d..691749810 100644 --- a/stdlib/source/test/lux/static.lux +++ b/stdlib/source/test/lux/static.lux @@ -6,11 +6,13 @@ ["[0]" meta] [data ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]]] + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" mix)]]] [macro ["[0]" code]] [math - ["[0]" random] + ["[0]" random ("[1]#[0]" functor)] [number ["n" nat] ["i" int] @@ -65,6 +67,13 @@ _ false))) + (_.cover [/.randoms] + (with_expansions [<amount> (/.random code.nat + (random#each (|>> (n.% 10) ++) random.nat)) + l/* (/.randoms code.nat (random.list <amount> random.nat))] + (and (n.= <amount> (list.size (list l/*))) + (n.= (list#mix n.+ 0 (list l/*)) + ($_ n.+ l/*))))) (_.cover [/.literal] (with_expansions [<left> (/.random code.text (random.ascii/alpha_num 1)) <right> (/.random code.text (random.ascii/alpha_num 1)) @@ -75,4 +84,11 @@ _ false))) + (_.cover [/.literals] + (with_expansions [l/0 (/.random_nat) + l/1 (/.random_nat) + l/2 (/.random_nat) + l/* (/.literals code.nat (list l/0 l/1 l/2))] + (n.= ($_ n.+ l/0 l/1 l/2) + ($_ n.+ l/*)))) )))) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 25f869808..c0e7fd739 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -20,11 +20,12 @@ ]]] ["[1][0]" meta "_" ["[1]/[0]" archive "_" - ["[1]/[0]" artifact] ["[1]/[0]" signature] ["[1]/[0]" key] - ["[1]/[0]" document] + ["[1]/[0]" artifact] ["[1]/[0]" registry] + ["[1]/[0]" module] + ["[1]/[0]" document] ["[1]/[0]" descriptor]]] ]]) @@ -36,11 +37,12 @@ /reference.test /phase.test /analysis.test - /meta/archive/artifact.test /meta/archive/signature.test /meta/archive/key.test - /meta/archive/document.test + /meta/archive/artifact.test /meta/archive/registry.test + /meta/archive/module.test + /meta/archive/document.test /meta/archive/descriptor.test /phase/extension.test /phase/analysis/simple.test diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux new file mode 100644 index 000000000..3d0bc262e --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux @@ -0,0 +1,21 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Module]) + ($_ _.and + (_.cover [/.ID /.runtime] + (n.= 0 /.runtime)) + ))) |