Quasiquote reader macros

build-scripts/common-test-args.hxml

@@ -1,3 +1,4 @@
 -lib utest
 -D test
+-D hscriptPos
 --main test.TestMain

src/kiss/Helpers.hx

@@ -3,11 +3,14 @@ package kiss;
 import haxe.macro.Expr;
 import haxe.macro.Context;
 import haxe.macro.PositionTools;
+import hscript.Parser;
+import hscript.Interp;
 import kiss.Reader;
 import kiss.CompileError;
 import kiss.Kiss;
 import kiss.SpecialForms;
 
+using tink.MacroApi;
 using kiss.Reader;
 using kiss.Helpers;
 using kiss.Kiss;
@@ -183,4 +186,72 @@ class Helpers {
             throw CompileError.fromExp(wholeExp, 'Too many arguments. Expected $expectedForm');
         }
     }
+
+    public static function runAtCompileTime(exp:ReaderExp, k:KissState, ?args:Map<String, Dynamic>):Dynamic {
+        var code = k.convert(exp).toString(); // tink_macro to the rescue
+        #if test
+        Prelude.print("Compile-time hscript: " + code);
+        #end
+        var parser = new Parser();
+        var interp = new Interp();
+        interp.variables.set("read", Reader.assertRead.bind(_, k.readTable));
+        interp.variables.set("readExpArray", Reader.readExpArray.bind(_, _, k.readTable));
+        interp.variables.set("ReaderExp", ReaderExpDef);
+        interp.variables.set("kiss", {
+            Reader: {
+                ReaderExpDef: ReaderExpDef
+            }
+        });
+        interp.variables.set("k", k);
+        interp.variables.set("args", args); // trippy
+        interp.variables.set("Helpers", Helpers);
+        interp.variables.set("Prelude", Prelude);
+        if (args != null) {
+            for (arg => value in args) {
+                interp.variables.set(arg, value);
+            }
+        }
+        var value = interp.execute(parser.parseString(code));
+        #if test
+        Prelude.print("Compile-time value: " + Std.string(value));
+        #end
+        return value;
+    }
+
+    static function evalUnquoteLists(l:Array<ReaderExp>, k:KissState, ?args:Map<String, Dynamic>):Array<ReaderExp> {
+        var idx = 0;
+        while (idx < l.length) {
+            switch (l[idx].def) {
+                case UnquoteList(exp):
+                    l.splice(idx, 1);
+                    var newElements:Array<ReaderExp> = runAtCompileTime(exp, k, args);
+                    for (el in newElements) {
+                        l.insert(idx++, el);
+                    }
+                default:
+                    idx++;
+            }
+        }
+        return l;
+    }
+
+    public static function evalUnquotes(exp:ReaderExp, k:KissState, ?args:Map<String, Dynamic>):ReaderExp {
+        var def = switch (exp.def) {
+            case Symbol(_) | StrExp(_) | RawHaxe(_):
+                exp.def;
+            case CallExp(func, callArgs):
+                CallExp(evalUnquotes(func, k, args), evalUnquoteLists(callArgs, k, args).map(evalUnquotes.bind(_, k, args)));
+            case ListExp(elements):
+                ListExp(evalUnquoteLists(elements, k, args).map(evalUnquotes.bind(_, k, args)));
+            case FieldExp(field, innerExp):
+                FieldExp(field, evalUnquotes(innerExp, k, args));
+            case KeyValueExp(keyExp, valueExp):
+                KeyValueExp(evalUnquotes(keyExp, k, args), evalUnquotes(valueExp, k, args));
+            case Unquote(exp):
+                runAtCompileTime(exp, k, args).def;
+            default:
+                throw CompileError.fromExp(exp, 'unquote evaluation not implemented');
+        };
+        return def.withPosOf(exp);
+    }
 }

src/kiss/Kiss.hx

@@ -90,6 +90,7 @@ class Kiss {
             Sys.exit(1);
             return null;
         } catch (err:Exception) {
+            trace(err.stack);
             throw err; // Re-throw haxe exceptions for precise stacks
         }
     }
@@ -159,6 +160,12 @@ class Kiss {
                 EField(convert(innerExp), field).withMacroPosOf(exp);
             case KeyValueExp(keyExp, valueExp):
                 EBinop(OpArrow, convert(keyExp), convert(valueExp)).withMacroPosOf(exp);
+            case Quasiquote(exp):
+                // TODO pass args here (including the recursive args value)
+                // This statement actually turns into an HScript expression before running
+                macro {
+                    Helpers.evalUnquotes($v{exp}, k, args).def;
+                };
             default:
                 throw CompileError.fromExp(exp, 'conversion not implemented');
         };

