From 55219078698866155d7d3879f1378f75ba2ba3ee Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sun, 29 Dec 2019 22:41:46 -0400
Subject: FIX the names of function classes are now prefixed with their
originating module.
---
.../source/lux/tool/compiler/default/platform.lux | 25 ++++++++++++++----
.../source/lux/tool/compiler/phase/directive.lux | 30 ++++++++++------------
.../source/lux/tool/compiler/phase/generation.lux | 18 ++++++++-----
3 files changed, 45 insertions(+), 28 deletions(-)
(limited to 'stdlib/source')
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)
--
cgit v1.2.3