diff options
Diffstat (limited to '')
43 files changed, 565 insertions, 721 deletions
diff --git a/stdlib/source/documentation/lux/meta/compiler/language/lux/analysis.lux b/stdlib/source/documentation/lux/meta/compiler/language/lux/analysis.lux index 766e1740f..bb478f3e9 100644 --- a/stdlib/source/documentation/lux/meta/compiler/language/lux/analysis.lux +++ b/stdlib/source/documentation/lux/meta/compiler/language/lux/analysis.lux @@ -88,7 +88,7 @@ ($.definition /.variant) ($.definition /.tuple) ($.definition /.format) - ($.definition /.State+) + ($.definition /.State) ($.definition /.Operation) ($.definition /.Phase) ($.definition /.Handler) diff --git a/stdlib/source/documentation/lux/meta/compiler/language/lux/declaration.lux b/stdlib/source/documentation/lux/meta/compiler/language/lux/declaration.lux index f50268496..2b906d759 100644 --- a/stdlib/source/documentation/lux/meta/compiler/language/lux/declaration.lux +++ b/stdlib/source/documentation/lux/meta/compiler/language/lux/declaration.lux @@ -21,7 +21,7 @@ ($.definition /.Requirements) ($.definition /.no_requirements) ($.definition /.merge_requirements) - ($.definition /.State+) + ($.definition /.State) ($.definition /.Operation) ($.definition /.Phase) ($.definition /.Handler) diff --git a/stdlib/source/documentation/lux/meta/compiler/language/lux/generation.lux b/stdlib/source/documentation/lux/meta/compiler/language/lux/generation.lux index 28c844658..990029dd0 100644 --- a/stdlib/source/documentation/lux/meta/compiler/language/lux/generation.lux +++ b/stdlib/source/documentation/lux/meta/compiler/language/lux/generation.lux @@ -21,7 +21,7 @@ ($.definition /.no_buffer_for_saving_code) ($.definition /.Host) ($.definition /.State) - ($.definition /.State+) + ($.definition /.State) ($.definition /.Operation) ($.definition /.Phase) ($.definition /.Handler) diff --git a/stdlib/source/documentation/lux/meta/compiler/language/lux/synthesis.lux b/stdlib/source/documentation/lux/meta/compiler/language/lux/synthesis.lux index 8b14adb0e..1ecf3f88b 100644 --- a/stdlib/source/documentation/lux/meta/compiler/language/lux/synthesis.lux +++ b/stdlib/source/documentation/lux/meta/compiler/language/lux/synthesis.lux @@ -127,7 +127,7 @@ ($.definition /.Function) ($.definition /.Control) ($.definition /.Synthesis) - ($.definition /.State+) + ($.definition /.State) ($.definition /.Operation) ($.definition /.Phase) ($.definition /.Handler) diff --git a/stdlib/source/experiment/tool/interpreter.lux b/stdlib/source/experiment/tool/interpreter.lux index 55064903b..53fe60a88 100644 --- a/stdlib/source/experiment/tool/interpreter.lux +++ b/stdlib/source/experiment/tool/interpreter.lux @@ -16,9 +16,8 @@ ["[0]" module] ["[0]" type]] ["[0]" generation] - ["[0]" declaration (.only State+ Operation) - ["[0]" total]] - ["[0]" extension]] + ["[0]" declaration (.only State Operation) + ["[0]" total]]] ["[0]" default ["[0]" syntax] ["[0]" platform (.only Platform)] @@ -72,14 +71,12 @@ (Console !) (Platform ! anchor expression declaration) Configuration (generation.Bundle anchor expression declaration) - (! (State+ anchor expression declaration)))) + (! (State anchor expression declaration)))) (do Monad<!> [state (platform.initialize platform generation_bundle) state (platform.compile platform (has cli.#module syntax.prelude configuration) - (has [extension.#state - declaration.#analysis declaration.#state - extension.#state + (has [declaration.#analysis declaration.#state .#info .#mode] {.#Interpreter} state)) @@ -102,7 +99,7 @@ (All (_ anchor expression declaration) (-> Code <Interpretation>)) (do [! phase.monad] - [state (extension.lifted phase.state) + [state phase.state .let [analyse (the [declaration.#analysis declaration.#phase] state) synthesize (the [declaration.#synthesis declaration.#phase] state) generate (the [declaration.#generation declaration.#phase] state)] @@ -131,7 +128,7 @@ (function (_ state) (when (<| (phase.result' state) (sharing [anchor expression declaration] - (is (State+ anchor expression declaration) + (is (State anchor expression declaration) state) (is <Interpretation> (interpret_declaration code)))) @@ -142,7 +139,7 @@ (if (ex.match? total.not_a_declaration error) (<| (phase.result' state) (sharing [anchor expression declaration] - (is (State+ anchor expression declaration) + (is (State anchor expression declaration) state) (is <Interpretation> (interpret_expression code)))) @@ -155,17 +152,14 @@ (do phase.monad [[codeT codeV] (interpret configuration code) state phase.state] - (in (/type.represent (the [extension.#state - declaration.#analysis declaration.#state - extension.#state] - state) + (in (/type.represent (the [declaration.#analysis declaration.#state] state) codeT codeV)))) (type (Context anchor expression declaration) (Record [#configuration Configuration - #state (State+ anchor expression declaration) + #state (State anchor expression declaration) #source Source])) (with_expansions [<Context> (these (Context anchor expression declaration))] @@ -179,7 +173,7 @@ state (sharing [anchor expression declaration] (is <Context> context) - (is (State+ anchor expression declaration) + (is (State anchor expression declaration) (the #state context)))] (<| (phase.result' state) ... TODO: Simplify ASAP diff --git a/stdlib/source/library/lux/math.lux b/stdlib/source/library/lux/math.lux index f5b4ec12a..063593890 100644 --- a/stdlib/source/library/lux/math.lux +++ b/stdlib/source/library/lux/math.lux @@ -70,7 +70,7 @@ [(with_expansions [<scenarios> (template.spliced <scenarios>')] (these (def .public <name> .Analysis - (analysis (_ self phase archive [operands (<>.some <code>.any)]) + (analysis (_ phase archive [operands (<>.some <code>.any)]) (<| type.with_var (function (_ [$it :it:])) (do [! phase.monad] @@ -137,8 +137,8 @@ [(with_expansions [<scenarios> (template.spliced <scenarios>')] (these (def .public <name> .Analysis - (analysis (_ self phase archive [left <code>.any - right <code>.any]) + (analysis (_ phase archive [left <code>.any + right <code>.any]) (<| type.with_var (function (_ [$it :it:])) (do [! phase.monad] @@ -189,8 +189,8 @@ [(with_expansions [<scenarios> (template.spliced <scenarios>')] (these (def .public <name> .Analysis - (analysis (_ self phase archive [left <code>.any - right <code>.any]) + (analysis (_ phase archive [left <code>.any + right <code>.any]) (<| type.with_var (function (_ [$it :it:])) (do [! phase.monad] diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux index 3ec4e3632..6f9051947 100644 --- a/stdlib/source/library/lux/meta/compiler/default/init.lux +++ b/stdlib/source/library/lux/meta/compiler/default/init.lux @@ -60,7 +60,7 @@ extension.Extender Expander (///generation.Host expression declaration) (-> extension.Extender Lux (///generation.Phase anchor expression declaration)) - (///declaration.State+ anchor expression declaration))) + (///declaration.State anchor expression declaration))) (let [lux (///analysis.state (///analysis.info version.latest target configuration))] [///declaration.#analysis [///declaration.#state lux ///declaration.#phase (analysisP.phase extender expander)] @@ -187,7 +187,6 @@ (moduleA.set_compiled module)) analysis_module (<| (is (Operation .Module)) ///declaration.lifted_analysis - extension.lifted meta.current_module) final_buffer (///declaration.lifted_generation ///generation.buffer) @@ -288,7 +287,7 @@ ///phase.Wrapper (Extender <parameters>) Expander descriptor.Module (-> declaration Binary) descriptor.Module (Maybe Text) (Extensions <parameters>) - (Instancer (///declaration.State+ <parameters>) .Module))) + (Instancer (///declaration.State <parameters>) .Module))) (let [execute! (declarationP.phase wrapper extender expander)] (function (_ key parameters input) (let [dependencies (default_dependencies prelude input)] @@ -344,7 +343,6 @@ (do [! ///phase.monad] [analysis_module (<| (is (Operation .Module)) ///declaration.lifted_analysis - extension.lifted meta.current_module) _ (///declaration.lifted_generation (///generation.set_buffer temporary_buffer)) diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux index 09d58919e..a9a8aaee0 100644 --- a/stdlib/source/library/lux/meta/compiler/default/platform.lux +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -93,7 +93,7 @@ (try.with async.monad))) (with_expansions [<Platform> (these (Platform <type_vars>)) - <State+> (these (///declaration.State+ <type_vars>))] + <State> (these (///declaration.State <type_vars>))] (def (format //) (All (_ a) @@ -190,10 +190,10 @@ (def (initialize_state analysis_state state) (All (_ <type_vars>) - (-> .Lux <State+> - (Try <State+>))) + (-> .Lux <State> + (Try <State>))) (|> (sharing [<type_vars>] - (is <State+> + (is <State> state) (is (///declaration.Operation <type_vars> Any) (do [! ///phase.monad] @@ -213,7 +213,7 @@ (Program expression declaration) extension.Extender Import (List _io.Context) Configuration - (Async (Try [<State+> Archive ///phase.Wrapper])))) + (Async (Try [<State> Archive ///phase.Wrapper])))) (do [! ..monad] [.let [phase_wrapper (the #phase_wrapper platform) state (//init.state (the context.#host context) @@ -228,7 +228,7 @@ [archive analysis_state bundles] (ioW.thaw (list) compilation_configuration (the #host platform) (the #file_system platform) context import compilation_sources) .let [with_missing_extensions (is (All (_ <type_vars>) - (-> <State+> (Async (Try <State+>)))) + (-> <State> (Async (Try <State>)))) (function (_ state) (|> state (initialize_state analysis_state) @@ -251,7 +251,7 @@ (def (module_compilation_log module) (All (_ <type_vars>) - (-> descriptor.Module <State+> Text)) + (-> descriptor.Module <State> Text)) (|>> (the [///declaration.#generation ///declaration.#state ///generation.#log]) @@ -261,7 +261,7 @@ (def with_reset_log (All (_ <type_vars>) - (-> <State+> <State+>)) + (-> <State> <State>)) (has [///declaration.#generation ///declaration.#state ///generation.#log] @@ -405,12 +405,12 @@ (type (Compiler state) (-> (List ///.Custom) descriptor.Module (Importer state) module.ID (Context state) descriptor.Module (Return state))) - (with_expansions [Lux_Context (..Context <State+>) - Lux_Return (..Return <State+>) - Lux_Signal (..Signal <State+>) - Lux_Pending (..Pending <State+>) - Lux_Importer (..Importer <State+>) - Lux_Compiler (..Compiler <State+>)] + (with_expansions [Lux_Context (..Context <State>) + Lux_Return (..Return <State>) + Lux_Signal (..Signal <State>) + Lux_Pending (..Pending <State>) + Lux_Importer (..Importer <State>) + Lux_Compiler (..Compiler <State>)] (def (parallel initial) (All (_ <type_vars>) (-> Lux_Context @@ -505,7 +505,7 @@ ... TODO: Find a better way, as this only works for the Lux compiler. (def (updated_state archive extended_states state) (All (_ <type_vars>) - (-> Archive (List <State+>) <State+> (Try <State+>))) + (-> Archive (List <State>) <State> (Try <State>))) (do [! try.monad] [modules (monad.each ! (function (_ module) (do ! @@ -519,7 +519,7 @@ (list#each product.left) (set.of_list text.hash)) with_modules (is (All (_ <type_vars>) - (-> <State+> <State+>)) + (-> <State> <State>)) (revised [///declaration.#analysis ///declaration.#state] (is (All (_ a) (-> a a)) @@ -537,7 +537,7 @@ (def (set_current_module module state) (All (_ <type_vars>) - (-> descriptor.Module <State+> <State+>)) + (-> descriptor.Module <State> <State>)) (|> (///declaration.set_current_module module) (///phase.result' state) try.trusted @@ -588,7 +588,7 @@ (def (after_lux_imports customs import! module duplicates new_dependencies [archive state]) (All (_ <type_vars>) (-> (List ///.Custom) Lux_Importer descriptor.Module (Set descriptor.Module) (List descriptor.Module) Lux_Context - (..Return [<State+> (List Text)]))) + (..Return [<State> (List Text)]))) (do ..monad [[archive state/* errors] (after_imports customs import! module duplicates new_dependencies archive)] (when errors @@ -607,9 +607,9 @@ (def (next_compilation module [archive state] compilation) (All (_ <type_vars>) - (-> descriptor.Module Lux_Context (///.Compilation <State+> .Module) - (Try [<State+> (Either (///.Compilation <State+> .Module) - (archive.Entry Any))]))) + (-> descriptor.Module Lux_Context (///.Compilation <State> .Module) + (Try [<State> (Either (///.Compilation <State> .Module) + (archive.Entry Any))]))) ((the ///.#process compilation) ... TODO: The "///declaration.set_current_module" below shouldn't be necessary. Remove it ASAP. ... TODO: The context shouldn't need to be re-set either. @@ -625,7 +625,7 @@ (-> (Program expression declaration) (-> Archive Symbol (///generation.Operation <type_vars> expression)) ///phase.Wrapper (Extender <type_vars>) Expander <Platform> Text (Maybe Module) (//init.Extensions <type_vars>) - (///.Compiler <State+> .Module))) + (///.Compiler <State> .Module))) (let [instancer (//init.compiler program global phase_wrapper extender expander syntax.prelude (the #write platform) program_module program_definition all_extensions)] (instancer $.key (list)))) @@ -634,7 +634,7 @@ compiler custom_key custom_format custom_compilation) (All (_ <type_vars> state document) - (-> Import context.Context <Platform> (List _io.Context) Configuration (///.Compiler <State+> .Module) + (-> Import context.Context <Platform> (List _io.Context) Configuration (///.Compiler <State> .Module) (Key document) (Format document) (///.Compilation state document) (-> (List ///.Custom) descriptor.Module Lux_Importer module.ID (..Context state) descriptor.Module (..Return state)))) (function (_ customs importer import! @module [archive state] module) @@ -679,8 +679,8 @@ (-> context.Context <Platform> (Set descriptor.Module) module.ID Text (archive.Entry Any) - Archive <State+> - (Return <State+>))) + Archive <State> + (Return <State>))) (do ..monad [_ (let [report (..module_compilation_log module state)] (with_expansions [<else> (in (debug.log! report))] @@ -701,8 +701,8 @@ (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) - (///.Compilation <State+> .Module) + (-> Import context.Context <Platform> (List _io.Context) Configuration (///.Compiler <State> .Module) + (///.Compilation <State> .Module) Lux_Compiler)) (function (_ customs importer import! @module [archive state] module) (loop (again [[archive state] [archive (..set_current_module module state)] @@ -747,7 +747,7 @@ (def (serial_compiler import context platform compilation_sources configuration compiler) (All (_ <type_vars>) - (-> Import context.Context <Platform> (List _io.Context) Configuration (///.Compiler <State+> .Module) + (-> Import context.Context <Platform> (List _io.Context) Configuration (///.Compiler <State> .Module) Lux_Compiler)) (function (_ all_customs importer import! @module [archive lux_state] module) (do [! ..monad] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux index c3a746cb1..406af1954 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux @@ -246,13 +246,19 @@ (%.format (%.symbol name) " ") (text.enclosed ["(" ")"])))) +(type .public State + Lux) + +(type .public Operation + (phase.Operation State)) + +(type .public Phase + (phase.Phase State Code Analysis)) + (with_template [<special> <general>] [(type .public <special> - (<general> .Lux Code Analysis))] + (<general> State Code Analysis))] - [State+ extension.State] - [Operation extension.Operation] - [Phase extension.Phase] [Handler extension.Handler] [Bundle extension.Bundle] [Extender extension.Extender] @@ -272,9 +278,9 @@ (def .public (with_current_module name) (All (_ a) (-> Text (Operation a) (Operation a))) - (extension.localized (the .#current_module) - (has .#current_module) - (function.constant {.#Some name}))) + (phase.localized (the .#current_module) + (has .#current_module) + (function.constant {.#Some name}))) (def .public (with_location location action) (All (_ a) (-> Location (Operation a) (Operation a))) @@ -339,7 +345,7 @@ (with_template [<name> <type> <field> <value>] [(def .public (<name> value) (-> <type> (Operation Any)) - (extension.update (has <field> <value>)))] + (phase.update (has <field> <value>)))] [set_source_code Source .#source value] [set_current_module Text .#current_module {.#Some value}] 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 03543aa35..2e80fdb66 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 @@ -24,7 +24,6 @@ [// [phase ["[0]P" analysis] - ["[0]" extension] [// ["[0]" synthesis] ["[0]" generation] @@ -46,9 +45,9 @@ [generation_state generation]) (All (_ anchor expression artifact) (-> //.Phase - [synthesis.State+ + [synthesis.State (-> Lux synthesis.Phase)] - [(generation.State+ anchor expression artifact) + [(generation.State anchor expression artifact) (-> Lux (generation.Phase anchor expression artifact))] Eval)) (function (eval archive type exprC) @@ -56,10 +55,8 @@ [exprA (<| (//type.expecting type) //scope.reset (analysis archive exprC)) - module (extension.lifted - meta.current_module_name) - lux (extension.lifted - meta.compiler_state)] + module meta.current_module_name + lux meta.compiler_state] (<| phase.lifted (do try.monad [exprS (|> exprA diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux index 8c4dc9032..6fa95812d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux @@ -16,8 +16,6 @@ ["[0]" property]]]]]] ["/" // (.only Operation) ["//[1]" // - [phase - ["[1][0]" extension]] [/// ["[1]" phase]]]]) @@ -59,88 +57,82 @@ (def .public (import module) (-> Text (Operation Any)) - (///extension.lifted - (do ///.monad - [self_name meta.current_module_name] - (function (_ state) - {try.#Success [(revised .#modules - (property.revised self_name (revised .#imports (function (_ current) - (if (list.any? (text#= module) - current) - current - {.#Item module current})))) - state) - []]})))) + (do ///.monad + [self_name meta.current_module_name] + (function (_ state) + {try.#Success [(revised .#modules + (property.revised self_name (revised .#imports (function (_ current) + (if (list.any? (text#= module) + current) + current + {.#Item module current})))) + state) + []]}))) (def .public (alias alias module) (-> Text Text (Operation Any)) - (///extension.lifted - (do ///.monad - [self_name meta.current_module_name] - (function (_ state) - {try.#Success [(revised .#modules - (property.revised self_name (revised .#module_aliases (is (-> (List [Text Text]) (List [Text Text])) - (|>> {.#Item [alias module]})))) - state) - []]})))) + (do ///.monad + [self_name meta.current_module_name] + (function (_ state) + {try.#Success [(revised .#modules + (property.revised self_name (revised .#module_aliases (is (-> (List [Text Text]) (List [Text Text])) + (|>> {.#Item [alias module]})))) + state) + []]}))) (def .public (exists? module) (-> Text (Operation Bit)) - (///extension.lifted - (function (_ state) - (|> state - (the .#modules) - (property.value module) - (pipe.when - {.#Some _} - true - - {.#None} - false) - [state] - {try.#Success})))) + (function (_ state) + (|> state + (the .#modules) + (property.value module) + (pipe.when + {.#Some _} + true + + {.#None} + false) + [state] + {try.#Success}))) (def .public (define name definition) (-> Text Global (Operation Any)) - (///extension.lifted - (do ///.monad - [self_name meta.current_module_name - self meta.current_module] - (function (_ state) - (when (property.value name (the .#definitions self)) - {.#None} - {try.#Success [(revised .#modules - (property.has self_name - (revised .#definitions - (is (-> (List [Text Global]) (List [Text Global])) - (|>> {.#Item [name definition]})) - self)) - state) - []]} - - {.#Some already_existing} - ((///extension.up (/.except ..cannot_define_more_than_once [[self_name name] already_existing])) - state)))))) + (do ///.monad + [self_name meta.current_module_name + self meta.current_module] + (function (_ state) + (when (property.value name (the .#definitions self)) + {.#None} + {try.#Success [(revised .#modules + (property.has self_name + (revised .#definitions + (is (-> (List [Text Global]) (List [Text Global])) + (|>> {.#Item [name definition]})) + self)) + state) + []]} + + {.#Some already_existing} + ((/.except ..cannot_define_more_than_once [[self_name name] already_existing]) + state))))) (def .public (override_definition [module short] definition) (-> Symbol Global (Operation Any)) - (///extension.lifted - (function (_ state) - {try.#Success [(revised .#modules - (property.revised module - (revised .#definitions - (property.has short definition))) - state) - []]}))) + (function (_ state) + {try.#Success [(revised .#modules + (property.revised module + (revised .#definitions + (property.has short definition))) + state) + []]})) (def .public (create hash name) (-> Nat Text (Operation Any)) - (///extension.lifted - (function (_ state) - {try.#Success [(revised .#modules - (property.has name (..empty hash)) - state) - []]}))) + (function (_ state) + {try.#Success [(revised .#modules + (property.has name (..empty hash)) + state) + []]})) (def .public (with hash name action) (All (_ a) (-> Nat Text (Operation a) (Operation [Module a]))) @@ -148,51 +140,49 @@ [_ (..create hash name) output (/.with_current_module name action) - module (///extension.lifted (meta.module name))] + module (meta.module name)] (in [module output]))) (with_template [<setter> <asker> <tag>] [(def .public (<setter> module_name) (-> Text (Operation Any)) - (///extension.lifted - (function (_ state) - (when (|> state (the .#modules) (property.value module_name)) - {.#Some module} - (let [active? (when (the .#module_state module) - {.#Active} - true - - _ - false)] - (if active? - {try.#Success [(revised .#modules - (property.has module_name (has .#module_state {<tag>} module)) - state) - []]} - ((///extension.up (/.except ..can_only_change_state_of_active_module [module_name {<tag>}])) - state))) + (function (_ state) + (when (|> state (the .#modules) (property.value module_name)) + {.#Some module} + (let [active? (when (the .#module_state module) + {.#Active} + true + + _ + false)] + (if active? + {try.#Success [(revised .#modules + (property.has module_name (has .#module_state {<tag>} module)) + state) + []]} + ((/.except ..can_only_change_state_of_active_module [module_name {<tag>}]) + state))) - {.#None} - ((///extension.up (/.except ..unknown_module module_name)) - state))))) + {.#None} + ((/.except ..unknown_module module_name) + state)))) (def .public (<asker> module_name) (-> Text (Operation Bit)) - (///extension.lifted - (function (_ state) - (when (|> state (the .#modules) (property.value module_name)) - {.#Some module} - {try.#Success [state - (when (the .#module_state module) - {<tag>} - true - - _ - false)]} + (function (_ state) + (when (|> state (the .#modules) (property.value module_name)) + {.#Some module} + {try.#Success [state + (when (the .#module_state module) + {<tag>} + true + + _ + false)]} - {.#None} - ((///extension.up (/.except ..unknown_module module_name)) - state)))))] + {.#None} + ((/.except ..unknown_module module_name) + state))))] [set_active active? .#Active] [set_compiled compiled? .#Compiled] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux index c262ad1b8..bdfa5b776 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux @@ -14,13 +14,10 @@ ["[0]" list (.use "[1]#[0]" functor mix monoid) ["[0]" property]]]]]] ["/" // (.only Environment Operation Phase) - [// - [phase - ["[0]" extension]] - [/// - ["[0]" phase] - [reference - ["[0]" variable (.only Register Variable)]]]]]) + [//// + ["[0]" phase] + [reference + ["[0]" variable (.only Register Variable)]]]]) (type Local (Bindings Text [Type Register])) @@ -77,33 +74,32 @@ (def .public (variable name) (-> Text (Operation (Maybe [Type Variable]))) - (extension.lifted - (function (_ state) - (let [[inner outer] (|> state - (the .#scopes) - (list.split_when (|>> (reference? name))))] - (when outer - {.#End} - {.#Right [state {.#None}]} - - {.#Item top_outer _} - (let [[ref_type init_ref] (maybe.else (undefined) - (..reference name top_outer)) - [ref inner'] (list#mix (is (-> Scope [Variable (List Scope)] [Variable (List Scope)]) - (function (_ scope ref+inner) - [{variable.#Foreign (the [.#captured .#counter] scope)} - {.#Item (revised .#captured - (is (-> Foreign Foreign) - (|>> (revised .#counter ++) - (revised .#mappings (property.has name [ref_type (product.left ref+inner)])))) - scope) - (product.right ref+inner)}])) - [init_ref {.#End}] - (list.reversed inner)) - scopes (list#composite inner' outer)] - {.#Right [(has .#scopes scopes state) - {.#Some [ref_type ref]}]}) - ))))) + (function (_ state) + (let [[inner outer] (|> state + (the .#scopes) + (list.split_when (|>> (reference? name))))] + (when outer + {.#End} + {.#Right [state {.#None}]} + + {.#Item top_outer _} + (let [[ref_type init_ref] (maybe.else (undefined) + (..reference name top_outer)) + [ref inner'] (list#mix (is (-> Scope [Variable (List Scope)] [Variable (List Scope)]) + (function (_ scope ref+inner) + [{variable.#Foreign (the [.#captured .#counter] scope)} + {.#Item (revised .#captured + (is (-> Foreign Foreign) + (|>> (revised .#counter ++) + (revised .#mappings (property.has name [ref_type (product.left ref+inner)])))) + scope) + (product.right ref+inner)}])) + [init_ref {.#End}] + (list.reversed inner)) + scopes (list#composite inner' outer)] + {.#Right [(has .#scopes scopes state) + {.#Some [ref_type ref]}]}) + )))) (exception.def .public no_scope) (exception.def .public drained) @@ -178,14 +174,13 @@ (def .public next (Operation Register) - (extension.lifted - (function (_ state) - (when (the .#scopes state) - {.#Item top _} - {try.#Success [state (the [.#locals .#counter] top)]} - - {.#End} - (exception.except ..no_scope []))))) + (function (_ state) + (when (the .#scopes state) + {.#Item top _} + {try.#Success [state (the [.#locals .#counter] top)]} + + {.#End} + (exception.except ..no_scope [])))) (def .public environment (-> Scope (Environment Variable)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux index b983f83b4..ddb530480 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/type.lux @@ -20,11 +20,8 @@ [type ["[0]" check (.only Check)]]]]] ["/" // (.only Operation) - [// - [phase - ["[0]" extension]] - [/// - ["[0]" phase]]]]) + [//// + ["[0]" phase]]]) (def .public (check action) (All (_ a) (-> (Check a) (Operation a))) @@ -56,25 +53,25 @@ (def .public existential (Operation Type) (do phase.monad - [module (extension.lifted meta.current_module_name) - id (extension.lifted meta.seed)] + [module meta.current_module_name + id meta.seed] (in (..existential' module id)))) (def .public (expecting expected) (All (_ a) (-> Type (Operation a) (Operation a))) - (extension.localized (the .#expected) (has .#expected) - (function.constant {.#Some expected}))) + (phase.localized (the .#expected) (has .#expected) + (function.constant {.#Some expected}))) (def .public fresh (All (_ a) (-> (Operation a) (Operation a))) - (extension.localized (the .#type_context) (has .#type_context) - (function.constant check.fresh_context))) + (phase.localized (the .#type_context) (has .#type_context) + (function.constant check.fresh_context))) (def .public (inference actualT) (-> Type (Operation Any)) (do phase.monad - [module (extension.lifted meta.current_module_name) - expectedT (extension.lifted meta.expected_type)] + [module meta.current_module_name + expectedT meta.expected_type] (..check (check.check expectedT actualT) ... (do [! check.monad] ... [pre check.context diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux b/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux index 71cfff604..5e3a91a34 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux @@ -28,11 +28,11 @@ (type .public (State anchor expression declaration) (Record - [#analysis (Component analysis.State+ + [#analysis (Component analysis.State analysis.Phase) - #synthesis (Component synthesis.State+ + #synthesis (Component synthesis.State (-> Lux synthesis.Phase)) - #generation (Component (generation.State+ anchor expression declaration) + #generation (Component (generation.State anchor expression declaration) (-> Lux (generation.Phase anchor expression declaration)))])) (type .public Import @@ -55,13 +55,16 @@ [#imports (list#composite (the #imports left) (the #imports right)) #referrals (list#composite (the #referrals left) (the #referrals right))]) +(type .public (Operation anchor expression declaration) + (phase.Operation (State anchor expression declaration))) + +(type .public (Phase anchor expression declaration) + (phase.Phase (State anchor expression declaration) Code Requirements)) + (with_template [<special> <general>] [(type .public (<special> anchor expression declaration) (<general> (..State anchor expression declaration) Code Requirements))] - [State+ extension.State] - [Operation extension.Operation] - [Phase extension.Phase] [Handler extension.Handler] [Bundle extension.Bundle] [Extender extension.Extender] @@ -84,9 +87,8 @@ (All (_ anchor expression declaration output) (-> (<operation> output) (Operation anchor expression declaration output))) - (|>> (phase.sub [(the [<component> ..#state]) - (has [<component> ..#state])]) - extension.lifted))] + (phase.sub [(the [<component> ..#state]) + (has [<component> ..#state])]))] [lifted_analysis ..#analysis analysis.Operation] [lifted_synthesis ..#synthesis synthesis.Operation] @@ -97,7 +99,5 @@ (All (_ anchor expression declaration) (-> Module (Operation anchor expression declaration Any))) (do phase.monad - [_ (..lifted_analysis - (analysis.set_current_module module))] - (..lifted_generation - (generation.enter_module module)))) + [_ (..lifted_analysis (analysis.set_current_module module))] + (..lifted_generation (generation.enter_module module)))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux index e0c5e0fea..a79b9afcf 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux @@ -86,13 +86,16 @@ #log (Sequence Text) #interim_artifacts (List artifact.ID)])) +(type .public (Operation anchor expression declaration) + (phase.Operation (State anchor expression declaration))) + +(type .public (Phase anchor expression declaration) + (phase.Phase (State anchor expression declaration) Synthesis expression)) + (with_template [<special> <general>] [(type .public (<special> anchor expression declaration) (<general> (State anchor expression declaration) Synthesis expression))] - [State+ extension.State] - [Operation extension.Operation] - [Phase extension.Phase] [Handler extension.Handler] [Bundle extension.Bundle] [Extender extension.Extender] @@ -185,8 +188,8 @@ (All (_ anchor expression declaration) (Operation anchor expression declaration Nat)) (do phase.monad - [count (extension.read (the #counter)) - _ (extension.update (revised #counter ++))] + [count (phase.read (the #counter)) + _ (phase.update (revised #counter ++))] (in count))) (def .public (symbol prefix) @@ -197,12 +200,12 @@ (def .public (enter_module module) (All (_ anchor expression declaration) (-> descriptor.Module (Operation anchor expression declaration Any))) - (extension.update (has #module module))) + (phase.update (has #module module))) (def .public module (All (_ anchor expression declaration) (Operation anchor expression declaration descriptor.Module)) - (extension.read (the #module))) + (phase.read (the #module))) (def .public (evaluate! label code) (All (_ anchor expression declaration) @@ -241,13 +244,13 @@ (All (_ anchor expression declaration) (-> artifact.ID (Maybe Text) declaration (Operation anchor expression declaration Any))) (do [! phase.monad] - [?buffer (extension.read (the #buffer))] + [?buffer (phase.read (the #buffer))] (when ?buffer {.#Some buffer} ... TODO: Optimize by no longer checking for overwrites... (if (sequence.any? (|>> product.left (n.= artifact_id)) buffer) (phase.except ..cannot_overwrite_output [artifact_id]) - (extension.update (has #buffer {.#Some (sequence.suffix [artifact_id custom code] buffer)}))) + (phase.update (has #buffer {.#Some (sequence.suffix [artifact_id custom code] buffer)}))) {.#None} (phase.except ..no_buffer_for_saving_code [artifact_id])))) @@ -388,7 +391,7 @@ (-> Archive (Operation anchor expression declaration a) (Operation anchor expression declaration [(List unit.ID) a]))) (do phase.monad - [module (extension.read (the #module))] + [module (phase.read (the #module))] (function (_ state) (do try.monad [@module (archive.id module archive) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux index fb9a479db..3354d05fe 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux @@ -28,17 +28,15 @@ ["[1][0]" reference] ["[1][0]" when] ["[1][0]" function] - ["/[1]" // - ["[1][0]" extension] - ["/[1]" // - ["/" analysis (.only Analysis Operation Phase Handler Extender) - ["[1][0]" macro (.only Expander)] - ["[1][0]" type]] - [/// - ["//" phase] - ["[0]" reference] - [meta - [archive (.only Archive)]]]]]]) + ["//[1]" /// + ["/" analysis (.only Analysis Operation Phase Handler Extender) + ["[1][0]" macro (.only Expander)] + ["[1][0]" type]] + [/// + ["//" phase] + ["[0]" reference] + [meta + [archive (.only Archive)]]]]]) (exception.def .public (invalid syntax) (Exception Code) @@ -119,17 +117,17 @@ Symbol (List Code) (Operation (Maybe Analysis))) (do [! //.monad] - [value (//extension.lifted (global_analysis name)) + [value (global_analysis name) .let [[module short] name]] (when value {.#Some value} (do ! [it (when value {#Normal definition} - ((extender definition) short phase archive parameters) + ((extender definition) phase archive parameters) {#Special default} - ((as Handler default) short phase archive parameters))] + ((as Handler default) phase archive parameters))] (in {.#Some it})) {.#None} @@ -144,11 +142,11 @@ (def (macro_application extender expander analysis archive def_name argsC+) (-> Extender Expander Phase Archive Symbol (List Code) (Operation Analysis)) (do [! //.monad] - [?macro (//extension.lifted (meta.macro def_name))] + [?macro (meta.macro def_name)] (when ?macro {.#Some macro} (do ! - [expansion (//extension.lifted (/macro.single_expansion expander def_name macro argsC+))] + [expansion (/macro.single_expansion expander def_name macro argsC+)] (analysis archive expansion)) _ diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux index a7f8bd83b..eb01fd9e0 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux @@ -26,7 +26,6 @@ ["[0]" // ["[1][0]" simple] ["/[1]" // - ["[1][0]" extension] [// ["/" analysis (.only Analysis Operation Phase) ["[1][0]" complex (.only Tag)] @@ -117,7 +116,7 @@ (let [tag (/complex.tag right? lefts)] (function (again valueC) (do [! ///.monad] - [expectedT (///extension.lifted meta.expected_type) + [expectedT meta.expected_type expectedT' (/type.check (check.clean (list) expectedT))] (/.with_exception ..cannot_analyse_sum [expectedT' lefts right? valueC] (when expectedT @@ -186,15 +185,15 @@ (def .public (variant analyse tag archive valueC) (-> Phase Symbol Phase) (do [! ///.monad] - [tag (///extension.lifted (meta.normal tag)) - [lefts,right? variantT] (///extension.lifted (meta.tag tag)) + [tag (meta.normal tag) + [lefts,right? variantT] (meta.tag tag) [lefts right?] (when lefts,right? {.#Some [lefts right? family]} (in [lefts right?]) {.#None} (in [0 false])) - expectedT (///extension.lifted meta.expected_type)] + expectedT meta.expected_type] (when expectedT {.#Var _} (do ! @@ -240,7 +239,7 @@ (def .public (product analyse archive membersC) (-> Phase Archive (List Code) (Operation Analysis)) (do [! ///.monad] - [expectedT (///extension.lifted meta.expected_type)] + [expectedT meta.expected_type] (/.with_exception ..cannot_analyse_tuple [expectedT membersC] (when expectedT {.#Product _} @@ -318,12 +317,12 @@ (if pattern_matching? (///#in {.#None}) (do ///.monad - [slotH (///extension.lifted (meta.normal ["" slotH]))] + [slotH (meta.normal ["" slotH])] (again tail {.#Item [slotH valueH] output}))) (list.partial [_ {.#Symbol slotH}] valueH tail) (do ///.monad - [slotH (///extension.lifted (meta.normal slotH))] + [slotH (meta.normal slotH)] (again tail {.#Item [slotH valueH] output})) {.#End} @@ -395,8 +394,7 @@ (def (order' head_k original_record) (-> Symbol (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type]))) (do [! ///.monad] - [record (<| ///extension.lifted - meta.try + [record (<| meta.try (monad.each ! (function (_ [slot value]) (do ! [slot (..slot slot)] @@ -432,8 +430,7 @@ (if pattern_matching? (///#in {.#None}) (do ///.monad - [local_binding? (///extension.lifted - (..local_binding? head_k'))] + [local_binding? (..local_binding? head_k')] (if local_binding? (in {.#None}) (order' head_k record)))) @@ -452,8 +449,8 @@ (list [_ {.#Symbol pseudo_slot}] singletonC) (do [! ///.monad] - [head_k (///extension.lifted (meta.normal pseudo_slot)) - slot (///extension.lifted (meta.try (meta.slot head_k)))] + [head_k (meta.normal pseudo_slot) + slot (meta.try (meta.slot head_k))] (when slot {try.#Success [lefts,right? recordT]} (when lefts,right? @@ -482,7 +479,7 @@ {.#Some [record_size membersC recordT]} (do ! - [expectedT (///extension.lifted meta.expected_type)] + [expectedT meta.expected_type] (when expectedT {.#Var _} (do ! diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux index a6d191510..2065c0773 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/function.lux @@ -20,7 +20,6 @@ ["[0]" type (.only) ["[0]" check]]]]] ["[0]" /// - ["[1][0]" extension] [// ["/" analysis (.only Analysis Operation Phase) ["[1][0]" type] @@ -53,7 +52,7 @@ (def .public (function analyse function_name arg_name archive body) (-> Phase Text Text Phase) (do [! ///.monad] - [expectedT (///extension.lifted meta.expected_type)] + [expectedT meta.expected_type] (loop (again [expectedT expectedT]) (/.with_exception ..cannot_analyse [expectedT function_name arg_name body] (when expectedT diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux index 730131ef1..d9c88a463 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux @@ -13,7 +13,6 @@ ["^" pattern]]]]] ["[0]" // ["/[1]" // - ["[1][0]" extension] [// ["/" analysis (.only Analysis Operation) ["[1][0]" type] @@ -44,7 +43,7 @@ (-> Text Symbol (Operation Analysis)) (with_expansions [<return> (in (|> def_name ///reference.constant {/.#Reference}))] (do [! ///.monad] - [constant (///extension.lifted (meta.definition def_name))] + [constant (meta.definition def_name)] (when constant {.#Alias real_def_name} (definition quoted_module real_def_name) @@ -52,13 +51,13 @@ {.#Definition [exported? actualT _]} (do ! [_ (/type.inference actualT) - (^.let def_name [::module ::name]) (///extension.lifted (meta.normal def_name)) - current (///extension.lifted meta.current_module_name)] + (^.let def_name [::module ::name]) (meta.normal def_name) + current meta.current_module_name] (if (text#= current ::module) <return> (if exported? (do ! - [imported! (///extension.lifted (meta.imported_by? ::module current))] + [imported! (meta.imported_by? ::module current)] (if (or imported! (text#= quoted_module ::module)) <return> @@ -93,7 +92,7 @@ {.#None} (do ! - [this_module (///extension.lifted meta.current_module_name)] + [this_module meta.current_module_name] (definition quoted_module [this_module short])))) _ diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux index 5a214df20..5f839c67a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux @@ -26,7 +26,6 @@ ["/[1]" // ["[1][0]" complex] ["/[1]" // - ["[1][0]" extension] [// ["/" analysis (.only Analysis Operation Phase) ["[1][0]" simple] @@ -325,8 +324,8 @@ [location {.#Variant (list.partial [_ {.#Symbol tag}] values)}] (/.with_location location (do ///.monad - [tag (///extension.lifted (meta.normal tag)) - [lefts,right? variantT] (///extension.lifted (meta.tag tag)) + [tag (meta.normal tag) + [lefts,right? variantT] (meta.tag tag) [lefts right?] (in (.when lefts,right? {.#Some [lefts right? family]} [lefts right?] 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 1ef820bc9..4cd82397c 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 @@ -15,7 +15,6 @@ [type (.only sharing) ["[0]" check]]]]] ["[0]" // - ["[1][0]" extension] ["[1][0]" analysis] ["/[1]" // ["/" declaration (.only Operation Phase Handler Extender)] @@ -24,7 +23,7 @@ ["[1]/[0]" macro (.only Expander)] ["[1]/[0]" type]] [/// - ["//" phase] + ["//" phase (.use "[1]#[0]" monad)] [reference (.only) [variable (.only)]] [meta @@ -47,21 +46,15 @@ (All (_ anchor expression declaration) (-> (Phase anchor expression declaration) Archive (List Code) (Operation anchor expression declaration /.Requirements))) - (function (_ state) - (loop (again [state state - input expansion - output /.no_requirements]) - (when input - {.#End} - {try.#Success [state output]} - - {.#Item head tail} - (when (phase archive head state) - {try.#Success [state' head']} - (again state' tail (/.merge_requirements head' output)) - - {try.#Failure error} - {try.#Failure error}))))) + (when expansion + {.#End} + (//#in /.no_requirements) + + {.#Item head tail} + (do //.monad + [head' (phase archive head) + tail' (requiring phase archive tail)] + (in (/.merge_requirements head' tail'))))) (exception.def .public (not_an_extension [name expected actual]) (Exception [Symbol Type Type]) @@ -106,12 +99,10 @@ Symbol (List Code) (Operation anchor expression declaration /.Requirements))) (do //.monad - [value (<| /.lifted_analysis - //extension.lifted - (global_declaration name))] + [value (/.lifted_analysis (global_declaration name))] (when value {#Normal definition} - ((extender definition) "" phase archive parameters) + ((extender definition) phase archive parameters) {#Special default} (let [default (sharing [anchor expression declaration] @@ -119,7 +110,7 @@ extender) (is (Handler anchor expression declaration) (as_expected default)))] - (default "" phase archive parameters))))) + (default phase archive parameters))))) (type Outcome (Variant @@ -146,15 +137,13 @@ [_ {.#Form (list.partial [_ {.#Symbol macro|extension}] inputs)}] (do ! [expansion|requirements (do ! - [[def_type def_value] (<| /.lifted_analysis - //extension.lifted - (global_value macro|extension))] + [[def_type def_value] (/.lifted_analysis (global_value macro|extension))] (when def_value {#Normal def_value} (cond (check.subsumes? Macro def_type) (/.lifted_analysis (do ! - [expansion (//extension.lifted (///analysis/macro.expansion expander macro|extension (as Macro def_value) inputs))] + [expansion (///analysis/macro.expansion expander macro|extension (as Macro def_value) inputs)] (in {#More expansion}))) (check.subsumes? .Declaration def_type) 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 34786e94f..adf9d20a0 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 @@ -1,71 +1,50 @@ (.require [library - [lux (.except with) + [lux (.except) [abstract [equivalence (.only Equivalence)] - [hash (.only Hash)] - ["[0]" monad (.only do)]] + [hash (.only Hash)]] [control - ["[0]" function] - ["[0]" try (.only Try)] ["[0]" exception (.only Exception)]] [data ["[0]" product] - ["[0]" text (.use "[1]#[0]" order) - ["%" \\format (.only Format format)]] + ["[0]" text (.only) + ["%" \\format (.only Format)]] [collection ["[0]" list] - ["[0]" dictionary (.only Dictionary)]]] - [meta - [macro - ["^" pattern]]]]] + ["[0]" dictionary (.only Dictionary)]]]]] [///// - ["//" phase] - [meta - [archive (.only Archive)]]]) + ["[0]" phase]]) (type .public Name Text) (type .public (Extension a) - [Name (List a)]) + (Record + [#name Name + #parameters (List a)])) (def .public equivalence - (All (_ a) (-> (Equivalence a) (Equivalence (Extension a)))) + (All (_ a) + (-> (Equivalence a) + (Equivalence (Extension a)))) (|>> list.equivalence (product.equivalence text.equivalence))) (def .public hash - (All (_ a) (-> (Hash a) (Hash (Extension a)))) + (All (_ a) + (-> (Hash a) + (Hash (Extension a)))) (|>> list.hash (product.hash text.hash))) (type .public (Handler s i o) - (-> Name - (//.Phase s i o) - (//.Phase s (List i) o))) + (-> (phase.Phase s i o) + (phase.Phase s (List i) o))) (type .public (Bundle s i o) (Dictionary Name (Handler s i o))) -(def .public empty - Bundle - (dictionary.empty text.hash)) - -(type .public (State s i o) - s) - -(type .public (Operation s i o v) - (//.Operation (State s i o) v)) - -(type .public (Phase s i o) - (//.Phase (State s i o) i o)) - -(exception.def .public (cannot_overwrite name) - (Exception Name) - (exception.report - (list ["Extension" (%.text name)]))) - (exception.def .public (incorrect_arity [name arity args]) (Exception [Name Nat Nat]) (exception.report @@ -74,85 +53,12 @@ ["Actual" (%.nat args)]))) (exception.def .public (invalid_syntax [name %format inputs]) - (All (_ a) (Exception [Name (Format a) (List a)])) + (All (_ a) + (Exception [Name (Format a) (List a)])) (exception.report (list ["Extension" (%.text name)] ["Inputs" (exception.listing %format inputs)]))) -(exception.def .public (unknown [name bundle]) - (All (_ s i o) (Exception [Name (Bundle s i o)])) - (exception.report - (list ["Extension" (%.text name)] - ["Available" (|> bundle - dictionary.keys - (list.sorted text#<) - (exception.listing %.text))]))) - (type .public (Extender s i o) - (-> Any (Handler s i o))) - -(def .public (localized get set transform) - (All (_ s s' i o v) - (-> (-> s s') (-> s' s s) (-> s' s') - (-> (Operation s i o v) (Operation s i o v)))) - (function (_ operation) - (function (_ state) - (let [old (get state)] - (when (operation (set (transform old) state)) - {try.#Success [state' output]} - {try.#Success [(set old state') output]} - - failure - failure))))) - -(def .public (temporary transform) - (All (_ s i o v) - (-> (-> s s) - (-> (Operation s i o v) (Operation s i o v)))) - (function (_ operation) - (function (_ state) - (when (operation (transform state)) - {try.#Success [state' output]} - {try.#Success [state output]} - - failure - failure)))) - -(def .public (with_state state) - (All (_ s i o v) - (-> s (-> (Operation s i o v) (Operation s i o v)))) - (..temporary (function.constant state))) - -(def .public (read get) - (All (_ s i o v) - (-> (-> s v) (Operation s i o v))) - (function (_ state) - {try.#Success [state (get state)]})) - -(def .public (update transform) - (All (_ s i o) - (-> (-> s s) (Operation s i o Any))) - (function (_ state) - {try.#Success [(transform state) []]})) - -(def .public (lifted action) - (All (_ s i o v) - (-> (//.Operation s v) (Operation s i o v))) - (function (_ state) - (when (action state) - {try.#Success [state' output]} - {try.#Success [state' output]} - - {try.#Failure error} - {try.#Failure error}))) - -(def .public (up it) - (All (_ s i o v) - (-> (Operation s i o v) (//.Operation s v))) - (function (_ state) - (when (it state) - {try.#Success [state' output]} - {try.#Success [state' output]} - - {try.#Failure error} - {try.#Failure error}))) + (-> Any + (Handler s i o))) 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 4b118d972..89b18beb8 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 @@ -450,7 +450,7 @@ phase.lifted))) (def (primitive_array_length_handler primitive_type) - (-> (Type Primitive) Handler) + (-> (Type Primitive) (-> Text Handler)) (function (_ extension_name analyse archive args) (when args (list arrayC) @@ -467,7 +467,7 @@ (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def array::length::object - Handler + (-> Text Handler) (function (_ extension_name analyse archive args) (when args (list arrayC) @@ -490,7 +490,7 @@ (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def (new_primitive_array_handler primitive_type) - (-> (Type Primitive) Handler) + (-> (Type Primitive) (-> Text Handler)) (function (_ extension_name analyse archive args) (when args (list lengthC) @@ -506,14 +506,14 @@ (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def array::new::object - Handler + (-> Text Handler) (function (_ extension_name analyse archive args) (when args (list lengthC) (do phase.monad [lengthA (<| (typeA.expecting ..int) (analyse archive lengthC)) - expectedT (///.lifted meta.expected_type) + expectedT meta.expected_type expectedJT (jvm_array_type expectedT) elementJT (when (parser.array? expectedJT) {.#Some elementJT} @@ -691,7 +691,7 @@ (check_jvm type))) (def (read_primitive_array_handler lux_type jvm_type) - (-> .Type (Type Primitive) Handler) + (-> .Type (Type Primitive) (-> Text Handler)) (function (_ extension_name analyse archive args) (when args (list idxC arrayC) @@ -709,7 +709,7 @@ (/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) (def array::read::object - Handler + (-> Text Handler) (function (_ extension_name analyse archive args) (when args (list idxC arrayC) @@ -735,7 +735,7 @@ (/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) (def (write_primitive_array_handler lux_type jvm_type) - (-> .Type (Type Primitive) Handler) + (-> .Type (Type Primitive) (-> Text Handler)) (let [array_type {.#Primitive (|> (jvm.array jvm_type) ..reflection) (list)}] (function (_ extension_name analyse archive args) @@ -758,7 +758,7 @@ (/////analysis.except ///.incorrect_arity [extension_name 3 (list.size args)]))))) (def array::write::object - Handler + (-> Text Handler) (function (_ extension_name analyse archive args) (when args (list idxC valueC arrayC) @@ -830,12 +830,12 @@ )) (def object::null - Handler + (-> Text Handler) (function (_ extension_name analyse archive args) (when args (list) (do phase.monad - [expectedT (///.lifted meta.expected_type) + [expectedT meta.expected_type [_ :object:] (check_object expectedT) _ (typeA.inference :object:)] (in {/////analysis.#Extension [.prelude (%.format extension_name "|generation")] @@ -845,7 +845,7 @@ (/////analysis.except ///.incorrect_arity [extension_name 0 (list.size args)])))) (def object::null? - Handler + (-> Text Handler) (function (_ extension_name analyse archive args) (when args (list objectC) @@ -861,7 +861,7 @@ (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def object::synchronized - Handler + (-> Text Handler) (function (_ extension_name analyse archive args) (when args (list monitorC exprC) @@ -877,7 +877,7 @@ (/////analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) (def (object::throw class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (function (_ extension_name analyse archive args) (when args (list exceptionC) @@ -898,7 +898,7 @@ (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def (object::class class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (function (_ extension_name analyse archive args) (when args (list classC) @@ -918,7 +918,7 @@ (/////analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) (def (object::instance? class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (..custom [(all <>.and <code>.text <code>.any) (function (_ extension_name analyse archive [sub_class objectC]) @@ -958,12 +958,12 @@ (array.list {.#None} (java/lang/Class::getGenericInterfaces from_class))))))) (def (object::cast class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (function (_ extension_name analyse archive args) (when args (list fromC) (do [! phase.monad] - [toT (///.lifted meta.expected_type) + [toT meta.expected_type toJT (check_jvm toT) [fromT fromA] (typeA.inferring (analyse archive fromC)) @@ -1041,7 +1041,7 @@ )) (def (get::static class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (..custom [..member (function (_ extension_name analyse archive [class field]) @@ -1061,7 +1061,7 @@ (/////analysis.text (..signature fieldJT)))))))])) (def (put::static class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (..custom [(all <>.and ..member <code>.any) (function (_ extension_name analyse archive [[class field] valueC]) @@ -1086,7 +1086,7 @@ valueA)))))])) (def (get::virtual class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (..custom [(all <>.and ..member <code>.any) (function (_ extension_name analyse archive [[class field] objectC]) @@ -1111,7 +1111,7 @@ objectA)))))])) (def (put::virtual class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (..custom [(all <>.and ..member <code>.any <code>.any) (function (_ extension_name analyse archive [[class field] valueC objectC]) @@ -1507,7 +1507,7 @@ (<code>.tuple (<>.some ..var))) (def (invoke::static class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (..custom [(all <>.and ..type_vars ..member ..type_vars (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars argsTC]) @@ -1526,7 +1526,7 @@ (decorate_inputs argsT argsA))})))])) (def (invoke::virtual class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (..custom [(all <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) @@ -1552,7 +1552,7 @@ (decorate_inputs argsT argsA))})))])) (def (invoke::special class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (..custom [(all <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) @@ -1578,7 +1578,7 @@ (decorate_inputs argsT argsA))})))])) (def (invoke::interface class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (..custom [(all <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class_name method] method_tvars objectC argsTC]) @@ -1607,7 +1607,7 @@ (decorate_inputs argsT argsA))})))])) (def (invoke::constructor class_loader) - (-> java/lang/ClassLoader Handler) + (-> java/lang/ClassLoader (-> Text Handler)) (..custom [(all <>.and ..type_vars <code>.text ..type_vars (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars class method_tvars argsTC]) @@ -2659,7 +2659,7 @@ inheritance)) (def (class::anonymous class_loader host) - (-> java/lang/ClassLoader runtime.Host Handler) + (-> java/lang/ClassLoader runtime.Host (-> Text Handler)) (..custom [(all <>.and (<code>.tuple (<>.some ..var)) @@ -2676,10 +2676,10 @@ [_ (..ensure_fresh_class! class_loader (..reflection super_class)) _ (monad.each ! (|>> ..reflection (..ensure_fresh_class! class_loader)) super_interfaces) - self_name (///.lifted (do meta.monad - [where meta.current_module_name - id meta.seed] - (in (..anonymous_class_name where id)))) + self_name (do meta.monad + [where meta.current_module_name + id meta.seed] + (in (..anonymous_class_name where id))) .let [selfT {.#Primitive self_name (list)}] mock (<| phase.lifted (..mock [self_name parameters] 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 f7e4393d9..c8b1a5d50 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 @@ -39,12 +39,12 @@ [meta [archive (.only Archive)]]]]]]) -(def .public (custom [syntax handler]) +(def .public (custom [syntax handler] extension_name) (All (_ s) (-> [(Parser s) (-> Text Phase Archive s (Operation Analysis))] - Handler)) - (function (_ extension_name analyse archive args) + (-> Text Handler))) + (function (_ analyse archive args) (when (<code>.result syntax args) {try.#Success inputs} (handler extension_name analyse archive inputs) @@ -52,10 +52,10 @@ {try.#Failure _} (analysis.except ///.invalid_syntax [extension_name %.code args])))) -(def (simple inputsT+ outputT) - (-> (List Type) Type Handler) +(def (simple inputsT+ outputT extension_name) + (-> (List Type) Type (-> Text Handler)) (let [num_expected (list.size inputsT+)] - (function (_ extension_name analyse archive args) + (function (_ analyse archive args) (let [num_actual (list.size args)] (if (n.= num_expected num_actual) (do [! ////.monad] @@ -69,19 +69,19 @@ (analysis.except ///.incorrect_arity [extension_name num_expected num_actual])))))) (def .public (nullary valueT) - (-> Type Handler) + (-> Type (-> Text Handler)) (simple (list) valueT)) (def .public (unary inputT outputT) - (-> Type Type Handler) + (-> Type Type (-> Text Handler)) (simple (list inputT) outputT)) (def .public (binary subjectT paramT outputT) - (-> Type Type Type Handler) + (-> Type Type Type (-> Text Handler)) (simple (list subjectT paramT) outputT)) (def .public (trinary subjectT param0T param1T outputT) - (-> Type Type Type Type Handler) + (-> Type Type Type Type (-> Text Handler)) (simple (list subjectT param0T param1T) outputT)) ... TODO: Get rid of this ASAP @@ -100,6 +100,7 @@ _ (<>.failure (exception.error ..char_text_must_be_size_1 [raw]))))) (def lux::syntax_char_case! + (-> Text Handler) (..custom [(all <>.and <code>.any @@ -110,7 +111,7 @@ (do [! ////.monad] [input (<| (typeA.expecting text.Char) (phase archive input)) - expectedT (///.lifted meta.expected_type) + expectedT meta.expected_type conditionals (monad.each ! (function (_ [cases branch]) (do ! [branch (<| (typeA.expecting expectedT) @@ -128,21 +129,20 @@ {analysis.#Extension [.prelude (format extension_name "|generation")]}))))]))) ... .is?# represents reference/pointer equality. -(def lux::is? - Handler - (function (_ extension_name analyse archive args) +(def (lux::is? extension_name) + (-> Text Handler) + (function (_ analyse archive args) (<| typeA.with_var (function (_ [@var :var:])) ((binary :var: :var: Bit extension_name) analyse archive args)))) -... .try# provides a simple way to interact with the host platform's -... error_handling facilities. +... .try# provides a unified way to interact with the host platform's runtime error-handling facilities. (def lux::try - Handler - (function (_ extension_name analyse archive args) - (when args - (list opC) + (-> Text Handler) + (..custom + [<code>.any + (function (_ extension_name analyse archive opC) (<| typeA.with_var (function (_ [@var :var:])) (do [! ////.monad] @@ -150,55 +150,43 @@ (|> opC (analyse archive) (typeA.expecting (type_literal (-> .Any :var:))) - (at ! each (|>> list {analysis.#Extension [.prelude (format extension_name "|generation")]}))))) - - _ - (analysis.except ///.incorrect_arity [extension_name 1 (list.size args)])))) + (at ! each (|>> list {analysis.#Extension [.prelude (format extension_name "|generation")]}))))))])) (def lux::in_module - Handler - (function (_ extension_name analyse archive argsC+) - (when argsC+ - (list [_ {.#Text module_name}] exprC) + (-> Text Handler) + (..custom + [(<>.and <code>.text <code>.any) + (function (_ extension_name analyse archive [module_name exprC]) (analysis.with_current_module module_name - (analyse archive exprC)) - - _ - (analysis.except ///.invalid_syntax [extension_name %.code argsC+])))) + (analyse archive exprC)))])) (def .public (is#_extension eval) - (-> Eval Handler) - (function (_ extension_name analyse archive args) - (when args - (list typeC valueC) + (-> Eval (-> Text Handler)) + (..custom + [(<>.and <code>.any <code>.any) + (function (_ extension_name analyse archive [typeC valueC]) (do [! ////.monad] [actualT (at ! each (|>> (as Type)) (eval archive Type typeC)) _ (typeA.inference actualT)] (<| (typeA.expecting actualT) - (analyse archive valueC))) - - _ - (analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) + (analyse archive valueC))))])) (def .public (as#_extension eval) - (-> Eval Handler) - (function (_ extension_name analyse archive args) - (when args - (list typeC valueC) + (-> Eval (-> Text Handler)) + (..custom + [(<>.and <code>.any <code>.any) + (function (_ extension_name analyse archive [typeC valueC]) (do [! ////.monad] [actualT (at ! each (|>> (as Type)) (eval archive Type typeC)) _ (typeA.inference actualT) [valueT valueA] (typeA.inferring (analyse archive valueC))] - (in valueA)) - - _ - (analysis.except ///.incorrect_arity [extension_name 2 (list.size args)])))) + (in valueA)))])) (def (caster input output) - (-> Type Type Handler) + (-> Type Type (-> Text Handler)) (..custom [<code>.any (function (_ extension_name phase archive valueC) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/bundle.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/bundle.lux index 1436c1002..d9b0fb4d2 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/bundle.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/bundle.lux @@ -1,14 +1,10 @@ (.require [library [lux (.except) - [abstract - [monad (.only do)]] [data - ["[0]" text (.only) - ["%" \\format (.only format)]] + ["[0]" text] [collection - ["[0]" list (.use "[1]#[0]" functor)] - ["[0]" dictionary (.only Dictionary)]]]]] + ["[0]" dictionary]]]]] [// (.only Handler Bundle)]) (def .public empty @@ -17,13 +13,6 @@ (def .public (install name anonymous) (All (_ s i o) - (-> Text (Handler s i o) + (-> Text (-> Text (Handler s i o)) (-> (Bundle s i o) (Bundle s i o)))) - (dictionary.has name anonymous)) - -(def .public (prefix prefix) - (All (_ s i o) - (-> Text (-> (Bundle s i o) (Bundle s i o)))) - (|>> dictionary.entries - (list#each (function (_ [key val]) [(format prefix " " key) val])) - (dictionary.of_list text.hash))) + (dictionary.has name (anonymous name))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux index a164ee5b9..6028be070 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/jvm.lux @@ -78,7 +78,7 @@ [jvm ["[0]" runtime (.only Anchor Definition Extender)] ["[0]" value]]] - ["[0]" extension (.only) + [extension ["[0]" bundle] [analysis ["[0]" jvm]] @@ -864,7 +864,7 @@ (<code>.tuple (<>.some ..annotation)) (<code>.tuple (<>.some ..field)) (<code>.tuple (<>.some ..method))) - (function (_ extension phase archive + (function (_ phase archive [class_declaration super interfaces @@ -895,7 +895,7 @@ luxT.fresh parameters) selfT {.#Primitive name (list#each product.right parameters)}] - state (extension.lifted phase.state) + state phase.state methods (monad.each ! (let [analysis_state (the [declaration.#analysis declaration.#state] state)] (..method_definition archive super interfaces [mapping selfT] [(the [declaration.#analysis declaration.#phase] state) @@ -939,7 +939,7 @@ ... TODO: Handle annotations. (<code>.tuple (<>.some ..annotation)) (<>.some jvm.method_declaration)) - (function (_ extension_name phase archive [[name parameters] supers annotations method_declarations]) + (function (_ phase archive [[name parameters] supers annotations method_declarations]) (declaration.lifted_generation (do [! phase.monad] [bytecode (<| (at ! each (\\format.result class.format)) 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 2a96f19a0..9052c2384 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 @@ -63,19 +63,18 @@ (def .public (custom [syntax handler]) (All (_ anchor expression declaration s) (-> [(Parser s) - (-> Text - (Phase anchor expression declaration) + (-> (Phase anchor expression declaration) Archive s (Operation anchor expression declaration Requirements))] (Handler anchor expression declaration))) - (function (_ extension_name phase archive inputs) + (function (_ phase archive inputs) (when (<code>.result syntax inputs) {try.#Success inputs} - (handler extension_name phase archive inputs) + (handler phase archive inputs) {try.#Failure error} - (phase.except ///.invalid_syntax [extension_name %.code inputs])))) + (phase.except ///.invalid_syntax ["" %.code inputs])))) (def (context [@module @artifact]) (-> unit.ID unit.ID) @@ -103,7 +102,7 @@ (All (_ anchor expression declaration) (-> Archive Type Code (Operation anchor expression declaration [Type expression Any]))) (do phase.monad - [state (///.lifted phase.state) + [state phase.state .let [analysis_state (the [/////declaration.#analysis /////declaration.#state] state) analysis (the [/////declaration.#analysis /////declaration.#phase] state) synthesis ((the [/////declaration.#synthesis /////declaration.#phase] state) analysis_state) @@ -150,7 +149,7 @@ (-> Archive Symbol (Maybe Type) Code (Operation anchor expression declaration [Type expression Any]))) (do [! phase.monad] - [state (///.lifted phase.state) + [state phase.state .let [analysis_state (the [/////declaration.#analysis /////declaration.#state] state) analysis (the [/////declaration.#analysis /////declaration.#phase] state) synthesis ((the [/////declaration.#synthesis /////declaration.#phase] state) analysis_state) @@ -186,8 +185,7 @@ Synthesis (Operation anchor expression declaration [expression Any]))) (do phase.monad - [current_module (/////declaration.lifted_analysis - (///.lifted meta.current_module_name))] + [current_module (/////declaration.lifted_analysis meta.current_module_name)] (/////declaration.lifted_generation (do phase.monad [dependencies (cache/artifact.dependencies archive codeS) @@ -204,7 +202,7 @@ (-> Archive Text Type Code (Operation anchor expression declaration [expression Any]))) (do phase.monad - [state (///.lifted phase.state) + [state phase.state .let [analysis_state (the [/////declaration.#analysis /////declaration.#state] state) analysis (the [/////declaration.#analysis /////declaration.#phase] state) synthesis ((the [/////declaration.#synthesis /////declaration.#phase] state) analysis_state) @@ -237,8 +235,8 @@ (the [/////declaration.#generation /////declaration.#phase] state)])] _ (/////declaration.lifted_analysis (do ! - [_ (moduleA.override_definition [.prelude "is#"] {.#Default [true .Analysis (analysisE.is#_extension eval)]}) - _ (moduleA.override_definition [.prelude "as#"] {.#Default [true .Analysis (analysisE.as#_extension eval)]})] + [_ (moduleA.override_definition [.prelude "is#"] {.#Default [true .Analysis (analysisE.is#_extension eval "is#")]}) + _ (moduleA.override_definition [.prelude "as#"] {.#Default [true .Analysis (analysisE.as#_extension eval "as#")]})] (in [])))] (in []))) @@ -250,13 +248,12 @@ (def lux::def Handler - (function (_ extension_name phase archive inputsC+) + (function (_ phase archive inputsC+) (when inputsC+ (list [_ {.#Symbol ["" short_name]}] valueC exported?C) (do phase.monad [_ ..refresh - current_module (/////declaration.lifted_analysis - (///.lifted meta.current_module_name)) + current_module (/////declaration.lifted_analysis meta.current_module_name) .let [full_name [current_module short_name]] [type valueT value] (..definition archive full_name {.#None} valueC) [_ _ exported?] (evaluate! archive Bit exported?C) @@ -266,7 +263,7 @@ (in /////declaration.no_requirements)) _ - (phase.except ///.invalid_syntax [extension_name %.code inputsC+])))) + (phase.except ///.invalid_syntax ["" %.code inputsC+])))) (def imports (Parser (List Import)) @@ -278,7 +275,7 @@ Handler (..custom [..imports - (function (_ extension_name phase archive imports) + (function (_ phase archive imports) (do [! phase.monad] [_ (/////declaration.lifted_analysis (monad.each ! (function (_ [module alias]) @@ -301,8 +298,8 @@ (def (define_alias alias original) (-> Text Symbol (/////analysis.Operation Any)) (do phase.monad - [current_module (///.lifted meta.current_module_name) - constant (///.lifted (meta.definition original))] + [current_module meta.current_module_name + constant (meta.definition original)] (when constant {.#Alias de_aliased} (phase.except ..cannot_alias_an_alias [[current_module alias] original de_aliased]) @@ -314,12 +311,11 @@ Handler (..custom [(all <>.and <code>.local <code>.symbol) - (function (_ extension_name phase archive [alias def_name]) + (function (_ phase archive [alias def_name]) (do phase.monad - [_ (///.lifted - (phase.sub [(the [/////declaration.#analysis /////declaration.#state]) - (has [/////declaration.#analysis /////declaration.#state])] - (define_alias alias def_name)))] + [_ (phase.sub [(the [/////declaration.#analysis /////declaration.#state]) + (has [/////declaration.#analysis /////declaration.#state])] + (define_alias alias def_name))] (in /////declaration.no_requirements)))])) ... TODO: Stop requiring these types and the "swapped" function below to make types line-up. diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux index e9980d164..a598e96c5 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -46,12 +46,12 @@ (def .public (custom [parser handler]) (All (_ s) (-> [(Parser s) - (-> Text Phase Archive s (Operation (Bytecode Any)))] - Handler)) + (-> Phase Archive s (Operation (Bytecode Any)))] + (-> Text Handler))) (function (_ extension_name phase archive input) (when (<synthesis>.result parser input) {try.#Success input'} - (handler extension_name phase archive input') + (handler phase archive input') {try.#Failure error} (/////.except /////extension.invalid_syntax [extension_name synthesis.%synthesis input])))) @@ -101,7 +101,7 @@ (<>.some (<synthesis>.tuple (all <>.and (<synthesis>.tuple (<>.many <synthesis>.i64)) <synthesis>.any)))) - (function (_ extension_name phase archive [inputS elseS conditionalsS]) + (function (_ phase archive [inputS elseS conditionalsS]) (do [! /////.monad] [@end ///runtime.forge_label inputG (phase archive inputS) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux index 18981ce1c..b72d1754a 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -379,10 +379,10 @@ (undefined)))) (def (primitive_array_length_handler jvm_primitive) - (-> (Type Primitive) Handler) + (-> (Type Primitive) (-> Text Handler)) (..custom [<synthesis>.any - (function (_ extension_name generate archive arrayS) + (function (_ generate archive arrayS) (do //////.monad [arrayG (generate archive arrayS)] (in (all _.composite @@ -391,10 +391,10 @@ _.arraylength))))])) (def array::length::object - Handler + (-> Text Handler) (..custom [(all <>.and ..object_array <synthesis>.any) - (function (_ extension_name generate archive [elementJT arrayS]) + (function (_ generate archive [elementJT arrayS]) (do //////.monad [arrayG (generate archive arrayS)] (in (all _.composite @@ -403,10 +403,10 @@ _.arraylength))))])) (def (new_primitive_array_handler jvm_primitive) - (-> Primitive_Array_Type Handler) + (-> Primitive_Array_Type (-> Text Handler)) (..custom [<synthesis>.any - (function (_ extension_name generate archive [lengthS]) + (function (_ generate archive [lengthS]) (do //////.monad [lengthG (generate archive lengthS)] (in (all _.composite @@ -414,10 +414,10 @@ (_.newarray jvm_primitive)))))])) (def array::new::object - Handler + (-> Text Handler) (..custom [(all <>.and ..object <synthesis>.any) - (function (_ extension_name generate archive [objectJT lengthS]) + (function (_ generate archive [objectJT lengthS]) (do //////.monad [lengthG (generate archive lengthS)] (in (all _.composite @@ -425,10 +425,10 @@ (_.anewarray objectJT)))))])) (def (read_primitive_array_handler jvm_primitive loadG) - (-> (Type Primitive) (Bytecode Any) Handler) + (-> (Type Primitive) (Bytecode Any) (-> Text Handler)) (..custom [(all <>.and <synthesis>.any <synthesis>.any) - (function (_ extension_name generate archive [idxS arrayS]) + (function (_ generate archive [idxS arrayS]) (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS)] @@ -439,10 +439,10 @@ loadG))))])) (def array::read::object - Handler + (-> Text Handler) (..custom [(all <>.and ..object_array <synthesis>.any <synthesis>.any) - (function (_ extension_name generate archive [elementJT idxS arrayS]) + (function (_ generate archive [elementJT idxS arrayS]) (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS)] @@ -453,10 +453,10 @@ _.aaload))))])) (def (write_primitive_array_handler jvm_primitive storeG) - (-> (Type Primitive) (Bytecode Any) Handler) + (-> (Type Primitive) (Bytecode Any) (-> Text Handler)) (..custom [(all <>.and <synthesis>.any <synthesis>.any <synthesis>.any) - (function (_ extension_name generate archive [idxS valueS arrayS]) + (function (_ generate archive [idxS valueS arrayS]) (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS) @@ -470,10 +470,10 @@ storeG))))])) (def array::write::object - Handler + (-> Text Handler) (..custom [(all <>.and ..object_array <synthesis>.any <synthesis>.any <synthesis>.any) - (function (_ extension_name generate archive [elementJT idxS valueS arrayS]) + (function (_ generate archive [elementJT idxS valueS arrayS]) (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS) @@ -572,10 +572,10 @@ (def $String (type.class "java.lang.String" (list))) (def object::class - Handler + (-> Text Handler) (..custom [<synthesis>.text - (function (_ extension_name generate archive [class]) + (function (_ generate archive [class]) (do //////.monad [] (in (all _.composite @@ -583,10 +583,10 @@ (_.invokestatic ..$Class "forName" (type.method [(list) (list ..$String) ..$Class (list)]))))))])) (def object::instance? - Handler + (-> Text Handler) (..custom [(all <>.and <synthesis>.text <synthesis>.any) - (function (_ extension_name generate archive [class objectS]) + (function (_ generate archive [class objectS]) (do //////.monad [objectG (generate archive objectS)] (in (all _.composite @@ -595,10 +595,10 @@ (///value.wrap type.boolean)))))])) (def object::cast - Handler + (-> Text Handler) (..custom [(all <>.and <synthesis>.text <synthesis>.text <synthesis>.any) - (function (_ extension_name generate archive [from to valueS]) + (function (_ generate archive [from to valueS]) (do //////.monad [valueG (generate archive valueS)] (in (`` (cond (,, (with_template [<object> <type>] @@ -637,17 +637,17 @@ )) (def get::static - Handler + (-> Text Handler) (..custom [(all <>.and <synthesis>.text <synthesis>.text ..value) - (function (_ extension_name generate archive [class field :unboxed:]) + (function (_ generate archive [class field :unboxed:]) (at //////.monad in (_.getstatic (type.class class (list)) field :unboxed:)))])) (def put::static - Handler + (-> Text Handler) (..custom [(all <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any) - (function (_ extension_name generate archive [class field :unboxed: valueS]) + (function (_ generate archive [class field :unboxed: valueS]) (do //////.monad [valueG (generate archive valueS)] (in (all _.composite @@ -662,10 +662,10 @@ ..unitG))))])) (def get::virtual - Handler + (-> Text Handler) (..custom [(all <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any) - (function (_ extension_name generate archive [class field :unboxed: objectS]) + (function (_ generate archive [class field :unboxed: objectS]) (do //////.monad [objectG (generate archive objectS) .let [:class: (type.class class (list)) @@ -676,10 +676,10 @@ getG))))])) (def put::virtual - Handler + (-> Text Handler) (..custom [(all <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any <synthesis>.any) - (function (_ extension_name generate archive [class field :unboxed: valueS objectS]) + (function (_ generate archive [class field :unboxed: valueS objectS]) (do //////.monad [valueG (generate archive valueS) objectG (generate archive objectS) @@ -729,10 +729,10 @@ (_#in []))) (def invoke::static - Handler + (-> Text Handler) (..custom [(all <>.and ..class <synthesis>.text ..return (<>.some ..input)) - (function (_ extension_name generate archive [class method outputT inputsTS]) + (function (_ generate archive [class method outputT inputsTS]) (do [! //////.monad] [inputsTG (monad.each ! (generate_input generate archive) inputsTS)] (in (all _.composite @@ -742,10 +742,10 @@ (with_template [<check_cast?> <name> <invoke>] [(def <name> - Handler + (-> Text Handler) (..custom [(all <>.and ..class <synthesis>.text ..return <synthesis>.any (<>.some ..input)) - (function (_ extension_name generate archive [class method outputT objectS inputsTS]) + (function (_ generate archive [class method outputT objectS inputsTS]) (do [! //////.monad] [objectG (generate archive objectS) inputsTG (monad.each ! (generate_input generate archive) inputsTS)] @@ -764,10 +764,10 @@ ) (def invoke::constructor - Handler + (-> Text Handler) (..custom [(all <>.and ..class (<>.some ..input)) - (function (_ extension_name generate archive [class inputsTS]) + (function (_ generate archive [class inputsTS]) (do [! //////.monad] [inputsTG (monad.each ! (generate_input generate archive) inputsTS)] (in (all _.composite @@ -1309,17 +1309,17 @@ (returnG returnT))}))))) (def class::anonymous - Handler + (-> Text Handler) (..custom [(all <>.and ..class (<synthesis>.tuple (<>.some ..class)) (<synthesis>.tuple (<>.some ..input)) (<synthesis>.tuple (<>.some ..overriden_method_definition))) - (function (_ extension_name generate archive [super_class - super_interfaces - inputsTS - overriden_methods]) + (function (_ generate archive [super_class + super_interfaces + inputsTS + overriden_methods]) (do [! //////.monad] [all_dependencies (anonymous_dependencies archive inputsTS overriden_methods) [context _] (//////generation.with_new_context archive all_dependencies (in [])) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/extension.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/extension.lux index 321e8ca7b..fde10a521 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/extension.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/extension.lux @@ -31,12 +31,12 @@ (def arity (syntax (_ [arity <code>.nat]) - (with_symbols [g!_ g!extension g!name g!phase g!archive g!inputs g!anchor g!expression g!declaration] + (with_symbols [g!_ g!name g!extension g!phase g!archive g!inputs g!anchor g!expression g!declaration] (do [! meta.monad] [g!input+ (monad.all ! (list.repeated arity (macro.symbol "input")))] (in (list (` (is (All ((, g!_) (, g!anchor) (, g!expression) (, g!declaration)) (-> ((Arity (, (code.nat arity))) (, g!expression)) - (generation.Handler (, g!anchor) (, g!expression) (, g!declaration)))) + (-> Text (generation.Handler (, g!anchor) (, g!expression) (, g!declaration))))) (function ((, g!_) (, g!extension)) (function ((, g!_) (, g!name) (, g!phase) (, g!archive) (, g!inputs)) (when (, g!inputs) @@ -49,7 +49,7 @@ ((,' in) ((, g!extension) [(,* g!input+)]))) (, g!_) - (///.except ///extension.incorrect_arity [(, g!name) + (///.except ///extension.incorrect_arity ["" (, (code.nat arity)) (list.size (, g!inputs))])) )))))))))) @@ -69,10 +69,9 @@ (def .public (variadic extension) (All (_ anchor expression declaration) - (-> (Variadic expression) (generation.Handler anchor expression declaration))) - (function (_ extension_name) - (function (_ phase archive inputsS) - (let [! ///.monad] - (|> inputsS - (monad.each ! (phase archive)) - (at ! each extension)))))) + (-> (Variadic expression) (-> Text (generation.Handler anchor expression declaration)))) + (function (_ extension_name phase archive inputsS) + (let [! ///.monad] + (|> inputsS + (monad.each ! (phase archive)) + (at ! each extension))))) 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 44fb80a79..d25fe3fcf 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 @@ -73,10 +73,10 @@ (if (check.subsumes? .Generation type) (when value {.#Left definition} - ((extender definition) "" phase archive parameters) + ((extender definition) phase archive parameters) {.#Right default} - ((as Handler default) "" phase archive parameters)) + ((as Handler default) phase archive parameters)) (///.except ..not_an_extension [name .Generation type])) {try.#Failure error} 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 e1b4ebc8e..3f6d6cb65 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 @@ -85,10 +85,10 @@ (if (check.subsumes? .Synthesis type) (when value {.#Left definition} - ((extender definition) "" phase archive parameters) + ((extender definition) phase archive parameters) {.#Right default} - ((as Handler default) "" phase archive parameters)) + ((as Handler default) phase archive parameters)) ... (phase.except ..not_an_extension [name .Synthesis type]) (|> parameters (monad.each phase.monad (phase archive)) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux index 6ef3645d3..80182d03d 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux @@ -132,13 +132,16 @@ {#Control (Control Synthesis)} {#Extension [Symbol (List Synthesis)]}))) +(type .public Operation + (phase.Operation State)) + +(type .public Phase + (phase.Phase State Analysis Synthesis)) + (with_template [<special> <general>] [(type .public <special> (<general> ..State Analysis Synthesis))] - [State+ extension.State] - [Operation extension.Operation] - [Phase extension.Phase] [Handler extension.Handler] [Bundle extension.Bundle] [Extender extension.Extender] @@ -217,11 +220,11 @@ (with_template [<with> <query> <tag> <type>] [(def .public (<with> value) (-> <type> (All (_ a) (-> (Operation a) (Operation a)))) - (extension.temporary (has <tag> value))) + (phase.temporary (has <tag> value))) (def .public <query> (Operation <type>) - (extension.read (the <tag>)))] + (phase.read (the <tag>)))] [with_locals locals #locals Nat] [with_currying? currying? #currying? Bit] diff --git a/stdlib/source/library/lux/meta/compiler/phase.lux b/stdlib/source/library/lux/meta/compiler/phase.lux index dd87d5866..d67fb5633 100644 --- a/stdlib/source/library/lux/meta/compiler/phase.lux +++ b/stdlib/source/library/lux/meta/compiler/phase.lux @@ -140,3 +140,42 @@ [[pre/state' temp] (pre archive input pre/state) [post/state' output] (post archive temp post/state)] (in [[pre/state' post/state'] output])))) + +(def .public (read get) + (All (_ s v) + (-> (-> s v) (Operation s v))) + (function (_ state) + {try.#Success [state (get state)]})) + +(def .public (update transform) + (All (_ s) + (-> (-> s s) (Operation s Any))) + (function (_ state) + {try.#Success [(transform state) []]})) + +(def .public (localized get set transform) + (All (_ s s' v) + (-> (-> s s') (-> s' s s) (-> s' s') + (-> (Operation s v) (Operation s v)))) + (function (_ operation) + (function (_ state) + (let [old (get state)] + (when (operation (set (transform old) state)) + {try.#Success [state' output]} + {try.#Success [(set old state') output]} + + failure + failure))))) + +(def .public (temporary transform) + (All (_ s v) + (-> (-> s s) + (-> (Operation s v) (Operation s v)))) + (function (_ operation) + (function (_ state) + (when (operation (transform state)) + {try.#Success [state' output]} + {try.#Success [state output]} + + failure + failure)))) diff --git a/stdlib/source/library/lux/meta/extension.lux b/stdlib/source/library/lux/meta/extension.lux index a713dd596..913acaec9 100644 --- a/stdlib/source/library/lux/meta/extension.lux +++ b/stdlib/source/library/lux/meta/extension.lux @@ -43,21 +43,19 @@ (with_template [<any> <end> <and> <result> <name> <extension_type> <handler_type>] [(def .public <name> - (syntax (_ [[handler extension phase archive inputs] (<c>.form (all <>.and - <c>.local - <c>.local - <c>.local - <c>.local - (<c>.tuple (<>.some <c>.any)))) + (syntax (_ [[handler phase archive inputs] (<c>.form (all <>.and + <c>.local + <c>.local + <c>.local + (<c>.tuple (<>.some <c>.any)))) body <c>.any]) (let [g!handler (code.local handler) - g!name (code.local extension) g!phase (code.local phase) g!archive (code.local archive)] (with_symbols [g!inputs g!error g!_] (in (list (` (<| (as <extension_type>) (is <handler_type>) - (.function ((, g!handler) (, g!name) (, g!phase) (, g!archive) (, g!inputs)) + (.function ((, g!handler) (, g!phase) (, g!archive) (, g!inputs)) (.when (<result> (monad.do <>.monad [(,* inputs) diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 5fb5696b1..f3723c1c0 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -161,7 +161,7 @@ [state archive phase_wrapper] (sharing [<parameters>] (is (Platform <parameters>) platform) - (is (Async (Try [(declaration.State+ <parameters>) + (is (Async (Try [(declaration.State <parameters>) Archive phase.Wrapper])) (as_expected (platform.initialize file_context @@ -176,7 +176,7 @@ [archive state] (sharing [<parameters>] (is (Platform <parameters>) platform) - (is (Async (Try [Archive (declaration.State+ <parameters>)])) + (is (Async (Try [Archive (declaration.State <parameters>)])) (as_expected (platform.compile program global lux_compiler diff --git a/stdlib/source/specification/compositor.lux b/stdlib/source/specification/compositor.lux index 8526daba4..7afe706c1 100644 --- a/stdlib/source/specification/compositor.lux +++ b/stdlib/source/specification/compositor.lux @@ -32,7 +32,7 @@ ["[1][0]" common]]]) (def (test runner definer state expander) - (-> Runner Definer analysis.State+ Expander Test) + (-> Runner Definer analysis.State Expander Test) (all _.and (/analysis/type.spec expander state) (/generation/primitive.spec runner) diff --git a/stdlib/source/specification/compositor/analysis/type.lux b/stdlib/source/specification/compositor/analysis/type.lux index 3eab3d50d..726e438c9 100644 --- a/stdlib/source/specification/compositor/analysis/type.lux +++ b/stdlib/source/specification/compositor/analysis/type.lux @@ -12,7 +12,7 @@ [meta ["[0]" code] [compiler - [analysis (.only State+)] + [analysis (.only State)] ["[0]" phase [macro (.only Expander)] ["[0]" analysis @@ -22,7 +22,7 @@ ["_" property (.only Test)]]]]) (def (check_success+ expander state extension params output_type) - (-> Expander State+ Text (List Code) Type Bit) + (-> Expander State Text (List Code) Type Bit) (|> (analysis/scope.with_scope "" (analysis/type.with_type output_type (analysis.phase expander (` ((, (code.text extension)) (,* params)))))) @@ -53,7 +53,7 @@ ))))) (def .public (spec expander state) - (-> Expander State+ Test) + (-> Expander State Test) (do r.monad [[typeC exprT exprC] ..check [other_typeC other_exprT other_exprC] ..check] diff --git a/stdlib/source/specification/compositor/common.lux b/stdlib/source/specification/compositor/common.lux index 2a3e6fb45..f72bb20bc 100644 --- a/stdlib/source/specification/compositor/common.lux +++ b/stdlib/source/specification/compositor/common.lux @@ -28,7 +28,7 @@ (type .public (Instancer what) (All (_ anchor expression declaration) (-> (Platform IO anchor expression declaration) - (generation.State+ anchor expression declaration) + (generation.State anchor expression declaration) what))) (def (runner (open "[0]") state) @@ -65,7 +65,7 @@ (generation.Bundle anchor expression declaration) (declaration.Bundle anchor expression declaration) (-> expression declaration) Extender - (IO (Try [(declaration.State+ anchor expression declaration) + (IO (Try [(declaration.State anchor expression declaration) Runner Definer])))) (do io.monad diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/analysis.lux b/stdlib/source/test/lux/meta/compiler/language/lux/analysis.lux index 201661c8e..3a724d8e5 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/analysis.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/analysis.lux @@ -39,12 +39,9 @@ ["[0]" \\parser] [\\library ["[0]" / (.only) - [// - [phase - ["[0]" extension]] - [/// - ["[0]" phase] - ["[0]" version]]]]] + [//// + ["[0]" phase] + ["[0]" version]]]] ["[0]" / ["[1][0]" complex] ["[1][0]" inference] @@ -393,18 +390,16 @@ (all _.and (_.coverage [/.set_state] (|> (do phase.monad - [pre (extension.read function.identity) + [pre (phase.read function.identity) _ (/.set_state state/1) - post (extension.read function.identity)] + post (phase.read function.identity)] (in (and (same? state/0 pre) (same? state/1 post)))) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) + (phase.result state/0) (try.else false))) (_.coverage [/.failure] (|> (/.failure expected_error) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) + (phase.result state/0) (pipe.when {try.#Failure actual_error} (and (text.contains? expected_error actual_error) @@ -414,8 +409,7 @@ false))) (_.coverage [/.except] (|> (/.except <exception> []) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) + (phase.result state/0) (pipe.when {try.#Failure actual_error} (and (text.contains? (exception.error <exception> []) actual_error) @@ -426,8 +420,7 @@ (_.coverage [/.with_exception] (|> (/.failure expected_error) (/.with_exception <exception> []) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) + (phase.result state/0) (pipe.when {try.#Failure actual_error} (and (text.contains? expected_error actual_error) @@ -438,8 +431,7 @@ false))) (_.coverage [/.assertion] (and (|> (/.assertion <exception> [] false) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) + (phase.result state/0) (pipe.when {try.#Failure actual_error} (and (text.contains? (exception.error <exception> []) actual_error) @@ -448,8 +440,7 @@ _ false)) (|> (/.assertion <exception> [] true) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) + (phase.result state/0) (pipe.when {try.#Success _} true @@ -505,9 +496,8 @@ (_.coverage [/.set_current_module] (|> (do phase.monad [_ (/.set_current_module expected_module)] - (extension.read (|>> (the .#current_module) (maybe.else "")))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) + (phase.read (|>> (the .#current_module) (maybe.else "")))) + (phase.result state) (pipe.when {try.#Success actual} (same? expected_module actual) @@ -515,7 +505,7 @@ _ false))) (_.coverage [/.with_current_module] - (let [current_module (extension.read (|>> (the .#current_module) (maybe.else "")))] + (let [current_module (phase.read (|>> (the .#current_module) (maybe.else "")))] (|> (do phase.monad [_ (/.set_current_module expected_module) pre current_module @@ -525,16 +515,14 @@ (in (and (same? expected_module pre) (same? dummy_module mid) (same? expected_module post)))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) + (phase.result state) (try.else false)))) (_.coverage [/.location /.set_location] (let [expected (/.location expected_file)] (|> (do phase.monad [_ (/.set_location expected)] - (extension.read (the .#location))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) + (phase.read (the .#location))) + (phase.result state) (pipe.when {try.#Success actual} (same? expected actual) @@ -544,7 +532,7 @@ (_.coverage [/.with_location] (let [expected (/.location expected_file) dummy (/.location expected_code) - location (extension.read (the .#location))] + location (phase.read (the .#location))] (|> (do phase.monad [_ (/.set_location expected) pre location @@ -554,16 +542,14 @@ (in (and (same? expected pre) (same? dummy mid) (same? expected post)))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) + (phase.result state) (try.else false)))) (_.coverage [/.source /.set_source_code] (let [expected (/.source expected_file expected_code)] (|> (do phase.monad [_ (/.set_source_code expected)] - (extension.read (the .#source))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) + (phase.read (the .#source))) + (phase.result state) (pipe.when {try.#Success actual} (same? expected actual) @@ -573,7 +559,7 @@ (_.coverage [/.with_source_code] (let [expected (/.source expected_file expected_code) dummy (/.source expected_code expected_file) - source (extension.read (the .#source))] + source (phase.read (the .#source))] (|> (do phase.monad [_ (/.set_source_code expected) pre source @@ -583,8 +569,7 @@ (in (and (same? expected pre) (same? dummy mid) (same? expected post)))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) + (phase.result state) (try.else false)))) ))) @@ -608,7 +593,7 @@ ..test|when) (_.for [/.Operation /.Phase /.Handler /.Bundle] ..test|phase) - (_.for [/.State+] + (_.for [/.State] ..test|state) (_.coverage [/.format] (bit#= (at /.equivalence = left right) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux index 7442e7a3c..007d2e71e 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux @@ -25,11 +25,8 @@ [\\library ["[0]" / (.only) ["/[1]" // (.only) - [// - [phase - ["[2][0]" extension]] - [/// - ["[2][0]" phase]]]]]]) + [//// + ["[2][0]" phase]]]]]) (def random_state (Random Lux) @@ -61,9 +58,7 @@ (def test|module Test (do [! random.monad] - [lux ..random_state - .let [state [/extension.#bundle /extension.empty - /extension.#state lux]] + [state ..random_state name (random.lower_case 1) hash random.nat expected_import (random.lower_case 2) @@ -74,7 +69,7 @@ (_.coverage [/.create] (|> (do /phase.monad [_ (/.create hash name)] - (/extension.lifted (meta.module name))) + (meta.module name)) (/phase.result state) (try#each (..new? hash)) (try.else false))) @@ -103,8 +98,7 @@ [_ (if <expected> (/.import expected_import) (in []))] - (/extension.lifted - (meta.imported? expected_import))))] + (meta.imported? expected_import)))] (in ?)) (/phase.result state) (try#each (bit#= <expected>)) @@ -135,9 +129,7 @@ (def test|state Test (do [! random.monad] - [lux ..random_state - .let [state [/extension.#bundle /extension.empty - /extension.#state lux]] + [state ..random_state name (random.lower_case 1) hash random.nat] (`` (all _.and @@ -200,9 +192,7 @@ (def test|definition Test (do [! random.monad] - [lux ..random_state - .let [state [/extension.#bundle /extension.empty - /extension.#state lux]] + [state ..random_state module_name (random.lower_case 1) hash random.nat def_name (random.lower_case 2) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/extension.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/extension.lux index e884cd858..c9953642d 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/extension.lux @@ -71,14 +71,6 @@ (phase.result [/.#bundle /.empty /.#state state]) (try.else false))) - (_.coverage [/.with_state] - (|> (is (/.Operation Int Nat Nat Text) - (/.with_state state - (/.read %.int))) - (at phase.functor each (text#= (%.int state))) - (phase.result [/.#bundle /.empty - /.#state dummy]) - (try.else false))) (_.coverage [/.localized] (|> (is (/.Operation Int Nat Nat Text) (do phase.monad diff --git a/stdlib/source/test/lux/meta/extension.lux b/stdlib/source/test/lux/meta/extension.lux index 3675c0d64..cdcf0879d 100644 --- a/stdlib/source/test/lux/meta/extension.lux +++ b/stdlib/source/test/lux/meta/extension.lux @@ -52,7 +52,6 @@ ["[0]" synthesis (.only) ["<[1]>" \\parser]] [phase - ["[0]" extension] [generation (.,, (.for "JVM" (.,, (.these ["[0]" jvm ["[1]/[0]" runtime]])) @@ -69,7 +68,7 @@ (these (for @.python ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. - (analysis ("dummy dum dum" self phase archive []) + (analysis ("dummy dum dum" phase archive []) (undefined)) (these)) @@ -77,18 +76,18 @@ ... Analysis (def my_analysis Analysis - (analysis (_ self phase archive [pass_through <code>.any]) + (analysis (_ phase archive [pass_through <code>.any]) (phase archive pass_through))) ... Synthesis (def my_synthesis|synthesis Synthesis - (synthesis (_ self phase archive [pass_through <analysis>.any]) + (synthesis (_ phase archive [pass_through <analysis>.any]) (phase archive pass_through))) (def my_synthesis Analysis - (analysis (_ self phase archive [parameters (<>.some <code>.any)]) + (analysis (_ phase archive [parameters (<>.some <code>.any)]) (let [! phase.monad] (|> parameters (monad.each ! (phase archive)) @@ -97,12 +96,12 @@ ... Generation (def my_generation|generation Generation - (generation (_ self phase archive [pass_through <synthesis>.any]) + (generation (_ phase archive [pass_through <synthesis>.any]) (phase archive pass_through))) (def my_generation|synthesis Synthesis - (synthesis (_ self phase archive [parameters (<>.some <analysis>.any)]) + (synthesis (_ phase archive [parameters (<>.some <analysis>.any)]) (let [! phase.monad] (|> parameters (monad.each ! (phase archive)) @@ -110,7 +109,7 @@ (def my_generation Analysis - (analysis (_ self phase archive [parameters (<>.some <code>.any)]) + (analysis (_ phase archive [parameters (<>.some <code>.any)]) (let [! phase.monad] (|> parameters (monad.each ! (phase archive)) @@ -118,7 +117,7 @@ (def dummy_generation|generation Generation - (generation (_ self phase archive []) + (generation (_ phase archive []) (let [[_ self] (symbol ..dummy_generation)] (at phase.monad in (for @.jvm (jvm.string self) @@ -131,27 +130,26 @@ (def dummy_generation|synthesis Synthesis - (synthesis (_ self phase archive []) + (synthesis (_ phase archive []) (at phase.monad in {synthesis.#Extension (symbol ..dummy_generation|generation) (list)}))) (def dummy_generation Analysis - (analysis (_ self phase archive []) + (analysis (_ phase archive []) (at phase.monad in {analysis.#Extension (symbol ..dummy_generation|synthesis) (list)}))) ... Declaration (def my_declaration Declaration - (declaration (_ self phase archive [expression <code>.any]) + (declaration (_ phase archive [expression <code>.any]) (do [! phase.monad] - [analysis_phase declaration.analysis + [.let [[_ self] (symbol ..my_declaration)] + analysis_phase declaration.analysis expressionA (<| declaration.lifted_analysis (type.expecting .Any) (analysis_phase archive expression)) - lux (<| declaration.lifted_analysis - extension.lifted - meta.compiler_state) + lux (declaration.lifted_analysis meta.compiler_state) synthesis_phase declaration.synthesis expressionS (declaration.lifted_synthesis |