From 1cf7adef90777698d1f17363a5f82c997d5f1c34 Mon Sep 17 00:00:00 2001
From: Mistivia <i@mistivia.com>
Date: Sat, 21 Jun 2025 20:20:12 +0800
Subject: fix tco bug

---
 src/interp.c            |  4 ++--
 tests/arithmetic.lisp   | 10 ++++++++++
 tests/control-flow.lisp | 36 ++++++++++++++++++++++++++++++++++++
 tests/error.lisp        | 10 ++++++++++
 tests/lambda.lisp       | 14 ++++++++++++++
 tests/logic.lisp        | 27 +++++++++++++++++++++++++++
 tests/tailcall.lisp     | 17 +++++++++++++++++
 tests/test.lisp         |  3 +++
 8 files changed, 119 insertions(+), 2 deletions(-)
 create mode 100644 tests/error.lisp
 create mode 100644 tests/logic.lisp
 create mode 100644 tests/tailcall.lisp

diff --git a/src/interp.c b/src/interp.c
index a99440c..df995ca 100644
--- a/src/interp.c
+++ b/src/interp.c
@@ -674,7 +674,7 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) {
                 LispPrimitive primitive_fn =
                     PrimitiveEntryVector_ref(&interp->primitives, i)->fn;
                 ret = (*primitive_fn)(interp, CDR(sexp), istail);
-                if (VALTYPE(ret) == kTailcallSExp) {
+                if (VALTYPE(ret) == kTailcallSExp && !istail) {
                     fn = REF(ret)->tailcall.fn;
                     args = REF(ret)->tailcall.args;
                     goto tailcall;
@@ -693,7 +693,7 @@ SExpRef lisp_eval(Interp *interp, SExpRef sexp, bool istail) {
             PUSH_REG(funcallargs);
             ret = primitive_funcall(interp, funcallargs, istail);
             POP_REG();
-            if (VALTYPE(ret) == kTailcallSExp) {
+            if (VALTYPE(ret) == kTailcallSExp && !istail) {
                 fn = REF(ret)->tailcall.fn;
                 args = REF(ret)->tailcall.args;
                 goto tailcall;
diff --git a/tests/arithmetic.lisp b/tests/arithmetic.lisp
index 2764b10..05459f6 100644
--- a/tests/arithmetic.lisp
+++ b/tests/arithmetic.lisp
@@ -5,6 +5,16 @@
 (assert (= 2 (i/ 11 5)))
 (assert (= 1 (mod 11 5)))
 
+(assert (< 1 2))
+(assert (< 1.0 2))
+(assert (not (> 1 2)))
+(assert (= 1.0 1.0))
+(assert (= 1 1.0))
+(assert (not (= 1 2)))
+(assert (>= 2 1))
+(assert (>= 1 1))
+(assert (not (>= 0 1)))
+
 (assert-error (+ 1 "a"))
 (assert-error (- 1 "a"))
 (assert-error (* 1 "a"))
diff --git a/tests/control-flow.lisp b/tests/control-flow.lisp
index 75095ec..321aae0 100644
--- a/tests/control-flow.lisp
+++ b/tests/control-flow.lisp
@@ -27,6 +27,42 @@
   (assert (= i 10))
   (assert (= flag 0)))
 
+(let ((f nil))
+  (setq f
+    (lambda (x)
+      (cond ((> x 5) 1)
+            ((> x 0) (+ 1 1))
+            (#t (+ x 1)))))
+  (assert (= 1 (funcall f 10)))
+  (assert (= 2 (funcall f 3)))
+  (assert (= 0 (funcall f -1))))
+
+(let ((r nil))
+  (if (> 2 1)
+    (setq r 1)
+    (setq r 2))
+  (assert (= r 1)))
+
+(let ((r 1))
+  (when (> 2 1)
+    (setq r 2))
+  (assert (= r 2)))
+
+(let ((r 1))
+  (when (> 1 2)
+    (setq r 2))
+  (assert (= r 1)))
+
+(let ((r 1))
+  (unless (> 1 2)
+    (setq r 2))
+  (assert (= r 2)))
+
+(let ((r 1))
+  (unless (> 2 1)
+    (setq r 2))
+  (assert (= r 1)))
+
 (assert-error (funcall (lambda () (break))))
 (assert-error (funcall (lambda () (continue))))
 (assert (= 1 (funcall (lambda () (return 1)))))
diff --git a/tests/error.lisp b/tests/error.lisp
new file mode 100644
index 0000000..e0e0c4a
--- /dev/null
+++ b/tests/error.lisp
@@ -0,0 +1,10 @@
+(assert-error (error ""))
+(assert-error (let () (error "") #t))
+(assert-error (if (error "") #t #t))
+(assert-error (and (error "")))
+(assert-error (or (error "")))
+(assert-error (funcall (lambda () (error ""))))
+(assert-error (while #t (error "")))
+(assert-error (cond (#t (error ""))))
+(assert-error (cond ((error "") #t)))
+
diff --git a/tests/lambda.lisp b/tests/lambda.lisp
index 5c93bdb..18bbd8b 100644
--- a/tests/lambda.lisp
+++ b/tests/lambda.lisp
@@ -3,10 +3,24 @@
     (lambda (g) (funcall g g))
     (lambda (h)
        (funcall f (lambda args (apply (funcall h h) args))))))
+
 (defun fibo-impl (self)
   (lambda (n)
     (if (<= n 2)
         1
         (+ (funcall self (- n 1)) (funcall self (- n 2))))))
+
 (defvar fibo (Y #'fibo-impl))
+
 (assert (= 55 (funcall fibo 10)))
+
+(defun generate-counter (init)
+  (let ((i init))
+    (lambda ()
+      (setq i (+ 1 i))
+      i)))
+
+(let ((c (generate-counter 0)))
+  (assert (= 1 (funcall c)))
+  (assert (= 2 (funcall c)))
+  (assert (= 3 (funcall c))))
diff --git a/tests/logic.lisp b/tests/logic.lisp
new file mode 100644
index 0000000..5d086de
--- /dev/null
+++ b/tests/logic.lisp
@@ -0,0 +1,27 @@
+(assert (and #t))
+(assert (and #t #t))
+(assert (and #t #t #t))
+(assert (not (and #t #f #t)))
+(assert (not (and #f #t #t)))
+(assert (not (and #f #t #t)))
+(assert (not (or #f)))
+(assert (not (or #f #f)))
+(assert (not (or #f #f #f)))
+(assert (or #t #f #f))
+(assert (or #f #t #f))
+(assert (or #t #t #f))
+
+(let ((t #f))
+  (or #t
+      (setq t #t))
+  (assert (not t)))
+
+(let ((t #f))
+  (and #t
+      (setq t #t))
+  (assert t))
+
+(let ((t #t))
+  (and (setq t #f)
+      (setq t #t))
+  (assert (not t)))
diff --git a/tests/tailcall.lisp b/tests/tailcall.lisp
new file mode 100644
index 0000000..8cea496
--- /dev/null
+++ b/tests/tailcall.lisp
@@ -0,0 +1,17 @@
+(defun is-even (x)
+  (if (= x 0)
+    #t
+    (is-odd (- x 1))))
+
+(defun is-odd (x)
+    (is-even (- x 1)))
+
+(assert (is-even 10000))
+(assert (is-even 10))
+(assert (is-even 0))
+(assert (is-odd 1))
+(assert (is-even 2))
+
+;; can pass without stack overflow,
+;; but comment out for too time-consuming
+;; (assert (is-even 1000000)) 
diff --git a/tests/test.lisp b/tests/test.lisp
index 07bdd5b..4ca2964 100644
--- a/tests/test.lisp
+++ b/tests/test.lisp
@@ -5,6 +5,9 @@
     (princ (format "[PASS] %s\n" ,name))))
 
 (test-module "arithmetic")
+(test-module "error")
+(test-module "logic")
+(test-module "tailcall")
 (test-module "control-flow")
 (test-module "lambda")
 (test-module "comment")
-- 
cgit v1.0