quasiquote

5 files changed, 69 insertions, 2 deletions

diff --git a/src/interp.c b/src/interp.c
index f03a688..e5e9167 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -55,6 +55,7 @@ void Interp_init(Interp *self) {
     Interp_add_primitive(self, "funcall", primitive_funcall);
     Interp_add_primitive(self, "apply", primitive_apply);
     Interp_add_primitive(self, "quote", primitive_quote);
+    Interp_add_primitive(self, "quasiquote", primitive_quasi);
 
     Interp_add_userfunc(self, "eval", lisp_eval);
     Interp_add_userfunc(self, "show", builtin_show);
diff --git a/src/interp.h b/src/interp.h
index ae4c451..1eaa920 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -60,6 +60,7 @@ void Interp_add_userfunc(Interp *self, const char *name, LispUserFunc fn);
 #define PUSH_REG(_x) { interp->reg = CONS((_x), interp->reg); }
 #define POP_REG() { interp->reg = CDR(interp->reg);  }
 
+SExpRef lisp_reverse(Interp *interp, SExpRef lst);
 void lisp_defun(Interp *interp, const char *name, SExpRef val);
 void lisp_defvar(Interp *interp, const char *name, SExpRef val);
 void lisp_print(Interp *interp, SExpRef obj, FILE *fp);
diff --git a/src/parser.c b/src/parser.c
index 45aeba6..cc41d76 100644
--- a/src/parser.c
+++ b/src/parser.c
@@ -349,7 +349,8 @@ ParseResult parse_string(Parser *parser) {
     Parser_getchar(parser);
     while (Parser_peek(parser) != '"') {
         if (Parser_peek(parser) == EOF) {
-            return ParseErr(parser, "Unexpected EOF.\n");
+            ret = ParseErr(parser, "Unexpected EOF.\n");
+            goto end;
         }
         if (Parser_peek(parser) == '\0') {
             ret = ParseErr(parser, "Unexpected zero terminator.\n");
@@ -360,7 +361,8 @@ ParseResult parse_string(Parser *parser) {
         } else {
             Parser_getchar(parser);
             if (Parser_peek(parser) == EOF) {
-                return ParseErr(parser, "Unexpected EOF.\n");
+                ret = ParseErr(parser, "Unexpected EOF.\n");
+                goto end;
             }
             int c = Parser_getchar(parser);
             if (c == EOF) {
@@ -377,6 +379,7 @@ ParseResult parse_string(Parser *parser) {
             }
         }
     }
+    Parser_getchar(parser);
     CharVector_push_back(&buf, '\0');
     ret = ParseOk(new_string(parser->ctx, buf.buffer));
 end:
diff --git a/src/primitives.c b/src/primitives.c
index 2a28677..8290a01 100644
--- a/src/primitives.c
+++ b/src/primitives.c
@@ -241,6 +241,67 @@ error:
     return new_error(interp, "apply: syntax error.\n");
 }
 
+static SExpRef quasi_on_list(Interp *interp, SExpRef lst);
+static SExpRef quasi_impl(Interp *interp, SExpRef obj, bool *slicing);
+
+static SExpRef quasi_impl(Interp *interp, SExpRef obj, bool *slicing) {
+    *slicing = false;
+    if (VALTYPE(obj) != kPairSExp) return obj;
+    if (VALTYPE(CAR(obj)) == kSymbolSExp
+            && strcmp("unquote", REF(CAR(obj))->str) == 0) {
+        if (lisp_length(interp, obj) != 2) {
+            return new_error(interp, "unquote: syntax error.\n");
+        }
+        return EVAL(CADR(obj));
+    }
+    if (VALTYPE(CAR(obj)) == kSymbolSExp
+            && strcmp("slicing-unquote", REF(CAR(obj))->str) == 0) {
+        SExpRef lst = EVAL(CADR(obj));
+        if (ERRORP(lst)) return lst;
+        if (lisp_length(interp, obj) != 2) {
+            return new_error(interp, "slicing-unquote: syntax error.\n");
+        }
+        if (!lisp_check_list(interp, lst)) {
+            return new_error(interp, "slicing-unquote: not a list.\n");
+        }
+        *slicing = true;
+        return lst;
+    }
+    return quasi_on_list(interp, obj);
+}
+
+static SExpRef quasi_on_list(Interp *interp, SExpRef lst) {
+    SExpRef newlst = NIL;
+    bool slicing;
+    SExpRef iter = lst;
+    while (!NILP(iter)) {
+        SExpRef x = CAR(iter);
+        SExpRef newx = quasi_impl(interp, x, &slicing);
+        if (ERRORP(newx)) return newx;
+        if (slicing) {
+            SExpRef j = newx;
+            while (!NILP(j)) {
+                newlst = CONS(CAR(j), newlst);
+                j = CDR(j);
+            }
+        } else {
+            newlst = CONS(newx, newlst);
+        }
+        iter = CDR(iter);
+    }
+
+    return lisp_reverse(interp, newlst);
+}
+
+
+SExpRef primitive_quasi(Interp *interp, SExpRef args) {
+    if (lisp_length(interp, args) != 1) return new_error(interp, "quasiquote: syntax error.\n");
+    bool slicing;
+    SExpRef ret = quasi_impl(interp, CAR(args), &slicing);
+    if (slicing) return new_error(interp, "quasiquote: syntax error.\n");
+    return ret;
+}
+
 // TODO:
 // - defmacro
 // - macroexpand-1
diff --git a/src/primitives.h b/src/primitives.h
index 010c479..4f481af 100644
--- a/src/primitives.h
+++ b/src/primitives.h
@@ -16,5 +16,6 @@ SExpRef primitive_function(Interp *interp, SExpRef sexp);
 SExpRef primitive_funcall(Interp *interp, SExpRef sexp);
 SExpRef primitive_apply(Interp *interp, SExpRef sexp);
 SExpRef primitive_quote(Interp *interp, SExpRef sexp);
+SExpRef primitive_quasi(Interp *interp, SExpRef sexp);
 
 #endif