kernel: Phase 6 hygiene — $let + $define-in! + 18 tests [shapes-reflective]

Hygiene-by-default was already present: user operatives close over
static-env and bind formals + body $define!s in (extend STATIC-ENV),
caller's env untouched. $let evaluates values in caller env, binds
in fresh child env, runs body there. $define-in! explicitly targets
an env. Full scope-set / frame-stamp hygiene is research-grade
and documented as deferred future work in the reflective API notes.

lib/kernel/runtime.sx

@@ -376,6 +376,78 @@
 (define kernel-make-encap-type-applicative
   (kernel-make-primitive-applicative kernel-make-encap-type-impl))
 
+;; ── Hygiene: $let, $define-in!, make-environment ────────────────
+;;
+;; Kernel-on-SX is hygienic *by default* because user-defined operatives
+;; (Phase 3) bind their formals + any $define! in a CHILD env extending
+;; the operative's static-env, never the dyn-env. The caller's env is
+;; only mutated when code explicitly says so (e.g. `(eval expr env-arg)`).
+;;
+;; Phase 6 adds two helpers that make the property easy to lean on:
+;;
+;;   ($let ((NAME EXPR) ...) BODY)
+;;     Evaluates each EXPR in the calling env, binds NAME in a fresh
+;;     child env, evaluates BODY in that child env. NAMES don't leak.
+;;
+;;   ($define-in! ENV NAME EXPR)
+;;     Binds NAME=value-of-EXPR in the *specified* env, not the dyn-env.
+;;     Useful for operatives that need to mutate a sandbox env without
+;;     touching their caller's env.
+;;
+;; Shutt's full scope-set / frame-stamp hygiene (lifted symbols carrying
+;; provenance markers so introduced bindings can shadow without
+;; capturing) is research-grade and not implemented here. Notes for
+;; `lib/guest/reflective/hygiene.sx` candidate API below the std env.
+
+(define knl-bind-let-vals!
+  (fn (local bindings dyn-env)
+    (cond
+      ((or (nil? bindings) (= (length bindings) 0)) nil)
+      (:else
+        (let ((b (first bindings)))
+          (cond
+            ((not (and (list? b) (= (length b) 2)))
+              (error "$let: each binding must be (name expr)"))
+            ((not (string? (first b)))
+              (error "$let: binding name must be a symbol"))
+            (:else
+              (begin
+                (kernel-env-bind! local
+                                  (first b)
+                                  (kernel-eval (nth b 1) dyn-env))
+                (knl-bind-let-vals! local (rest bindings) dyn-env)))))))))
+
+(define kernel-let-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 2))
+          (error "$let: expects (bindings body)"))
+        ((not (list? (first args)))
+          (error "$let: bindings must be a list"))
+        (:else
+          (let ((local (kernel-extend-env dyn-env)))
+            (knl-bind-let-vals! local (first args) dyn-env)
+            (kernel-eval (nth args 1) local)))))))
+
+(define kernel-define-in!-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 3))
+          (error "$define-in!: expects (env-expr name expr)"))
+        ((not (string? (nth args 1)))
+          (error "$define-in!: name must be a symbol"))
+        (:else
+          (let ((target (kernel-eval (first args) dyn-env)))
+            (cond
+              ((not (kernel-env? target))
+                (error "$define-in!: first arg must evaluate to an env"))
+              (:else
+                (let ((v (kernel-eval (nth args 2) dyn-env)))
+                  (kernel-env-bind! target (nth args 1) v)
+                  v)))))))))
+
 (define
   kernel-standard-env
   (fn
@@ -416,4 +488,6 @@
       (kernel-env-bind! env "not" kernel-not-applicative)
       (kernel-env-bind! env "make-encapsulation-type"
                             kernel-make-encap-type-applicative)
+      (kernel-env-bind! env "$let"         kernel-let-operative)
+      (kernel-env-bind! env "$define-in!"  kernel-define-in!-operative)
       env)))

lib/kernel/tests/hygiene.sx

@@ -0,0 +1,194 @@
+;; 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}))