;; ==========================================================================
;; test-advanced.sx — Tests for advanced evaluation patterns
;;
;; Requires: test-framework.sx loaded first.
;; Modules tested: eval.sx (nested forms, higher-order patterns, define,
;;                 quasiquote, thread-first, letrec, case/cond)
;; ==========================================================================


;; --------------------------------------------------------------------------
;; Nested special forms
;; --------------------------------------------------------------------------

(defsuite "nested-special-forms"
  (deftest "let inside let"
    (let ((x 1))
      (let ((y (let ((z 10)) (+ x z))))
        (assert-equal 11 y))))

  (deftest "if inside let"
    (let ((flag true)
          (result (if true "yes" "no")))
      (assert-equal "yes" result))
    (let ((result (if false "yes" "no")))
      (assert-equal "no" result)))

  (deftest "let inside if"
    (assert-equal 15
      (if true
        (let ((a 5) (b 10)) (+ a b))
        0))
    (assert-equal 0
      (if false
        99
        (let ((x 0)) x))))

  (deftest "cond inside let"
    (let ((n 2)
          (label (cond (= 2 1) "one"
                       (= 2 2) "two"
                       :else   "other")))
      (assert-equal "two" label)))

  (deftest "when inside when (nested conditional)"
    ;; Inner when only runs when outer when runs
    (let ((result "none"))
      (when true
        (when true
          (set! result "both")))
      (assert-equal "both" result))
    (let ((result "none"))
      (when true
        (when false
          (set! result "inner")))
      (assert-equal "none" result))
    (let ((result "none"))
      (when false
        (when true
          (set! result "inner")))
      (assert-equal "none" result)))

  (deftest "do inside let body"
    (let ((x 0))
      (do
        (set! x (+ x 1))
        (set! x (+ x 1))
        (set! x (+ x 1)))
      (assert-equal 3 x)))

  (deftest "let inside map callback"
    ;; Each map iteration creates its own let scope
    (let ((result (map (fn (x)
                         (let ((doubled (* x 2))
                               (label (str "item-" x)))
                           (str label "=" doubled)))
                       (list 1 2 3))))
      (assert-equal "item-1=2" (nth result 0))
      (assert-equal "item-2=4" (nth result 1))
      (assert-equal "item-3=6" (nth result 2)))))


;; --------------------------------------------------------------------------
;; Higher-order patterns
;; --------------------------------------------------------------------------

(defsuite "higher-order-patterns"
  (deftest "map then filter (pipeline)"
    ;; Double each number, then keep only those > 4
    (let ((result (filter (fn (x) (> x 4))
                          (map (fn (x) (* x 2)) (list 1 2 3 4 5)))))
      (assert-equal (list 6 8 10) result)))

  (deftest "filter then map"
    ;; Keep odd numbers, then square them
    (let ((result (map (fn (x) (* x x))
                       (filter (fn (x) (= (mod x 2) 1)) (list 1 2 3 4 5)))))
      (assert-equal (list 1 9 25) result)))

  (deftest "reduce to build a dict"
    ;; Build a word-length dict from a list of strings
    (let ((result (reduce
                    (fn (acc s) (assoc acc s (string-length s)))
                    {}
                    (list "a" "bb" "ccc"))))
      (assert-equal 1 (get result "a"))
      (assert-equal 2 (get result "bb"))
      (assert-equal 3 (get result "ccc"))))

  (deftest "map returning lambdas, then calling them"
    ;; Produce a list of adder functions; call each with 10
    (let ((adders (map (fn (n) (fn (x) (+ n x))) (list 1 2 3)))
          (results (list)))
      (for-each
        (fn (f) (append! results (f 10)))
        adders)
      (assert-equal (list 11 12 13) results)))

  (deftest "nested map (map of map)"
    (let ((matrix (list (list 1 2) (list 3 4) (list 5 6)))
          (result (map (fn (row) (map (fn (x) (* x 10)) row)) matrix)))
      (assert-equal (list 10 20) (nth result 0))
      (assert-equal (list 30 40) (nth result 1))
      (assert-equal (list 50 60) (nth result 2))))

  (deftest "for-each with side effect (set! counter)"
    (define fe-counter 0)
    (for-each
      (fn (x) (set! fe-counter (+ fe-counter x)))
      (list 1 2 3 4 5))
    ;; 1+2+3+4+5 = 15
    (assert-equal 15 fe-counter)))


