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". --- .../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 +- 17 files changed, 716 insertions(+), 716 deletions(-) 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 (limited to 'stdlib') 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