aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2019-03-02 23:57:30 -0400
committerEduardo Julian2019-03-02 23:57:30 -0400
commit8dfd0e3992f5ae60d568793a6843dc9fb472eba7 (patch)
treeb1e188f6631856219e6109c04eba036575cb0192
parentd117adb8fd8869cdff9c9ba0f9e5f14304c285d8 (diff)
Partially factored-out the macro-expansion machinery.
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux/tool/compiler/default/evaluation.lux29
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux54
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux19
-rw-r--r--stdlib/source/lux/tool/compiler/phase/analysis/expression.lux25
-rw-r--r--stdlib/source/lux/tool/compiler/phase/analysis/macro.lux61
-rw-r--r--stdlib/source/lux/tool/compiler/phase/statement/total.lux60
6 files changed, 135 insertions, 113 deletions
diff --git a/stdlib/source/lux/tool/compiler/default/evaluation.lux b/stdlib/source/lux/tool/compiler/default/evaluation.lux
index 1f21304ca..68fda1e7d 100644
--- a/stdlib/source/lux/tool/compiler/default/evaluation.lux
+++ b/stdlib/source/lux/tool/compiler/default/evaluation.lux
@@ -10,7 +10,8 @@
["." phase
[analysis (#+ Operation)
[".A" expression]
- ["." type]]
+ ["." type]
+ [macro (#+ Expander)]]
["." synthesis
[".S" expression]]
["." translation]]])
@@ -18,19 +19,21 @@
(type: #export Eval
(-> Nat Type Code (Operation Any)))
-(def: #export (evaluator synthesis-state translation-state translate)
+(def: #export (evaluator expander synthesis-state translation-state translate)
(All [anchor expression statement]
- (-> synthesis.State+
+ (-> Expander
+ synthesis.State+
(translation.State+ anchor expression statement)
(translation.Phase anchor expression statement)
Eval))
- (function (eval count type exprC)
- (do phase.monad
- [exprA (type.with-type type
- (expressionA.compile exprC))]
- (phase.lift (do error.monad
- [exprS (|> exprA expressionS.phase (phase.run synthesis-state))]
- (phase.run translation-state
- (do phase.monad
- [exprO (translate exprS)]
- (translation.evaluate! (format "eval" (%n count)) exprO))))))))
+ (let [analyze (expressionA.phase expander)]
+ (function (eval count type exprC)
+ (do phase.monad
+ [exprA (type.with-type type
+ (analyze exprC))]
+ (phase.lift (do error.monad
+ [exprS (|> exprA expressionS.phase (phase.run synthesis-state))]
+ (phase.run translation-state
+ (do phase.monad
+ [exprO (translate exprS)]
+ (translation.evaluate! (format "eval" (%n count)) exprO)))))))))
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
index 8375c4642..8d23b6a4a 100644
--- a/stdlib/source/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -21,6 +21,7 @@
["." phase
["." analysis
["." module]
+ [macro (#+ Expander)]
[".A" expression]]
["." synthesis
[".S" expression]]
@@ -52,34 +53,36 @@
#.version //.version
#.mode #.Build})
-(def: refresh
+(def: (refresh expander)
(All [anchor expression statement]
- (statement.Operation anchor expression statement Any))
+ (-> Expander (statement.Operation anchor expression statement Any)))
(do phase.monad
[[bundle state] phase.get-state
- #let [eval (evaluation.evaluator (get@ [#statement.synthesis #statement.state] state)
+ #let [eval (evaluation.evaluator expander
+ (get@ [#statement.synthesis #statement.state] state)
(get@ [#statement.translation #statement.state] state)
(get@ [#statement.translation #statement.phase] state))]]
- (phase.set-state [statementE.bundle
+ (phase.set-state [bundle
(update@ [#statement.analysis #statement.state]
(: (-> analysis.State+ analysis.State+)
(|>> product.right
[(analysisE.bundle eval)]))
state)])))
-(def: #export (state host translate translation-bundle)
+(def: #export (state expander host translate translation-bundle)
(All [anchor expression statement]
- (-> (translation.Host expression statement)
+ (-> Expander
+ (translation.Host expression statement)
(translation.Phase anchor expression statement)
(translation.Bundle anchor expression statement)
(statement.State+ anchor expression statement)))
(let [synthesis-state [synthesisE.bundle synthesis.init]
translation-state [translation-bundle (translation.state host)]
- eval (evaluation.evaluator synthesis-state translation-state translate)
+ eval (evaluation.evaluator expander synthesis-state translation-state translate)
analysis-state [(analysisE.bundle eval) (analysis.state ..info host)]]
[statementE.bundle
{#statement.analysis {#statement.state analysis-state
- #statement.phase expressionA.compile}
+ #statement.phase (expressionA.phase expander)}
#statement.synthesis {#statement.state synthesis-state
#statement.phase expressionS.phase}
#statement.translation {#statement.state translation-state
@@ -126,22 +129,23 @@
(|>> module.set-compiled
statement.lift-analysis))
- (def: (iteration reader)
- (-> Reader <Operation>)
- (do phase.monad
- [code (statement.lift-analysis
- (..read reader))
- _ (totalS.phase code)]
- ..refresh))
-
- (def: (loop module)
- (-> Module <Operation>)
+ (def: (iteration expander reader)
+ (-> Expander Reader <Operation>)
+ (let [execute (totalS.phase expander)]
+ (do phase.monad
+ [code (statement.lift-analysis
+ (..read reader))
+ _ (execute code)]
+ (..refresh expander))))
+
+ (def: (loop expander module)
+ (-> Expander Module <Operation>)
(do phase.monad
[reader (statement.lift-analysis
(..reader module syntax.no-aliases))]
(function (_ state)
(.loop [state state]
- (case (..iteration reader state)
+ (case (..iteration expander reader state)
(#error.Success [state' output])
(recur state')
@@ -150,12 +154,12 @@
(#error.Success [state []])
(ex.with-stack ///.cannot-compile module (#error.Failure error))))))))
- (def: (compile hash input)
- (-> Nat ///.Input <Operation>)
+ (def: (compile expander hash input)
+ (-> Expander Nat ///.Input <Operation>)
(do phase.monad
[#let [module (get@ #///.module input)]
_ (..begin hash input)
- _ (..loop module)]
+ _ (..loop expander module)]
(..end module)))
(def: (default-dependencies prelude input)
@@ -165,9 +169,9 @@
(list prelude)))
)
-(def: #export (compiler prelude state)
+(def: #export (compiler expander prelude state)
(All [anchor expression statement]
- (-> Module
+ (-> Expander Module
(statement.State+ anchor expression statement)
(Instancer .Module)))
(function (_ key parameters input)
@@ -180,7 +184,7 @@
(: (All [anchor expression statement]
(statement.Operation anchor expression statement .Module))
(do phase.monad
- [_ (compile hash input)]
+ [_ (compile expander hash input)]
(statement.lift-analysis
(extension.lift
macro.current-module)))))
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 22c50ddec..d751d2321 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -12,6 +12,8 @@
["." syntax]
["/." //
["." phase
+ [analysis
+ [macro (#+ Expander)]]
["." translation]
["." statement]]
["." cli (#+ Configuration)]
@@ -40,13 +42,14 @@
<State+> (as-is (statement.State+ anchor expression statement))
<Bundle> (as-is (translation.Bundle anchor expression statement))]
- (def: #export (initialize platform translation-bundle)
+ (def: #export (initialize expander platform translation-bundle)
(All [! anchor expression statement]
- (-> <Platform> <Bundle> (! (Error <State+>))))
+ (-> Expander <Platform> <Bundle> (! (Error <State+>))))
(|> platform
(get@ #runtime)
statement.lift-translation
- (phase.run' (init.state (get@ #host platform)
+ (phase.run' (init.state expander
+ (get@ #host platform)
(get@ #phase platform)
translation-bundle))
(:: error.functor map product.left)
@@ -78,9 +81,9 @@
## (io.fail error))
)
- (def: #export (compile platform configuration state)
+ (def: #export (compile expander platform configuration state)
(All [! anchor expression statement]
- (-> <Platform> Configuration <State+> (! (Error Any))))
+ (-> Expander <Platform> Configuration <State+> (! (Error Any))))
(let [monad (get@ #&monad platform)]
(do monad
[input (context.read monad
@@ -92,8 +95,8 @@
]
(wrap (do error.monad
[input input
- #let [compiler (init.compiler syntax.prelude state)
- compilation (compiler init.key (list) input)]]
+ #let [compile (init.compiler expander syntax.prelude state)
+ compilation (compile init.key (list) input)]]
(case ((get@ #///.process compilation)
archive.empty)
(#error.Success more|done)
@@ -107,7 +110,7 @@
(#error.Failure error)
(#error.Failure error))))
- ## (case (compiler input)
+ ## (case (compile input)
## (#error.Failure error)
## (:: monad wrap (#error.Failure error))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux b/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux
index 82c9cd65b..f79d36f4f 100644
--- a/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/expression.lux
@@ -15,7 +15,7 @@
["//." reference]
["." case]
["." function]
- ["//." macro]
+ ["//." macro (#+ Expander)]
["/." //
["." extension]
[//
@@ -79,8 +79,8 @@
_
(else code')))
-(def: (compile|others compile code')
- (-> Phase (-> (Code' (Ann Cursor)) (Operation Analysis)))
+(def: (compile|others expander compile code')
+ (-> Expander Phase (-> (Code' (Ann Cursor)) (Operation Analysis)))
(case code'
(#.Identifier reference)
(//reference.reference reference)
@@ -107,7 +107,7 @@
(case ?macro
(#.Some macro)
(do @
- [expansion (extension.lift (//macro.expand-one def-name macro argsC+))]
+ [expansion (extension.lift (//macro.expand-one expander def-name macro argsC+))]
(compile expansion))
_
@@ -119,11 +119,12 @@
_
(///.throw unrecognized-syntax [.dummy-cursor code'])))
-(def: #export (compile code)
- Phase
- (let [[cursor code'] code]
- ## The cursor must be set in the state for the sake
- ## of having useful error messages.
- (//.with-cursor cursor
- (compile|primitive (compile|structure compile (compile|others compile))
- code'))))
+(def: #export (phase expander)
+ (-> Expander Phase)
+ (function (compile code)
+ (let [[cursor code'] code]
+ ## The cursor must be set in the state for the sake
+ ## of having useful error messages.
+ (//.with-cursor cursor
+ (compile|primitive (compile|structure compile (compile|others expander compile))
+ code')))))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux b/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux
index 18455b837..aae26ada7 100644
--- a/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux
@@ -27,50 +27,59 @@
(list/map (|>> %code (format text.new-line text.tab)))
(text.join-with ""))]))
-(import: java/lang/reflect/Method
- (invoke [Object (Array Object)] #try Object))
+(import: #long java/lang/reflect/Method
+ (invoke [java/lang/Object (Array java/lang/Object)] #try java/lang/Object))
-(import: (java/lang/Class c)
- (getMethod [String (Array (Class Object))] #try Method))
+(import: #long (java/lang/Class c)
+ (getMethod [java/lang/String (Array (java/lang/Class java/lang/Object))] #try java/lang/reflect/Method))
-(import: java/lang/Object
- (getClass [] (Class Object)))
+(import: #long java/lang/Object
+ (getClass [] (java/lang/Class java/lang/Object)))
(def: _object-class
- (Class Object)
- (host.class-for Object))
+ (java/lang/Class java/lang/Object)
+ (host.class-for java/lang/Object))
(def: _apply-args
- (Array (Class Object))
- (|> (host.array (Class Object) 2)
+ (Array (java/lang/Class java/lang/Object))
+ (|> (host.array (java/lang/Class java/lang/Object) 2)
(host.array-write 0 _object-class)
(host.array-write 1 _object-class)))
-(def: #export (expand name macro inputs)
- (-> Name Macro (List Code) (Meta (List Code)))
+(type: #export Expander
+ (-> Macro (List Code) Lux (Error (Error [Lux (List Code)]))))
+
+(def: #export (jvm macro inputs lux)
+ Expander
+ (do error.monad
+ [apply-method (|> macro
+ (:coerce java/lang/Object)
+ (java/lang/Object::getClass)
+ (java/lang/Class::getMethod "apply" _apply-args))]
+ (:coerce (Error (Error [Lux (List Code)]))
+ (java/lang/reflect/Method::invoke
+ (:coerce java/lang/Object macro)
+ (|> (host.array java/lang/Object 2)
+ (host.array-write 0 (:coerce java/lang/Object inputs))
+ (host.array-write 1 (:coerce java/lang/Object lux)))
+ apply-method))))
+
+(def: #export (expand expander name macro inputs)
+ (-> Expander Name Macro (List Code) (Meta (List Code)))
(function (_ state)
(do error.monad
- [apply-method (|> macro
- (:coerce Object)
- (Object::getClass)
- (Class::getMethod "apply" _apply-args))
- output (Method::invoke (:coerce Object macro)
- (|> (host.array Object 2)
- (host.array-write 0 (:coerce Object inputs))
- (host.array-write 1 (:coerce Object state)))
- apply-method)]
- (case (:coerce (Error [Lux (List Code)])
- output)
+ [output (expander macro inputs state)]
+ (case output
(#error.Success output)
(#error.Success output)
(#error.Failure error)
((///.throw expansion-failed [name inputs error]) state)))))
-(def: #export (expand-one name macro inputs)
- (-> Name Macro (List Code) (Meta Code))
+(def: #export (expand-one expander name macro inputs)
+ (-> Expander Name Macro (List Code) (Meta Code))
(do macro.monad
- [expansion (expand name macro inputs)]
+ [expansion (expand expander name macro inputs)]
(case expansion
(^ (list single))
(wrap single)
diff --git a/stdlib/source/lux/tool/compiler/phase/statement/total.lux b/stdlib/source/lux/tool/compiler/phase/statement/total.lux
index 542be5408..da2cc387c 100644
--- a/stdlib/source/lux/tool/compiler/phase/statement/total.lux
+++ b/stdlib/source/lux/tool/compiler/phase/statement/total.lux
@@ -12,45 +12,47 @@
["." analysis
["." expression]
["." type]
- ["///." macro]]
+ ["///." macro (#+ Expander)]]
["." extension]]])
(exception: #export (not-a-statement {code Code})
(ex.report ["Statement" (%code code)]))
-(exception: #export (not-a-macro {code Code})
+(exception: #export (not-a-macro-call {code Code})
(ex.report ["Code" (%code code)]))
(exception: #export (macro-was-not-found {name Name})
(ex.report ["Name" (%name name)]))
-(def: #export (phase code)
- Phase
- (case code
- (^ [_ (#.Form (list& [_ (#.Text name)] inputs))])
- (extension.apply phase [name inputs])
+(def: #export (phase expander)
+ (-> Expander Phase)
+ (let [analyze (expression.phase expander)]
+ (function (compile code)
+ (case code
+ (^ [_ (#.Form (list& [_ (#.Text name)] inputs))])
+ (extension.apply compile [name inputs])
- (^ [_ (#.Form (list& macro inputs))])
- (do ///.monad
- [expansion (//.lift-analysis
- (do @
- [macroA (type.with-type Macro
- (expression.compile macro))]
- (case macroA
- (^ (analysis.constant macro-name))
+ (^ [_ (#.Form (list& macro inputs))])
+ (do ///.monad
+ [expansion (//.lift-analysis
(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 macro-name macro inputs)))
-
- _
- (///.throw not-a-macro code))))]
- (monad.map @ phase expansion))
+ [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 not-a-macro-call code))))]
+ (monad.map @ compile expansion))
- _
- (///.throw not-a-statement code)))
+ _
+ (///.throw not-a-statement code)))))