kernel: Phase 6 hygiene — $let + $define-in! + 18 tests [shapes-reflective]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s

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.
This commit is contained in:
2026-05-11 20:57:47 +00:00
parent 45789520ce
commit bf7ec55e92
3 changed files with 278 additions and 3 deletions

View File

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