From 5f494b497e79bcea1d3c64d663ca5435bbf8ca2d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 7 Sep 2019 20:02:14 -0400 Subject: Renamed "Statement" to "Directive". --- luxc/src/lux/analyser/lux.clj | 6 +- luxc/src/lux/base.clj | 4 +- new-luxc/source/luxc/lang/directive/jvm.lux | 263 ++++++++++++++++ new-luxc/source/luxc/lang/statement/jvm.lux | 263 ---------------- new-luxc/source/program.lux | 2 +- .../lux/tool/compiler/default/evaluation.lux | 6 +- stdlib/source/lux/tool/compiler/default/init.lux | 112 +++---- .../source/lux/tool/compiler/default/platform.lux | 32 +- stdlib/source/lux/tool/compiler/directive.lux | 70 +++++ .../source/lux/tool/compiler/phase/directive.lux | 79 +++++ .../compiler/phase/extension/directive/lux.lux | 345 +++++++++++++++++++++ .../compiler/phase/extension/statement/lux.lux | 345 --------------------- .../source/lux/tool/compiler/phase/generation.lux | 96 +++--- .../tool/compiler/phase/generation/extension.lux | 10 +- .../tool/compiler/phase/generation/reference.lux | 20 +- .../source/lux/tool/compiler/phase/statement.lux | 79 ----- stdlib/source/lux/tool/compiler/statement.lux | 70 ----- stdlib/source/lux/tool/interpreter.lux | 80 ++--- stdlib/source/program/compositor.lux | 42 +-- stdlib/source/spec/compositor.lux | 14 +- stdlib/source/spec/compositor/common.lux | 30 +- stdlib/source/test/lux.lux | 2 +- 22 files changed, 985 insertions(+), 985 deletions(-) create mode 100644 new-luxc/source/luxc/lang/directive/jvm.lux delete mode 100644 new-luxc/source/luxc/lang/statement/jvm.lux create mode 100644 stdlib/source/lux/tool/compiler/directive.lux create mode 100644 stdlib/source/lux/tool/compiler/phase/directive.lux create mode 100644 stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux delete mode 100644 stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux delete mode 100644 stdlib/source/lux/tool/compiler/phase/statement.lux delete mode 100644 stdlib/source/lux/tool/compiler/statement.lux diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index 0a6858a92..8a2f4b70c 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -542,7 +542,7 @@ (return (&/|list output)))) (defn analyse-def* [analyse optimize eval! compile-def ?name ?value ?meta exported? & [?expected-type]] - (|do [_ &/ensure-statement + (|do [_ &/ensure-directive module-name &/get-module-name ? (&&module/defined? module-name ?name) _ (&/assert! (not ?) @@ -650,7 +650,7 @@ (deliver (&/$Right _compiler)))))))) (defn analyse-module [analyse optimize eval! compile-module ?meta ?imports] - (|do [_ &/ensure-statement + (|do [_ &/ensure-directive =anns (&&/analyse-1 analyse &type/Code ?meta) ==anns (eval! (optimize =anns)) module-name &/get-module-name @@ -713,7 +713,7 @@ (let [program-type (&/$Function (&/$Apply &type/Text &type/List) (&/$Apply &type/Any &type/IO))] (defn analyse-program [analyse optimize compile-program ?program] - (|do [_ &/ensure-statement + (|do [_ &/ensure-directive =program (&&/analyse-1 analyse program-type ?program) _ (compile-program (optimize =program))] (return &/$Nil)))) diff --git a/luxc/src/lux/base.clj b/luxc/src/lux/base.clj index 0d7d661d7..f91bc4f2a 100644 --- a/luxc/src/lux/base.clj +++ b/luxc/src/lux/base.clj @@ -1071,14 +1071,14 @@ output)))))) (def ^{:doc "(Meta Any)"} - ensure-statement + ensure-directive (fn [state] (|case (get$ $expected state) ($None) (return* state unit-tag) ($Some _) - ((fail-with-loc "[Error] All statements must be top-level forms.") + ((fail-with-loc "[Error] All directives must be top-level forms.") state)))) (def cursor diff --git a/new-luxc/source/luxc/lang/directive/jvm.lux b/new-luxc/source/luxc/lang/directive/jvm.lux new file mode 100644 index 000000000..5c1ddee0d --- /dev/null +++ b/new-luxc/source/luxc/lang/directive/jvm.lux @@ -0,0 +1,263 @@ +(.module: + [lux (#- Type Definition) + [abstract + ["." monad (#+ do)]] + [control + ["<>" parser + ["" code (#+ Parser)] + ["" text]]] + [data + ["." product] + [text + ["%" format (#+ format)]] + [collection + ["." list ("#@." functor fold)] + ["." dictionary]]] + [type + ["." check (#+ Check)]] + [target + [jvm + ["." type (#+ Type Constraint Argument Typed) + [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)] + [".T" lux] + ["." signature] + ["." descriptor (#+ Descriptor)] + ["." parser]]]] + [tool + [compiler + ["." directive (#+ Handler Bundle)] + ["." phase + ["." generation] + [analysis + [".A" type]] + ["." extension + ["." bundle] + [analysis + ["." jvm]] + [directive + ["/" lux]]]]]]] + [luxc + [lang + [host + ["$" jvm (#+ Anchor Inst Definition Operation Phase) + ["_." def]]]]]) + +(def: signature (|>> type.signature signature.signature)) + +(type: Declaration + [Text (List (Type Var))]) + +(def: declaration + (Parser Declaration) + (.form (<>.and .text (<>.some jvm.var)))) + +(type: Inheritance + #FinalI + #AbstractI + #DefaultI) + +(def: inheritance + (Parser Inheritance) + ($_ <>.or + (.text! "final") + (.text! "abstract") + (.text! "default"))) + +(type: State + #VolatileS + #FinalS + #DefaultS) + +(def: state + (Parser State) + ($_ <>.or + (.text! "volatile") + (.text! "final") + (.text! "default"))) + +(type: Annotation Any) + +(def: annotation + (Parser Annotation) + .any) + +(def: field-type + (Parser (Type Value)) + (.embed parser.value .text)) + +(type: Constant + [Text (List Annotation) (Type Value) Code]) + +(def: constant + (Parser Constant) + (<| .form + (<>.after (.text! "constant")) + ($_ <>.and + .text + (.tuple (<>.some ..annotation)) + ..field-type + .any + ))) + +(type: Variable + [Text jvm.Visibility State (List Annotation) (Type Value)]) + +(def: variable + (Parser Variable) + (<| .form + (<>.after (.text! "variable")) + ($_ <>.and + .text + jvm.visibility + ..state + (.tuple (<>.some ..annotation)) + ..field-type + ))) + +(type: Field + (#Constant Constant) + (#Variable Variable)) + +(def: field + (Parser Field) + ($_ <>.or + ..constant + ..variable + )) + +(type: Method-Definition + (#Constructor (jvm.Constructor Code)) + (#Virtual-Method (jvm.Virtual-Method Code)) + (#Static-Method (jvm.Static-Method Code)) + (#Overriden-Method (jvm.Overriden-Method Code))) + +(def: method + (Parser Method-Definition) + ($_ <>.or + jvm.constructor-definition + jvm.virtual-method-definition + jvm.static-method-definition + jvm.overriden-method-definition + )) + +(def: (constraint name) + (-> Text Constraint) + {#type.name name + #type.super-class (type.class "java.lang.Object" (list)) + #type.super-interfaces (list)}) + +(def: jvm::class + (Handler Anchor Inst Definition) + (/.custom + [($_ <>.and + ..declaration + jvm.class + (.tuple (<>.some jvm.class)) + ..inheritance + (.tuple (<>.some ..annotation)) + (.tuple (<>.some ..field)) + (.tuple (<>.some ..method))) + (function (_ extension phase + [[name parameters] + super-class + super-interfaces + inheritance + ## TODO: Handle annotations. + annotations + fields + methods]) + (do phase.monad + [parameters (directive.lift-analysis + (typeA.with-env + (jvm.parameter-types parameters))) + #let [mapping (list@fold (function (_ [parameterJ parameterT] mapping) + (dictionary.put (parser.name parameterJ) parameterT mapping)) + luxT.fresh + parameters) + field-definitions (|> fields + (list@map (function (_ field) + (case field + ## TODO: Handle annotations. + (#Constant [name annotations type value]) + (case value + (^template [ ] + [_ ( value)] + ( #$.Public ($.++F $.staticF $.finalF) name value)) + ([#.Bit _def.boolean-field] + [#.Int _def.byte-field] + [#.Int _def.short-field] + [#.Int _def.int-field] + [#.Int _def.long-field] + [#.Frac _def.float-field] + [#.Frac _def.double-field] + [#.Nat _def.char-field] + [#.Text _def.string-field]) + + _ + (undefined)) + + ## TODO: Handle annotations. + (#Variable [name visibility state annotations type]) + (_def.field visibility + (case state + ## TODO: Handle transient & static. + #VolatileS $.volatileF + #FinalS $.finalF + #DefaultS $.noneF) + name + type)))) + _def.fuse)] + super-classT (directive.lift-analysis + (typeA.with-env + (luxT.check (luxT.class mapping) (..signature super-class)))) + super-interfaceT+ (directive.lift-analysis + (typeA.with-env + (monad.map check.monad + (|>> ..signature (luxT.check (luxT.class mapping))) + super-interfaces))) + #let [selfT (jvm.inheritance-relationship-type (#.Primitive name (list@map product.right parameters)) + super-classT + super-interfaceT+)] + state (extension.lift phase.get-state) + #let [analyse (get@ [#directive.analysis #directive.phase] state) + synthesize (get@ [#directive.synthesis #directive.phase] state) + generate (get@ [#directive.generation #directive.phase] state)] + methods (monad.map @ (function (_ methodC) + (do @ + [methodA (directive.lift-analysis + (case methodC + (#Constructor method) + (jvm.analyse-constructor-method analyse selfT mapping method) + + (#Virtual-Method method) + (jvm.analyse-virtual-method analyse selfT mapping method) + + (#Static-Method method) + (jvm.analyse-static-method analyse mapping method) + + (#Overriden-Method method) + (jvm.analyse-overriden-method analyse selfT mapping method)))] + (directive.lift-synthesis + (synthesize methodA)))) + methods) + _ (directive.lift-generation + (generation.save! true ["" name] + [name + (_def.class #$.V1_6 #$.Public + (case inheritance + #FinalI $.finalC + ## TODO: Handle abstract classes. + #AbstractI (undefined) + #DefaultI $.noneC) + name (list@map (|>> product.left parser.name ..constraint) parameters) + super-class super-interfaces + field-definitions)])) + #let [_ (log! (format "Class " name))]] + (wrap directive.no-requirements)))])) + +(def: #export bundle + (Bundle Anchor Inst Definition) + (<| (bundle.prefix "jvm") + (|> bundle.empty + (dictionary.put "class" jvm::class) + ))) diff --git a/new-luxc/source/luxc/lang/statement/jvm.lux b/new-luxc/source/luxc/lang/statement/jvm.lux deleted file mode 100644 index 20ba938d1..000000000 --- a/new-luxc/source/luxc/lang/statement/jvm.lux +++ /dev/null @@ -1,263 +0,0 @@ -(.module: - [lux (#- Type Definition) - [abstract - ["." monad (#+ do)]] - [control - ["<>" parser - ["" code (#+ Parser)] - ["" text]]] - [data - ["." product] - [text - ["%" format (#+ format)]] - [collection - ["." list ("#@." functor fold)] - ["." dictionary]]] - [type - ["." check (#+ Check)]] - [target - [jvm - ["." type (#+ Type Constraint Argument Typed) - [category (#+ Void Value Return Method Primitive Object Class Array Var Parameter)] - [".T" lux] - ["." signature] - ["." descriptor (#+ Descriptor)] - ["." parser]]]] - [tool - [compiler - ["." statement (#+ Handler Bundle)] - ["." phase - ["." generation] - [analysis - [".A" type]] - ["." extension - ["." bundle] - [analysis - ["." jvm]] - [statement - ["/" lux]]]]]]] - [luxc - [lang - [host - ["$" jvm (#+ Anchor Inst Definition Operation Phase) - ["_." def]]]]]) - -(def: signature (|>> type.signature signature.signature)) - -(type: Declaration - [Text (List (Type Var))]) - -(def: declaration - (Parser Declaration) - (.form (<>.and .text (<>.some jvm.var)))) - -(type: Inheritance - #FinalI - #AbstractI - #DefaultI) - -(def: inheritance - (Parser Inheritance) - ($_ <>.or - (.text! "final") - (.text! "abstract") - (.text! "default"))) - -(type: State - #VolatileS - #FinalS - #DefaultS) - -(def: state - (Parser State) - ($_ <>.or - (.text! "volatile") - (.text! "final") - (.text! "default"))) - -(type: Annotation Any) - -(def: annotation - (Parser Annotation) - .any) - -(def: field-type - (Parser (Type Value)) - (.embed parser.value .text)) - -(type: Constant - [Text (List Annotation) (Type Value) Code]) - -(def: constant - (Parser Constant) - (<| .form - (<>.after (.text! "constant")) - ($_ <>.and - .text - (.tuple (<>.some ..annotation)) - ..field-type - .any - ))) - -(type: Variable - [Text jvm.Visibility State (List Annotation) (Type Value)]) - -(def: variable - (Parser Variable) - (<| .form - (<>.after (.text! "variable")) - ($_ <>.and - .text - jvm.visibility - ..state - (.tuple (<>.some ..annotation)) - ..field-type - ))) - -(type: Field - (#Constant Constant) - (#Variable Variable)) - -(def: field - (Parser Field) - ($_ <>.or - ..constant - ..variable - )) - -(type: Method-Definition - (#Constructor (jvm.Constructor Code)) - (#Virtual-Method (jvm.Virtual-Method Code)) - (#Static-Method (jvm.Static-Method Code)) - (#Overriden-Method (jvm.Overriden-Method Code))) - -(def: method - (Parser Method-Definition) - ($_ <>.or - jvm.constructor-definition - jvm.virtual-method-definition - jvm.static-method-definition - jvm.overriden-method-definition - )) - -(def: (constraint name) - (-> Text Constraint) - {#type.name name - #type.super-class (type.class "java.lang.Object" (list)) - #type.super-interfaces (list)}) - -(def: jvm::class - (Handler Anchor Inst Definition) - (/.custom - [($_ <>.and - ..declaration - jvm.class - (.tuple (<>.some jvm.class)) - ..inheritance - (.tuple (<>.some ..annotation)) - (.tuple (<>.some ..field)) - (.tuple (<>.some ..method))) - (function (_ extension phase - [[name parameters] - super-class - super-interfaces - inheritance - ## TODO: Handle annotations. - annotations - fields - methods]) - (do phase.monad - [parameters (statement.lift-analysis - (typeA.with-env - (jvm.parameter-types parameters))) - #let [mapping (list@fold (function (_ [parameterJ parameterT] mapping) - (dictionary.put (parser.name parameterJ) parameterT mapping)) - luxT.fresh - parameters) - field-definitions (|> fields - (list@map (function (_ field) - (case field - ## TODO: Handle annotations. - (#Constant [name annotations type value]) - (case value - (^template [ ] - [_ ( value)] - ( #$.Public ($.++F $.staticF $.finalF) name value)) - ([#.Bit _def.boolean-field] - [#.Int _def.byte-field] - [#.Int _def.short-field] - [#.Int _def.int-field] - [#.Int _def.long-field] - [#.Frac _def.float-field] - [#.Frac _def.double-field] - [#.Nat _def.char-field] - [#.Text _def.string-field]) - - _ - (undefined)) - - ## TODO: Handle annotations. - (#Variable [name visibility state annotations type]) - (_def.field visibility - (case state - ## TODO: Handle transient & static. - #VolatileS $.volatileF - #FinalS $.finalF - #DefaultS $.noneF) - name - type)))) - _def.fuse)] - super-classT (statement.lift-analysis - (typeA.with-env - (luxT.check (luxT.class mapping) (..signature super-class)))) - super-interfaceT+ (statement.lift-analysis - (typeA.with-env - (monad.map check.monad - (|>> ..signature (luxT.check (luxT.class mapping))) - super-interfaces))) - #let [selfT (jvm.inheritance-relationship-type (#.Primitive name (list@map product.right parameters)) - super-classT - super-interfaceT+)] - state (extension.lift phase.get-state) - #let [analyse (get@ [#statement.analysis #statement.phase] state) - synthesize (get@ [#statement.synthesis #statement.phase] state) - generate (get@ [#statement.generation #statement.phase] state)] - methods (monad.map @ (function (_ methodC) - (do @ - [methodA (statement.lift-analysis - (case methodC - (#Constructor method) - (jvm.analyse-constructor-method analyse selfT mapping method) - - (#Virtual-Method method) - (jvm.analyse-virtual-method analyse selfT mapping method) - - (#Static-Method method) - (jvm.analyse-static-method analyse mapping method) - - (#Overriden-Method method) - (jvm.analyse-overriden-method analyse selfT mapping method)))] - (statement.lift-synthesis - (synthesize methodA)))) - methods) - _ (statement.lift-generation - (generation.save! true ["" name] - [name - (_def.class #$.V1_6 #$.Public - (case inheritance - #FinalI $.finalC - ## TODO: Handle abstract classes. - #AbstractI (undefined) - #DefaultI $.noneC) - name (list@map (|>> product.left parser.name ..constraint) parameters) - super-class super-interfaces - field-definitions)])) - #let [_ (log! (format "Class " name))]] - (wrap statement.no-requirements)))])) - -(def: #export bundle - (Bundle Anchor Inst Definition) - (<| (bundle.prefix "jvm") - (|> bundle.empty - (dictionary.put "class" jvm::class) - ))) diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index 36c6e3209..43cc9e9cd 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -36,7 +36,7 @@ ["_" jvm ["$d" def] ["$i" inst]]] - [statement + [directive [".S" jvm]] [translation ["." jvm diff --git a/stdlib/source/lux/tool/compiler/default/evaluation.lux b/stdlib/source/lux/tool/compiler/default/evaluation.lux index 36e5678db..b6bc6b46b 100644 --- a/stdlib/source/lux/tool/compiler/default/evaluation.lux +++ b/stdlib/source/lux/tool/compiler/default/evaluation.lux @@ -22,11 +22,11 @@ (-> Nat Type Code (Operation Any))) (def: #export (evaluator expander synthesis-state generation-state generate) - (All [anchor expression statement] + (All [anchor expression directive] (-> Expander synthesis.State+ - (generation.State+ anchor expression statement) - (generation.Phase anchor expression statement) + (generation.State+ anchor expression directive) + (generation.Phase anchor expression directive) Eval)) (let [analyze (analysisP.phase expander)] (function (eval count type exprC) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index d24c2828d..fc9a805f7 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -21,18 +21,18 @@ ["/#" // (#+ Instancer) ["#." analysis] ["#." synthesis] - ["#." statement (#+ Requirements)] + ["#." directive (#+ Requirements)] ["#." phase [macro (#+ Expander)] [".P" analysis ["." module]] [".P" synthesis] ["." generation] - [".P" statement] + [".P" directive] ["." extension [".E" analysis] [".E" synthesis] - [statement + [directive [".S" lux]]]] [meta [archive @@ -47,30 +47,30 @@ #.version //.version #.mode #.Build}) -(def: #export (state target expander host-analysis host generate generation-bundle host-statement-bundle program) - (All [anchor expression statement] +(def: #export (state target expander host-analysis host generate generation-bundle host-directive-bundle program) + (All [anchor expression directive] (-> Text Expander ///analysis.Bundle - (generation.Host expression statement) - (generation.Phase anchor expression statement) - (generation.Bundle anchor expression statement) - (///statement.Bundle anchor expression statement) - (-> expression statement) - (///statement.State+ anchor expression statement))) + (generation.Host expression directive) + (generation.Phase anchor expression directive) + (generation.Bundle anchor expression directive) + (///directive.Bundle anchor expression directive) + (-> expression directive) + (///directive.State+ anchor expression directive))) (let [synthesis-state [synthesisE.bundle ///synthesis.init] generation-state [generation-bundle (generation.state host)] eval (//evaluation.evaluator expander synthesis-state generation-state generate) analysis-state [(analysisE.bundle eval host-analysis) (///analysis.state (..info target) host)]] [(dictionary.merge (luxS.bundle expander host-analysis program) - host-statement-bundle) - {#///statement.analysis {#///statement.state analysis-state - #///statement.phase (analysisP.phase expander)} - #///statement.synthesis {#///statement.state synthesis-state - #///statement.phase synthesisP.phase} - #///statement.generation {#///statement.state generation-state - #///statement.phase generate}}])) + host-directive-bundle) + {#///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}}])) (type: Reader (-> Source (Either [Source Text] [Source Code]))) @@ -96,15 +96,15 @@ [source' output]]))))) (type: (Operation a) - (All [anchor expression statement] - (///statement.Operation anchor expression statement a))) + (All [anchor expression directive] + (///directive.Operation anchor expression directive a))) (def: (begin dependencies hash input) (-> (List Module) Nat ///.Input - (All [anchor expression statement] - (///statement.Operation anchor expression statement - [Source (generation.Buffer statement)]))) - (///statement.lift-analysis + (All [anchor expression directive] + (///directive.Operation anchor expression directive + [Source (generation.Buffer directive)]))) + (///directive.lift-analysis (do ///phase.monad [#let [module (get@ #///.module input)] _ (module.create hash module) @@ -117,56 +117,56 @@ (def: (end module) (-> Module (Operation Any)) (do ///phase.monad - [_ (///statement.lift-analysis + [_ (///directive.lift-analysis (module.set-compiled module))] - (///statement.lift-generation + (///directive.lift-generation (generation.save-buffer! module)))) ## TODO: Inline ASAP (def: (get-current-buffer old-buffer) - (All [statement] - (-> (generation.Buffer statement) + (All [directive] + (-> (generation.Buffer directive) (All [anchor expression] - (///statement.Operation anchor expression statement - (generation.Buffer statement))))) - (///statement.lift-generation + (///directive.Operation anchor expression directive + (generation.Buffer directive))))) + (///directive.lift-generation generation.buffer)) ## TODO: Inline ASAP -(def: (process-statement expander pre-buffer code) - (All [statement] - (-> Expander (generation.Buffer statement) Code +(def: (process-directive expander pre-buffer code) + (All [directive] + (-> Expander (generation.Buffer directive) Code (All [anchor expression] - (///statement.Operation anchor expression statement - [Requirements (generation.Buffer statement)])))) + (///directive.Operation anchor expression directive + [Requirements (generation.Buffer directive)])))) (do ///phase.monad - [_ (///statement.lift-generation + [_ (///directive.lift-generation (generation.set-buffer pre-buffer)) - requirements (let [execute! (statementP.phase expander)] + requirements (let [execute! (directiveP.phase expander)] (execute! code)) post-buffer (..get-current-buffer pre-buffer)] (wrap [requirements post-buffer]))) (def: (iteration expander reader source pre-buffer) - (All [statement] - (-> Expander Reader Source (generation.Buffer statement) + (All [directive] + (-> Expander Reader Source (generation.Buffer directive) (All [anchor expression] - (///statement.Operation anchor expression statement - [Source Requirements (generation.Buffer statement)])))) + (///directive.Operation anchor expression directive + [Source Requirements (generation.Buffer directive)])))) (do ///phase.monad - [[source code] (///statement.lift-analysis + [[source code] (///directive.lift-analysis (..read source reader)) - [requirements post-buffer] (process-statement expander pre-buffer code)] + [requirements post-buffer] (process-directive expander pre-buffer code)] (wrap [source requirements post-buffer]))) (def: (iterate expander module source pre-buffer aliases) - (All [statement] - (-> Expander Module Source (generation.Buffer statement) Aliases + (All [directive] + (-> Expander Module Source (generation.Buffer directive) Aliases (All [anchor expression] - (///statement.Operation anchor expression statement - (Maybe [Source Requirements (generation.Buffer statement)]))))) + (///directive.Operation anchor expression directive + (Maybe [Source Requirements (generation.Buffer directive)]))))) (do ///phase.monad - [reader (///statement.lift-analysis + [reader (///directive.lift-analysis (..reader module aliases source))] (function (_ state) (case (///phase.run' state (..iteration expander reader source pre-buffer)) @@ -190,9 +190,9 @@ (def: #export (compiler expander prelude) (-> Expander Module - (All [anchor expression statement] - (Instancer (///statement.State+ anchor expression statement) .Module))) - (let [execute! (statementP.phase expander)] + (All [anchor expression directive] + (Instancer (///directive.State+ anchor expression directive) .Module))) + (let [execute! (directiveP.phase expander)] (function (_ key parameters input) (let [dependencies (default-dependencies prelude input)] {#///.dependencies dependencies @@ -213,7 +213,7 @@ (do ///phase.monad [_ (..end module)] (<| (: (Operation .Module)) - ///statement.lift-analysis + ///directive.lift-analysis extension.lift macro.current-module))) #let [descriptor {#descriptor.hash hash @@ -228,16 +228,16 @@ (#.Some [source requirements buffer]) (wrap [state (#.Left {#///.dependencies (|> requirements - (get@ #///statement.imports) + (get@ #///directive.imports) (list@map product.left)) #///.process (function (_ state archive) (recur (<| (///phase.run' state) (do ///phase.monad [analysis-module (<| (: (Operation .Module)) - ///statement.lift-analysis + ///directive.lift-analysis extension.lift macro.current-module) - _ (monad.map @ execute! (get@ #///statement.referrals requirements))] + _ (monad.map @ execute! (get@ #///directive.referrals requirements))] (..iterate expander module source buffer (..module-aliases analysis-module))))))})]) )))))})))) diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index ad82d860b..4ed6d6d42 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -19,7 +19,7 @@ ["#." syntax] ["/#" // ["#." analysis] - ["#." statement] + ["#." directive] ["#." phase [macro (#+ Expander)] ## TODO: Get rid of this import ASAP @@ -36,12 +36,12 @@ [compositor ["." cli (#+ Configuration)]]]) -(type: #export (Platform ! anchor expression statement) +(type: #export (Platform ! anchor expression directive) {#&monad (Monad !) #&file-system (file.System !) - #host (generation.Host expression statement) - #phase (generation.Phase anchor expression statement) - #runtime (generation.Operation anchor expression statement Any)}) + #host (generation.Host expression directive) + #phase (generation.Phase anchor expression directive) + #runtime (generation.Operation anchor expression directive Any)}) ## (def: (write-module target-dir file-name module-name module outputs) ## (-> File Text Text Module Outputs (Process Any)) @@ -52,31 +52,31 @@ ## (format module-name "/" cache.descriptor-name) ## (encoding.to-utf8 (%.code (cache/description.write file-name module)))))) -(with-expansions [ (as-is [! anchor expression statement]) - (as-is (Platform ! anchor expression statement)) - (as-is (///statement.State+ anchor expression statement)) - (as-is (generation.Bundle anchor expression statement))] +(with-expansions [ (as-is [! anchor expression directive]) + (as-is (Platform ! anchor expression directive)) + (as-is (///directive.State+ anchor expression directive)) + (as-is (generation.Bundle anchor expression directive))] - (def: #export (initialize target expander host-analysis platform generation-bundle host-statement-bundle program) + (def: #export (initialize target expander host-analysis platform generation-bundle host-directive-bundle program) (All (-> Text Expander ///analysis.Bundle - (///statement.Bundle anchor expression statement) - (-> expression statement) + (///directive.Bundle anchor expression directive) + (-> expression directive) (! (Try )))) (|> platform (get@ #runtime) - ///statement.lift-generation + ///directive.lift-generation (///phase.run' (//init.state target expander host-analysis (get@ #host platform) (get@ #phase platform) generation-bundle - host-statement-bundle + host-directive-bundle program)) (:: try.functor map product.left) (:: (get@ #&monad platform) wrap)) @@ -112,7 +112,7 @@ (-> Text Expander Configuration Archive (! (Try [Archive ])))) (let [monad (get@ #&monad platform) source-module (get@ #cli.module configuration) - compiler (:share [anchor expression statement] + compiler (:share [anchor expression directive] { state} {(///.Compiler .Module Any) @@ -165,7 +165,7 @@ _ ## TODO: The "///analysis.set-current-module" below shouldn't be necessary. Remove it ASAP. (|> (///analysis.set-current-module module) - ///statement.lift-analysis + ///directive.lift-analysis (///phase.run' state) try.assume product.left)) diff --git a/stdlib/source/lux/tool/compiler/directive.lux b/stdlib/source/lux/tool/compiler/directive.lux new file mode 100644 index 000000000..b307213c2 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/directive.lux @@ -0,0 +1,70 @@ +(.module: + [lux (#- Module) + [data + [collection + ["." list ("#;." monoid)]]]] + [// + [meta + [archive + [descriptor (#+ Module)]]] + ["." analysis] + ["." synthesis] + ["." phase + ["." generation] + ["." extension]]]) + +(type: #export (Component state phase) + {#state state + #phase phase}) + +(type: #export (State anchor expression directive) + {#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: #export Import + {#module Module + #alias Text}) + +(type: #export Requirements + {#imports (List Import) + #referrals (List Code)}) + +(def: #export no-requirements + Requirements + {#imports (list) + #referrals (list)}) + +(def: #export (merge-requirements left right) + (-> Requirements Requirements Requirements) + {#imports (list;compose (get@ #imports left) (get@ #imports right)) + #referrals (list;compose (get@ #referrals left) (get@ #referrals right))}) + +(template [ ] + [(type: #export ( anchor expression directive) + ( (..State anchor expression directive) Code Requirements))] + + [State+ extension.State] + [Operation extension.Operation] + [Phase extension.Phase] + [Handler extension.Handler] + [Bundle extension.Bundle] + ) + +(template [ ] + [(def: #export ( operation) + (All [anchor expression directive output] + (-> ( output) + (Operation anchor expression directive output))) + (extension.lift + (phase.sub [(get@ [ #..state]) + (set@ [ #..state])] + operation)))] + + [lift-analysis #..analysis analysis.Operation] + [lift-synthesis #..synthesis synthesis.Operation] + [lift-generation #..generation (generation.Operation anchor expression directive)] + ) diff --git a/stdlib/source/lux/tool/compiler/phase/directive.lux b/stdlib/source/lux/tool/compiler/phase/directive.lux new file mode 100644 index 000000000..f79f2b586 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/directive.lux @@ -0,0 +1,79 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + ["." exception (#+ exception:)]] + [data + [text + ["%" format (#+ format)]] + [collection + ["." list ("#;." fold monoid)]]] + ["." macro]] + ["." // + ["#." macro (#+ Expander)] + ["#." extension] + [".P" analysis + ["." type]] + ["#/" // #_ + [reference (#+)] + ["#." analysis] + ["/" directive (#+ Phase)]]]) + +(exception: #export (not-a-directive {code Code}) + (exception.report + ["Directive" (%.code code)])) + +(exception: #export (invalid-macro-call {code Code}) + (exception.report + ["Code" (%.code code)])) + +(exception: #export (macro-was-not-found {name Name}) + (exception.report + ["Name" (%.name name)])) + +(with-expansions [ (as-is [|form-cursor| (#.Form (list& [|text-cursor| (#.Text "lux def module")] annotations))])] + (def: #export (phase expander) + (-> Expander Phase) + (let [analyze (analysisP.phase expander)] + (function (compile code) + (case code + (^ [_ (#.Form (list& [_ (#.Text name)] inputs))]) + (do //.monad + [requirements (//extension.apply compile [name inputs])] + (wrap requirements)) + + (^ [_ (#.Form (list& macro inputs))]) + (do //.monad + [expansion (/.lift-analysis + (do @ + [macroA (type.with-type Macro + (analyze macro))] + (case macroA + (^ (///analysis.constant macro-name)) + (do @ + [?macro (//extension.lift (macro.find-macro macro-name)) + macro (case ?macro + (#.Some macro) + (wrap macro) + + #.None + (//.throw macro-was-not-found macro-name))] + (//extension.lift (//macro.expand expander macro-name macro inputs))) + + _ + (//.throw invalid-macro-call code)))) + requirements (case expansion + (^ (list& referrals)) + (do @ + [requirements (compile )] + (wrap (update@ #/.referrals (list;compose referrals) requirements))) + + _ + (|> expansion + (monad.map @ compile) + (:: @ map (list;fold /.merge-requirements /.no-requirements))))] + (wrap requirements)) + + _ + (//.throw not-a-directive code)))))) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux new file mode 100644 index 000000000..9344169f2 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux @@ -0,0 +1,345 @@ +(.module: + [lux #* + [abstract + ["." monad (#+ do)]] + [control + [io (#+ IO)] + ["." try] + ["." exception (#+ exception:)] + ["p" parser + ["s" code (#+ Parser)]]] + [data + ["." product] + ["." maybe] + [text + ["%" format (#+ format)]] + [collection + ["." dictionary]]] + ["." macro + ["." code]] + ["." type (#+ :share :by-example) ("#@." equivalence) + ["." check]]] + ["." /// + ["#." bundle] + ["#." analysis] + ["#/" // + ["#." macro (#+ Expander)] + ["#." generation] + [analysis + ["." module] + [".A" type]] + ["#/" // #_ + ["#." analysis] + ["#." synthesis (#+ Synthesis)] + ["#." directive (#+ Import Requirements Phase Operation Handler Bundle)] + [default + ["#." evaluation]]]]]) + +(def: #export (custom [syntax handler]) + (All [anchor expression directive s] + (-> [(Parser s) + (-> Text + (Phase anchor expression directive) + s + (Operation anchor expression directive Requirements))] + (Handler anchor expression directive))) + (function (_ extension-name phase inputs) + (case (s.run syntax inputs) + (#try.Success inputs) + (handler extension-name phase inputs) + + (#try.Failure error) + (////.throw ///.invalid-syntax [extension-name %.code inputs])))) + +## TODO: Inline "evaluate!'" into "evaluate!" ASAP +(def: (evaluate!' generate code//type codeS) + (All [anchor expression directive] + (-> (////generation.Phase anchor expression directive) + Type + Synthesis + (Operation anchor expression directive [Type expression Any]))) + (/////directive.lift-generation + (do ////.monad + [codeT (generate codeS) + count ////generation.next + codeV (////generation.evaluate! (format "evaluate" (%.nat count)) codeT)] + (wrap [code//type codeT codeV])))) + +(def: (evaluate! type codeC) + (All [anchor expression directive] + (-> Type Code (Operation anchor expression directive [Type expression Any]))) + (do ////.monad + [state (///.lift ////.get-state) + #let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) + synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) + generate (get@ [#/////directive.generation #/////directive.phase] state)] + [_ codeA] (/////directive.lift-analysis + (/////analysis.with-scope + (typeA.with-fresh-env + (typeA.with-type type + (analyse codeC))))) + codeS (/////directive.lift-synthesis + (synthesize codeA))] + (evaluate!' generate type codeS))) + +## TODO: Inline "definition'" into "definition" ASAP +(def: (definition' generate name code//type codeS) + (All [anchor expression directive] + (-> (////generation.Phase anchor expression directive) + Name + Type + Synthesis + (Operation anchor expression directive [Type expression Text Any]))) + (/////directive.lift-generation + (do ////.monad + [codeT (generate codeS) + [target-name value directive] (////generation.define! name codeT) + _ (////generation.save! false name directive)] + (wrap [code//type codeT target-name value])))) + +(def: (definition name expected codeC) + (All [anchor expression directive] + (-> Name (Maybe Type) Code + (Operation anchor expression directive [Type expression Text Any]))) + (do ////.monad + [state (///.lift ////.get-state) + #let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) + synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) + generate (get@ [#/////directive.generation #/////directive.phase] state)] + [_ code//type codeA] (/////directive.lift-analysis + (/////analysis.with-scope + (typeA.with-fresh-env + (case expected + #.None + (do @ + [[code//type codeA] (typeA.with-inference (analyse codeC)) + code//type (typeA.with-env + (check.clean code//type))] + (wrap [code//type codeA])) + + (#.Some expected) + (do @ + [codeA (typeA.with-type expected + (analyse codeC))] + (wrap [expected codeA])))))) + codeS (/////directive.lift-synthesis + (synthesize codeA))] + (definition' generate name code//type codeS))) + +(def: (refresh expander host-analysis) + (All [anchor expression directive] + (-> Expander /////analysis.Bundle (Operation anchor expression directive Any))) + (do ////.monad + [[bundle state] ////.get-state + #let [eval (/////evaluation.evaluator expander + (get@ [#/////directive.synthesis #/////directive.state] state) + (get@ [#/////directive.generation #/////directive.state] state) + (get@ [#/////directive.generation #/////directive.phase] state))]] + (////.set-state [bundle + (update@ [#/////directive.analysis #/////directive.state] + (: (-> /////analysis.State+ /////analysis.State+) + (|>> product.right + [(///analysis.bundle eval host-analysis)])) + state)]))) + +(def: (lux::def expander host-analysis) + (-> Expander /////analysis.Bundle Handler) + (function (_ extension-name phase inputsC+) + (case inputsC+ + (^ (list [_ (#.Identifier ["" short-name])] valueC annotationsC [_ (#.Bit exported?)])) + (do ////.monad + [current-module (/////directive.lift-analysis + (///.lift macro.current-module-name)) + #let [full-name [current-module short-name]] + [type valueT valueN value] (..definition full-name #.None valueC) + [_ annotationsT annotations] (evaluate! Code annotationsC) + _ (/////directive.lift-analysis + (module.define short-name (#.Right [exported? type (:coerce Code annotations) value]))) + #let [_ (log! (format "Definition " (%.name full-name)))] + _ (/////directive.lift-generation + (////generation.learn full-name valueN)) + _ (..refresh expander host-analysis)] + (wrap /////directive.no-requirements)) + + _ + (////.throw ///.invalid-syntax [extension-name %.code inputsC+])))) + +(def: (def::type-tagged expander host-analysis) + (-> Expander /////analysis.Bundle Handler) + (..custom + [($_ p.and s.local-identifier s.any s.any (s.tuple (p.some s.text)) s.bit) + (function (_ extension-name phase [short-name valueC annotationsC tags exported?]) + (do ////.monad + [current-module (/////directive.lift-analysis + (///.lift macro.current-module-name)) + #let [full-name [current-module short-name]] + [_ annotationsT annotations] (evaluate! Code annotationsC) + #let [annotations (:coerce Code annotations)] + [type valueT valueN value] (..definition full-name (#.Some .Type) valueC) + _ (/////directive.lift-analysis + (do ////.monad + [_ (module.define short-name (#.Right [exported? type annotations value]))] + (module.declare-tags tags exported? (:coerce Type value)))) + #let [_ (log! (format "Definition " (%.name full-name)))] + _ (/////directive.lift-generation + (////generation.learn full-name valueN)) + _ (..refresh expander host-analysis)] + (wrap /////directive.no-requirements)))])) + +(def: imports + (Parser (List Import)) + (|> (s.tuple (p.and s.text s.text)) + p.some + s.tuple)) + +(def: def::module + Handler + (..custom + [($_ p.and s.any ..imports) + (function (_ extension-name phase [annotationsC imports]) + (do ////.monad + [[_ annotationsT annotationsV] (evaluate! Code annotationsC) + #let [annotationsV (:coerce Code annotationsV)] + _ (/////directive.lift-analysis + (do @ + [_ (monad.map @ (function (_ [module alias]) + (do @ + [_ (module.import module)] + (case alias + "" (wrap []) + _ (module.alias alias module)))) + imports)] + (module.set-annotations annotationsV)))] + (wrap {#/////directive.imports imports + #/////directive.referrals (list)})))])) + +(exception: #export (cannot-alias-an-alias {local Alias} {foreign Alias} {target Name}) + (exception.report + ["Local alias" (%.name local)] + ["Foreign alias" (%.name foreign)] + ["Target definition" (%.name target)])) + +(def: (define-alias alias original) + (-> Text Name (/////analysis.Operation Any)) + (do ////.monad + [current-module (///.lift macro.current-module-name) + constant (///.lift (macro.find-def original))] + (case constant + (#.Left de-aliased) + (////.throw ..cannot-alias-an-alias [[current-module alias] original de-aliased]) + + (#.Right [exported? original-type original-annotations original-value]) + (module.define alias (#.Left original))))) + +(def: def::alias + Handler + (..custom + [($_ p.and s.local-identifier s.identifier) + (function (_ extension-name phase [alias def-name]) + (do ////.monad + [_ (///.lift + (////.sub [(get@ [#/////directive.analysis #/////directive.state]) + (set@ [#/////directive.analysis #/////directive.state])] + (define-alias alias def-name)))] + (wrap /////directive.no-requirements)))])) + +(template [ ] + [(def: + (All [anchor expression directive] + (Handler anchor expression directive)) + (function (handler extension-name phase inputsC+) + (case inputsC+ + (^ (list [_ (#.Text name)] valueC)) + (do ////.monad + [[_ handlerT handlerV] (evaluate! (:by-example [anchor expression directive] + {(Handler anchor expression directive) + handler} + ) + valueC) + _ (<| + (///.install name) + (:share [anchor expression directive] + {(Handler anchor expression directive) + handler} + { + (:assume handlerV)}))] + (wrap /////directive.no-requirements)) + + _ + (////.throw ///.invalid-syntax [extension-name %.code inputsC+]))))] + + [def::analysis /////analysis.Handler /////directive.lift-analysis] + [def::synthesis /////synthesis.Handler /////directive.lift-synthesis] + [def::generation (////generation.Handler anchor expression directive) /////directive.lift-generation] + [def::directive (/////directive.Handler anchor expression directive) (<|)] + ) + +## TODO; Both "prepare-program" and "define-program" exist only +## because the old compiler couldn"t handle a fully-inlined definition +## for "def::program". Inline them ASAP. +(def: (prepare-program analyse synthesize programC) + (All [anchor expression directive output] + (-> /////analysis.Phase + /////synthesis.Phase + Code + (Operation anchor expression directive Synthesis))) + (do ////.monad + [[_ programA] (/////directive.lift-analysis + (/////analysis.with-scope + (typeA.with-fresh-env + (typeA.with-type (type (-> (List Text) (IO Any))) + (analyse programC)))))] + (/////directive.lift-synthesis + (synthesize programA)))) + +(def: (define-program generate program programS) + (All [anchor expression directive output] + (-> (////generation.Phase anchor expression directive) + (-> expression directive) + Synthesis + (////generation.Operation anchor expression directive Any))) + (do ////.monad + [programG (generate programS)] + (////generation.save! false ["" ""] (program programG)))) + +(def: (def::program program) + (All [anchor expression directive] + (-> (-> expression directive) (Handler anchor expression directive))) + (function (handler extension-name phase inputsC+) + (case inputsC+ + (^ (list programC)) + (do ////.monad + [state (///.lift ////.get-state) + #let [analyse (get@ [#/////directive.analysis #/////directive.phase] state) + synthesize (get@ [#/////directive.synthesis #/////directive.phase] state) + generate (get@ [#/////directive.generation #/////directive.phase] state)] + programS (prepare-program analyse synthesize programC) + _ (/////directive.lift-generation + (define-program generate program programS))] + (wrap /////directive.no-requirements)) + + _ + (////.throw ///.invalid-syntax [extension-name %.code inputsC+])))) + +(def: (bundle::def expander host-analysis program) + (All [anchor expression directive] + (-> Expander /////analysis.Bundle (-> expression directive) (Bundle anchor expression directive))) + (<| (///bundle.prefix "def") + (|> ///bundle.empty + (dictionary.put "module" def::module) + (dictionary.put "alias" def::alias) + (dictionary.put "type tagged" (def::type-tagged expander host-analysis)) + (dictionary.put "analysis" def::analysis) + (dictionary.put "synthesis" def::synthesis) + (dictionary.put "generation" def::generation) + (dictionary.put "directive" def::directive) + (dictionary.put "program" (def::program program)) + ))) + +(def: #export (bundle expander host-analysis program) + (All [anchor expression directive] + (-> Expander /////analysis.Bundle (-> expression directive) (Bundle anchor expression directive))) + (<| (///bundle.prefix "lux") + (|> ///bundle.empty + (dictionary.put "def" (lux::def expander host-analysis)) + (dictionary.merge (..bundle::def expander host-analysis program))))) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux deleted file mode 100644 index eef4731d2..000000000 --- a/stdlib/source/lux/tool/compiler/phase/extension/statement/lux.lux +++ /dev/null @@ -1,345 +0,0 @@ -(.module: - [lux #* - [abstract - ["." monad (#+ do)]] - [control - [io (#+ IO)] - ["." try] - ["." exception (#+ exception:)] - ["p" parser - ["s" code (#+ Parser)]]] - [data - ["." product] - ["." maybe] - [text - ["%" format (#+ format)]] - [collection - ["." dictionary]]] - ["." macro - ["." code]] - ["." type (#+ :share :by-example) ("#@." equivalence) - ["." check]]] - ["." /// - ["#." bundle] - ["#." analysis] - ["#/" // - ["#." macro (#+ Expander)] - ["#." generation] - [analysis - ["." module] - [".A" type]] - ["#/" // #_ - ["#." analysis] - ["#." synthesis (#+ Synthesis)] - ["#." statement (#+ Import Requirements Phase Operation Handler Bundle)] - [default - ["#." evaluation]]]]]) - -(def: #export (custom [syntax handler]) - (All [anchor expression statement s] - (-> [(Parser s) - (-> Text - (Phase anchor expression statement) - s - (Operation anchor expression statement Requirements))] - (Handler anchor expression statement))) - (function (_ extension-name phase inputs) - (case (s.run syntax inputs) - (#try.Success inputs) - (handler extension-name phase inputs) - - (#try.Failure error) - (////.throw ///.invalid-syntax [extension-name %.code inputs])))) - -## TODO: Inline "evaluate!'" into "evaluate!" ASAP -(def: (evaluate!' generate code//type codeS) - (All [anchor expression statement] - (-> (////generation.Phase anchor expression statement) - Type - Synthesis - (Operation anchor expression statement [Type expression Any]))) - (/////statement.lift-generation - (do ////.monad - [codeT (generate codeS) - count ////generation.next - codeV (////generation.evaluate! (format "evaluate" (%.nat count)) codeT)] - (wrap [code//type codeT codeV])))) - -(def: (evaluate! type codeC) - (All [anchor expression statement] - (-> Type Code (Operation anchor expression statement [Type expression Any]))) - (do ////.monad - [state (///.lift ////.get-state) - #let [analyse (get@ [#/////statement.analysis #/////statement.phase] state) - synthesize (get@ [#/////statement.synthesis #/////statement.phase] state) - generate (get@ [#/////statement.generation #/////statement.phase] state)] - [_ codeA] (/////statement.lift-analysis - (/////analysis.with-scope - (typeA.with-fresh-env - (typeA.with-type type - (analyse codeC))))) - codeS (/////statement.lift-synthesis - (synthesize codeA))] - (evaluate!' generate type codeS))) - -## TODO: Inline "definition'" into "definition" ASAP -(def: (definition' generate name code//type codeS) - (All [anchor expression statement] - (-> (////generation.Phase anchor expression statement) - Name - Type - Synthesis - (Operation anchor expression statement [Type expression Text Any]))) - (/////statement.lift-generation - (do ////.monad - [codeT (generate codeS) - [target-name value statement] (////generation.define! name codeT) - _ (////generation.save! false name statement)] - (wrap [code//type codeT target-name value])))) - -(def: (definition name expected codeC) - (All [anchor expression statement] - (-> Name (Maybe Type) Code - (Operation anchor expression statement [Type expression Text Any]))) - (do ////.monad - [state (///.lift ////.get-state) - #let [analyse (get@ [#/////statement.analysis #/////statement.phase] state) - synthesize (get@ [#/////statement.synthesis #/////statement.phase] state) - generate (get@ [#/////statement.generation #/////statement.phase] state)] - [_ code//type codeA] (/////statement.lift-analysis - (/////analysis.with-scope - (typeA.with-fresh-env - (case expected - #.None - (do @ - [[code//type codeA] (typeA.with-inference (analyse codeC)) - code//type (typeA.with-env - (check.clean code//type))] - (wrap [code//type codeA])) - - (#.Some expected) - (do @ - [codeA (typeA.with-type expected - (analyse codeC))] - (wrap [expected codeA])))))) - codeS (/////statement.lift-synthesis - (synthesize codeA))] - (definition' generate name code//type codeS))) - -(def: (refresh expander host-analysis) - (All [anchor expression statement] - (-> Expander /////analysis.Bundle (Operation anchor expression statement Any))) - (do ////.monad - [[bundle state] ////.get-state - #let [eval (/////evaluation.evaluator expander - (get@ [#/////statement.synthesis #/////statement.state] state) - (get@ [#/////statement.generation #/////statement.state] state) - (get@ [#/////statement.generation #/////statement.phase] state))]] - (////.set-state [bundle - (update@ [#/////statement.analysis #/////statement.state] - (: (-> /////analysis.State+ /////analysis.State+) - (|>> product.right - [(///analysis.bundle eval host-analysis)])) - state)]))) - -(def: (lux::def expander host-analysis) - (-> Expander /////analysis.Bundle Handler) - (function (_ extension-name phase inputsC+) - (case inputsC+ - (^ (list [_ (#.Identifier ["" short-name])] valueC annotationsC [_ (#.Bit exported?)])) - (do ////.monad - [current-module (/////statement.lift-analysis - (///.lift macro.current-module-name)) - #let [full-name [current-module short-name]] - [type valueT valueN value] (..definition full-name #.None valueC) - [_ annotationsT annotations] (evaluate! Code annotationsC) - _ (/////statement.lift-analysis - (module.define short-name (#.Right [exported? type (:coerce Code annotations) value]))) - #let [_ (log! (format "Definition " (%.name full-name)))] - _ (/////statement.lift-generation - (////generation.learn full-name valueN)) - _ (..refresh expander host-analysis)] - (wrap /////statement.no-requirements)) - - _ - (////.throw ///.invalid-syntax [extension-name %.code inputsC+])))) - -(def: (def::type-tagged expander host-analysis) - (-> Expander /////analysis.Bundle Handler) - (..custom - [($_ p.and s.local-identifier s.any s.any (s.tuple (p.some s.text)) s.bit) - (function (_ extension-name phase [short-name valueC annotationsC tags exported?]) - (do ////.monad - [current-module (/////statement.lift-analysis - (///.lift macro.current-module-name)) - #let [full-name [current-module short-name]] - [_ annotationsT annotations] (evaluate! Code annotationsC) - #let [annotations (:coerce Code annotations)] - [type valueT valueN value] (..definition full-name (#.Some .Type) valueC) - _ (/////statement.lift-analysis - (do ////.monad - [_ (module.define short-name (#.Right [exported? type annotations value]))] - (module.declare-tags tags exported? (:coerce Type value)))) - #let [_ (log! (format "Definition " (%.name full-name)))] - _ (/////statement.lift-generation - (////generation.learn full-name valueN)) - _ (..refresh expander host-analysis)] - (wrap /////statement.no-requirements)))])) - -(def: imports - (Parser (List Import)) - (|> (s.tuple (p.and s.text s.text)) - p.some - s.tuple)) - -(def: def::module - Handler - (..custom - [($_ p.and s.any ..imports) - (function (_ extension-name phase [annotationsC imports]) - (do ////.monad - [[_ annotationsT annotationsV] (evaluate! Code annotationsC) - #let [annotationsV (:coerce Code annotationsV)] - _ (/////statement.lift-analysis - (do @ - [_ (monad.map @ (function (_ [module alias]) - (do @ - [_ (module.import module)] - (case alias - "" (wrap []) - _ (module.alias alias module)))) - imports)] - (module.set-annotations annotationsV)))] - (wrap {#/////statement.imports imports - #/////statement.referrals (list)})))])) - -(exception: #export (cannot-alias-an-alias {local Alias} {foreign Alias} {target Name}) - (exception.report - ["Local alias" (%.name local)] - ["Foreign alias" (%.name foreign)] - ["Target definition" (%.name target)])) - -(def: (define-alias alias original) - (-> Text Name (/////analysis.Operation Any)) - (do ////.monad - [current-module (///.lift macro.current-module-name) - constant (///.lift (macro.find-def original))] - (case constant - (#.Left de-aliased) - (////.throw ..cannot-alias-an-alias [[current-module alias] original de-aliased]) - - (#.Right [exported? original-type original-annotations original-value]) - (module.define alias (#.Left original))))) - -(def: def::alias - Handler - (..custom - [($_ p.and s.local-identifier s.identifier) - (function (_ extension-name phase [alias def-name]) - (do ////.monad - [_ (///.lift - (////.sub [(get@ [#/////statement.analysis #/////statement.state]) - (set@ [#/////statement.analysis #/////statement.state])] - (define-alias alias def-name)))] - (wrap /////statement.no-requirements)))])) - -(template [ ] - [(def: - (All [anchor expression statement] - (Handler anchor expression statement)) - (function (handler extension-name phase inputsC+) - (case inputsC+ - (^ (list [_ (#.Text name)] valueC)) - (do ////.monad - [[_ handlerT handlerV] (evaluate! (:by-example [anchor expression statement] - {(Handler anchor expression statement) - handler} - ) - valueC) - _ (<| - (///.install name) - (:share [anchor expression statement] - {(Handler anchor expression statement) - handler} - { - (:assume handlerV)}))] - (wrap /////statement.no-requirements)) - - _ - (////.throw ///.invalid-syntax [extension-name %.code inputsC+]))))] - - [def::analysis /////analysis.Handler /////statement.lift-analysis] - [def::synthesis /////synthesis.Handler /////statement.lift-synthesis] - [def::generation (////generation.Handler anchor expression statement) /////statement.lift-generation] - [def::statement (/////statement.Handler anchor expression statement) (<|)] - ) - -## TODO; Both "prepare-program" and "define-program" exist only -## because the old compiler couldn"t handle a fully-inlined definition -## for "def::program". Inline them ASAP. -(def: (prepare-program analyse synthesize programC) - (All [anchor expression statement output] - (-> /////analysis.Phase - /////synthesis.Phase - Code - (Operation anchor expression statement Synthesis))) - (do ////.monad - [[_ programA] (/////statement.lift-analysis - (/////analysis.with-scope - (typeA.with-fresh-env - (typeA.with-type (type (-> (List Text) (IO Any))) - (analyse programC)))))] - (/////statement.lift-synthesis - (synthesize programA)))) - -(def: (define-program generate program programS) - (All [anchor expression statement output] - (-> (////generation.Phase anchor expression statement) - (-> expression statement) - Synthesis - (////generation.Operation anchor expression statement Any))) - (do ////.monad - [programG (generate programS)] - (////generation.save! false ["" ""] (program programG)))) - -(def: (def::program program) - (All [anchor expression statement] - (-> (-> expression statement) (Handler anchor expression statement))) - (function (handler extension-name phase inputsC+) - (case inputsC+ - (^ (list programC)) - (do ////.monad - [state (///.lift ////.get-state) - #let [analyse (get@ [#/////statement.analysis #/////statement.phase] state) - synthesize (get@ [#/////statement.synthesis #/////statement.phase] state) - generate (get@ [#/////statement.generation #/////statement.phase] state)] - programS (prepare-program analyse synthesize programC) - _ (/////statement.lift-generation - (define-program generate program programS))] - (wrap /////statement.no-requirements)) - - _ - (////.throw ///.invalid-syntax [extension-name %.code inputsC+])))) - -(def: (bundle::def expander host-analysis program) - (All [anchor expression statement] - (-> Expander /////analysis.Bundle (-> expression statement) (Bundle anchor expression statement))) - (<| (///bundle.prefix "def") - (|> ///bundle.empty - (dictionary.put "module" def::module) - (dictionary.put "alias" def::alias) - (dictionary.put "type tagged" (def::type-tagged expander host-analysis)) - (dictionary.put "analysis" def::analysis) - (dictionary.put "synthesis" def::synthesis) - (dictionary.put "generation" def::generation) - (dictionary.put "statement" def::statement) - (dictionary.put "program" (def::program program)) - ))) - -(def: #export (bundle expander host-analysis program) - (All [anchor expression statement] - (-> Expander /////analysis.Bundle (-> expression statement) (Bundle anchor expression statement))) - (<| (///bundle.prefix "lux") - (|> ///bundle.empty - (dictionary.put "def" (lux::def expander host-analysis)) - (dictionary.merge (..bundle::def expander host-analysis program))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation.lux b/stdlib/source/lux/tool/compiler/phase/generation.lux index aa7d09d66..cbd0bba9b 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation.lux @@ -59,29 +59,29 @@ {#scope-name Text #inner-functions Nat}) -(signature: #export (Host expression statement) +(signature: #export (Host expression directive) (: (-> Text expression (Try Any)) evaluate!) - (: (-> Text statement (Try Any)) + (: (-> Text directive (Try Any)) execute!) - (: (-> Name expression (Try [Text Any statement])) + (: (-> Name expression (Try [Text Any directive])) define!)) -(type: #export (Buffer statement) (Row [Name statement])) -(type: #export (Output statement) (Row [Module (Buffer statement)])) +(type: #export (Buffer directive) (Row [Name directive])) +(type: #export (Output directive) (Row [Module (Buffer directive)])) -(type: #export (State anchor expression statement) +(type: #export (State anchor expression directive) {#context Context #anchor (Maybe anchor) - #host (Host expression statement) - #buffer (Maybe (Buffer statement)) - #output (Output statement) + #host (Host expression directive) + #buffer (Maybe (Buffer directive)) + #output (Output directive) #counter Nat #name-cache Registry}) (template [ ] - [(type: #export ( anchor expression statement) - ( (State anchor expression statement) Synthesis expression))] + [(type: #export ( anchor expression directive) + ( (State anchor expression directive) Synthesis expression))] [State+ extension.State] [Operation extension.Operation] @@ -91,9 +91,9 @@ ) (def: #export (state host) - (All [anchor expression statement] - (-> (Host expression statement) - (..State anchor expression statement))) + (All [anchor expression directive] + (-> (Host expression directive) + (..State anchor expression directive))) {#context {#scope-name "" #inner-functions 0} #anchor #.None @@ -104,9 +104,9 @@ #name-cache (dictionary.new name.hash)}) (def: #export (with-context expr) - (All [anchor expression statement output] - (-> (Operation anchor expression statement output) - (Operation anchor expression statement [Text output]))) + (All [anchor expression directive output] + (-> (Operation anchor expression directive output) + (Operation anchor expression directive [Text output]))) (function (_ [bundle state]) (let [[old-scope old-inner] (get@ #context state) new-scope (format old-scope "c" (%.nat old-inner))] @@ -119,8 +119,8 @@ (#try.Failure error))))) (def: #export context - (All [anchor expression statement] - (Operation anchor expression statement Text)) + (All [anchor expression directive] + (Operation anchor expression directive Text)) (extension.read (|>> (get@ #context) (get@ #scope-name)))) @@ -132,7 +132,7 @@ [(exception: #export ) (def: #export - (All [anchor expression statement output] ) + (All [anchor expression directive output] ) (function (_ body) (function (_ [bundle state]) (case (body [bundle (set@ (#.Some ) state)]) @@ -144,8 +144,8 @@ (#try.Failure error))))) (def: #export - (All [anchor expression statement] - (Operation anchor expression statement )) + (All [anchor expression directive] + (Operation anchor expression directive )) (function (_ (^@ stateE [bundle state])) (case (get@ state) (#.Some output) @@ -155,49 +155,49 @@ (exception.throw [])))) (def: #export ( value) - (All [anchor expression statement] - (-> (Operation anchor expression statement Any))) + (All [anchor expression directive] + (-> (Operation anchor expression directive Any))) (function (_ [bundle state]) (#try.Success [[bundle (set@ (#.Some value) state)] []])))] [#anchor (with-anchor anchor) - (-> anchor (Operation anchor expression statement output) - (Operation anchor expression statement output)) + (-> anchor (Operation anchor expression directive output) + (Operation anchor expression directive output)) anchor set-anchor anchor anchor no-anchor] [#buffer with-buffer - (-> (Operation anchor expression statement output) - (Operation anchor expression statement output)) + (-> (Operation anchor expression directive output) + (Operation anchor expression directive output)) ..empty-buffer - set-buffer buffer (Buffer statement) no-active-buffer] + set-buffer buffer (Buffer directive) no-active-buffer] ) (def: #export output - (All [anchor expression statement] - (Operation anchor expression statement (Output statement))) + (All [anchor expression directive] + (Operation anchor expression directive (Output directive))) (extension.read (get@ #output))) (def: #export next - (All [anchor expression statement] - (Operation anchor expression statement Nat)) + (All [anchor expression directive] + (Operation anchor expression directive Nat)) (do //.monad [count (extension.read (get@ #counter)) _ (extension.update (update@ #counter inc))] (wrap count))) (def: #export (gensym prefix) - (All [anchor expression statement] - (-> Text (Operation anchor expression statement Text))) + (All [anchor expression directive] + (-> Text (Operation anchor expression directive Text))) (:: //.monad map (|>> %.nat (format prefix)) ..next)) (template [ ] [(def: #export ( label code) - (All [anchor expression statement] - (-> Text (Operation anchor expression statement Any))) + (All [anchor expression directive] + (-> Text (Operation anchor expression directive Any))) (function (_ (^@ state+ [bundle state])) (case (:: (get@ #host state) label code) (#try.Success output) @@ -207,12 +207,12 @@ (exception.throw cannot-interpret error))))] [evaluate! expression] - [execute! statement] + [execute! directive] ) (def: #export (define! name code) - (All [anchor expression statement] - (-> Name expression (Operation anchor expression statement [Text Any statement]))) + (All [anchor expression directive] + (-> Name expression (Operation anchor expression directive [Text Any directive]))) (function (_ (^@ stateE [bundle state])) (case (:: (get@ #host state) define! name code) (#try.Success output) @@ -222,8 +222,8 @@ (exception.throw cannot-interpret error)))) (def: #export (save! execute? name code) - (All [anchor expression statement] - (-> Bit Name statement (Operation anchor expression statement Any))) + (All [anchor expression directive] + (-> Bit Name directive (Operation anchor expression directive Any))) (do //.monad [label (..gensym "save") _ (if execute? @@ -240,15 +240,15 @@ (//.throw no-buffer-for-saving-code name)))) (def: #export (save-buffer! target) - (All [anchor expression statement] - (-> Module (Operation anchor expression statement Any))) + (All [anchor expression directive] + (-> Module (Operation anchor expression directive Any))) (do //.monad [buffer ..buffer] (extension.update (update@ #output (row.add [target buffer]))))) (def: #export (remember lux-name) - (All [anchor expression statement] - (-> Name (Operation anchor expression statement Text))) + (All [anchor expression directive] + (-> Name (Operation anchor expression directive Text))) (function (_ (^@ stateE [_ state])) (let [cache (get@ #name-cache state)] (case (dictionary.get lux-name cache) @@ -259,8 +259,8 @@ (exception.throw unknown-lux-name [lux-name cache]))))) (def: #export (learn lux-name host-name) - (All [anchor expression statement] - (-> Name Text (Operation anchor expression statement Any))) + (All [anchor expression directive] + (-> Name Text (Operation anchor expression directive Any))) (function (_ [bundle state]) (let [cache (get@ #name-cache state)] (case (dictionary.get lux-name cache) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/extension.lux b/stdlib/source/lux/tool/compiler/phase/generation/extension.lux index 2dddb89f6..91e1b661c 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/extension.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/extension.lux @@ -27,12 +27,12 @@ (type: #export (Variadic of) (-> (List of) of)) (syntax: (arity: {arity s.nat} {name s.local-identifier} type) - (with-gensyms [g!_ g!extension g!name g!phase g!inputs g!of g!anchor g!expression g!statement] + (with-gensyms [g!_ g!extension g!name g!phase g!inputs g!of g!anchor g!expression g!directive] (do @ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension)) - (All [(~ g!anchor) (~ g!expression) (~ g!statement)] - (-> ((~ type) (~ g!expression)) (//.Handler (~ g!anchor) (~ g!expression) (~ g!statement)))) + (All [(~ g!anchor) (~ g!expression) (~ g!directive)] + (-> ((~ type) (~ g!expression)) (//.Handler (~ g!anchor) (~ g!expression) (~ g!directive)))) (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs)) (case (~ g!inputs) (^ (list (~+ g!input+))) @@ -52,8 +52,8 @@ (arity: 3 trinary ..Trinary) (def: #export (variadic extension) - (All [anchor expression statement] - (-> (Variadic expression) (//.Handler anchor expression statement))) + (All [anchor expression directive] + (-> (Variadic expression) (//.Handler anchor expression directive))) (function (_ extension-name) (function (_ phase inputsS) (do ///.monad diff --git a/stdlib/source/lux/tool/compiler/phase/generation/reference.lux b/stdlib/source/lux/tool/compiler/phase/generation/reference.lux index 110d78d0d..8a80953e9 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/reference.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/reference.lux @@ -17,14 +17,14 @@ local) (: (-> Register expression) foreign) - (: (All [anchor statement] - (-> Variable (//.Operation anchor expression statement))) + (: (All [anchor directive] + (-> Variable (//.Operation anchor expression directive))) variable) - (: (All [anchor statement] - (-> Name (//.Operation anchor expression statement))) + (: (All [anchor directive] + (-> Name (//.Operation anchor expression directive))) constant) - (: (All [anchor statement] - (-> Reference (//.Operation anchor expression statement))) + (: (All [anchor directive] + (-> Reference (//.Operation anchor expression directive))) reference)) (def: (variable-maker prefix variable) @@ -54,8 +54,8 @@ variable (:share [expression] {(-> Text expression) variable} - {(All [anchor statement] - (-> Variable (//.Operation anchor expression statement))) + {(All [anchor directive] + (-> Variable (//.Operation anchor expression directive))) (|>> (case> (#////reference.Local register) (local register) @@ -65,8 +65,8 @@ constant (:share [expression] {(-> Text expression) constant} - {(All [anchor statement] - (-> Name (//.Operation anchor expression statement))) + {(All [anchor directive] + (-> Name (//.Operation anchor expression directive))) (|>> //.remember (///@map constant))})] (structure (def: local local) diff --git a/stdlib/source/lux/tool/compiler/phase/statement.lux b/stdlib/source/lux/tool/compiler/phase/statement.lux deleted file mode 100644 index 250d14721..000000000 --- a/stdlib/source/lux/tool/compiler/phase/statement.lux +++ /dev/null @@ -1,79 +0,0 @@ -(.module: - [lux #* - [abstract - ["." monad (#+ do)]] - [control - ["." exception (#+ exception:)]] - [data - [text - ["%" format (#+ format)]] - [collection - ["." list ("#;." fold monoid)]]] - ["." macro]] - ["." // - ["#." macro (#+ Expander)] - ["#." extension] - [".P" analysis - ["." type]] - ["#/" // #_ - [reference (#+)] - ["#." analysis] - ["/" statement (#+ Phase)]]]) - -(exception: #export (not-a-statement {code Code}) - (exception.report - ["Statement" (%.code code)])) - -(exception: #export (invalid-macro-call {code Code}) - (exception.report - ["Code" (%.code code)])) - -(exception: #export (macro-was-not-found {name Name}) - (exception.report - ["Name" (%.name name)])) - -(with-expansions [ (as-is [|form-cursor| (#.Form (list& [|text-cursor| (#.Text "lux def module")] annotations))])] - (def: #export (phase expander) - (-> Expander Phase) - (let [analyze (analysisP.phase expander)] - (function (compile code) - (case code - (^ [_ (#.Form (list& [_ (#.Text name)] inputs))]) - (do //.monad - [requirements (//extension.apply compile [name inputs])] - (wrap requirements)) - - (^ [_ (#.Form (list& macro inputs))]) - (do //.monad - [expansion (/.lift-analysis - (do @ - [macroA (type.with-type Macro - (analyze macro))] - (case macroA - (^ (///analysis.constant macro-name)) - (do @ - [?macro (//extension.lift (macro.find-macro macro-name)) - macro (case ?macro - (#.Some macro) - (wrap macro) - - #.None - (//.throw macro-was-not-found macro-name))] - (//extension.lift (//macro.expand expander macro-name macro inputs))) - - _ - (//.throw invalid-macro-call code)))) - requirements (case expansion - (^ (list& referrals)) - (do @ - [requirements (compile )] - (wrap (update@ #/.referrals (list;compose referrals) requirements))) - - _ - (|> expansion - (monad.map @ compile) - (:: @ map (list;fold /.merge-requirements /.no-requirements))))] - (wrap requirements)) - - _ - (//.throw not-a-statement code)))))) diff --git a/stdlib/source/lux/tool/compiler/statement.lux b/stdlib/source/lux/tool/compiler/statement.lux deleted file mode 100644 index 5f816204c..000000000 --- a/stdlib/source/lux/tool/compiler/statement.lux +++ /dev/null @@ -1,70 +0,0 @@ -(.module: - [lux (#- Module) - [data - [collection - ["." list ("#;." monoid)]]]] - [// - [meta - [archive - [descriptor (#+ Module)]]] - ["." analysis] - ["." synthesis] - ["." phase - ["." generation] - ["." extension]]]) - -(type: #export (Component state phase) - {#state state - #phase phase}) - -(type: #export (State anchor expression statement) - {#analysis (Component analysis.State+ - analysis.Phase) - #synthesis (Component synthesis.State+ - synthesis.Phase) - #generation (Component (generation.State+ anchor expression statement) - (generation.Phase anchor expression statement))}) - -(type: #export Import - {#module Module - #alias Text}) - -(type: #export Requirements - {#imports (List Import) - #referrals (List Code)}) - -(def: #export no-requirements - Requirements - {#imports (list) - #referrals (list)}) - -(def: #export (merge-requirements left right) - (-> Requirements Requirements Requirements) - {#imports (list;compose (get@ #imports left) (get@ #imports right)) - #referrals (list;compose (get@ #referrals left) (get@ #referrals right))}) - -(template [ ] - [(type: #export ( anchor expression statement) - ( (..State anchor expression statement) Code Requirements))] - - [State+ extension.State] - [Operation extension.Operation] - [Phase extension.Phase] - [Handler extension.Handler] - [Bundle extension.Bundle] - ) - -(template [ ] - [(def: #export ( operation) - (All [anchor expression statement output] - (-> ( output) - (Operation anchor expression statement output))) - (extension.lift - (phase.sub [(get@ [ #..state]) - (set@ [ #..state])] - operation)))] - - [lift-analysis #..analysis analysis.Operation] - [lift-synthesis #..synthesis synthesis.Operation] - [lift-generation #..generation (generation.Operation anchor expression statement)] - ) diff --git a/stdlib/source/lux/tool/interpreter.lux b/stdlib/source/lux/tool/interpreter.lux index 44f14f0ab..9eda33dc5 100644 --- a/stdlib/source/lux/tool/interpreter.lux +++ b/stdlib/source/lux/tool/interpreter.lux @@ -15,7 +15,7 @@ ["." module] ["." type]] ["." generation] - ["." statement (#+ State+ Operation) + ["." directive (#+ State+ Operation) ["." total]] ["." extension]] ["." default @@ -53,26 +53,26 @@ "Till next time...") (def: enter-module - (All [anchor expression statement] - (Operation anchor expression statement Any)) - (statement.lift-analysis + (All [anchor expression directive] + (Operation anchor expression directive Any)) + (directive.lift-analysis (do phase.monad [_ (module.create 0 ..module)] (analysis.set-current-module ..module)))) (def: (initialize Monad Console platform configuration generation-bundle) - (All [! anchor expression statement] + (All [! anchor expression directive] (-> (Monad !) - (Console !) (Platform ! anchor expression statement) + (Console !) (Platform ! anchor expression directive) Configuration - (generation.Bundle anchor expression statement) - (! (State+ anchor expression statement)))) + (generation.Bundle anchor expression directive) + (! (State+ anchor expression directive)))) (do Monad [state (platform.initialize platform generation-bundle) state (platform.compile platform (set@ #cli.module syntax.prelude configuration) (set@ [#extension.state - #statement.analysis #statement.state + #directive.analysis #directive.state #extension.state #.info #.mode] #.Interpreter @@ -82,10 +82,10 @@ _ (:: Console write ..welcome-message)] (wrap state))) -(with-expansions [ (as-is (Operation anchor expression statement [Type Any]))] +(with-expansions [ (as-is (Operation anchor expression directive [Type Any]))] - (def: (interpret-statement code) - (All [anchor expression statement] + (def: (interpret-directive code) + (All [anchor expression directive] (-> Code )) (do phase.monad [_ (total.phase code) @@ -93,14 +93,14 @@ (wrap [Any []]))) (def: (interpret-expression code) - (All [anchor expression statement] + (All [anchor expression directive] (-> Code )) (do phase.monad [state (extension.lift phase.get-state) - #let [analyse (get@ [#statement.analysis #statement.phase] state) - synthesize (get@ [#statement.synthesis #statement.phase] state) - generate (get@ [#statement.generation #statement.phase] state)] - [_ codeT codeA] (statement.lift-analysis + #let [analyse (get@ [#directive.analysis #directive.phase] state) + synthesize (get@ [#directive.synthesis #directive.phase] state) + generate (get@ [#directive.generation #directive.phase] state)] + [_ codeT codeA] (directive.lift-analysis (analysis.with-scope (type.with-fresh-env (do @ @@ -109,9 +109,9 @@ codeT (type.with-env (check.clean codeT))] (wrap [codeT codeA]))))) - codeS (statement.lift-synthesis + codeS (directive.lift-synthesis (synthesize codeA))] - (statement.lift-generation + (directive.lift-generation (generation.with-buffer (do @ [codeH (generate codeS) @@ -120,23 +120,23 @@ (wrap [codeT codeV])))))) (def: (interpret configuration code) - (All [anchor expression statement] + (All [anchor expression directive] (-> Configuration Code )) (function (_ state) (case (<| (phase.run' state) - (:share [anchor expression statement] - {(State+ anchor expression statement) + (:share [anchor expression directive] + {(State+ anchor expression directive) state} { - (interpret-statement code)})) + (interpret-directive code)})) (#try.Success [state' output]) (#try.Success [state' output]) (#try.Failure error) - (if (ex.match? total.not-a-statement error) + (if (ex.match? total.not-a-directive error) (<| (phase.run' state) - (:share [anchor expression statement] - {(State+ anchor expression statement) + (:share [anchor expression directive] + {(State+ anchor expression directive) state} { (interpret-expression code)})) @@ -144,42 +144,42 @@ ) (def: (execute configuration code) - (All [anchor expression statement] - (-> Configuration Code (Operation anchor expression statement Text))) + (All [anchor expression directive] + (-> Configuration Code (Operation anchor expression directive Text))) (do phase.monad [[codeT codeV] (interpret configuration code) state phase.get-state] (wrap (/type.represent (get@ [#extension.state - #statement.analysis #statement.state + #directive.analysis #directive.state #extension.state] state) codeT codeV)))) -(type: (Context anchor expression statement) +(type: (Context anchor expression directive) {#configuration Configuration - #state (State+ anchor expression statement) + #state (State+ anchor expression directive) #source Source}) -(with-expansions [ (as-is (Context anchor expression statement))] +(with-expansions [ (as-is (Context anchor expression directive))] (def: (read-eval-print context) - (All [anchor expression statement] + (All [anchor expression directive] (-> (Try [ Text]))) (do try.monad [#let [[_where _offset _code] (get@ #source context)] [source' input] (syntax.parse ..module syntax.no-aliases (text.size _code) (get@ #source context)) [state' representation] (let [## TODO: Simplify ASAP - state (:share [anchor expression statement] + state (:share [anchor expression directive] { context} - {(State+ anchor expression statement) + {(State+ anchor expression directive) (get@ #state context)})] (<| (phase.run' state) ## TODO: Simplify ASAP - (:share [anchor expression statement] + (:share [anchor expression directive] { context} - {(Operation anchor expression statement Text) + {(Operation anchor expression directive Text) (execute (get@ #configuration context) input)})))] (wrap [(|> context (set@ #state state') @@ -187,11 +187,11 @@ representation])))) (def: #export (run Monad Console platform configuration generation-bundle) - (All [! anchor expression statement] + (All [! anchor expression directive] (-> (Monad !) - (Console !) (Platform ! anchor expression statement) + (Console !) (Platform ! anchor expression directive) Configuration - (generation.Bundle anchor expression statement) + (generation.Bundle anchor expression directive) (! Any))) (do Monad [state (initialize Monad Console platform configuration)] diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 2a6f9bfd4..1725e80e5 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -26,7 +26,7 @@ [tool [compiler ["." analysis] - ["." statement] + ["." directive] ["." phase [macro (#+ Expander)] ["." generation]] @@ -58,17 +58,17 @@ (wrap output)))) (def: (save-artifacts! system state) - (All [anchor expression statement] + (All [anchor expression directive] (-> (file.System IO) - (statement.State+ anchor expression statement) + (directive.State+ anchor expression directive) (IO (Try Any)))) (let [?outcome (phase.run' state - (:share [anchor expression statement] - {(statement.State+ anchor expression statement) + (:share [anchor expression directive] + {(directive.State+ anchor expression directive) state} - {(statement.Operation anchor expression statement - (generation.Output statement)) - (statement.lift-generation generation.output)}))] + {(directive.Operation anchor expression directive + (generation.Output directive)) + (directive.lift-generation generation.output)}))] (case ?outcome (#try.Success [state output]) (do (try.with io.monad) @@ -79,16 +79,16 @@ (#try.Failure error) (:: io.monad wrap (#try.Failure error))))) -(def: #export (compiler target partial-host-extension expander host-analysis platform generation-bundle host-statement-bundle program service) - (All [anchor expression statement] +(def: #export (compiler target partial-host-extension expander host-analysis platform generation-bundle host-directive-bundle program service) + (All [anchor expression directive] (-> Text Text Expander analysis.Bundle - (IO (Platform IO anchor expression statement)) - (generation.Bundle anchor expression statement) - (statement.Bundle anchor expression statement) - (-> expression statement) + (IO (Platform IO anchor expression directive)) + (generation.Bundle anchor expression directive) + (directive.Bundle anchor expression directive) + (-> expression directive) Service (IO Any))) (do io.monad @@ -98,15 +98,15 @@ (#cli.Compilation configuration) (<| (or-crash! "Compilation failed:") (do (try.with io.monad) - [state (:share [anchor expression statement] - {(Platform IO anchor expression statement) + [state (:share [anchor expression directive] + {(Platform IO anchor expression directive) platform} - {(IO (Try (statement.State+ anchor expression statement))) - (platform.initialize target expander host-analysis platform generation-bundle host-statement-bundle program)}) - [archive state] (:share [anchor expression statement] - {(Platform IO anchor expression statement) + {(IO (Try (directive.State+ anchor expression directive))) + (platform.initialize target expander host-analysis platform generation-bundle host-directive-bundle program)}) + [archive state] (:share [anchor expression directive] + {(Platform IO anchor expression directive) platform} - {(IO (Try [Archive (statement.State+ anchor expression statement)])) + {(IO (Try [Archive (directive.State+ anchor expression directive)])) (platform.compile partial-host-extension expander platform configuration archive.empty state)}) _ (save-artifacts! (get@ #platform.&file-system platform) state) ## _ (cache/io.clean target ...) diff --git a/stdlib/source/spec/compositor.lux b/stdlib/source/spec/compositor.lux index 903097950..08a294282 100644 --- a/stdlib/source/spec/compositor.lux +++ b/stdlib/source/spec/compositor.lux @@ -11,7 +11,7 @@ [tool [compiler ["." analysis] - ["." statement] + ["." directive] [phase [macro (#+ Expander)] [generation (#+ Bundle)]] @@ -42,11 +42,11 @@ )) (def: #export (spec platform bundle expander program) - (All [anchor expression statement] - (-> (IO (Platform IO anchor expression statement)) - (Bundle anchor expression statement) + (All [anchor expression directive] + (-> (IO (Platform IO anchor expression directive)) + (Bundle anchor expression directive) Expander - (-> expression statement) + (-> expression directive) Test)) (do r.monad [_ (wrap []) @@ -58,9 +58,9 @@ expander program))]] (case ?state,runner,definer - (#try.Success [[statement-bundle statement-state] runner definer]) + (#try.Success [[directive-bundle directive-state] runner definer]) (..test runner definer - (get@ [#statement.analysis #statement.state] statement-state) + (get@ [#directive.analysis #directive.state] directive-state) expander) (#try.Failure error) diff --git a/stdlib/source/spec/compositor/common.lux b/stdlib/source/spec/compositor/common.lux index 7b1c940fb..05fbe7fc2 100644 --- a/stdlib/source/spec/compositor/common.lux +++ b/stdlib/source/spec/compositor/common.lux @@ -9,7 +9,7 @@ [compiler ["." reference] ["." synthesis (#+ Synthesis)] - ["." statement] + ["." directive] ["." phase ["." macro (#+ Expander)] ["." generation (#+ Operation Bundle)] @@ -22,9 +22,9 @@ (type: #export Definer (-> Name Synthesis (Try Any))) (type: #export (Instancer what) - (All [anchor expression statement] - (-> (Platform IO anchor expression statement) - (generation.State+ anchor expression statement) + (All [anchor expression directive] + (-> (Platform IO anchor expression directive) + (generation.State+ anchor expression directive) what))) (def: (runner (^slots [#platform.runtime #platform.phase #platform.host]) state) @@ -48,27 +48,27 @@ (do phase.monad [_ runtime expressionG (phase expressionS) - [host-name host-value host-statement] (generation.define! lux-name expressionG) + [host-name host-value host-directive] (generation.define! lux-name expressionG) _ (generation.learn lux-name host-name)] (phase (synthesis.constant lux-name))))] (:: host evaluate! "definer" definitionG)))) (def: #export (executors platform bundle expander program) - (All [anchor expression statement] - (-> (Platform IO anchor expression statement) - (Bundle anchor expression statement) + (All [anchor expression directive] + (-> (Platform IO anchor expression directive) + (Bundle anchor expression directive) Expander - (-> expression statement) - (IO (Try [(statement.State+ anchor expression statement) + (-> expression directive) + (IO (Try [(directive.State+ anchor expression directive) Runner Definer])))) (do io.monad [?state (platform.initialize expander platform bundle program)] (wrap (do try.monad - [[statement-bundle statement-state] ?state - #let [generation-state (get@ [#statement.generation - #statement.state] - statement-state)]] - (wrap [[statement-bundle statement-state] + [[directive-bundle directive-state] ?state + #let [generation-state (get@ [#directive.generation + #directive.state] + directive-state)]] + (wrap [[directive-bundle directive-state] (..runner platform generation-state) (..definer platform generation-state)]))))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index e99cdb85a..c293985a4 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -110,7 +110,7 @@ ## [phase ## ["._" generation] ## [extension - ## ["._" statement]]] + ## ["._" directive]]] ## ["._default" cache]] ## [meta ## ["._meta" io -- cgit v1.2.3