Quasiquote reader macros

This commit is contained in:
2020-12-09 16:48:24 -07:00
parent cfaa6aec2f
commit 646f10f52b
7 changed files with 103 additions and 18 deletions

View File

@@ -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);
}
}

View File

@@ -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');
};

View File

@@ -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
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)));
Helpers.runAtCompileTime(body, k, [streamArgName => stream]);
};
default:
throw CompileError.fromExp(exps[1], 'second argument to defreadermacro should be [steamArgName]');

View File

@@ -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()}';
}
}
}

View File

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

View File

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