diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase')
3 files changed, 79 insertions, 67 deletions
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))))) |