diff options
15 files changed, 453 insertions, 285 deletions
diff --git a/lux-bootstrapper/src/lux/base.clj b/lux-bootstrapper/src/lux/base.clj index 8e99d8cde..2265c49af 100644 --- a/lux-bootstrapper/src/lux/base.clj +++ b/lux-bootstrapper/src/lux/base.clj @@ -129,8 +129,7 @@ "loader" "classes" "type-env" - "dummy-mappings" - ]) + "dummy-mappings"]) (defvariant ("Build" 0) @@ -150,7 +149,8 @@ (defvariant ("DefinitionG" 1) - ("AliasG" 1)) + ("AliasG" 1) + ("DefaultG" 1)) (deftuple ["info" diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 19cc619a2..e1092f696 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -524,6 +524,15 @@ {#Product Bit {#Product Type Any}}}) .public) +... (type .public Default +... Definition) +("lux def" Default + ("lux type check" + Type + {#Named [..prelude "Default"] + Definition}) + .public) + ... (type .public Alias ... Symbol) ("lux def" Alias @@ -536,13 +545,15 @@ ... (type .public Global ... (Variant ... {#Definition Definition} -... {#Alias Alias})) +... {#Alias Alias} +... {#Default Default})) ("lux def" Global ("lux type check" Type {#Named [..prelude "Global"] {#Sum Definition - Alias}}) + {#Sum Alias + Default}}}) .public) ("lux def" global_tags @@ -550,10 +561,12 @@ {#Apply Symbol List} {#Item [..prelude "#Definition"] {#Item [..prelude "#Alias"] - {#End}}}) + {#Item [..prelude "#Default"] + {#End}}}}) #0) ("lux def" #Definition (tag [{#Some [0 #0 ..global_tags]} Global]) .public) -("lux def" #Alias (tag [{#Some [0 #1 ..global_tags]} Global]) .public) +("lux def" #Alias (tag [{#Some [1 #0 ..global_tags]} Global]) .public) +("lux def" #Default (tag [{#Some [1 #1 ..global_tags]} Global]) .public) ... (type .public (Bindings k v) ... (Record @@ -1907,7 +1920,10 @@ {#Right [state full_name]} {#Alias real_name} - {#Right [state real_name]}} + {#Right [state real_name]} + + {#Default _} + {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}} constant) {#None} @@ -2037,7 +2053,10 @@ {#Definition [exported? def_type def_value]} (if (available? expected_module current_module exported?) {#Right [state [def_type def_value]]} - {#Left (text#composite "Unavailable definition: " (symbol#encoded name))})} + {#Left (text#composite "Unavailable definition: " (symbol#encoded name))}) + + {#Default _} + {#Left (text#composite "Unknown definition: " (symbol#encoded name))}} definition)} (property#value expected_short definitions))} (property#value expected_module modules)))) @@ -2713,7 +2732,10 @@ (if (text#= module current_module) {#Some ("lux type as" Macro def_value)} {#None})) - {#None})} + {#None}) + + {#Default _} + {#None}} ("lux type check" Global gdef)))) (def' .private (named_macro full_name) @@ -4545,7 +4567,10 @@ {#Definition [exported? def_type def_value]} (if exported? (list name) - (list))))) + (list)) + + {#Default _} + (list)))) (let [[..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _] =module] definitions))] {#Right state (list#conjoint to_alias)}) @@ -4677,7 +4702,10 @@ (definition_type real_name state) {#Definition [exported? def_type def_value]} - {#Some def_type}))))) + {#Some def_type} + + {#Default _} + {#None}))))) (def (type_variable idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) @@ -5880,6 +5908,7 @@ (with_template [<type>] [(def .public <type> + Type (let [[_ short] (symbol <type>)] {.#Primitive (text#composite "#" short) (list)}))] diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index 8f5195d1f..69211a03c 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -185,7 +185,10 @@ {.#Definition [exported? def_type def_value]} (if (macro_type? def_type) {.#Some (as Macro def_value)} - {.#None}))))) + {.#None}) + + {.#Default _} + {.#None})))) {try.#Failure error} {.#None})]})))) @@ -286,66 +289,74 @@ (list.sorted text#<) (text.interposed ..listing_separator))) -(def .public (definition name) - (-> Symbol (Meta Global)) - (do ..monad - [name (..normal name) - .let [[normal_module normal_short] name]] - (function (_ lux) - (when (is (Maybe Global) - (do maybe.monad - [(open "[0]") (|> lux - (the .#modules) - (property.value normal_module))] - (property.value normal_short #definitions))) - {.#Some definition} - {try.#Success [lux definition]} - - _ - (let [current_module (|> lux (the .#current_module) (maybe.else "???")) - all_known_modules (|> lux - (the .#modules) - (list#each product.left) - ..module_listing)] - {try.#Failure (all text#composite - "Unknown definition: " (symbol#encoded name) text.new_line - " Current module: " current_module text.new_line - (when (property.value current_module (the .#modules lux)) - {.#Some this_module} - (let [candidates (|> lux - (the .#modules) - (list#each (function (_ [module_name module]) - (|> module - (the .#definitions) - (list.all (function (_ [def_name global]) - (`` (when global - {.#Definition [exported? _]} - (if (and exported? - (text#= normal_short def_name)) - {.#Some (symbol#encoded [module_name def_name])} - {.#None}) - - {.#Alias _} - {.#None}))))))) - list.together +(with_template [<name> <yes> <no>] + [(def .public (<name> name) + (-> Symbol (Meta Global)) + (do ..monad + [name (..normal name) + .let [[normal_module normal_short] name]] + (function (_ lux) + (when (is (Maybe Global) + (do maybe.monad + [(open "[0]") (|> lux + (the .#modules) + (property.value normal_module))] + (property.value normal_short #definitions))) + {.#Some definition} + {try.#Success [lux definition]} + + _ + (let [current_module (|> lux (the .#current_module) (maybe.else "???")) + all_known_modules (|> lux + (the .#modules) + (list#each product.left) + ..module_listing)] + {try.#Failure (all text#composite + "Unknown definition: " (symbol#encoded name) text.new_line + " Current module: " current_module text.new_line + (when (property.value current_module (the .#modules lux)) + {.#Some this_module} + (let [candidates (|> lux + (the .#modules) + (list#each (function (_ [module_name module]) + (|> module + (the .#definitions) + (list.all (function (_ [def_name global]) + (`` (when global + {<yes> [exported? _]} + (if (and exported? + (text#= normal_short def_name)) + {.#Some (symbol#encoded [module_name def_name])} + {.#None}) + + {.#Alias _} + {.#None} + + {<no> _} + {.#None}))))))) + list.together + (list.sorted text#<) + (text.interposed ..listing_separator)) + imports (|> this_module + (the .#imports) + ..module_listing) + aliases (|> this_module + (the .#module_aliases) + (list#each (function (_ [alias real]) (all text#composite alias " => " real))) (list.sorted text#<) - (text.interposed ..listing_separator)) - imports (|> this_module - (the .#imports) - ..module_listing) - aliases (|> this_module - (the .#module_aliases) - (list#each (function (_ [alias real]) (all text#composite alias " => " real))) - (list.sorted text#<) - (text.interposed ..listing_separator))] - (all text#composite - " Candidates: " candidates text.new_line - " Imports: " imports text.new_line - " Aliases: " aliases text.new_line)) - - _ - "") - " All known modules: " all_known_modules text.new_line)}))))) + (text.interposed ..listing_separator))] + (all text#composite + " Candidates: " candidates text.new_line + " Imports: " imports text.new_line + " Aliases: " aliases text.new_line)) + + _ + "") + " All known modules: " all_known_modules text.new_line)})))))] + + [definition .#Definition .#Default] + [default' .#Default .#Definition] + ) (def .public (export name) (-> Symbol (Meta Definition)) @@ -353,22 +364,54 @@ [name (..normal name) definition (..definition name)] (when definition - {.#Definition definition} - (let [[exported? def_type def_value] definition] + {.#Definition it} + (let [[exported? def_type def_value] it] (if exported? - (in definition) + (in it) (do ! [.let [[expected _] name] actual ..current_module_name] (if (text#= expected actual) - (in definition) + (in it) (failure (all text#composite "Definition is not an export: " (symbol#encoded name))))))) {.#Alias de_aliased} (failure (all text#composite "Aliases are not considered exports: " + (symbol#encoded name))) + + {.#Default _} + (failure (all text#composite + "Defaults are not considered exports: " (symbol#encoded name)))))) +(def .public (default name) + (-> Symbol (Meta Default)) + (do [! ..monad] + [name (..normal name) + definition (..default' name)] + (when definition + {.#Definition _} + (failure (all text#composite + "Definitions are not considered defaults: " + (symbol#encoded name))) + + {.#Alias de_aliased} + (failure (all text#composite + "Aliases are not considered defaults: " + (symbol#encoded name))) + + {.#Default it} + (let [[exported? def_type def_value] it] + (if exported? + (in it) + (do ! + [.let [[expected _] name] + actual ..current_module_name] + (if (text#= expected actual) + (in it) + (failure (all text#composite "Default is not an export: " (symbol#encoded name)))))))))) + (def .public (definition_type name) (-> Symbol (Meta Type)) (do ..monad @@ -378,7 +421,12 @@ (definition_type de_aliased) {.#Definition [exported? def_type def_value]} - (clean_type def_type)))) + (clean_type def_type) + + {.#Default _} + (failure (all text#composite + "Defaults are not considered definitions: " + (symbol#encoded name)))))) (def .public (type name) (-> Symbol (Meta Type)) @@ -405,7 +453,10 @@ (type_code .Type) (type_code def_type))) (in (as Type def_value)) - (..failure (all text#composite "Definition is not a type: " (symbol#encoded name)))))))) + (..failure (all text#composite "Definition is not a type: " (symbol#encoded name))))) + + {.#Default _} + (..failure (all text#composite "Default is not a type: " (symbol#encoded name)))))) (def .public (globals module) (-> Text (Meta (List [Text Global]))) @@ -426,7 +477,10 @@ {.#None} {.#Definition definition} - {.#Some [name definition]}))) + {.#Some [name definition]} + + {.#Default _} + {.#None}))) (..globals module))) (def .public (exports module_name) @@ -594,17 +648,10 @@ real_def_name {.#Definition _} - def_name)))) + def_name -(def .public compiler_state - (Meta Lux) - (function (_ lux) - {try.#Success [lux lux]})) - -(def .public type_context - (Meta Type_Context) - (function (_ lux) - {try.#Success [lux (the .#type_context lux)]})) + {.#Default _} + def_name)))) (def .public (lifted result) (All (_ a) (-> (Try a) (Meta a))) @@ -615,6 +662,21 @@ {try.#Failure error} (..failure error))) +(with_template [<name> <slot> <type>] + [(def .public <name> + (Meta <type>) + (function (_ lux) + {try.#Success [lux (the <slot> lux)]}))] + + [compiler_state [] Lux] + + [type_context .#type_context Type_Context] + + [target [.#info .#target] Text] + [version [.#info .#version] Text] + [configuration [.#info .#configuration] (List [Text Text])] + ) + (def .public (eval type code) (-> Type Code (Meta Any)) (do [! ..monad] @@ -625,21 +687,9 @@ (def .public (try computation) (All (_ it) (-> (Meta it) (Meta (Try it)))) (function (_ lux) - (when (computation lux) - {try.#Success [lux' output]} - {try.#Success [lux' {try.#Success output}]} - - {try.#Failure error} - {try.#Success [lux {try.#Failure error}]}))) + {try.#Success (when (computation lux) + {try.#Success [lux' output]} + [lux' {try.#Success output}] -(with_template [<type> <name> <slot>] - [(def .public <name> - (Meta <type>) - (function (_ lux) - {try.#Success [lux - (the [.#info <slot>] lux)]}))] - - [Text target .#target] - [Text version .#version] - [(List [Text Text]) configuration .#configuration] - ) + {try.#Failure error} + [lux {try.#Failure error}])})) diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux index 519224bb7..b30769ba6 100644 --- a/stdlib/source/library/lux/meta/compiler/default/init.lux +++ b/stdlib/source/library/lux/meta/compiler/default/init.lux @@ -64,13 +64,15 @@ (-> extension.Extender Lux (///generation.Phase anchor expression declaration)) (///generation.Bundle anchor expression declaration) (///declaration.State+ anchor expression declaration))) - (let [synthesis_state [synthesisE.bundle ///synthesis.init] - generation_state [generation_bundle (///generation.state host module)] + (let [synthesis_state [extension.#bundle synthesisE.bundle + extension.#state ///synthesis.init] + generation_state [extension.#bundle generation_bundle + extension.#state (///generation.state host module)] lux (///analysis.state (///analysis.info version.latest target configuration)) analysis_phase (analysisP.phase extender expander) eval (///analysis/evaluation.evaluator analysis_phase - [synthesis_state (synthesisP.phase extender lux)] - [generation_state (generate extender lux)]) + [synthesis_state (synthesisP.phase extender)] + [generation_state (generate extender)]) analysis_state [(analysisE.bundle eval host_analysis) lux]] [extension.empty @@ -124,6 +126,33 @@ [(///generation.Buffer declaration) Registry]) +(def (with_generation_defaults module) + (-> Text + (Operation Any)) + (do [! ///phase.monad] + [state ///phase.state + _ (|> state + (the [extension.#state ///declaration.#generation ///declaration.#state extension.#bundle]) + dictionary.entries + (monad.each ! + (function (_ [name handler]) + (///declaration.lifted_analysis + (moduleA.define name {.#Default [true .Generation handler]})))))] + (in []))) + +(def (with_defaults module) + (-> Text + (Operation Any)) + (when module + .prelude + (do ///phase.monad + [] + (with_generation_defaults module)) + + _ + (with ///phase.monad + (in [])))) + (def (begin dependencies hash input) (-> (List descriptor.Module) Nat ///.Input (All (_ anchor expression declaration) @@ -131,11 +160,13 @@ [Source (Payload declaration)]))) (do ///phase.monad [.let [module (the ///.#module input)] - _ (///declaration.set_current_module module)] + _ (///declaration.set_current_module module) + _ (///declaration.lifted_analysis + (moduleA.create hash module)) + _ (with_defaults module)] (///declaration.lifted_analysis (do [! ///phase.monad] - [_ (moduleA.create hash module) - _ (monad.each ! moduleA.import dependencies) + [_ (monad.each ! moduleA.import dependencies) .let [source (///analysis.source (the ///.#module input) (the ///.#code input))] _ (///analysis.set_source_code source)] (in [source [///generation.empty_buffer diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux index 5608be3b2..eecc1ed00 100644 --- a/stdlib/source/library/lux/meta/compiler/default/platform.lux +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -743,6 +743,34 @@ {try.#Failure error} <cache_and_fail>))))))) + (def (complete_lux_compilation context platform + all_dependencies + @module module entry + archive state) + (All (_ <type_vars>) + (-> context.Context <Platform> + (Set descriptor.Module) + module.ID Text (archive.Entry Any) + Archive <State+> + (Return <State+>))) + (do ..monad + [_ (let [report (..module_compilation_log module state)] + (with_expansions [<else> (in (debug.log! report))] + (for @.js (is (Async (Try Any)) + (when console.default + {.#None} + <else> + + {.#Some console} + (console.write_line report console))) + <else>))) + .let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] + _ (..cache_module context platform @module $.key $.format (as (archive.Entry .Module) entry))] + (async#in (do try.monad + [archive (archive.has module entry archive)] + (in [archive + (..with_reset_log state)]))))) + (def (lux_compiler import context platform compilation_sources configuration compiler compilation) (All (_ <type_vars>) (-> Import context.Context <Platform> (List _io.Context) Configuration (///.Compiler <State+> .Module Any) @@ -772,23 +800,10 @@ (again [archive state] more all_dependencies) {.#Right entry} - (do ! - [_ (let [report (..module_compilation_log module state)] - (with_expansions [<else> (in (debug.log! report))] - (for @.js (is (Async (Try Any)) - (when console.default - {.#None} - <else> - - {.#Some console} - (console.write_line report console))) - <else>))) - .let [entry (has [archive.#module module.#descriptor descriptor.#references] all_dependencies entry)] - _ (..cache_module context platform @module $.key $.format (as (archive.Entry .Module) entry))] - (async#in (do try.monad - [archive (archive.has module entry archive)] - (in [archive - (..with_reset_log state)]))))) + (complete_lux_compilation context platform + all_dependencies + @module module entry + archive state)) {try.#Failure error} <cache_and_fail>))))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux.lux index 1176afc91..d8fd8a22e 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux.lux @@ -29,7 +29,8 @@ global (is (Format Global) (all _.or definition - alias))] + alias + definition))] (all _.and ... #module_hash _.nat @@ -56,7 +57,8 @@ global (is (Parser Global) (all <binary>.or definition - alias))] + alias + definition))] (all <>.and ... #module_hash <binary>.nat diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux index c89ce3db1..5327bb81a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/evaluation.lux @@ -46,9 +46,9 @@ (All (_ anchor expression artifact) (-> //.Phase [synthesis.State+ - synthesis.Phase] + (-> Lux synthesis.Phase)] [(generation.State+ anchor expression artifact) - (generation.Phase anchor expression artifact)] + (-> Lux (generation.Phase anchor expression artifact))] Eval)) (function (eval archive type exprC) (do phase.monad @@ -56,16 +56,18 @@ //scope.reset (analysis archive exprC)) module (extensionP.lifted - meta.current_module_name)] + meta.current_module_name) + lux (extensionP.lifted + meta.compiler_state)] (<| phase.lifted (do try.monad [exprS (|> exprA - (synthesis archive) + (synthesis lux archive) (phase.result synthesis_state))]) (phase.result generation_state) (do phase.monad [@module (sharing [anchor expression artifact] - (is (generation.Phase anchor expression artifact) + (is (-> Lux (generation.Phase anchor expression artifact)) generation) (is (generation.Operation anchor expression artifact module.ID) (generation.module_id module archive))) @@ -75,5 +77,5 @@ ("lux i64 left-shift" 16) ("lux i64 or" @eval) ("lux i64 left-shift" 32))) - (generation archive exprS))] + (generation lux archive exprS))] (generation.evaluate! [@module @eval] [{.#None} exprO])))))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux index a88649369..363c97fe5 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux @@ -117,12 +117,11 @@ .let [analysis (the [//extension.#state /.#analysis /.#phase] state) compiler_eval (meta_eval archive (the [//extension.#state /.#analysis /.#state //extension.#bundle] state) - (let [analysis_state (the [//extension.#state /.#analysis /.#state //extension.#state] state)] - (evaluation.evaluator analysis - [(the [//extension.#state /.#synthesis /.#state] state) - ((the [//extension.#state /.#synthesis /.#phase] state) analysis_state)] - [(the [//extension.#state /.#generation /.#state] state) - ((the [//extension.#state /.#generation /.#phase] state) analysis_state)]))) + (evaluation.evaluator analysis + [(the [//extension.#state /.#synthesis /.#state] state) + (the [//extension.#state /.#synthesis /.#phase] state)] + [(the [//extension.#state /.#generation /.#state] state) + (the [//extension.#state /.#generation /.#phase] state)])) extension_eval (as Eval (wrapper (as_expected compiler_eval)))] _ (//.with (has [//extension.#state /.#analysis /.#state //extension.#state .#eval] extension_eval state))] (when code diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux index aa15450d3..7a6c27ad8 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux @@ -139,8 +139,8 @@ {try.#Success [[bundle' state'] output]} {try.#Success [[bundle' (set old state')] output]} - {try.#Failure error} - {try.#Failure error}))))) + failure + failure))))) (def .public (temporary transform) (All (_ s i o v) @@ -152,8 +152,8 @@ {try.#Success [[bundle' state'] output]} {try.#Success [[bundle' state] output]} - {try.#Failure error} - {try.#Failure error})))) + failure + failure)))) (def .public (with_state state) (All (_ s i o v) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux index 79e514a76..f59e344ac 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Type Module Primitive Analysis Declaration char int type) + [lux (.except Type Module Primitive Analysis Declaration #Default char int type) ["[0]" ffi (.only import)] [abstract ["[0]" monad (.only do)]] @@ -36,8 +36,8 @@ ["[0]" template]] [target ["[0]" jvm - ["[0]!" reflection] ["_" bytecode (.only Bytecode) (.use "[1]#[0]" monad)] + ["[0]!" reflection] ["[0]" modifier (.only Modifier) (.use "[1]#[0]" monoid)] ["[0]" attribute] ["[0]" field] @@ -465,7 +465,7 @@ ..reflection) (list)}) (analyse archive arrayC))] - (in {/////analysis.#Extension ["" extension_name] (list arrayA)})) + (in {/////analysis.#Extension [.prelude extension_name] (list arrayA)})) _ (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) @@ -486,8 +486,8 @@ :read: (typeA.check (check.clean (list) :read:)) :write: (typeA.check (check.clean (list) :write:)) arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:)))] - (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text (..signature arrayJT)) - arrayA)}))) + (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text (..signature arrayJT)) + arrayA)}))) _ (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) @@ -502,7 +502,7 @@ (analyse archive lengthC)) _ (typeA.inference {.#Primitive (|> (jvm.array primitive_type) ..reflection) (list)})] - (in {/////analysis.#Extension ["" extension_name] (list lengthA)})) + (in {/////analysis.#Extension [.prelude extension_name] (list lengthA)})) _ (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) @@ -523,8 +523,8 @@ {.#None} (/////analysis.except ..non_array expectedT))] - (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text (..signature elementJT)) - lengthA)})) + (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text (..signature elementJT)) + lengthA)})) _ (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) @@ -703,7 +703,7 @@ arrayA (<| (typeA.expecting {.#Primitive (|> (jvm.array jvm_type) ..reflection) (list)}) (analyse archive arrayC))] - (in {/////analysis.#Extension ["" extension_name] (list idxA arrayA)})) + (in {/////analysis.#Extension [.prelude extension_name] (list idxA arrayA)})) _ (/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) @@ -726,9 +726,9 @@ :read: (typeA.check (check.clean (list) :read:)) :write: (typeA.check (check.clean (list) :write:)) arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:)))] - (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text (..signature arrayJT)) - idxA - arrayA)}))) + (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text (..signature arrayJT)) + idxA + arrayA)}))) _ (/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) @@ -748,9 +748,9 @@ (analyse archive valueC)) arrayA (<| (typeA.expecting array_type) (analyse archive arrayC))] - (in {/////analysis.#Extension ["" extension_name] (list idxA - valueA - arrayA)})) + (in {/////analysis.#Extension [.prelude extension_name] (list idxA + valueA + arrayA)})) _ (/////analysis.except ///.incorrect_arity [extension_name 3 (list.size args)]))))) @@ -775,10 +775,10 @@ :read: (typeA.check (check.clean (list) :read:)) :write: (typeA.check (check.clean (list) :write:)) arrayJT (jvm_array_type (.type_literal (array.Array' :read: :write:)))] - (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text (..signature arrayJT)) - idxA - valueA - arrayA)}))) + (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text (..signature arrayJT)) + idxA + valueA + arrayA)}))) _ (/////analysis.except ///.incorrect_arity [extension_name 3 (list.size args)])))) @@ -842,7 +842,7 @@ [expectedT (///.lifted meta.expected_type) [_ :object:] (check_object expectedT) _ (typeA.inference :object:)] - (in {/////analysis.#Extension ["" extension_name] (list)})) + (in {/////analysis.#Extension [.prelude extension_name] (list)})) _ (/////analysis.except ///.incorrect_arity [extension_name 0 (list.size args)])))) @@ -857,7 +857,7 @@ [objectT objectA] (typeA.inferring (analyse archive objectC)) _ (check_object objectT)] - (in {/////analysis.#Extension ["" extension_name] (list objectA)})) + (in {/////analysis.#Extension [.prelude extension_name] (list objectA)})) _ (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) @@ -872,7 +872,7 @@ (analyse archive monitorC)) _ (check_object monitorT) exprA (analyse archive exprC)] - (in {/////analysis.#Extension ["" extension_name] (list monitorA exprA)})) + (in {/////analysis.#Extension [.prelude extension_name] (list monitorA exprA)})) _ (/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) @@ -892,7 +892,7 @@ (if ? (in []) (/////analysis.except non_throwable exception_class)))] - (in {/////analysis.#Extension ["" extension_name] (list exceptionA)})) + (in {/////analysis.#Extension [.prelude extension_name] (list exceptionA)})) _ (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) @@ -908,7 +908,7 @@ [_ (..ensure_fresh_class! class_loader class) _ (typeA.inference {.#Primitive "java.lang.Class" (list {.#Primitive class (list)})}) _ (phase.lifted (reflection!.load class_loader class))] - (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text class))})) + (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text class))})) _ (/////analysis.except ///.invalid_syntax [extension_name %.code args])) @@ -929,7 +929,7 @@ [object_class _] (check_object objectT) ? (phase.lifted (reflection!.sub? class_loader object_class sub_class))] (if ? - (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text sub_class) objectA)}) + (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text sub_class) objectA)}) (/////analysis.except cannot_possibly_be_an_instance (format sub_class " !<= " object_class)))))])) (def (class_candidate_parents class_loader from_name fromT to_name to_class) @@ -1018,9 +1018,9 @@ _ false)))))))] (if can_cast? - (in {/////analysis.#Extension ["" extension_name] (list (/////analysis.text from_name) - (/////analysis.text to_name) - fromA)}) + (in {/////analysis.#Extension [.prelude extension_name] (list (/////analysis.text from_name) + (/////analysis.text to_name) + fromA)}) (/////analysis.except ..cannot_cast [fromJT toJT fromC]))) _ @@ -1054,7 +1054,7 @@ (not deprecated?)) fieldT (reflection_type luxT.fresh fieldJT) _ (typeA.inference fieldT)] - (in (<| {/////analysis.#Extension ["" extension_name]} + (in (<| {/////analysis.#Extension [.prelude extension_name]} (list (/////analysis.text class) (/////analysis.text field) (/////analysis.text (..signature fieldJT)))))))])) @@ -1078,7 +1078,7 @@ fieldT (reflection_type luxT.fresh fieldJT) valueA (<| (typeA.expecting fieldT) (analyse archive valueC))] - (in (<| {/////analysis.#Extension ["" extension_name]} + (in (<| {/////analysis.#Extension [.prelude extension_name]} (list (/////analysis.text class) (/////analysis.text field) (/////analysis.text (..signature fieldJT)) @@ -1103,7 +1103,7 @@ (not deprecated?)) fieldT (reflection_type mapping fieldJT) _ (typeA.inference fieldT)] - (in (<| {/////analysis.#Extension ["" extension_name]} + (in (<| {/////analysis.#Extension [.prelude extension_name]} (list (/////analysis.text class) (/////analysis.text field) (/////analysis.text (..signature fieldJT)) @@ -1132,7 +1132,7 @@ fieldT (reflection_type mapping fieldJT) valueA (<| (typeA.expecting fieldT) (analyse archive valueC))] - (in (<| {/////analysis.#Extension ["" extension_name]} + (in (<| {/////analysis.#Extension [.prelude extension_name]} (list (/////analysis.text class) (/////analysis.text field) (/////analysis.text (..signature fieldJT)) @@ -1518,10 +1518,10 @@ (not deprecated?)) [outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC)) outputJT (check_return outputT)] - (in {/////analysis.#Extension ["" extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list)))) - (/////analysis.text method) - (/////analysis.text (..signature outputJT)) - (decorate_inputs argsT argsA))})))])) + (in {/////analysis.#Extension [.prelude extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list)))) + (/////analysis.text method) + (/////analysis.text (..signature outputJT)) + (decorate_inputs argsT argsA))})))])) (def (invoke::virtual class_loader) (-> java/lang/ClassLoader Handler) @@ -1542,11 +1542,11 @@ _ (undefined))] outputJT (check_return outputT)] - (in {/////analysis.#Extension ["" extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list)))) - (/////analysis.text method) - (/////analysis.text (..signature outputJT)) - objectA - (decorate_inputs argsT argsA))})))])) + (in {/////analysis.#Extension [.prelude extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list)))) + (/////analysis.text method) + (/////analysis.text (..signature outputJT)) + objectA + (decorate_inputs argsT argsA))})))])) (def (invoke::special class_loader) (-> java/lang/ClassLoader Handler) @@ -1567,11 +1567,11 @@ _ (undefined))] outputJT (check_return outputT)] - (in {/////analysis.#Extension ["" extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list)))) - (/////analysis.text method) - (/////analysis.text (..signature outputJT)) - objectA - (decorate_inputs argsT argsA))})))])) + (in {/////analysis.#Extension [.prelude extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list)))) + (/////analysis.text method) + (/////analysis.text (..signature outputJT)) + objectA + (decorate_inputs argsT argsA))})))])) (def (invoke::interface class_loader) (-> java/lang/ClassLoader Handler) @@ -1595,7 +1595,7 @@ _ (undefined))] outputJT (check_return outputT)] - (in {/////analysis.#Extension ["" extension_name] + (in {/////analysis.#Extension [.prelude extension_name] (list.partial (/////analysis.text (..signature (jvm.class class_name (list)))) (/////analysis.text method) (/////analysis.text (..signature outputJT)) @@ -1614,8 +1614,8 @@ _ (phase.assertion ..deprecated_method [class ..constructor_method methodT] (not deprecated?)) [outputT argsA] (inference.general archive analyse methodT (list#each product.right argsTC))] - (in {/////analysis.#Extension ["" extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list)))) - (decorate_inputs argsT argsA))})))])) + (in {/////analysis.#Extension [.prelude extension_name] (list.partial (/////analysis.text (..signature (jvm.class class (list)))) + (decorate_inputs argsT argsA))})))])) (def (bundle::member class_loader) (-> java/lang/ClassLoader Bundle) @@ -2709,7 +2709,7 @@ .let [supers {.#Item super_class super_interfaces}] _ (..require_complete_method_concretion class_loader supers methods) methodsA (monad.each ! (analyse_overriden_method analyse archive selfT mapping supers) methods)] - (in {/////analysis.#Extension ["" extension_name] + (in {/////analysis.#Extension [.prelude extension_name] (list (class_analysis super_class) (/////analysis.tuple (list#each class_analysis super_interfaces)) (/////analysis.tuple (list#each typed_analysis constructor_argsA+)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux index b80344bc1..f311c48ec 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux @@ -65,7 +65,7 @@ (<| (typeA.expecting argT) (analyse archive argC))) (list.zipped_2 inputsT+ args))] - (in {analysis.#Extension ["" extension_name] argsA})) + (in {analysis.#Extension [.prelude extension_name] argsA})) (analysis.except ///.incorrect_arity [extension_name num_expected num_actual])))))) (def .public (nullary valueT) @@ -125,7 +125,7 @@ (list (analysis.tuple (list#each (|>> analysis.nat) cases)) branch)))) (list.partial input else) - {analysis.#Extension ["" extension_name]}))))]))) + {analysis.#Extension [.prelude extension_name]}))))]))) ... "lux is" represents reference/pointer equality. (def lux::is @@ -150,7 +150,7 @@ (|> opC (analyse archive) (typeA.expecting (type_literal (-> .Any :var:))) - (at ! each (|>> list {analysis.#Extension ["" extension_name]}))))) + (at ! each (|>> list {analysis.#Extension [.prelude extension_name]}))))) _ (analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux index 50054b9cb..caddd4c81 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux @@ -226,13 +226,11 @@ (-> /////analysis.Bundle (Operation anchor expression declaration Any))) (do phase.monad [[bundle state] phase.state - .let [analysis_state (the [/////declaration.#analysis /////declaration.#state ///.#state] state) - analysis_phase (the [/////declaration.#analysis /////declaration.#phase] state) - eval (/////analysis/evaluation.evaluator analysis_phase + .let [eval (/////analysis/evaluation.evaluator (the [/////declaration.#analysis /////declaration.#phase] state) [(the [/////declaration.#synthesis /////declaration.#state] state) - ((the [/////declaration.#synthesis /////declaration.#phase] state) analysis_state)] + (the [/////declaration.#synthesis /////declaration.#phase] state)] [(the [/////declaration.#generation /////declaration.#state] state) - ((the [/////declaration.#generation /////declaration.#phase] state) analysis_state)]) + (the [/////declaration.#generation /////declaration.#phase] state)]) previous_analysis_extensions (the [/////declaration.#analysis /////declaration.#state ///.#bundle] state)]] (phase.with [bundle (revised [/////declaration.#analysis /////declaration.#state] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux index fc45197f5..b31d36e9b 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux @@ -24,7 +24,7 @@ [dependency ["[1]/[0]" artifact]]]]]]]] ["[0]" / - [runtime (.only Operation Phase)] + [runtime (.only Operation Phase Handler)] ["[1][0]" primitive] ["[1][0]" structure] ["[1][0]" reference] @@ -46,79 +46,98 @@ ["Expected" (%.type expected)] ["Actual" (%.type actual)]))) +(exception.def .public (extension_error error) + (Exception Text) + error) + (def (extension_application extender lux phase archive name parameters) (-> extension.Extender Lux - (-> extension.Extender Lux Phase) Archive + Phase Archive Symbol (List Synthesis) (Operation (Bytecode Any))) - (when (|> name - meta.export + (when (|> (do [! meta.monad] + [definition (meta.try (meta.export name))] + (when definition + {try.#Success [exported? type definition]} + (in [exported? type {.#Left definition}]) + + {try.#Failure error} + (do ! + [[exported? type default] (meta.default name)] + (in [exported? type {.#Right default}])))) + (is (Meta [Bit Type (Either Any Any)])) (meta.result lux)) {try.#Success [exported? type value]} (if (check.subsumes? .Generation type) - ((extender value) "" (phase extender lux) archive parameters) + (when value + {.#Left definition} + ((extender definition) "" phase archive parameters) + + {.#Right default} + ((as Handler default) "" phase archive parameters)) (///.except ..not_an_extension [name .Generation type])) {try.#Failure error} - (///.failure error))) + (///.except ..extension_error [error]))) -(def .public (generate extender lux archive synthesis) +(def .public (generate extender lux) (-> extension.Extender Lux Phase) - (when synthesis - (^.with_template [<tag> <generator>] - [(<tag> value) - (///#in (<generator> value))]) - ([synthesis.bit /primitive.bit] - [synthesis.i64 /primitive.i64] - [synthesis.f64 /primitive.f64] - [synthesis.text /primitive.text]) + (function (phase archive synthesis) + (when synthesis + (^.with_template [<tag> <generator>] + [(<tag> value) + (///#in (<generator> value))]) + ([synthesis.bit /primitive.bit] + [synthesis.i64 /primitive.i64] + [synthesis.f64 /primitive.f64] + [synthesis.text /primitive.text]) - (synthesis.variant variantS) - (/structure.variant (generate extender lux) archive variantS) + (synthesis.variant variantS) + (/structure.variant phase archive variantS) - (synthesis.tuple members) - (/structure.tuple (generate extender lux) archive members) + (synthesis.tuple members) + (/structure.tuple phase archive members) - {synthesis.#Reference reference} - (when reference - {reference.#Variable variable} - (/reference.variable archive variable) - - {reference.#Constant constant} - (/reference.constant archive constant)) + {synthesis.#Reference reference} + (when reference + {reference.#Variable variable} + (/reference.variable archive variable) + + {reference.#Constant constant} + (/reference.constant archive constant)) - (synthesis.branch/when [valueS pathS]) - (/when.when (generate extender lux) archive [valueS pathS]) + (synthesis.branch/when [valueS pathS]) + (/when.when phase archive [valueS pathS]) - (synthesis.branch/exec [this that]) - (/when.exec (generate extender lux) archive [this that]) + (synthesis.branch/exec [this that]) + (/when.exec phase archive [this that]) - (synthesis.branch/let [inputS register bodyS]) - (/when.let (generate extender lux) archive [inputS register bodyS]) + (synthesis.branch/let [inputS register bodyS]) + (/when.let phase archive [inputS register bodyS]) - (synthesis.branch/if [conditionS thenS elseS]) - (/when.if (generate extender lux) archive [conditionS thenS elseS]) + (synthesis.branch/if [conditionS thenS elseS]) + (/when.if phase archive [conditionS thenS elseS]) - (synthesis.branch/get [path recordS]) - (/when.get (generate extender lux) archive [path recordS]) + (synthesis.branch/get [path recordS]) + (/when.get phase archive [path recordS]) - (synthesis.loop/scope scope) - (/loop.scope (generate extender lux) archive scope) + (synthesis.loop/scope scope) + (/loop.scope phase archive scope) - (synthesis.loop/again updates) - (/loop.again (generate extender lux) archive updates) + (synthesis.loop/again updates) + (/loop.again phase archive updates) - (synthesis.function/abstraction abstraction) - (/function.abstraction (generate extender lux) archive abstraction) + (synthesis.function/abstraction abstraction) + (/function.abstraction phase archive abstraction) - (synthesis.function/apply application) - (/function.apply (generate extender lux) archive application) + (synthesis.function/apply application) + (/function.apply phase archive application) - {synthesis.#Extension [["" name] parameters]} - (extension.apply archive (generate extender lux) [name parameters]) + {synthesis.#Extension [["" name] parameters]} + (extension.apply archive phase [name parameters]) - {synthesis.#Extension [name parameters]} - (extension_application extender lux generate archive name parameters) - )) + {synthesis.#Extension [name parameters]} + (extension_application extender lux phase archive name parameters) + ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux index 1e5562447..539c17856 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux @@ -25,7 +25,7 @@ ["/[1]" // ["[1][0]" extension] ["/[1]" // - ["/" synthesis (.only Synthesis Operation Phase Extender) + ["/" synthesis (.only Synthesis Operation Phase Extender Handler) ["[1][0]" simple]] ["[1][0]" analysis (.only Analysis) ["[2][0]" simple] @@ -68,23 +68,42 @@ phase archive name parameters) (-> Extender Lux - (-> Extender Lux Phase) Archive + Phase Archive Symbol (List Analysis) (Operation Synthesis)) - (when (|> name - meta.export + (when (|> (do [! meta.monad] + [definition (meta.try (meta.export name))] + (when definition + {try.#Success [exported? type definition]} + (in [exported? type {.#Left definition}]) + + {try.#Failure error} + (do ! + [[exported? type default] (meta.default name)] + (in [exported? type {.#Right default}])))) + (is (Meta [Bit Type (Either Any Any)])) (meta.result lux)) {try.#Success [exported? type value]} (if (check.subsumes? .Synthesis type) - ((extender value) "" (phase extender lux) archive parameters) - (phase.except ..not_an_extension [name .Synthesis type])) + (when value + {.#Left definition} + ((extender definition) "" phase archive parameters) + + {.#Right default} + ((as Handler default) "" phase archive parameters)) + ... (phase.except ..not_an_extension [name .Synthesis type]) + (|> parameters + (monad.each phase.monad (phase archive)) + (phase#each (|>> [name] {/.#Extension})))) {try.#Failure error} - (phase.failure error))) + (|> parameters + (monad.each phase.monad (phase archive)) + (phase#each (|>> [name] {/.#Extension}))))) -(def (optimization phase extender lux archive) - (-> Phase Extender Lux Phase) - (function (optimization' analysis) +(def (optimization extender lux) + (-> Extender Lux Phase) + (function (phase archive analysis) (when analysis {///analysis.#Simple analysis'} (phase#in {/.#Simple (..simple analysis')}) @@ -96,38 +115,39 @@ (/.with_currying? false (when structure {///complex.#Variant variant} - (do phase.monad - [valueS (optimization' (the ///complex.#value variant))] - (in (/.variant (has ///complex.#value valueS variant)))) + (phase#each + (function (_ valueS) + (/.variant (has ///complex.#value valueS variant))) + (phase archive (the ///complex.#value variant))) {///complex.#Tuple tuple} (|> tuple - (monad.each phase.monad optimization') + (monad.each phase.monad (phase archive)) (phase#each (|>> /.tuple))))) {///analysis.#When inputA branchesAB+} (/.with_currying? false - (/when.synthesize (optimization phase extender lux) branchesAB+ archive inputA)) + (/when.synthesize phase branchesAB+ archive inputA)) (///analysis.no_op value) - (optimization' value) + (phase archive value) {///analysis.#Apply _} (/.with_currying? false - (/function.apply (optimization phase extender lux) archive analysis)) + (/function.apply phase archive analysis)) {///analysis.#Function environmentA bodyA} - (/function.abstraction (optimization phase extender lux) environmentA archive bodyA) + (/function.abstraction phase environmentA archive bodyA) {///analysis.#Extension ["" name] args} (/.with_currying? false (function (_ state) - (|> (//extension.apply archive (optimization phase extender lux) [name args]) + (|> (//extension.apply archive phase [name args]) (phase.result' state) (pipe.when {try.#Failure _} (|> args - (monad.each phase.monad optimization') + (monad.each phase.monad (phase archive)) (phase#each (|>> [["" name]] {/.#Extension})) (phase.result' state)) @@ -136,13 +156,12 @@ {///analysis.#Extension name parameters} (extension_application extender lux - (optimization phase) archive + phase archive name parameters) ))) -(def .public (phase extender lux) +(def .public (phase extender lux archive analysis) (-> Extender Lux Phase) - (function (phase archive analysis) - (do phase.monad - [synthesis (..optimization phase extender lux archive analysis)] - (phase.lifted (/variable.optimization synthesis))))) + (do phase.monad + [synthesis (..optimization extender lux archive analysis)] + (phase.lifted (/variable.optimization synthesis)))) diff --git a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux index 1d1aaca4b..71f055c64 100644 --- a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux @@ -16,7 +16,7 @@ ["%" \\format (.only format)]] [collection [set (.only Set)] - ["[0]" list (.use "[1]#[0]" mix)] + ["[0]" list (.use "[1]#[0]" mix monad)] ["[0]" dictionary (.only Dictionary)] ["[0]" sequence (.only Sequence)]]] [meta @@ -222,7 +222,7 @@ definitions (monad.each ! (function (_ [def_name def_global]) (when def_global {.#Alias payload} - (in [def_name def_global]) + (in (list [def_name def_global])) {.#Definition [exported? type _]} (|> definitions @@ -230,9 +230,13 @@ try.of_maybe (at ! each (|>> [exported? type] {.#Definition} - [def_name]))))) + [def_name] + (list)))) + + {.#Default [exported? type _]} + (in (list)))) (the .#definitions content))] - (in [(document.document $.key (has .#definitions definitions content)) + (in [(document.document $.key (has .#definitions (list#conjoint definitions) content)) bundles]))) (def (load_definitions fs context @module host_environment entry) |