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]))))