Lisp macro back-end w/ +, - as examples

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()

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<String, FieldFormFunction>,
+	static function readerExpToField(exp:ReaderExp, position:String, fieldForms:Map<String, FieldFormFunction>, macros:Map<String, MacroFunction>,
 			specialForms:Map<String, SpecialFormFunction>):Field {
 		return switch (exp) {
-			case Call(Symbol(formName), args) if (fieldForms.exists(formName)):
+			case CallExp(Symbol(formName), args) if (fieldForms.exists(formName)):
-				fieldForms[formName](position, args, readerExpToHaxeExpr.bind(_, specialForms));
+				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<String, SpecialFormFunction>):Expr {
+	static function readerExpToHaxeExpr(exp:ReaderExp, macros:Map<String, MacroFunction>, specialForms:Map<String, SpecialFormFunction>):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)):
+			case CallExp(Symbol(mac), args) if (macros.exists(mac)):
-				specialForms[specialForm](args, readerExpToHaxeExpr.bind(_, specialForms));
+				convert(macros[mac](args));
-			case Call(func, body):
+			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)])
 						}
 					])
 				}

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>) -> ReaderExp;
+
+class Macros {
+	public static function builtins() {
+		var macros:Map<String, MacroFunction> = [];
+
+		macros["+"] = (exps) -> {
+			CallExp(Symbol("Lambda.fold"), [ListExp(exps), Symbol("Prelude.add"), Symbol("0")]);
+		};
+
+		macros["-"] = (exps:Array<ReaderExp>) -> {
+			CallExp(Symbol("Lambda.fold"), [ListExp(exps.slice(1)), Symbol("Prelude.subtract"), exps[0]]);
+		}
+
+		return macros;
+	}
+}

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;
+	}
+}

src/kiss/Reader.hx

@@ -4,9 +4,9 @@ import haxe.ds.Option;
 import kiss.Stream;
 
 enum ReaderExp {
-	Call(func:ReaderExp, args:Array<ReaderExp>); // (f a1 a2...)
+	CallExp(func:ReaderExp, args:Array<ReaderExp>); // (f a1 a2...)
-	List(exps:Array<ReaderExp>); // [v1 v2 v3]
+	ListExp(exps:Array<ReaderExp>); // [v1 v2 v3]
-	Str(s:String); // "literal"
+	StrExp(s:String); // "literal"
 	Symbol(name:String); // s
 	RawHaxe(code:String);
 }
@@ -18,9 +18,9 @@ class Reader {
 	public static function builtins() {
 		var readTable:Map<String, ReadFunction> = [];
 
-		readTable["("] = (stream) -> Call(assertRead(stream, readTable), readExpArray(stream, ")", readTable));
+		readTable["("] = (stream) -> CallExp(assertRead(stream, readTable), readExpArray(stream, ")", readTable));
-		readTable["["] = (stream) -> List(readExpArray(stream, "]", readTable));
+		readTable["["] = (stream) -> ListExp(readExpArray(stream, "]", readTable));
-		readTable["\""] = (stream) -> Str(stream.expect("closing \"", () -> stream.takeUntilAndDrop("\"")));
+		readTable["\""] = (stream) -> StrExp(stream.expect("closing \"", () -> stream.takeUntilAndDrop("\"")));
 		readTable["/*"] = (stream) -> {
 			stream.dropUntil("*/");
 			stream.dropString("*/");

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

src/test/cases/BasicTestCase.kiss

@@ -20,3 +20,8 @@
 
 // [...] returns a Kiss array (they have special features and convert implicitly)
 (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))