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

;; ==========================================================================
;; test-scope.sx — Comprehensive tests for scope, binding, and environment
;;
;; Requires: test-framework.sx loaded first.
;; Modules tested: eval.sx (let, define, set!, letrec, lambda, closure env)
;;
;; Covers edge cases that break with incorrect environment handling:
;;   - let single/many bindings, multi-body, sequential binding, nesting
;;   - define visibility at top-level, in do, in let body
;;   - set! mutation through closure chains and loops
;;   - Closure independence, mutual mutation, survival after scope exit
;;   - letrec single/mutual recursion, plain values, ordering
;;   - Env isolation: components, lambdas, higher-order callbacks
;; ==========================================================================


;; --------------------------------------------------------------------------
;; let edge cases
;; --------------------------------------------------------------------------

(defsuite "let-edge-cases"
  (deftest "let with single binding"
    (assert-equal 7 (let ((x 7)) x)))

  (deftest "let with many bindings"
    (let ((a 1) (b 2) (c 3) (d 4) (e 5))
      (assert-equal 1 a)
      (assert-equal 2 b)
      (assert-equal 3 c)
      (assert-equal 4 d)
      (assert-equal 5 e)
      (assert-equal 15 (+ a b c d e))))

  (deftest "let body with multiple expressions returns last"
    ;; All expressions must be evaluated; only the last value is returned.
    (let ((log (list)))
      (let ((result
              (let ((x 10))
                (set! log (append log (list 1)))
                (set! log (append log (list 2)))
                x)))
        (assert-equal 10 result)
        (assert-equal (list 1 2) log))))

  (deftest "let bindings are sequential — earlier visible in later"
    ;; SX let evaluates bindings sequentially (like let*).
    ;; The second binding CAN see the first.
    (let ((x 100))
      (let ((x 1) (y x))
        (assert-equal 1 x)
        (assert-equal 1 y))))

  (deftest "nested let — inner shadows outer, outer restored after"
    (let ((x 1))
      (let ((x 2))
        (assert-equal 2 x))
      ;; inner let is finished; outer x must be restored
      (assert-equal 1 x)))

  (deftest "let with computed binding value"
    (let ((x (+ 1 2)))
      (assert-equal 3 x))
    (let ((y (* 4 5)))
      (assert-equal 20 y))
    (let ((z (str "hel" "lo")))
      (assert-equal "hello" z)))

  (deftest "let inside lambda body"
    (let ((f (fn (n)
               (let ((doubled (* n 2))
                     (incremented (+ n 1)))
                 (+ doubled incremented)))))
      ;; f(3) => doubled=6, incremented=4 => 10
      (assert-equal 10 (f 3))
      (assert-equal 16 (f 5))))

  (deftest "lambda inside let binding value"
    (let ((add (fn (a b) (+ a b)))
          (mul (fn (a b) (* a b))))
      (assert-equal 5 (add 2 3))
      (assert-equal 6 (mul 2 3))
      ;; Both lambdas co-exist without interfering
      (assert-equal 14 (add (mul 2 3) (add 2 6)))))

  (deftest "let binding value that calls another let-bound function"
    ;; The inner let is evaluated left-to-right; double sees add.
    (let ((add (fn (x) (+ x 1))))
      (let ((result (add 41)))
        (assert-equal 42 result))))

  (deftest "deeply nested let all bindings remain accessible"
    (let ((a 10))
      (let ((b 20))
        (let ((c 30))
          ;; All three outer bindings are visible here
          (assert-equal 60 (+ a b c))
          (let ((a 99))
            ;; a is shadowed, b and c still visible
            (assert-equal 149 (+ a b c)))
          ;; After inner let, a is restored to 10
          (assert-equal 60 (+ a b c)))))))


;; --------------------------------------------------------------------------
;; define scope
;; --------------------------------------------------------------------------

