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-test-pass 0)
(define kh-test-fail 0)
(define kh-test-fails (list))

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

(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)

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