;; lib/kernel/tests/eval.sx — exercises lib/kernel/eval.sx.
;;
;; Phase 2 covers literal evaluation, symbol lookup, and combiner
;; dispatch (operative vs applicative). Standard-environment operatives
;; ($if, $define!, $lambda, …) arrive in Phase 4, so tests build a
;; minimal env on the fly and verify the dispatch contract directly.

(define ke-test-pass 0)
(define ke-test-fail 0)
(define ke-test-fails (list))

(define
  ke-test
  (fn
    (name actual expected)
    (if
      (= actual expected)
      (set! ke-test-pass (+ ke-test-pass 1))
      (begin
        (set! ke-test-fail (+ ke-test-fail 1))
        (append! ke-test-fails {:name name :actual actual :expected expected})))))

;; ── helpers ──────────────────────────────────────────────────────

(define ke-eval-src (fn (src env) (kernel-eval (kernel-parse src) env)))

(define
  ke-make-test-env
  (fn
    ()
    (let
      ((env (kernel-make-env)))
      (kernel-env-bind!
        env
        "+"
        (kernel-make-primitive-applicative
          (fn (args) (+ (first args) (nth args 1)))))
      (kernel-env-bind!
        env
        "list"
        (kernel-make-primitive-applicative (fn (args) args)))
      (kernel-env-bind!
        env
        "$quote"
        (kernel-make-primitive-operative (fn (args dyn-env) (first args))))
      (kernel-env-bind!
        env
        "$if"
        (kernel-make-primitive-operative
          (fn
            (args dyn-env)
            (if
              (kernel-eval (first args) dyn-env)
              (kernel-eval (nth args 1) dyn-env)
              (kernel-eval (nth args 2) dyn-env)))))
      env)))

;; ── literal evaluation ───────────────────────────────────────────
(ke-test "lit: number" (ke-eval-src "42" (kernel-make-env)) 42)
(ke-test "lit: zero" (ke-eval-src "0" (kernel-make-env)) 0)
(ke-test "lit: float" (ke-eval-src "3.14" (kernel-make-env)) 3.14)
(ke-test "lit: true" (ke-eval-src "#t" (kernel-make-env)) true)
(ke-test "lit: false" (ke-eval-src "#f" (kernel-make-env)) false)
(ke-test "lit: string" (ke-eval-src "\"hello\"" (kernel-make-env)) "hello")
(ke-test "lit: empty list" (ke-eval-src "()" (kernel-make-env)) (list))

;; ── symbol lookup ────────────────────────────────────────────────
(ke-test
  "sym: bound to number"
  (let
    ((env (kernel-make-env)))
    (kernel-env-bind! env "x" 100)
    (ke-eval-src "x" env))
  100)

(ke-test
  "sym: bound to string"
  (let
    ((env (kernel-make-env)))
    (kernel-env-bind! env "name" "kernel")
    (ke-eval-src "name" env))
  "kernel")

(ke-test
  "sym: parent-chain lookup"
  (let
    ((p (kernel-make-env)))
    (kernel-env-bind! p "outer" 1)
    (let
      ((c (kernel-extend-env p)))
      (kernel-env-bind! c "inner" 2)
      (+ (ke-eval-src "outer" c) (ke-eval-src "inner" c))))
  3)

(ke-test
  "sym: child shadows parent"
  (let
    ((p (kernel-make-env)))
    (kernel-env-bind! p "x" 1)
    (let
      ((c (kernel-extend-env p)))
      (kernel-env-bind! c "x" 2)
      (ke-eval-src "x" c)))
  2)

(ke-test
  "env-has?: present"
  (let
    ((env (kernel-make-env)))
    (kernel-env-bind! env "x" 1)
    (kernel-env-has? env "x"))
  true)

(ke-test
  "env-has?: missing"
  (kernel-env-has? (kernel-make-env) "nope")
  false)

;; ── tagged-value predicates ─────────────────────────────────────
(ke-test
  "tag: operative?"
  (kernel-operative? (kernel-make-primitive-operative (fn (a e) nil)))
  true)

(ke-test
  "tag: applicative?"
  (kernel-applicative? (kernel-make-primitive-applicative (fn (a) nil)))
  true)

(ke-test
  "tag: combiner? operative"
  (kernel-combiner? (kernel-make-primitive-operative (fn (a e) nil)))
  true)