;; --------------------------------------------------------------------------
;; Define patterns
;; --------------------------------------------------------------------------

(defsuite "define-patterns"
  (deftest "define inside let body"
    ;; define inside a let body is visible in subsequent let body expressions
    (let ((x 5))
      (define y (* x 2))
      (assert-equal 10 y)))

  (deftest "define inside do block"
    (do
      (define do-val 42)
      (assert-equal 42 do-val)))

  (deftest "define function then call it"
    (define square (fn (n) (* n n)))
    (assert-equal 9  (square 3))
    (assert-equal 25 (square 5))
    (assert-equal 0  (square 0)))

  (deftest "redefine a name (second define overwrites first)"
    (define redef-x 1)
    (assert-equal 1 redef-x)
    (define redef-x 99)
    (assert-equal 99 redef-x))

  (deftest "define with computed value"
    (define base 7)
    (define derived (* base 6))
    (assert-equal 42 derived)))


;; --------------------------------------------------------------------------
;; Quasiquote advanced
;; --------------------------------------------------------------------------

(defsuite "quasiquote-advanced"
  (deftest "quasiquote with multiple unquotes"
    (let ((a 1) (b 2) (c 3))
      (assert-equal (list 1 2 3) `(,a ,b ,c))
      (assert-equal (list 10 2 30) `(,(* a 10) ,b ,(* c 10)))))

  (deftest "unquote-splicing at start of list"
    (let ((prefix (list 1 2 3)))
      (assert-equal (list 1 2 3 4 5) `(,@prefix 4 5))))

  (deftest "unquote-splicing at end of list"
    (let ((suffix (list 3 4 5)))
      (assert-equal (list 1 2 3 4 5) `(1 2 ,@suffix))))

  (deftest "unquote inside nested list"
    (let ((x 42))
      ;; The inner list contains an unquote — it should still be spliced
      (let ((result `(a (b ,x) c)))
        (assert-length 3 result)
        (assert-equal 42 (nth (nth result 1) 1)))))

  (deftest "quasiquote preserving structure"
    ;; A quasiquoted form with no unquotes is identical to the quoted form
    (let ((q `(fn (a b) (+ a b))))
      (assert-type "list" q)
      (assert-length 3 q)
      ;; First element is the symbol fn
      (assert-true (equal? (sx-parse-one "fn") (first q)))
      ;; Body is (+ a b) — a 3-element list
      (assert-length 3 (nth q 2)))))


;; --------------------------------------------------------------------------
;; Thread-first
;; --------------------------------------------------------------------------

(defsuite "thread-first"
  (deftest "simple thread through arithmetic"
    ;; (-> 5 (+ 1) (* 2)) = (5+1)*2 = 12
    (assert-equal 12 (-> 5 (+ 1) (* 2))))

  (deftest "thread with string ops"
    (assert-equal "HELLO" (-> "hello" upcase))
    (assert-equal "hello" (-> "HELLO" downcase)))

  (deftest "thread with multiple steps"
    ;; (-> 1 (+ 1) (+ 1) (+ 1) (+ 1)) = 5
    (assert-equal 5 (-> 1 (+ 1) (+ 1) (+ 1) (+ 1)))
    ;; (-> 100 (- 10) (/ 2) (+ 5)) = (100-10)/2+5 = 50
    (assert-equal 50 (-> 100 (- 10) (/ 2) (+ 5))))

  (deftest "thread through list ops"
    ;; Build list, reverse, take first
    (assert-equal 3 (-> (list 1 2 3) reverse first))
    ;; Append then get length
    (assert-equal 5 (-> (list 1 2 3) (append (list 4 5)) len))))


;; --------------------------------------------------------------------------
;; letrec
;; --------------------------------------------------------------------------

(defsuite "letrec"
  (deftest "simple letrec with self-reference"
    ;; A single binding that calls itself recursively
    (letrec ((count-down (fn (n)
                           (if (<= n 0)
                             "done"
                             (count-down (- n 1))))))
      (assert-equal "done" (count-down 5))))

  (deftest "mutual recursion in letrec"
    (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? 4))
      (assert-false (my-even? 3))
      (assert-true  (my-odd?  3))
      (assert-false (my-odd?  4))))

  (deftest "letrec fibonacci"
    (letrec ((fib (fn (n)
                    (if (< n 2)
                      n
                      (+ (fib (- n 1)) (fib (- n 2)))))))
      (assert-equal 0  (fib 0))
      (assert-equal 1  (fib 1))
      (assert-equal 1  (fib 2))
      (assert-equal 8  (fib 6))
      (assert-equal 55 (fib 10))))

  (deftest "letrec with non-recursive values too"
    ;; letrec can hold plain values alongside recursive fns
    (letrec ((base   10)
             (triple (fn (n) (* n 3)))
             (result (fn () (triple base))))
      (assert-equal 10 base)
      (assert-equal 6  (triple 2))
      (assert-equal 30 (result)))))


