diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/tool/compiler/default/platform.lux | 25 | ||||
-rw-r--r-- | stdlib/source/lux/tool/compiler/phase/directive.lux | 30 | ||||
-rw-r--r-- | stdlib/source/lux/tool/compiler/phase/generation.lux | 18 |
3 files changed, 45 insertions, 28 deletions
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index b37e74c2b..aea0ca787 100644 --- a/stdlib/source/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/lux/tool/compiler/default/platform.lux @@ -23,7 +23,7 @@ ["#." phase [macro (#+ Expander)] ## TODO: Get rid of this import ASAP - [extension (#+ Extender)] + ["." extension (#+ Extender)] ["." generation (#+ Buffer)] [analysis ["." module]]] @@ -57,6 +57,18 @@ <State+> (as-is (///directive.State+ anchor expression directive)) <Bundle> (as-is (generation.Bundle anchor expression directive))] + (def: pause-context + (All <type-vars> + (-> <State+> generation.Context)) + (get@ [#extension.state #///directive.generation #///directive.state #extension.state #generation.context])) + + (def: (resume-context context state) + (All <type-vars> + (-> generation.Context <State+> <State+>)) + (set@ [#extension.state #///directive.generation #///directive.state #extension.state #generation.context] + context + state)) + (def: #export (initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender) (All <type-vars> (-> Text @@ -157,16 +169,18 @@ ## _ (write-module target-dir file-name (get@ #cli.module configuration) module outputs) ] (loop [archive archive - state state + state (..resume-context (generation.fresh-context module) state) compilation (compiler (:coerce ///.Input input))] (do @ - [#let [dependencies (get@ #///.dependencies compilation)] + [#let [dependencies (get@ #///.dependencies compilation) + current-context (..pause-context state)] archive+state (monad.fold @ import! [archive state] (list.filter (bit.complement (archive.archived? archive)) dependencies)) - #let [[archive state] (:share <type-vars> + #let [## TODO: Inline ASAP + [archive state] (:share <type-vars> {<Platform> platform} {[Archive <State+>] @@ -184,9 +198,10 @@ _ ## TODO: The "///analysis.set-current-module" below shouldn't be necessary. Remove it ASAP. + ## TODO: The context shouldn't need to be re-set either. (|> (///analysis.set-current-module module) ///directive.lift-analysis - (///phase.run' state) + (///phase.run' (..resume-context current-context state)) try.assume product.left)) archive) diff --git a/stdlib/source/lux/tool/compiler/phase/directive.lux b/stdlib/source/lux/tool/compiler/phase/directive.lux index f79f2b586..dc4115610 100644 --- a/stdlib/source/lux/tool/compiler/phase/directive.lux +++ b/stdlib/source/lux/tool/compiler/phase/directive.lux @@ -36,12 +36,10 @@ (def: #export (phase expander) (-> Expander Phase) (let [analyze (analysisP.phase expander)] - (function (compile code) + (function (recur code) (case code (^ [_ (#.Form (list& [_ (#.Text name)] inputs))]) - (do //.monad - [requirements (//extension.apply compile [name inputs])] - (wrap requirements)) + (//extension.apply recur [name inputs]) (^ [_ (#.Form (list& macro inputs))]) (do //.monad @@ -58,22 +56,20 @@ (wrap macro) #.None - (//.throw macro-was-not-found macro-name))] + (//.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& <lux_def_module> referrals)) - (do @ - [requirements (compile <lux_def_module>)] - (wrap (update@ #/.referrals (list;compose referrals) requirements))) + (//.throw ..invalid-macro-call code))))] + (case expansion + (^ (list& <lux_def_module> referrals)) + (|> (recur <lux_def_module>) + (:: @ map (update@ #/.referrals (list;compose referrals)))) - _ - (|> expansion - (monad.map @ compile) - (:: @ map (list;fold /.merge-requirements /.no-requirements))))] - (wrap requirements)) + _ + (|> expansion + (monad.map @ recur) + (:: @ map (list;fold /.merge-requirements /.no-requirements))))) _ - (//.throw not-a-directive code)))))) + (//.throw ..not-a-directive code)))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation.lux b/stdlib/source/lux/tool/compiler/phase/generation.lux index 2f6e28ed2..35fa850be 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation.lux @@ -90,12 +90,16 @@ [Bundle extension.Bundle] ) +(def: #export (fresh-context scope-name) + (-> Text Context) + {#scope-name scope-name + #inner-functions 0}) + (def: #export (state host) (All [anchor expression directive] (-> (Host expression directive) (..State anchor expression directive))) - {#context {#scope-name "" - #inner-functions 0} + {#context (..fresh-context "") #anchor #.None #host host #buffer #.None @@ -110,7 +114,7 @@ (Operation anchor expression directive output))) (function (_ [bundle state]) (let [old (get@ #context state)] - (case (expr [bundle (set@ #context [specific-scope 0] state)]) + (case (expr [bundle (set@ #context (..fresh-context specific-scope) state)]) (#try.Success [[bundle' state'] output]) (#try.Success [[bundle' (set@ #context old state')] @@ -125,10 +129,12 @@ (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))] - (case (expr [bundle (set@ #context [new-scope 0] state)]) + new-scope (format old-scope "$c" (%.nat old-inner))] + (case (expr [bundle (set@ #context (..fresh-context new-scope) state)]) (#try.Success [[bundle' state'] output]) - (#try.Success [[bundle' (set@ #context [old-scope (inc old-inner)] state')] + (#try.Success [[bundle' (set@ #context {#scope-name old-scope + #inner-functions (inc old-inner)} + state')] [new-scope output]]) (#try.Failure error) |