src/kiss/Macros.hx

@@ -2,14 +2,11 @@ package kiss;
 
 import haxe.macro.Expr;
 import haxe.macro.Context;
-import hscript.Parser;
-import hscript.Interp;
 import uuid.Uuid;
 import kiss.Reader;
 import kiss.Kiss;
 import kiss.CompileError;
 
-using tink.MacroApi;
 using uuid.Uuid;
 using kiss.Kiss;
 using kiss.Reader;
@@ -211,13 +208,7 @@ class Macros {
                                 stream.putBackString(s);
                             }
                             var body = CallExp(Symbol("begin").withPos(stream.position()), exps.slice(2)).withPos(stream.position());
-                            var code = k.convert(body).toString(); // tink_macro to the rescue
+                            Helpers.runAtCompileTime(body, k, [streamArgName => stream]);
-                            var parser = new Parser();
-                            var interp = new Interp();
-                            // TODO reader macros also need to access the readtable
-                            interp.variables.set("ReaderExp", ReaderExpDef);
-                            interp.variables.set(streamArgName, stream);
-                            interp.execute(Prelude.print(parser.parseString(code)));
                         };
                     default:
                         throw CompileError.fromExp(exps[1], 'second argument to defreadermacro should be [steamArgName]');

src/kiss/Reader.hx

@@ -32,6 +32,7 @@ enum ReaderExpDef {
     KeyValueExp(key:ReaderExp, value:ReaderExp); // =>key value
     Quasiquote(exp:ReaderExp); // `[exp]
     Unquote(exp:ReaderExp); // ,[exp]
+    UnquoteList(exp:ReaderExp); // ,@[exp]
 }
 
 typedef ReadFunction = (Stream) -> Null<ReaderExpDef>;
@@ -82,6 +83,7 @@ class Reader {
 
         readTable["`"] = (stream) -> Quasiquote(assertRead(stream, readTable));
         readTable[","] = (stream) -> Unquote(assertRead(stream, readTable));
+        readTable[",@"] = (stream) -> UnquoteList(assertRead(stream, readTable));
 
         // Because macro keys are sorted by length and peekChars(0) returns "", this will be used as the default reader macro:
         readTable[""] = (stream) -> Symbol(nextToken(stream, "a symbol name"));
@@ -232,6 +234,8 @@ class Reader {
                 '`${exp.def.toString()}';
             case Unquote(exp):
                 ',${exp.def.toString()}';
+            case UnquoteList(exp):
+                ',@${exp.def.toString()}';
         }
     }
 }

src/test/cases/ReaderMacroTestCase.hx

@@ -15,8 +15,11 @@ class ReaderMacroTestCase extends Test {
     }
 
     function testMultipleInitiators() {
-        Assert.equals("a", ReaderMacroTestCase.str1);
+        Assert.equals("b", ReaderMacroTestCase.str1);
-        Assert.equals("b", ReaderMacroTestCase.str2);
+        Assert.equals("c", ReaderMacroTestCase.str2);
-        Assert.equals("c", ReaderMacroTestCase.str3);
+    }
+
+    function testQuasiquoteMacro() {
+        _testQuasiquoteMacro();
     }
 }

src/test/cases/ReaderMacroTestCase.kiss

@@ -12,9 +12,17 @@
 
 (defvar mySum (pluppers fluffers buffers))
 
-// Read a b c directly as strings
+// Read b c directly as strings
-(defreadermacro ["a" "b" "c"] [stream] #|ReaderExp.StrExp(stream.expect("a, b, or c", function () stream.takeChars(1)))|#)
+(defreadermacro ["b" "c"] [stream] #|ReaderExp.StrExp(stream.expect("b, or c", function () stream.takeChars(1)))|#)
 
-(defvar str1 a)
+(defvar str1 b)
-(defvar str2 b)
+(defvar str2 c)
-(defvar str3 c)
+
+// rassert asserts the next expression without parens
+(defreadermacro "rassert" [stream] `(assert ,(read stream)))
+
+(defun _testQuasiquoteMacro []
+    rassert [5]
+    rassert b
+    rassert fluffers
+    (Assert.pass))