;; --------------------------------------------------------------------------
;; case and cond
;; --------------------------------------------------------------------------

(defsuite "case-cond"
  (deftest "case with string matching"
    (define color-label
      (fn (c)
        (case c
          "red"   "warm"
          "blue"  "cool"
          "green" "natural"
          :else   "unknown")))
    (assert-equal "warm"    (color-label "red"))
    (assert-equal "cool"    (color-label "blue"))
    (assert-equal "natural" (color-label "green"))
    (assert-equal "unknown" (color-label "purple")))

  (deftest "case with number matching"
    (define grade
      (fn (n)
        (case n
          1 "one"
          2 "two"
          3 "three"
          :else "many")))
    (assert-equal "one"   (grade 1))
    (assert-equal "two"   (grade 2))
    (assert-equal "three" (grade 3))
    (assert-equal "many"  (grade 99)))

  (deftest "case :else fallthrough"
    (assert-equal "fallback"
      (case "unrecognised"
        "a" "alpha"
        "b" "beta"
        :else "fallback")))

  (deftest "case no match returns nil"
    (assert-nil
      (case "x"
        "a" "alpha"
        "b" "beta")))

  (deftest "cond with multiple predicates"
    (define classify
      (fn (n)
        (cond (< n 0)  "negative"
              (= n 0)  "zero"
              (< n 10) "small"
              :else    "large")))
    (assert-equal "negative" (classify -5))
    (assert-equal "zero"     (classify 0))
    (assert-equal "small"    (classify 7))
    (assert-equal "large"    (classify 100)))

  (deftest "cond with (= x val) predicate style"
    (let ((x "b"))
      (assert-equal "beta"
        (cond (= x "a") "alpha"
              (= x "b") "beta"
              (= x "c") "gamma"
              :else      "other"))))

  (deftest "cond :else"
    (assert-equal "default"
      (cond false "nope"
            false "also-nope"
            :else "default")))

  (deftest "cond all false returns nil"
    (assert-nil
      (cond false "a"
            false "b"
            false "c")))

  (deftest "nested cond/case"
    ;; cond selects a branch, that branch uses case
    (define describe
      (fn (kind val)
        (cond (= kind "color")
                (case val
                  "r" "red"
                  "g" "green"
                  "b" "blue"
                  :else "unknown-color")
              (= kind "size")
                (case val
                  "s" "small"
                  "l" "large"
                  :else "unknown-size")
              :else "unknown-kind")))
    (assert-equal "red"          (describe "color" "r"))
    (assert-equal "green"        (describe "color" "g"))
    (assert-equal "unknown-color" (describe "color" "x"))
    (assert-equal "small"        (describe "size"  "s"))
    (assert-equal "large"        (describe "size"  "l"))
    (assert-equal "unknown-kind" (describe "other" "?"))))