From 5a77d393bef044d3434cfbe4ae21a0240822f8f0 Mon Sep 17 00:00:00 2001 From: Nat Quayle Nelson Date: Sun, 15 Nov 2020 12:47:06 -0700 Subject: [PATCH] Macros --- src/kiss/Kiss.hx | 20 ++++++++++++---- src/kiss/Macros.hx | 39 +++++++++++++++++++++++++++---- src/kiss/Quote.hx | 19 +++++++++++++++ src/kiss/Reader.hx | 4 +++- src/test/cases/BasicTestCase.hx | 9 +++++++ src/test/cases/BasicTestCase.kiss | 14 ++++++++++- 6 files changed, 94 insertions(+), 11 deletions(-) create mode 100644 src/kiss/Quote.hx diff --git a/src/kiss/Kiss.hx b/src/kiss/Kiss.hx index db6ed6e7..9d747ed7 100644 --- a/src/kiss/Kiss.hx +++ b/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, fieldForms:Map, specialForms:Map, - macros:Map + macros:Map, + convert:ExprConversion }; class Kiss { @@ -21,15 +24,19 @@ class Kiss { **/ macro static public function build(kissFile:String):Array { 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): diff --git a/src/kiss/Macros.hx b/src/kiss/Macros.hx index 2a7fc881..b6003e35 100644 --- a/src/kiss/Macros.hx +++ b/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; +using kiss.Helpers; + +// Macros generate new Kiss reader expressions from the arguments of their call expression. +typedef MacroFunction = (Array, KissState) -> ReaderExp; class Macros { public static function builtins() { @@ -17,14 +22,14 @@ class Macros { macros["/"] = foldMacro("Prelude.divide"); - macros["%"] = (exps:Array) -> { + macros["%"] = (exps:Array, 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) -> { + macros["^"] = (exps:Array, 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, 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, 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]]); }; } diff --git a/src/kiss/Quote.hx b/src/kiss/Quote.hx new file mode 100644 index 00000000..88e2b300 --- /dev/null +++ b/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(Void->T) from Void->T to Void->T { + public inline function new(unquote:Void->T) { + this = unquote; + } + + @:from + public static function fromLambda(unquote:Void->T) { + return new Quote(unquote); + } + + @:to + public function toLambda() { + return this; + } +} diff --git a/src/kiss/Reader.hx b/src/kiss/Reader.hx index b1caf6db..cc985929 100644 --- a/src/kiss/Reader.hx +++ b/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; } diff --git a/src/test/cases/BasicTestCase.hx b/src/test/cases/BasicTestCase.hx index ab5cd846..679eb324 100644 --- a/src/test/cases/BasicTestCase.hx +++ b/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 "; + })); + } } diff --git a/src/test/cases/BasicTestCase.kiss b/src/test/cases/BasicTestCase.kiss index 50357e9e..6d5f482a 100644 --- a/src/test/cases/BasicTestCase.kiss +++ b/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)) \ No newline at end of file +(defvar myIf8 (if "" true false)) + +(defmacro doTwiceInt [intOp] + ,intOp + ,intOp) + +// I think this causes doTwiceInt's runtime function to be typed as requiring Quote and returning Int +(defun incrementTwice [val] + (doTwiceInt ++val)) + +(defmacro doTwiceString [stringOp] + ,stringOp + ,stringOp) \ No newline at end of file