From 14bf4ffe5d7d88692ab895f96a2bb6a829a406de Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 20 Jan 2022 04:30:57 -0400 Subject: Better text formatting for types. --- stdlib/source/library/lux.lux | 4 +- .../lux/tool/compiler/language/lux/generation.lux | 2 +- .../language/lux/phase/extension/directive/lux.lux | 11 +- .../lux/phase/extension/generation/jvm/host.lux | 19 +- .../language/lux/phase/generation/jvm/function.lux | 7 +- .../lux/tool/compiler/language/lux/program.lux | 44 ++-- .../lux/tool/compiler/meta/archive/dependency.lux | 233 --------------------- .../lux/tool/compiler/meta/archive/registry.lux | 2 +- .../lux/tool/compiler/meta/cache/artifact.lux | 233 +++++++++++++++++++++ .../lux/tool/compiler/meta/cache/dependency.lux | 98 --------- .../lux/tool/compiler/meta/cache/module.lux | 98 +++++++++ .../library/lux/tool/compiler/meta/io/archive.lux | 8 +- .../library/lux/tool/compiler/meta/packager.lux | 6 +- .../lux/tool/compiler/meta/packager/jvm.lux | 12 +- .../lux/tool/compiler/meta/packager/ruby.lux | 12 +- .../lux/tool/compiler/meta/packager/script.lux | 12 +- stdlib/source/library/lux/type.lux | 4 +- stdlib/source/program/compositor.lux | 108 +++++----- stdlib/source/test/lux/control/parser/type.lux | 91 +++++--- stdlib/source/test/lux/meta/symbol.lux | 56 ++--- stdlib/source/test/lux/tool.lux | 4 +- .../lux/tool/compiler/meta/archive/registry.lux | 173 +++++++++++++++ 22 files changed, 725 insertions(+), 512 deletions(-) delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/archive/dependency.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux create mode 100644 stdlib/source/library/lux/tool/compiler/meta/cache/module.lux create mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux (limited to 'stdlib/source') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 8bd316fee..bd3f36e3e 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -3003,10 +3003,10 @@ (nat#encoded id) {#Var id} - ($_ text#composite "⌈v:" (nat#encoded id) "⌋") + ($_ text#composite "-" (nat#encoded id)) {#Ex id} - ($_ text#composite "⟨e:" (nat#encoded id) "⟩") + ($_ text#composite "+" (nat#encoded id)) {#UnivQ env body} ($_ text#composite "(All " (type#encoded body) ")") 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 a65131c3a..4a9efba50 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -283,7 +283,7 @@ (do try.monad [[descriptor document] (archive.find _module archive)] {try.#Success (value@ descriptor.#registry descriptor)}))] - (case (registry.remember _name registry) + (case (registry.id _name registry) {.#None} (exception.except ..unknown_definition [name (registry.definitions registry)]) 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 965a9e641..e85b1325b 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 @@ -47,8 +47,9 @@ ["[0]" phase] [meta ["[0]" archive {"+" Archive} - ["[0]" artifact] - ["[0]" dependency]]]]]]]) + ["[0]" artifact]] + ["[0]" cache "_" + ["[1]/[0]" artifact]]]]]]]) (def: .public (custom [syntax handler]) (All (_ anchor expression directive s) @@ -119,7 +120,7 @@ (do phase.monad [[interim_artifacts codeG] (/////generation.with_interim_artifacts archive (generate archive codeS)) - dependencies (dependency.dependencies archive codeS) + dependencies (cache/artifact.dependencies archive codeS) module_id (phase.lifted (archive.id module archive)) id (/////generation.learn name false (set.union interim_artifacts dependencies)) [target_name value directive] (/////generation.define! [module_id id] {.#None} codeG) @@ -173,7 +174,7 @@ (do phase.monad [[interim_artifacts codeG] (/////generation.with_interim_artifacts archive (generate archive codeS)) - dependencies (dependency.dependencies archive codeS) + dependencies (cache/artifact.dependencies archive codeS) module_id (phase.lifted (archive.id current_module archive)) id ( extension (set.union interim_artifacts dependencies)) [target_name value directive] (/////generation.define! [module_id id] {.#None} codeG) @@ -498,7 +499,7 @@ (do phase.monad [[interim_artifacts programG] (/////generation.with_interim_artifacts archive (generate archive programS)) - dependencies (dependency.dependencies archive programS) + dependencies (cache/artifact.dependencies archive programS) artifact_id (/////generation.learn /////program.name true (set.union interim_artifacts dependencies))] (/////generation.save! artifact_id {.#None} (program [module_id artifact_id] programG)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index 7a3c93014..dda74b0e1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -71,8 +71,9 @@ ["[2][0]" variable {"+" Variable Register}]] [meta ["[0]" archive {"+" Archive} - ["[0]" artifact] - ["[0]" dependency]]]]]]]) + ["[0]" artifact]] + ["[0]" cache "_" + ["[1]/[0]" artifact]]]]]]]) (template [ <0>] [(def: @@ -1071,22 +1072,22 @@ (let [[_super _name _strict_fp? _annotations _t_vars _this _arguments _return _exceptions bodyS] method] - (dependency.dependencies archive bodyS))) + (cache/artifact.dependencies archive bodyS))) (def: (anonymous_dependencies archive inputsTS overriden_methods) (-> Archive (List Input) (List [(Environment Synthesis) (/.Overriden_Method Synthesis)]) (Operation (Set artifact.Dependency))) (do [! //////.monad] - [all_input_dependencies (monad.each ! (|>> product.right (dependency.dependencies archive)) inputsTS) + [all_input_dependencies (monad.each ! (|>> product.right (cache/artifact.dependencies archive)) inputsTS) all_closure_dependencies (|> overriden_methods (list#each product.left) list.together - (monad.each ! (dependency.dependencies archive))) + (monad.each ! (cache/artifact.dependencies archive))) all_method_dependencies (monad.each ! (|>> product.right (method_dependencies archive)) overriden_methods)] - (in (dependency.all ($_ list#composite - all_input_dependencies - all_closure_dependencies - all_method_dependencies))))) + (in (cache/artifact.all ($_ list#composite + all_input_dependencies + all_closure_dependencies + all_method_dependencies))))) (def: (prepare_argument lux_register argumentT jvm_register) (-> Register (Type Value) Register [Register (Bytecode Any)]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux index 357337927..2227d9f1d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux @@ -33,8 +33,9 @@ [tool [compiler [meta - ["[0]" archive {"+" Archive} - ["[0]" dependency]]]]]]] + ["[0]" archive {"+" Archive}] + ["[0]" cache "_" + ["[1]/[0]" artifact]]]]]]] ["[0]" / "_" ["[1][0]" abstract] [field @@ -100,7 +101,7 @@ (def: .public (abstraction generate archive [environment arity bodyS]) (Generator Abstraction) (do phase.monad - [dependencies (dependency.dependencies archive bodyS) + [dependencies (cache/artifact.dependencies archive bodyS) @begin //runtime.forge_label [function_context bodyG] (generation.with_new_context archive dependencies (generation.with_anchor [@begin ..this_offset] 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 176ab28ed..4e1c9805d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/program.lux @@ -1,25 +1,25 @@ (.using - [library - [lux {"-" Module} - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" maybe] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] - [data - ["[0]" product] - [text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor)]]]]] - [// - [generation {"+" Context}] - [/// - [meta - ["[0]" archive {"+" Archive} - ["[0]" descriptor {"+" Module}] - ["[0]" registry {"+" Registry}]]]]]) + [library + [lux {"-" Module} + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" maybe] + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}]] + [data + ["[0]" product] + [text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor)]]]]] + [// + [generation {"+" Context}] + [/// + [meta + ["[0]" archive {"+" Archive} + ["[0]" descriptor {"+" Module}] + ["[0]" registry {"+" Registry}]]]]]) (type: .public (Program expression directive) (-> Context expression directive)) @@ -45,7 +45,7 @@ (in [[module id] (value@ descriptor.#registry descriptor)])))))] (case (list.one (function (_ [[module module_id] registry]) (do maybe.monad - [program_id (registry.remember ..name registry)] + [program_id (registry.id ..name registry)] (in [module_id program_id]))) registries) {.#Some program_context} diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/dependency.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/dependency.lux deleted file mode 100644 index 9d04addde..000000000 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/dependency.lux +++ /dev/null @@ -1,233 +0,0 @@ -... https://en.wikipedia.org/wiki/Tree_shaking -(.using - [library - [lux "*" - [abstract - [hash {"+" Hash}] - ["[0]" monad {"+" do}]] - [data - ["[0]" product] - [collection - ["[0]" list ("[1]#[0]" monoid mix monad)] - ["[0]" set {"+" Set}] - ["[0]" dictionary {"+" Dictionary}] - ["[0]" sequence]]] - [math - [number - ["[0]" nat]]] - [meta - ["[0]" symbol]] - [tool - [compiler - ["[0]" phase] - ["[0]" reference {"+" Constant}] - [language - [lux - ["[0]" analysis - ["[1]/[0]" complex]] - ["[0]" synthesis {"+" Synthesis Path}] - ["[0]" generation {"+" Context Operation}]]] - [meta - ["[0]" archive {"+" Archive} - ["[0]" artifact] - ["[0]" descriptor] - ["[0]" registry {"+" Registry}]]]]]]]) - -(def: (path_references references) - (-> (-> Synthesis (List Constant)) - (-> Path (List Constant))) - (function (again path) - (case path - (^or {synthesis.#Pop} - {synthesis.#Access _} - {synthesis.#Bind _}) - (list) - - (^template [] - [{ left right} - ($_ list#composite - (again left) - (again right))]) - ([synthesis.#Alt] - [synthesis.#Seq]) - - {synthesis.#Bit_Fork when then else} - (case else - {.#Some else} - ($_ list#composite - (again then) - (again else)) - - {.#None} - (again then)) - - (^template [] - [{ fork} - (|> {.#Item fork} - (list#each (|>> product.right again)) - list#conjoint)]) - ([synthesis.#I64_Fork] - [synthesis.#F64_Fork] - [synthesis.#Text_Fork]) - - {synthesis.#Then then} - (references then)))) - -(def: (references value) - (-> Synthesis (List Constant)) - (case value - {synthesis.#Primitive value} - (list) - - {synthesis.#Structure value} - (case value - {analysis/complex.#Variant value} - (|> value - (value@ analysis/complex.#value) - references) - - {analysis/complex.#Tuple value} - (|> value - (list#each references) - list#conjoint)) - - {synthesis.#Reference value} - (case value - {reference.#Variable _} - (list) - - {reference.#Constant value} - (list value)) - - {synthesis.#Control value} - (case value - {synthesis.#Branch value} - (case value - {synthesis.#Exec this that} - ($_ list#composite - (references this) - (references that)) - - {synthesis.#Let input _ body} - ($_ list#composite - (references input) - (references body)) - - {synthesis.#If test then else} - ($_ list#composite - (references test) - (references then) - (references else)) - - {synthesis.#Get _ record} - (references record) - - {synthesis.#Case input path} - ($_ list#composite - (references input) - (path_references references path))) - - {synthesis.#Loop value} - (case value - {synthesis.#Scope value} - (|> value - (value@ synthesis.#iteration) - references) - - {synthesis.#Again value} - (|> value - (list#each references) - list#conjoint)) - - {synthesis.#Function value} - (case value - {synthesis.#Abstraction value} - (|> value - (value@ synthesis.#body) - references) - - {synthesis.#Apply function arguments} - (|> (list& function arguments) - (list#each references) - list#conjoint))) - - {synthesis.#Extension [name parameters]} - (|> parameters - (list#each references) - list#conjoint))) - -(def: context_hash - (Hash Context) - (product.hash nat.hash nat.hash)) - -(def: .public (dependencies archive value) - (All (_ anchor expression directive) - (-> Archive Synthesis (Operation anchor expression directive (Set artifact.Dependency)))) - (let [! phase.monad] - (|> value - ..references - (set.of_list symbol.hash) - set.list - (monad.each ! (generation.remember archive)) - (# ! each (set.of_list context_hash))))) - -(def: .public (path_dependencies archive value) - (All (_ anchor expression directive) - (-> Archive Path (Operation anchor expression directive (Set artifact.Dependency)))) - (let [! phase.monad] - (|> value - (..path_references ..references) - (set.of_list symbol.hash) - set.list - (monad.each ! (generation.remember archive)) - (# ! each (set.of_list context_hash))))) - -(def: .public all - (-> (List (Set artifact.Dependency)) - (Set artifact.Dependency)) - (list#mix set.union artifact.no_dependencies)) - -(def: (immediate_dependencies archive) - (-> Archive [(List artifact.Dependency) - (Dictionary artifact.Dependency (Set artifact.Dependency))]) - (|> archive - archive.entries - (list#each (function (_ [module [module_id [descriptor document output]]]) - (|> descriptor - (value@ descriptor.#registry) - registry.artifacts - sequence.list - (list#each (function (_ [artifact dependencies]) - [[module_id (value@ artifact.#id artifact)] - (value@ artifact.#mandatory? artifact) - dependencies]))))) - list.together - (list#mix (function (_ [artifact_id mandatory? dependencies] - [mandatory_dependencies - all_dependencies]) - [(if mandatory? - (list& artifact_id mandatory_dependencies) - mandatory_dependencies) - (dictionary.has artifact_id dependencies all_dependencies)]) - [(list) - (dictionary.empty context_hash)]))) - -(def: .public (necessary_dependencies archive) - (-> Archive (Set artifact.Dependency)) - (let [[mandatory immediate] (immediate_dependencies archive)] - (loop [pending mandatory - minimum artifact.no_dependencies] - (case pending - {.#Item head tail} - (if (set.member? minimum head) - (again tail minimum) - (again (case (dictionary.value head immediate) - {.#Some additional} - (list#composite (set.list additional) tail) - - {.#None} - tail) - (set.has head minimum))) - - {.#End} - minimum)))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux index 9b8e1e38a..c289d9af0 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux @@ -88,7 +88,7 @@ [//category.#Custom custom customs] ) - (def: .public (remember name registry) + (def: .public (id name registry) (-> Text Registry (Maybe ID)) (|> (:representation registry) (value@ #resolver) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux new file mode 100644 index 000000000..2a464b397 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/artifact.lux @@ -0,0 +1,233 @@ +... https://en.wikipedia.org/wiki/Tree_shaking +(.using + [library + [lux "*" + [abstract + [hash {"+" Hash}] + ["[0]" monad {"+" do}]] + [data + ["[0]" product] + [collection + ["[0]" list ("[1]#[0]" monoid mix monad)] + ["[0]" set {"+" Set}] + ["[0]" dictionary {"+" Dictionary}] + ["[0]" sequence]]] + [math + [number + ["[0]" nat]]] + [meta + ["[0]" symbol]] + [tool + [compiler + ["[0]" phase] + ["[0]" reference {"+" Constant}] + [language + [lux + ["[0]" synthesis {"+" Synthesis Path}] + ["[0]" generation {"+" Context Operation}] + ["[0]" analysis + ["[1]/[0]" complex]]]] + [meta + ["[0]" archive {"+" Archive} + ["[0]" artifact] + ["[0]" descriptor] + ["[0]" registry {"+" Registry}]]]]]]]) + +(def: (path_references references) + (-> (-> Synthesis (List Constant)) + (-> Path (List Constant))) + (function (again path) + (case path + (^or {synthesis.#Pop} + {synthesis.#Access _} + {synthesis.#Bind _}) + (list) + + (^template [] + [{ left right} + ($_ list#composite + (again left) + (again right))]) + ([synthesis.#Alt] + [synthesis.#Seq]) + + {synthesis.#Bit_Fork when then else} + (case else + {.#Some else} + ($_ list#composite + (again then) + (again else)) + + {.#None} + (again then)) + + (^template [] + [{ fork} + (|> {.#Item fork} + (list#each (|>> product.right again)) + list#conjoint)]) + ([synthesis.#I64_Fork] + [synthesis.#F64_Fork] + [synthesis.#Text_Fork]) + + {synthesis.#Then then} + (references then)))) + +(def: (references value) + (-> Synthesis (List Constant)) + (case value + {synthesis.#Primitive value} + (list) + + {synthesis.#Structure value} + (case value + {analysis/complex.#Variant value} + (|> value + (value@ analysis/complex.#value) + references) + + {analysis/complex.#Tuple value} + (|> value + (list#each references) + list#conjoint)) + + {synthesis.#Reference value} + (case value + {reference.#Variable _} + (list) + + {reference.#Constant value} + (list value)) + + {synthesis.#Control value} + (case value + {synthesis.#Branch value} + (case value + {synthesis.#Exec this that} + ($_ list#composite + (references this) + (references that)) + + {synthesis.#Let input _ body} + ($_ list#composite + (references input) + (references body)) + + {synthesis.#If test then else} + ($_ list#composite + (references test) + (references then) + (references else)) + + {synthesis.#Get _ record} + (references record) + + {synthesis.#Case input path} + ($_ list#composite + (references input) + (path_references references path))) + + {synthesis.#Loop value} + (case value + {synthesis.#Scope value} + (|> value + (value@ synthesis.#iteration) + references) + + {synthesis.#Again value} + (|> value + (list#each references) + list#conjoint)) + + {synthesis.#Function value} + (case value + {synthesis.#Abstraction value} + (|> value + (value@ synthesis.#body) + references) + + {synthesis.#Apply function arguments} + (|> (list& function arguments) + (list#each references) + list#conjoint))) + + {synthesis.#Extension [name parameters]} + (|> parameters + (list#each references) + list#conjoint))) + +(def: context_hash + (Hash Context) + (product.hash nat.hash nat.hash)) + +(def: .public (dependencies archive value) + (All (_ anchor expression directive) + (-> Archive Synthesis (Operation anchor expression directive (Set artifact.Dependency)))) + (let [! phase.monad] + (|> value + ..references + (set.of_list symbol.hash) + set.list + (monad.each ! (generation.remember archive)) + (# ! each (set.of_list context_hash))))) + +(def: .public (path_dependencies archive value) + (All (_ anchor expression directive) + (-> Archive Path (Operation anchor expression directive (Set artifact.Dependency)))) + (let [! phase.monad] + (|> value + (..path_references ..references) + (set.of_list symbol.hash) + set.list + (monad.each ! (generation.remember archive)) + (# ! each (set.of_list context_hash))))) + +(def: .public all + (-> (List (Set artifact.Dependency)) + (Set artifact.Dependency)) + (list#mix set.union artifact.no_dependencies)) + +(def: (immediate_dependencies archive) + (-> Archive [(List artifact.Dependency) + (Dictionary artifact.Dependency (Set artifact.Dependency))]) + (|> archive + archive.entries + (list#each (function (_ [module [module_id [descriptor document output]]]) + (|> descriptor + (value@ descriptor.#registry) + registry.artifacts + sequence.list + (list#each (function (_ [artifact dependencies]) + [[module_id (value@ artifact.#id artifact)] + (value@ artifact.#mandatory? artifact) + dependencies]))))) + list.together + (list#mix (function (_ [artifact_id mandatory? dependencies] + [mandatory_dependencies + all_dependencies]) + [(if mandatory? + (list& artifact_id mandatory_dependencies) + mandatory_dependencies) + (dictionary.has artifact_id dependencies all_dependencies)]) + [(list) + (dictionary.empty context_hash)]))) + +(def: .public (necessary_dependencies archive) + (-> Archive (Set artifact.Dependency)) + (let [[mandatory immediate] (immediate_dependencies archive)] + (loop [pending mandatory + minimum artifact.no_dependencies] + (case pending + {.#Item head tail} + (if (set.member? minimum head) + (again tail minimum) + (again (case (dictionary.value head immediate) + {.#Some additional} + (list#composite (set.list additional) tail) + + {.#None} + tail) + (set.has head minimum))) + + {.#End} + minimum)))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux deleted file mode 100644 index 7b8a98a61..000000000 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency.lux +++ /dev/null @@ -1,98 +0,0 @@ -(.using - [library - [lux {"-" Module} - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" maybe ("[1]#[0]" functor)] - ["[0]" try {"+" Try}] - ["[0]" state] - [function - ["[0]" memo {"+" Memo}]]] - [data - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor mix)] - ["[0]" dictionary {"+" Dictionary}] - ["[0]" set {"+" Set}]]]]] - [/// - ["[0]" archive {"+" Output Archive} - [key {"+" Key}] - ["[0]" descriptor {"+" Module Descriptor}] - ["[0]" document {"+" Document}]]]) - -(type: .public Ancestry - (Set Module)) - -(def: fresh - Ancestry - (set.empty text.hash)) - -(type: .public Graph - (Dictionary Module Ancestry)) - -(def: empty - Graph - (dictionary.empty text.hash)) - -(def: .public modules - (-> Graph (List Module)) - dictionary.keys) - -(type: .public Dependency - (Record - [#module Module - #imports Ancestry])) - -(def: .public graph - (-> (List Dependency) Graph) - (list#mix (function (_ [module imports] graph) - (dictionary.has module imports graph)) - ..empty)) - -(def: (ancestry archive) - (-> Archive Graph) - (let [memo (: (Memo Module Ancestry) - (function (_ again module) - (do [! state.monad] - [.let [parents (case (archive.find module archive) - {try.#Success [descriptor document]} - (value@ descriptor.#references descriptor) - - {try.#Failure error} - ..fresh)] - ancestors (monad.each ! again (set.list parents))] - (in (list#mix set.union parents ancestors))))) - ancestry (memo.open memo)] - (list#mix (function (_ module memory) - (if (dictionary.key? memory module) - memory - (let [[memory _] (ancestry [memory module])] - memory))) - ..empty - (archive.archived archive)))) - -(def: (dependency? ancestry target source) - (-> Graph Module Module Bit) - (let [target_ancestry (|> ancestry - (dictionary.value target) - (maybe.else ..fresh))] - (set.member? target_ancestry source))) - -(type: .public Order - (List [Module [archive.ID [Descriptor (Document .Module) Output]]])) - -(def: .public (load_order key archive) - (-> (Key .Module) Archive (Try Order)) - (let [ancestry (..ancestry archive)] - (|> ancestry - dictionary.keys - (list.sorted (..dependency? ancestry)) - (monad.each try.monad - (function (_ module) - (do try.monad - [module_id (archive.id module archive) - [descriptor document output] (archive.find module archive) - document (document.marked? key document)] - (in [module [module_id [descriptor document output]]]))))))) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux new file mode 100644 index 000000000..e61b8cad2 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/module.lux @@ -0,0 +1,98 @@ +(.using + [library + [lux {"-" Module} + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try {"+" Try}] + ["[0]" state] + [function + ["[0]" memo {"+" Memo}]]] + [data + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" dictionary {"+" Dictionary}] + ["[0]" set {"+" Set}]]]]] + [/// + ["[0]" archive {"+" Output Archive} + [key {"+" Key}] + ["[0]" descriptor {"+" Module Descriptor}] + ["[0]" document {"+" Document}]]]) + +(type: .public Ancestry + (Set Module)) + +(def: fresh + Ancestry + (set.empty text.hash)) + +(type: .public Graph + (Dictionary Module Ancestry)) + +(def: empty + Graph + (dictionary.empty text.hash)) + +(def: .public modules + (-> Graph (List Module)) + dictionary.keys) + +(type: .public Dependency + (Record + [#module Module + #imports Ancestry])) + +(def: .public graph + (-> (List Dependency) Graph) + (list#mix (function (_ [module imports] graph) + (dictionary.has module imports graph)) + ..empty)) + +(def: (ancestry archive) + (-> Archive Graph) + (let [memo (: (Memo Module Ancestry) + (function (_ again module) + (do [! state.monad] + [.let [parents (case (archive.find module archive) + {try.#Success [descriptor document]} + (value@ descriptor.#references descriptor) + + {try.#Failure error} + ..fresh)] + ancestors (monad.each ! again (set.list parents))] + (in (list#mix set.union parents ancestors))))) + ancestry (memo.open memo)] + (list#mix (function (_ module memory) + (if (dictionary.key? memory module) + memory + (let [[memory _] (ancestry [memory module])] + memory))) + ..empty + (archive.archived archive)))) + +(def: (dependency? ancestry target source) + (-> Graph Module Module Bit) + (let [target_ancestry (|> ancestry + (dictionary.value target) + (maybe.else ..fresh))] + (set.member? target_ancestry source))) + +(type: .public Order + (List [Module [archive.ID [Descriptor (Document .Module) Output]]])) + +(def: .public (load_order key archive) + (-> (Key .Module) Archive (Try Order)) + (let [ancestry (..ancestry archive)] + (|> ancestry + dictionary.keys + (list.sorted (..dependency? ancestry)) + (monad.each try.monad + (function (_ module) + (do try.monad + [module_id (archive.id module archive) + [descriptor document output] (archive.find module archive) + document (document.marked? key document)] + (in [module [module_id [descriptor document output]]]))))))) 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 b5fae7763..94e96ca26 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -41,8 +41,8 @@ ["[0]" document {"+" Document}] ["[0]" artifact {"+" Artifact Dependency} ["[0]" category {"+" Category}]]] - [cache - ["[0]" dependency]] + ["[0]" cache "_" + ["[1]/[0]" module]] ["/[1]" // {"+" Input} [language ["$" lux @@ -395,7 +395,7 @@ (def: (full_purge caches load_order) (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]]) - dependency.Order + cache/module.Order Purge) (list#mix (function (_ [module_name [module_id [descriptor document]]] purge) (let [purged? (: (Predicate Module) @@ -439,7 +439,7 @@ (function (_ [module [module_id [descriptor document]]] archive) (archive.has module [descriptor document (: Output sequence.empty)] archive)) archive) - (# try.monad each (dependency.load_order $.key)) + (# try.monad each (cache/module.load_order $.key)) (# try.monad conjoint) async#in) .let [purge (..full_purge pre_loaded_caches load_order)] diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager.lux b/stdlib/source/library/lux/tool/compiler/meta/packager.lux index d434c4603..9f37fff18 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager.lux @@ -13,8 +13,8 @@ [world ["[0]" file]]]] [// - [cache - ["[0]" dependency]] + ["[0]" cache "_" + ["[1]/[0]" module]] ["[0]" archive {"+" Archive} ["[0]" descriptor] ["[0]" artifact] @@ -35,7 +35,7 @@ (List [archive.ID (List artifact.ID)])) (def: .public order - (-> dependency.Order Order) + (-> cache/module.Order Order) (list#each (function (_ [module [module_id [descriptor document]]]) (|> descriptor (value@ descriptor.#registry) 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 0f933172d..594f14dd8 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/jvm.lux @@ -33,10 +33,10 @@ [// ["[0]" archive {"+" Output} ["[0]" descriptor {"+" Module}] - ["[0]" artifact] - ["tree_shaking" dependency]] - [cache - ["[0]" dependency]] + ["[0]" artifact]] + ["[0]" cache "_" + ["[1]/[0]" module] + ["[1]/[0]" artifact]] ["[0]" io "_" ["[1]" archive]] [// @@ -253,8 +253,8 @@ (-> Static Packager) (function (_ host_dependencies archive program) (do [! try.monad] - [.let [necessary_dependencies (tree_shaking.necessary_dependencies archive)] - order (dependency.load_order $.key archive) + [.let [necessary_dependencies (cache/artifact.necessary_dependencies archive)] + 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]]]) 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 a375a908a..4cc20607c 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/ruby.lux @@ -33,10 +33,10 @@ ["[0]" archive {"+" Output} ["[0]" descriptor {"+" Module Descriptor}] ["[0]" artifact] - ["[0]" document {"+" Document}] - ["tree_shaking" dependency]] - [cache - ["[0]" dependency {"+" Order}]] + ["[0]" document {"+" Document}]] + ["[0]" cache "_" + ["[1]/[0]" module {"+" Order}] + ["[1]/[0]" artifact]] ["[0]" io "_" ["[1]" archive]] [// @@ -116,8 +116,8 @@ (def: .public (package host_dependencies archive program) Packager (do [! try.monad] - [.let [necessary_dependencies (tree_shaking.necessary_dependencies archive)] - order (dependency.load_order $.key archive) + [.let [necessary_dependencies (cache/artifact.necessary_dependencies archive)] + order (cache/module.load_order $.key archive) entries (monad.mix ! (..write_module (module_id_mapping order) necessary_dependencies) {.#End} order) .let [included_modules (..included_modules entries) imports (|> order 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 7d6954d1a..c3f3e4867 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/script.lux @@ -24,10 +24,10 @@ [// ["[0]" archive {"+" Output} ["[0]" descriptor] - ["[0]" artifact] - ["tree_shaking" dependency]] - [cache - ["[0]" dependency]] + ["[0]" artifact]] + ["[0]" cache "_" + ["[1]/[0]" module] + ["[1]/[0]" artifact]] ["[0]" io "_" ["[1]" archive]] [// @@ -68,8 +68,8 @@ Packager)) (function (package host_dependencies archive program) (do [! try.monad] - [.let [necessary_dependencies (tree_shaking.necessary_dependencies archive)] - order (dependency.load_order $.key archive)] + [.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]]]) [module_id output])) diff --git a/stdlib/source/library/lux/type.lux b/stdlib/source/library/lux/type.lux index dafd87759..380331c40 100644 --- a/stdlib/source/library/lux/type.lux +++ b/stdlib/source/library/lux/type.lux @@ -115,10 +115,10 @@ (n#encoded idx) {.#Var id} - ($_ text#composite "⌈v:" (n#encoded id) "⌋") + ($_ text#composite "-" (n#encoded id)) {.#Ex id} - ($_ text#composite "⟨e:" (n#encoded id) "⟩") + ($_ text#composite "+" (n#encoded id)) {.#Apply param fun} (let [[type_func type_args] (flat_application type)] diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 2b6850cf8..1b7e161d1 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -1,59 +1,57 @@ (.using - [library - [lux {"-" Module} - [type {"+" :sharing}] - ["@" target] - ["[0]" debug] - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" io {"+" IO io}] - ["[0]" try {"+" Try}] - [concurrency - ["[0]" async {"+" Async} ("[1]#[0]" monad)]]] - [data - [binary {"+" Binary}] - ["[0]" product] - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" dictionary {"+" Dictionary}]]] - [time - ["[0]" instant]] - ["[0]" world "_" - ["[0]" file] - ["[0]" console] - ["[1]/[0]" program]] - [tool - [compiler - ["[0]" phase] - [default - ["[0]" platform {"+" Platform}]] - [language - ["$" lux - ["[1]/[0]" program {"+" Program}] - ["[0]" syntax] - ["[0]" analysis - [macro {"+" Expander}]] - ["[0]" generation {"+" Buffer Context}] - ["[0]" directive] - [phase - [extension {"+" Extender}]]]] - [meta - [packager {"+" Packager}] - [archive {"+" Archive} - [descriptor {"+" Module}]] - [cache - ["[0]" dependency]] - [io - ["ioW" archive]]]] - ... ["[0]" interpreter] - ]]] - ["[0]" / "_" - ["[1][0]" cli {"+" Service}] - ["[1][0]" static {"+" Static}] - ["[1][0]" export] - ["[1][0]" import]]) + [library + [lux {"-" Module} + [type {"+" :sharing}] + ["@" target] + ["[0]" debug] + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" io {"+" IO io}] + ["[0]" try {"+" Try}] + [concurrency + ["[0]" async {"+" Async} ("[1]#[0]" monad)]]] + [data + [binary {"+" Binary}] + ["[0]" product] + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" dictionary {"+" Dictionary}]]] + [time + ["[0]" instant]] + ["[0]" world "_" + ["[0]" file] + ["[0]" console] + ["[1]/[0]" program]] + [tool + [compiler + ["[0]" phase] + [default + ["[0]" platform {"+" Platform}]] + [language + ["$" lux + ["[1]/[0]" program {"+" Program}] + ["[0]" syntax] + ["[0]" generation {"+" Buffer Context}] + ["[0]" directive] + ["[0]" analysis + [macro {"+" Expander}]] + [phase + [extension {"+" Extender}]]]] + [meta + [packager {"+" Packager}] + [archive {"+" Archive} + [descriptor {"+" Module}]] + [io + ["ioW" archive]]]] + ... ["[0]" interpreter] + ]]] + ["[0]" / "_" + ["[1][0]" cli {"+" Service}] + ["[1][0]" static {"+" Static}] + ["[1][0]" export] + ["[1][0]" import]]) (def: (or_crash! failure_description action) (All (_ a) diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux index 360826130..39656a32c 100644 --- a/stdlib/source/test/lux/control/parser/type.lux +++ b/stdlib/source/test/lux/control/parser/type.lux @@ -1,25 +1,27 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" try] - ["[0]" exception]] - [data - [collection - ["[0]" list]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]] - [meta - ["[0]" symbol ("[1]#[0]" equivalence)]] - ["[0]" type ("[1]#[0]" equivalence)]]] - [\\library - ["[0]" / - ["/[1]" //]]]) + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" type ("[1]#[0]" equivalence)] + [abstract + [monad {"+" do}]] + [control + ["[0]" try] + ["[0]" exception]] + [data + [text + ["%" format {"+" format}]] + [collection + ["[0]" list]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]] + [meta + ["[0]" symbol ("[1]#[0]" equivalence)]]]] + [\\library + ["[0]" / + ["/[1]" //]]]) (template: (!expect ) [(case @@ -35,7 +37,7 @@ (# random.monad each (function (_ name) {.#Primitive name (list)})))) -(def: matches +(def: test|matches Test (<| (_.for [/.types_do_not_match]) (do [! random.monad] @@ -71,7 +73,7 @@ (exception.match? /.types_do_not_match error)))))) ))) -(def: aggregate +(def: test|aggregate Test (do [! random.monad] [expected_left ..primitive @@ -119,7 +121,7 @@ (exception.match? /.not_application error)))))) )))) -(def: parameter +(def: test|parameter Test (do random.monad [quantification ..primitive @@ -163,7 +165,7 @@ (!expect {try.#Success [quantification##binding argument##binding _]}))) ))) -(def: polymorphic +(def: test|polymorphic Test (do [! random.monad] [not_polymorphic ..primitive @@ -186,6 +188,36 @@ (same? not_polymorphic bodyT)))))) ))) +(def: test|recursive + Test + (do random.monad + [expected ..primitive] + ($_ _.and + (_.cover [/.recursive] + (|> (.type (Rec @ expected)) + (/.result (/.recursive /.any)) + (!expect (^multi {try.#Success [@self actual]} + (type#= expected actual))))) + (_.cover [/.recursive_self] + (|> (.type (Rec @ @)) + (/.result (/.recursive /.recursive_self)) + (!expect (^multi {try.#Success [@expected @actual]} + (same? @expected @actual))))) + (_.cover [/.recursive_call] + (|> (.type (All (self input) (self input))) + (/.result (/.polymorphic /.recursive_call)) + (!expect {try.#Success [@self inputs ???]}))) + (_.cover [/.not_recursive] + (and (|> expected + (/.result (/.recursive /.any)) + (!expect (^multi {try.#Failure error} + (exception.match? /.not_recursive error)))) + (|> expected + (/.result /.recursive_self) + (!expect (^multi {try.#Failure error} + (exception.match? /.not_recursive error)))))) + ))) + (def: .public test Test (<| (_.covering /._) @@ -263,8 +295,9 @@ (!expect (^multi {try.#Success [actual_name actual_type]} (and (symbol#= expected_name actual_name) (type#= expected_type actual_type))))))) - ..aggregate - ..matches - ..parameter - ..polymorphic + ..test|aggregate + ..test|matches + ..test|parameter + ..test|polymorphic + ..test|recursive ))) diff --git a/stdlib/source/test/lux/meta/symbol.lux b/stdlib/source/test/lux/meta/symbol.lux index cdd051770..3e4233939 100644 --- a/stdlib/source/test/lux/meta/symbol.lux +++ b/stdlib/source/test/lux/meta/symbol.lux @@ -1,24 +1,24 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" order] - ["$[0]" codec]]] - [control - pipe] - [data - ["[0]" text ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" order] + ["$[0]" codec]]] + [control + pipe] + [data + ["[0]" text]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: .public (random module_size short_size) (-> Nat Nat (Random Symbol)) @@ -49,12 +49,16 @@ ($order.spec /.order (..random sizeM1 sizeS1))) (_.for [/.codec] (_.and ($codec.spec /.equivalence /.codec (..random sizeM1 sizeS1)) - (let [(^open "/#[0]") /.codec] - (_.test "Encoding a symbol without a module component results in text equal to the short of the symbol." - (if (text.empty? module1) - (text#= short1 (/#encoded symbol1)) - #1))))) - + (_.test "Encoding a symbol without a module component results in text equal to the short of the symbol." + (if (text.empty? module1) + (same? short1 (# /.codec encoded symbol1)) + #1)))) + + (_.cover [/.separator] + (let [it (# /.codec encoded symbol1)] + (if (text.empty? module1) + (same? short1 it) + (text.contains? /.separator it)))) (_.cover [/.module /.short] (and (same? module1 (/.module symbol1)) (same? short1 (/.short symbol1)))) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 78aaee40e..219151d6c 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -23,7 +23,8 @@ ["[1]/[0]" artifact] ["[1]/[0]" signature] ["[1]/[0]" key] - ["[1]/[0]" document]]] + ["[1]/[0]" document] + ["[1]/[0]" registry]]] ]]) (def: .public test @@ -38,6 +39,7 @@ /meta/archive/signature.test /meta/archive/key.test /meta/archive/document.test + /meta/archive/registry.test /phase/extension.test /phase/analysis/simple.test ... /syntax.test diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux new file mode 100644 index 000000000..feee41b0a --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux @@ -0,0 +1,173 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" binary]]] + [data + ["[0]" product] + ["[0]" text] + [collection + ["[0]" sequence {"+" Sequence}] + ["[0]" set {"+" Set}] + ["[0]" list ("[1]#[0]" mix)]] + [format + ["[0]" binary]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" / + [// + ["[0]" artifact + ["[0]" category]]]]]) + +(template: (tagged? ) + [(case + { _} + true + + _ + false)]) + +(def: random_dependency + (Random artifact.Dependency) + ($_ random.and + random.nat + random.nat + )) + +(def: (random_dependencies amount) + (-> Nat (Random (Set artifact.Dependency))) + (random.set artifact.dependency_hash amount ..random_dependency)) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Registry]) + (do [! random.monad] + [expected_name (random.ascii/lower 5) + mandatory? random.bit + expected_dependencies (..random_dependencies 5) + + expected_amount (# ! each (n.% 10) random.nat) + expected_names (|> (random.ascii/lower 1) + (random.set text.hash expected_amount) + (# ! each set.list))] + (`` ($_ _.and + (_.cover [/.empty] + (|> /.empty + /.artifacts + sequence.size + (n.= 0))) + (_.cover [/.resource] + (let [[@it registry] (/.resource mandatory? expected_dependencies /.empty)] + (case (sequence.list (/.artifacts registry)) + (^ (list [artifact actual_dependencies])) + (and (same? @it (value@ artifact.#id artifact)) + (same? mandatory? (value@ artifact.#mandatory? artifact)) + (tagged? category.#Anonymous (value@ artifact.#category artifact)) + (same? expected_dependencies actual_dependencies)) + + _ + false))) + (~~ (template [ ] + [(_.cover [ ] + (and (let [[@it registry] ( expected_name mandatory? expected_dependencies /.empty)] + (and (case ( registry) + (^ (list actual_name)) + (same? expected_name actual_name) + + _ + false) + (case (sequence.list (/.artifacts registry)) + (^ (list [artifact actual_dependencies])) + (and (same? @it (value@ artifact.#id artifact)) + (same? mandatory? (value@ artifact.#mandatory? artifact)) + (case (value@ artifact.#category artifact) + { actual_name} + (same? expected_name actual_name) + + _ + false) + (same? expected_dependencies actual_dependencies)) + + _ + false))) + (let [[@it registry] ( expected_name mandatory? expected_dependencies /.empty)] + (case ( registry) + (^ (list)) + true + + _ + false))))] + + [/.definition /.definitions category.#Definition /.analyser] + [/.analyser /.analysers category.#Analyser /.synthesizer] + [/.synthesizer /.synthesizers category.#Synthesizer /.generator] + [/.generator /.generators category.#Generator /.directive] + [/.directive /.directives category.#Directive /.custom] + [/.custom /.customs category.#Custom /.definition] + )) + (_.cover [/.id] + (and (~~ (template [] + [(let [[@expected registry] ( expected_name mandatory? expected_dependencies /.empty)] + (|> (/.id expected_name registry) + (maybe#each (same? @expected)) + (maybe.else false)))] + + [/.definition] + [/.analyser] + [/.synthesizer] + [/.generator] + [/.directive] + [/.custom] + )))) + (_.cover [/.artifacts] + (and (~~ (template [ ] + [(let [[ids registry] (: [(Sequence artifact.ID) /.Registry] + (list#mix (function (_ name [ids registry]) + (let [[@new registry] ( name mandatory? expected_dependencies registry)] + [(sequence.suffix @new ids) registry])) + [sequence.empty /.empty] + expected_names)) + it (/.artifacts registry)] + (and (n.= expected_amount (sequence.size it)) + (n.= expected_amount (sequence.size it)) + (list.every? (function (_ [@it [it dependencies]]) + (same? @it (value@ artifact.#id it))) + (list.zipped/2 (sequence.list ids) (sequence.list it))) + (# (list.equivalence text.equivalence) = expected_names ( registry))))] + + [/.definition /.definitions] + [/.analyser /.analysers] + [/.synthesizer /.synthesizers] + [/.generator /.generators] + [/.directive /.directives] + [/.custom /.customs] + )))) + (_.cover [/.writer /.parser] + (and (~~ (template [] + [(let [[@expected before] ( expected_name mandatory? expected_dependencies /.empty)] + (|> before + (binary.result /.writer) + (.result /.parser) + (try#each (|>> (/.id expected_name) + (maybe#each (same? @expected)) + (maybe.else false))) + (try.else false)))] + + [/.definition] + [/.analyser] + [/.synthesizer] + [/.generator] + [/.directive] + [/.custom] + )))) + ))))) -- cgit v1.2.3