diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase/analysis/macro.lux')
-rw-r--r-- | stdlib/source/lux/tool/compiler/phase/analysis/macro.lux | 79 |
1 files changed, 79 insertions, 0 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux b/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux new file mode 100644 index 000000000..18455b837 --- /dev/null +++ b/stdlib/source/lux/tool/compiler/phase/analysis/macro.lux @@ -0,0 +1,79 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)]] + [data + ["." error (#+ Error)] + ["." text + format] + [collection + [array (#+ Array)] + ["." list ("#/." functor)]]] + ["." macro] + ["." host (#+ import:)]] + ["." ///]) + +(exception: #export (expansion-failed {macro Name} {inputs (List Code)} {error Text}) + (ex.report ["Macro" (%name macro)] + ["Inputs" (|> inputs + (list/map (|>> %code (format text.new-line text.tab))) + (text.join-with ""))] + ["Error" error])) + +(exception: #export (must-have-single-expansion {macro Name} {inputs (List Code)}) + (ex.report ["Macro" (%name macro)] + ["Inputs" (|> inputs + (list/map (|>> %code (format text.new-line text.tab))) + (text.join-with ""))])) + +(import: java/lang/reflect/Method + (invoke [Object (Array Object)] #try Object)) + +(import: (java/lang/Class c) + (getMethod [String (Array (Class Object))] #try Method)) + +(import: java/lang/Object + (getClass [] (Class Object))) + +(def: _object-class + (Class Object) + (host.class-for Object)) + +(def: _apply-args + (Array (Class Object)) + (|> (host.array (Class 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))) + (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) + (#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)) + (do macro.monad + [expansion (expand name macro inputs)] + (case expansion + (^ (list single)) + (wrap single) + + _ + (///.throw must-have-single-expansion [name inputs])))) |