From 853d28f803e75d125915a81dcdcd140513efe3d2 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 26 Jun 2022 19:37:45 -0400 Subject: Re-named directives to declarations. --- stdlib/source/library/lux/extension.lux | 6 +- stdlib/source/library/lux/ffi/export.js.lux | 66 +- stdlib/source/library/lux/ffi/export.lua.lux | 90 +- stdlib/source/library/lux/ffi/export.py.lux | 52 +- stdlib/source/library/lux/ffi/export.rb.lux | 72 +- .../source/library/lux/target/jvm/reflection.lux | 2 +- stdlib/source/library/lux/target/jvm/type/lux.lux | 15 +- .../library/lux/tool/compiler/default/init.lux | 148 ++-- .../library/lux/tool/compiler/default/platform.lux | 92 +- .../lux/tool/compiler/language/lux/declaration.lux | 102 +++ .../lux/tool/compiler/language/lux/directive.lux | 102 --- .../lux/tool/compiler/language/lux/generation.lux | 142 +-- .../compiler/language/lux/phase/declaration.lux | 125 +++ .../tool/compiler/language/lux/phase/directive.lux | 125 --- .../language/lux/phase/extension/analysis/jvm.lux | 46 +- .../lux/phase/extension/declaration/jvm.lux | 978 +++++++++++++++++++++ .../lux/phase/extension/declaration/lux.lux | 570 ++++++++++++ .../language/lux/phase/extension/directive/jvm.lux | 978 --------------------- .../language/lux/phase/extension/directive/lux.lux | 570 ------------ .../lux/phase/extension/generation/php/common.lux | 14 +- .../language/lux/phase/generation/extension.lux | 10 +- .../jvm/function/method/implementation.lux | 2 +- .../phase/generation/jvm/function/method/init.lux | 2 +- .../phase/generation/jvm/function/method/reset.lux | 2 +- .../language/lux/phase/generation/jvm/host.lux | 2 +- .../language/lux/phase/generation/lua/loop.lux | 42 +- .../language/lux/phase/generation/php/case.lux | 6 +- .../language/lux/phase/generation/php/loop.lux | 28 +- .../language/lux/phase/generation/python/case.lux | 8 +- .../lux/phase/generation/python/function.lux | 58 +- .../language/lux/phase/generation/python/loop.lux | 36 +- .../language/lux/phase/generation/reference.lux | 8 +- .../lux/tool/compiler/language/lux/program.lux | 4 +- .../compiler/meta/archive/artifact/category.lux | 4 +- .../lux/tool/compiler/meta/archive/registry.lux | 8 +- .../compiler/meta/cache/dependency/artifact.lux | 8 +- .../library/lux/tool/compiler/meta/io/archive.lux | 68 +- .../lux/tool/compiler/meta/packager/ruby.lux | 6 +- .../lux/tool/compiler/meta/packager/scheme.lux | 6 +- .../lux/tool/compiler/meta/packager/script.lux | 22 +- stdlib/source/library/lux/tool/interpreter.lux | 80 +- 41 files changed, 2353 insertions(+), 2352 deletions(-) create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/declaration.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/directive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/declaration.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/jvm.lux create mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/lux.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux delete mode 100644 stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index 9c3946a30..cfa13af9b 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -31,7 +31,7 @@ #archive Text #inputs (List Code)])) -(def (declaration default) +(def (declarationP default) (-> Code (Parser Declaration)) (.form (all <>.and .any @@ -42,7 +42,7 @@ (with_template [ ] [(def .public - (syntax (_ [[name extension phase archive inputs] (..declaration (` )) + (syntax (_ [[name extension phase archive inputs] (..declarationP (` )) body .any]) (let [g!name (code.local extension) g!phase (code.local phase) @@ -66,5 +66,5 @@ [.any .end .and .result "lux def analysis" analysis] [.any .end .and .result "lux def synthesis" synthesis] [.any .end .and .result "lux def generation" generation] - [.any .end .and .result "lux def directive" directive] + [.any .end .and .result "lux def declaration" declaration] ) diff --git a/stdlib/source/library/lux/ffi/export.js.lux b/stdlib/source/library/lux/ffi/export.js.lux index e40ea1964..a887d9f84 100644 --- a/stdlib/source/library/lux/ffi/export.js.lux +++ b/stdlib/source/library/lux/ffi/export.js.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - [extension (.only directive)] + [extension (.only declaration)] ["[0]" meta] ["[0]" static] [abstract @@ -32,7 +32,7 @@ [language [lux ["[0]" generation] - ["[0]" directive] + ["[0]" declaration] [analysis ["[0]" type]]]]]]]]) @@ -49,41 +49,41 @@ (with_expansions [ (static.random (|>> %.nat (%.format "lua export ") code.text) random.nat)] - (directive ( self phase archive [name .text - term .any]) - (do [! phase.monad] - [next directive.analysis - [_ term] (<| directive.lifted_analysis - type.inferring - (next archive term)) + (declaration ( self phase archive [name .text + term .any]) + (do [! phase.monad] + [next declaration.analysis + [_ term] (<| declaration.lifted_analysis + type.inferring + (next archive term)) - next directive.synthesis - term (directive.lifted_synthesis - (next archive term)) + next declaration.synthesis + term (declaration.lifted_synthesis + (next archive term)) - dependencies (directive.lifted_generation - (dependency.dependencies archive term)) + dependencies (declaration.lifted_generation + (dependency.dependencies archive term)) - next directive.generation - [interim_artifacts term] (directive.lifted_generation - (generation.with_interim_artifacts archive - (next archive term))) + next declaration.generation + [interim_artifacts term] (declaration.lifted_generation + (generation.with_interim_artifacts archive + (next archive term))) - _ (directive.lifted_generation - (do ! - [@self (generation.learn_custom name (list#mix set.has dependencies interim_artifacts)) - .let [$module (/.var "module") - $exports (/.the "exports" $module) - definition (/.define (/.var name) term) - export (/.when (/.not (/.= (/.string "undefined") (/.type_of $module))) - (/.set (/.the name $exports) (/.var name))) - code (all /.then - definition - export)] - _ (generation.execute! definition) - _ (generation.save! @self {.#None} code)] - (generation.log! (%.format "Export " (%.text name)))))] - (in directive.no_requirements))) + _ (declaration.lifted_generation + (do ! + [@self (generation.learn_custom name (list#mix set.has dependencies interim_artifacts)) + .let [$module (/.var "module") + $exports (/.the "exports" $module) + definition (/.define (/.var name) term) + export (/.when (/.not (/.= (/.string "undefined") (/.type_of $module))) + (/.set (/.the name $exports) (/.var name))) + code (all /.then + definition + export)] + _ (generation.execute! definition) + _ (generation.save! @self {.#None} code)] + (generation.log! (%.format "Export " (%.text name)))))] + (in declaration.no_requirements))) (def .public export (syntax (_ [exports (<>.many .any)]) diff --git a/stdlib/source/library/lux/ffi/export.lua.lux b/stdlib/source/library/lux/ffi/export.lua.lux index 66b98998d..c38eaf711 100644 --- a/stdlib/source/library/lux/ffi/export.lua.lux +++ b/stdlib/source/library/lux/ffi/export.lua.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - [extension (.only directive)] + [extension (.only declaration)] ["[0]" meta] ["[0]" static] [abstract @@ -32,7 +32,7 @@ [language [lux ["[0]" generation] - ["[0]" directive] + ["[0]" declaration] [analysis ["[0]" type]]]]]]]]) @@ -53,53 +53,53 @@ (with_expansions [ (static.random (|>> %.nat (%.format "lua export ") code.text) random.nat)] - (directive ( self phase archive [name .text - term .any]) - (do [! phase.monad] - [next directive.analysis - [_ term] (<| directive.lifted_analysis - type.inferring - (next archive term)) + (declaration ( self phase archive [name .text + term .any]) + (do [! phase.monad] + [next declaration.analysis + [_ term] (<| declaration.lifted_analysis + type.inferring + (next archive term)) - next directive.synthesis - term (directive.lifted_synthesis - (next archive term)) + next declaration.synthesis + term (declaration.lifted_synthesis + (next archive term)) - dependencies (directive.lifted_generation - (dependency.dependencies archive term)) + dependencies (declaration.lifted_generation + (dependency.dependencies archive term)) - next directive.generation - [interim_artifacts term] (directive.lifted_generation - (generation.with_interim_artifacts archive - (next archive term))) + next declaration.generation + [interim_artifacts term] (declaration.lifted_generation + (generation.with_interim_artifacts archive + (next archive term))) - _ (directive.lifted_generation - (do ! - [@self (generation.learn_custom name (list#mix set.has dependencies interim_artifacts)) - .let [$exports (/.var "_REQUIREDNAME") - $global (/.var "_G") - exporting? (/.not (/.= /.nil $exports)) - no_exports? (/.= /.nil (/.item $exports $global)) - initialize_exports! (/.set (list (/.item $exports $global)) (/.table (list))) - export_definition! (/.set (|> $global - (/.item $exports) - (/.item (/.string name)) - (list)) - (/.var name)) - export! (/.when exporting? - (all /.then - (/.when no_exports? - initialize_exports!) - export_definition! - ))] - _ (generation.execute! (all /.then - (/.set (list (/.var name)) term) - export!)) - _ (generation.save! @self {.#None} (all /.then - (/.local/1 (/.var name) term) - export!))] - (generation.log! (%.format "Export " (%.text name)))))] - (in directive.no_requirements))) + _ (declaration.lifted_generation + (do ! + [@self (generation.learn_custom name (list#mix set.has dependencies interim_artifacts)) + .let [$exports (/.var "_REQUIREDNAME") + $global (/.var "_G") + exporting? (/.not (/.= /.nil $exports)) + no_exports? (/.= /.nil (/.item $exports $global)) + initialize_exports! (/.set (list (/.item $exports $global)) (/.table (list))) + export_definition! (/.set (|> $global + (/.item $exports) + (/.item (/.string name)) + (list)) + (/.var name)) + export! (/.when exporting? + (all /.then + (/.when no_exports? + initialize_exports!) + export_definition! + ))] + _ (generation.execute! (all /.then + (/.set (list (/.var name)) term) + export!)) + _ (generation.save! @self {.#None} (all /.then + (/.local/1 (/.var name) term) + export!))] + (generation.log! (%.format "Export " (%.text name)))))] + (in declaration.no_requirements))) (def .public export (syntax (_ [exports (<>.many .any)]) diff --git a/stdlib/source/library/lux/ffi/export.py.lux b/stdlib/source/library/lux/ffi/export.py.lux index 42309927e..be61ff11e 100644 --- a/stdlib/source/library/lux/ffi/export.py.lux +++ b/stdlib/source/library/lux/ffi/export.py.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except) - [extension (.only directive)] + [extension (.only declaration)] ["[0]" meta] ["[0]" static] [abstract @@ -32,7 +32,7 @@ [language [lux ["[0]" generation] - ["[0]" directive] + ["[0]" declaration] [analysis ["[0]" type]]]]]]]]) @@ -49,34 +49,34 @@ (with_expansions [ (static.random (|>> %.nat (%.format "python export ") code.text) random.nat)] - (directive ( self phase archive [name .text - term .any]) - (do [! phase.monad] - [next directive.analysis - [_ term] (<| directive.lifted_analysis - type.inferring - (next archive term)) + (declaration ( self phase archive [name .text + term .any]) + (do [! phase.monad] + [next declaration.analysis + [_ term] (<| declaration.lifted_analysis + type.inferring + (next archive term)) - next directive.synthesis - term (directive.lifted_synthesis - (next archive term)) + next declaration.synthesis + term (declaration.lifted_synthesis + (next archive term)) - dependencies (directive.lifted_generation - (dependency.dependencies archive term)) + dependencies (declaration.lifted_generation + (dependency.dependencies archive term)) - next directive.generation - [interim_artifacts term] (directive.lifted_generation - (generation.with_interim_artifacts archive - (next archive term))) + next declaration.generation + [interim_artifacts term] (declaration.lifted_generation + (generation.with_interim_artifacts archive + (next archive term))) - _ (directive.lifted_generation - (do ! - [@self (generation.learn_custom name (list#mix set.has dependencies interim_artifacts)) - .let [code (/.set (list (/.item (/.string name) /.globals/0)) term)] - _ (generation.execute! code) - _ (generation.save! @self {.#None} code)] - (generation.log! (%.format "Export " (%.text name)))))] - (in directive.no_requirements))) + _ (declaration.lifted_generation + (do ! + [@self (generation.learn_custom name (list#mix set.has dependencies interim_artifacts)) + .let [code (/.set (list (/.item (/.string name) /.globals/0)) term)] + _ (generation.execute! code) + _ (generation.save! @self {.#None} code)] + (generation.log! (%.format "Export " (%.text name)))))] + (in declaration.no_requirements))) (def .public export (syntax (_ [exports (<>.many .any)]) diff --git a/stdlib/source/library/lux/ffi/export.rb.lux b/stdlib/source/library/lux/ffi/export.rb.lux index 6777bfa86..b29982a1c 100644 --- a/stdlib/source/library/lux/ffi/export.rb.lux +++ b/stdlib/source/library/lux/ffi/export.rb.lux @@ -1,7 +1,7 @@ (.require [library [lux (.except global) - [extension (.only directive)] + [extension (.only declaration)] ["[0]" meta] ["[0]" static] ["[0]" type] @@ -34,7 +34,7 @@ [language [lux ["[0]" generation] - ["[0]" directive] + ["[0]" declaration] ["[0]" analysis ["[1]" type]]]]]]]]) @@ -87,45 +87,45 @@ (with_expansions [ (static.random (|>> %.nat (%.format "ruby export ") code.text) random.nat)] - (directive ( self phase archive [global? .bit - name .text - term .any]) - (do [! phase.monad] - [next directive.analysis - [type term] (<| directive.lifted_analysis - analysis.inferring - (next archive term)) + (declaration ( self phase archive [global? .bit + name .text + term .any]) + (do [! phase.monad] + [next declaration.analysis + [type term] (<| declaration.lifted_analysis + analysis.inferring + (next archive term)) - next directive.synthesis - term (directive.lifted_synthesis - (next archive term)) + next declaration.synthesis + term (declaration.lifted_synthesis + (next archive term)) - dependencies (directive.lifted_generation - (dependency.dependencies archive term)) + dependencies (declaration.lifted_generation + (dependency.dependencies archive term)) - next directive.generation - [interim_artifacts term] (directive.lifted_generation - (generation.with_interim_artifacts archive - (next archive term))) + next declaration.generation + [interim_artifacts term] (declaration.lifted_generation + (generation.with_interim_artifacts archive + (next archive term))) - _ (directive.lifted_generation - (do ! - [@self (generation.learn_custom name (list#mix set.has dependencies interim_artifacts)) - .let [[:input:/* :output:] (type.flat_function type) - code (if global? - (/.set (list (/.manual name)) term) - (case :input:/* - {.#End} - (/.function (/.manual name) (list) - (/.return term)) + _ (declaration.lifted_generation + (do ! + [@self (generation.learn_custom name (list#mix set.has dependencies interim_artifacts)) + .let [[:input:/* :output:] (type.flat_function type) + code (if global? + (/.set (list (/.manual name)) term) + (case :input:/* + {.#End} + (/.function (/.manual name) (list) + (/.return term)) - _ - (/.statement (/.apply (list (/.string name) term) {.#None} - (/.manual "define_method")))))] - _ (generation.execute! code) - _ (generation.save! @self {.#None} code)] - (generation.log! (%.format "Export " (%.text name)))))] - (in directive.no_requirements))) + _ + (/.statement (/.apply (list (/.string name) term) {.#None} + (/.manual "define_method")))))] + _ (generation.execute! code) + _ (generation.save! @self {.#None} code)] + (generation.log! (%.format "Export " (%.text name)))))] + (in declaration.no_requirements))) (def .public export (syntax (_ [exports (<>.many .any)]) diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux index 4922fd23e..7a5bdebc0 100644 --- a/stdlib/source/library/lux/target/jvm/reflection.lux +++ b/stdlib/source/library/lux/target/jvm/reflection.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Primitive parameter) + [lux (.except Primitive parameter type) ["[0]" ffi (.only import)] ["[0]" type] [abstract diff --git a/stdlib/source/library/lux/target/jvm/type/lux.lux b/stdlib/source/library/lux/target/jvm/type/lux.lux index b68215990..6f2ab6b47 100644 --- a/stdlib/source/library/lux/target/jvm/type/lux.lux +++ b/stdlib/source/library/lux/target/jvm/type/lux.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Primitive int char parameter) + [lux (.except Primitive int char parameter type) [abstract ["[0]" monad (.only do)]] [control @@ -16,7 +16,7 @@ ["[0]" array] ["[0]" dictionary (.only Dictionary)]]] [type - [primitive (.except)] + [":" primitive] ["[0]" check (.only Check) (.use "[1]#[0]" monad)]]]] ["[0]" // (.only) [category (.only Void Value Return Method Primitive Object Class Array Var Parameter)] @@ -30,12 +30,13 @@ ["[1][0]" name]]]]) (with_template [] - [(primitive .public ( class) Any)] + [(:.primitive .public ( class) Any)] - [Lower] [Upper] + [Lower] + [Upper] ) -(type .public Mapping +(.type .public Mapping (Dictionary Text Type)) (def .public fresh @@ -186,10 +187,10 @@ [//reflection.double] [//reflection.char])))) {.#Primitive (|> name //reflection.class //reflection.array //reflection.reflection) {.#End}} - (|> elementT array.Array .type)) + (|> elementT array.Array type_literal)) _ - (|> elementT array.Array .type))))) + (|> elementT array.Array type_literal))))) (<>.after (.this //descriptor.array_prefix)))) (def .public (type mapping) diff --git a/stdlib/source/library/lux/tool/compiler/default/init.lux b/stdlib/source/library/lux/tool/compiler/default/init.lux index f9c201df1..f966f9b63 100644 --- a/stdlib/source/library/lux/tool/compiler/default/init.lux +++ b/stdlib/source/library/lux/tool/compiler/default/init.lux @@ -31,7 +31,7 @@ [program (.only Program)] ["[1][0]" syntax (.only Aliases)] ["[1][0]" synthesis] - ["[1][0]" directive (.only Requirements)] + ["[1][0]" declaration (.only Requirements)] ["[1][0]" generation] ["[1][0]" analysis (.only) [macro (.only Expander)] @@ -40,11 +40,11 @@ [phase ["[0]P" analysis] ["[0]P" synthesis] - ["[0]P" directive] + ["[0]P" declaration] ["[0]" extension (.only Extender) ["[0]E" analysis] ["[0]E" synthesis] - [directive + [declaration ["[0]D" lux]]]]]] [meta ["[0]" archive (.only Archive) @@ -54,41 +54,41 @@ ["[0]" document]]]]]]) (def .public (state target module configuration expander host_analysis host generate generation_bundle) - (All (_ anchor expression directive) + (All (_ anchor expression declaration) (-> Target descriptor.Module Configuration Expander ///analysis.Bundle - (///generation.Host expression directive) - (///generation.Phase anchor expression directive) - (///generation.Bundle anchor expression directive) - (///directive.State+ anchor expression directive))) + (///generation.Host expression declaration) + (///generation.Phase anchor expression declaration) + (///generation.Bundle anchor expression declaration) + (///declaration.State+ anchor expression declaration))) (let [synthesis_state [synthesisE.bundle ///synthesis.init] generation_state [generation_bundle (///generation.state host module)] eval (///analysis/evaluation.evaluator expander synthesis_state generation_state generate) analysis_state [(analysisE.bundle eval host_analysis) (///analysis.state (///analysis.info version.latest target configuration))]] [extension.empty - [///directive.#analysis [///directive.#state analysis_state - ///directive.#phase (analysisP.phase expander)] - ///directive.#synthesis [///directive.#state synthesis_state - ///directive.#phase synthesisP.phase] - ///directive.#generation [///directive.#state generation_state - ///directive.#phase generate]]])) + [///declaration.#analysis [///declaration.#state analysis_state + ///declaration.#phase (analysisP.phase expander)] + ///declaration.#synthesis [///declaration.#state synthesis_state + ///declaration.#phase synthesisP.phase] + ///declaration.#generation [///declaration.#state generation_state + ///declaration.#phase generate]]])) -(def .public (with_default_directives expander host_analysis program anchorT,expressionT,directiveT extender) - (All (_ anchor expression directive) +(def .public (with_default_declarations expander host_analysis program anchorT,expressionT,declarationT extender) + (All (_ anchor expression declaration) (-> Expander ///analysis.Bundle - (Program expression directive) + (Program expression declaration) [Type Type Type] Extender - (-> (///directive.State+ anchor expression directive) - (///directive.State+ anchor expression directive)))) - (function (_ [directive_extensions sub_state]) - [(dictionary.composite directive_extensions - (luxD.bundle expander host_analysis program anchorT,expressionT,directiveT extender)) + (-> (///declaration.State+ anchor expression declaration) + (///declaration.State+ anchor expression declaration)))) + (function (_ [declaration_extensions sub_state]) + [(dictionary.composite declaration_extensions + (luxD.bundle expander host_analysis program anchorT,expressionT,declarationT extender)) sub_state])) (type Reader @@ -115,22 +115,22 @@ [source' output]]})))) (type (Operation a) - (All (_ anchor expression directive) - (///directive.Operation anchor expression directive a))) + (All (_ anchor expression declaration) + (///declaration.Operation anchor expression declaration a))) -(type (Payload directive) - [(///generation.Buffer directive) +(type (Payload declaration) + [(///generation.Buffer declaration) Registry]) (def (begin dependencies hash input) (-> (List descriptor.Module) Nat ///.Input - (All (_ anchor expression directive) - (///directive.Operation anchor expression directive - [Source (Payload directive)]))) + (All (_ anchor expression declaration) + (///declaration.Operation anchor expression declaration + [Source (Payload declaration)]))) (do ///phase.monad [.let [module (the ///.#module input)] - _ (///directive.set_current_module module)] - (///directive.lifted_analysis + _ (///declaration.set_current_module module)] + (///declaration.lifted_analysis (do [! ///phase.monad] [_ (moduleA.create hash module) _ (monad.each ! moduleA.import dependencies) @@ -141,74 +141,74 @@ (def (end module) (-> descriptor.Module - (All (_ anchor expression directive) - (///directive.Operation anchor expression directive [.Module (Payload directive)]))) + (All (_ anchor expression declaration) + (///declaration.Operation anchor expression declaration [.Module (Payload declaration)]))) (do ///phase.monad - [_ (///directive.lifted_analysis + [_ (///declaration.lifted_analysis (moduleA.set_compiled module)) analysis_module (<| (is (Operation .Module)) - ///directive.lifted_analysis + ///declaration.lifted_analysis extension.lifted meta.current_module) - final_buffer (///directive.lifted_generation + final_buffer (///declaration.lifted_generation ///generation.buffer) - final_registry (///directive.lifted_generation + final_registry (///declaration.lifted_generation ///generation.get_registry)] (in [analysis_module [final_buffer final_registry]]))) ... TODO: Inline ASAP (def (get_current_payload _) - (All (_ directive) - (-> (Payload directive) + (All (_ declaration) + (-> (Payload declaration) (All (_ anchor expression) - (///directive.Operation anchor expression directive - (Payload directive))))) + (///declaration.Operation anchor expression declaration + (Payload declaration))))) (do ///phase.monad - [buffer (///directive.lifted_generation + [buffer (///declaration.lifted_generation ///generation.buffer) - registry (///directive.lifted_generation + registry (///declaration.lifted_generation ///generation.get_registry)] (in [buffer registry]))) ... TODO: Inline ASAP -(def (process_directive wrapper archive expander pre_payoad code) - (All (_ directive) - (-> ///phase.Wrapper Archive Expander (Payload directive) Code +(def (process_declaration wrapper archive expander pre_payoad code) + (All (_ declaration) + (-> ///phase.Wrapper Archive Expander (Payload declaration) Code (All (_ anchor expression) - (///directive.Operation anchor expression directive - [Requirements (Payload directive)])))) + (///declaration.Operation anchor expression declaration + [Requirements (Payload declaration)])))) (do ///phase.monad [.let [[pre_buffer pre_registry] pre_payoad] - _ (///directive.lifted_generation + _ (///declaration.lifted_generation (///generation.set_buffer pre_buffer)) - _ (///directive.lifted_generation + _ (///declaration.lifted_generation (///generation.set_registry pre_registry)) - requirements (let [execute! (directiveP.phase wrapper expander)] + requirements (let [execute! (declarationP.phase wrapper expander)] (execute! archive code)) post_payload (..get_current_payload pre_payoad)] (in [requirements post_payload]))) (def (iteration' wrapper archive expander reader source pre_payload) - (All (_ directive) - (-> ///phase.Wrapper Archive Expander Reader Source (Payload directive) + (All (_ declaration) + (-> ///phase.Wrapper Archive Expander Reader Source (Payload declaration) (All (_ anchor expression) - (///directive.Operation anchor expression directive - [Source Requirements (Payload directive)])))) + (///declaration.Operation anchor expression declaration + [Source Requirements (Payload declaration)])))) (do ///phase.monad - [[source code] (///directive.lifted_analysis + [[source code] (///declaration.lifted_analysis (..read source reader)) - [requirements post_payload] (process_directive wrapper archive expander pre_payload code)] + [requirements post_payload] (process_declaration wrapper archive expander pre_payload code)] (in [source requirements post_payload]))) (def (iteration wrapper archive expander module source pre_payload aliases) - (All (_ directive) - (-> ///phase.Wrapper Archive Expander descriptor.Module Source (Payload directive) Aliases + (All (_ declaration) + (-> ///phase.Wrapper Archive Expander descriptor.Module Source (Payload declaration) Aliases (All (_ anchor expression) - (///directive.Operation anchor expression directive - (Maybe [Source Requirements (Payload directive)]))))) + (///declaration.Operation anchor expression declaration + (Maybe [Source Requirements (Payload declaration)]))))) (do ///phase.monad - [reader (///directive.lifted_analysis + [reader (///declaration.lifted_analysis (..reader module aliases source))] (function (_ state) (case (///phase.result' state (..iteration' wrapper archive expander reader source pre_payload)) @@ -231,11 +231,11 @@ (-> .Module Aliases) (|>> (the .#module_aliases) (dictionary.of_list text.hash))) -(def .public (compiler wrapper expander prelude write_directive) - (All (_ anchor expression directive) - (-> ///phase.Wrapper Expander descriptor.Module (-> directive Binary) - (Instancer (///directive.State+ anchor expression directive) .Module))) - (let [execute! (directiveP.phase wrapper expander)] +(def .public (compiler wrapper expander prelude write_declaration) + (All (_ anchor expression declaration) + (-> ///phase.Wrapper Expander descriptor.Module (-> declaration Binary) + (Instancer (///declaration.State+ anchor expression declaration) .Module))) + (let [execute! (declarationP.phase wrapper expander)] (function (_ key parameters input) (let [dependencies (default_dependencies prelude input)] [///.#dependencies dependencies @@ -262,8 +262,8 @@ {.#Right [[module.#id (try.else module.runtime (archive.id module archive)) module.#descriptor descriptor module.#document (document.document key analysis_module)] - (sequence#each (function (_ [artifact_id custom directive]) - [artifact_id custom (write_directive directive)]) + (sequence#each (function (_ [artifact_id custom declaration]) + [artifact_id custom (write_declaration declaration)]) final_buffer) final_registry]}])) @@ -271,21 +271,21 @@ (let [[temporary_buffer temporary_registry] temporary_payload] (in [state {.#Left [///.#dependencies (|> requirements - (the ///directive.#imports) + (the ///declaration.#imports) (list#each product.left)) ///.#process (function (_ state archive) (again (<| (///phase.result' state) (do [! ///phase.monad] [analysis_module (<| (is (Operation .Module)) - ///directive.lifted_analysis + ///declaration.lifted_analysis extension.lifted meta.current_module) - _ (///directive.lifted_generation + _ (///declaration.lifted_generation (///generation.set_buffer temporary_buffer)) - _ (///directive.lifted_generation + _ (///declaration.lifted_generation (///generation.set_registry temporary_registry)) _ (|> requirements - (the ///directive.#referrals) + (the ///declaration.#referrals) (monad.each ! (execute! archive))) temporary_payload (..get_current_payload temporary_payload)] (..iteration wrapper archive expander module source temporary_payload (..module_aliases analysis_module))))))]}])) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 0f893a1dc..492644edc 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -20,7 +20,7 @@ ["[0]" binary (.only Binary) ["_" \\format (.only Format)]] ["[0]" text (.use "[1]#[0]" equivalence) - ["%" \\format (.only format)]] + ["%" \\format]] [collection ["[0]" dictionary (.only Dictionary)] ["[0]" sequence (.only Sequence) (.use "[1]#[0]" mix)] @@ -44,7 +44,7 @@ ["[0]" syntax] ["[1][0]" synthesis] ["[1][0]" generation (.only Buffer)] - ["[1][0]" directive] + ["[1][0]" declaration] ["[1][0]" analysis (.only) [macro (.only Expander)] ["[0]A" module]] @@ -71,16 +71,16 @@ ["[1]" context] ["ioW" archive]]]]]) -(with_expansions [ (these anchor expression directive) +(with_expansions [ (these anchor expression declaration) (these ///generation.Operation )] (type .public (Platform ) (Record [#file_system (file.System Async) - #host (///generation.Host expression directive) + #host (///generation.Host expression declaration) #phase (///generation.Phase ) #runtime ( [Registry Output]) #phase_wrapper (-> Archive ( ///phase.Wrapper)) - #write (-> directive Binary)])) + #write (-> declaration Binary)])) ... TODO: Get rid of this (type (Action a) @@ -92,7 +92,7 @@ (try.with async.monad))) (with_expansions [ (these (Platform )) - (these (///directive.State+ )) + (these (///declaration.State+ )) (these (///generation.Bundle ))] (def (format //) @@ -175,10 +175,10 @@ (def (process_runtime archive platform) (All (_ ) (-> Archive - (///directive.Operation - [Archive (archive.Entry .Module)]))) + (///declaration.Operation + [Archive (archive.Entry .Module)]))) (do ///phase.monad - [[registry payload] (///directive.lifted_generation + [[registry payload] (///declaration.lifted_generation (..compile_runtime! platform)) .let [entry [..runtime_module payload registry]] archive (///phase.lifted (if (archive.reserved? archive descriptor.runtime) @@ -192,7 +192,7 @@ [analysers synthesizers generators - directives] + declarations] analysis_state state) (All (_ ) @@ -200,24 +200,24 @@ [(Dictionary Text ///analysis.Handler) (Dictionary Text ///synthesis.Handler) (Dictionary Text (///generation.Handler )) - (Dictionary Text (///directive.Handler ))] + (Dictionary Text (///declaration.Handler ))] .Lux (Try ))) (|> (sharing [] (is state) - (is (///directive.Operation Any) + (is (///declaration.Operation Any) (do [! ///phase.monad] - [_ (///directive.lifted_analysis + [_ (///declaration.lifted_analysis (do ! [_ (///analysis.set_state analysis_state)] (extension.with extender analysers))) - _ (///directive.lifted_synthesis + _ (///declaration.lifted_synthesis (extension.with extender synthesizers)) - _ (///directive.lifted_generation + _ (///declaration.lifted_generation (extension.with extender (as_expected generators))) - _ (extension.with extender (as_expected directives))] + _ (extension.with extender (as_expected declarations))] (in [])))) (///phase.result' state) (at try.monad each product.left))) @@ -227,27 +227,27 @@ (-> Archive (Try [ ///phase.Wrapper]))) (|> archive ((the #phase_wrapper platform)) - ///directive.lifted_generation + ///declaration.lifted_generation (///phase.result' state))) - (def (complete_extensions host_directive_bundle phase_wrapper [analysers synthesizers generators directives]) + (def (complete_extensions host_declaration_bundle phase_wrapper [analysers synthesizers generators declarations]) (All (_ ) - (-> (-> ///phase.Wrapper (///directive.Bundle )) + (-> (-> ///phase.Wrapper (///declaration.Bundle )) ///phase.Wrapper [(Dictionary Text ///analysis.Handler) (Dictionary Text ///synthesis.Handler) (Dictionary Text (///generation.Handler )) - (Dictionary Text (///directive.Handler ))] + (Dictionary Text (///declaration.Handler ))] [(Dictionary Text ///analysis.Handler) (Dictionary Text ///synthesis.Handler) (Dictionary Text (///generation.Handler )) - (Dictionary Text (///directive.Handler ))])) + (Dictionary Text (///declaration.Handler ))])) [analysers synthesizers generators - (dictionary.composite directives (host_directive_bundle phase_wrapper))]) + (dictionary.composite declarations (host_declaration_bundle phase_wrapper))]) - (def .public (initialize context module expander host_analysis platform generation_bundle host_directive_bundle program anchorT,expressionT,directiveT extender + (def .public (initialize context module expander host_analysis platform generation_bundle host_declaration_bundle program anchorT,expressionT,declarationT extender import compilation_sources compilation_configuration) (All (_ ) (-> context.Context @@ -256,8 +256,8 @@ ///analysis.Bundle - (-> ///phase.Wrapper (///directive.Bundle )) - (Program expression directive) + (-> ///phase.Wrapper (///declaration.Bundle )) + (Program expression declaration) [Type Type Type] (-> ///phase.Wrapper Extender) Import (List _io.Context) Configuration (Async (Try [ Archive ///phase.Wrapper])))) @@ -275,7 +275,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 (_ ) - (-> (Program expression directive) + (-> (Program expression declaration) (Async (Try [///phase.Wrapper ])))) (function (_ platform program state) (async#in @@ -283,9 +283,9 @@ [[state phase_wrapper] (..phase_wrapper archive platform state)] (|> state (initialize_state (extender phase_wrapper) - (as_expected (..complete_extensions host_directive_bundle phase_wrapper (as_expected bundles))) + (as_expected (..complete_extensions host_declaration_bundle phase_wrapper (as_expected bundles))) analysis_state) - (try#each (|>> (//init.with_default_directives expander host_analysis program anchorT,expressionT,directiveT (extender phase_wrapper)) + (try#each (|>> (//init.with_default_declarations expander host_analysis program anchorT,expressionT,declarationT (extender phase_wrapper)) [phase_wrapper])))))))]] (if (archive.archived? archive descriptor.runtime) (do ! @@ -301,26 +301,26 @@ (in [state archive phase_wrapper]))))) (def compilation_log_separator - (format text.new_line text.tab)) + (%.format text.new_line text.tab)) (def (module_compilation_log module) (All (_ ) (-> descriptor.Module Text)) (|>> (the [extension.#state - ///directive.#generation - ///directive.#state + ///declaration.#generation + ///declaration.#state extension.#state ///generation.#log]) (sequence#mix (function (_ right left) - (format left ..compilation_log_separator right)) + (%.format left ..compilation_log_separator right)) module))) (def with_reset_log (All (_ ) (-> )) (has [extension.#state - ///directive.#generation - ///directive.#state + ///declaration.#generation + ///declaration.#state extension.#state ///generation.#log] sequence.empty)) @@ -447,10 +447,10 @@ [inherited (with_extensions (the from) (the state))] (in (has inherited state))))] - [with_analysis_extensions [extension.#state ///directive.#analysis ///directive.#state extension.#bundle]] - [with_synthesis_extensions [extension.#state ///directive.#synthesis ///directive.#state extension.#bundle]] - [with_generation_extensions [extension.#state ///directive.#generation ///directive.#state extension.#bundle]] - [with_directive_extensions [extension.#bundle]] + [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) @@ -460,7 +460,7 @@ [state (with_analysis_extensions from state) state (with_synthesis_extensions from state) state (with_generation_extensions from state)] - (with_directive_extensions from state))) + (with_declaration_extensions from state))) (type (Context state) [Archive state]) @@ -600,8 +600,8 @@ with_modules (is (All (_ ) (-> )) (revised [extension.#state - ///directive.#analysis - ///directive.#state + ///declaration.#analysis + ///declaration.#state extension.#state] (is (All (_ a) (-> a a)) (function (_ analysis_state) @@ -620,7 +620,7 @@ (def (set_current_module module state) (All (_ ) (-> descriptor.Module )) - (|> (///directive.set_current_module module) + (|> (///declaration.set_current_module module) (///phase.result' state) try.trusted product.left)) @@ -685,9 +685,9 @@ (Try [ (Either (///.Compilation .Module Any) (archive.Entry Any))]))) ((the ///.#process compilation) - ... TODO: The "///directive.set_current_module" below shouldn't be necessary. Remove it ASAP. + ... 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. - (|> (///directive.set_current_module module) + (|> (///declaration.set_current_module module) (///phase.result' state) try.trusted product.left) @@ -856,8 +856,8 @@ [context (import! (list) descriptor.runtime /#module) .let [[archive state] context meta_state (the [extension.#state - ///directive.#analysis - ///directive.#state + ///declaration.#analysis + ///declaration.#state extension.#state] state)] [_ /#type /#value] (|> /#definition diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/declaration.lux b/stdlib/source/library/lux/tool/compiler/language/lux/declaration.lux new file mode 100644 index 000000000..1f2b4505a --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/declaration.lux @@ -0,0 +1,102 @@ +(.require + [library + [lux (.except Module) + [abstract + [monad (.only do)]] + [control + ["[0]" try]] + [data + [collection + ["[0]" list (.use "[1]#[0]" monoid)]]]]] + [// + ["[0]" analysis] + ["[0]" synthesis] + ["[0]" generation] + [phase + ["[0]" extension]] + [/// + ["[0]" phase] + [meta + [archive + [module + [descriptor (.only Module)]]]]]]) + +(type .public (Component state phase) + (Record + [#state state + #phase phase])) + +(type .public (State anchor expression declaration) + (Record + [#analysis (Component analysis.State+ + analysis.Phase) + #synthesis (Component synthesis.State+ + synthesis.Phase) + #generation (Component (generation.State+ anchor expression declaration) + (generation.Phase anchor expression declaration))])) + +(type .public Import + (Record + [#module Module + #alias Text])) + +(type .public Requirements + (Record + [#imports (List Import) + #referrals (List Code)])) + +(def .public no_requirements + Requirements + [#imports (list) + #referrals (list)]) + +(def .public (merge_requirements left right) + (-> Requirements Requirements Requirements) + [#imports (list#composite (the #imports left) (the #imports right)) + #referrals (list#composite (the #referrals left) (the #referrals right))]) + +(with_template [ ] + [(type .public ( anchor expression declaration) + ( (..State anchor expression declaration) Code Requirements))] + + [State+ extension.State] + [Operation extension.Operation] + [Phase extension.Phase] + [Handler extension.Handler] + [Bundle extension.Bundle] + ) + +(with_template [ ] + [(def .public + (All (_ anchor expression declaration) + (Operation anchor expression declaration )) + (function (_ [bundle state]) + {try.#Success [[bundle state] (the [ ..#phase] state)]}))] + + [analysis ..#analysis analysis.Phase] + [synthesis ..#synthesis synthesis.Phase] + [generation ..#generation (generation.Phase anchor expression declaration)] + ) + +(with_template [ ] + [(def .public + (All (_ anchor expression declaration output) + (-> ( output) + (Operation anchor expression declaration output))) + (|>> (phase.sub [(the [ ..#state]) + (has [ ..#state])]) + extension.lifted))] + + [lifted_analysis ..#analysis analysis.Operation] + [lifted_synthesis ..#synthesis synthesis.Operation] + [lifted_generation ..#generation (generation.Operation anchor expression declaration)] + ) + +(def .public (set_current_module module) + (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)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux deleted file mode 100644 index 380e48d63..000000000 --- a/stdlib/source/library/lux/tool/compiler/language/lux/directive.lux +++ /dev/null @@ -1,102 +0,0 @@ -(.require - [library - [lux (.except Module) - [abstract - [monad (.only do)]] - [control - ["[0]" try]] - [data - [collection - ["[0]" list (.use "[1]#[0]" monoid)]]]]] - [// - ["[0]" analysis] - ["[0]" synthesis] - ["[0]" generation] - [phase - ["[0]" extension]] - [/// - ["[0]" phase] - [meta - [archive - [module - [descriptor (.only Module)]]]]]]) - -(type .public (Component state phase) - (Record - [#state state - #phase phase])) - -(type .public (State anchor expression directive) - (Record - [#analysis (Component analysis.State+ - analysis.Phase) - #synthesis (Component synthesis.State+ - synthesis.Phase) - #generation (Component (generation.State+ anchor expression directive) - (generation.Phase anchor expression directive))])) - -(type .public Import - (Record - [#module Module - #alias Text])) - -(type .public Requirements - (Record - [#imports (List Import) - #referrals (List Code)])) - -(def .public no_requirements - Requirements - [#imports (list) - #referrals (list)]) - -(def .public (merge_requirements left right) - (-> Requirements Requirements Requirements) - [#imports (list#composite (the #imports left) (the #imports right)) - #referrals (list#composite (the #referrals left) (the #referrals right))]) - -(with_template [ ] - [(type .public ( anchor expression directive) - ( (..State anchor expression directive) Code Requirements))] - - [State+ extension.State] - [Operation extension.Operation] - [Phase extension.Phase] - [Handler extension.Handler] - [Bundle extension.Bundle] - ) - -(with_template [ ] - [(def .public - (All (_ anchor expression directive) - (Operation anchor expression directive )) - (function (_ [bundle state]) - {try.#Success [[bundle state] (the [ ..#phase] state)]}))] - - [analysis ..#analysis analysis.Phase] - [synthesis ..#synthesis synthesis.Phase] - [generation ..#generation (generation.Phase anchor expression directive)] - ) - -(with_template [ ] - [(def .public - (All (_ anchor expression directive output) - (-> ( output) - (Operation anchor expression directive output))) - (|>> (phase.sub [(the [ ..#state]) - (has [ ..#state])]) - extension.lifted))] - - [lifted_analysis ..#analysis analysis.Operation] - [lifted_synthesis ..#synthesis synthesis.Operation] - [lifted_generation ..#generation (generation.Operation anchor expression directive)] - ) - -(def .public (set_current_module module) - (All (_ anchor expression directive) - (-> Module (Operation anchor expression directive Any))) - (do phase.monad - [_ (..lifted_analysis - (analysis.set_current_module module))] - (..lifted_generation - (generation.enter_module module)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux index 67bc8b4c1..b8067a964 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/generation.lux @@ -39,8 +39,8 @@ ["[0]" module (.only) ["[0]" descriptor]]]]]]) -(type .public (Buffer directive) - (Sequence [artifact.ID (Maybe Text) directive])) +(type .public (Buffer declaration) + (Sequence [artifact.ID (Maybe Text) declaration])) (exception .public (cannot_interpret [error Text]) (exception.report @@ -55,28 +55,28 @@ [no_buffer_for_saving_code] ) -(type .public (Host expression directive) +(type .public (Host expression declaration) (Interface (is (-> unit.ID [(Maybe unit.ID) expression] (Try Any)) evaluate) - (is (-> directive (Try Any)) + (is (-> declaration (Try Any)) execute) - (is (-> unit.ID (Maybe Text) [(Maybe unit.ID) expression] (Try [Text Any directive])) + (is (-> unit.ID (Maybe Text) [(Maybe unit.ID) expression] (Try [Text Any declaration])) define) - (is (-> unit.ID Binary directive) + (is (-> unit.ID Binary declaration) ingest) - (is (-> unit.ID (Maybe Text) directive (Try Any)) + (is (-> unit.ID (Maybe Text) declaration (Try Any)) re_learn) - (is (-> unit.ID (Maybe Text) directive (Try Any)) + (is (-> unit.ID (Maybe Text) declaration (Try Any)) re_load))) -(type .public (State anchor expression directive) +(type .public (State anchor expression declaration) (Record [#module descriptor.Module #anchor (Maybe anchor) - #host (Host expression directive) - #buffer (Maybe (Buffer directive)) + #host (Host expression declaration) + #buffer (Maybe (Buffer declaration)) #registry Registry #registry_shift Nat #counter Nat @@ -85,8 +85,8 @@ #interim_artifacts (List artifact.ID)])) (with_template [ ] - [(type .public ( anchor expression directive) - ( (State anchor expression directive) Synthesis expression))] + [(type .public ( anchor expression declaration) + ( (State anchor expression declaration) Synthesis expression))] [State+ extension.State] [Operation extension.Operation] @@ -97,10 +97,10 @@ ) (def .public (state host module) - (All (_ anchor expression directive) - (-> (Host expression directive) + (All (_ anchor expression declaration) + (-> (Host expression declaration) descriptor.Module - (..State anchor expression directive))) + (..State anchor expression declaration))) [#module module #anchor {.#None} #host host @@ -122,7 +122,7 @@ [(exception .public ) (def .public - (All (_ anchor expression directive output) ) + (All (_ anchor expression declaration output) ) (function (_ body) (function (_ [bundle state]) (case (body [bundle (has {.#Some } state)]) @@ -134,8 +134,8 @@ {try.#Failure error})))) (def .public - (All (_ anchor expression directive) - (Operation anchor expression directive )) + (All (_ anchor expression declaration) + (Operation anchor expression declaration )) (function (_ (^.let stateE [bundle state])) (case (the state) {.#Some output} @@ -145,66 +145,66 @@ (exception.except [])))) (def .public ( value) - (All (_ anchor expression directive) - (-> (Operation anchor expression directive Any))) + (All (_ anchor expression declaration) + (-> (Operation anchor expression declaration Any))) (function (_ [bundle state]) {try.#Success [[bundle (has {.#Some value} state)] []]}))] [#anchor (with_anchor anchor) - (-> anchor (Operation anchor expression directive output) - (Operation anchor expression directive output)) + (-> anchor (Operation anchor expression declaration output) + (Operation anchor expression declaration output)) anchor set_anchor anchor anchor no_anchor] [#buffer with_buffer - (-> (Operation anchor expression directive output) - (Operation anchor expression directive output)) + (-> (Operation anchor expression declaration output) + (Operation anchor expression declaration output)) ..empty_buffer - set_buffer buffer (Buffer directive) no_active_buffer] + set_buffer buffer (Buffer declaration) no_active_buffer] ) (def .public get_registry - (All (_ anchor expression directive) - (Operation anchor expression directive Registry)) + (All (_ anchor expression declaration) + (Operation anchor expression declaration Registry)) (function (_ (^.let stateE [bundle state])) {try.#Success [stateE (the #registry state)]})) (def .public (set_registry value) - (All (_ anchor expression directive) - (-> Registry (Operation anchor expression directive Any))) + (All (_ anchor expression declaration) + (-> Registry (Operation anchor expression declaration Any))) (function (_ [bundle state]) {try.#Success [[bundle (has #registry value state)] []]})) (def .public next - (All (_ anchor expression directive) - (Operation anchor expression directive Nat)) + (All (_ anchor expression declaration) + (Operation anchor expression declaration Nat)) (do phase.monad [count (extension.read (the #counter)) _ (extension.update (revised #counter ++))] (in count))) (def .public (symbol prefix) - (All (_ anchor expression directive) - (-> Text (Operation anchor expression directive Text))) + (All (_ anchor expression declaration) + (-> Text (Operation anchor expression declaration Text))) (at phase.monad each (|>> %.nat (format prefix)) ..next)) (def .public (enter_module module) - (All (_ anchor expression directive) - (-> descriptor.Module (Operation anchor expression directive Any))) + (All (_ anchor expression declaration) + (-> descriptor.Module (Operation anchor expression declaration Any))) (extension.update (has #module module))) (def .public module - (All (_ anchor expression directive) - (Operation anchor expression directive descriptor.Module)) + (All (_ anchor expression declaration) + (Operation anchor expression declaration descriptor.Module)) (extension.read (the #module))) (def .public (evaluate! label code) - (All (_ anchor expression directive) - (-> unit.ID [(Maybe unit.ID) expression] (Operation anchor expression directive Any))) + (All (_ anchor expression declaration) + (-> unit.ID [(Maybe unit.ID) expression] (Operation anchor expression declaration Any))) (function (_ (^.let state+ [bundle state])) (case (at (the #host state) evaluate label code) {try.#Success output} @@ -214,8 +214,8 @@ (exception.except ..cannot_interpret [error])))) (def .public (execute! code) - (All (_ anchor expression directive) - (-> directive (Operation anchor expression directive Any))) + (All (_ anchor expression declaration) + (-> declaration (Operation anchor expression declaration Any))) (function (_ (^.let state+ [bundle state])) (case (at (the #host state) execute code) {try.#Success output} @@ -225,8 +225,8 @@ (exception.except ..cannot_interpret error)))) (def .public (define! context custom code) - (All (_ anchor expression directive) - (-> unit.ID (Maybe Text) [(Maybe unit.ID) expression] (Operation anchor expression directive [Text Any directive]))) + (All (_ anchor expression declaration) + (-> unit.ID (Maybe Text) [(Maybe unit.ID) expression] (Operation anchor expression declaration [Text Any declaration]))) (function (_ (^.let stateE [bundle state])) (case (at (the #host state) define context custom code) {try.#Success output} @@ -236,8 +236,8 @@ (exception.except ..cannot_interpret error)))) (def .public (save! artifact_id custom code) - (All (_ anchor expression directive) - (-> artifact.ID (Maybe Text) directive (Operation anchor expression directive Any))) + (All (_ anchor expression declaration) + (-> artifact.ID (Maybe Text) declaration (Operation anchor expression declaration Any))) (do [! phase.monad] [?buffer (extension.read (the #buffer))] (case ?buffer @@ -252,8 +252,8 @@ (with_template [ ] [(`` (def .public ( it (~~ (template.spliced )) dependencies) - (All (_ anchor expression directive) - (-> (~~ (template.spliced )) (Set unit.ID) (Operation anchor expression directive artifact.ID))) + (All (_ anchor expression declaration) + (-> (~~ (template.spliced )) (Set unit.ID) (Operation anchor expression declaration artifact.ID))) (function (_ (^.let stateE [bundle state])) (let [[id registry'] ( it dependencies (the #registry state))] {try.#Success [[bundle (has #registry registry' state)] @@ -264,7 +264,7 @@ [Text #0 [] [] learn_analyser registry.analyser] [Text #0 [] [] learn_synthesizer registry.synthesizer] [Text #0 [] [] learn_generator registry.generator] - [Text #0 [] [] learn_directive registry.directive] + [Text #0 [] [] learn_declaration registry.declaration] ) (exception .public (unknown_definition [name Symbol @@ -275,8 +275,8 @@ "Known Definitions" (exception.listing product.left known_definitions))) (def .public (remember archive name) - (All (_ anchor expression directive) - (-> Archive Symbol (Operation anchor expression directive unit.ID))) + (All (_ anchor expression declaration) + (-> Archive Symbol (Operation anchor expression declaration unit.ID))) (function (_ (^.let stateE [bundle state])) (let [[_module _name] name] (do try.monad @@ -294,8 +294,8 @@ {try.#Success [stateE [@module id]]}))))) (def .public (definition archive name) - (All (_ anchor expression directive) - (-> Archive Symbol (Operation anchor expression directive [unit.ID (Maybe category.Definition)]))) + (All (_ anchor expression declaration) + (-> Archive Symbol (Operation anchor expression declaration [unit.ID (Maybe category.Definition)]))) (function (_ (^.let stateE [bundle state])) (let [[_module _name] name] (do try.monad @@ -315,16 +315,16 @@ (exception .public no_context) (def .public (module_id module archive) - (All (_ anchor expression directive) - (-> descriptor.Module Archive (Operation anchor expression directive module.ID))) + (All (_ anchor expression declaration) + (-> descriptor.Module Archive (Operation anchor expression declaration module.ID))) (function (_ (^.let stateE [bundle state])) (do try.monad [@module (archive.id module archive)] (in [stateE @module])))) (def .public (context archive) - (All (_ anchor expression directive) - (-> Archive (Operation anchor expression directive unit.ID))) + (All (_ anchor expression declaration) + (-> Archive (Operation anchor expression declaration unit.ID))) (function (_ (^.let stateE [bundle state])) (case (the #context state) {.#None} @@ -336,10 +336,10 @@ (in [stateE [@module id]]))))) (def .public (with_context @artifact body) - (All (_ anchor expression directive a) + (All (_ anchor expression declaration a) (-> artifact.ID - (Operation anchor expression directive a) - (Operation anchor expression directive a))) + (Operation anchor expression declaration a) + (Operation anchor expression declaration a))) (function (_ [bundle state]) (do try.monad [[[bundle' state'] output] (body [bundle (has #context {.#Some @artifact} state)])] @@ -347,10 +347,10 @@ output])))) (def .public (with_registry_shift shift body) - (All (_ anchor expression directive a) + (All (_ anchor expression declaration a) (-> Nat - (Operation anchor expression directive a) - (Operation anchor expression directive a))) + (Operation anchor expression declaration a) + (Operation anchor expression declaration a))) (function (_ [bundle state]) (do try.monad [[[bundle' state'] output] (body [bundle (has #registry_shift shift state)])] @@ -358,9 +358,9 @@ output])))) (def .public (with_new_context archive dependencies body) - (All (_ anchor expression directive a) - (-> Archive (Set unit.ID) (Operation anchor expression directive a) - (Operation anchor expression directive [unit.ID a]))) + (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])) (let [[@artifact registry'] (registry.resource false dependencies (the #registry state)) @artifact (n.+ @artifact (the #registry_shift state))] @@ -375,17 +375,17 @@ output]]))))) (def .public (log! message) - (All (_ anchor expression directive a) - (-> Text (Operation anchor expression directive Any))) + (All (_ anchor expression declaration a) + (-> Text (Operation anchor expression declaration Any))) (function (_ [bundle state]) {try.#Success [[bundle (revised #log (sequence.suffix message) state)] []]})) (def .public (with_interim_artifacts archive body) - (All (_ anchor expression directive a) - (-> Archive (Operation anchor expression directive a) - (Operation anchor expression directive [(List unit.ID) a]))) + (All (_ anchor expression declaration a) + (-> Archive (Operation anchor expression declaration a) + (Operation anchor expression declaration [(List unit.ID) a]))) (do phase.monad [module (extension.read (the #module))] (function (_ state+) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/declaration.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/declaration.lux new file mode 100644 index 000000000..806308519 --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/declaration.lux @@ -0,0 +1,125 @@ +(.require + [library + [lux (.except) + ["[0]" meta] + [abstract + ["[0]" monad (.only do)]] + [control + ["[0]" try] + ["[0]" exception (.only exception)]] + [data + [text + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" mix monoid)]]]]] + ["[0]" // + ["[1][0]" extension] + ["[1][0]" analysis] + ["/[1]" // + ["/" declaration (.only Operation Phase)] + ["[1][0]" analysis (.only) + ["[0]" evaluation] + ["[1]/[0]" macro (.only Expander)] + ["[1]/[0]" type]] + [/// + ["//" phase] + [reference (.only) + [variable (.only)]] + [meta + [archive (.only Archive)]]]]]) + +(exception .public (not_a_declaration [code Code]) + (exception.report + "Declaration" (%.code code))) + +(exception .public (invalid_macro_call [code Code]) + (exception.report + "Code" (%.code code))) + +(exception .public (macro_was_not_found [name Symbol]) + (exception.report + "Name" (%.symbol name))) + +(type Eval + (-> Type Code (Meta Any))) + +(def (meta_eval archive bundle compiler_eval) + (-> Archive ///analysis.Bundle evaluation.Eval + Eval) + (function (_ type code lux) + (case (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) + (Operation anchor expression declaration /.Requirements))) + (function (_ state) + (loop (again [state state + input expansion + output /.no_requirements]) + (case input + {.#End} + {try.#Success [state output]} + + {.#Item head tail} + (case (phase archive head state) + {try.#Success [state' head']} + (again state' tail (/.merge_requirements head' output)) + + {try.#Failure error} + {try.#Failure error}))))) + +(with_expansions [ (these [|form_location| {.#Form (list.partial [|text_location| {.#Text "lux def module"}] annotations)}])] + (def .public (phase wrapper expander) + (-> //.Wrapper Expander Phase) + (let [analysis (//analysis.phase expander)] + (function (again archive code) + (do [! //.monad] + [state //.state + .let [compiler_eval (meta_eval archive + (the [//extension.#state /.#analysis /.#state //extension.#bundle] state) + (evaluation.evaluator expander + (the [//extension.#state /.#synthesis /.#state] state) + (the [//extension.#state /.#generation /.#state] state) + (the [//extension.#state /.#generation /.#phase] state))) + extension_eval (as Eval (wrapper (as_expected compiler_eval)))] + _ (//.with (has [//extension.#state /.#analysis /.#state //extension.#state .#eval] extension_eval state))] + (case code + (pattern [_ {.#Form (list.partial [_ {.#Text name}] inputs)}]) + (//extension.apply archive again [name inputs]) + + (pattern [_ {.#Form (list.partial macro inputs)}]) + (do ! + [expansion (/.lifted_analysis + (do ! + [macroA (<| (///analysis/type.expecting Macro) + (analysis archive macro))] + (case macroA + (pattern (///analysis.constant macro_name)) + (do ! + [?macro (//extension.lifted (meta.macro macro_name)) + macro (case ?macro + {.#Some macro} + (in macro) + + {.#None} + (//.except ..macro_was_not_found macro_name))] + (//extension.lifted (///analysis/macro.expansion expander macro_name macro inputs))) + + _ + (//.except ..invalid_macro_call code))))] + (case expansion + (pattern (list.partial referrals)) + (|> (again archive ) + (at ! each (revised /.#referrals (list#composite referrals)))) + + _ + (..requiring again archive expansion))) + + _ + (//.except ..not_a_declaration code))))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux deleted file mode 100644 index cffe0d681..000000000 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/directive.lux +++ /dev/null @@ -1,125 +0,0 @@ -(.require - [library - [lux (.except) - ["[0]" meta] - [abstract - ["[0]" monad (.only do)]] - [control - ["[0]" try] - ["[0]" exception (.only exception)]] - [data - [text - ["%" \\format (.only format)]] - [collection - ["[0]" list (.use "[1]#[0]" mix monoid)]]]]] - ["[0]" // - ["[1][0]" extension] - ["[1][0]" analysis] - ["/[1]" // - ["/" directive (.only Operation Phase)] - ["[1][0]" analysis (.only) - ["[0]" evaluation] - ["[1]/[0]" macro (.only Expander)] - ["[1]/[0]" type]] - [/// - ["//" phase] - [reference (.only) - [variable (.only)]] - [meta - [archive (.only Archive)]]]]]) - -(exception .public (not_a_directive [code Code]) - (exception.report - "Directive" (%.code code))) - -(exception .public (invalid_macro_call [code Code]) - (exception.report - "Code" (%.code code))) - -(exception .public (macro_was_not_found [name Symbol]) - (exception.report - "Name" (%.symbol name))) - -(type Eval - (-> Type Code (Meta Any))) - -(def (meta_eval archive bundle compiler_eval) - (-> Archive ///analysis.Bundle evaluation.Eval - Eval) - (function (_ type code lux) - (case (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 directive) - (-> (Phase anchor expression directive) Archive (List Code) - (Operation anchor expression directive /.Requirements))) - (function (_ state) - (loop (again [state state - input expansion - output /.no_requirements]) - (case input - {.#End} - {try.#Success [state output]} - - {.#Item head tail} - (case (phase archive head state) - {try.#Success [state' head']} - (again state' tail (/.merge_requirements head' output)) - - {try.#Failure error} - {try.#Failure error}))))) - -(with_expansions [ (these [|form_location| {.#Form (list.partial [|text_location| {.#Text "lux def module"}] annotations)}])] - (def .public (phase wrapper expander) - (-> //.Wrapper Expander Phase) - (let [analysis (//analysis.phase expander)] - (function (again archive code) - (do [! //.monad] - [state //.state - .let [compiler_eval (meta_eval archive - (the [//extension.#state /.#analysis /.#state //extension.#bundle] state) - (evaluation.evaluator expander - (the [//extension.#state /.#synthesis /.#state] state) - (the [//extension.#state /.#generation /.#state] state) - (the [//extension.#state /.#generation /.#phase] state))) - extension_eval (as Eval (wrapper (as_expected compiler_eval)))] - _ (//.with (has [//extension.#state /.#analysis /.#state //extension.#state .#eval] extension_eval state))] - (case code - (pattern [_ {.#Form (list.partial [_ {.#Text name}] inputs)}]) - (//extension.apply archive again [name inputs]) - - (pattern [_ {.#Form (list.partial macro inputs)}]) - (do ! - [expansion (/.lifted_analysis - (do ! - [macroA (<| (///analysis/type.expecting Macro) - (analysis archive macro))] - (case macroA - (pattern (///analysis.constant macro_name)) - (do ! - [?macro (//extension.lifted (meta.macro macro_name)) - macro (case ?macro - {.#Some macro} - (in macro) - - {.#None} - (//.except ..macro_was_not_found macro_name))] - (//extension.lifted (///analysis/macro.expansion expander macro_name macro inputs))) - - _ - (//.except ..invalid_macro_call code))))] - (case expansion - (pattern (list.partial referrals)) - (|> (again archive ) - (at ! each (revised /.#referrals (list#composite referrals)))) - - _ - (..requiring again archive expansion))) - - _ - (//.except ..not_a_directive code))))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 4696b3104..eb523d7e0 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except Type Module Primitive char int) + [lux (.except Type Module Primitive char int type) ["[0]" ffi (.only import)] ["[0]" meta] [abstract @@ -70,7 +70,7 @@ ["[1]" abstract]]]] ["/[1]" // ["[0]" generation] - ["[0]" directive] + ["[0]" declaration] ["[1][0]" analysis (.only Analysis Operation Phase Handler Bundle) ["[0]" complex] ["[0]" pattern] @@ -226,7 +226,7 @@ [char (reflection.reflection reflection.char)] ) -(type Member +(.type Member (Record [#class External #member Text])) @@ -235,7 +235,7 @@ (Parser Member) (all <>.and .text .text)) -(type Method_Signature +(.type Method_Signature (Record [#method .Type #deprecated? Bit @@ -1150,7 +1150,7 @@ valueA objectA)))))])) -(type Method_Style +(.type Method_Style (Variant {#Static} {#Abstract} @@ -1357,7 +1357,7 @@ concrete_exceptions generic_exceptions)])))) -(type Evaluation +(.type Evaluation (Variant {#Pass Method_Signature} {#Hint Method_Signature})) @@ -1650,14 +1650,14 @@ ))) ))) -(type .public (Annotation_Parameter a) +(.type .public (Annotation_Parameter a) [Text a]) (def annotation_parameter (Parser (Annotation_Parameter Code)) (.tuple (<>.and .text .any))) -(type .public (Annotation a) +(.type .public (Annotation a) [Text (List (Annotation_Parameter a))]) (def .public annotation @@ -1767,15 +1767,15 @@ [invalid_overriden_methods] ) -(type .public Visibility +(.type .public Visibility (Variant {#Public} {#Private} {#Protected} {#Default})) -(type .public Finality Bit) -(type .public Strictness Bit) +(.type .public Finality Bit) +(.type .public Strictness Bit) (def .public public_tag "public") (def .public private_tag "private") @@ -1803,7 +1803,7 @@ {#Protected} ..protected_tag {#Default} ..default_tag))) -(type Exception +(.type Exception (Type Class)) (def .public parameter_types @@ -1814,7 +1814,7 @@ [[_ parameterT] check.existential] (in [parameterJ parameterT]))))) -(type .public (Abstract_Method a) +(.type .public (Abstract_Method a) [Text Visibility (List (Annotation a)) @@ -1874,7 +1874,7 @@ (/////analysis.tuple (list#each class_analysis exceptions)) )))))) -(type .public (Constructor a) +(.type .public (Constructor a) [Visibility Strictness (List (Annotation a)) @@ -1952,7 +1952,7 @@ (/////analysis.tuple (list bodyA))} )))))) -(type .public (Virtual_Method a) +(.type .public (Virtual_Method a) [Text Visibility Finality @@ -1984,7 +1984,7 @@ (.tuple (<>.some ..class)) .any))) -(type .public (Method_Declaration a) +(.type .public (Method_Declaration a) (Record [#name Text #annotations (List (Annotation a)) @@ -2052,7 +2052,7 @@ (/////analysis.tuple (list bodyA))} )))))) -(type .public (Static_Method a) +(.type .public (Static_Method a) [Text Visibility Strictness @@ -2125,7 +2125,7 @@ (/////analysis.tuple (list bodyA))} )))))) -(type .public (Overriden_Method a) +(.type .public (Overriden_Method a) [(Type Class) Text Bit @@ -2436,21 +2436,21 @@ (list.empty? invalid_overriden_methods))] (in []))) -(type Declaration +(.type Declaration [Text (List (Type Var))]) -(type Constant +(.type Constant [Text (List Annotation) (Type Value) Code]) -(type Variable +(.type Variable [Text (Modifier field.Field) (Modifier field.Field) (List Annotation) (Type Value)]) -(type Field +(.type Field (Variant {#Constant Constant} {#Variable Variable})) -(type (Method_Definition a) +(.type (Method_Definition a) (Variant {#Constructor (..Constructor a)} {#Virtual_Method (..Virtual_Method a)} diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/jvm.lux new file mode 100644 index 000000000..9fdfb4d7c --- /dev/null +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/declaration/jvm.lux @@ -0,0 +1,978 @@ +(.require + [library + [lux (.except Type Definition Primitive) + ["[0]" ffi (.only import)] + [abstract + ["[0]" monad (.only do)]] + [control + ["<>" parser (.use "[1]#[0]" monad)] + ["[0]" pipe] + ["[0]" try (.only Try) (.use "[1]#[0]" functor)] + ["[0]" exception]] + [data + ["[0]" product] + [binary (.only Binary) + ["[0]" \\format]] + ["[0]" text + ["%" \\format (.only format)] + ["<[1]>" \\parser]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" dictionary] + ["[0]" sequence] + ["[0]" set (.only Set)]]] + [macro + ["^" pattern] + ["[0]" template] + ["[0]" code + ["<[1]>" \\parser (.only Parser)]]] + [math + [number + ["n" nat] + ["[0]" i32]]] + [target + [jvm + ["_" bytecode (.only Bytecode) (.use "[1]#[0]" monad)] + ["[0]" modifier (.only Modifier) (.use "[1]#[0]" monoid)] + ["[0]" attribute] + ["[0]" field] + ["[0]" version] + ["[0]" method (.only Method)] + ["[0]" class] + ["[0]" constant (.only) + ["[0]" pool (.only Resource)]] + [encoding + ["[0]" name (.only External)]] + ["[0]" type (.only Type Constraint Argument Typed) + [category (.only Void Value Return Primitive Object Class Array Var Parameter)] + ["[0]T" lux (.only Mapping)] + ["[0]" signature] + ["[0]" reflection] + ["[0]" descriptor (.only Descriptor)] + ["[0]" parser]]]] + [tool + [compiler + ["[0]" phase] + [reference + [variable (.only Register)]] + [meta + [archive (.only Archive) + ["[0]" artifact] + ["[0]" unit]] + ["[0]" cache + [dependency + ["[1]" artifact]]]] + [language + [lux + ["[0]" generation] + ["[0]" declaration (.only Handler Bundle)] + ["[0]" analysis (.only Analysis) + ["[0]A" type] + ["[0]A" scope]] + ["[0]" synthesis (.only Synthesis) + ["<[1]>" \\parser]] + [phase + [generation + [jvm + ["[0]" runtime (.only Anchor Definition Extender)] + ["[0]" value]]] + ["[0]" extension (.only) + ["[0]" bundle] + [analysis + ["[0]" jvm]] + [generation + [jvm + ["[0]" host]]] + [declaration + ["/" lux]]]]]]]] + [type + ["[0]" check (.only Check)]]]]) + +(type Operation + (declaration.Operation Anchor (Bytecode Any) Definition)) + +(def signature (|>> type.signature signature.signature)) +(def reflection (|>> type.reflection reflection.reflection)) + +(type Declaration + [Text (List (Type Var))]) + +(def declaration + (Parser Declaration) + (.form (<>.and .text (<>.some jvm.var)))) + +(def method_privacy + (-> ffi.Privacy (Modifier method.Method)) + (|>> (pipe.case + {ffi.#PublicP} method.public + {ffi.#PrivateP} method.private + {ffi.#ProtectedP} method.protected + {ffi.#DefaultP} modifier.empty))) + +(def visibility' + (.Parser (Modifier field.Field)) + (`` (all <>.either + (~~ (with_template [