rose-ash/lib/kernel/tests/hygiene.sx

;; lib/kernel/tests/hygiene.sx — exercises Phase 6 hygiene helpers.
;;
;; Kernel-on-SX is hygienic by default: $vau/$lambda close over their
;; static env, and bind their formals (plus any $define!s in the body)
;; in a CHILD env. The caller's env is only mutated when user code
;; explicitly threads the env-param through `eval` or `$define-in!`.
;;
;; These tests verify the property, plus the Phase 6 helpers ($let and
;; $define-in!). Shutt's full scope-set hygiene (lifted symbols with
;; provenance markers) is research-grade and is NOT implemented — see
;; the plan's reflective-API notes for the proposed approach.

(define kh-suite (refl-make-test-suite))
(define kh-test  (fn (n a e) (refl-test kh-suite n a e)))

(define kh-eval-in (fn (src env) (kernel-eval (kernel-parse src) env)))

;; ── Default hygiene: $define! inside operative body stays local ─

(kh-test
  "hygiene: vau body $define! doesn't escape"
  (let
    ((env (kernel-standard-env)))
    (kh-eval-in "($define! x 1)" env)
    (kh-eval-in
      "($define! my-op ($vau () _ ($sequence ($define! x 999) x)))"
      env)
    (kh-eval-in "(my-op)" env)
    (kh-eval-in "x" env))
  1)

(kh-test
  "hygiene: vau body $define! visible inside body"
  (let
    ((env (kernel-standard-env)))
    (kh-eval-in "($define! x 1)" env)
    (kh-eval-in
      "($define! my-op ($vau () _ ($sequence ($define! x 999) x)))"
      env)
    (kh-eval-in "(my-op)" env))
  999)

(kh-test
  "hygiene: lambda body $define! doesn't escape"
  (let
    ((env (kernel-standard-env)))
    (kh-eval-in "($define! y 50)" env)
    (kh-eval-in "($define! f ($lambda () ($sequence ($define! y 7) y)))" env)
    (kh-eval-in "(f)" env)
    (kh-eval-in "y" env))
  50)

(kh-test
  "hygiene: caller's binding visible inside operative"
  (let
    ((env (kernel-standard-env)))
    (kh-eval-in "($define! caller-x 88)" env)
    (kh-eval-in "($define! my-op ($vau () _ caller-x))" env)
    (kh-eval-in "(my-op)" env))
  88)

;; ── $let — proper hygienic scoping ──────────────────────────────

(kh-test
  "let: returns body value"
  (kh-eval-in "($let ((x 5)) (+ x 1))" (kernel-standard-env))
  6)

(kh-test
  "let: multiple bindings"
  (kh-eval-in "($let ((x 3) (y 4)) (+ x y))" (kernel-standard-env))
  7)

(kh-test
  "let: bindings shadow outer"
  (let
    ((env (kernel-standard-env)))
    (kh-eval-in "($define! x 1)" env)
    (kh-eval-in "($let ((x 99)) x)" env))
  99)

(kh-test
  "let: bindings don't leak after"
  (let
    ((env (kernel-standard-env)))
    (kh-eval-in "($define! x 1)" env)
    (kh-eval-in "($let ((x 99)) x)" env)
    (kh-eval-in "x" env))
  1)

(kh-test
  "let: parallel — RHS sees outer, not inner"
  (let
    ((env (kernel-standard-env)))
    (kh-eval-in "($define! x 1)" env)
    (kh-eval-in "($let ((x 10) (y x)) y)" env))
  1)

(kh-test
  "let: nested"
  (kh-eval-in "($let ((x 1)) ($let ((y 2)) (+ x y)))" (kernel-standard-env))
  3)

(kh-test
  "let: error on malformed binding"
  (guard
    (e (true :raised))
    (kh-eval-in "($let ((x)) x)" (kernel-standard-env)))
  :raised)

(kh-test
  "let: error on non-symbol name"
  (guard
    (e (true :raised))
    (kh-eval-in "($let ((1 2)) 1)" (kernel-standard-env)))
  :raised)

;; ── $define-in! — explicit env targeting ────────────────────────

(kh-test
  "define-in!: binds in chosen env, not dyn-env"
  (let
    ((env (kernel-standard-env)))
    (kh-eval-in "($define! sandbox (make-environment))" env)
    (kh-eval-in "($define-in! sandbox z 77)" env)
    (kernel-env-has? (kh-eval-in "sandbox" env) "z"))
  true)

(kh-test
  "define-in!: doesn't pollute caller"
  (let
    ((env (kernel-standard-env)))
    (kh-eval-in "($define! sandbox (make-environment))" env)
    (kh-eval-in "($define-in! sandbox z 77)" env)
    (kernel-env-has? env "z"))
  false)

(kh-test
  "define-in!: error on non-env target"
  (guard
    (e (true :raised))
    (let
      ((env (kernel-standard-env)))
      (kh-eval-in "($define-in! 42 x 1)" env)))
  :raised)

;; ── Closure does NOT see post-definition caller binds ───────────
;; The classic "lexical scope wins over dynamic" test.

(kh-test
  "lexical: closure sees its own static env"
  (let
    ((env (kernel-standard-env)))
    (kh-eval-in "($define! x 1)" env)
    (kh-eval-in "($define! get-x ($lambda () x))" env)
    (kh-eval-in "($define! x 999)" env)
    (kh-eval-in "(get-x)" env))
  999)

(kh-test
  "lexical: $let-bound name invisible outside"
  (guard
    (e (true :raised))
    (let
      ((env (kernel-standard-env)))
      (kh-eval-in "($let ((private 42)) private)" env)
      (kh-eval-in "private" env)))
  :raised)

;; ── Operative + $let: hygiene compose ───────────────────────────

(kh-test
  "let-inside-vau: temp doesn't escape body"
  (let
    ((env (kernel-standard-env)))
    (kh-eval-in "($define! x 1)" env)
    (kh-eval-in "($define! op ($vau () _ ($let ((x 5)) x)))" env)
    (kh-eval-in "(op)" env)
    (kh-eval-in "x" env))
  1)

;; ── $let* — sequential let ──────────────────────────────────────
(kh-test "let*: empty bindings"
  (kh-eval-in "($let* () 42)" (kernel-standard-env)) 42)
(kh-test "let*: single binding"
  (kh-eval-in "($let* ((x 5)) (+ x 1))" (kernel-standard-env)) 6)
(kh-test "let*: later sees earlier"
  (kh-eval-in "($let* ((x 1) (y (+ x 1)) (z (+ y 1))) z)"
              (kernel-standard-env)) 3)
(kh-test "let*: bindings don't leak after"
  (let ((env (kernel-standard-env)))
    (kh-eval-in "($define! x 1)" env)
    (kh-eval-in "($let* ((x 99) (y (+ x 1))) y)" env)
    (kh-eval-in "x" env)) 1)
(kh-test "let*: same-name later binding shadows earlier"
  (kh-eval-in "($let* ((x 1) (x 2)) x)" (kernel-standard-env)) 2)
(kh-test "let*: multi-expression body"
  (kh-eval-in "($let* ((x 5)) ($define! double (+ x x)) double)"
              (kernel-standard-env)) 10)
(kh-test "let*: error on malformed binding"
  (guard (e (true :raised))
    (kh-eval-in "($let* ((x)) x)" (kernel-standard-env)))
  :raised)
(kh-test "let: multi-body"
  (kh-eval-in "($let ((x 5)) ($define! tmp (+ x 1)) tmp)"
              (kernel-standard-env)) 6)

(define kh-tests-run! (fn () (refl-test-report kh-suite)))