From 54b69afa96cd00b174b07c3f23b496b5e5b63858 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 17 Mar 2019 22:19:06 -0400 Subject: Now compiling program statements. --- stdlib/source/lux/cli.lux | 4 +- stdlib/source/lux/tool/compiler/default/init.lux | 5 +- .../source/lux/tool/compiler/default/platform.lux | 11 ++- .../tool/compiler/phase/extension/statement.lux | 80 ++++++++++++++++++---- .../tool/compiler/phase/generation/js/runtime.lux | 25 +++---- stdlib/source/program/compositor.lux | 32 ++++----- 6 files changed, 107 insertions(+), 50 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index 8af410d54..34f4fa31c 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -140,7 +140,7 @@ (with-gensyms [g!program] (case args (#Raw args) - (wrap (list (` ("lux program" + (wrap (list (` ("lux def program" (.function ((~ g!program) (~ (code.identifier ["" args]))) ((~! do) (~! io.monad) [] @@ -148,7 +148,7 @@ (#Parsed args) (with-gensyms [g!args g!_ g!output g!message] - (wrap (list (` ("lux program" + (wrap (list (` ("lux def program" (.function ((~ g!program) (~ g!args)) (case ((: (~! (..CLI (io.IO .Any))) ((~! do) (~! p.monad) diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux index 9c7aa546c..4686441f1 100644 --- a/stdlib/source/lux/tool/compiler/default/init.lux +++ b/stdlib/source/lux/tool/compiler/default/init.lux @@ -71,18 +71,19 @@ [(analysisE.bundle eval)])) state)]))) -(def: #export (state expander host generate generation-bundle) +(def: #export (state expander host generate generation-bundle program) (All [anchor expression statement] (-> Expander (generation.Host expression statement) (generation.Phase anchor expression statement) (generation.Bundle anchor expression statement) + (-> expression statement) (///statement.State+ anchor expression statement))) (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) (///analysis.state ..info host)]] - [statementE.bundle + [(statementE.bundle program) {#///statement.analysis {#///statement.state analysis-state #///statement.phase (analysisP.phase expander)} #///statement.synthesis {#///statement.state synthesis-state diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index 05e645e58..61b27dacf 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -56,16 +56,21 @@ (as-is (///statement.State+ anchor expression statement)) (as-is (generation.Bundle anchor expression statement))] - (def: #export (initialize expander platform generation-bundle) + (def: #export (initialize expander platform generation-bundle program) (All - (-> Expander (! (Error )))) + (-> Expander + + + (-> expression statement) + (! (Error )))) (|> platform (get@ #runtime) ///statement.lift-generation (///phase.run' (//init.state expander (get@ #host platform) (get@ #phase platform) - generation-bundle)) + generation-bundle + program)) (:: error.functor map product.left) (:: (get@ #&monad platform) wrap)) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux index e8910a3fb..18bb58fbd 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux @@ -1,5 +1,6 @@ (.module: [lux #* + [io (#+ IO)] [control ["." monad (#+ do)] ["p" parser]] @@ -18,10 +19,10 @@ ["." // ["#." bundle] ["#/" // + ["#." generation] [analysis ["." module] ["." type]] - ["#." generation] ["#/" // #_ ["#." analysis] ["#." synthesis (#+ Synthesis)] @@ -169,11 +170,13 @@ (#error.Failure error) (///.throw //.invalid-syntax [extension-name])) _ (////statement.lift-analysis - (do ///.monad + (do @ [_ (monad.map @ (function (_ [module alias]) (do @ [_ (module.import module)] - (module.alias alias module))) + (case alias + "" (wrap []) + _ (module.alias alias module)))) imports)] (module.set-annotations (:coerce Code annotationsV))))] (wrap {#////statement.imports imports @@ -243,21 +246,72 @@ [def::statement (////statement.Handler anchor expression statement) (<|)] ) -(def: bundle::def - Bundle +## 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 + (type.with-fresh-env + (type.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))) + (///generation.with-buffer + (do ///.monad + [programG (generate programS)] + (///generation.save! ["" ""] (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])))) + +(def: (bundle::def program) + (All [anchor expression statement] + (-> (-> expression statement) (Bundle anchor expression statement))) (<| (//bundle.prefix "def") (|> //bundle.empty - (dictionary.put "module" def::module) - (dictionary.put "alias" def::alias) - (dictionary.put "analysis" def::analysis) - (dictionary.put "synthesis" def::synthesis) + (dictionary.put "module" def::module) + (dictionary.put "alias" def::alias) + (dictionary.put "analysis" def::analysis) + (dictionary.put "synthesis" def::synthesis) (dictionary.put "generation" def::generation) - (dictionary.put "statement" def::statement) + (dictionary.put "statement" def::statement) + (dictionary.put "program" (def::program program)) ))) -(def: #export bundle - Bundle +(def: #export (bundle program) + (All [anchor expression statement] + (-> (-> expression statement) (Bundle anchor expression statement))) (<| (//bundle.prefix "lux") (|> //bundle.empty (dictionary.put "def" lux::def) - (dictionary.merge ..bundle::def)))) + (dictionary.merge (..bundle::def program))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux index 25f24cc98..5e2da39de 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/js/runtime.lux @@ -160,20 +160,17 @@ (_.at (..last-index tuple) tuple)) -(runtime: (lux//program-args) - (with-vars [process output idx] - (_.if (_.and (|> process _.type-of (_.= _.undefined) _.not) - (|> process (_.the "argv"))) - ($_ _.then - (_.define output ..none) - (_.for idx - (|> process (_.the "argv") ..last-index) - (_.>= (_.i32 +0) idx) - (_.-- idx) - (_.set output (..some (_.array (list (|> process (_.the "argv") (_.at idx)) - output))))) - (_.return output)) - (_.return ..none)))) +(runtime: (lux//program-args inputs) + (with-vars [output idx] + ($_ _.then + (_.define output ..none) + (_.for idx + (..last-index inputs) + (_.>= (_.i32 +0) idx) + (_.-- idx) + (_.set output (..some (_.array (list (_.at idx inputs) + output))))) + (_.return output)))) (def: runtime//lux Statement diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux index 3c4d2015c..b2ab8208e 100644 --- a/stdlib/source/program/compositor.lux +++ b/stdlib/source/program/compositor.lux @@ -44,11 +44,12 @@ (#error.Success output) (wrap output)))) -(def: #export (compiler expander platform bundle service) +(def: #export (compiler expander platform bundle program service) (All [anchor expression statement] (-> Expander (IO (Platform IO anchor expression statement)) (generation.Bundle anchor expression statement) + (-> expression statement) Service (IO Any))) (do io.monad @@ -57,21 +58,20 @@ (case service (#cli.Compilation configuration) (<| (or-crash! "Compilation failed:") - (function (_ _) - (do (error.with io.monad) - [state (:share [anchor expression statement] - {(Platform IO anchor expression statement) - platform} - {(IO (Error (statement.State+ anchor expression statement))) - (platform.initialize expander platform bundle)}) - _ (:share [anchor expression statement] - {(Platform IO anchor expression statement) - platform} - {(IO (Error [Archive (statement.State+ anchor expression statement)])) - (platform.compile expander platform configuration archive.empty state)}) - ## _ (cache/io.clean target ...) - ] - (wrap (log! "Compilation complete!"))))) + (do (error.with io.monad) + [state (:share [anchor expression statement] + {(Platform IO anchor expression statement) + platform} + {(IO (Error (statement.State+ anchor expression statement))) + (platform.initialize expander platform bundle program)}) + _ (:share [anchor expression statement] + {(Platform IO anchor expression statement) + platform} + {(IO (Error [Archive (statement.State+ anchor expression statement)])) + (platform.compile expander platform configuration archive.empty state)}) + ## _ (cache/io.clean target ...) + ] + (wrap (log! "Compilation complete!")))) (#cli.Interpretation configuration) ## TODO: Fix the interpreter... -- cgit v1.2.3