;; ==========================================================================
;; test-cek-advanced.sx — Advanced stress tests for the CEK machine evaluator
;;
;; Exercises complex evaluation patterns that stress the step/continue
;; dispatch loop: deep nesting, higher-order forms, macro expansion in
;; the CEK context, environment pressure, and subtle edge cases.
;;
;; Requires: test-framework.sx, frames.sx, cek.sx loaded.
;; Helpers: cek-eval (source string → value via eval-expr-cek).
;; ==========================================================================


;; --------------------------------------------------------------------------
;; 1. Deep nesting
;; --------------------------------------------------------------------------

(defsuite "cek-deep-nesting"
  (deftest "deeply nested let — 5 levels"
    ;; Each let layer adds a binding; innermost body sees all of them.
    (assert-equal 15
      (cek-eval
        "(let ((a 1))
           (let ((b 2))
             (let ((c 3))
               (let ((d 4))
                 (let ((e 5))
                   (+ a b c d e))))))")))

  (deftest "deeply nested let — 7 levels with shadowing"
    ;; x is rebound at each level; innermost sees 7.
    (assert-equal 7
      (cek-eval
        "(let ((x 1))
           (let ((x 2))
             (let ((x 3))
               (let ((x 4))
                 (let ((x 5))
                   (let ((x 6))
                     (let ((x 7))
                       x)))))))")))

  (deftest "deeply nested if — 5 levels"
    ;; All true branches taken; value propagates through every level.
    (assert-equal 42
      (cek-eval
        "(if true
           (if true
             (if true
               (if true
                 (if true
                   42
                   0)
                 0)
               0)
             0)
           0)")))

  (deftest "deeply nested if — alternating true/false reaching else"
    ;; Outer true → inner false → its else → next true → final value.
    (assert-equal "deep"
      (cek-eval
        "(if true
           (if false
             \"wrong\"
             (if true
               (if false
                 \"also-wrong\"
                 (if true \"deep\" \"no\"))
               \"bad\"))
           \"outer-else\")")))

  (deftest "deeply nested function calls f(g(h(x)))"
    ;; Three composed single-arg functions: inc, double, square.
    ;; square(double(inc(3))) = square(double(4)) = square(8) = 64
    (assert-equal 64
      (cek-eval
        "(do
           (define inc-fn    (fn (x) (+ x 1)))
           (define double-fn (fn (x) (* x 2)))
           (define square-fn (fn (x) (* x x)))
           (square-fn (double-fn (inc-fn 3))))")))

  (deftest "5-level deeply nested function call chain"
    ;; f1(f2(f3(f4(f5(0))))) with each adding 10.
    (assert-equal 50
      (cek-eval
        "(do
           (define f1 (fn (x) (+ x 10)))
           (define f2 (fn (x) (+ x 10)))
           (define f3 (fn (x) (+ x 10)))
           (define f4 (fn (x) (+ x 10)))
           (define f5 (fn (x) (+ x 10)))
           (f1 (f2 (f3 (f4 (f5 0))))))")))

  (deftest "deep begin/do chain — 6 sequential expressions"
    ;; All expressions evaluated; last value returned.
    (assert-equal 60
      (cek-eval
        "(do
           (define acc 0)
           (set! acc (+ acc 10))
           (set! acc (+ acc 10))
           (set! acc (+ acc 10))
           (set! acc (+ acc 10))
           (set! acc (+ acc 10))
           (set! acc (+ acc 10))
           acc)")))

  (deftest "let inside if inside let inside cond"
    ;; cond dispatches → outer let binds → if selects → inner let computes.
    (assert-equal 30
      (cek-eval
        "(let ((mode \"go\"))
           (cond
             (= mode \"stop\") -1
             (= mode \"go\")
               (let ((base 10))
                 (if (> base 5)
                   (let ((factor 3))
                     (* base factor))
                   0))
             :else 0))"))))


;; --------------------------------------------------------------------------
;; 2. Complex call patterns
;; --------------------------------------------------------------------------

(defsuite "cek-complex-calls"
  (deftest "higher-order function returning higher-order function"
    ;; make-adder-factory returns a factory that makes adders.
    ;; Exercises three closure levels in the CEK call handler.
    (assert-equal 115
      (cek-eval
        "(do
           (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-10 5))))")))

  (deftest "curried multiplication — 3 application levels"
    ;; ((mul a) b) c — each level returns a lambda.
    (assert-equal 60
      (cek-eval
        "(do
           (define mul3
             (fn (a) (fn (b) (fn (c) (* a b c)))))
           (((mul3 3) 4) 5))")))

  (deftest "function applied to itself — omega-like (non-diverging)"
    ;; self-apply passes f to f; f ignores its argument and returns a value.
    ;; Tests that call dispatch handles (f f) correctly.
    (assert-equal "done"
      (cek-eval
        "(do
           (define self-apply (fn (f) (f f)))
           (define const-done (fn (anything) \"done\"))
           (self-apply const-done))")))

  (deftest "Y-combinator-like: recursive factorial without define"
    ;; The Z combinator (strict Y) enables self-reference via argument.
    ;; Tests that CEK handles the double-application (f f) correctly.
    (assert-equal 120
      (cek-eval
        "(do
           (define Z
             (fn (f)
               ((fn (x) (f (fn (v) ((x x) v))))
                (fn (x) (f (fn (v) ((x x) v)))))))
           (define fact
             (Z (fn (self)
                  (fn (n)
                    (if (<= n 1) 1 (* n (self (- n 1))))))))
           (fact 5))")))

  (deftest "recursive tree traversal via nested lists"
    ;; A tree is a (value left right) triple or nil leaf.
    ;; Sum all leaf values: (3 (1 nil nil) (2 nil nil)) → 6.
    (assert-equal 6
      (cek-eval
        "(do
           (define tree-sum
             (fn (node)
               (if (nil? node)
                 0
                 (let ((val   (nth node 0))
                       (left  (nth node 1))
                       (right (nth node 2)))
                   (+ val (tree-sum left) (tree-sum right))))))
           (let ((tree
                   (list 3
                     (list 1 nil nil)
                     (list 2 nil nil))))
             (tree-sum tree)))")))

  (deftest "mutual recursion through 3 functions"
    ;; f → g → h → f cycle, counting down to 0.
    ;; Tests that CEK handles cross-name call dispatch across 3 branches.
    (assert-equal "zero"
      (cek-eval
        "(do
           (define f (fn (n) (if (<= n 0) \"zero\" (g (- n 1)))))
           (define g (fn (n) (if (<= n 0) \"zero\" (h (- n 1)))))
           (define h (fn (n) (if (<= n 0) \"zero\" (f (- n 1)))))
           (f 9))")))

  (deftest "higher-order composition pipeline"
    ;; A list of single-arg functions applied in sequence via reduce.
    ;; Tests map + reduce + closure interaction in a single CEK run.
    (assert-equal 30
      (cek-eval
        "(do
           (define pipeline
             (fn (fns init)
               (reduce (fn (acc f) (f acc)) init fns)))
           (let ((steps (list
                          (fn (x) (* x 2))
                          (fn (x) (+ x 5))
                          (fn (x) (* x 2)))))
             (pipeline steps 5)))")))

  (deftest "variable-arity: function ignoring nil-padded extra args"
    ;; Caller provides more args than the param list; excess are ignored.
    ;; The CEK call frame must bind declared params and discard extras.
    (assert-equal 3
      (cek-eval
        "(do
           (define first-two (fn (a b) (+ a b)))
           (first-two 1 2))"))))


;; --------------------------------------------------------------------------
;; 3. Macro interaction
;; --------------------------------------------------------------------------

(defsuite "cek-macro-interaction"
  (deftest "macro that generates an if expression"
    ;; my-unless wraps its condition in (not ...) and emits an if.
    ;; CEK must expand the macro then step through the resulting if form.
    (assert-equal "ran"
      (cek-eval
        "(do
           (defmacro my-unless (cond-expr then-expr)
             \`(if (not ,cond-expr) ,then-expr nil))
           (my-unless false \"ran\"))")))

  (deftest "macro that generates a cond expression"
    ;; pick-label expands to a cond clause tree.
    (assert-equal "medium"
      (cek-eval
        "(do
           (defmacro classify-num (n)
             \`(cond (< ,n 0)  \"negative\"
                    (< ,n 10) \"small\"
                    (< ,n 100) \"medium\"
                    :else      \"large\"))
           (classify-num 42))")))

  (deftest "macro that generates let bindings"
    ;; bind-pair expands to a two-binding let wrapping its body.
    (assert-equal 7
      (cek-eval
        "(do
           (defmacro bind-pair (a av b bv body)
             \`(let ((,a ,av) (,b ,bv)) ,body))
           (bind-pair x 3 y 4 (+ x y)))")))

  (deftest "macro inside macro expansion (chained expansion)"
    ;; outer-mac expands to a call of inner-mac, which is also a macro.
    ;; CEK must re-enter step-eval after each expansion.
    (assert-equal 20
      (cek-eval
        "(do
           (defmacro double-it (x) \`(* ,x 2))
           (defmacro quadruple-it (x) \`(double-it (double-it ,x)))
           (quadruple-it 5))")))

  (deftest "macro with quasiquote and splice in complex position"
    ;; wrap-args splices its rest args into a list call.
    (assert-equal (list 1 2 3 4)
      (cek-eval
        "(do
           (defmacro wrap-args (&rest items)
             \`(list ,@items))
           (wrap-args 1 2 3 4))")))

  (deftest "macro generating a define"
    ;; defconst expands to a define, introducing a binding into env.
    (assert-equal 99
      (cek-eval
        "(do
           (defmacro defconst (name val)
             \`(define ,name ,val))
           (defconst answer 99)
           answer)")))

  (deftest "macro used inside lambda body"
    ;; The macro is expanded each time the lambda is called.
    (assert-equal (list 2 4 6)
      (cek-eval
        "(do
           (defmacro double-it (x) \`(* 2 ,x))
           (let ((double-fn (fn (n) (double-it n))))
             (map double-fn (list 1 2 3))))")))

  (deftest "nested macro call — macro output feeds another macro"
    ;; negate-add: (negate-add a b) → (- (+ a b))
    ;; Expands in two macro steps; CEK must loop through both.
    (assert-equal -7
      (cek-eval
        "(do
           (defmacro my-add (a b) \`(+ ,a ,b))
           (defmacro negate-add (a b) \`(- (my-add ,a ,b)))
           (negate-add 3 4))"))))


;; --------------------------------------------------------------------------
;; 4. Environment stress
;; --------------------------------------------------------------------------

(defsuite "cek-environment-stress"
  (deftest "10 bindings in a single let — all accessible"
    ;; One large let frame; CEK env-extend must handle all 10 at once.
    (assert-equal 55
      (cek-eval
        "(let ((a 1) (b 2) (c 3) (d 4) (e 5)
               (f 6) (g 7) (h 8) (i 9) (j 10))
           (+ a b c d e f g h i j))")))

  (deftest "10 bindings — correct value for each binding"
    ;; Spot-check that the env frame stores each binding at the right slot.
    (assert-equal "ok"
      (cek-eval
        "(let ((v1 \"a\") (v2 \"b\") (v3 \"c\") (v4 \"d\") (v5 \"e\")
               (v6 \"f\") (v7 \"g\") (v8 \"h\") (v9 \"i\") (v10 \"j\"))
           (if (and (= v1 \"a\") (= v5 \"e\") (= v10 \"j\"))
             \"ok\"
             \"fail\"))")))

  (deftest "shadowing chain — x shadows x shadows x (3 levels)"
    ;; After 3 let layers, x == 3; unwinding restores x at each level.
    ;; Inner let must not mutate the outer env frames.
    (assert-equal (list 3 2 1)
      (cek-eval
        "(let ((results (list)))
           (let ((x 1))
             (let ((x 2))
               (let ((x 3))
                 (append! results x))  ;; records 3
               (append! results x))    ;; records 2 after inner unwinds
             (append! results x))      ;; records 1 after middle unwinds
           results)")))

  (deftest "closure capturing 5 variables from enclosing let"
    ;; All 5 captured vars remain accessible after the let exits.
    (assert-equal 150
      (cek-eval
        "(do
           (define make-closure
             (fn ()
               (let ((a 10) (b 20) (c 30) (d 40) (e 50))
                 (fn () (+ a b c d e)))))
           (let ((f (make-closure)))
             (f)))")))

  (deftest "set! visible through 3 closure levels"
    ;; Top-level define → lambda → lambda → lambda modifies top binding.
    ;; CEK set! must walk the env chain and find the outermost slot.
    (assert-equal 999
      (cek-eval
        "(do
           (define shared 0)
           (define make-level1
             (fn ()
               (fn ()
                 (fn ()
                   (set! shared 999)))))
           (let ((level2 (make-level1)))
             (let ((level3 (level2)))
               (level3)))
           shared)")))

  (deftest "define inside let inside define — scope chain"
    ;; outer define → let body → inner define. The inner define mutates
    ;; the env that the let body executes in; later exprs must see it.
    (assert-equal 42
      (cek-eval
        "(do
           (define outer-fn
             (fn (base)
               (let ((step 1))
                 (define result (* base step))
                 (set! result (+ result 1))
                 result)))
           (outer-fn 41))")))

  (deftest "env not polluted across sibling lambda calls"
    ;; Two separate calls to the same lambda must not share param state.
    (assert-equal (list 10 20)
      (cek-eval
        "(do
           (define f (fn (x) (* x 2)))
           (list (f 5) (f 10)))")))

  (deftest "large closure env — 8 closed-over variables"
    ;; A lambda closing over 8 variables; all used in the body.
    (assert-equal 36
      (cek-eval
        "(let ((a 1) (b 2) (c 3) (d 4) (e 5) (f 6) (g 7) (h 8))
           (let ((sum-all (fn () (+ a b c d e f g h))))
             (sum-all)))"))))


;; --------------------------------------------------------------------------
;; 5. Edge cases
;; --------------------------------------------------------------------------

(defsuite "cek-edge-cases"
  (deftest "empty begin/do returns nil"
    ;; The step-sf-begin handler with an empty arg list must yield nil.
    (assert-nil (cek-eval "(do)")))

  (deftest "single-expression begin/do returns value"
    ;; A do with exactly one expression is equivalent to that expression.
    (assert-equal 42 (cek-eval "(do 42)")))

  (deftest "begin/do with side-effecting expressions returns last"
    ;; All intermediate expressions run; only the last value is kept.
    (assert-equal "last"
      (cek-eval "(do \"first\" \"middle\" \"last\")")))

  (deftest "if with only true branch — false path returns nil"
    ;; No else clause: the make-if-frame must default else to nil.
    (assert-nil (cek-eval "(if false 42)")))

  (deftest "if with only true branch — true path returns value"
    (assert-equal 7 (cek-eval "(if true 7)")))

  (deftest "and with all truthy values returns last"
    ;; SX and: short-circuit stops at first falsy; last truthy is returned.
    (assert-equal "c"
      (cek-eval "(and \"a\" \"b\" \"c\")")))

  (deftest "and with leading falsy short-circuits — returns false"
    (assert-false (cek-eval "(and 1 false 3)")))

  (deftest "and with no args returns true"
    (assert-true (cek-eval "(and)")))

  (deftest "or with all falsy returns last falsy"
    ;; SX or: if all falsy, the last falsy value is returned.
    (assert-false (cek-eval "(or false false false)")))

  (deftest "or returns first truthy value"
    (assert-equal 1 (cek-eval "(or false nil 1 2 3)")))

  (deftest "or with no args returns false"
    (assert-false (cek-eval "(or)")))

  (deftest "keyword evaluated as string in call position"
    ;; A keyword in non-call position evaluates to its string name.
    (assert-equal "color"
      (cek-eval "(let ((k :color)) k)")))

  (deftest "keyword as dict key in evaluation context"
    ;; Dict literal with keyword key; the keyword must be converted to
    ;; string so (get d \"color\") succeeds.
    (assert-equal "red"
      (cek-eval
        "(let ((d {:color \"red\"}))
           (get d \"color\"))")))

  (deftest "quote preserves list structure — no evaluation inside"
    ;; (quote (+ 1 2)) must return the list (+ 1 2), not 3.
    (assert-equal 3
      (cek-eval "(len (quote (+ 1 2)))")))

  (deftest "quote preserves nested structure"
    ;; Deeply nested quoted form is returned verbatim as a list tree.
    (assert-equal 2
      (cek-eval "(len (quote (a (b c))))")))

  (deftest "quasiquote with nested unquote"
    ;; `(a ,(+ 1 2) c) → the list (a 3 c).
    (assert-equal 3
      (cek-eval
        "(let ((x (+ 1 2)))
           (nth \`(a ,x c) 1))")))

  (deftest "quasiquote with splice — list flattened into result"
    ;; `(1 ,@(list 2 3) 4) → (1 2 3 4).
    (assert-equal (list 1 2 3 4)
      (cek-eval
        "(let ((mid (list 2 3)))
           \`(1 ,@mid 4))")))

  (deftest "quasiquote with nested unquote-splice at multiple positions"
    ;; Mixed literal and spliced elements across the template.
    (assert-equal (list 0 1 2 3 10 11 12 99)
      (cek-eval
        "(let ((xs (list 1 2 3))
               (ys (list 10 11 12)))
           \`(0 ,@xs ,@ys 99))")))

  (deftest "cond with no matching clause returns nil"
    ;; No branch taken, no :else → nil.
    (assert-nil
      (cek-eval "(cond false \"a\" false \"b\")")))

  (deftest "nested cond: outer selects branch, inner dispatches value"
    ;; Two cond forms nested; CEK must handle the double-dispatch.
    (assert-equal "cold"
      (cek-eval
        "(let ((season \"winter\") (temp -5))
           (cond
             (= season \"winter\")
               (cond (< temp 0) \"cold\"
                     :else      \"cool\")
             (= season \"summer\") \"hot\"
             :else \"mild\"))")))

  (deftest "lambda with no params — nullary function"
    ;; () → 42 via CEK call dispatch with empty arg list.
    (assert-equal 42
      (cek-eval "((fn () 42))")))

  (deftest "immediately invoked lambda with multiple body forms"
    ;; IIFE with a do-style body; last expression is the value.
    (assert-equal 6
      (cek-eval
        "((fn ()
            (define a 1)
            (define b 2)
            (define c 3)
            (+ a b c)))")))

  (deftest "thread-first through 5 steps"
    ;; (-> 1 (+ 1) (* 3) (+ 1) (* 2) (- 2))
    ;; 1+1=2, *3=6, +1=7, *2=14, 14-2=12
    ;; Tests that each -> step creates the correct frame and threads value.
    (assert-equal 12
      (cek-eval "(-> 1 (+ 1) (* 3) (+ 1) (* 2) (- 2))")))

  (deftest "case falls through to :else"
    (assert-equal "unknown"
      (cek-eval "(case 99 1 \"one\" 2 \"two\" :else \"unknown\")")))

  (deftest "case with no :else and no match returns nil"
    (assert-nil (cek-eval "(case 99 1 \"one\" 2 \"two\")")))

  (deftest "when with multiple body forms returns last"
    (assert-equal "last"
      (cek-eval "(when true \"first\" \"middle\" \"last\")")))

  (deftest "when false body not evaluated — no side effects"
    (assert-equal 0
      (cek-eval
        "(do
           (define side-ct 0)
           (when false (set! side-ct 1))
           side-ct)")))

  (deftest "define followed by symbol lookup returns bound value"
    ;; define evaluates its RHS and returns the value.
    ;; The subsequent symbol reference must find the binding in env.
    (assert-equal 7
      (cek-eval "(do (define q 7) q)")))

  (deftest "set! in deeply nested scope updates the correct frame"
    ;; set! inside a 4-level let must find the binding defined at level 1.
    (assert-equal 100
      (cek-eval
        "(let ((target 0))
           (let ((a 1))
             (let ((b 2))
               (let ((c 3))
                 (set! target 100))))
           target)")))

  (deftest "list literal (non-call) evaluated element-wise"
    ;; A list whose head is a number — treated as data list, not a call.
    ;; All elements are evaluated; numbers pass through unchanged.
    (assert-equal 3
      (cek-eval "(len (list 10 20 30))")))

  (deftest "recursive fibonacci — tests non-tail call frame stacking"
    ;; fib(7) = 13. Non-tail recursion stacks O(n) CEK frames; tests
    ;; that the continuation frame list handles deep frame accumulation.
    (assert-equal 13
      (cek-eval
        "(do
           (define fib
             (fn (n)
               (if (< n 2)
                 n
                 (+ (fib (- n 1)) (fib (- n 2))))))
           (fib 7))"))))


;; --------------------------------------------------------------------------
;; 8. Data-first higher-order forms
;; --------------------------------------------------------------------------

(defsuite "data-first-ho"
  (deftest "map — data-first arg order"
    (assert-equal (list 2 4 6)
      (map (list 1 2 3) (fn (x) (* x 2)))))

  (deftest "filter — data-first arg order"
    (assert-equal (list 3 4 5)
      (filter (list 1 2 3 4 5) (fn (x) (> x 2)))))

  (deftest "reduce — data-first arg order"
    (assert-equal 10
      (reduce (list 1 2 3 4) + 0)))

  (deftest "some — data-first arg order"
    (assert-true
      (some (list 1 2 3) (fn (x) (> x 2))))
    (assert-false
      (some (list 1 2 3) (fn (x) (> x 5)))))

  (deftest "every? — data-first arg order"
    (assert-true
      (every? (list 2 4 6) (fn (x) (> x 1))))
    (assert-false
      (every? (list 2 4 6) (fn (x) (> x 3)))))

  (deftest "for-each — data-first arg order"
    (let ((acc (list)))
      (for-each (list 10 20 30)
        (fn (x) (set! acc (append acc (list x)))))
      (assert-equal (list 10 20 30) acc)))

  (deftest "map-indexed — data-first arg order"
    (assert-equal (list "0:a" "1:b" "2:c")
      (map-indexed (list "a" "b" "c")
        (fn (i v) (str i ":" v)))))

  (deftest "fn-first still works — map"
    (assert-equal (list 2 4 6)
      (map (fn (x) (* x 2)) (list 1 2 3))))

  (deftest "fn-first still works — reduce"
    (assert-equal 10
      (reduce + 0 (list 1 2 3 4)))))


;; --------------------------------------------------------------------------
;; 9. Threading with HO forms
;; --------------------------------------------------------------------------

(defsuite "thread-ho"
  (deftest "-> map"
    (assert-equal (list 2 4 6)
      (-> (list 1 2 3) (map (fn (x) (* x 2))))))

  (deftest "-> filter"
    (assert-equal (list 3 4 5)
      (-> (list 1 2 3 4 5) (filter (fn (x) (> x 2))))))

  (deftest "-> filter then map pipeline"
    (assert-equal (list 30 40 50)
      (-> (list 1 2 3 4 5)
          (filter (fn (x) (> x 2)))
          (map (fn (x) (* x 10))))))

  (deftest "-> reduce"
    (assert-equal 15
      (-> (list 1 2 3 4 5) (reduce + 0))))

  (deftest "-> map then reduce"
    (assert-equal 12
      (-> (list 1 2 3)
          (map (fn (x) (* x 2)))
          (reduce + 0))))

  (deftest "-> some"
    (assert-true
      (-> (list 1 2 3) (some (fn (x) (> x 2)))))
    (assert-false
      (-> (list 1 2 3) (some (fn (x) (> x 5))))))

  (deftest "-> every?"
    (assert-true
      (-> (list 2 4 6) (every? (fn (x) (> x 1))))))

  (deftest "-> full pipeline: map filter reduce"
    ;; Double each, keep > 4, sum
    (assert-equal 24
      (-> (list 1 2 3 4 5)
          (map (fn (x) (* x 2)))
          (filter (fn (x) (> x 4)))
          (reduce + 0)))))