fix tailcall bug

4 files changed, 21 insertions, 15 deletions

diff --git a/src/builtins.c b/src/builtins.c
index d6db48a..68330d8 100644
--- a/src/builtins.c
+++ b/src/builtins.c
@@ -19,7 +19,7 @@ SExpRef builtin_map(Interp *interp, SExpRef args) {
     for (SExpRef i = lst; !NILP(i); i = CDR(i)) {
         SExpRef x = CAR(i);
         PUSH_REG(newlst);
-        SExpRef newx = lisp_apply(interp, fn, CONS(x, NIL), false);
+        SExpRef newx = lisp_call(interp, fn, CONS(x, NIL));
         POP_REG();
         if (CTL_FL(newx)) return newx;
         newlst = CONS(newx, newlst);
@@ -40,7 +40,7 @@ SExpRef builtin_filter(Interp *interp, SExpRef args) {
     for (SExpRef i = lst; !NILP(i); i = CDR(i)) {
         SExpRef x = CAR(i);
         PUSH_REG(newlst);
-        SExpRef pred = lisp_apply(interp, fn, CONS(x, NIL), false);
+        SExpRef pred = lisp_call(interp, fn, CONS(x, NIL));
         POP_REG();
         if (CTL_FL(pred)) return pred;
         if (TRUEP(pred)) {
@@ -63,7 +63,7 @@ SExpRef builtin_remove(Interp *interp, SExpRef args) {
     for (SExpRef i = lst; !NILP(i); i = CDR(i)) {
         SExpRef x = CAR(i);
         PUSH_REG(newlst);
-        SExpRef pred = lisp_apply(interp, fn, CONS(x, NIL), false);
+        SExpRef pred = lisp_call(interp, fn, CONS(x, NIL));
         POP_REG();
         if (CTL_FL(pred)) return pred;
         if (!TRUEP(pred)) {
@@ -85,7 +85,7 @@ SExpRef builtin_count(Interp *interp, SExpRef args) {
     int count = 0;
     for (SExpRef i = lst; !NILP(i); i = CDR(i)) {
         SExpRef x = CAR(i);
-        SExpRef pred = lisp_apply(interp, fn, CONS(x, NIL), false);
+        SExpRef pred = lisp_call(interp, fn, CONS(x, NIL));
         if (CTL_FL(pred)) return pred;
         if (TRUEP(pred)) {
             count++;
@@ -105,7 +105,7 @@ SExpRef builtin_foreach(Interp *interp, SExpRef args) {
     }
     for (SExpRef i = lst; !NILP(i); i = CDR(i)) {
         SExpRef x = CAR(i);
-        SExpRef newx = lisp_apply(interp, fn, CONS(x, NIL), false);
+        SExpRef newx = lisp_call(interp, fn, CONS(x, NIL));
         if (CTL_FL(newx)) return newx;
     }
     return NIL;
diff --git a/src/interp.c b/src/interp.c
index 3d7b318..44800c8 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -481,7 +481,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, false);
+    SExpRef ret = lisp_call(interp, fn, args);
     POP_REG();
     return ret;
 error:
@@ -691,6 +691,19 @@ static SExpRef build_function_env(Interp *interp, SExpRef func, SExpRef args) {
     return env;
 }
 
+SExpRef lisp_call(Interp *interp, SExpRef fn, SExpRef args) {
+    SExpRef ret = lisp_apply(interp, fn, args, false);
+    while (VALTYPE(ret) == kTailcallSExp) {
+        fn = REF(ret)->tailcall.fn;
+        args = REF(ret)->tailcall.args;
+        PUSH_REG(ret);
+        ret = lisp_apply(interp, fn, args, false);
+        POP_REG();
+        if (CTL_FL(ret)) break;
+    }
+    return ret;
+}
+
 SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args, bool istail) {
     if (interp->recursion_depth > 2048)
         return new_error(interp, "apply: stack overflow.\n");
@@ -734,14 +747,6 @@ end:
     if (VALTYPE(ret) == kReturnSignal) {
         ret = REF(ret)->ret;
     }
-    if (VALTYPE(ret) == kTailcallSExp && !istail) {
-        fn = REF(ret)->tailcall.fn;
-        args = REF(ret)->tailcall.args;
-        PUSH_REG(ret);
-        ret = lisp_apply(interp, fn, args, false);
-        POP_REG();
-        goto end;
-    }
     interp->stack = CDR(interp->stack);
     interp->recursion_depth--;
     return ret;
diff --git a/src/interp.h b/src/interp.h
index 96173a7..3feecfa 100644
--- a/src/interp.h
+++ b/src/interp.h
@@ -88,6 +88,7 @@ void lisp_print(Interp *interp, SExpRef obj, FILE *fp);
 SExpRef lisp_lookup(Interp *interp, SExpRef name);
 SExpRef lisp_lookup_func(Interp *interp, SExpRef name);
 SExpRef lisp_apply(Interp *interp, SExpRef fn, SExpRef args, bool istail);
+SExpRef lisp_call(Interp *interp, SExpRef fn, SExpRef args);
 SExpRef lisp_cons(Interp *interp, SExpRef a, SExpRef b);
 SExpRef lisp_dup(Interp *interp, SExpRef arg);
 bool lisp_nilp(Interp *interp, SExpRef arg);
diff --git a/tests/tailcall.lisp b/tests/tailcall.lisp
index 4a3e480..7cfbf61 100644
--- a/tests/tailcall.lisp
+++ b/tests/tailcall.lisp
@@ -6,7 +6,7 @@
 (defun is-odd (x)
     (is-even (- x 1)))
 
-(assert (is-even 1024))
+(assert (is-even 2050))
 (assert (is-even 10))
 (assert (is-even 0))
 (assert (is-odd 1))