1 files changed, 58 insertions, 0 deletions
diff --git a/stdlib/source/lux/tool/compiler/phase/generation/extension.lux b/stdlib/source/lux/tool/compiler/phase/generation/extension.lux
new file mode 100644
index 000000000..681fd35f8
--- /dev/null
+++ b/stdlib/source/lux/tool/compiler/phase/generation/extension.lux
@@ -0,0 +1,58 @@
+(.module:
+  [lux #*
+   [control
+    ["." monad (#+ do)]]
+   [data
+    [collection
+     ["." list ("#@." functor)]]]
+   ["." macro (#+ with-gensyms)
+    ["." code]
+    ["s" syntax (#+ syntax:)]]]
+  ["." //
+   ["#/" //
+    ["#." extension]
+    [//
+     [synthesis (#+ Synthesis)]]]])
+
+(syntax: (Vector {size s.nat} elemT)
+  (wrap (list (` [(~+ (list.repeat size elemT))]))))
+
+(type: #export (Nullary of) (-> (Vector 0 of) of))
+(type: #export (Unary of)   (-> (Vector 1 of) of))
+(type: #export (Binary of)  (-> (Vector 2 of) of))
+(type: #export (Trinary of) (-> (Vector 3 of) of))
+(type: #export (Variadic of) (-> (List of) of))
+
+(syntax: (arity: {arity s.nat} {name s.local-identifier} type)
+  (with-gensyms [g!_ g!extension g!name g!phase g!inputs g!of g!anchor g!expression g!statement]
+    (do @
+      [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))]
+      (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension))
+                       (All [(~ g!anchor) (~ g!expression) (~ g!statement)]
+                         (-> ((~ type) (~ g!expression)) (//.Handler (~ g!anchor) (~ g!expression) (~ g!statement))))
+                       (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs))
+                         (case (~ g!inputs)
+                           (^ (list (~+ g!input+)))
+                           (do ///.monad
+                             [(~+ (|> g!input+
+                                      (list@map (function (_ g!input)
+                                                  (list g!input (` ((~ g!phase) (~ g!input))))))
+                                      list.concat))]
+                             ((~' wrap) ((~ g!extension) [(~+ g!input+)])))
+
+                           (~' _)
+                           (///.throw ///extension.incorrect-arity [(~ g!name) 1 (list.size (~ g!inputs))]))))))))))
+
+(arity: 0 nullary ..Nullary)
+(arity: 1 unary ..Unary)
+(arity: 2 binary ..Binary)
+(arity: 3 trinary ..Trinary)
+
+(def: #export (variadic extension)
+  (All [anchor expression statement]
+    (-> (Variadic expression) (//.Handler anchor expression statement)))
+  (function (_ extension-name)
+    (function (_ phase inputsS)
+      (do ///.monad
+        [inputsI (monad.map @ phase inputsS)]
+        (wrap (extension inputsI))))))