diff options
Diffstat (limited to 'stdlib/source/library')
14 files changed, 404 insertions, 233 deletions
diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index 2c095da17..a96ab07c4 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -184,9 +184,15 @@ (-> Frac Frac Frac) ("lua power" param subject)) - (def: .public root/3 + (def: .public (root/3 it) (-> Frac Frac) - (..pow ("lux f64 /" +3.0 +1.0)))) + (if ("lux f64 <" +0.0 it) + (|> it + ("lux f64 *" -1.0) + (..pow ("lux f64 /" +3.0 +1.0)) + ("lux f64 *" -1.0)) + (|> it + (..pow ("lux f64 /" +3.0 +1.0)))))) @.ruby (as_is (template [<name> <method>] diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 57c18e4e1..2ddc8a689 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -53,6 +53,7 @@ [meta [import {"+" Import}] ["[0]" context {"+" Context}] + ["[0]" cache] [cli {"+" Compilation Library} ["[0]" compiler {"+" Compiler}]] ["[0]" archive {"+" Output Archive} @@ -260,7 +261,7 @@ (value@ #host platform) (value@ #phase platform) generation_bundle)] - _ (ioW.enable (value@ #&file_system platform) context) + _ (cache.enable! (value@ #&file_system platform) context) [archive analysis_state bundles] (ioW.thaw (value@ #host platform) (value@ #&file_system platform) context import compilation_sources) .let [with_missing_extensions (: (All (_ <type_vars>) 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 4c810f8c5..d130a38e6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -31,9 +31,10 @@ ["[0]" phase] [meta ["[0]" archive {"+" Archive} - ["[0]" artifact] ["[0]" registry {"+" Registry}] ["[0]" unit] + ["[0]" artifact + ["[0]" category]] ["[0]" module ["[0]" descriptor]]]]]]) @@ -248,29 +249,29 @@ {.#None} (phase.except ..no_buffer_for_saving_code [artifact_id])))) -(template [<mandatory?> <inputs> <input_types> <name> <artifact>] - [(`` (def: .public (<name> name (~~ (template.spliced <inputs>)) dependencies) +(template [<type> <mandatory?> <inputs> <input_types> <name> <artifact>] + [(`` (def: .public (<name> it (~~ (template.spliced <inputs>)) dependencies) (All (_ anchor expression directive) - (-> Text (~~ (template.spliced <input_types>)) (Set unit.ID) (Operation anchor expression directive artifact.ID))) + (-> <type> (~~ (template.spliced <input_types>)) (Set unit.ID) (Operation anchor expression directive artifact.ID))) (function (_ (^@ stateE [bundle state])) - (let [[id registry'] (<artifact> name <mandatory?> dependencies (value@ #registry state))] + (let [[id registry'] (<artifact> it <mandatory?> dependencies (value@ #registry state))] {try.#Success [[bundle (with@ #registry registry' state)] id]}))))] - [mandatory? [mandatory?] [Bit] learn registry.definition] - [#1 [] [] learn_custom registry.custom] - [#0 [] [] learn_analyser registry.analyser] - [#0 [] [] learn_synthesizer registry.synthesizer] - [#0 [] [] learn_generator registry.generator] - [#0 [] [] learn_directive registry.directive] + [category.Definition mandatory? [mandatory?] [Bit] learn registry.definition] + [Text #1 [] [] learn_custom registry.custom] + [Text #0 [] [] learn_analyser registry.analyser] + [Text #0 [] [] learn_synthesizer registry.synthesizer] + [Text #0 [] [] learn_generator registry.generator] + [Text #0 [] [] learn_directive registry.directive] ) (exception: .public (unknown_definition [name Symbol - known_definitions (List Text)]) + known_definitions (List category.Definition)]) (exception.report ["Definition" (symbol.short name)] ["Module" (symbol.module name)] - ["Known Definitions" (exception.listing function.identity known_definitions)])) + ["Known Definitions" (exception.listing product.left known_definitions)])) (def: .public (remember archive name) (All (_ anchor expression directive) @@ -278,7 +279,7 @@ (function (_ (^@ stateE [bundle state])) (let [[_module _name] name] (do try.monad - [module_id (archive.id _module archive) + [@module (archive.id _module archive) registry (if (text#= (value@ #module state) _module) {try.#Success (value@ #registry state)} (do try.monad @@ -289,7 +290,26 @@ (exception.except ..unknown_definition [name (registry.definitions registry)]) {.#Some id} - {try.#Success [stateE [module_id id]]}))))) + {try.#Success [stateE [@module id]]}))))) + +(def: .public (definition archive name) + (All (_ anchor expression directive) + (-> Archive Symbol (Operation anchor expression directive [unit.ID (Maybe category.Definition)]))) + (function (_ (^@ stateE [bundle state])) + (let [[_module _name] name] + (do try.monad + [@module (archive.id _module archive) + registry (if (text#= (value@ #module state) _module) + {try.#Success (value@ #registry state)} + (do try.monad + [[_module output registry] (archive.find _module archive)] + {try.#Success registry}))] + (case (registry.find_definition _name registry) + {.#None} + (exception.except ..unknown_definition [name (registry.definitions registry)]) + + {.#Some [@artifact def]} + {try.#Success [stateE [[@module @artifact] def]]}))))) (exception: .public no_context) @@ -298,8 +318,8 @@ (-> descriptor.Module Archive (Operation anchor expression directive module.ID))) (function (_ (^@ stateE [bundle state])) (do try.monad - [module_id (archive.id module archive)] - (in [stateE module_id])))) + [@module (archive.id module archive)] + (in [stateE @module])))) (def: .public (context archive) (All (_ anchor expression directive) @@ -311,17 +331,17 @@ {.#Some id} (do try.monad - [module_id (archive.id (value@ #module state) archive)] - (in [stateE [module_id id]]))))) + [@module (archive.id (value@ #module state) archive)] + (in [stateE [@module id]]))))) -(def: .public (with_context id body) +(def: .public (with_context @artifact body) (All (_ anchor expression directive a) (-> artifact.ID (Operation anchor expression directive a) (Operation anchor expression directive a))) (function (_ [bundle state]) (do try.monad - [[[bundle' state'] output] (body [bundle (with@ #context {.#Some id} state)])] + [[[bundle' state'] output] (body [bundle (with@ #context {.#Some @artifact} state)])] (in [[bundle' (with@ #context (value@ #context state) state')] output])))) @@ -341,16 +361,16 @@ (-> Archive (Set unit.ID) (Operation anchor expression directive a) (Operation anchor expression directive [unit.ID a]))) (function (_ (^@ stateE [bundle state])) - (let [[id registry'] (registry.resource false dependencies (value@ #registry state)) - id (n.+ id (value@ #registry_shift state))] + (let [[@artifact registry'] (registry.resource false dependencies (value@ #registry state)) + @artifact (n.+ @artifact (value@ #registry_shift state))] (do try.monad [[[bundle' state'] output] (body [bundle (|> state (with@ #registry registry') - (with@ #context {.#Some id}) - (revised@ #interim_artifacts (|>> {.#Item id})))]) - module_id (archive.id (value@ #module state) archive)] + (with@ #context {.#Some @artifact}) + (revised@ #interim_artifacts (|>> {.#Item @artifact})))]) + @module (archive.id (value@ #module state) archive)] (in [[bundle' (with@ #context (value@ #context state) state')] - [[module_id id] + [[@module @artifact] output]]))))) (def: .public (log! message) @@ -364,17 +384,14 @@ (def: .public (with_interim_artifacts archive body) (All (_ anchor expression directive a) (-> Archive (Operation anchor expression directive a) - (Operation anchor expression directive [(Set unit.ID) a]))) + (Operation anchor expression directive [(List unit.ID) a]))) (do phase.monad [module (extension.read (value@ #module))] (function (_ state+) (do try.monad - [module_id (archive.id module archive) + [@module (archive.id module archive) [[bundle' state'] output] (body state+)] (in [[bundle' (with@ #interim_artifacts (list) state')] - [(list#mix (function (_ artifact_id dependencies) - (set.has [module_id artifact_id] dependencies)) - unit.none - (value@ #interim_artifacts state')) + [(list#each (|>> [@module]) (value@ #interim_artifacts state')) output]]))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux index 72a47712f..78bf307b0 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux @@ -6,7 +6,7 @@ ["[0]" monad {"+" do}]] [control ["<>" parser - ["<c>" code {"+" Parser}]]] + ["<[0]>" code {"+" Parser}]]] [data [collection ["[0]" array {"+" Array}] @@ -29,70 +29,75 @@ (def: array::new Handler (custom - [<c>.any + [<code>.any (function (_ extension phase archive lengthC) - (do phase.monad - [lengthA (analysis/type.expecting Nat - (phase archive lengthC)) - [var_id varT] (analysis/type.check check.var) - _ (analysis/type.inference (type (Array varT)))] - (in {analysis.#Extension extension (list lengthA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [lengthA (analysis/type.expecting Nat + (phase archive lengthC)) + _ (analysis/type.inference (type (Array :var:)))] + (in {analysis.#Extension extension (list lengthA)}))))])) (def: array::length Handler (custom - [<c>.any + [<code>.any (function (_ extension phase archive arrayC) - (do phase.monad - [[var_id varT] (analysis/type.check check.var) - arrayA (analysis/type.expecting (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.inference Nat)] - (in {analysis.#Extension extension (list arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [arrayA (analysis/type.expecting (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.inference Nat)] + (in {analysis.#Extension extension (list arrayA)}))))])) (def: array::read Handler (custom - [(<>.and <c>.any <c>.any) + [(<>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) - (do phase.monad - [indexA (analysis/type.expecting Nat - (phase archive indexC)) - [var_id varT] (analysis/type.check check.var) - arrayA (analysis/type.expecting (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.inference varT)] - (in {analysis.#Extension extension (list indexA arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + arrayA (analysis/type.expecting (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.inference :var:)] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) (def: array::write Handler (custom - [($_ <>.and <c>.any <c>.any <c>.any) + [($_ <>.and <code>.any <code>.any <code>.any) (function (_ extension phase archive [indexC valueC arrayC]) - (do phase.monad - [indexA (analysis/type.expecting Nat - (phase archive indexC)) - [var_id varT] (analysis/type.check check.var) - valueA (analysis/type.expecting varT - (phase archive valueC)) - arrayA (analysis/type.expecting (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.inference (type (Array varT)))] - (in {analysis.#Extension extension (list indexA valueA arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + valueA (analysis/type.expecting :var: + (phase archive valueC)) + arrayA (analysis/type.expecting (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.inference (type (Array :var:)))] + (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) (def: array::delete Handler (custom - [($_ <>.and <c>.any <c>.any) + [($_ <>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) - (do phase.monad - [indexA (analysis/type.expecting Nat - (phase archive indexC)) - [var_id varT] (analysis/type.check check.var) - arrayA (analysis/type.expecting (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.inference (type (Array varT)))] - (in {analysis.#Extension extension (list indexA arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + arrayA (analysis/type.expecting (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.inference (type (Array :var:)))] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) (def: bundle::array Bundle @@ -108,7 +113,7 @@ (def: object::new Handler (custom - [($_ <>.and <c>.any (<c>.tuple (<>.some <c>.any))) + [($_ <>.and <code>.any (<code>.tuple (<>.some <code>.any))) (function (_ extension phase archive [constructorC inputsC]) (do [! phase.monad] [constructorA (analysis/type.expecting Any @@ -120,7 +125,7 @@ (def: object::get Handler (custom - [($_ <>.and <c>.text <c>.any) + [($_ <>.and <code>.text <code>.any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad [objectA (analysis/type.expecting Any @@ -132,7 +137,7 @@ (def: object::do Handler (custom - [($_ <>.and <c>.text <c>.any (<c>.tuple (<>.some <c>.any))) + [($_ <>.and <code>.text <code>.any (<code>.tuple (<>.some <code>.any))) (function (_ extension phase archive [methodC objectC inputsC]) (do [! phase.monad] [objectA (analysis/type.expecting Any @@ -159,7 +164,7 @@ (def: js::constant Handler (custom - [<c>.text + [<code>.text (function (_ extension phase archive name) (do phase.monad [_ (analysis/type.inference Any)] @@ -168,7 +173,7 @@ (def: js::apply Handler (custom - [($_ <>.and <c>.any (<>.some <c>.any)) + [($_ <>.and <code>.any (<>.some <code>.any)) (function (_ extension phase archive [abstractionC inputsC]) (do [! phase.monad] [abstractionA (analysis/type.expecting Any @@ -180,7 +185,7 @@ (def: js::type_of Handler (custom - [<c>.any + [<code>.any (function (_ extension phase archive objectC) (do phase.monad [objectA (analysis/type.expecting Any @@ -191,7 +196,7 @@ (def: js::function Handler (custom - [($_ <>.and <c>.nat <c>.any) + [($_ <>.and <code>.nat <code>.any) (function (_ extension phase archive [arity abstractionC]) (do phase.monad [.let [inputT (type.tuple (list.repeated arity Any))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux index d27c8ceac..b1e865767 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux @@ -31,68 +31,73 @@ (custom [<code>.any (function (_ extension phase archive lengthC) - (do phase.monad - [lengthA (analysis/type.expecting Nat - (phase archive lengthC)) - [var_id varT] (analysis/type.check check.var) - _ (analysis/type.inference (type (Array varT)))] - (in {analysis.#Extension extension (list lengthA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [lengthA (analysis/type.expecting Nat + (phase archive lengthC)) + _ (analysis/type.inference (type (Array :var:)))] + (in {analysis.#Extension extension (list lengthA)}))))])) (def: array::length Handler (custom [<code>.any (function (_ extension phase archive arrayC) - (do phase.monad - [[var_id varT] (analysis/type.check check.var) - arrayA (analysis/type.expecting (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.inference Nat)] - (in {analysis.#Extension extension (list arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [arrayA (analysis/type.expecting (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.inference Nat)] + (in {analysis.#Extension extension (list arrayA)}))))])) (def: array::read Handler (custom [(<>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) - (do phase.monad - [indexA (analysis/type.expecting Nat - (phase archive indexC)) - [var_id varT] (analysis/type.check check.var) - arrayA (analysis/type.expecting (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.inference varT)] - (in {analysis.#Extension extension (list indexA arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + arrayA (analysis/type.expecting (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.inference :var:)] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) (def: array::write Handler (custom [($_ <>.and <code>.any <code>.any <code>.any) (function (_ extension phase archive [indexC valueC arrayC]) - (do phase.monad - [indexA (analysis/type.expecting Nat - (phase archive indexC)) - [var_id varT] (analysis/type.check check.var) - valueA (analysis/type.expecting varT - (phase archive valueC)) - arrayA (analysis/type.expecting (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.inference (type (Array varT)))] - (in {analysis.#Extension extension (list indexA valueA arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + valueA (analysis/type.expecting :var: + (phase archive valueC)) + arrayA (analysis/type.expecting (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.inference (type (Array :var:)))] + (in {analysis.#Extension extension (list indexA valueA arrayA)}))))])) (def: array::delete Handler (custom [($_ <>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) - (do phase.monad - [indexA (analysis/type.expecting Nat - (phase archive indexC)) - [var_id varT] (analysis/type.check check.var) - arrayA (analysis/type.expecting (type (Array varT)) - (phase archive arrayC)) - _ (analysis/type.inference (type (Array varT)))] - (in {analysis.#Extension extension (list indexA arrayA)})))])) + (<| analysis/type.with_var + (function (_ [@var :var:])) + (do phase.monad + [indexA (analysis/type.expecting Nat + (phase archive indexC)) + arrayA (analysis/type.expecting (type (Array :var:)) + (phase archive arrayC)) + _ (analysis/type.inference (type (Array :var:)))] + (in {analysis.#Extension extension (list indexA arrayA)}))))])) (def: bundle::array Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index e159172b2..4fb0a4715 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 @@ -7,6 +7,7 @@ ["[0]" monad {"+" do}]] [control [io {"+" IO}] + ["[0]" maybe ("[1]#[0]" functor)] ["[0]" try] ["[0]" exception {"+" exception:}] ["<>" parser @@ -120,13 +121,21 @@ (Operation anchor expression directive [Type expression Any]))) (/////directive.lifted_generation (do phase.monad - [[interim_artifacts codeG] (/////generation.with_interim_artifacts archive + [dependencies (cache/artifact.dependencies archive codeS) + [interim_artifacts codeG] (/////generation.with_interim_artifacts archive (generate archive codeS)) - dependencies (cache/artifact.dependencies archive codeS) + .let [function_artifact (case codeS + (^ (/////synthesis.function/abstraction [env arity body])) + (|> interim_artifacts + list.last + (maybe#each (|>> [arity]))) + + _ + {.#None})] 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) - _ (/////generation.save! id {.#None} directive)] + @self (/////generation.learn [name function_artifact] false (list#mix set.has dependencies interim_artifacts)) + [target_name value directive] (/////generation.define! [module_id @self] {.#None} codeG) + _ (/////generation.save! @self {.#None} directive)] (in [code//type codeG value])))) (def: (definition archive name expected codeC) @@ -173,13 +182,13 @@ (///.lifted meta.current_module_name))] (/////directive.lifted_generation (do phase.monad - [[interim_artifacts codeG] (/////generation.with_interim_artifacts archive + [dependencies (cache/artifact.dependencies archive codeS) + [interim_artifacts codeG] (/////generation.with_interim_artifacts archive (generate archive codeS)) - dependencies (cache/artifact.dependencies archive codeS) module_id (phase.lifted (archive.id current_module archive)) - id (<learn> extension (set.union interim_artifacts dependencies)) - [target_name value directive] (/////generation.define! [module_id id] {.#None} codeG) - _ (/////generation.save! id {.#None} directive)] + @self (<learn> extension (list#mix set.has dependencies interim_artifacts)) + [target_name value directive] (/////generation.define! [module_id @self] {.#None} codeG) + _ (/////generation.save! @self {.#None} directive)] (in [codeG value]))))) (def: .public (<full> archive extension codeT codeC) @@ -498,11 +507,11 @@ Synthesis (/////generation.Operation anchor expression directive Any))) (do phase.monad - [[interim_artifacts programG] (/////generation.with_interim_artifacts archive + [dependencies (cache/artifact.dependencies archive programS) + [interim_artifacts programG] (/////generation.with_interim_artifacts archive (generate 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)))) + @self (/////generation.learn [/////program.name {.#None}] true (list#mix set.has dependencies interim_artifacts))] + (/////generation.save! @self {.#None} (program [module_id @self] programG)))) (def: (def::program program) (All (_ anchor expression directive) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux index 83171eea1..7cabfc178 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm.lux @@ -1,23 +1,23 @@ (.using - [library - [lux "*" - [abstract - [monad {"+" do}]]]] - ["[0]" / "_" - [runtime {"+" Phase}] - ["[1][0]" primitive] - ["[1][0]" structure] - ["[1][0]" reference] - ["[1][0]" function] - ["[1][0]" case] - ["[1][0]" loop] - ["//[1]" /// "_" - ["[1][0]" extension] - [// - ["[0]" synthesis] - [/// - ["[0]" reference] - ["[1]" phase ("[1]#[0]" monad)]]]]]) + [library + [lux "*" + [abstract + [monad {"+" do}]]]] + ["[0]" / "_" + [runtime {"+" Phase}] + ["[1][0]" primitive] + ["[1][0]" structure] + ["[1][0]" reference] + ["[1][0]" function] + ["[1][0]" case] + ["[1][0]" loop] + ["//[1]" /// "_" + ["[1][0]" extension] + [// + ["[0]" synthesis] + [/// + ["[0]" reference] + ["[1]" phase ("[1]#[0]" monad)]]]]]) (def: .public (generate archive synthesis) Phase 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 59206b6fb..e01b1dd0d 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 @@ -52,13 +52,17 @@ ["[1][0]" apply]] ["/[1]" // "_" ["[1][0]" runtime {"+" Operation Phase Generator}] + ["[1][0]" reference] [//// [analysis {"+" Environment}] - [synthesis {"+" Synthesis Abstraction Apply}] + ["[0]" synthesis {"+" Synthesis Abstraction Apply}] ["[0]" generation] [/// ["[0]" arity {"+" Arity}] ["[0]" phase] + [meta + [archive + ["[0]" unit]]] [reference [variable {"+" Register}]]]]]]) @@ -79,7 +83,8 @@ list.indices (list#each (|>> ++ (/apply.method classT environment arity @begin body))) (list& (/implementation.method arity @begin body))) - (list (/implementation.method' //runtime.apply::name arity @begin body)))))] + (list (/implementation.method arity @begin body) + (/apply.method classT environment arity @begin body 1)))))] (do phase.monad [instance (/new.instance generate archive classT environment arity)] (in [fields methods instance])))) @@ -121,11 +126,10 @@ _ (generation.save! (product.right function_context) {.#None} bytecode)] (in instance))) -(def: .public (apply generate archive [abstractionS inputsS]) - (Generator Apply) +(def: (apply/?' generate archive [abstractionG inputsS]) + (Generator [(Bytecode Any) (List Synthesis)]) (do [! phase.monad] - [abstractionG (generate archive abstractionS) - inputsG (monad.each ! (generate archive) inputsS)] + [inputsG (monad.each ! (generate archive) inputsS)] (in ($_ _.composite abstractionG (|> inputsG @@ -138,3 +142,52 @@ (_.invokevirtual /abstract.class //runtime.apply::name (//runtime.apply::type (list.size batchG))) )))) )))) + +(def: (apply/? generate archive [abstractionS inputsS]) + (Generator Apply) + (do [! phase.monad] + [abstractionG (generate archive abstractionS)] + (apply/?' generate archive [abstractionG inputsS]))) + +(def: (apply/= generate archive [$abstraction @abstraction arity inputsS]) + (Generator [Symbol unit.ID Arity (List Synthesis)]) + (do [! phase.monad] + [.let [:abstraction: (type.class (//runtime.class_name @abstraction) (list))] + abstractionG (//reference.constant archive $abstraction) + inputsG (monad.each ! (generate archive) inputsS)] + (in ($_ _.composite + abstractionG + (_.checkcast :abstraction:) + (monad.all _.monad inputsG) + (/implementation.call @abstraction arity) + )))) + +(def: (apply/> generate archive [$abstraction @abstraction arity inputsS]) + (Generator [Symbol unit.ID Arity (List Synthesis)]) + (do [! phase.monad] + [=G (apply/= generate archive [$abstraction @abstraction arity (list.first arity inputsS)])] + (apply/?' generate archive [=G (list.after arity inputsS)]))) + +(def: .public (apply generate archive [abstractionS inputsS]) + (Generator Apply) + (case abstractionS + (^ (synthesis.constant $abstraction)) + (do [! phase.monad] + [[@definition |abstraction|] (generation.definition archive $abstraction) + .let [actual_arity (list.size inputsS)]] + (case |abstraction| + {.#Some [_ {.#Some [expected_arity @abstraction]}]} + (cond (n.< expected_arity actual_arity) + (apply/? generate archive [abstractionS inputsS]) + + (n.= expected_arity actual_arity) + (apply/= generate archive [$abstraction @abstraction expected_arity inputsS]) + + ... (n.> expected_arity actual_arity) + (apply/> generate archive [$abstraction @abstraction expected_arity inputsS])) + + _ + (apply/? generate archive [abstractionS inputsS]))) + + _ + (apply/? generate archive [abstractionS inputsS]))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux index 22e3a8b0d..ddcc315a2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux @@ -4,19 +4,27 @@ [data [collection ["[0]" list]]] + [math + [number + ["n" nat]]] [target [jvm + ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)] ["[0]" method {"+" Method}] ["_" bytecode {"+" Label Bytecode}] [constant [pool {"+" Resource}]] ["[0]" type {"+" Type} - ["[0]" category]]]]]] + ["[0]" category {"+" Class}]]]]]] ["[0]" // ["//[1]" /// "_" + ["[0]" runtime] ["[1][0]" type] [////// - [arity {"+" Arity}]]]]) + [arity {"+" Arity}] + [meta + [archive + ["[0]" unit]]]]]]) (def: .public name "impl") @@ -27,9 +35,10 @@ ////type.value (list)])) -(def: .public (method' name arity @begin body) - (-> Text Arity Label (Bytecode Any) (Resource Method)) - (method.method //.modifier name +(def: .public (method arity @begin body) + (-> Arity Label (Bytecode Any) (Resource Method)) + (method.method //.modifier + ..name #0 (..type arity) (list) {.#Some ($_ _.composite @@ -38,6 +47,8 @@ (_.when_continuous _.areturn) )})) -(def: .public method - (-> Arity Label (Bytecode Any) (Resource Method)) - (method' ..name)) +(def: .public (call @abstraction arity) + (-> unit.ID Arity (Bytecode Any)) + (_.invokevirtual (type.class (runtime.class_name @abstraction) (list)) + ..name + (..type arity))) diff --git a/stdlib/source/library/lux/tool/compiler/meta.lux b/stdlib/source/library/lux/tool/compiler/meta.lux index bf357179c..aa506aa08 100644 --- a/stdlib/source/library/lux/tool/compiler/meta.lux +++ b/stdlib/source/library/lux/tool/compiler/meta.lux @@ -1,8 +1,8 @@ (.using - [library - [lux "*"]] - [// - [version {"+" Version}]]) + [library + [lux "*"]] + [// + [version {"+" Version}]]) (def: .public version Version diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux index 8286af9a8..526a8bce1 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux @@ -1,15 +1,37 @@ (.using [library - [lux "*" + [lux {"-" Definition} [abstract [equivalence {"+" Equivalence}]] + [control + ["[0]" maybe]] [data - ["[0]" text ("[1]#[0]" equivalence)]]]]) + ["[0]" product] + ["[0]" text ("[1]#[0]" equivalence)]] + [math + [number + ["[0]" nat]]]]] + [///// + [arity {"+" Arity}]]) + +(type: .public Definition + [Text (Maybe [Arity [Nat Nat]])]) + +(def: definition_equivalence + (Equivalence Definition) + ($_ product.equivalence + text.equivalence + (maybe.equivalence ($_ product.equivalence + nat.equivalence + nat.equivalence + nat.equivalence + )) + )) (type: .public Category (Variant {#Anonymous} - {#Definition Text} + {#Definition Definition} {#Analyser Text} {#Synthesizer Text} {#Generator Text} @@ -23,12 +45,14 @@ (case [left right] [{#Anonymous} {#Anonymous}] true + + [{#Definition left} {#Definition right}] + (# definition_equivalence = left right) (^template [<tag>] [[{<tag> left} {<tag> right}] (text#= left right)]) - ([#Definition] - [#Analyser] + ([#Analyser] [#Synthesizer] [#Generator] [#Directive] 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 7af5c105b..02b8e7055 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux @@ -4,7 +4,8 @@ [abstract [monad {"+" do}]] [control - [pipe {"+" case>}] + [pipe {"+" case> let>}] + ["[0]" maybe ("[1]#[0]" functor)] ["[0]" exception {"+" exception:}] ["<>" parser ["<[0]>" binary {"+" Parser}]]] @@ -29,7 +30,7 @@ (abstract: .public Registry (Record [#artifacts (Sequence [Artifact (Set unit.ID)]) - #resolver (Dictionary Text ID)]) + #resolver (Dictionary Text [ID (Maybe //category.Definition)])]) (def: .public empty Registry @@ -56,55 +57,70 @@ dependencies])) :abstraction)])) - (template [<tag> <create> <fetch>] - [(def: .public (<create> name mandatory? dependencies registry) - (-> Text Bit (Set unit.ID) Registry [ID Registry]) + (template [<tag> <create> <fetch> <type> <name> <+resolver>] + [(def: .public (<create> it mandatory? dependencies registry) + (-> <type> Bit (Set unit.ID) Registry [ID Registry]) (let [id (..next registry)] [id (|> registry :representation (revised@ #artifacts (sequence.suffix [[//.#id id - //.#category {<tag> name} + //.#category {<tag> it} //.#mandatory? mandatory?] dependencies])) - (revised@ #resolver (dictionary.has name id)) + (revised@ #resolver (dictionary.has (<name> it) [id <+resolver>])) :abstraction)])) (def: .public (<fetch> registry) - (-> Registry (List Text)) + (-> Registry (List <type>)) (|> registry :representation (value@ #artifacts) sequence.list (list.all (|>> product.left (value@ //.#category) - (case> {<tag> name} {.#Some name} + (case> {<tag> it} {.#Some it} _ {.#None})))))] - [//category.#Definition definition definitions] - [//category.#Analyser analyser analysers] - [//category.#Synthesizer synthesizer synthesizers] - [//category.#Generator generator generators] - [//category.#Directive directive directives] - [//category.#Custom custom customs] + [//category.#Definition definition definitions //category.Definition + product.left {.#Some it}] + [//category.#Analyser analyser analysers Text |> {.#None}] + [//category.#Synthesizer synthesizer synthesizers Text |> {.#None}] + [//category.#Generator generator generators Text |> {.#None}] + [//category.#Directive directive directives Text |> {.#None}] + [//category.#Custom custom customs Text |> {.#None}] ) - (def: .public (id name registry) - (-> Text Registry (Maybe ID)) + (def: .public (find_definition name registry) + (-> Text Registry (Maybe [ID (Maybe //category.Definition)])) (|> (:representation registry) (value@ #resolver) (dictionary.value name))) + (def: .public (id name registry) + (-> Text Registry (Maybe ID)) + (maybe#each product.left (find_definition name registry))) + (def: .public writer (Writer Registry) - (let [category (: (Writer Category) + (let [definition (: (Writer //category.Definition) + ($_ binary.and + binary.text + (binary.maybe + ($_ binary.and + binary.nat + binary.nat + binary.nat + )) + )) + category (: (Writer Category) (function (_ value) (case value (^template [<nat> <tag> <writer>] [{<tag> value} ((binary.and binary.nat <writer>) [<nat> value])]) ([0 //category.#Anonymous binary.any] - [1 //category.#Definition binary.text] + [1 //category.#Definition definition] [2 //category.#Analyser binary.text] [3 //category.#Synthesizer binary.text] [4 //category.#Generator binary.text] @@ -131,7 +147,17 @@ (def: .public parser (Parser Registry) - (let [category (: (Parser Category) + (let [definition (: (Parser //category.Definition) + ($_ <>.and + <binary>.text + (<binary>.maybe + ($_ <>.and + <binary>.nat + <binary>.nat + <binary>.nat + )) + )) + category (: (Parser Category) (do [! <>.monad] [tag <binary>.nat] (case tag @@ -139,7 +165,7 @@ [<nat> (# ! each (|>> {<tag>}) <parser>)]) ([0 //category.#Anonymous <binary>.any] - [1 //category.#Definition <binary>.text] + [1 //category.#Definition definition] [2 //category.#Analyser <binary>.text] [3 //category.#Synthesizer <binary>.text] [4 //category.#Generator <binary>.text] diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache.lux b/stdlib/source/library/lux/tool/compiler/meta/cache.lux new file mode 100644 index 000000000..d9ed86253 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/meta/cache.lux @@ -0,0 +1,39 @@ +(.using + [library + [lux "*" + [abstract + [monad {"+" do}]] + [control + ["[0]" try {"+" Try}] + [concurrency + ["[0]" async {"+" Async}]]] + [data + [text + ["%" format {"+" format}]]] + [world + ["[0]" file]]]] + ["[0]" // + ["[0]" context {"+" Context}] + [// + ["[0]" version]]]) + +(def: .public (path fs context) + (All (_ !) (-> (file.System !) Context file.Path)) + (let [/ (# fs separator)] + (format (value@ context.#target context) + / (value@ context.#host context) + / (version.format //.version)))) + +(def: .public (enabled? fs context) + (-> (file.System Async) Context (Async Bit)) + (|> context + (..path fs) + (# fs directory?))) + +(def: .public (enable! fs context) + (-> (file.System Async) Context (Async (Try Any))) + (do [! async.monad] + [? (..enabled? fs context)] + (if ? + (in {try.#Success []}) + (file.make_directories ! fs (..path fs context))))) 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 515e3ff09..4693a7d2f 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -41,7 +41,7 @@ ["[0]" module ["[0]" descriptor {"+" Descriptor}] ["[0]" document {"+" Document}]]] - ["[0]" cache "_" + ["[0]" cache ["[1]/[0]" module]] ["/[1]" // {"+" Input} [language @@ -61,27 +61,9 @@ ["Module ID" (%.nat module_id)] ["Error" error])) -(def: (archive fs context) - (All (_ !) (-> (file.System !) Context file.Path)) - (format (value@ context.#target context) - (# fs separator) - (value@ context.#host context))) - -(def: (unversioned_lux_archive fs context) - (All (_ !) (-> (file.System !) Context file.Path)) - (format (..archive fs context) - (# fs separator) - //.lux_context)) - -(def: (versioned_lux_archive fs context) - (All (_ !) (-> (file.System !) Context file.Path)) - (format (..unversioned_lux_archive fs context) - (# fs separator) - (%.nat version.version))) - (def: (module fs context module_id) (All (_ !) (-> (file.System !) Context module.ID file.Path)) - (format (..versioned_lux_archive fs context) + (format (cache.path fs context) (# fs separator) (%.nat module_id))) @@ -108,15 +90,14 @@ (if module_exists? (in {try.#Success []}) (do (try.with !) - [_ (ensure_directory fs (..unversioned_lux_archive fs context)) - _ (ensure_directory fs (..versioned_lux_archive fs context))] + [_ (cache.enable! fs context)] (|> module (# fs make_directory) (# ! each (|>> (case> {try.#Success output} {try.#Success []} {try.#Failure error} - (exception.except ..cannot_prepare [(..archive fs context) + (exception.except ..cannot_prepare [(cache.path fs context) module_id error]))))))))) @@ -124,15 +105,9 @@ (-> (file.System Async) Context module.ID artifact.ID Binary (Async (Try Any))) (# fs write content (..artifact fs context module_id artifact_id))) -(def: .public (enable fs context) - (-> (file.System Async) Context (Async (Try Any))) - (do (try.with async.monad) - [_ (..ensure_directory fs (value@ context.#target context))] - (..ensure_directory fs (..archive fs context)))) - (def: (general_descriptor fs context) (-> (file.System Async) Context file.Path) - (format (..archive fs context) + (format (cache.path fs context) (# fs separator) "general_descriptor")) @@ -252,7 +227,7 @@ directives] output])) - {category.#Definition name} + {category.#Definition [name function_artifact]} (let [output (sequence.suffix [artifact_id {.#None} data] output)] (if (text#= $/program.name name) (in [definitions |