From e62a65fb57ed2783547ef41cbcef83b696ef028f Mon Sep 17 00:00:00 2001
From: Nat Quayle Nelson <natquaylenelson@gmail.com>
Date: Wed, 9 Dec 2020 13:36:50 -0700
Subject: [PATCH] Reader macros implemented in Kiss

---
 src/kiss/Macros.hx                      | 35 +++++++++++--------------
 src/kiss/Reader.hx                      |  9 +++++++
 src/kiss/SpecialForms.hx                |  2 +-
 src/test/cases/ReaderMacroTestCase.kiss |  4 ++-
 4 files changed, 29 insertions(+), 21 deletions(-)

diff --git a/src/kiss/Macros.hx b/src/kiss/Macros.hx
index 2976330..81a674b 100644
--- a/src/kiss/Macros.hx
+++ b/src/kiss/Macros.hx
@@ -9,8 +9,9 @@ import kiss.Reader;
 import kiss.Kiss;
 import kiss.CompileError;
 
-using kiss.Kiss;
+using tink.MacroApi;
 using uuid.Uuid;
+using kiss.Kiss;
 using kiss.Reader;
 using kiss.Helpers;
 
@@ -181,7 +182,7 @@ class Macros {
         };
 
         macros["defreadermacro"] = (wholeExp:ReaderExp, exps:Array<ReaderExp>, k:KissState) -> {
-            wholeExp.checkNumArgs(3, 3, '(defreadermacro ["[startingString]" or [startingStrings...]] [[streamArgName]] [RawHaxe])');
+            wholeExp.checkNumArgs(3, null, '(defreadermacro ["[startingString]" or [startingStrings...]] [[streamArgName]] [body...])');
 
             // reader macros can define a list of strings that will trigger the macro. When there are multiple,
             // the macro will put back the initiating string into the stream so you can check which one it was
@@ -205,23 +206,19 @@ class Macros {
             for (s in stringsThatMatch) {
                 switch (exps[1].def) {
                     case ListExp([{pos: _, def: Symbol(streamArgName)}]):
-                        // For now, reader macros only support a one-expression body implemented in #|raw haxe|# (which can contain a block).
-                        switch (exps[2].def) {
-                            case RawHaxe(code):
-                                k.readTable[s] = (stream) -> {
-                                    if (stringsThatMatch.length > 1) {
-                                        stream.putBackString(s);
-                                    }
-                                    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(parser.parseString(code));
-                                };
-                            default:
-                                throw CompileError.fromExp(exps[2], 'third argument to defreadermacro should be #|raw haxe|#');
-                        }
+                        k.readTable[s] = (stream) -> {
+                            if (stringsThatMatch.length > 1) {
+                                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)));
+                        };
                     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 a2e2771..6d77f1f 100644
--- a/src/kiss/Reader.hx
+++ b/src/kiss/Reader.hx
@@ -30,6 +30,8 @@ enum ReaderExpDef {
     MetaExp(meta:String, exp:ReaderExp); // &meta [exp]
     FieldExp(field:String, exp:ReaderExp); // .field [exp]
     KeyValueExp(key:ReaderExp, value:ReaderExp); // =>key value
+    Quasiquote(exp:ReaderExp); // `[exp]
+    Unquote(exp:ReaderExp); // ,[exp]
 }
 
 typedef ReadFunction = (Stream) -> Null<ReaderExpDef>;
@@ -78,6 +80,9 @@ class Reader {
             throw new UnmatchedBracketSignal("]", stream.position());
         };
 
+        readTable["`"] = (stream) -> Quasiquote(assertRead(stream, readTable));
+        readTable[","] = (stream) -> Unquote(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"));
 
@@ -223,6 +228,10 @@ class Reader {
                 '.$field ${exp.def.toString()}';
             case KeyValueExp(keyExp, valueExp):
                 '=>${keyExp.def.toString()} ${valueExp.def.toString()}';
+            case Quasiquote(exp):
+                '`${exp.def.toString()}';
+            case Unquote(exp):
+                ',${exp.def.toString()}';
         }
     }
 }
diff --git a/src/kiss/SpecialForms.hx b/src/kiss/SpecialForms.hx
index 6987dd3..3d6fae4 100644
--- a/src/kiss/SpecialForms.hx
+++ b/src/kiss/SpecialForms.hx
@@ -191,7 +191,7 @@ class SpecialForms {
 
         map["lambda"] = (wholeExp:ReaderExp, args:Array<ReaderExp>, k:KissState) -> {
             wholeExp.checkNumArgs(2, null, "(lambda [[argsNames...]] [body...])");
-            EFunction(FArrow, Helpers.makeFunction(null, args[0], args.slice(1), k)).withMacroPosOf(wholeExp);
+            EFunction(FAnonymous, Helpers.makeFunction(null, args[0], args.slice(1), k)).withMacroPosOf(wholeExp);
         };
 
         function forExpr(formName:String, wholeExp:ReaderExp, args:Array<ReaderExp>, k:KissState) {
diff --git a/src/test/cases/ReaderMacroTestCase.kiss b/src/test/cases/ReaderMacroTestCase.kiss
index 48d064c..8358621 100644
--- a/src/test/cases/ReaderMacroTestCase.kiss
+++ b/src/test/cases/ReaderMacroTestCase.kiss
@@ -1,4 +1,6 @@
-(defreadermacro "!" [stream] #|ReaderExp.StrExp(stream.expect("a string line", function () stream.takeLine()))|#)
+(defreadermacro "!" [stream] 
+    (let [line (stream.expect "a string line" (lambda [] (stream.takeLine)))]
+        (ReaderExp.StrExp line)))
 
 (defun myLine []
     !String that takes the rest of the line