diff options
Diffstat (limited to '')
14 files changed, 145 insertions, 260 deletions
diff --git a/stdlib/source/library/lux/meta/compiler/default/init.lux b/stdlib/source/library/lux/meta/compiler/default/init.lux index 6de9ff2d9..3ec4e3632 100644 --- a/stdlib/source/library/lux/meta/compiler/default/init.lux +++ b/stdlib/source/library/lux/meta/compiler/default/init.lux @@ -62,37 +62,33 @@ (-> extension.Extender Lux (///generation.Phase anchor expression declaration)) (///declaration.State+ anchor expression declaration))) (let [lux (///analysis.state (///analysis.info version.latest target configuration))] - [extension.empty - [///declaration.#analysis [///declaration.#state [extension.empty lux] - ///declaration.#phase (analysisP.phase extender expander)] - ///declaration.#synthesis [///declaration.#state [extension.#bundle extension.empty - extension.#state ///synthesis.init] - ///declaration.#phase (synthesisP.phase extender)] - ///declaration.#generation [///declaration.#state [extension.#bundle extension.empty - extension.#state (///generation.state host module)] - ///declaration.#phase (generate extender)]]])) + [///declaration.#analysis [///declaration.#state lux + ///declaration.#phase (analysisP.phase extender expander)] + ///declaration.#synthesis [///declaration.#state ///synthesis.init + ///declaration.#phase (synthesisP.phase extender)] + ///declaration.#generation [///declaration.#state (///generation.state host module) + ///declaration.#phase (generate extender)]])) (type Reader (-> Source (Either [Source Text] [Source Code]))) (def (reader current_module aliases [location offset source_code]) (-> descriptor.Module Aliases Source (///analysis.Operation Reader)) - (function (_ [bundle state]) - {try.#Success [[bundle state] - (///syntax.parse current_module aliases (text.size source_code))]})) + (function (_ state) + {try.#Success [state (///syntax.parse current_module aliases (text.size source_code))]})) (def (read source reader) (-> Source Reader (///analysis.Operation [Source Code])) - (function (_ [bundle compiler]) + (function (_ compiler) (when (reader source) {.#Left [source' error]} {try.#Failure error} {.#Right [source' output]} (let [[location _] output] - {try.#Success [[bundle (|> compiler - (has .#source source') - (has .#location location))] + {try.#Success [(|> compiler + (has .#source source') + (has .#location location)) [source' output]]})))) (type (Operation a) diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux index 9488ab8a3..09d58919e 100644 --- a/stdlib/source/library/lux/meta/compiler/default/platform.lux +++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux @@ -252,10 +252,8 @@ (def (module_compilation_log module) (All (_ <type_vars>) (-> descriptor.Module <State+> Text)) - (|>> (the [extension.#state - ///declaration.#generation + (|>> (the [///declaration.#generation ///declaration.#state - extension.#state ///generation.#log]) (sequence#mix (function (_ right left) (%.format left ..compilation_log_separator right)) @@ -264,10 +262,8 @@ (def with_reset_log (All (_ <type_vars>) (-> <State+> <State+>)) - (has [extension.#state - ///declaration.#generation + (has [///declaration.#generation ///declaration.#state - extension.#state ///generation.#log] sequence.empty)) @@ -387,29 +383,6 @@ (list.only (|>> product.left (dictionary.key? to) not) (dictionary.entries from)))) - (with_template [<name> <path>] - [(def (<name> from state) - (All (_ <type_vars>) - (-> <State+> <State+> (Try <State+>))) - (do try.monad - [inherited (with_extensions (the <path> from) (the <path> state))] - (in (has <path> inherited state))))] - - [with_analysis_extensions [extension.#state ///declaration.#analysis ///declaration.#state extension.#bundle]] - [with_synthesis_extensions [extension.#state ///declaration.#synthesis ///declaration.#state extension.#bundle]] - [with_generation_extensions [extension.#state ///declaration.#generation ///declaration.#state extension.#bundle]] - [with_declaration_extensions [extension.#bundle]] - ) - - (def (with_all_extensions from state) - (All (_ <type_vars>) - (-> <State+> <State+> (Try <State+>))) - (do try.monad - [state (with_analysis_extensions from state) - state (with_synthesis_extensions from state) - state (with_generation_extensions from state)] - (with_declaration_extensions from state))) - (type (Context state) [Archive state]) @@ -547,10 +520,8 @@ (set.of_list text.hash)) with_modules (is (All (_ <type_vars>) (-> <State+> <State+>)) - (revised [extension.#state - ///declaration.#analysis - ///declaration.#state - extension.#state] + (revised [///declaration.#analysis + ///declaration.#state] (is (All (_ a) (-> a a)) (function (_ analysis_state) (|> analysis_state @@ -561,8 +532,7 @@ not) current) modules))) - as_expected)))))] - state (monad.mix ! with_all_extensions state extended_states)] + as_expected)))))]] (in (with_modules state)))) (def (set_current_module module state) @@ -826,10 +796,8 @@ (do ..monad [context (import! (list) descriptor.runtime /#module) .let [[archive state] context - meta_state (the [extension.#state - ///declaration.#analysis - ///declaration.#state - extension.#state] + meta_state (the [///declaration.#analysis + ///declaration.#state] state)] [_ /#type /#value] (|> /#definition meta.export 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 f97722a14..c3a746cb1 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux @@ -260,11 +260,11 @@ (def .public (with_source_code source action) (All (_ a) (-> Source (Operation a) (Operation a))) - (function (_ [bundle state]) + (function (_ state) (let [old_source (the .#source state)] - (.when (action [bundle (has .#source source state)]) - {try.#Success [[bundle' state'] output]} - {try.#Success [[bundle' (has .#source old_source state')] + (.when (action (has .#source source state)) + {try.#Success [state' output]} + {try.#Success [(has .#source old_source state') output]} failure @@ -280,11 +280,11 @@ (All (_ a) (-> Location (Operation a) (Operation a))) (if (text#= "" (product.left location)) action - (function (_ [bundle state]) + (function (_ state) (let [old_location (the .#location state)] - (.when (action [bundle (has .#location location state)]) - {try.#Success [[bundle' state'] output]} - {try.#Success [[bundle' (has .#location old_location state')] + (.when (action (has .#location location state)) + {try.#Success [state' output]} + {try.#Success [(has .#location old_location state') output]} failure @@ -297,18 +297,18 @@ (def .public (failure error) (-> Text Operation) - (function (_ [bundle state]) + (function (_ state) {try.#Failure (located (the .#location state) error)})) (def .public (of_try it) (All (_ a) (-> (Try a) (Operation a))) - (function (_ [bundle state]) + (function (_ state) (.when it {try.#Failure error} {try.#Failure (located (the .#location state) error)} {try.#Success it} - {try.#Success [[bundle state] it]}))) + {try.#Success [state it]}))) (def .public (except exception parameters) (All (_ e) (-> (Exception e) e Operation)) @@ -322,21 +322,19 @@ (def .public (with_exception exception message action) (All (_ e o) (-> (Exception e) e (Operation o) (Operation o))) - (function (_ bundle,state) + (function (_ state) (.when (exception.with exception message - (action bundle,state)) + (action state)) {try.#Failure error} - (let [[bundle state] bundle,state] - {try.#Failure (located (the .#location state) error)}) + {try.#Failure (located (the .#location state) error)} success success))) (def .public (set_state state) (-> .Lux (Operation Any)) - (function (_ [bundle _]) - {try.#Success [[bundle state] - []]})) + (function (_ _) + {try.#Success [state []]})) (with_template [<name> <type> <field> <value>] [(def .public (<name> value) 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 833bb997c..c262ad1b8 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 @@ -110,7 +110,7 @@ (def .public (with_local [name type] action) (All (_ a) (-> [Text Type] (Operation a) (Operation a))) - (function (_ [bundle state]) + (function (_ state) (when (the .#scopes state) {.#Item head tail} (let [old_mappings (the [.#locals .#mappings] head) @@ -120,14 +120,14 @@ (|>> (revised .#counter ++) (revised .#mappings (property.has name [type new_var_id])))) head)] - (when (phase.result' [bundle (has .#scopes {.#Item new_head tail} state)] + (when (phase.result' (has .#scopes {.#Item new_head tail} state) action) - {try.#Success [[bundle' state'] output]} + {try.#Success [state' output]} (when (the .#scopes state') {.#Item head' tail'} (let [scopes' {.#Item (has .#locals (the .#locals head) head') tail'}] - {try.#Success [[bundle' (has .#scopes scopes' state')] + {try.#Success [(has .#scopes scopes' state') output]}) _ @@ -151,10 +151,10 @@ (def .public (reset action) (All (_ a) (-> (Operation a) (Operation a))) - (function (_ [bundle state]) - (when (action [bundle (has .#scopes (list ..empty) state)]) - {try.#Success [[bundle' state'] output]} - {try.#Success [[bundle' (has .#scopes (the .#scopes state) state')] + (function (_ state) + (when (action (has .#scopes (list ..empty) state)) + {try.#Success [state' output]} + {try.#Success [(has .#scopes (the .#scopes state) state') output]} failure @@ -162,12 +162,12 @@ (def .public (with action) (All (_ a) (-> (Operation a) (Operation [Scope a]))) - (function (_ [bundle state]) - (when (action [bundle (revised .#scopes (|>> {.#Item ..empty}) state)]) - {try.#Success [[bundle' state'] output]} + (function (_ state) + (when (action (revised .#scopes (|>> {.#Item ..empty}) state)) + {try.#Success [state' output]} (when (the .#scopes state') {.#Item head tail} - {try.#Success [[bundle' (has .#scopes tail state')] + {try.#Success [(has .#scopes tail state') [head output]]} {.#End} 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 85f275a67..b983f83b4 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 @@ -28,14 +28,14 @@ (def .public (check action) (All (_ a) (-> (Check a) (Operation a))) - (function (_ (^.let stateE [bundle state])) + (function (_ state) (when (action (the .#type_context state)) {try.#Success [context' output]} - {try.#Success [[bundle (has .#type_context context' state)] + {try.#Success [(has .#type_context context' state) output]} {try.#Failure error} - ((/.failure error) stateE)))) + ((/.failure error) state)))) (def prefix (format (%.symbol (symbol ..type)) "#")) 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 b75132497..71cfff604 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux @@ -71,8 +71,8 @@ [(def .public <name> (All (_ anchor expression declaration) (Operation anchor expression declaration <phase>)) - (function (_ [bundle state]) - {try.#Success [[bundle state] (the [<component> ..#phase] state)]}))] + (function (_ state) + {try.#Success [state (the [<component> ..#phase] state)]}))] [analysis ..#analysis analysis.Phase] [synthesis ..#synthesis (-> Lux synthesis.Phase)] 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 71caea7e7..e0c5e0fea 100644 --- a/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux @@ -126,10 +126,10 @@ (def .public <with_declaration> (All (_ anchor expression declaration output) <with_type>) (function (_ body) - (function (_ [bundle state]) - (when (body [bundle (has <tag> {.#Some <with_value>} state)]) - {try.#Success [[bundle' state'] output]} - {try.#Success [[bundle' (has <tag> (the <tag> state) state')] + (function (_ state) + (when (body (has <tag> {.#Some <with_value>} state)) + {try.#Success [state' output]} + {try.#Success [(has <tag> (the <tag> state) state') output]} {try.#Failure error} @@ -138,10 +138,10 @@ (def .public <get> (All (_ anchor expression declaration) (Operation anchor expression declaration <get_type>)) - (function (_ (^.let stateE [bundle state])) + (function (_ state) (when (the <tag> state) {.#Some output} - {try.#Success [stateE output]} + {try.#Success [state output]} {.#None} (exception.except <exception> [])))) @@ -149,8 +149,8 @@ (def .public (<set> value) (All (_ anchor expression declaration) (-> <get_type> (Operation anchor expression declaration Any))) - (function (_ [bundle state]) - {try.#Success [[bundle (has <tag> {.#Some value} state)] + (function (_ state) + {try.#Success [(has <tag> {.#Some value} state) []]}))] [#anchor @@ -171,14 +171,14 @@ (def .public get_registry (All (_ anchor expression declaration) (Operation anchor expression declaration Registry)) - (function (_ (^.let stateE [bundle state])) - {try.#Success [stateE (the #registry state)]})) + (function (_ state) + {try.#Success [state (the #registry state)]})) (def .public (set_registry value) (All (_ anchor expression declaration) (-> Registry (Operation anchor expression declaration Any))) - (function (_ [bundle state]) - {try.#Success [[bundle (has #registry value state)] + (function (_ state) + {try.#Success [(has #registry value state) []]})) (def .public next @@ -207,10 +207,10 @@ (def .public (evaluate! label code) (All (_ anchor expression declaration) (-> unit.ID [(Maybe unit.ID) expression] (Operation anchor expression declaration Any))) - (function (_ (^.let state+ [bundle state])) + (function (_ state) (when (at (the #host state) evaluate label code) {try.#Success output} - {try.#Success [state+ output]} + {try.#Success [state output]} {try.#Failure error} (exception.except ..cannot_interpret [error])))) @@ -218,10 +218,10 @@ (def .public (execute! code) (All (_ anchor expression declaration) (-> declaration (Operation anchor expression declaration Any))) - (function (_ (^.let state+ [bundle state])) + (function (_ state) (when (at (the #host state) execute code) {try.#Success output} - {try.#Success [state+ output]} + {try.#Success [state output]} {try.#Failure error} (exception.except ..cannot_interpret error)))) @@ -229,10 +229,10 @@ (def .public (define! context custom code) (All (_ anchor expression declaration) (-> unit.ID (Maybe Text) [(Maybe unit.ID) expression] (Operation anchor expression declaration [Text Any declaration]))) - (function (_ (^.let stateE [bundle state])) + (function (_ state) (when (at (the #host state) define context custom code) {try.#Success output} - {try.#Success [stateE output]} + {try.#Success [state output]} {try.#Failure error} (exception.except ..cannot_interpret error)))) @@ -256,9 +256,9 @@ [(`` (def .public (<name> it (,, (template.spliced <inputs>)) dependencies) (All (_ anchor expression declaration) (-> <type> (,, (template.spliced <input_types>)) (Set unit.ID) (Operation anchor expression declaration artifact.ID))) - (function (_ (^.let stateE [bundle state])) + (function (_ state) (let [[id registry'] (<artifact> it <mandatory?> dependencies (the #registry state))] - {try.#Success [[bundle (has #registry registry' state)] + {try.#Success [(has #registry registry' state) id]}))))] [category.Definition mandatory? [mandatory?] [Bit] learn registry.definition] @@ -279,7 +279,7 @@ (def .public (remember archive name) (All (_ anchor expression declaration) (-> Archive Symbol (Operation anchor expression declaration unit.ID))) - (function (_ (^.let stateE [bundle state])) + (function (_ state) (let [[_module _name] name] (do try.monad [@module (archive.id _module archive) @@ -293,12 +293,12 @@ (exception.except ..unknown_definition [name (registry.definitions registry)]) {.#Some id} - {try.#Success [stateE [@module id]]}))))) + {try.#Success [state [@module id]]}))))) (def .public (definition archive name) (All (_ anchor expression declaration) (-> Archive Symbol (Operation anchor expression declaration [unit.ID (Maybe category.Definition)]))) - (function (_ (^.let stateE [bundle state])) + (function (_ state) (let [[_module _name] name] (do try.monad [@module (archive.id _module archive) @@ -312,22 +312,22 @@ (exception.except ..unknown_definition [name (registry.definitions registry)]) {.#Some [@artifact def]} - {try.#Success [stateE [[@module @artifact] def]]}))))) + {try.#Success [state [[@module @artifact] def]]}))))) (exception.def .public no_context) (def .public (module_id module archive) (All (_ anchor expression declaration) (-> descriptor.Module Archive (Operation anchor expression declaration module.ID))) - (function (_ (^.let stateE [bundle state])) + (function (_ state) (do try.monad [@module (archive.id module archive)] - (in [stateE @module])))) + (in [state @module])))) (def .public (context archive) (All (_ anchor expression declaration) (-> Archive (Operation anchor expression declaration unit.ID))) - (function (_ (^.let stateE [bundle state])) + (function (_ state) (when (the #context state) {.#None} (exception.except ..no_context []) @@ -335,17 +335,17 @@ {.#Some id} (do try.monad [@module (archive.id (the #module state) archive)] - (in [stateE [@module id]]))))) + (in [state [@module id]]))))) (def .public (with_context @artifact body) (All (_ anchor expression declaration a) (-> artifact.ID (Operation anchor expression declaration a) (Operation anchor expression declaration a))) - (function (_ [bundle state]) + (function (_ state) (do try.monad - [[[bundle' state'] output] (body [bundle (has #context {.#Some @artifact} state)])] - (in [[bundle' (has #context (the #context state) state')] + [[state' output] (body (has #context {.#Some @artifact} state))] + (in [(has #context (the #context state) state') output])))) (def .public (with_registry_shift shift body) @@ -353,35 +353,34 @@ (-> Nat (Operation anchor expression declaration a) (Operation anchor expression declaration a))) - (function (_ [bundle state]) + (function (_ state) (do try.monad - [[[bundle' state'] output] (body [bundle (has #registry_shift shift state)])] - (in [[bundle' (has #registry_shift (the #registry_shift state) state')] + [[state' output] (body (has #registry_shift shift state))] + (in [(has #registry_shift (the #registry_shift state) state') output])))) (def .public (with_new_context archive dependencies body) (All (_ anchor expression declaration a) (-> Archive (Set unit.ID) (Operation anchor expression declaration a) (Operation anchor expression declaration [unit.ID a]))) - (function (_ (^.let stateE [bundle state])) + (function (_ state) (let [[@artifact registry'] (registry.resource false dependencies (the #registry state)) @artifact (n.+ @artifact (the #registry_shift state))] (do try.monad - [[[bundle' state'] output] (body [bundle (|> state - (has #registry registry') - (has #context {.#Some @artifact}) - (revised #interim_artifacts (|>> {.#Item @artifact})))]) + [[state' output] (body (|> state + (has #registry registry') + (has #context {.#Some @artifact}) + (revised #interim_artifacts (|>> {.#Item @artifact})))) @module (archive.id (the #module state) archive)] - (in [[bundle' (has #context (the #context state) state')] + (in [(has #context (the #context state) state') [[@module @artifact] output]]))))) (def .public (log! message) (All (_ anchor expression declaration a) (-> Text (Operation anchor expression declaration Any))) - (function (_ [bundle state]) - {try.#Success [[bundle - (revised #log (sequence.suffix message) state)] + (function (_ state) + {try.#Success [(revised #log (sequence.suffix message) state) []]})) (def .public (with_interim_artifacts archive body) @@ -390,11 +389,10 @@ (Operation anchor expression declaration [(List unit.ID) a]))) (do phase.monad [module (extension.read (the #module))] - (function (_ state+) + (function (_ state) (do try.monad [@module (archive.id module archive) - [[bundle' state'] output] (body state+)] - (in [[bundle' - (has #interim_artifacts (list) state')] + [state' output] (body state)] + (in [(has #interim_artifacts (list) state') [(list#each (|>> [@module]) (the #interim_artifacts state')) output]]))))) 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 8637d6b38..fb9a479db 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 @@ -229,9 +229,6 @@ (^.` ([(^., [_ {.#Symbol ["" function_name]}]) (^., [_ {.#Symbol ["" arg_name]}])] (^., body))) (/function.function analysis function_name arg_name archive body) - (^.` ((^., [_ {.#Text extension_name}]) (^.,* extension_args))) - (//extension.apply archive analysis [extension_name extension_args]) - (^.` ((^., functionC) (^.,* argsC+))) (..apply_analysis extender expander analysis archive functionC argsC+) 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 88ce8f82b..1ef820bc9 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 @@ -43,17 +43,6 @@ (type Eval (-> Type Code (Meta Any))) -(def (meta_eval archive bundle compiler_eval) - (-> Archive ///analysis.Bundle evaluation.Eval - Eval) - (function (_ type code lux) - (when (compiler_eval archive type code [bundle lux]) - {try.#Success [[_bundle lux'] value]} - {try.#Success [lux' value]} - - {try.#Failure error} - {try.#Failure error}))) - (def (requiring phase archive expansion) (All (_ anchor expression declaration) (-> (Phase anchor expression declaration) Archive (List Code) @@ -144,20 +133,16 @@ (function (again archive code) (do [! //.monad] [state //.state - .let [analysis (the [//extension.#state /.#analysis /.#phase] state) - compiler_eval (meta_eval archive - (the [//extension.#state /.#analysis /.#state //extension.#bundle] state) - (evaluation.evaluator analysis - [(the [//extension.#state /.#synthesis /.#state] state) - (the [//extension.#state /.#synthesis /.#phase] state)] - [(the [//extension.#state /.#generation /.#state] state) - (the [//extension.#state /.#generation /.#phase] state)])) + .let [analysis (the [/.#analysis /.#phase] state) + compiler_eval ((evaluation.evaluator analysis + [(the [/.#synthesis /.#state] state) + (the [/.#synthesis /.#phase] state)] + [(the [/.#generation /.#state] state) + (the [/.#generation /.#phase] state)]) + archive) extension_eval (as Eval (wrapper (as_expected compiler_eval)))] - _ (//.with (has [//extension.#state /.#analysis /.#state //extension.#state .#eval] extension_eval state))] + _ (//.with (has [/.#analysis /.#state .#eval] extension_eval state))] (when code - [_ {.#Form (list.partial [_ {.#Text name}] inputs)}] - (//extension.apply archive again [name inputs]) - [_ {.#Form (list.partial [_ {.#Symbol macro|extension}] inputs)}] (do ! [expansion|requirements (do ! 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 7a6c27ad8..34786e94f 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 @@ -40,23 +40,20 @@ (|>> list.hash (product.hash text.hash))) -(with_expansions [<Bundle> (these (Dictionary Name (Handler s i o)))] - (type .public (Handler s i o) - (-> Name - (//.Phase [<Bundle> s] i o) - (//.Phase [<Bundle> s] (List i) o))) +(type .public (Handler s i o) + (-> Name + (//.Phase s i o) + (//.Phase s (List i) o))) - (type .public (Bundle s i o) - <Bundle>)) +(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) - (Record - [#bundle (Bundle s i o) - #state s])) + s) (type .public (Operation s i o v) (//.Operation (State s i o) v)) @@ -94,50 +91,16 @@ (type .public (Extender s i o) (-> Any (Handler s i o))) -(def .public (install extender name handler) - (All (_ s i o) - (-> (Extender s i o) Name (Handler s i o) (Operation s i o Any))) - (function (_ [bundle state]) - (when (dictionary.has' name (extender handler) bundle) - {try.#Success bundle'} - {try.#Success [[bundle' state] - []]} - - {try.#Failure _} - (exception.except ..cannot_overwrite name)))) - -(def .public (with extender extensions) - (All (_ s i o) - (-> Extender (Bundle s i o) (Operation s i o Any))) - (|> extensions - dictionary.entries - (monad.mix //.monad - (function (_ [extension handle] output) - (..install extender extension handle)) - []))) - -(def .public (apply archive phase [name parameters]) - (All (_ s i o) - (-> Archive (Phase s i o) (Extension i) (Operation s i o o))) - (function (_ (^.let stateE [bundle state])) - (when (dictionary.value name bundle) - {.#Some handler} - (((handler name phase) archive parameters) - stateE) - - {.#None} - (exception.except ..unknown [name bundle])))) - (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 (_ [bundle state]) + (function (_ state) (let [old (get state)] - (when (operation [bundle (set (transform old) state)]) - {try.#Success [[bundle' state'] output]} - {try.#Success [[bundle' (set old state')] output]} + (when (operation (set (transform old) state)) + {try.#Success [state' output]} + {try.#Success [(set old state') output]} failure failure))))) @@ -147,10 +110,10 @@ (-> (-> s s) (-> (Operation s i o v) (Operation s i o v)))) (function (_ operation) - (function (_ [bundle state]) - (when (operation [bundle (transform state)]) - {try.#Success [[bundle' state'] output]} - {try.#Success [[bundle' state] output]} + (function (_ state) + (when (operation (transform state)) + {try.#Success [state' output]} + {try.#Success [state output]} failure failure)))) @@ -163,22 +126,22 @@ (def .public (read get) (All (_ s i o v) (-> (-> s v) (Operation s i o v))) - (function (_ [bundle state]) - {try.#Success [[bundle state] (get state)]})) + (function (_ state) + {try.#Success [state (get state)]})) (def .public (update transform) (All (_ s i o) (-> (-> s s) (Operation s i o Any))) - (function (_ [bundle state]) - {try.#Success [[bundle (transform state)] []]})) + (function (_ state) + {try.#Success [(transform state) []]})) (def .public (lifted action) (All (_ s i o v) (-> (//.Operation s v) (Operation s i o v))) - (function (_ [bundle state]) + (function (_ state) (when (action state) {try.#Success [state' output]} - {try.#Success [[bundle state'] output]} + {try.#Success [state' output]} {try.#Failure error} {try.#Failure error}))) @@ -187,8 +150,8 @@ (All (_ s i o v) (-> (Operation s i o v) (//.Operation s v))) (function (_ state) - (when (it [..empty state]) - {try.#Success [[_ state'] output]} + (when (it state) + {try.#Success [state' output]} {try.#Success [state' output]} {try.#Failure error} 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 f32eabad5..a164ee5b9 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 @@ -896,7 +896,7 @@ parameters) selfT {.#Primitive name (list#each product.right parameters)}] state (extension.lifted phase.state) - methods (monad.each ! (let [analysis_state (the [declaration.#analysis declaration.#state extension.#state] 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) ((the [declaration.#synthesis declaration.#phase] state) analysis_state) 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 a5300258e..2a96f19a0 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 @@ -104,7 +104,7 @@ (-> Archive Type Code (Operation anchor expression declaration [Type expression Any]))) (do phase.monad [state (///.lifted phase.state) - .let [analysis_state (the [/////declaration.#analysis /////declaration.#state ///.#state] 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) generation ((the [/////declaration.#generation /////declaration.#phase] state) analysis_state)] @@ -151,7 +151,7 @@ (Operation anchor expression declaration [Type expression Any]))) (do [! phase.monad] [state (///.lifted phase.state) - .let [analysis_state (the [/////declaration.#analysis /////declaration.#state ///.#state] 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) generation ((the [/////declaration.#generation /////declaration.#phase] state) analysis_state)] @@ -205,7 +205,7 @@ (Operation anchor expression declaration [expression Any]))) (do phase.monad [state (///.lifted phase.state) - .let [analysis_state (the [/////declaration.#analysis /////declaration.#state ///.#state] 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) generation ((the [/////declaration.#generation /////declaration.#phase] state) analysis_state)] @@ -229,7 +229,7 @@ (All (_ anchor expression declaration) (Operation anchor expression declaration Any)) (do [! phase.monad] - [[bundle state] phase.state + [state phase.state .let [eval (/////analysis/evaluation.evaluator (the [/////declaration.#analysis /////declaration.#phase] state) [(the [/////declaration.#synthesis /////declaration.#state] state) (the [/////declaration.#synthesis /////declaration.#phase] state)] diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux index 8c55204b3..44fb80a79 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 @@ -135,9 +135,6 @@ (synthesis.function/apply application) (/function.apply phase archive application) - {synthesis.#Extension [["" name] parameters]} - (extension.apply archive phase [name parameters]) - {synthesis.#Extension [name parameters]} (extension_application extender lux phase archive name parameters) ))) diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux index 49f847b4d..e1b4ebc8e 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 @@ -22,20 +22,18 @@ ["[1][0]" function] ["[1][0]" when] ["[1][0]" variable] - ["/[1]" // - ["[1][0]" extension] - ["/[1]" // - ["/" synthesis (.only Synthesis Operation Phase Extender Handler) - ["[1][0]" simple]] - ["[1][0]" analysis (.only Analysis) - ["[2][0]" simple] - ["[2][0]" complex]] - [/// - ["[0]" phase (.use "[1]#[0]" monad)] - [reference (.only) - [variable (.only)]] - [meta - [archive (.only Archive)]]]]]]) + ["//[1]" /// + ["/" synthesis (.only Synthesis Operation Phase Extender Handler) + ["[1][0]" simple]] + ["[1][0]" analysis (.only Analysis) + ["[2][0]" simple] + ["[2][0]" complex]] + [/// + ["[0]" phase (.use "[1]#[0]" monad)] + [reference (.only) + [variable (.only)]] + [meta + [archive (.only Archive)]]]]]) (def (simple analysis) (-> ///simple.Simple /simple.Simple) @@ -139,21 +137,6 @@ {///analysis.#Function environmentA bodyA} (/function.abstraction phase environmentA archive bodyA) - {///analysis.#Extension ["" name] args} - (/.with_currying? false - (function (_ state) - (|> (//extension.apply archive phase [name args]) - (phase.result' state) - (pipe.when - {try.#Failure _} - (|> args - (monad.each phase.monad (phase archive)) - (phase#each (|>> [["" name]] {/.#Extension})) - (phase.result' state)) - - success - success)))) - {///analysis.#Extension name parameters} (extension_application extender lux phase archive |