rose-ash/spec/tests/test-tco.sx

;; ==========================================================================
;; test-tco.sx — Tests for tail-call optimization and set! mutation
;;
;; Requires: test-framework.sx loaded first.
;; Modules tested: eval.sx (trampoline, thunk, set!)
;;
;; TCO note: tail-recursive calls in SX produce thunks that are resolved
;; by the trampoline. Deep recursion that would overflow a native call
;; stack must complete in O(1) stack space via this mechanism.
;; ==========================================================================


;; --------------------------------------------------------------------------
;; Tail-call optimization — basic deep recursion
;; --------------------------------------------------------------------------

(defsuite "tco-basic"
  (deftest "tail-recursive sum completes without stack overflow"
    ;; sum-iter is tail-recursive: the recursive call is the final value.
    ;; n=500 would blow the call stack without TCO.
    ;; (Depth limited by Python's default recursion limit)
    (define sum-iter
      (fn (n acc)
        (if (<= n 0)
          acc
          (sum-iter (- n 1) (+ acc n)))))
    (assert-equal 125250 (sum-iter 500 0)))

  (deftest "tail-recursive factorial"
    (define fact-iter
      (fn (n acc)
        (if (<= n 1)
          acc
          (fact-iter (- n 1) (* acc n)))))
    (assert-equal 120 (fact-iter 5 1))
    (assert-equal 3628800 (fact-iter 10 1)))

  (deftest "mutual tail recursion via define"
    ;; even? and odd? call each other in tail position.
    ;; With TCO both directions must trampoline correctly.
    (define my-even?
      (fn (n)
        (if (= n 0)
          true
          (my-odd? (- n 1)))))
    (define my-odd?
      (fn (n)
        (if (= n 0)
          false
          (my-even? (- n 1)))))
    (assert-true  (my-even? 100))
    (assert-false (my-odd?  100))
    (assert-false (my-even? 99))
    (assert-true  (my-odd?  99)))

  (deftest "non-tail recursion at moderate depth"
    ;; Classic non-tail factorial: O(n) stack frames.
    ;; n=100 is deep enough to exercise recursion without relying on TCO.
    (define factorial
      (fn (n)
        (if (<= n 1)
          1
          (* n (factorial (- n 1))))))
    (assert-equal 1 (factorial 1))
    (assert-equal 24 (factorial 4))
    ;; Use a boolean check so we don't need big-integer support
    (assert-true (> (factorial 20) 1000000))))


;; --------------------------------------------------------------------------
;; set! mutation
;; --------------------------------------------------------------------------

(defsuite "set-mutation"
  (deftest "set! changes binding value"
    (define x 1)
    (set! x 2)
    (assert-equal 2 x))

  (deftest "set! in let body"
    (let ((y 10))
      (set! y 20)
      (assert-equal 20 y)))

  (deftest "set! visible to subsequent expressions in do block"
    (let ((counter 0))
      (do
        (set! counter (+ counter 1))
        (set! counter (+ counter 1))
        (set! counter (+ counter 1)))
      (assert-equal 3 counter)))

  (deftest "set! counter pattern"
    ;; Simulate an imperative loop via set! + tail recursion.
    (let ((total 0))
      (define loop
        (fn (i)
          (when (< i 5)
            (set! total (+ total i))
            (loop (+ i 1)))))
      (loop 0)
      ;; 0+1+2+3+4 = 10
      (assert-equal 10 total)))

  (deftest "multiple set! to same variable"
    (define v 0)
    (set! v 1)
    (set! v 2)
    (set! v 3)
    (assert-equal 3 v)))


;; --------------------------------------------------------------------------
;; TCO in various tail positions
;; --------------------------------------------------------------------------

(defsuite "tco-patterns"
  (deftest "accumulator pattern"
    ;; Classic FP accumulator — build result in extra param so the
    ;; recursive call stays in tail position.
    (define reverse-iter
      (fn (lst acc)
        (if (empty? lst)
          acc
          (reverse-iter (rest lst) (cons (first lst) acc)))))
    (assert-equal (list 3 2 1) (reverse-iter (list 1 2 3) (list)))
    (assert-equal (list)       (reverse-iter (list) (list))))

  (deftest "loop via tail recursion until condition"
    ;; count-down reaches zero via tail calls only.
    (define count-down
      (fn (n)
        (if (= n 0)
          "done"
          (count-down (- n 1)))))
    (assert-equal "done" (count-down 500)))

  (deftest "tail position in if then-branch"
    (define f
      (fn (n)
        (if (> n 0)
          (f (- n 1))   ;; tail call in then-branch
          "zero")))
    (assert-equal "zero" (f 500)))

  (deftest "tail position in if else-branch"
    (define g
      (fn (n)
        (if (= n 0)
          "done"
          (g (- n 1)))))  ;; tail call in else-branch
    (assert-equal "done" (g 500)))

  (deftest "tail position in cond"
    (define classify
      (fn (n)
        (cond (< n 0)  "negative"
              (= n 0)  "zero"
              :else     "positive")))
    (assert-equal "negative" (classify -5))
    (assert-equal "zero"     (classify 0))
    (assert-equal "positive" (classify 7)))

  (deftest "tail position in cond recursive clause"
    (define count-up
      (fn (n limit)
        (cond (= n limit) n
              :else        (count-up (+ n 1) limit))))
    (assert-equal 200 (count-up 0 200)))

  (deftest "tail position in let body"
    ;; The body expression of a let is in tail position.
    (define h
      (fn (n)
        (let ((m (- n 1)))
          (if (<= m 0)
            m
            (h m)))))
    (assert-equal 0 (h 500)))

  (deftest "tail position in when body"
    ;; The last expression of a when body is in tail position.
    (define scan
      (fn (lst acc)
        (when (not (empty? lst))
          (scan (rest lst) (+ acc (first lst))))))
    ;; scan returns nil on empty — seed with pre-evaluated sum
    (define sum-list
      (fn (lst)
        (reduce (fn (a x) (+ a x)) 0 lst)))
    (assert-equal 15 (sum-list (list 1 2 3 4 5)))))

(defsuite
  "tco-step10"
  (deftest
    "tail position in match"
    (define
      loop
      (fn (n acc) (match n (0 acc) (_ (loop (- n 1) (+ acc 1))))))
    (assert= 100000 (loop 100000 0)))
  (deftest
    "tail position in do form"
    (assert=
      100000
      (do
        (define loop (fn (n) (if (zero? n) n (loop (- n 1)))))
        (loop 100000)
        100000)))
  (deftest
    "tail position in begin"
    (define
      loop
      (fn (n acc) (if (zero? n) acc (begin (loop (- n 1) (+ acc 1))))))
    (assert= 100000 (loop 100000 0)))
  (deftest
    "tail position in parameterize body"
    (let
      ((p (make-parameter 0)))
      (define
        loop
        (fn
          (n)
          (parameterize ((p n)) (if (zero? n) (p) (loop (- n 1))))))
      (assert= 0 (loop 10000))))
  (deftest
    "tail position in guard body"
    (define
      loop
      (fn
        (n acc)
        (guard
          (exn (true acc))
          (if (zero? n) acc (loop (- n 1) (+ acc 1))))))
    (assert= 100000 (loop 100000 0)))
  (deftest
    "tail position in handler-bind body"
    (define
      loop
      (fn
        (n acc)
        (handler-bind () (if (zero? n) acc (loop (- n 1) (+ acc 1))))))
    (assert= 100000 (loop 100000 0)))
  (deftest
    "tail position in let-match body"
    (define
      loop
      (fn
        (n acc)
        (let-match
          {:val v}
          {:val n}
          (if (zero? v) acc (loop (- v 1) (+ acc 1))))))
    (assert= 100000 (loop 100000 0)))
  (deftest
    "tail position in and/or"
    (define
      loop-and
      (fn (n) (if (zero? n) true (and true (loop-and (- n 1))))))
    (define
      loop-or
      (fn (n) (if (zero? n) false (or false (loop-or (- n 1))))))
    (do (assert= true (loop-and 100000)) (assert= false (loop-or 100000))))
  (deftest
    "mutual tail recursion at depth 200000"
    (define is-even? (fn (n) (if (zero? n) true (is-odd? (- n 1)))))
    (define is-odd? (fn (n) (if (zero? n) false (is-even? (- n 1)))))
    (do (assert (is-even? 200000)) (assert (not (is-odd? 200000))))))