(ke-test
  "tag: combiner? applicative"
  (kernel-combiner? (kernel-make-primitive-applicative (fn (a) nil)))
  true)

(ke-test "tag: combiner? number" (kernel-combiner? 42) false)

(ke-test "tag: number is not operative" (kernel-operative? 42) false)

;; ── wrap / unwrap ────────────────────────────────────────────────
(ke-test
  "wrap+unwrap roundtrip"
  (let
    ((op (kernel-make-primitive-operative (fn (a e) :sentinel))))
    (= (kernel-unwrap (kernel-wrap op)) op))
  true)

(ke-test
  "wrap produces applicative"
  (kernel-applicative?
    (kernel-wrap (kernel-make-primitive-operative (fn (a e) nil))))
  true)

(ke-test
  "unwrap of primitive-applicative is operative"
  (kernel-operative?
    (kernel-unwrap (kernel-make-primitive-applicative (fn (a) nil))))
  true)

;; ── combiner dispatch — applicatives evaluate their args ─────────
(ke-test
  "applicative: simple call"
  (ke-eval-src "(+ 2 3)" (ke-make-test-env))
  5)

(ke-test
  "applicative: nested"
  (ke-eval-src "(+ (+ 1 2) (+ 3 4))" (ke-make-test-env))
  10)

(ke-test
  "applicative: receives evaluated args"
  (let
    ((env (ke-make-test-env)))
    (kernel-env-bind! env "x" 10)
    (kernel-env-bind! env "y" 20)
    (ke-eval-src "(+ x y)" env))
  30)

(ke-test
  "applicative: list builds an SX list of values"
  (let
    ((env (ke-make-test-env)))
    (kernel-env-bind! env "a" 1)
    (kernel-env-bind! env "b" 2)
    (ke-eval-src "(list a b 99)" env))
  (list 1 2 99))

;; ── combiner dispatch — operatives DO NOT evaluate their args ───
(ke-test
  "operative: $quote returns symbol unevaluated"
  (ke-eval-src "($quote foo)" (ke-make-test-env))
  "foo")

(ke-test
  "operative: $quote returns list unevaluated"
  (ke-eval-src "($quote (+ 1 2))" (ke-make-test-env))
  (list "+" 1 2))

(ke-test
  "operative: $if true branch"
  (ke-eval-src "($if #t 1 2)" (ke-make-test-env))
  1)

(ke-test
  "operative: $if false branch"
  (ke-eval-src "($if #f 1 2)" (ke-make-test-env))
  2)

(ke-test
  "operative: $if doesn't eval untaken branch"
  (ke-eval-src "($if #t 99 unbound)" (ke-make-test-env))
  99)

(ke-test
  "operative: $if takes dynamic env for branches"
  (let
    ((env (ke-make-test-env)))
    (kernel-env-bind! env "x" 7)
    (ke-eval-src "($if #t x 0)" env))
  7)

;; ── operative built ON-THE-FLY can inspect raw expressions ──────
(ke-test
  "operative: sees raw symbol head"
  (let
    ((env (kernel-make-env)))
    (kernel-env-bind!
      env
      "head"
      (kernel-make-primitive-operative (fn (args dyn-env) (first args))))
    (ke-eval-src "(head (+ 1 2))" env))
  (list "+" 1 2))

(ke-test
  "operative: sees dynamic env"
  (let
    ((env (kernel-make-env)))
    (kernel-env-bind! env "x" 999)
    (kernel-env-bind!
      env
      "$probe"
      (kernel-make-primitive-operative
        (fn (args dyn-env) (kernel-env-lookup dyn-env "x"))))
    (ke-eval-src "($probe ignored)" env))
  999)

;; ── error cases ──────────────────────────────────────────────────
(ke-test
  "error: unbound symbol"
  (guard
    (e (true :raised))
    (kernel-eval (kernel-parse "nope") (kernel-make-env)))
  :raised)

(ke-test
  "error: combine non-combiner"
  (guard
    (e (true :raised))
    (let
      ((env (kernel-make-env)))
      (kernel-env-bind! env "x" 42)
      (kernel-eval (kernel-parse "(x 1)") env)))
  :raised)

(define ke-tests-run! (fn () {:total (+ ke-test-pass ke-test-fail) :passed ke-test-pass :failed ke-test-fail :fails ke-test-fails}))