Macros

src/kiss/Kiss.hx

@@ -7,12 +7,15 @@ import kiss.Reader;
 import kiss.FieldForms;
 import kiss.SpecialForms;
 import kiss.Macros;
+import kiss.Types;
 
 typedef KissState = {
+    className:String,
     readTable:Map<String, ReadFunction>,
     fieldForms:Map<String, FieldFormFunction>,
     specialForms:Map<String, SpecialFormFunction>,
-    macros:Map<String, MacroFunction>
+    macros:Map<String, MacroFunction>,
+    convert:ExprConversion
 };
 
 class Kiss {
@@ -21,15 +24,19 @@ class Kiss {
     **/
     macro static public function build(kissFile:String):Array<Field> {
         var classFields = Context.getBuildFields();
+        var className = Context.getLocalClass().get().name;
 
         var stream = new Stream(kissFile);
 
         var k = {
+            className: className,
             readTable: Reader.builtins(),
             fieldForms: FieldForms.builtins(),
             specialForms: SpecialForms.builtins(),
-            macros: Macros.builtins()
-        };
+            macros: Macros.builtins(),
+            convert: null
+        }
+        k.convert = readerExpToHaxeExpr.bind(_, k);
 
         while (true) {
             stream.dropWhitespace();
@@ -55,7 +62,12 @@ class Kiss {
     static function readerExpToField(exp:ReaderExp, position:String, k:KissState):Field {
         var fieldForms = k.fieldForms;
 
+        // Macros at top-level are allowed if they expand into a fieldform, or don't become an expression, like defmacro
+        var macros = k.macros;
+
         return switch (exp) {
+            case CallExp(Symbol(mac), args) if (macros.exists(mac)):
+                readerExpToField(macros[mac](args, k), position, k);
             case CallExp(Symbol(formName), args) if (fieldForms.exists(formName)):
                 fieldForms[formName](position, args, readerExpToHaxeExpr.bind(_, k));
             default:
@@ -77,7 +89,7 @@ class Kiss {
                     expr: EConst(CString(s))
                 };
             case CallExp(Symbol(mac), args) if (macros.exists(mac)):
-                convert(macros[mac](args));
+                convert(macros[mac](args, k));
             case CallExp(Symbol(specialForm), args) if (specialForms.exists(specialForm)):
                 specialForms[specialForm](args, convert);
             case CallExp(func, body):

src/kiss/Macros.hx

@@ -1,9 +1,14 @@
 package kiss;
 
+import haxe.macro.Expr;
+import haxe.macro.Context;
 import kiss.Reader;
+import kiss.Kiss;
 
-// Macros generate Kiss new reader from the arguments of their call expression.
-typedef MacroFunction = (Array<ReaderExp>) -> ReaderExp;
+using kiss.Helpers;
+
+// Macros generate new Kiss reader expressions from the arguments of their call expression.
+typedef MacroFunction = (Array<ReaderExp>, KissState) -> ReaderExp;
 
 class Macros {
     public static function builtins() {
@@ -17,14 +22,14 @@ class Macros {
 
         macros["/"] = foldMacro("Prelude.divide");
 
-        macros["%"] = (exps:Array<ReaderExp>) -> {
+        macros["%"] = (exps:Array<ReaderExp>, k) -> {
             if (exps.length != 2) {
                 throw 'Got ${exps.length} arguments for % instead of 2.';
             }
             CallExp(Symbol("Prelude.mod"), [exps[1], exps[0]]);
         };
 
-        macros["^"] = (exps:Array<ReaderExp>) -> {
+        macros["^"] = (exps:Array<ReaderExp>, k) -> {
             if (exps.length != 2) {
                 throw 'Got ${exps.length} arguments for ^ instead of 2.';
             }
@@ -41,11 +46,35 @@ class Macros {
 
         macros["_eq"] = foldMacro("Prelude.areEqual");
 
+        // TODO when
+
+        // Under the hood, (defmacro ...) defines a runtime function that accepts Quote arguments and a special form that quotes the arguments to macro calls
+        macros["defmacro"] = (exps:Array<ReaderExp>, k:KissState) -> {
+            if (exps.length < 3)
+                throw '${exps.length} is not enough arguments for (defmacro [name] [args] [body])';
+            var macroName = switch (exps[0]) {
+                case Symbol(name): name;
+                default: throw 'first argument ${exps[0]} for defmacro should be a symbol for the macro name';
+            };
+            k.specialForms[macroName] = (callArgs:Array<ReaderExp>, convert) -> {
+                ECall(Context.parse('${k.className}.${macroName}', Context.currentPos()), [
+                    for (callArg in callArgs)
+                        EFunction(FArrow, {
+                            args: [],
+                            ret: null,
+                            expr: EReturn(k.convert(callArg)).withPos()
+                        }).withPos()
+                ]).withPos();
+            };
+
+            CallExp(Symbol("defun"), exps);
+        }
+
         return macros;
     }
 
     static function foldMacro(func:String):MacroFunction {
-        return (exps) -> {
+        return (exps, k) -> {
             CallExp(Symbol("Lambda.fold"), [ListExp(exps.slice(1)), Symbol(func), exps[0]]);
         };
     }

src/kiss/Quote.hx

@@ -0,0 +1,19 @@
+package kiss;
+
+/** Under the hood, a quoted expression is just a zero-argument lambda that returns the value. **/
+// TODO this type isn't actually used for anything yet, but may come in handy
+abstract Quote<T>(Void->T) from Void->T to Void->T {
+    public inline function new(unquote:Void->T) {
+        this = unquote;
+    }
+
+    @:from
+    public static function fromLambda<T>(unquote:Void->T) {
+        return new Quote(unquote);
+    }
+
+    @:to
+    public function toLambda<T>() {
+        return this;
+    }
+}

src/kiss/Reader.hx

@@ -30,7 +30,9 @@ class Reader {
             stream.dropUntil("\n");
             null;
         };
-        readTable["#|"] = (stream) -> RawHaxe(stream.expect("closing |", () -> stream.takeUntilAndDrop("|#")));
+        readTable["#|"] = (stream) -> RawHaxe(stream.expect("closing |#", () -> stream.takeUntilAndDrop("|#")));
+        // Unquote is syntactic sugar for calling a Quote (Void->T)
+        readTable[","] = (stream) -> CallExp(assertRead(stream, readTable), []);
 
         return readTable;
     }

src/test/cases/BasicTestCase.hx

@@ -118,4 +118,13 @@ class BasicTestCase extends Test {
         Assert.equals(true, BasicTestCase.myIf7);
         Assert.equals(false, BasicTestCase.myIf8);
     }
+
+    function testMacros() {
+        Assert.equals(7, BasicTestCase.incrementTwice(5));
+
+        var seasonsGreetings = "ho ";
+        Assert.equals("ho ho ho ", BasicTestCase.doTwiceString(() -> {
+            seasonsGreetings += "ho ";
+        }));
+    }
 }

src/test/cases/BasicTestCase.kiss

@@ -61,4 +61,16 @@
 (defvar myIf5 (if true true false))
 (defvar myIf6 (if false true false))
 (defvar myIf7 (if "string" true false))
-(defvar myIf8 (if "" true false))
+(defvar myIf8 (if "" true false))
+
+(defmacro doTwiceInt [intOp]
+    ,intOp
+    ,intOp)
+
+// I think this causes doTwiceInt's runtime function to be typed as requiring Quote<Int> and returning Int
+(defun incrementTwice [val]
+    (doTwiceInt ++val))
+
+(defmacro doTwiceString [stringOp]
+    ,stringOp
+    ,stringOp)