(defsuite "define-scope"
  (deftest "define at top level visible in subsequent expressions"
    (define scope-test-val 42)
    (assert-equal 42 scope-test-val))

  (deftest "define with lambda value, then call it"
    (define scope-double (fn (n) (* n 2)))
    (assert-equal 10 (scope-double 5))
    (assert-equal 0  (scope-double 0))
    (assert-equal -6 (scope-double -3)))

  (deftest "define with result of another function call"
    (define scope-sum (+ 10 20 30))
    (assert-equal 60 scope-sum))

  (deftest "define inside do block visible in later do expressions"
    (do
      (define do-local-x 77)
      (assert-equal 77 do-local-x)
      (define do-local-y (* do-local-x 2))
      (assert-equal 154 do-local-y)))

  (deftest "two defines with same name — second overwrites first"
    (define redef-var "first")
    (assert-equal "first" redef-var)
    (define redef-var "second")
    (assert-equal "second" redef-var))

  (deftest "define lambda that calls another defined lambda"
    (define scope-inc (fn (n) (+ n 1)))
    (define scope-inc2 (fn (n) (scope-inc (scope-inc n))))
    (assert-equal 7 (scope-inc2 5)))

  (deftest "define inside let body is visible within that let body"
    (let ((outer 10))
      (define inner-def 20)
      (assert-equal 30 (+ outer inner-def))))

  (deftest "define with a conditional value"
    (define scope-max-val (if (> 5 3) "big" "small"))
    (assert-equal "big" scope-max-val)))


;; --------------------------------------------------------------------------
;; set! scope chain
;; --------------------------------------------------------------------------

(defsuite "set-scope-chain"
  (deftest "set! on define'd variable"
    (define setscope-x 1)
    (set! setscope-x 99)
    (assert-equal 99 setscope-x))

  (deftest "set! on let binding"
    (let ((x 0))
      (set! x 42)
      (assert-equal 42 x)))

  (deftest "set! through one level of closure"
    (let ((counter 0))
      (let ((bump! (fn () (set! counter (+ counter 1)))))
        (bump!)
        (bump!)
        (assert-equal 2 counter))))

  (deftest "set! through two levels of closure"
    (let ((value 0))
      (let ((make-setter (fn ()
                           (fn (n) (set! value n)))))
        (let ((setter (make-setter)))
          (setter 100)
          (assert-equal 100 value)
          (setter 200)
          (assert-equal 200 value)))))

  (deftest "set! inside for-each loop body accumulates"
    (let ((total 0))
      (for-each (fn (n) (set! total (+ total n)))
                (list 1 2 3 4 5))
      (assert-equal 15 total)))

  (deftest "set! updates are visible immediately in same scope"
    (let ((x 1))
      (set! x (+ x 1))
      (set! x (+ x 1))
      (set! x (+ x 1))
      (assert-equal 4 x)))

  (deftest "set! on undefined variable creates binding"
    ;; In SX, set! on an unbound name creates a new binding on the
    ;; immediate env (falls through after chain walk). This is
    ;; permissive behavior — strict mode could enforce this differently.
    (let ((r (try-call (fn () (set! _test-set-undef 42)))))
      (assert-true (get r "ok"))))

  (deftest "set! mutation visible across sibling closures in same let"
    (let ((shared 0))
      (let ((writer (fn (v) (set! shared v)))
            (reader (fn () shared)))
        (assert-equal 0 (reader))
        (writer 55)
        (assert-equal 55 (reader))
        (writer 99)
        (assert-equal 99 (reader)))))

  (deftest "set! does not affect outer scope bindings with same name"
    ;; Inner let introduces its own x; set! inside it must not touch outer x.
    (let ((x 10))
      (let ((x 20))
        (set! x 999))
      ;; outer x must remain 10
      (assert-equal 10 x))))


;; --------------------------------------------------------------------------
;; closure scope edge cases
;; --------------------------------------------------------------------------

