From 1e989ac79cfa8cdca347c0d8aea3a5aff82d596f Mon Sep 17 00:00:00 2001 From: Nat Quayle Nelson Date: Wed, 9 Dec 2020 16:48:24 -0700 Subject: [PATCH] Quasiquote reader macros --- build-scripts/common-test-args.hxml | 1 + src/kiss/Helpers.hx | 71 +++++++++++++++++++++++++ src/kiss/Kiss.hx | 7 +++ src/kiss/Macros.hx | 11 +--- src/kiss/Reader.hx | 4 ++ src/test/cases/ReaderMacroTestCase.hx | 9 ++-- src/test/cases/ReaderMacroTestCase.kiss | 18 +++++-- 7 files changed, 103 insertions(+), 18 deletions(-) diff --git a/build-scripts/common-test-args.hxml b/build-scripts/common-test-args.hxml index 8e7f39d..7b7df13 100644 --- a/build-scripts/common-test-args.hxml +++ b/build-scripts/common-test-args.hxml @@ -1,3 +1,4 @@ -lib utest -D test +-D hscriptPos --main test.TestMain \ No newline at end of file diff --git a/src/kiss/Helpers.hx b/src/kiss/Helpers.hx index e071336..f5fd135 100644 --- a/src/kiss/Helpers.hx +++ b/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):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, k:KissState, ?args:Map):Array { + var idx = 0; + while (idx < l.length) { + switch (l[idx].def) { + case UnquoteList(exp): + l.splice(idx, 1); + var newElements:Array = 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):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); + } } diff --git a/src/kiss/Kiss.hx b/src/kiss/Kiss.hx index b835d17..4a8bab1 100644 --- a/src/kiss/Kiss.hx +++ b/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'); }; diff --git a/src/kiss/Macros.hx b/src/kiss/Macros.hx index 81a674b..5b7fc56 100644 --- a/src/kiss/Macros.hx +++ b/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 - 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]'); diff --git a/src/kiss/Reader.hx b/src/kiss/Reader.hx index 6d77f1f..124b78b 100644 --- a/src/kiss/Reader.hx +++ b/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; @@ -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()}'; } } } diff --git a/src/test/cases/ReaderMacroTestCase.hx b/src/test/cases/ReaderMacroTestCase.hx index 8c92679..19744dd 100644 --- a/src/test/cases/ReaderMacroTestCase.hx +++ b/src/test/cases/ReaderMacroTestCase.hx @@ -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(); } } diff --git a/src/test/cases/ReaderMacroTestCase.kiss b/src/test/cases/ReaderMacroTestCase.kiss index 8358621..fc77445 100644 --- a/src/test/cases/ReaderMacroTestCase.kiss +++ b/src/test/cases/ReaderMacroTestCase.kiss @@ -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) \ No newline at end of file +(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)) \ No newline at end of file