aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/interp.c1
-rw-r--r--src/interp.h1
-rw-r--r--src/parser.c7
-rw-r--r--src/primitives.c61
-rw-r--r--src/primitives.h1
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