(defsuite
  "closure-scope-edge"
  (deftest
    "for-each captures independent value per iteration"
    (let
      ((thunks (map (fn (x) (fn () x)) (list 10 20 30))))
      (assert-equal 10 ((nth thunks 0)))
      (assert-equal 20 ((nth thunks 1)))
      (assert-equal 30 ((nth thunks 2)))))
  (deftest
    "multiple closures from same let are independent"
    (define
      make-pair
      (fn
        (init)
        (let
          ((state init))
          (list (fn (v) (set! state v)) (fn () state)))))
    (let
      ((pair-a (make-pair 0)) (pair-b (make-pair 100)))
      (let
        ((set-a (nth pair-a 0))
          (get-a (nth pair-a 1))
          (set-b (nth pair-b 0))
          (get-b (nth pair-b 1)))
        (set-a 7)
        (set-b 42)
        (assert-equal 7 (get-a))
        (assert-equal 42 (get-b))
        (set-a 99)
        (assert-equal 99 (get-a))
        (assert-equal 42 (get-b)))))
  (deftest
    "closure over closure — function returning a function"
    (define
      make-adder-factory
      (fn (base) (fn (offset) (fn (x) (+ base offset x)))))
    (let
      ((factory (make-adder-factory 100)))
      (let
        ((add-10 (factory 10)) (add-20 (factory 20)))
        (assert-equal 115 (add-10 5))
        (assert-equal 125 (add-20 5))
        (assert-equal 130 (add-10 20))
        (assert-equal 140 (add-20 20)))))
  (deftest
    "closure survives after creating scope is gone"
    (define make-frozen-adder (fn (n) (fn (x) (+ n x))))
    (let
      ((add5 (make-frozen-adder 5)) (add99 (make-frozen-adder 99)))
      (assert-equal 10 (add5 5))
      (assert-equal 105 (add5 100))
      (assert-equal 100 (add99 1))
      (assert-equal 199 (add99 100))))
  (deftest
    "closure sees set! mutations from sibling closure"
    (let
      ((shared 0))
      (let
        ((inc! (fn () (set! shared (+ shared 1))))
          (get-val (fn () shared)))
        (assert-equal 0 (get-val))
        (inc!)
        (assert-equal 1 (get-val))
        (inc!)
        (inc!)
        (assert-equal 3 (get-val)))))
  (deftest
    "closure captures value not reference for immutable bindings"
    (let
      ((x 1))
      (let
        ((f (fn () x)))
        (let ((x 99)) (assert-equal 1 (f)))
        (assert-equal 1 (f))))))


;; --------------------------------------------------------------------------
;; letrec edge cases
;; --------------------------------------------------------------------------

(defsuite "letrec-edge"
  (deftest "letrec with single recursive binding"
    (letrec ((sum-to (fn (n)
                       (if (<= n 0)
                         0
                         (+ n (sum-to (- n 1)))))))
      (assert-equal 0  (sum-to 0))
      (assert-equal 1  (sum-to 1))
      (assert-equal 10 (sum-to 4))
      (assert-equal 55 (sum-to 10))))

  (deftest "letrec with two mutually recursive functions"
    (letrec ((my-even? (fn (n)
                         (if (= n 0) true  (my-odd?  (- n 1)))))
             (my-odd?  (fn (n)
                         (if (= n 0) false (my-even? (- n 1))))))
      (assert-true  (my-even? 0))
      (assert-false (my-even? 1))
      (assert-true  (my-even? 10))
      (assert-false (my-even? 7))
      (assert-true  (my-odd?  1))
      (assert-false (my-odd?  0))
      (assert-true  (my-odd?  9))))

  (deftest "letrec non-recursive bindings work too"
    (letrec ((constant 42)
             (label "hello"))
      (assert-equal 42 constant)
      (assert-equal "hello" label)))

  (deftest "letrec body can use all bindings"
    (letrec ((double (fn (n) (* n 2)))
             (triple (fn (n) (* n 3)))
             (base   5))
      ;; Body accesses all three bindings together
      (assert-equal 10 (double base))
      (assert-equal 15 (triple base))
      (assert-equal 25 (+ (double base) (triple base)))))

  (deftest "letrec — later binding can call earlier binding"
    ;; In letrec all bindings see all others, regardless of order.
    (letrec ((square (fn (n) (* n n)))
             (sum-of-squares (fn (a b) (+ (square a) (square b)))))
      ;; sum-of-squares calls square, which was defined before it
      (assert-equal 25 (sum-of-squares 3 4))
      (assert-equal 13 (sum-of-squares 2 3))))

  (deftest "letrec with three-way mutual recursion"
    ;; a → b → c → a cycle
    (letrec ((fa (fn (n) (if (<= n 0) "a-done" (fb (- n 1)))))
             (fb (fn (n) (if (<= n 0) "b-done" (fc (- n 1)))))
             (fc (fn (n) (if (<= n 0) "c-done" (fa (- n 1))))))
      ;; n=0: fa returns immediately
      (assert-equal "a-done" (fa 0))
      ;; n=1: fa→fb, fb returns
      (assert-equal "b-done" (fa 1))
      ;; n=2: fa→fb→fc, fc returns
      (assert-equal "c-done" (fa 2))
      ;; n=3: fa→fb→fc→fa, fa returns
      (assert-equal "a-done" (fa 3)))))


