From d209868eb6c9528275304d8e1068b2d3f0ca8b2d Mon Sep 17 00:00:00 2001 From: Nat Quayle Nelson Date: Sat, 14 Nov 2020 13:56:47 -0700 Subject: [PATCH] Lisp macro back-end w/ +, - as examples --- src/kiss/FieldForms.hx | 4 ++-- src/kiss/Kiss.hx | 30 ++++++++++++++++++------------ src/kiss/Macros.hx | 22 ++++++++++++++++++++++ src/kiss/Prelude.hx | 11 +++++++++++ src/kiss/Reader.hx | 12 ++++++------ src/test/cases/BasicTestCase.hx | 9 +++++++++ src/test/cases/BasicTestCase.kiss | 7 ++++++- 7 files changed, 74 insertions(+), 21 deletions(-) create mode 100644 src/kiss/Macros.hx create mode 100644 src/kiss/Prelude.hx diff --git a/src/kiss/FieldForms.hx b/src/kiss/FieldForms.hx index f5e3f8b1..ce228dd8 100644 --- a/src/kiss/FieldForms.hx +++ b/src/kiss/FieldForms.hx @@ -71,7 +71,7 @@ class FieldForms { access: access, kind: FFun({ args: switch (args[1]) { - case List(funcArgs): + case ListExp(funcArgs): [ for (funcArg in funcArgs) { @@ -90,7 +90,7 @@ class FieldForms { ret: null, expr: { pos: Context.currentPos(), - expr: EReturn(convert(Call(Symbol("begin"), args.slice(2)))) + expr: EReturn(convert(CallExp(Symbol("begin"), args.slice(2)))) } }), pos: Context.currentPos() diff --git a/src/kiss/Kiss.hx b/src/kiss/Kiss.hx index 5c05f29c..d5df5e33 100644 --- a/src/kiss/Kiss.hx +++ b/src/kiss/Kiss.hx @@ -6,6 +6,7 @@ import kiss.Stream; import kiss.Reader; import kiss.FieldForms; import kiss.SpecialForms; +import kiss.Macros; class Kiss { /** @@ -19,6 +20,7 @@ class Kiss { var readTable = Reader.builtins(); var fieldForms = FieldForms.builtins(); var specialForms = SpecialForms.builtins(); + var macros = Macros.builtins(); while (true) { stream.dropWhitespace(); @@ -32,7 +34,7 @@ class Kiss { // The last expression might be a comment, in which case None will be returned switch (nextExp) { case Some(nextExp): - classFields.push(readerExpToField(nextExp, position, fieldForms, specialForms)); + classFields.push(readerExpToField(nextExp, position, fieldForms, macros, specialForms)); case None: stream.dropWhitespace(); // If there was a comment, drop whitespace that comes after } @@ -41,33 +43,37 @@ class Kiss { return classFields; } - static function readerExpToField(exp:ReaderExp, position:String, fieldForms:Map, + static function readerExpToField(exp:ReaderExp, position:String, fieldForms:Map, macros:Map, specialForms:Map):Field { return switch (exp) { - case Call(Symbol(formName), args) if (fieldForms.exists(formName)): - fieldForms[formName](position, args, readerExpToHaxeExpr.bind(_, specialForms)); + case CallExp(Symbol(formName), args) if (fieldForms.exists(formName)): + fieldForms[formName](position, args, readerExpToHaxeExpr.bind(_, macros, specialForms)); default: throw '$exp at $position is not a valid field form'; }; } - static function readerExpToHaxeExpr(exp:ReaderExp, specialForms:Map):Expr { + static function readerExpToHaxeExpr(exp:ReaderExp, macros:Map, specialForms:Map):Expr { + // Bind the table arguments of this function for easy recursive calling/passing + var convert = readerExpToHaxeExpr.bind(_, macros, specialForms); var expr = switch (exp) { case Symbol(name): Context.parse(name, Context.currentPos()); - case Str(s): + case StrExp(s): { pos: Context.currentPos(), expr: EConst(CString(s)) }; - case Call(Symbol(specialForm), args) if (specialForms.exists(specialForm)): - specialForms[specialForm](args, readerExpToHaxeExpr.bind(_, specialForms)); - case Call(func, body): + case CallExp(Symbol(mac), args) if (macros.exists(mac)): + convert(macros[mac](args)); + case CallExp(Symbol(specialForm), args) if (specialForms.exists(specialForm)): + specialForms[specialForm](args, convert); + case CallExp(func, body): { pos: Context.currentPos(), - expr: ECall(readerExpToHaxeExpr(func, specialForms), [for (bodyExp in body) readerExpToHaxeExpr(bodyExp, specialForms)]) + expr: ECall(readerExpToHaxeExpr(func, macros, specialForms), [for (bodyExp in body) readerExpToHaxeExpr(bodyExp, macros, specialForms)]) }; - case List(elements): + case ListExp(elements): { pos: Context.currentPos(), expr: ENew({ @@ -76,7 +82,7 @@ class Kiss { }, [ { pos: Context.currentPos(), - expr: EArrayDecl([for (elementExp in elements) readerExpToHaxeExpr(elementExp, specialForms)]) + expr: EArrayDecl([for (elementExp in elements) convert(elementExp)]) } ]) } diff --git a/src/kiss/Macros.hx b/src/kiss/Macros.hx new file mode 100644 index 00000000..8f729001 --- /dev/null +++ b/src/kiss/Macros.hx @@ -0,0 +1,22 @@ +package kiss; + +import kiss.Reader; + +// Macros generate Kiss new reader from the arguments of their call expression. +typedef MacroFunction = (Array) -> ReaderExp; + +class Macros { + public static function builtins() { + var macros:Map = []; + + macros["+"] = (exps) -> { + CallExp(Symbol("Lambda.fold"), [ListExp(exps), Symbol("Prelude.add"), Symbol("0")]); + }; + + macros["-"] = (exps:Array) -> { + CallExp(Symbol("Lambda.fold"), [ListExp(exps.slice(1)), Symbol("Prelude.subtract"), exps[0]]); + } + + return macros; + } +} diff --git a/src/kiss/Prelude.hx b/src/kiss/Prelude.hx new file mode 100644 index 00000000..da888ecf --- /dev/null +++ b/src/kiss/Prelude.hx @@ -0,0 +1,11 @@ +package kiss; + +class Prelude { + public static function add(a, b) { + return a + b; + } + + public static function subtract(val, from) { + return from - val; + } +} diff --git a/src/kiss/Reader.hx b/src/kiss/Reader.hx index 49010f04..d1f643ec 100644 --- a/src/kiss/Reader.hx +++ b/src/kiss/Reader.hx @@ -4,9 +4,9 @@ import haxe.ds.Option; import kiss.Stream; enum ReaderExp { - Call(func:ReaderExp, args:Array); // (f a1 a2...) - List(exps:Array); // [v1 v2 v3] - Str(s:String); // "literal" + CallExp(func:ReaderExp, args:Array); // (f a1 a2...) + ListExp(exps:Array); // [v1 v2 v3] + StrExp(s:String); // "literal" Symbol(name:String); // s RawHaxe(code:String); } @@ -18,9 +18,9 @@ class Reader { public static function builtins() { var readTable:Map = []; - readTable["("] = (stream) -> Call(assertRead(stream, readTable), readExpArray(stream, ")", readTable)); - readTable["["] = (stream) -> List(readExpArray(stream, "]", readTable)); - readTable["\""] = (stream) -> Str(stream.expect("closing \"", () -> stream.takeUntilAndDrop("\""))); + readTable["("] = (stream) -> CallExp(assertRead(stream, readTable), readExpArray(stream, ")", readTable)); + readTable["["] = (stream) -> ListExp(readExpArray(stream, "]", readTable)); + readTable["\""] = (stream) -> StrExp(stream.expect("closing \"", () -> stream.takeUntilAndDrop("\""))); readTable["/*"] = (stream) -> { stream.dropUntil("*/"); stream.dropString("*/"); diff --git a/src/test/cases/BasicTestCase.hx b/src/test/cases/BasicTestCase.hx index 9b289766..74a9016e 100644 --- a/src/test/cases/BasicTestCase.hx +++ b/src/test/cases/BasicTestCase.hx @@ -2,6 +2,7 @@ package test.cases; import utest.Test; import utest.Assert; +import kiss.Prelude; @:build(kiss.Kiss.build("src/test/cases/BasicTestCase.kiss")) class BasicTestCase extends Test { @@ -41,4 +42,12 @@ class BasicTestCase extends Test { Assert.equals(2, arr[-2]); Assert.equals(1, arr[-3]); } + + function testVariadicAdd() { + Assert.equals(6, BasicTestCase.mySum); + } + + function testVariadicSubtract() { + Assert.equals(-2, BasicTestCase.myDifference); + } } diff --git a/src/test/cases/BasicTestCase.kiss b/src/test/cases/BasicTestCase.kiss index ced91f52..0263030d 100644 --- a/src/test/cases/BasicTestCase.kiss +++ b/src/test/cases/BasicTestCase.kiss @@ -19,4 +19,9 @@ (defmethod myMethod [] this.myField) // [...] returns a Kiss array (they have special features and convert implicitly) -(defvar myArray [1 2 3]) \ No newline at end of file +(defvar myArray [1 2 3]) + +// Variadic math uses haxe's Lambda.fold under the hood +(defvar mySum (+ 1 2 3)) + +(defvar myDifference (- 5 4 3)) \ No newline at end of file