;; lib/scheme/tests/reflection.sx — Phase 7 reflective primitives.

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

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

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

(define
  scm-ref-all
  (fn
    (src)
    (scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))

;; ── eval ─────────────────────────────────────────────────────────

(scm-ref-test
  "eval: arithmetic"
  (scm-ref "(eval '(+ 1 2 3) (interaction-environment))")
  6)
(scm-ref-test
  "eval: nested"
  (scm-ref "(eval '(* (+ 1 2) (- 5 1)) (interaction-environment))")
  12)
(scm-ref-test
  "eval: constructed form"
  (scm-ref "(eval (list '+ 10 20) (interaction-environment))")
  30)
(scm-ref-test
  "eval: variable reference"
  (scm-ref-all "(define x 42) (eval 'x (interaction-environment))")
  42)

;; ── interaction-environment ─────────────────────────────────────

(scm-ref-test
  "interaction-environment: is an env"
  (scm-ref "(environment? (interaction-environment))")
  true)
(scm-ref-test
  "interaction-environment: define persists"
  (scm-ref-all
    "(define ie (interaction-environment))\n     (eval '(define stashed 99) ie)\n     (eval 'stashed ie)")
  99)
(scm-ref-test
  "interaction-environment: same env across calls"
  (scm-ref-all
    "(define a (interaction-environment))\n     (define b (interaction-environment))\n     (eqv? a b)")
  true)

;; ── null-environment ────────────────────────────────────────────

(scm-ref-test
  "null-environment: is an env"
  (scm-ref "(environment? (null-environment 7))")
  true)
(scm-ref-test
  "null-environment: has no + binding"
  (scm-ref-all
    "(define ne (null-environment 7))\n     (guard (e (else 'unbound)) (eval '+ ne))")
  "unbound")

;; ── scheme-report-environment ───────────────────────────────────

(scm-ref-test
  "scheme-report-environment: is an env"
  (scm-ref "(environment? (scheme-report-environment 7))")
  true)
(scm-ref-test
  "scheme-report-environment: has +"
  (scm-ref "(eval '(+ 1 2) (scheme-report-environment 7))")
  3)
(scm-ref-test
  "scheme-report-environment: distinct from interaction"
  (scm-ref-all
    "(define ie (interaction-environment))\n     (define re (scheme-report-environment 7))\n     (eval '(define only-in-ie 1) ie)\n     (guard (e (else 'unbound)) (eval 'only-in-ie re))")
  "unbound")

;; ── eval with explicit env for sandboxing ──────────────────────

(scm-ref-test
  "eval: sandbox with null-environment"
  (scm-ref-all
    "(define sandbox (null-environment 7))\n     (guard (e (else 'unbound))\n       (eval '(+ 1 1) sandbox))")
  "unbound")

;; ── quasiquote / unquote / unquote-splicing ─────────────────────
(scm-ref-test "qq: plain atom"
  (scm-ref "`hello") "hello")
(scm-ref-test "qq: plain list"
  (scm-ref "`(a b c)") (list "a" "b" "c"))
(scm-ref-test "qq: unquote substitutes value"
  (scm-ref-all "(define x 42) `(a ,x b)")
  (list "a" 42 "b"))
(scm-ref-test "qq: unquote-splicing splices list"
  (scm-ref-all "(define xs '(1 2 3)) `(a ,@xs b)")
  (list "a" 1 2 3 "b"))
(scm-ref-test "qq: splice at start"
  (scm-ref-all "(define xs '(1 2)) `(,@xs c)")
  (list 1 2 "c"))
(scm-ref-test "qq: splice at end"
  (scm-ref-all "(define xs '(9 8)) `(a b ,@xs)")
  (list "a" "b" 9 8))
(scm-ref-test "qq: nested list with unquote"
  (scm-ref-all "(define x 5) `(a (b ,x) c)")
  (list "a" (list "b" 5) "c"))
(scm-ref-test "qq: unquote evaluates expression"
  (scm-ref "`(a ,(+ 1 2) b)")
  (list "a" 3 "b"))
(scm-ref-test "qq: error on splicing non-list"
  (scm-ref-all
    "(define x 42) (guard (e (else 'raised)) `(a ,@x b))")
  "raised")
(scm-ref-test "qq: bare unquote at top level errors"
  (scm-ref "(guard (e (else 'raised)) (unquote 5))") "raised")

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