;; --------------------------------------------------------------------------
;; environment isolation
;; --------------------------------------------------------------------------

(defsuite "environment-isolation"
  (deftest "lambda call does not leak its params to caller scope"
    (let ((x 99))
      (let ((f (fn (x) (* x 2))))
        (f 5)
        ;; Caller's x must be unchanged after call
        (assert-equal 99 x))))

  (deftest "lambda call does not leak its local defines to caller scope"
    (let ((f (fn ()
               (define iso-local 123)
               iso-local)))
      (assert-equal 123 (f))
      ;; iso-local defined inside f must not be visible here
      (assert-throws (fn () iso-local))))

  (deftest "for-each callback does not leak its param to caller scope"
    (let ((n 1000))
      (for-each (fn (n) n) (list 1 2 3))
      ;; Caller's n must be unaffected by callback's parameter n
      (assert-equal 1000 n)))

  (deftest "map callback does not leak its param to caller scope"
    (let ((item "original"))
      (map (fn (item) (str item "!")) (list "a" "b" "c"))
      (assert-equal "original" item)))

  (deftest "nested lambda calls don't interfere with each other's locals"
    ;; Two independent calls to the same lambda must not share state.
    (define iso-make-counter
      (fn (start)
        (let ((n start))
          (fn ()
            (set! n (+ n 1))
            n))))
    (let ((c1 (iso-make-counter 0))
          (c2 (iso-make-counter 100)))
      (assert-equal 1   (c1))
      (assert-equal 2   (c1))
      (assert-equal 101 (c2))
      ;; c1 and c2 are fully independent
      (assert-equal 3   (c1))
      (assert-equal 102 (c2))))

  (deftest "map callback env is isolated per call"
    ;; Each map callback invocation should start with a fresh param binding.
    (let ((results (map (fn (x)
                          (let ((local (* x 10)))
                            local))
                        (list 1 2 3 4 5))))
      (assert-equal (list 10 20 30 40 50) results)))

  (deftest "filter callback does not pollute caller scope"
    (let ((threshold 5))
      (let ((big (filter (fn (threshold) (> threshold 5))
                         (list 3 6 9 2 7))))
        ;; The callback shadowed 'threshold' — caller's binding must survive
        (assert-equal 5 threshold)
        (assert-equal (list 6 9 7) big))))

  (deftest "reduce callback accumulates without leaking"
    (let ((acc "untouched"))
      (let ((sum (reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4))))
        (assert-equal 10 sum)
        ;; Outer acc must be unaffected by reduce's internal use of acc
        (assert-equal "untouched" acc))))

  (deftest "component call does not expose its closure to caller"
    ;; Define a component that binds a local name; caller should not
    ;; be able to see that name after the component is invoked.
    (defcomp ~iso-comp (&key val)
      (do
        (define iso-comp-secret (* val 999))
        (div (str val))))
    ;; Component exists and is callable (we can't inspect its internals)
    (assert-true (not (nil? ~iso-comp)))))