diff options
Diffstat (limited to 'src/interp.c')
| -rw-r--r-- | src/interp.c | 77 |
1 files changed, 55 insertions, 22 deletions
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; } |