aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/builtins.c2
-rw-r--r--src/interp.c77
-rw-r--r--src/interp.h23
-rw-r--r--src/main.c10
-rw-r--r--src/prelude.c6
-rw-r--r--src/prelude.h7
-rw-r--r--src/prelude.lisp4
-rw-r--r--src/primitives.c114
-rw-r--r--src/primitives.h36
-rw-r--r--src/sexp.h13
10 files changed, 200 insertions, 92 deletions
diff --git a/src/builtins.c b/src/builtins.c
index 58873ef..f64083b 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -10,7 +10,7 @@ SExpRef builtin_car(Interp *interp, SExpRef args) {
if (LENGTH(args) != 1) {
return new_error(interp, "car: wrong argument number.\n");
}
- if (ERRORP(args)) return args;
+ if (CTL_FL(args)) return args;
return CAR(CAR(args));
}
diff --git a/src/interp.c b/src/interp.c
index 6f7871c..7579502 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -74,7 +74,6 @@ void Interp_init(Interp *self) {
Interp_add_primitive(self, "and", primitive_and);
Interp_add_primitive(self, "or", primitive_or);
- Interp_add_userfunc(self, "eval", lisp_eval);
Interp_add_userfunc(self, "show", builtin_show);
Interp_add_userfunc(self, "car", builtin_car);
Interp_add_userfunc(self, "list", builtin_list);
@@ -272,8 +271,14 @@ void lisp_to_string_impl(str_builder_t *sb, Int2IntHashTable *visited, Interp *i
str_builder_append(sb, "<BINDING>");
} else if (pe->type == kNilSExp) {
str_builder_append(sb, "()");
- } else if (pe->type == kErrSExp) {
+ } else if (pe->type == kErrSignal) {
str_builder_append(sb, "<ERROR>");
+ } else if (pe->type == kReturnSignal) {
+ str_builder_append(sb, "<RETURN>");
+ } else if (pe->type == kBreakSignal) {
+ str_builder_append(sb, "<BREAK>");
+ } else if (pe->type == kContinueSignal) {
+ str_builder_append(sb, "<CONTINUE>");
} else if (pe->type == kPairSExp) {
if (Int2IntHashTable_find(visited, val.idx) != NULL) {
str_builder_append(sb, "<%d>", val.idx);
@@ -315,7 +320,7 @@ const char* lisp_to_string(Interp *interp, SExpRef val) {
SExpRef lisp_macroexpand1(Interp *interp, SExpRef macro, SExpRef args) {
SExpRef fn = new_lambda(interp, REF(macro)->macro.args, REF(macro)->macro.body, interp->top_level);
PUSH_REG(fn);
- SExpRef ret = lisp_apply(interp, fn, args);
+ SExpRef ret = lisp_apply(interp, fn, args, false);
POP_REG();
return ret;
error:
@@ -434,7 +439,7 @@ SExpRef lisp_eval_args(Interp *interp, SExpRef args) {
PUSH_REG(ret);
evalres = EVAL(CAR(cur));
POP_REG();
- if (ERRORP(evalres)) {
+ if (CTL_FL(evalres)) {
ret = evalres;
goto end;
}
@@ -489,35 +494,44 @@ static SExpRef build_function_env(Interp *interp, SExpRef func, SExpRef args) {
return env;
}
-SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args) {
+SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args, bool istail) {
SExpRef exp, env, ret, iter;
-
+ if (istail) return new_tailcall(interp, fn, args);
if (VALTYPE(fn) == kFuncSExp) {
env = build_function_env(interp, fn, args);
- if (ERRORP(env)) return env;
+ if (CTL_FL(env)) return env;
interp->stack = CONS(env, interp->stack);
iter = REF(fn)->func.body;
while (!NILP(iter)) {
exp = CAR(iter);
- ret = EVAL(exp);
- if (ERRORP(exp)) goto end;
+ if (NILP(CDR(iter))) {
+ ret = lisp_eval(interp, exp, true);
+ goto end;
+ } else {
+ ret = EVAL(exp);
+ }
+ if (CTL_FL(exp)) goto end;
iter = CDR(iter);
}
- end:
- interp->stack = CDR(interp->stack);
- return ret;
} else if (VALTYPE(fn) == kUserFuncSExp) {
LispUserFunc fnptr = REF(fn)->userfunc;
ret = (*fnptr)(interp, args);
return ret;
}
+end:
+ if (VALTYPE(ret) == kBreakSignal || VALTYPE(ret) == kContinueSignal) {
+ ret = new_error(interp, "function call: unexpected control flow signal.\n");
+ }
+ if (VALTYPE(ret) == kReturnSignal) {
+ ret = REF(ret)->ret;
+ }
+ interp->stack = CDR(interp->stack);
+ return ret;
error:
return new_error(interp, "function call: syntax error.\n");
}
-
-
-SExpRef lisp_eval(Interp *interp, SExpRef sexp) {
+SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) {
SExpRef ret;
SExpType type;
PUSH_REG(sexp);
@@ -530,7 +544,10 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp) {
|| type == kStringSExp
|| type == kBooleanSExp
|| type == kCharSExp
- || type == kErrSExp
+ || type == kErrSignal
+ || type == kBreakSignal
+ || type == kContinueSignal
+ || type == kReturnSignal
|| type == kFuncSExp
|| type == kUserFuncSExp
|| type == kRealSExp) {
@@ -555,27 +572,35 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp) {
if (strcmp(symbol, PrimitiveEntryVector_ref(&interp->primitives, i)->name) == 0) {
LispPrimitive primitive_fn =
PrimitiveEntryVector_ref(&interp->primitives, i)->fn;
- ret = (*primitive_fn)(interp, CDR(sexp));
+ ret = (*primitive_fn)(interp, CDR(sexp), istail);
goto end;
}
}
SExpRef fn = lisp_lookup_func(interp, symbol);
- if (ERRORP(fn)) {
+ if (CTL_FL(fn)) {
ret = new_error(interp, "eval: \"%s\" is not a primitive, function, or macro.\n", symbol);
goto end;
}
if (VALTYPE(fn) == kFuncSExp || VALTYPE(fn) == kUserFuncSExp) {
SExpRef args = CDR(sexp);
- SExpRef funcallargs = CONS(fn, args);
+ SExpRef funcallargs;
+ tailcall:
+ funcallargs = CONS(fn, args);
PUSH_REG(funcallargs);
- ret = primitive_funcall(interp, funcallargs);
+ ret = primitive_funcall(interp, funcallargs, istail);
POP_REG();
+ if (VALTYPE(ret) == kTailcallSExp) {
+ fn = REF(ret)->tailcall.fn;
+ args = REF(ret)->tailcall.args;
+ istail = false;
+ goto tailcall;
+ }
goto end;
} else if (VALTYPE(fn) == kMacroSExp) {
SExpRef args = CDR(sexp);
SExpRef newast = lisp_macroexpand1(interp, fn, args);
PUSH_REG(newast);
- ret = EVAL(newast);
+ ret = lisp_eval(interp, newast, istail);
POP_REG();
goto end;
}
@@ -608,6 +633,14 @@ SExpRef new_env(Interp *interp) {
return ret;
}
+SExpRef new_tailcall(Interp *interp, SExpRef fn, SExpRef args) {
+ SExpRef ret = new_sexp(interp);
+ REF(ret)->type = kTailcallSExp;
+ REF(ret)->tailcall.fn = fn;
+ REF(ret)->tailcall.args= args;
+ return ret;
+}
+
SExpRef new_lambda(Interp *interp, SExpRef param, SExpRef body, SExpRef env) {
SExpRef ret = new_sexp(interp);
REF(ret)->type = kFuncSExp;
@@ -644,7 +677,7 @@ SExpRef new_error(Interp *interp, const char *format, ...) {
vsnprintf(interp->errmsg_buf, BUFSIZE, format, args);
va_end(args);
SExpRef ret = new_sexp(interp);
- REF(ret)->type = kErrSExp;
+ REF(ret)->type = kErrSignal;
REF(ret)->str = interp->errmsg_buf;
return ret;
}
diff --git a/src/interp.h b/src/interp.h
index 2daa29d..4e358eb 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -11,7 +11,7 @@
struct interp;
typedef struct interp Interp;
-typedef SExpRef (*LispPrimitive)(Interp *interp, SExpRef sexp);
+typedef SExpRef (*LispPrimitive)(Interp *interp, SExpRef sexp, bool istail);
typedef struct {
const char *name;
@@ -41,13 +41,23 @@ void Interp_gc(Interp *self, SExpRef tmp_root);
void Interp_add_primitive(Interp *self, const char *name, LispPrimitive fn);
void Interp_add_userfunc(Interp *self, const char *name, LispUserFunc fn);
-#define REF(_x) (Interp_ref(interp, (_x)))
+SExpRef Interp_eval_string(Interp *interp, const char * str);
+void Interp_load_file(Interp *interp, const char *filename);
+void Interp_eval_readline(Interp *interp);
+
+#define REF(_x) (&(interp->objs.buffer)[(_x).idx])
#define CONS(_x, _y) (lisp_cons(interp, (_x), (_y)))
#define NILP(_x) (lisp_nilp(interp, (_x)))
#define LENGTH(_x) (lisp_length(interp, (_x)))
-#define EVAL(_x) (lisp_eval(interp, (_x)))
+#define EVAL(_x) (lisp_eval(interp, (_x), false))
+#define EVALTAIL(_x) (lisp_eval(interp, (_x), true))
#define TRUEP(_x) (lisp_truep(interp, (_x)))
-#define ERRORP(_x) (REF((_x))->type == kErrSExp)
+// control flow
+#define CTL_FL(_x) \
+ (REF((_x))->type == kErrSignal \
+ || REF((_x))->type == kReturnSignal \
+ || REF((_x))->type == kBreakSignal \
+ || REF((_x))->type == kContinueSignal)
#define VALTYPE(_x) (REF((_x))->type)
#define NIL (interp->nil)
#define CAR(_x) (lisp_car(interp, (_x)))
@@ -70,7 +80,7 @@ void lisp_defvar(Interp *interp, const char *name, SExpRef val);
void lisp_print(Interp *interp, SExpRef obj, FILE *fp);
SExpRef lisp_lookup(Interp *interp, const char *name);
SExpRef lisp_lookup_func(Interp *interp, const char *name);
-SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args);
+SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args, bool istail);
SExpRef lisp_cons(Interp *interp, SExpRef a, SExpRef b);
SExpRef lisp_dup(Interp *interp, SExpRef arg);
bool lisp_nilp(Interp *interp, SExpRef arg);
@@ -80,7 +90,7 @@ SExpRef lisp_setq(Interp *interp, const char *name, SExpRef val);
int lisp_length(Interp *interp, SExpRef lst);
SExpRef lisp_car(Interp *interp, SExpRef arg);
SExpRef lisp_cdr(Interp *interp, SExpRef arg);
-SExpRef lisp_eval(Interp *interp, SExpRef arg);
+SExpRef lisp_eval(Interp *interp, SExpRef arg, bool istail);
SExpRef lisp_eval_args(Interp *interp, SExpRef args);
SExpRef lisp_add(Interp *interp, SExpRef args);
SExpRef lisp_sub(Interp *interp, SExpRef args);
@@ -100,6 +110,7 @@ SExpRef new_binding(Interp *ctx, SExpRef name, SExpRef val);
SExpRef new_userfunc(Interp *interp, LispUserFunc val);
SExpRef new_lambda(Interp *interp, SExpRef param, SExpRef body, SExpRef env);
SExpRef new_macro(Interp *interp, SExpRef param, SExpRef body);
+SExpRef new_tailcall(Interp *interp, SExpRef fn, SExpRef args);
SExpRef new_list1(Interp *ctx, SExpRef e1);
SExpRef new_list2(Interp *ctx, SExpRef e1, SExpRef e2);
SExpRef new_list3(Interp *ctx, SExpRef e1, SExpRef e2, SExpRef e3);
diff --git a/src/main.c b/src/main.c
index 6656296..d41809e 100644
--- a/src/main.c
+++ b/src/main.c
@@ -22,11 +22,17 @@ int main() {
continue;
}
- res = lisp_eval(&interp, parse_result.val);
- if (Interp_ref(&interp, res)->type == kErrSExp) {
+ res = lisp_eval(&interp, parse_result.val, false);
+ if (Interp_ref(&interp, res)->type == kErrSignal) {
fprintf(stderr, "Eval error: %s", Interp_ref(&interp, res)->str);
continue;
}
+ if (Interp_ref(&interp, res)->type == kBreakSignal
+ || Interp_ref(&interp, res)->type == kContinueSignal
+ || Interp_ref(&interp, res)->type == kReturnSignal) {
+ fprintf(stderr, "Eval error: unexpected control flow signal.\n");
+ continue;
+ }
lisp_print(&interp, res, stdout);
}
end:
diff --git a/src/prelude.c b/src/prelude.c
new file mode 100644
index 0000000..50fdbba
--- /dev/null
+++ b/src/prelude.c
@@ -0,0 +1,6 @@
+
+#include "prelude.h"
+
+const char *prelude = "(defvar nil \'())\n\n(defvar pi 3.1415926)\n\n";
+
+
diff --git a/src/prelude.h b/src/prelude.h
new file mode 100644
index 0000000..3acf146
--- /dev/null
+++ b/src/prelude.h
@@ -0,0 +1,7 @@
+#ifndef BAMBOO_LISP_PRELUDE_H_
+#define BAMBOO_LISP_PRELUDE_H_
+
+extern const char *bamboo_lisp_prelude;
+
+#endif
+
diff --git a/src/prelude.lisp b/src/prelude.lisp
new file mode 100644
index 0000000..6c48743
--- /dev/null
+++ b/src/prelude.lisp
@@ -0,0 +1,4 @@
+(defvar nil '())
+
+(defvar pi 3.1415926)
+
diff --git a/src/primitives.c b/src/primitives.c
index 6efa018..435080c 100644
--- a/src/primitives.c
+++ b/src/primitives.c
@@ -2,7 +2,7 @@
#include "interp.h"
#include "sexp.h"
-SExpRef primitive_if(Interp *interp, SExpRef args) {
+SExpRef primitive_if(Interp *interp, SExpRef args, bool istail) {
SExpRef cond, tb, fb;
if (LENGTH(args) != 3) goto error;
@@ -10,15 +10,14 @@ SExpRef primitive_if(Interp *interp, SExpRef args) {
tb = CADR(args);
fb = CADDR(args);
cond = EVAL(cond);
- if (ERRORP(cond)) return cond;
- if (TRUEP(cond)) return EVAL(tb);
- else return EVAL(fb);
- return NIL;
+ if (CTL_FL(cond)) return cond;
+ if (TRUEP(cond)) return lisp_eval(interp, tb, istail);
+ else return lisp_eval(interp, fb, istail);
error:
return new_error(interp, "if: syntax error.\n");
}
-SExpRef primitive_cond(Interp *interp, SExpRef args) {
+SExpRef primitive_cond(Interp *interp, SExpRef args, bool istail) {
SExpRef pair, condition, exp, iter;
if (LENGTH(args) < 1) goto error;
@@ -30,8 +29,8 @@ SExpRef primitive_cond(Interp *interp, SExpRef args) {
condition = CAR(pair);
exp = CADR(pair);
condition = EVAL(condition);
- if (ERRORP(condition)) return condition;
- if (TRUEP(condition)) return EVAL(exp);
+ if (CTL_FL(condition)) return condition;
+ if (TRUEP(condition)) return lisp_eval(interp, exp, istail);
iter = CDR(iter);
}
return NIL;
@@ -39,19 +38,23 @@ error:
return new_error(interp, "cond: syntax error.\n");
}
-SExpRef primitive_progn(Interp *interp, SExpRef args) {
+SExpRef primitive_progn(Interp *interp, SExpRef args, bool istail) {
SExpRef iter = args;
SExpRef ret;
while (!NILP(iter)) {
- ret = EVAL(CAR(iter));
- if (ERRORP(ret)) return ret;
+ if (NILP(CDR(iter))) {
+ return lisp_eval(interp, CAR(iter), istail);
+ } else {
+ ret = EVAL(CAR(iter));
+ }
+ if (CTL_FL(ret)) return ret;
iter = CDR(iter);
}
return ret;
}
-SExpRef primitive_setq(Interp *interp, SExpRef args) {
+SExpRef primitive_setq(Interp *interp, SExpRef args, bool istail) {
SExpRef name, exp, value;
if (LENGTH(args) != 2) goto error;
@@ -59,7 +62,7 @@ SExpRef primitive_setq(Interp *interp, SExpRef args) {
exp = CADR(args);
if (REF(name)->type != kSymbolSExp) goto error;
value = EVAL(exp);
- if (ERRORP(value)) return value;
+ if (CTL_FL(value)) return value;
return lisp_setq(interp, REF(name)->str, value);
error:
return new_error(interp, "setq: syntax error.\n");
@@ -80,7 +83,7 @@ static bool is_binding_repeat(Interp *interp, SExpRef sym, SExpRef env) {
return false;
}
-SExpRef primitive_let(Interp *interp, SExpRef args) {
+SExpRef primitive_let(Interp *interp, SExpRef args, bool istail) {
SExpRef binding, iter, bindings, env, x,
val, body, ret, exp;
@@ -108,9 +111,9 @@ SExpRef primitive_let(Interp *interp, SExpRef args) {
while (!NILP(iter)) {
x = CAR(iter);
val = EVAL(CADR(x));
- if (REF(val)->type == kErrSExp) goto end;
+ if (CTL_FL(val)) goto end;
ret = lisp_setq(interp, REF(CAR(x))->str, val);
- if (ERRORP(ret)) goto end;
+ if (CTL_FL(ret)) goto end;
iter = CDR(iter);
}
@@ -118,8 +121,13 @@ SExpRef primitive_let(Interp *interp, SExpRef args) {
iter = body;
while (!NILP(iter)) {
exp = CAR(iter);
- ret = EVAL(exp);
- if (REF(ret)->type == kErrSExp) goto end;
+ if (NILP(CDR(iter))) {
+ ret = lisp_eval(interp, exp, istail);
+ goto end;
+ } else {
+ ret = EVAL(exp);
+ }
+ if (CTL_FL(val)) goto end;
iter = CDR(iter);
}
end:
@@ -130,7 +138,7 @@ error:
return new_error(interp, "let: syntax error. \n");
}
-SExpRef primitive_while(Interp *interp, SExpRef args) {
+SExpRef primitive_while(Interp *interp, SExpRef args, bool istail) {
SExpRef ret, pred, body, cond, iter, x;
if (LENGTH(args) < 2) goto error;
@@ -138,14 +146,28 @@ SExpRef primitive_while(Interp *interp, SExpRef args) {
pred = CAR(args);
body = CDR(args);
while (1) {
+nextloop:
cond = EVAL(pred);
- if (ERRORP(cond)) return cond;
+ if (CTL_FL(cond)) {
+ if (VALTYPE(cond) != kErrSignal) {
+ return new_error(interp, "while: unexpected control flow.\n");
+ }
+ return cond;
+ }
if (!TRUEP(cond)) return ret;
iter = body;
while (!NILP(iter)) {
x = CAR(iter);
ret = EVAL(x);
- if (ERRORP(ret)) return ret;
+ if (VALTYPE(ret) == kErrSignal || VALTYPE(ret) == kReturnSignal) {
+ return ret;
+ }
+ if (VALTYPE(ret) == kBreakSignal) {
+ return REF(ret)->ret;
+ }
+ if (VALTYPE(ret) == kContinueSignal) {
+ goto nextloop;
+ }
iter = CDR(iter);
}
}
@@ -153,7 +175,7 @@ error:
return new_error(interp, "while: syntax error.\n");
}
-SExpRef primitive_lambda(Interp *interp, SExpRef args) {
+SExpRef primitive_lambda(Interp *interp, SExpRef args, bool istail) {
SExpRef env, param, body;
if (LENGTH(args) < 2) goto error;
@@ -165,7 +187,7 @@ error:
return new_error(interp, "lambda: syntax error.\n");
}
-SExpRef primitive_defun(Interp *interp, SExpRef args) {
+SExpRef primitive_defun(Interp *interp, SExpRef args, bool istail) {
SExpRef name, param, body, function;
if (LENGTH(args) < 3) goto error;
@@ -182,7 +204,7 @@ SExpRef primitive_defun(Interp *interp, SExpRef args) {
error:
return new_error(interp, "defun: syntax error.\n");
}
-SExpRef primitive_defmacro(Interp *interp, SExpRef args) {
+SExpRef primitive_defmacro(Interp *interp, SExpRef args, bool istail) {
SExpRef param, name, body, macro;
if (LENGTH(args) < 3) goto error;
@@ -200,7 +222,7 @@ error:
return new_error(interp, "defmacro: syntax error.\n");
}
-SExpRef primitive_defvar(Interp *interp, SExpRef args) {
+SExpRef primitive_defvar(Interp *interp, SExpRef args, bool istail) {
SExpRef name, exp, val;
if (LENGTH(args) != 2) goto error;
@@ -211,14 +233,14 @@ SExpRef primitive_defvar(Interp *interp, SExpRef args) {
if (VALTYPE(name) != kSymbolSExp) goto error;
exp = CADR(args);
val = EVAL(exp);
- if (ERRORP(val)) return val;
+ if (CTL_FL(val)) return val;
lisp_defvar(interp, REF(name)->str, val);
return name;
error:
return new_error(interp, "defvar: syntax error.\n");
}
-SExpRef primitive_function(Interp *interp, SExpRef args) {
+SExpRef primitive_function(Interp *interp, SExpRef args, bool istail) {
if (LENGTH(args) != 1) goto error;
if (VALTYPE(CAR(args)) != kSymbolSExp) goto error;
return lisp_lookup_func(interp, REF(CAR(args))->str);
@@ -255,21 +277,21 @@ static SExpRef build_function_env(Interp *interp, SExpRef func, SExpRef args) {
return env;
}
-SExpRef primitive_funcall(Interp *interp, SExpRef args) {
+SExpRef primitive_funcall(Interp *interp, SExpRef args, bool istail) {
if (LENGTH(args) < 1) goto error;
args = lisp_eval_args(interp, args);
- if (ERRORP(args)) return args;
- return lisp_apply(interp, CAR(args), CDR(args));
+ if (CTL_FL(args)) return args;
+ return lisp_apply(interp, CAR(args), CDR(args), istail);
error:
return new_error(interp, "funcall: syntax error.\n");
}
-SExpRef primitive_quote(Interp *interp, SExpRef args) {
+SExpRef primitive_quote(Interp *interp, SExpRef args, bool istail) {
if (LENGTH(args) != 1) return new_error(interp, "quote: syntax error.\n");
return CAR(args);
}
-SExpRef primitive_macroexpand1(Interp *interp, SExpRef args) {
+SExpRef primitive_macroexpand1(Interp *interp, SExpRef args, bool istail) {
SExpRef macro;
if (LENGTH(args) != 1) goto error;
@@ -282,15 +304,15 @@ error:
return new_error(interp, "macroexpand-1: syntax error.\n");
}
-SExpRef primitive_apply(Interp *interp, SExpRef args) {
+SExpRef primitive_apply(Interp *interp, SExpRef args, bool istail) {
SExpRef ret;
if (LENGTH(args) != 2) goto error;
args = lisp_eval_args(interp, args);
- if (ERRORP(args)) return args;
+ if (CTL_FL(args)) return args;
if (!lisp_check_list(interp, CADR(args))) goto error;
PUSH_REG(args);
- ret = lisp_apply(interp, CAR(args), CADR(args));
+ ret = lisp_apply(interp, CAR(args), CADR(args), istail);
POP_REG();
return ret;
error:
@@ -315,7 +337,7 @@ static SExpRef quasi_impl(Interp *interp, SExpRef obj, bool *slicing) {
if (VALTYPE(CAR(obj)) == kSymbolSExp
&& strcmp("slicing-unquote", REF(CAR(obj))->str) == 0) {
lst = EVAL(CADR(obj));
- if (ERRORP(lst)) return lst;
+ if (CTL_FL(lst)) return lst;
if (LENGTH(obj) != 2) {
return new_error(interp, "slicing-unquote: syntax error.\n");
}
@@ -337,7 +359,7 @@ static SExpRef quasi_on_list(Interp *interp, SExpRef lst) {
while (!NILP(iter)) {
x = CAR(iter);
newx = quasi_impl(interp, x, &slicing);
- if (ERRORP(newx)) return newx;
+ if (CTL_FL(newx)) return newx;
if (slicing) {
j = newx;
while (!NILP(j)) {
@@ -353,7 +375,7 @@ static SExpRef quasi_on_list(Interp *interp, SExpRef lst) {
return lisp_reverse(interp, newlst);
}
-SExpRef primitive_quasi(Interp *interp, SExpRef args) {
+SExpRef primitive_quasi(Interp *interp, SExpRef args, bool istail) {
SExpRef ret;
if (LENGTH(args) != 1) return new_error(interp, "quasiquote: syntax error.\n");
bool slicing;
@@ -362,25 +384,33 @@ SExpRef primitive_quasi(Interp *interp, SExpRef args) {
return ret;
}
-SExpRef primitive_and(Interp *interp, SExpRef args) {
+SExpRef primitive_and(Interp *interp, SExpRef args, bool istail) {
SExpRef ret;
SExpRef i = args;
if (LENGTH(args) < 1) return new_error(interp, "and: syntax error.\n");
while (!NILP(i)) {
- ret = EVAL(CAR(i));
+ if (!NILP(CDR(i))) {
+ ret = EVAL(CAR(i));
+ } else {
+ return lisp_eval(interp, CAR(i), istail);
+ }
if (!TRUEP(ret)) return ret;
i = CDR(i);
}
return ret;
}
-SExpRef primitive_or(Interp *interp, SExpRef args) {
+SExpRef primitive_or(Interp *interp, SExpRef args, bool istail) {
SExpRef ret;
SExpRef i = args;
if (LENGTH(args) < 1) return new_error(interp, "or: syntax error.\n");
while (!NILP(i)) {
- ret = EVAL(CAR(i));
+ if (!NILP(CDR(i))) {
+ ret = EVAL(CAR(i));
+ } else {
+ return lisp_eval(interp, CAR(i), istail);
+ }
if (TRUEP(ret)) return ret;
i = CDR(i);
}
diff --git a/src/primitives.h b/src/primitives.h
index 7e6d559..5e22ba9 100644
--- a/src/primitives.h
+++ b/src/primitives.h
@@ -3,23 +3,23 @@
#include "interp.h"
-SExpRef primitive_if(Interp *interp, SExpRef sexp);
-SExpRef primitive_cond(Interp *interp, SExpRef sexp);
-SExpRef primitive_progn(Interp *interp, SExpRef sexp);
-SExpRef primitive_setq(Interp *interp, SExpRef sexp);
-SExpRef primitive_let(Interp *interp, SExpRef sexp);
-SExpRef primitive_while(Interp *interp, SExpRef sexp);
-SExpRef primitive_lambda(Interp *interp, SExpRef sexp);
-SExpRef primitive_defun(Interp *interp, SExpRef sexp);
-SExpRef primitive_defvar(Interp *interp, SExpRef sexp);
-SExpRef primitive_defmacro(Interp *interp, SExpRef sexp);
-SExpRef primitive_function(Interp *interp, SExpRef sexp);
-SExpRef primitive_macroexpand1(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);
-SExpRef primitive_and(Interp *interp, SExpRef sexp);
-SExpRef primitive_or(Interp *interp, SExpRef sexp);
+SExpRef primitive_if(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_cond(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_progn(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_setq(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_let(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_while(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_lambda(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_defun(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_defvar(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_defmacro(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_function(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_macroexpand1(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_funcall(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_apply(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_quote(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_quasi(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_and(Interp *interp, SExpRef sexp, bool istail);
+SExpRef primitive_or(Interp *interp, SExpRef sexp, bool istail);
#endif
diff --git a/src/sexp.h b/src/sexp.h
index 1fc0ce9..dfd3ee6 100644
--- a/src/sexp.h
+++ b/src/sexp.h
@@ -45,6 +45,11 @@ typedef struct {
SExpRef next;
} SExpBinding;
+typedef struct {
+ SExpRef fn;
+ SExpRef args;
+} SExpTailcall;
+
typedef enum {
kEmptySExp,
kIntegerSExp,
@@ -61,7 +66,11 @@ typedef enum {
kEnvSExp,
kBindingSExp,
kMacroSExp,
- kErrSExp,
+ kErrSignal,
+ kReturnSignal,
+ kBreakSignal,
+ kContinueSignal,
+ kTailcallSExp,
} SExpType;
struct sexp {
@@ -80,6 +89,8 @@ struct sexp {
SExpEnv env;
SExpBinding binding;
SExpMacro macro;
+ SExpRef ret;
+ SExpTailcall tailcall;
};
};
generated by cgit v1.0 at 2025-12-29 21:05:19 +0000