;; lib/scheme/tests/eval.sx — exercises lib/scheme/eval.sx (Phase 2).

(define scm-eval-pass 0)
(define scm-eval-fail 0)
(define scm-eval-fails (list))

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

(define scm-eval-src (fn (src env) (scheme-eval (scheme-parse src) env)))

;; A toy env with arithmetic + list primitives.
(define
  scm-test-env
  (fn
    ()
    (let
      ((env (scheme-make-env)))
      (scheme-env-bind!
        env
        "+"
        (fn (args) (+ (first args) (nth args 1))))
      (scheme-env-bind!
        env
        "-"
        (fn (args) (- (first args) (nth args 1))))
      (scheme-env-bind!
        env
        "*"
        (fn (args) (* (first args) (nth args 1))))
      (scheme-env-bind! env "list" (fn (args) args))
      env)))

;; ── self-evaluating ──────────────────────────────────────────────
(scm-eval-test
  "lit: integer"
  (scm-eval-src "42" (scheme-make-env))
  42)
(scm-eval-test "lit: float" (scm-eval-src "3.14" (scheme-make-env)) 3.14)
(scm-eval-test "lit: #t" (scm-eval-src "#t" (scheme-make-env)) true)
(scm-eval-test "lit: #f" (scm-eval-src "#f" (scheme-make-env)) false)
(scm-eval-test
  "lit: empty list"
  (scm-eval-src "()" (scheme-make-env))
  (list))
(scm-eval-test
  "lit: string"
  (scheme-string? (scm-eval-src "\"hello\"" (scheme-make-env)))
  true)
(scm-eval-test
  "lit: char"
  (scheme-char? (scm-eval-src "#\\a" (scheme-make-env)))
  true)
(scm-eval-test
  "lit: vector"
  (scheme-vector? (scm-eval-src "#(1 2 3)" (scheme-make-env)))
  true)

;; ── symbol lookup ────────────────────────────────────────────────
(scm-eval-test
  "sym: bound"
  (let
    ((env (scheme-make-env)))
    (scheme-env-bind! env "x" 100)
    (scm-eval-src "x" env))
  100)
(scm-eval-test
  "sym: parent chain"
  (let
    ((p (scheme-make-env)))
    (scheme-env-bind! p "outer" 1)
    (let
      ((c (scheme-extend-env p)))
      (scheme-env-bind! c "inner" 2)
      (+ (scm-eval-src "outer" c) (scm-eval-src "inner" c))))
  3)
(scm-eval-test
  "sym: shadowing"
  (let
    ((p (scheme-make-env)))
    (scheme-env-bind! p "x" 1)
    (let
      ((c (scheme-extend-env p)))
      (scheme-env-bind! c "x" 2)
      (scm-eval-src "x" c)))
  2)

;; ── quote ────────────────────────────────────────────────────────
(scm-eval-test
  "quote: symbol"
  (scm-eval-src "(quote foo)" (scheme-make-env))
  "foo")
(scm-eval-test
  "quote: list"
  (scm-eval-src "(quote (+ 1 2))" (scheme-make-env))
  (list "+" 1 2))
(scm-eval-test "quote: sugar 'x" (scm-eval-src "'x" (scheme-make-env)) "x")
(scm-eval-test
  "quote: sugar list"
  (scm-eval-src "'(a b c)" (scheme-make-env))
  (list "a" "b" "c"))
(scm-eval-test
  "quote: nested"
  (scm-eval-src "''x" (scheme-make-env))
  (list "quote" "x"))

;; ── primitive application ────────────────────────────────────────
(scm-eval-test "prim: +" (scm-eval-src "(+ 2 3)" (scm-test-env)) 5)
(scm-eval-test
  "prim: nested +"
  (scm-eval-src "(+ (+ 1 2) (+ 3 4))" (scm-test-env))
  10)
(scm-eval-test
  "prim: mixed ops"
  (scm-eval-src "(- (* 4 5) (+ 3 2))" (scm-test-env))
  15)
(scm-eval-test
  "prim: list builds SX list"
  (scm-eval-src "(list 1 2 3)" (scm-test-env))
  (list 1 2 3))
(scm-eval-test
  "prim: args eval in order"
  (let
    ((env (scm-test-env)))
    (scheme-env-bind! env "a" 10)
    (scheme-env-bind! env "b" 20)
    (scm-eval-src "(+ a b)" env))
  30)

;; ── env-as-value (the third-consumer demonstration) ─────────────
;; Scheme's env IS lib/guest/reflective/env.sx's canonical wire shape
;; with no adapter cfg. Verify the kit primitives work directly.
(scm-eval-test
  "env: refl-env? on Scheme env"
  (refl-env? (scheme-make-env))
  true)
(scm-eval-test
  "env: lookup via kit"
  (let
    ((env (scheme-make-env)))
    (refl-env-bind! env "name" "scheme")
    (refl-env-lookup env "name"))
  "scheme")
(scm-eval-test
  "env: find-frame walks parent"
  (let
    ((p (scheme-make-env)))
    (refl-env-bind! p "root-binding" 99)
    (let
      ((c (scheme-extend-env p)))
      (= (refl-env-find-frame c "root-binding") p)))
  true)

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