plans: kernel-on-sx — log quoting.sx extraction + evaluator.sx decline

Updates Phase 7 status:
- env.sx ✓ extracted (three live consumers: Kernel, Tcl, Smalltalk,
  with Scheme also using it directly)
- class-chain.sx ✓ extracted (bonus — not on the original six-file
  list but surfaced by the same chiselling discipline; Smalltalk +
  CLOS consumers)
- quoting.sx ✓ extracted (Kernel + Scheme consumers)
- evaluator.sx DECLINED — too thin to be its own kit; the shared
  content is protocol/API surface, not algorithm. Documented
  in-plan, no file created.
- combiner.sx, short-circuit.sx — still need fexpr-having
  second consumers
- hygiene.sx — still awaits Scheme Phase 6c (research-grade
  scope-set work)

Three kits live, one declined, three still gated.

lib/guest/reflective/env.sx

@@ -0,0 +1,159 @@
+;; lib/guest/reflective/env.sx — first-class environment kit.
+;;
+;; Extracted from Kernel-on-SX (lib/kernel/eval.sx) when Tcl's
+;; uplevel/upvar machinery (lib/tcl/runtime.sx) materialised as a
+;; second consumer needing the same scope-chain semantics.
+;;
+;; Canonical wire shape
+;; --------------------
+;;   {:refl-tag :env :bindings DICT :parent ENV-OR-NIL}
+;;
+;;   - :bindings is a mutable SX dict keyed by symbol name.
+;;   - :parent is either another env or nil (root).
+;;   - Lookup walks the parent chain until a hit or nil.
+;;   - Default cfg uses dict-set! to mutate bindings in place.
+;;
+;; Consumers with their own shape (e.g., Tcl's {:level :locals :parent})
+;; pass an adapter cfg dict — same trick as lib/guest/match.sx's cfg
+;; for unification over guest-specific term shapes.
+;;
+;; Adapter cfg keys
+;; ----------------
+;;   :bindings-of  — fn (scope) → DICT
+;;   :parent-of    — fn (scope) → SCOPE-OR-NIL
+;;   :extend       — fn (scope) → SCOPE         (push a fresh child)
+;;   :bind!        — fn (scope name val) → scope (functional or mutable)
+;;   :env?         — fn (v) → bool              (predicate; cheap shape check)
+;;
+;; Public API — canonical shape, mutable, raises on miss
+;;
+;;   (refl-make-env)
+;;   (refl-extend-env PARENT)
+;;   (refl-env? V)
+;;   (refl-env-bind! ENV NAME VAL)
+;;   (refl-env-has? ENV NAME)
+;;   (refl-env-lookup ENV NAME)
+;;   (refl-env-lookup-or-nil ENV NAME)
+;;
+;; Public API — adapter-cfg, any shape
+;;
+;;   (refl-env-extend-with CFG SCOPE)
+;;   (refl-env-bind!-with  CFG SCOPE NAME VAL)
+;;   (refl-env-has?-with   CFG SCOPE NAME)
+;;   (refl-env-lookup-with CFG SCOPE NAME)
+;;   (refl-env-lookup-or-nil-with CFG SCOPE NAME)
+;;   (refl-env-find-frame-with CFG SCOPE NAME)
+;;     — returns the scope in the chain that contains NAME (or nil).
+;;       Consumers needing source-frame mutation use this.
+;;
+;;   (refl-canonical-cfg) — the default cfg, exposed so consumers
+;;                          can compare or extend it.
+
+;; ── Canonical-shape predicates and constructors ─────────────────
+
+(define refl-env? (fn (v) (and (dict? v) (= (get v :refl-tag) :env))))
+
+(define refl-make-env (fn () {:parent nil :refl-tag :env :bindings {}}))
+
+(define refl-extend-env (fn (parent) {:parent parent :refl-tag :env :bindings {}}))
+
+(define
+  refl-env-bind!
+  (fn (env name val) (dict-set! (get env :bindings) name val) env))
+
+(define
+  refl-env-has?
+  (fn
+    (env name)
+    (cond
+      ((nil? env) false)
+      ((not (refl-env? env)) false)
+      ((dict-has? (get env :bindings) name) true)
+      (:else (refl-env-has? (get env :parent) name)))))
+
+(define
+  refl-env-lookup
+  (fn
+    (env name)
+    (cond
+      ((nil? env) (error (str "refl-env-lookup: unbound symbol: " name)))
+      ((not (refl-env? env))
+        (error (str "refl-env-lookup: corrupt env: " env)))
+      ((dict-has? (get env :bindings) name) (get (get env :bindings) name))
+      (:else (refl-env-lookup (get env :parent) name)))))
+
+(define
+  refl-env-lookup-or-nil
+  (fn
+    (env name)
+    (cond
+      ((nil? env) nil)
+      ((not (refl-env? env)) nil)
+      ((dict-has? (get env :bindings) name) (get (get env :bindings) name))
+      (:else (refl-env-lookup-or-nil (get env :parent) name)))))
+
+;; ── Adapter-cfg variants — any wire shape ───────────────────────
+
+(define refl-env-extend-with (fn (cfg scope) ((get cfg :extend) scope)))
+
+(define
+  refl-env-bind!-with
+  (fn (cfg scope name val) ((get cfg :bind!) scope name val)))
+
+(define
+  refl-env-has?-with
+  (fn
+    (cfg scope name)
+    (cond
+      ((nil? scope) false)
+      ((not ((get cfg :env?) scope)) false)
+      ((dict-has? ((get cfg :bindings-of) scope) name) true)
+      (:else (refl-env-has?-with cfg ((get cfg :parent-of) scope) name)))))
+
+(define
+  refl-env-lookup-with
+  (fn
+    (cfg scope name)
+    (cond
+      ((nil? scope) (error (str "refl-env-lookup: unbound symbol: " name)))
+      ((not ((get cfg :env?) scope))
+        (error (str "refl-env-lookup: corrupt scope: " scope)))
+      ((dict-has? ((get cfg :bindings-of) scope) name)
+        (get ((get cfg :bindings-of) scope) name))
+      (:else (refl-env-lookup-with cfg ((get cfg :parent-of) scope) name)))))
+
+(define
+  refl-env-lookup-or-nil-with
+  (fn
+    (cfg scope name)
+    (cond
+      ((nil? scope) nil)
+      ((not ((get cfg :env?) scope)) nil)
+      ((dict-has? ((get cfg :bindings-of) scope) name)
+        (get ((get cfg :bindings-of) scope) name))
+      (:else
+        (refl-env-lookup-or-nil-with cfg ((get cfg :parent-of) scope) name)))))
+
+;; Returns the SCOPE in the chain that contains NAME, or nil if no
+;; scope binds it. Consumers (e.g. Smalltalk) use this to mutate the
+;; binding at its source frame rather than introducing a new shadow
+;; binding at the current frame. Pairs with `refl-env-lookup-with`
+;; for callers that need both the value and the defining scope.
+
+(define refl-env-find-frame-with
+  (fn (cfg scope name)
+    (cond
+      ((nil? scope) nil)
+      ((not ((get cfg :env?) scope)) nil)
+      ((dict-has? ((get cfg :bindings-of) scope) name) scope)
+      (:else
+        (refl-env-find-frame-with cfg ((get cfg :parent-of) scope) name)))))
+
+(define refl-env-find-frame
+  (fn (env name) (refl-env-find-frame-with refl-canonical-cfg env name)))
+
+;; ── Default canonical cfg ───────────────────────────────────────
+;; Exposed so consumers can use it explicitly, compose with it, or
+;; check adapter-correctness against the canonical implementation.
+
+(define refl-canonical-cfg {:bind! (fn (e n v) (refl-env-bind! e n v)) :parent-of (fn (e) (get e :parent)) :env? (fn (v) (refl-env? v)) :bindings-of (fn (e) (get e :bindings)) :extend (fn (e) (refl-extend-env e))})

lib/guest/reflective/quoting.sx

@@ -0,0 +1,77 @@
+;; lib/guest/reflective/quoting.sx — quasiquote walker.
+;;
+;; Extracted from Kernel's `knl-quasi-walk` and Scheme's `scm-quasi-walk`,
+;; which differ only in:
+;;   - the unquote keyword name (Kernel: "$unquote" / "$unquote-splicing";
+;;     Scheme: "unquote" / "unquote-splicing")
+;;   - the host evaluator function (`kernel-eval` vs `scheme-eval`)
+;;
+;; Algorithm is identical. Adapter cfg parameterises the two
+;; language-specific knobs.
+;;
+;; Adapter cfg keys
+;; ----------------
+;;   :unquote-name           — string, name of the unquote keyword
+;;   :unquote-splicing-name  — string, name of the splice keyword
+;;   :eval                   — fn (form env) → value
+;;
+;; Public API
+;;   (refl-quasi-walk-with CFG FORM ENV)
+;;     Top-level walker. Returns FORM with unquotes evaluated in ENV.
+;;
+;;   (refl-quasi-walk-list-with CFG FORMS ENV)
+;;     Walks a list of forms, splicing unquote-splicing results inline.
+;;
+;;   (refl-quasi-list-concat XS YS)
+;;     Pure-SX list append (no host append/append! needed).
+
+(define
+  refl-quasi-list-concat
+  (fn
+    (xs ys)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) ys)
+      (:else (cons (first xs) (refl-quasi-list-concat (rest xs) ys))))))
+
+(define
+  refl-quasi-walk-with
+  (fn
+    (cfg form env)
+    (cond
+      ((not (list? form)) form)
+      ((= (length form) 0) form)
+      ((and (string? (first form)) (= (first form) (get cfg :unquote-name)))
+        (cond
+          ((not (= (length form) 2))
+            (error
+              (str (get cfg :unquote-name) ": expects exactly 1 argument")))
+          (:else ((get cfg :eval) (nth form 1) env))))
+      (:else (refl-quasi-walk-list-with cfg form env)))))
+
+(define
+  refl-quasi-walk-list-with
+  (fn
+    (cfg forms env)
+    (cond
+      ((or (nil? forms) (= (length forms) 0)) (list))
+      (:else
+        (let
+          ((head (first forms)))
+          (cond
+            ((and (list? head) (= (length head) 2) (string? (first head)) (= (first head) (get cfg :unquote-splicing-name)))
+              (let
+                ((spliced ((get cfg :eval) (nth head 1) env)))
+                (cond
+                  ((not (list? spliced))
+                    (error
+                      (str
+                        (get cfg :unquote-splicing-name)
+                        ": value must be a list")))
+                  (:else
+                    (refl-quasi-list-concat
+                      spliced
+                      (refl-quasi-walk-list-with cfg (rest forms) env))))))
+            (:else
+              (cons
+                (refl-quasi-walk-with cfg head env)
+                (refl-quasi-walk-list-with cfg (rest forms) env)))))))))

lib/kernel/eval.sx

@@ -0,0 +1,214 @@
+;; lib/kernel/eval.sx — Kernel evaluator.
+;;
+;; The evaluator is `lookup-and-combine`: there are no hardcoded special
+;; forms. Even $if / $define! / $lambda are ordinary operatives bound in
+;; the standard environment (Phase 4). This file builds the dispatch
+;; machinery and the operative/applicative tagged-value protocol.
+;;
+;; Tagged values
+;; -------------
+;;   {:refl-tag :env :bindings DICT :parent PARENT-OR-NIL}
+;;     A first-class Kernel environment. Bindings is a mutable SX dict
+;;     keyed by symbol name; parent walks up the lookup chain. Shape
+;;     and operations are inherited from lib/guest/reflective/env.sx
+;;     (canonical wire shape) — Kernel-side names are thin wrappers.
+;;
+;;   {:knl-tag :operative :impl FN}
+;;     Primitive operative. FN receives (args dyn-env) — args are the
+;;     UN-evaluated argument expressions, dyn-env is the calling env.
+;;
+;;   {:knl-tag :operative :params P :env-param EP :body B :static-env SE}
+;;     User-defined operative (built by $vau). Same tag; dispatch in
+;;     kernel-call-operative forks on which keys are present.
+;;
+;;   {:knl-tag :applicative :underlying OP}
+;;     An applicative wraps an operative. Calls evaluate args first,
+;;     then forward to the underlying operative.
+;;
+;; The env-param of a user operative may be the sentinel :knl-ignore,
+;; in which case the dynamic env is not bound.
+;;
+;; Public API
+;;   (kernel-eval EXPR ENV)                     — primary entry
+;;   (kernel-combine COMBINER ARGS DYN-ENV)
+;;   (kernel-call-operative OP ARGS DYN-ENV)
+;;   (kernel-bind-params! ENV PARAMS ARGS)
+;;   (kernel-make-env) / (kernel-extend-env P)
+;;   (kernel-env-bind! E N V) / (kernel-env-lookup E N)
+;;   (kernel-env-has? E N) / (kernel-env? V)
+;;   (kernel-make-primitive-operative IMPL)
+;;   (kernel-make-primitive-applicative IMPL)
+;;   (kernel-make-user-operative PARAMS EPARAM BODY STATIC-ENV)
+;;   (kernel-wrap OP) / (kernel-unwrap APP)
+;;   (kernel-operative? V) / (kernel-applicative? V) / (kernel-combiner? V)
+;;
+;; Consumes: lib/kernel/parser.sx (kernel-string?, kernel-string-value)
+
+;; ── Environments — delegated to lib/guest/reflective/env.sx ──────
+;; The env values themselves now carry `:refl-tag :env` (shared with the
+;; reflective kit). Kernel's API names stay; bodies are thin wrappers.
+
+(define kernel-env?        refl-env?)
+(define kernel-make-env    refl-make-env)
+(define kernel-extend-env  refl-extend-env)
+(define kernel-env-bind!   refl-env-bind!)
+(define kernel-env-has?    refl-env-has?)
+(define kernel-env-lookup  refl-env-lookup)
+
+;; ── Tagged-value constructors and predicates ─────────────────────
+
+(define kernel-make-primitive-operative (fn (impl) {:impl impl :knl-tag :operative}))
+
+(define
+  kernel-make-user-operative
+  (fn (params eparam body static-env) {:knl-tag :operative :static-env static-env :params params :body body :env-param eparam}))
+
+(define
+  kernel-operative?
+  (fn (v) (and (dict? v) (= (get v :knl-tag) :operative))))
+
+(define
+  kernel-applicative?
+  (fn (v) (and (dict? v) (= (get v :knl-tag) :applicative))))
+
+(define
+  kernel-combiner?
+  (fn (v) (or (kernel-operative? v) (kernel-applicative? v))))
+
+(define
+  kernel-wrap
+  (fn
+    (op)
+    (cond
+      ((kernel-operative? op) {:knl-tag :applicative :underlying op})
+      (:else (error "kernel-wrap: argument must be an operative")))))
+
+(define
+  kernel-unwrap
+  (fn
+    (app)
+    (cond
+      ((kernel-applicative? app) (get app :underlying))
+      (:else (error "kernel-unwrap: argument must be an applicative")))))
+
+(define
+  kernel-make-primitive-applicative
+  (fn
+    (impl)
+    (kernel-wrap
+      (kernel-make-primitive-operative (fn (args dyn-env) (impl args))))))
+
+;; As above, but IMPL receives (args dyn-env). Used by combinators that
+;; re-enter the evaluator (map, filter, reduce, apply, eval, ...).
+(define kernel-make-primitive-applicative-with-env
+  (fn (impl)
+    (kernel-wrap
+      (kernel-make-primitive-operative
+        (fn (args dyn-env) (impl args dyn-env))))))
+
+;; ── The evaluator ────────────────────────────────────────────────
+
+(define
+  kernel-eval
+  (fn
+    (expr env)
+    (cond
+      ((number? expr) expr)
+      ((boolean? expr) expr)
+      ((nil? expr) expr)
+      ((kernel-string? expr) (kernel-string-value expr))
+      ((string? expr) (kernel-env-lookup env expr))
+      ((list? expr)
+        (cond
+          ((= (length expr) 0) expr)
+          (:else
+            (let
+              ((combiner (kernel-eval (first expr) env))
+                (args (rest expr)))
+              (kernel-combine combiner args env)))))
+      (:else (error (str "kernel-eval: unknown form: " expr))))))
+
+(define
+  kernel-combine
+  (fn
+    (combiner args dyn-env)
+    (cond
+      ((kernel-operative? combiner)
+        (kernel-call-operative combiner args dyn-env))
+      ((kernel-applicative? combiner)
+        (kernel-combine
+          (get combiner :underlying)
+          (kernel-eval-args args dyn-env)
+          dyn-env))
+      (:else (error (str "kernel-eval: not a combiner: " combiner))))))
+
+;; Operatives may be primitive (:impl is a host fn) or user-defined
+;; (carry :params / :env-param / :body / :static-env). The dispatch
+;; fork is here so kernel-combine stays small.
+(define
+  kernel-call-operative
+  (fn
+    (op args dyn-env)
+    (cond
+      ((dict-has? op :impl) ((get op :impl) args dyn-env))
+      ((dict-has? op :body)
+        (let
+          ((local (kernel-extend-env (get op :static-env))))
+          (kernel-bind-params! local (get op :params) args)
+          (let
+            ((eparam (get op :env-param)))
+            (when
+              (not (= eparam :knl-ignore))
+              (kernel-env-bind! local eparam dyn-env)))
+          ;; :body is a list of forms — evaluate in sequence, return last.
+          (knl-eval-body (get op :body) local)))
+      (:else (error "kernel-call-operative: malformed operative")))))
+
+(define knl-eval-body
+  (fn (forms env)
+    (cond
+      ((= (length forms) 1) (kernel-eval (first forms) env))
+      (:else
+        (begin
+          (kernel-eval (first forms) env)
+          (knl-eval-body (rest forms) env))))))
+
+;; Phase 3 supports a flat parameter list only — destructuring later.
+(define
+  kernel-bind-params!
+  (fn
+    (env params args)
+    (cond
+      ((or (nil? params) (= (length params) 0))
+        (cond
+          ((or (nil? args) (= (length args) 0)) nil)
+          (:else (error "kernel-call: too many arguments"))))
+      ((or (nil? args) (= (length args) 0))
+        (error "kernel-call: too few arguments"))
+      (:else
+        (begin
+          (kernel-env-bind! env (first params) (first args))
+          (kernel-bind-params! env (rest params) (rest args)))))))
+
+(define
+  kernel-eval-args
+  (fn
+    (args env)
+    (cond
+      ((or (nil? args) (= (length args) 0)) (list))
+      (:else
+        (cons
+          (kernel-eval (first args) env)
+          (kernel-eval-args (rest args) env))))))
+
+(define
+  kernel-eval-program
+  (fn
+    (forms env)
+    (cond
+      ((or (nil? forms) (= (length forms) 0)) nil)
+      ((= (length forms) 1) (kernel-eval (first forms) env))
+      (:else
+        (begin
+          (kernel-eval (first forms) env)
+          (kernel-eval-program (rest forms) env))))))

lib/kernel/parser.sx

@@ -0,0 +1,253 @@
+;; lib/kernel/parser.sx — Kernel s-expression reader.
+;;
+;; Reads R-1RK lexical syntax: numbers, strings, symbols, booleans (#t/#f),
+;; the empty list (), nested lists, and ; line comments. Reader macros
+;; (' ` , ,@) deferred to Phase 6 per the plan.
+;;
+;; Public AST shape:
+;;   number      → SX number
+;;   #t / #f     → SX true / false
+;;   ()          → SX empty list (Kernel's nil — the empty list)
+;;   "..."       → {:knl-string "..."}    wrapped to distinguish from symbols
+;;   foo         → "foo"                  bare SX string is a Kernel symbol
+;;   (a b c)     → SX list of forms
+;;
+;; Public API:
+;;   (kernel-parse SRC)      — first form; errors on extra trailing input
+;;   (kernel-parse-all SRC)  — all top-level forms, as SX list
+;;   (kernel-string? V)      — recognise wrapped string literal
+;;   (kernel-string-value V) — extract the underlying string
+;;
+;; Consumes: lib/guest/lex.sx (lex-digit?, lex-whitespace?)
+
+(define kernel-string-make (fn (s) {:knl-string s}))
+(define
+  kernel-string?
+  (fn (v) (and (dict? v) (string? (get v :knl-string)))))
+(define kernel-string-value (fn (v) (get v :knl-string)))
+
+;; Atom delimiters: characters that end a symbol or numeric token.
+(define
+  knl-delim?
+  (fn
+    (c)
+    (or
+      (nil? c)
+      (lex-whitespace? c)
+      (= c "(")
+      (= c ")")
+      (= c "\"")
+      (= c ";")
+      (= c "'")
+      (= c "`")
+      (= c ","))))
+
+;; Numeric grammar:  [+-]? (digit+ ('.' digit+)? | '.' digit+) ([eE][+-]?digit+)?
+(define
+  knl-numeric?
+  (fn
+    (s)
+    (let
+      ((n (string-length s)))
+      (cond
+        ((= n 0) false)
+        (:else
+          (let
+            ((c0 (substring s 0 1)))
+            (let
+              ((start (if (or (= c0 "+") (= c0 "-")) 1 0)))
+              (knl-num-body? s start n))))))))
+
+(define
+  knl-num-body?
+  (fn
+    (s start n)
+    (cond
+      ((>= start n) false)
+      ((= (substring s start (+ start 1)) ".")
+        (knl-num-need-digits? s (+ start 1) n false))
+      ((lex-digit? (substring s start (+ start 1)))
+        (knl-num-int-tail? s (+ start 1) n))
+      (:else false))))
+
+(define
+  knl-num-int-tail?
+  (fn
+    (s i n)
+    (cond
+      ((>= i n) true)
+      ((lex-digit? (substring s i (+ i 1)))
+        (knl-num-int-tail? s (+ i 1) n))
+      ((= (substring s i (+ i 1)) ".")
+        (knl-num-need-digits? s (+ i 1) n true))
+      ((or (= (substring s i (+ i 1)) "e") (= (substring s i (+ i 1)) "E"))
+        (knl-num-exp-sign? s (+ i 1) n))
+      (:else false))))
+
+(define
+  knl-num-need-digits?
+  (fn
+    (s i n had-int)
+    (cond
+      ((>= i n) had-int)
+      ((lex-digit? (substring s i (+ i 1)))
+        (knl-num-frac-tail? s (+ i 1) n))
+      (:else false))))
+
+(define
+  knl-num-frac-tail?
+  (fn
+    (s i n)
+    (cond
+      ((>= i n) true)
+      ((lex-digit? (substring s i (+ i 1)))
+        (knl-num-frac-tail? s (+ i 1) n))
+      ((or (= (substring s i (+ i 1)) "e") (= (substring s i (+ i 1)) "E"))
+        (knl-num-exp-sign? s (+ i 1) n))
+      (:else false))))
+
+(define
+  knl-num-exp-sign?
+  (fn
+    (s i n)
+    (cond
+      ((>= i n) false)
+      ((or (= (substring s i (+ i 1)) "+") (= (substring s i (+ i 1)) "-"))
+        (knl-num-exp-digits? s (+ i 1) n false))
+      (:else (knl-num-exp-digits? s i n false)))))
+
+(define
+  knl-num-exp-digits?
+  (fn
+    (s i n had)
+    (cond
+      ((>= i n) had)
+      ((lex-digit? (substring s i (+ i 1)))
+        (knl-num-exp-digits? s (+ i 1) n true))
+      (:else false))))
+
+;; Reader: a closure over (src, pos). Exposes :read-form and :read-all.
+(define
+  knl-make-reader
+  (fn
+    (src)
+    (let
+      ((pos 0) (n (string-length src)))
+      (define
+        at
+        (fn () (if (< pos n) (substring src pos (+ pos 1)) nil)))
+      (define adv (fn () (set! pos (+ pos 1))))
+      (define
+        skip-line
+        (fn () (when (and (at) (not (= (at) "\n"))) (adv) (skip-line))))
+      (define
+        skip-ws
+        (fn
+          ()
+          (cond
+            ((nil? (at)) nil)
+            ((lex-whitespace? (at)) (do (adv) (skip-ws)))
+            ((= (at) ";") (do (adv) (skip-line) (skip-ws)))
+            (:else nil))))
+      (define
+        read-string-body
+        (fn
+          (acc)
+          (cond
+            ((nil? (at)) (error "kernel-parse: unterminated string"))
+            ((= (at) "\"") (do (adv) acc))
+            ((= (at) "\\")
+              (do
+                (adv)
+                (let
+                  ((c (at)))
+                  (when (nil? c) (error "kernel-parse: trailing backslash"))
+                  (adv)
+                  (read-string-body
+                    (str
+                      acc
+                      (cond
+                        ((= c "n") "\n")
+                        ((= c "t") "\t")
+                        ((= c "r") "\r")
+                        ((= c "\"") "\"")
+                        ((= c "\\") "\\")
+                        (:else c)))))))
+            (:else
+              (let ((c (at))) (adv) (read-string-body (str acc c)))))))
+      (define
+        read-atom-body
+        (fn
+          (acc)
+          (cond
+            ((knl-delim? (at)) acc)
+            (:else (let ((c (at))) (adv) (read-atom-body (str acc c)))))))
+      (define
+        classify-atom
+        (fn
+          (s)
+          (cond
+            ((= s "#t") true)
+            ((= s "#f") false)
+            ((knl-numeric? s) (string->number s))
+            (:else s))))
+      (define
+        read-form
+        (fn
+          ()
+          (skip-ws)
+          (cond
+            ((nil? (at)) :knl-eof)
+            ((= (at) ")") (error "kernel-parse: unexpected ')'"))
+            ((= (at) "(") (do (adv) (read-list (list))))
+            ((= (at) "\"")
+              (do (adv) (kernel-string-make (read-string-body ""))))
+            ((= (at) "'")
+              (do (adv) (list "$quote" (read-form))))
+            ((= (at) "`")
+              (do (adv) (list "$quasiquote" (read-form))))
+            ((= (at) ",")
+              (do (adv)
+                  (cond
+                    ((= (at) "@")
+                      (do (adv) (list "$unquote-splicing" (read-form))))
+                    (:else (list "$unquote" (read-form))))))
+            (:else (classify-atom (read-atom-body ""))))))
+      (define
+        read-list
+        (fn
+          (acc)
+          (skip-ws)
+          (cond
+            ((nil? (at)) (error "kernel-parse: unterminated list"))
+            ((= (at) ")") (do (adv) acc))
+            (:else (read-list (append acc (list (read-form))))))))
+      (define
+        read-all
+        (fn
+          (acc)
+          (skip-ws)
+          (if (nil? (at)) acc (read-all (append acc (list (read-form)))))))
+      {:read-form read-form :read-all read-all})))
+
+(define
+  kernel-parse-all
+  (fn (src) ((get (knl-make-reader src) :read-all) (list))))
+
+(define
+  kernel-parse
+  (fn
+    (src)
+    (let
+      ((r (knl-make-reader src)))
+      (let
+        ((form ((get r :read-form))))
+        (cond
+          ((= form :knl-eof) (error "kernel-parse: empty input"))
+          (:else
+            (let
+              ((next ((get r :read-form))))
+              (if
+                (= next :knl-eof)
+                form
+                (error "kernel-parse: trailing input after first form")))))))))

lib/kernel/runtime.sx

@@ -0,0 +1,881 @@
+;; lib/kernel/runtime.sx — the operative–applicative substrate and the
+;; standard Kernel environment.
+;;
+;; Phase 3 supplied four user-visible combiners ($vau, $lambda, wrap,
+;; unwrap). Phase 4 fills out the rest of the R-1RK core: $if, $define!,
+;; $sequence, eval, make-environment, get-current-environment, plus
+;; arithmetic, equality, list/pair, and boolean primitives — enough to
+;; write factorial.
+;;
+;; The standard env is built by EXTENDING the base env, not replacing
+;; it. So `kernel-standard-env` includes everything from `kernel-base-env`.
+;;
+;; Public API
+;;   (kernel-base-env)       — Phase 3 combiners
+;;   (kernel-standard-env)   — Phase 4 standard environment
+
+(define
+  knl-eparam-sentinel
+  (fn
+    (sym)
+    (cond
+      ((= sym "_") :knl-ignore)
+      ((= sym "#ignore") :knl-ignore)
+      (:else sym))))
+
+(define
+  knl-formals-ok?
+  (fn
+    (formals)
+    (cond
+      ((not (list? formals)) false)
+      ((= (length formals) 0) true)
+      ((string? (first formals)) (knl-formals-ok? (rest formals)))
+      (:else false))))
+
+;; ── $vau ─────────────────────────────────────────────────────────
+
+(define
+  kernel-vau-impl
+  (fn
+    (args dyn-env)
+    (cond
+      ((< (length args) 3)
+        (error "$vau: expects (formals env-param body...)"))
+      (:else
+        (let
+          ((formals (first args))
+            (eparam-raw (nth args 1))
+            (body-forms (rest (rest args))))
+          (cond
+            ((not (knl-formals-ok? formals))
+              (error "$vau: formals must be a list of symbols"))
+            ((not (string? eparam-raw))
+              (error "$vau: env-param must be a symbol"))
+            (:else
+              (kernel-make-user-operative
+                formals
+                (knl-eparam-sentinel eparam-raw)
+                body-forms
+                dyn-env))))))))
+
+(define
+  kernel-vau-operative
+  (kernel-make-primitive-operative kernel-vau-impl))
+
+;; ── $lambda ──────────────────────────────────────────────────────
+
+(define
+  kernel-lambda-impl
+  (fn
+    (args dyn-env)
+    (cond
+      ((< (length args) 2)
+        (error "$lambda: expects (formals body...)"))
+      (:else
+        (let
+          ((formals (first args)) (body-forms (rest args)))
+          (cond
+            ((not (knl-formals-ok? formals))
+              (error "$lambda: formals must be a list of symbols"))
+            (:else
+              (kernel-wrap
+                (kernel-make-user-operative
+                  formals
+                  :knl-ignore
+                  body-forms
+                  dyn-env)))))))))
+
+(define
+  kernel-lambda-operative
+  (kernel-make-primitive-operative kernel-lambda-impl))
+
+;; ── wrap / unwrap / predicates ───────────────────────────────────
+
+(define
+  kernel-wrap-applicative
+  (kernel-make-primitive-applicative
+    (fn
+      (args)
+      (cond
+        ((not (= (length args) 1))
+          (error "wrap: expects exactly 1 argument"))
+        (:else (kernel-wrap (first args)))))))
+
+(define
+  kernel-unwrap-applicative
+  (kernel-make-primitive-applicative
+    (fn
+      (args)
+      (cond
+        ((not (= (length args) 1))
+          (error "unwrap: expects exactly 1 argument"))
+        (:else (kernel-unwrap (first args)))))))
+
+(define
+  kernel-operative?-applicative
+  (kernel-make-primitive-applicative
+    (fn (args) (kernel-operative? (first args)))))
+
+(define
+  kernel-applicative?-applicative
+  (kernel-make-primitive-applicative
+    (fn (args) (kernel-applicative? (first args)))))
+
+(define
+  kernel-base-env
+  (fn
+    ()
+    (let
+      ((env (kernel-make-env)))
+      (kernel-env-bind! env "$vau" kernel-vau-operative)
+      (kernel-env-bind! env "$lambda" kernel-lambda-operative)
+      (kernel-env-bind! env "wrap" kernel-wrap-applicative)
+      (kernel-env-bind! env "unwrap" kernel-unwrap-applicative)
+      (kernel-env-bind! env "operative?" kernel-operative?-applicative)
+      (kernel-env-bind! env "applicative?" kernel-applicative?-applicative)
+      env)))
+
+;; ── $if / $define! / $sequence ───────────────────────────────────
+
+(define
+  kernel-if-operative
+  (kernel-make-primitive-operative
+    (fn
+      (args dyn-env)
+      (cond
+        ((not (= (length args) 3))
+          (error "$if: expects (condition then-expr else-expr)"))
+        (:else
+          (let
+            ((c (kernel-eval (first args) dyn-env)))
+            (if
+              c
+              (kernel-eval (nth args 1) dyn-env)
+              (kernel-eval (nth args 2) dyn-env))))))))
+
+(define
+  kernel-define!-operative
+  (kernel-make-primitive-operative
+    (fn
+      (args dyn-env)
+      (cond
+        ((not (= (length args) 2))
+          (error "$define!: expects (name expr)"))
+        ((not (string? (first args)))
+          (error "$define!: name must be a symbol"))
+        (:else
+          (let
+            ((v (kernel-eval (nth args 1) dyn-env)))
+            (kernel-env-bind! dyn-env (first args) v)
+            v))))))
+
+(define
+  kernel-sequence-operative
+  (kernel-make-primitive-operative
+    (fn
+      (args dyn-env)
+      (cond
+        ((or (nil? args) (= (length args) 0)) nil)
+        ((= (length args) 1) (kernel-eval (first args) dyn-env))
+        (:else
+          (begin
+            (kernel-eval (first args) dyn-env)
+            ((get kernel-sequence-operative :impl) (rest args) dyn-env)))))))
+
+;; ── eval / make-environment / get-current-environment ───────────
+
+(define
+  kernel-quote-operative
+  (kernel-make-primitive-operative
+    (fn
+      (args dyn-env)
+      (cond
+        ((not (= (length args) 1)) (error "$quote: expects 1 argument"))
+        (:else (first args))))))
+
+;; Kernel-side adapter for lib/guest/reflective/quoting.sx.
+;; Kernel uses $unquote / $unquote-splicing (dollar-prefixed) and the
+;; host-level kernel-eval as the evaluator. The walker algorithm
+;; itself is shared with Scheme via the kit.
+(define knl-quasi-cfg
+  {:unquote-name "$unquote"
+   :unquote-splicing-name "$unquote-splicing"
+   :eval (fn (form env) (kernel-eval form env))})
+
+(define knl-quasi-walk
+  (fn (form dyn-env)
+    (refl-quasi-walk-with knl-quasi-cfg form dyn-env)))
+
+;; $cond — multi-clause branch.
+;;   ($cond (TEST1 EXPR1 ...) (TEST2 EXPR2 ...) ...)
+;; Evaluates each TEST in order; first truthy one runs its EXPRs (in
+;; sequence) and returns the last; if no TEST is truthy, returns nil.
+;; A clause with TEST = `else` always matches (sugar for $if's default).
+(define knl-cond-impl
+  (fn (clauses dyn-env)
+    (cond
+      ((or (nil? clauses) (= (length clauses) 0)) nil)
+      (:else
+        (let ((clause (first clauses)))
+          (cond
+            ((not (list? clause))
+              (error "$cond: each clause must be a list"))
+            ((= (length clause) 0)
+              (error "$cond: empty clause"))
+            ((and (string? (first clause)) (= (first clause) "else"))
+              (knl-cond-eval-body (rest clause) dyn-env))
+            (:else
+              (let ((test-val (kernel-eval (first clause) dyn-env)))
+                (cond
+                  (test-val (knl-cond-eval-body (rest clause) dyn-env))
+                  (:else (knl-cond-impl (rest clauses) dyn-env)))))))))))
+
+(define knl-cond-eval-body
+  (fn (body dyn-env)
+    (cond
+      ((or (nil? body) (= (length body) 0)) nil)
+      ((= (length body) 1) (kernel-eval (first body) dyn-env))
+      (:else
+        (begin
+          (kernel-eval (first body) dyn-env)
+          (knl-cond-eval-body (rest body) dyn-env))))))
+
+(define kernel-cond-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env) (knl-cond-impl args dyn-env))))
+
+;; $when COND BODY... — evaluate body iff COND is truthy; else nil.
+(define kernel-when-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env)
+      (cond
+        ((< (length args) 1)
+          (error "$when: expects (cond body...)"))
+        (:else
+          (let ((c (kernel-eval (first args) dyn-env)))
+            (cond
+              (c (knl-cond-eval-body (rest args) dyn-env))
+              (:else nil))))))))
+
+;; $and? — short-circuit AND. Operative (not applicative) so untaken
+;; clauses are NOT evaluated. Empty $and? returns true (the identity).
+(define knl-and?-impl
+  (fn (args dyn-env)
+    (cond
+      ((or (nil? args) (= (length args) 0)) true)
+      ((= (length args) 1) (kernel-eval (first args) dyn-env))
+      (:else
+        (let ((v (kernel-eval (first args) dyn-env)))
+          (cond
+            (v (knl-and?-impl (rest args) dyn-env))
+            (:else v)))))))
+
+(define kernel-and?-operative
+  (kernel-make-primitive-operative knl-and?-impl))
+
+;; $or? — short-circuit OR. Operative; untaken clauses NOT evaluated.
+;; Empty $or? returns false (the identity).
+(define knl-or?-impl
+  (fn (args dyn-env)
+    (cond
+      ((or (nil? args) (= (length args) 0)) false)
+      ((= (length args) 1) (kernel-eval (first args) dyn-env))
+      (:else
+        (let ((v (kernel-eval (first args) dyn-env)))
+          (cond
+            (v v)
+            (:else (knl-or?-impl (rest args) dyn-env))))))))
+
+(define kernel-or?-operative
+  (kernel-make-primitive-operative knl-or?-impl))
+
+;; $unless COND BODY... — evaluate body iff COND is falsy; else nil.
+(define kernel-unless-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env)
+      (cond
+        ((< (length args) 1)
+          (error "$unless: expects (cond body...)"))
+        (:else
+          (let ((c (kernel-eval (first args) dyn-env)))
+            (cond
+              (c nil)
+              (:else (knl-cond-eval-body (rest args) dyn-env)))))))))
+
+(define kernel-quasiquote-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 1))
+          (error "$quasiquote: expects exactly 1 argument"))
+        (:else (knl-quasi-walk (first args) dyn-env))))))
+
+(define
+  kernel-eval-applicative
+  (kernel-make-primitive-applicative
+    (fn
+      (args)
+      (cond
+        ((not (= (length args) 2))
+          (error "eval: expects (expr env)"))
+        ((not (kernel-env? (nth args 1)))
+          (error "eval: second arg must be a kernel env"))
+        (:else (kernel-eval (first args) (nth args 1)))))))
+
+(define
+  kernel-make-environment-applicative
+  (kernel-make-primitive-applicative
+    (fn
+      (args)
+      (cond
+        ((= (length args) 0) (kernel-make-env))
+        ((= (length args) 1)
+          (cond
+            ((not (kernel-env? (first args)))
+              (error "make-environment: parent must be a kernel env"))
+            (:else (kernel-extend-env (first args)))))
+        (:else (error "make-environment: 0 or 1 argument"))))))
+
+;; ── arithmetic and comparison (binary; trivial to extend later) ─
+
+(define
+  kernel-get-current-env-operative
+  (kernel-make-primitive-operative
+    (fn
+      (args dyn-env)
+      (cond
+        ((not (= (length args) 0))
+          (error "get-current-environment: expects 0 arguments"))
+        (:else dyn-env)))))
+
+(define
+  knl-bin-app
+  (fn
+    (name f)
+    (kernel-make-primitive-applicative
+      (fn
+        (args)
+        (cond
+          ((not (= (length args) 2))
+            (error (str name ": expects 2 arguments")))
+          (:else (f (first args) (nth args 1))))))))
+
+;; Variadic left-fold helper. ZERO-RES is the identity (`(+)` → 0);
+;; ONE-FN handles single-arg case (`(- x)` negates; `(+ x)` returns x).
+(define knl-fold-step
+  (fn (f acc rest-args)
+    (cond
+      ((or (nil? rest-args) (= (length rest-args) 0)) acc)
+      (:else
+        (knl-fold-step f (f acc (first rest-args)) (rest rest-args))))))
+
+(define knl-fold-app
+  (fn (name f zero-res one-fn)
+    (kernel-make-primitive-applicative
+      (fn (args)
+        (cond
+          ((= (length args) 0) zero-res)
+          ((= (length args) 1) (one-fn (first args)))
+          (:else (knl-fold-step f (first args) (rest args))))))))
+
+;; Variadic n-ary chained comparison: `(< 1 2 3)` ≡ `(< 1 2)` AND `(< 2 3)`.
+(define knl-chain-step
+  (fn (cmp prev rest-args)
+    (cond
+      ((or (nil? rest-args) (= (length rest-args) 0)) true)
+      (:else
+        (let ((next (first rest-args)))
+          (cond
+            ((cmp prev next)
+              (knl-chain-step cmp next (rest rest-args)))
+            (:else false)))))))
+
+(define knl-chain-cmp
+  (fn (name cmp)
+    (kernel-make-primitive-applicative
+      (fn (args)
+        (cond
+          ((< (length args) 2)
+            (error (str name ": expects at least 2 arguments")))
+          (:else (knl-chain-step cmp (first args) (rest args))))))))
+
+;; ── list / pair primitives ──────────────────────────────────────
+
+(define
+  knl-unary-app
+  (fn
+    (name f)
+    (kernel-make-primitive-applicative
+      (fn
+        (args)
+        (cond
+          ((not (= (length args) 1))
+            (error (str name ": expects 1 argument")))
+          (:else (f (first args))))))))
+
+(define kernel-cons-applicative (knl-bin-app "cons" (fn (a b) (cons a b))))
+
+(define
+  kernel-car-applicative
+  (knl-unary-app
+    "car"
+    (fn
+      (xs)
+      (cond
+        ((or (nil? xs) (and (list? xs) (= (length xs) 0)))
+          (error "car: empty list"))
+        (:else (first xs))))))
+
+(define
+  kernel-cdr-applicative
+  (knl-unary-app
+    "cdr"
+    (fn
+      (xs)
+      (cond
+        ((or (nil? xs) (and (list? xs) (= (length xs) 0)))
+          (error "cdr: empty list"))
+        (:else (rest xs))))))
+
+(define
+  kernel-list-applicative
+  (kernel-make-primitive-applicative (fn (args) args)))
+
+(define
+  kernel-length-applicative
+  (knl-unary-app "length" (fn (xs) (length xs))))
+
+(define
+  kernel-null?-applicative
+  (knl-unary-app
+    "null?"
+    (fn (v) (or (nil? v) (and (list? v) (= (length v) 0))))))
+
+;; ── boolean / equality ──────────────────────────────────────────
+
+(define
+  kernel-pair?-applicative
+  (knl-unary-app
+    "pair?"
+    (fn (v) (and (list? v) (> (length v) 0)))))
+
+(define knl-append-step
+  (fn (xs ys)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) ys)
+      (:else (cons (first xs) (knl-append-step (rest xs) ys))))))
+
+(define knl-all-lists?
+  (fn (xs)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) true)
+      ((list? (first xs)) (knl-all-lists? (rest xs)))
+      (:else false))))
+
+(define knl-append-all
+  (fn (lists)
+    (cond
+      ((or (nil? lists) (= (length lists) 0)) (list))
+      ((= (length lists) 1) (first lists))
+      (:else
+        (knl-append-step (first lists)
+                         (knl-append-all (rest lists)))))))
+
+(define kernel-append-applicative
+  (kernel-make-primitive-applicative
+    (fn (args)
+      (cond
+        ((knl-all-lists? args) (knl-append-all args))
+        (:else (error "append: all arguments must be lists"))))))
+
+(define knl-reverse-step
+  (fn (xs acc)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) acc)
+      (:else (knl-reverse-step (rest xs) (cons (first xs) acc))))))
+
+(define kernel-reverse-applicative
+  (knl-unary-app "reverse"
+    (fn (xs)
+      (cond
+        ((not (list? xs)) (error "reverse: argument must be a list"))
+        (:else (knl-reverse-step xs (list)))))))
+
+(define kernel-not-applicative (knl-unary-app "not" (fn (v) (not v))))
+
+;; Type predicates (Kernel-visible). Note `string?` covers BOTH symbols
+;; and string-literals in our representation (symbols are bare SX
+;; strings); a `kernel-string?` applicative distinguishes the two if
+;; needed.
+(define kernel-number?-applicative
+  (knl-unary-app "number?" (fn (v) (number? v))))
+(define kernel-string?-applicative
+  (knl-unary-app "string?" (fn (v) (string? v))))
+(define kernel-list?-applicative
+  (knl-unary-app "list?" (fn (v) (list? v))))
+(define kernel-boolean?-applicative
+  (knl-unary-app "boolean?" (fn (v) (boolean? v))))
+(define kernel-symbol?-applicative
+  (knl-unary-app "symbol?" (fn (v) (string? v))))
+
+(define kernel-eq?-applicative (knl-bin-app "eq?" (fn (a b) (= a b))))
+
+;; ── the standard environment ────────────────────────────────────
+
+(define
+  kernel-equal?-applicative
+  (knl-bin-app "equal?" (fn (a b) (= a b))))
+
+;; ── List combinators: map / filter / reduce ─────────────────────
+;; These re-enter the evaluator on each element, so they use the
+;; with-env applicative constructor.
+
+;; When the combiner is an applicative, we MUST unwrap before calling
+;; — otherwise kernel-combine will re-evaluate the already-evaluated
+;; element values (and crash if an element is itself a list).
+(define knl-apply-op
+  (fn (combiner)
+    (cond
+      ((kernel-applicative? combiner) (kernel-unwrap combiner))
+      (:else combiner))))
+
+(define knl-map-step
+  (fn (fn-val xs dyn-env)
+    (let ((op (knl-apply-op fn-val)))
+      (knl-map-walk op xs dyn-env))))
+
+(define knl-map-walk
+  (fn (op xs dyn-env)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) (list))
+      (:else
+        (cons (kernel-combine op (list (first xs)) dyn-env)
+              (knl-map-walk op (rest xs) dyn-env))))))
+
+(define kernel-map-applicative
+  (kernel-make-primitive-applicative-with-env
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 2))
+          (error "map: expects (fn list)"))
+        ((not (kernel-combiner? (first args)))
+          (error "map: first arg must be a combiner"))
+        ((not (list? (nth args 1)))
+          (error "map: second arg must be a list"))
+        (:else (knl-map-step (first args) (nth args 1) dyn-env))))))
+
+(define knl-filter-step
+  (fn (pred xs dyn-env)
+    (knl-filter-walk (knl-apply-op pred) xs dyn-env)))
+
+(define knl-filter-walk
+  (fn (op xs dyn-env)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) (list))
+      (:else
+        (let ((keep? (kernel-combine op (list (first xs)) dyn-env)))
+          (cond
+            (keep?
+              (cons (first xs) (knl-filter-walk op (rest xs) dyn-env)))
+            (:else (knl-filter-walk op (rest xs) dyn-env))))))))
+
+(define kernel-filter-applicative
+  (kernel-make-primitive-applicative-with-env
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 2))
+          (error "filter: expects (pred list)"))
+        ((not (kernel-combiner? (first args)))
+          (error "filter: first arg must be a combiner"))
+        ((not (list? (nth args 1)))
+          (error "filter: second arg must be a list"))
+        (:else (knl-filter-step (first args) (nth args 1) dyn-env))))))
+
+(define knl-reduce-step
+  (fn (fn-val xs acc dyn-env)
+    (knl-reduce-walk (knl-apply-op fn-val) xs acc dyn-env)))
+
+(define knl-reduce-walk
+  (fn (op xs acc dyn-env)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) acc)
+      (:else
+        (knl-reduce-walk
+          op
+          (rest xs)
+          (kernel-combine op (list acc (first xs)) dyn-env)
+          dyn-env)))))
+
+;; (apply COMBINER ARGS-LIST) — call COMBINER with the elements of
+;; ARGS-LIST as arguments. The Kernel canonical use: turn a constructed
+;; list of values into a function call. We skip the applicative's
+;; auto-eval step (via unwrap) because ARGS-LIST is already values, not
+;; expressions; for a bare operative, we pass through directly.
+(define kernel-apply-applicative
+  (kernel-make-primitive-applicative-with-env
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 2))
+          (error "apply: expects (combiner args-list)"))
+        ((not (kernel-combiner? (first args)))
+          (error "apply: first arg must be a combiner"))
+        ((not (list? (nth args 1)))
+          (error "apply: second arg must be a list"))
+        (:else
+          (let ((op (cond
+                      ((kernel-applicative? (first args))
+                        (kernel-unwrap (first args)))
+                      (:else (first args)))))
+            (kernel-combine op (nth args 1) dyn-env)))))))
+
+(define kernel-reduce-applicative
+  (kernel-make-primitive-applicative-with-env
+    (fn (args dyn-env)
+      (cond
+        ((not (= (length args) 3))
+          (error "reduce: expects (fn init list)"))
+        ((not (kernel-combiner? (first args)))
+          (error "reduce: first arg must be a combiner"))
+        ((not (list? (nth args 2)))
+          (error "reduce: third arg must be a list"))
+        (:else
+          (knl-reduce-step (first args) (nth args 2)
+                           (nth args 1) dyn-env))))))
+
+;; ── Encapsulations: Kernel's opaque-type idiom ──────────────────
+;;
+;; (make-encapsulation-type) → (encapsulator predicate decapsulator)
+;;
+;; Each call returns three applicatives over a fresh family identity.
+;; - (encapsulator V) → an opaque wrapper around V.
+;; - (predicate V)    → true iff V was wrapped by THIS family.
+;; - (decapsulator W) → the inner value; errors on wrong family.
+;;
+;; Family identity is a fresh empty dict; SX compares dicts by reference,
+;; so two `(make-encapsulation-type)` calls return distinct families.
+;;
+;; Pattern usage (Phase 5 lacks destructuring, so accessors are explicit):
+;;   ($define! triple (make-encapsulation-type))
+;;   ($define! wrap-promise   (car  triple))
+;;   ($define! promise?       (car  (cdr triple)))
+;;   ($define! unwrap-promise (car  (cdr (cdr triple))))
+
+(define kernel-make-encap-type-impl
+  (fn (args)
+    (cond
+      ((not (= (length args) 0))
+        (error "make-encapsulation-type: expects 0 arguments"))
+      (:else
+        (let ((family {}))
+          (let ((encap
+                  (kernel-make-primitive-applicative
+                    (fn (vargs)
+                      (cond
+                        ((not (= (length vargs) 1))
+                          (error "encapsulator: expects 1 argument"))
+                        (:else
+                          {:knl-tag :encap
+                           :family family
+                           :value (first vargs)})))))
+                (pred
+                  (kernel-make-primitive-applicative
+                    (fn (vargs)
+                      (cond
+                        ((not (= (length vargs) 1))
+                          (error "predicate: expects 1 argument"))
+                        (:else
+                          (let ((v (first vargs)))
+                            (and (dict? v)
+                                 (= (get v :knl-tag) :encap)
+                                 (= (get v :family) family))))))))
+                (decap
+                  (kernel-make-primitive-applicative
+                    (fn (vargs)
+                      (cond
+                        ((not (= (length vargs) 1))
+                          (error "decapsulator: expects 1 argument"))
+                        (:else
+                          (let ((v (first vargs)))
+                            (cond
+                              ((not (and (dict? v)
+                                         (= (get v :knl-tag) :encap)))
+                                (error "decapsulator: not an encapsulation"))
+                              ((not (= (get v :family) family))
+                                (error "decapsulator: wrong family"))
+                              (:else (get v :value))))))))))
+            (list encap pred decap)))))))
+
+(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
+        ((< (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)
+            (knl-eval-body (rest args) local)))))))
+
+;; $let* — sequential let. Each binding sees prior names in scope.
+;; Implemented by nesting envs one per binding; the body runs in the
+;; innermost env, so later bindings shadow earlier ones if names repeat.
+(define knl-let*-step
+  (fn (bindings env body-forms)
+    (cond
+      ((or (nil? bindings) (= (length bindings) 0))
+        (knl-eval-body body-forms env))
+      (: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
+              (let ((child (kernel-extend-env env)))
+                (kernel-env-bind! child
+                                  (first b)
+                                  (kernel-eval (nth b 1) env))
+                (knl-let*-step (rest bindings) child body-forms)))))))))
+
+(define kernel-let*-operative
+  (kernel-make-primitive-operative
+    (fn (args dyn-env)
+      (cond
+        ((< (length args) 2)
+          (error "$let*: expects (bindings body...)"))
+        ((not (list? (first args)))
+          (error "$let*: bindings must be a list"))
+        (:else
+          (knl-let*-step (first args) dyn-env (rest args)))))))
+
+(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
+    ()
+    (let
+      ((env (kernel-base-env)))
+      (kernel-env-bind! env "$if" kernel-if-operative)
+      (kernel-env-bind! env "$define!" kernel-define!-operative)
+      (kernel-env-bind! env "$sequence" kernel-sequence-operative)
+      (kernel-env-bind! env "$quote"    kernel-quote-operative)
+      (kernel-env-bind! env "$quasiquote" kernel-quasiquote-operative)
+      (kernel-env-bind! env "$cond"   kernel-cond-operative)
+      (kernel-env-bind! env "$when"   kernel-when-operative)
+      (kernel-env-bind! env "$unless" kernel-unless-operative)
+      (kernel-env-bind! env "$and?"   kernel-and?-operative)
+      (kernel-env-bind! env "$or?"    kernel-or?-operative)
+      (kernel-env-bind! env "eval" kernel-eval-applicative)
+      (kernel-env-bind!
+        env
+        "make-environment"
+        kernel-make-environment-applicative)
+      (kernel-env-bind!
+        env
+        "get-current-environment"
+        kernel-get-current-env-operative)
+      (kernel-env-bind! env "+"
+        (knl-fold-app "+" (fn (a b) (+ a b)) 0 (fn (x) x)))
+      (kernel-env-bind! env "-"
+        (knl-fold-app "-" (fn (a b) (- a b)) 0 (fn (x) (- 0 x))))
+      (kernel-env-bind! env "*"
+        (knl-fold-app "*" (fn (a b) (* a b)) 1 (fn (x) x)))
+      (kernel-env-bind! env "/"
+        (knl-fold-app "/" (fn (a b) (/ a b)) 1 (fn (x) (/ 1 x))))
+      (kernel-env-bind! env "<"   (knl-chain-cmp "<"   (fn (a b) (< a b))))
+      (kernel-env-bind! env ">"   (knl-chain-cmp ">"   (fn (a b) (> a b))))
+      (kernel-env-bind! env "<=?" (knl-chain-cmp "<=?" (fn (a b) (<= a b))))
+      (kernel-env-bind! env ">=?" (knl-chain-cmp ">=?" (fn (a b) (>= a b))))
+      (kernel-env-bind! env "=?" kernel-eq?-applicative)
+      (kernel-env-bind! env "equal?" kernel-equal?-applicative)
+      (kernel-env-bind! env "eq?" kernel-eq?-applicative)
+      (kernel-env-bind! env "cons" kernel-cons-applicative)
+      (kernel-env-bind! env "car" kernel-car-applicative)
+      (kernel-env-bind! env "cdr" kernel-cdr-applicative)
+      (kernel-env-bind! env "list" kernel-list-applicative)
+      (kernel-env-bind! env "length" kernel-length-applicative)
+      (kernel-env-bind! env "null?" kernel-null?-applicative)
+      (kernel-env-bind! env "pair?" kernel-pair?-applicative)
+      (kernel-env-bind! env "map"    kernel-map-applicative)
+      (kernel-env-bind! env "filter" kernel-filter-applicative)
+      (kernel-env-bind! env "reduce" kernel-reduce-applicative)
+      (kernel-env-bind! env "apply"   kernel-apply-applicative)
+      (kernel-env-bind! env "append"  kernel-append-applicative)
+      (kernel-env-bind! env "reverse" kernel-reverse-applicative)
+      (kernel-env-bind! env "number?"  kernel-number?-applicative)
+      (kernel-env-bind! env "string?"  kernel-string?-applicative)
+      (kernel-env-bind! env "list?"    kernel-list?-applicative)
+      (kernel-env-bind! env "boolean?" kernel-boolean?-applicative)
+      (kernel-env-bind! env "symbol?"  kernel-symbol?-applicative)
+      (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 "$let*"        kernel-let*-operative)
+      (kernel-env-bind! env "$define-in!"  kernel-define-in!-operative)
+      env)))

lib/kernel/tests/encap.sx

@@ -0,0 +1,183 @@
+;; lib/kernel/tests/encap.sx — exercises make-encapsulation-type.
+;;
+;; The Phase 5 Kernel idiom: build opaque types whose constructor,
+;; predicate, and accessor are all standard Kernel applicatives. The
+;; identity is per-call, so two `(make-encapsulation-type)` calls
+;; produce non-interchangeable families.
+
+(define ken-test-pass 0)
+(define ken-test-fail 0)
+(define ken-test-fails (list))
+
+(define
+  ken-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! ken-test-pass (+ ken-test-pass 1))
+      (begin
+        (set! ken-test-fail (+ ken-test-fail 1))
+        (append! ken-test-fails {:name name :actual actual :expected expected})))))
+
+(define ken-eval-in (fn (src env) (kernel-eval (kernel-parse src) env)))
+
+;; A helper that builds a standard env with `encap`/`pred?`/`decap`
+;; bound from a single call to make-encapsulation-type.
+(define
+  ken-make-encap-env
+  (fn
+    ()
+    (let
+      ((env (kernel-standard-env)))
+      (ken-eval-in "($define! triple (make-encapsulation-type))" env)
+      (ken-eval-in "($define! encap (car triple))" env)
+      (ken-eval-in "($define! pred? (car (cdr triple)))" env)
+      (ken-eval-in "($define! decap (car (cdr (cdr triple))))" env)
+      env)))
+
+;; ── construction ────────────────────────────────────────────────
+(ken-test
+  "make: returns 3-element list"
+  (ken-eval-in "(length (make-encapsulation-type))" (kernel-standard-env))
+  3)
+
+(ken-test
+  "make: first is applicative"
+  (kernel-applicative?
+    (ken-eval-in "(car (make-encapsulation-type))" (kernel-standard-env)))
+  true)
+
+(ken-test
+  "make: second is applicative"
+  (kernel-applicative?
+    (ken-eval-in
+      "(car (cdr (make-encapsulation-type)))"
+      (kernel-standard-env)))
+  true)
+
+(ken-test
+  "make: third is applicative"
+  (kernel-applicative?
+    (ken-eval-in
+      "(car (cdr (cdr (make-encapsulation-type))))"
+      (kernel-standard-env)))
+  true)
+
+;; ── round-trip ──────────────────────────────────────────────────
+(ken-test
+  "round-trip: number"
+  (ken-eval-in "(decap (encap 42))" (ken-make-encap-env))
+  42)
+
+(ken-test
+  "round-trip: string"
+  (ken-eval-in "(decap (encap ($quote hello)))" (ken-make-encap-env))
+  "hello")
+
+(ken-test
+  "round-trip: list"
+  (ken-eval-in "(decap (encap (list 1 2 3)))" (ken-make-encap-env))
+  (list 1 2 3))
+
+;; ── predicate ───────────────────────────────────────────────────
+(ken-test
+  "pred?: wrapped value"
+  (ken-eval-in "(pred? (encap 1))" (ken-make-encap-env))
+  true)
+
+(ken-test
+  "pred?: raw value"
+  (ken-eval-in "(pred? 1)" (ken-make-encap-env))
+  false)
+
+(ken-test
+  "pred?: raw string"
+  (ken-eval-in "(pred? ($quote foo))" (ken-make-encap-env))
+  false)
+
+(ken-test
+  "pred?: raw list"
+  (ken-eval-in "(pred? (list))" (ken-make-encap-env))
+  false)
+
+;; ── opacity: different families are not interchangeable ─────────
+(ken-test
+  "opacity: foreign value rejected by predicate"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in "($define! tA (make-encapsulation-type))" env)
+    (ken-eval-in "($define! tB (make-encapsulation-type))" env)
+    (ken-eval-in "($define! encA (car tA))" env)
+    (ken-eval-in "($define! predB (car (cdr tB)))" env)
+    (ken-eval-in "(predB (encA 42))" env))
+  false)
+
+(ken-test
+  "opacity: decap rejects foreign value"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in "($define! tA (make-encapsulation-type))" env)
+    (ken-eval-in "($define! tB (make-encapsulation-type))" env)
+    (ken-eval-in "($define! encA (car tA))" env)
+    (ken-eval-in "($define! decapB (car (cdr (cdr tB))))" env)
+    (guard (e (true :raised)) (ken-eval-in "(decapB (encA 42))" env)))
+  :raised)
+
+(ken-test
+  "opacity: decap rejects raw value"
+  (guard
+    (e (true :raised))
+    (ken-eval-in "(decap 42)" (ken-make-encap-env)))
+  :raised)
+
+;; ── promise: classic Kernel encapsulation use case ──────────────
+;; A "promise" wraps a thunk to compute on demand and memoises the
+;; first result. Built entirely with the standard encap idiom.
+(ken-test
+  "promise: force returns thunk result"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in
+      "($sequence\n         ($define! ptriple (make-encapsulation-type))\n         ($define! make-promise (car ptriple))\n         ($define! promise? (car (cdr ptriple)))\n         ($define! decode-promise (car (cdr (cdr ptriple))))\n         ($define! force ($lambda (p) ((decode-promise p))))\n         ($define! delay ($lambda (thunk) (make-promise thunk)))\n         (force (delay ($lambda () (+ 19 23)))))"
+      env))
+  42)
+
+(ken-test
+  "promise: promise? recognises its own type"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in
+      "($sequence\n         ($define! ptriple (make-encapsulation-type))\n         ($define! make-promise (car ptriple))\n         ($define! promise? (car (cdr ptriple)))\n         (promise? (make-promise ($lambda () 42))))"
+      env))
+  true)
+
+(ken-test
+  "promise: promise? false on plain value"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in
+      "($sequence\n         ($define! ptriple (make-encapsulation-type))\n         ($define! promise? (car (cdr ptriple)))\n         (promise? 99))"
+      env))
+  false)
+
+;; ── independent families don't leak ─────────────────────────────
+(ken-test
+  "two families: distinct identity"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in
+      "($sequence\n         ($define! t1 (make-encapsulation-type))\n         ($define! t2 (make-encapsulation-type))\n         ($define! enc1 (car t1))\n         ($define! pred2 (car (cdr t2)))\n         (pred2 (enc1 ($quote stuff))))"
+      env))
+  false)
+
+(ken-test
+  "same family: re-bound shares identity"
+  (let
+    ((env (kernel-standard-env)))
+    (ken-eval-in
+      "($sequence\n         ($define! t (make-encapsulation-type))\n         ($define! e (car t))\n         ($define! p (car (cdr t)))\n         ($define! d (car (cdr (cdr t))))\n         (list (p (e 7)) (d (e 7))))"
+      env))
+  (list true 7))
+
+(define ken-tests-run! (fn () {:total (+ ken-test-pass ken-test-fail) :passed ken-test-pass :failed ken-test-fail :fails ken-test-fails}))

lib/kernel/tests/eval.sx

@@ -0,0 +1,270 @@
+;; lib/kernel/tests/eval.sx — exercises lib/kernel/eval.sx.
+;;
+;; Phase 2 covers literal evaluation, symbol lookup, and combiner
+;; dispatch (operative vs applicative). Standard-environment operatives
+;; ($if, $define!, $lambda, …) arrive in Phase 4, so tests build a
+;; minimal env on the fly and verify the dispatch contract directly.
+
+(define ke-test-pass 0)
+(define ke-test-fail 0)
+(define ke-test-fails (list))
+
+(define
+  ke-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! ke-test-pass (+ ke-test-pass 1))
+      (begin
+        (set! ke-test-fail (+ ke-test-fail 1))
+        (append! ke-test-fails {:name name :actual actual :expected expected})))))
+
+;; ── helpers ──────────────────────────────────────────────────────
+
+(define ke-eval-src (fn (src env) (kernel-eval (kernel-parse src) env)))
+
+(define
+  ke-make-test-env
+  (fn
+    ()
+    (let
+      ((env (kernel-make-env)))
+      (kernel-env-bind!
+        env
+        "+"
+        (kernel-make-primitive-applicative
+          (fn (args) (+ (first args) (nth args 1)))))
+      (kernel-env-bind!
+        env
+        "list"
+        (kernel-make-primitive-applicative (fn (args) args)))
+      (kernel-env-bind!
+        env
+        "$quote"
+        (kernel-make-primitive-operative (fn (args dyn-env) (first args))))
+      (kernel-env-bind!
+        env
+        "$if"
+        (kernel-make-primitive-operative
+          (fn
+            (args dyn-env)
+            (if
+              (kernel-eval (first args) dyn-env)
+              (kernel-eval (nth args 1) dyn-env)
+              (kernel-eval (nth args 2) dyn-env)))))
+      env)))
+
+;; ── literal evaluation ───────────────────────────────────────────
+(ke-test "lit: number" (ke-eval-src "42" (kernel-make-env)) 42)
+(ke-test "lit: zero" (ke-eval-src "0" (kernel-make-env)) 0)
+(ke-test "lit: float" (ke-eval-src "3.14" (kernel-make-env)) 3.14)
+(ke-test "lit: true" (ke-eval-src "#t" (kernel-make-env)) true)
+(ke-test "lit: false" (ke-eval-src "#f" (kernel-make-env)) false)
+(ke-test "lit: string" (ke-eval-src "\"hello\"" (kernel-make-env)) "hello")
+(ke-test "lit: empty list" (ke-eval-src "()" (kernel-make-env)) (list))
+
+;; ── symbol lookup ────────────────────────────────────────────────
+(ke-test
+  "sym: bound to number"
+  (let
+    ((env (kernel-make-env)))
+    (kernel-env-bind! env "x" 100)
+    (ke-eval-src "x" env))
+  100)
+
+(ke-test
+  "sym: bound to string"
+  (let
+    ((env (kernel-make-env)))
+    (kernel-env-bind! env "name" "kernel")
+    (ke-eval-src "name" env))
+  "kernel")
+
+(ke-test
+  "sym: parent-chain lookup"
+  (let
+    ((p (kernel-make-env)))
+    (kernel-env-bind! p "outer" 1)
+    (let
+      ((c (kernel-extend-env p)))
+      (kernel-env-bind! c "inner" 2)
+      (+ (ke-eval-src "outer" c) (ke-eval-src "inner" c))))
+  3)
+
+(ke-test
+  "sym: child shadows parent"
+  (let
+    ((p (kernel-make-env)))
+    (kernel-env-bind! p "x" 1)
+    (let
+      ((c (kernel-extend-env p)))
+      (kernel-env-bind! c "x" 2)
+      (ke-eval-src "x" c)))
+  2)
+
+(ke-test
+  "env-has?: present"
+  (let
+    ((env (kernel-make-env)))
+    (kernel-env-bind! env "x" 1)
+    (kernel-env-has? env "x"))
+  true)
+
+(ke-test
+  "env-has?: missing"
+  (kernel-env-has? (kernel-make-env) "nope")
+  false)
+
+;; ── tagged-value predicates ─────────────────────────────────────
+(ke-test
+  "tag: operative?"
+  (kernel-operative? (kernel-make-primitive-operative (fn (a e) nil)))
+  true)
+
+(ke-test
+  "tag: applicative?"
+  (kernel-applicative? (kernel-make-primitive-applicative (fn (a) nil)))
+  true)
+
+(ke-test
+  "tag: combiner? operative"
+  (kernel-combiner? (kernel-make-primitive-operative (fn (a e) nil)))
+  true)
+
+(ke-test
+  "tag: combiner? applicative"
+  (kernel-combiner? (kernel-make-primitive-applicative (fn (a) nil)))
+  true)
+
+(ke-test "tag: combiner? number" (kernel-combiner? 42) false)
+
+(ke-test "tag: number is not operative" (kernel-operative? 42) false)
+
+;; ── wrap / unwrap ────────────────────────────────────────────────
+(ke-test
+  "wrap+unwrap roundtrip"
+  (let
+    ((op (kernel-make-primitive-operative (fn (a e) :sentinel))))
+    (= (kernel-unwrap (kernel-wrap op)) op))
+  true)
+
+(ke-test
+  "wrap produces applicative"
+  (kernel-applicative?
+    (kernel-wrap (kernel-make-primitive-operative (fn (a e) nil))))
+  true)
+
+(ke-test
+  "unwrap of primitive-applicative is operative"
+  (kernel-operative?
+    (kernel-unwrap (kernel-make-primitive-applicative (fn (a) nil))))
+  true)
+
+;; ── combiner dispatch — applicatives evaluate their args ─────────
+(ke-test
+  "applicative: simple call"
+  (ke-eval-src "(+ 2 3)" (ke-make-test-env))
+  5)
+
+(ke-test
+  "applicative: nested"
+  (ke-eval-src "(+ (+ 1 2) (+ 3 4))" (ke-make-test-env))
+  10)
+
+(ke-test
+  "applicative: receives evaluated args"
+  (let
+    ((env (ke-make-test-env)))
+    (kernel-env-bind! env "x" 10)
+    (kernel-env-bind! env "y" 20)
+    (ke-eval-src "(+ x y)" env))
+  30)
+
+(ke-test
+  "applicative: list builds an SX list of values"
+  (let
+    ((env (ke-make-test-env)))
+    (kernel-env-bind! env "a" 1)
+    (kernel-env-bind! env "b" 2)
+    (ke-eval-src "(list a b 99)" env))
+  (list 1 2 99))
+
+;; ── combiner dispatch — operatives DO NOT evaluate their args ───
+(ke-test
+  "operative: $quote returns symbol unevaluated"
+  (ke-eval-src "($quote foo)" (ke-make-test-env))
+  "foo")
+
+(ke-test
+  "operative: $quote returns list unevaluated"
+  (ke-eval-src "($quote (+ 1 2))" (ke-make-test-env))
+  (list "+" 1 2))
+
+(ke-test
+  "operative: $if true branch"
+  (ke-eval-src "($if #t 1 2)" (ke-make-test-env))
+  1)
+
+(ke-test
+  "operative: $if false branch"
+  (ke-eval-src "($if #f 1 2)" (ke-make-test-env))
+  2)
+
+(ke-test
+  "operative: $if doesn't eval untaken branch"
+  (ke-eval-src "($if #t 99 unbound)" (ke-make-test-env))
+  99)
+
+(ke-test
+  "operative: $if takes dynamic env for branches"
+  (let
+    ((env (ke-make-test-env)))
+    (kernel-env-bind! env "x" 7)
+    (ke-eval-src "($if #t x 0)" env))
+  7)
+
+;; ── operative built ON-THE-FLY can inspect raw expressions ──────
+(ke-test
+  "operative: sees raw symbol head"
+  (let
+    ((env (kernel-make-env)))
+    (kernel-env-bind!
+      env
+      "head"
+      (kernel-make-primitive-operative (fn (args dyn-env) (first args))))
+    (ke-eval-src "(head (+ 1 2))" env))
+  (list "+" 1 2))
+
+(ke-test
+  "operative: sees dynamic env"
+  (let
+    ((env (kernel-make-env)))
+    (kernel-env-bind! env "x" 999)
+    (kernel-env-bind!
+      env
+      "$probe"
+      (kernel-make-primitive-operative
+        (fn (args dyn-env) (kernel-env-lookup dyn-env "x"))))
+    (ke-eval-src "($probe ignored)" env))
+  999)
+
+;; ── error cases ──────────────────────────────────────────────────
+(ke-test
+  "error: unbound symbol"
+  (guard
+    (e (true :raised))
+    (kernel-eval (kernel-parse "nope") (kernel-make-env)))
+  :raised)
+
+(ke-test
+  "error: combine non-combiner"
+  (guard
+    (e (true :raised))
+    (let
+      ((env (kernel-make-env)))
+      (kernel-env-bind! env "x" 42)
+      (kernel-eval (kernel-parse "(x 1)") env)))
+  :raised)
+
+(define ke-tests-run! (fn () {:total (+ ke-test-pass ke-test-fail) :passed ke-test-pass :failed ke-test-fail :fails ke-test-fails}))

lib/kernel/tests/hygiene.sx

@@ -0,0 +1,220 @@
+;; 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)
+
+;; ── $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 () {:total (+ kh-test-pass kh-test-fail) :passed kh-test-pass :failed kh-test-fail :fails kh-test-fails}))

lib/kernel/tests/metacircular.sx

@@ -0,0 +1,162 @@
+;; lib/kernel/tests/metacircular.sx — Kernel-in-Kernel demo.
+;;
+;; Demonstrates reflective completeness: a Kernel program implements
+;; a recognisable subset of Kernel's own evaluation rules and produces
+;; matching values for a battery of test programs.
+;;
+;; This is a SHALLOW metacircular: it dispatches on expression shape
+;; itself (numbers, booleans, lists, symbols), recursively meta-evals
+;; each argument of an applicative call, and delegates only to the
+;; host evaluator for the leaf cases (operatives, symbol lookup). The
+;; point is to show that env-as-value, first-class operatives, and
+;; first-class evaluators all line up — enough so a Kernel program
+;; can itself reason about Kernel programs.
+
+(define kmc-test-pass 0)
+(define kmc-test-fail 0)
+(define kmc-test-fails (list))
+
+(define
+  kmc-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! kmc-test-pass (+ kmc-test-pass 1))
+      (begin
+        (set! kmc-test-fail (+ kmc-test-fail 1))
+        (append! kmc-test-fails {:name name :actual actual :expected expected})))))
+
+;; Build a Kernel env with m-eval and m-apply defined. The two refer
+;; to each other and to standard primitives, so we use the standard
+;; env as the static-env for both.
+(define
+  kmc-make-env
+  (fn
+    ()
+    (let
+      ((env (kernel-standard-env)))
+      (kernel-eval
+        (kernel-parse
+          "($define! m-eval\n           ($lambda (expr env)\n             ($cond\n               ((number? expr) expr)\n               ((boolean? expr) expr)\n               ((null? expr) expr)\n               ((symbol? expr) (eval expr env))\n               ((list? expr)\n                 ($let ((head-val (m-eval (car expr) env)))\n                   ($cond\n                     ((applicative? head-val)\n                       (apply head-val\n                         (map ($lambda (a) (m-eval a env)) (cdr expr))))\n                     (else (eval expr env)))))\n               (else expr))))")
+        env)
+      env)))
+
+(define
+  kmc-eval
+  (fn
+    (src)
+    (let
+      ((env (kmc-make-env)))
+      (kernel-eval
+        (kernel-parse
+          (str "(m-eval (quote " src ") (get-current-environment))"))
+        env))))
+
+;; ── literals self-evaluate via m-eval ──────────────────────────
+(kmc-test
+  "m-eval: integer literal"
+  (kernel-eval
+    (kernel-parse "(m-eval 42 (get-current-environment))")
+    (kmc-make-env))
+  42)
+
+(kmc-test
+  "m-eval: boolean true"
+  (kernel-eval
+    (kernel-parse "(m-eval #t (get-current-environment))")
+    (kmc-make-env))
+  true)
+
+(kmc-test
+  "m-eval: boolean false"
+  (kernel-eval
+    (kernel-parse "(m-eval #f (get-current-environment))")
+    (kmc-make-env))
+  false)
+
+(kmc-test
+  "m-eval: empty list"
+  (kernel-eval
+    (kernel-parse "(m-eval () (get-current-environment))")
+    (kmc-make-env))
+  (list))
+
+;; ── symbol lookup goes through env ─────────────────────────────
+(kmc-test
+  "m-eval: symbol lookup"
+  (let
+    ((env (kmc-make-env)))
+    (kernel-eval (kernel-parse "($define! shared-x 99)") env)
+    (kernel-eval
+      (kernel-parse "(m-eval ($quote shared-x) (get-current-environment))")
+      env))
+  99)
+
+;; ── applicative calls are dispatched by m-eval recursively ─────
+(kmc-test
+  "m-eval: addition"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote (+ 1 2)) (get-current-environment))")
+    (kmc-make-env))
+  3)
+
+(kmc-test
+  "m-eval: nested arithmetic"
+  (kernel-eval
+    (kernel-parse
+      "(m-eval ($quote (+ (* 2 3) (- 10 4))) (get-current-environment))")
+    (kmc-make-env))
+  12)
+
+(kmc-test
+  "m-eval: variadic +"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote (+ 1 2 3 4 5)) (get-current-environment))")
+    (kmc-make-env))
+  15)
+
+(kmc-test
+  "m-eval: list construction"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote (list 1 2 3)) (get-current-environment))")
+    (kmc-make-env))
+  (list 1 2 3))
+
+(kmc-test "m-eval: cons reverse-style"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote (cons 0 (list 1 2))) (get-current-environment))")
+    (kmc-make-env)) (list 0 1 2))
+
+(kmc-test "m-eval: nested apply"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote (apply + (list 10 20 30))) (get-current-environment))")
+    (kmc-make-env)) 60)
+
+;; ── operatives delegate to host eval (transparently for the caller) ─
+(kmc-test
+  "m-eval: $if true branch (via delegation)"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote ($if #t 1 2)) (get-current-environment))")
+    (kmc-make-env))
+  1)
+
+(kmc-test
+  "m-eval: $if false branch"
+  (kernel-eval
+    (kernel-parse "(m-eval ($quote ($if #f 1 2)) (get-current-environment))")
+    (kmc-make-env))
+  2)
+
+;; ── m-eval can call a user-defined lambda ──────────────────────
+(kmc-test
+  "m-eval: user lambda call"
+  (let
+    ((env (kmc-make-env)))
+    (kernel-eval (kernel-parse "($define! sq ($lambda (x) (* x x)))") env)
+    (kernel-eval
+      (kernel-parse "(m-eval ($quote (sq 7)) (get-current-environment))")
+      env))
+  49)
+
+(define kmc-tests-run! (fn () {:total (+ kmc-test-pass kmc-test-fail) :passed kmc-test-pass :failed kmc-test-fail :fails kmc-test-fails}))

lib/kernel/tests/parse.sx

@@ -0,0 +1,158 @@
+;; lib/kernel/tests/parse.sx — exercises lib/kernel/parser.sx.
+
+(define knl-test-pass 0)
+(define knl-test-fail 0)
+(define knl-test-fails (list))
+
+(define
+  knl-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! knl-test-pass (+ knl-test-pass 1))
+      (begin
+        (set! knl-test-fail (+ knl-test-fail 1))
+        (append! knl-test-fails {:name name :actual actual :expected expected})))))
+
+;; ── atoms: numbers ────────────────────────────────────────────────
+(knl-test "num: integer" (kernel-parse "42") 42)
+(knl-test "num: zero" (kernel-parse "0") 0)
+(knl-test "num: negative integer" (kernel-parse "-7") -7)
+(knl-test "num: positive sign" (kernel-parse "+5") 5)
+(knl-test "num: float" (kernel-parse "3.14") 3.14)
+(knl-test "num: negative float" (kernel-parse "-2.5") -2.5)
+(knl-test "num: leading dot" (kernel-parse ".5") 0.5)
+(knl-test "num: exponent" (kernel-parse "1e3") 1000)
+(knl-test "num: exponent with sign" (kernel-parse "2.5e-1") 0.25)
+(knl-test "num: capital E exponent" (kernel-parse "1E2") 100)
+
+;; ── atoms: booleans ───────────────────────────────────────────────
+(knl-test "bool: true" (kernel-parse "#t") true)
+(knl-test "bool: false" (kernel-parse "#f") false)
+
+;; ── atoms: empty list (Kernel nil) ────────────────────────────────
+(knl-test "nil: ()" (kernel-parse "()") (list))
+(knl-test "nil: (= () (list))" (= (kernel-parse "()") (list)) true)
+
+;; ── atoms: symbols ────────────────────────────────────────────────
+(knl-test "sym: word" (kernel-parse "foo") "foo")
+(knl-test "sym: hyphenated" (kernel-parse "foo-bar") "foo-bar")
+(knl-test "sym: dollar-bang" (kernel-parse "$define!") "$define!")
+(knl-test "sym: question" (kernel-parse "null?") "null?")
+(knl-test "sym: lt-eq" (kernel-parse "<=") "<=")
+(knl-test "sym: bare plus" (kernel-parse "+") "+")
+(knl-test "sym: bare minus" (kernel-parse "-") "-")
+(knl-test "sym: plus-letter" (kernel-parse "+a") "+a")
+(knl-test "sym: arrow" (kernel-parse "->") "->")
+(knl-test "sym: dot-prefixed" (kernel-parse ".foo") ".foo")
+
+;; ── atoms: strings ────────────────────────────────────────────────
+(knl-test "str: empty" (kernel-string-value (kernel-parse "\"\"")) "")
+(knl-test
+  "str: hello"
+  (kernel-string-value (kernel-parse "\"hello\""))
+  "hello")
+(knl-test "str: predicate" (kernel-string? (kernel-parse "\"x\"")) true)
+(knl-test "str: not symbol" (kernel-string? (kernel-parse "x")) false)
+(knl-test
+  "str: escape newline"
+  (kernel-string-value (kernel-parse "\"a\\nb\""))
+  "a\nb")
+(knl-test
+  "str: escape tab"
+  (kernel-string-value (kernel-parse "\"a\\tb\""))
+  "a\tb")
+(knl-test
+  "str: escape quote"
+  (kernel-string-value (kernel-parse "\"a\\\"b\""))
+  "a\"b")
+(knl-test
+  "str: escape backslash"
+  (kernel-string-value (kernel-parse "\"a\\\\b\""))
+  "a\\b")
+
+;; ── lists ─────────────────────────────────────────────────────────
+(knl-test "list: flat" (kernel-parse "(a b c)") (list "a" "b" "c"))
+(knl-test
+  "list: nested"
+  (kernel-parse "(a (b c) d)")
+  (list "a" (list "b" "c") "d"))
+(knl-test
+  "list: deeply nested"
+  (kernel-parse "(((x)))")
+  (list (list (list "x"))))
+(knl-test
+  "list: mixed atoms"
+  (kernel-parse "(1 #t foo)")
+  (list 1 true "foo"))
+(knl-test
+  "list: empty inside"
+  (kernel-parse "(a () b)")
+  (list "a" (list) "b"))
+
+;; ── whitespace + comments ─────────────────────────────────────────
+(knl-test "ws: leading" (kernel-parse "   42") 42)
+(knl-test "ws: trailing" (kernel-parse "42   ") 42)
+(knl-test "ws: tabs/newlines" (kernel-parse "\n\t  42 \n") 42)
+(knl-test "comment: line" (kernel-parse "; nope\n42") 42)
+(knl-test "comment: trailing" (kernel-parse "42 ; tail") 42)
+(knl-test
+  "comment: inside list"
+  (kernel-parse "(a ; mid\n  b)")
+  (list "a" "b"))
+
+;; ── parse-all ─────────────────────────────────────────────────────
+(knl-test "all: empty input" (kernel-parse-all "") (list))
+(knl-test "all: only whitespace" (kernel-parse-all "   ") (list))
+(knl-test "all: only comment" (kernel-parse-all "; nope") (list))
+(knl-test
+  "all: three forms"
+  (kernel-parse-all "1 2 3")
+  (list 1 2 3))
+(knl-test
+  "all: mixed"
+  (kernel-parse-all "($if #t 1 2) foo")
+  (list (list "$if" true 1 2) "foo"))
+
+;; ── classic Kernel programs (smoke) ───────────────────────────────
+(knl-test
+  "klisp: vau form"
+  (kernel-parse "($vau (x e) e (eval x e))")
+  (list "$vau" (list "x" "e") "e" (list "eval" "x" "e")))
+(knl-test
+  "klisp: define lambda"
+  (kernel-parse "($define! sq ($lambda (x) (* x x)))")
+  (list "$define!" "sq" (list "$lambda" (list "x") (list "*" "x" "x"))))
+
+;; ── round-trip identity for primitive symbols ─────────────────────
+(knl-test "identity: $vau" (kernel-parse "$vau") "$vau")
+(knl-test "identity: $lambda" (kernel-parse "$lambda") "$lambda")
+(knl-test "identity: wrap" (kernel-parse "wrap") "wrap")
+(knl-test "identity: unwrap" (kernel-parse "unwrap") "unwrap")
+
+;; ── reader macros ─────────────────────────────────────────────────
+(knl-test "reader: 'foo  → ($quote foo)"
+  (kernel-parse "'foo") (list "$quote" "foo"))
+(knl-test "reader: '(a b c)"
+  (kernel-parse "'(a b c)") (list "$quote" (list "a" "b" "c")))
+(knl-test "reader: nested quotes"
+  (kernel-parse "''x")
+  (list "$quote" (list "$quote" "x")))
+(knl-test "reader: ` quasiquote"
+  (kernel-parse "`x") (list "$quasiquote" "x"))
+(knl-test "reader: , unquote"
+  (kernel-parse ",x") (list "$unquote" "x"))
+(knl-test "reader: ,@ unquote-splicing"
+  (kernel-parse ",@x") (list "$unquote-splicing" "x"))
+(knl-test "reader: quasi-mix"
+  (kernel-parse "`(a ,b ,@c)")
+  (list "$quasiquote"
+        (list "a"
+              (list "$unquote" "b")
+              (list "$unquote-splicing" "c"))))
+(knl-test "reader: quote separates from neighbouring atom"
+  (kernel-parse "(a 'b c)")
+  (list "a" (list "$quote" "b") "c"))
+
+(define knl-tests-run! (fn () {:total (+ knl-test-pass knl-test-fail) :passed knl-test-pass :failed knl-test-fail :fails knl-test-fails}))

lib/kernel/tests/standard.sx

@@ -0,0 +1,445 @@
+;; lib/kernel/tests/standard.sx — exercises the Kernel standard env.
+;;
+;; Phase 4 tests verify that the standard env is rich enough to run
+;; classic Kernel programs: factorial via recursion, list operations,
+;; first-class environment manipulation. Each test starts from a fresh
+;; standard env via `(kernel-standard-env)`.
+
+(define ks-test-pass 0)
+(define ks-test-fail 0)
+(define ks-test-fails (list))
+
+(define
+  ks-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! ks-test-pass (+ ks-test-pass 1))
+      (begin
+        (set! ks-test-fail (+ ks-test-fail 1))
+        (append! ks-test-fails {:name name :actual actual :expected expected})))))
+
+(define
+  ks-eval
+  (fn (src) (kernel-eval (kernel-parse src) (kernel-standard-env))))
+
+(define ks-eval-in (fn (src env) (kernel-eval (kernel-parse src) env)))
+
+(define
+  ks-eval-all
+  (fn (src env) (kernel-eval-program (kernel-parse-all src) env)))
+
+;; ── $if ──────────────────────────────────────────────────────────
+(ks-test "if: true branch" (ks-eval "($if #t 1 2)") 1)
+(ks-test "if: false branch" (ks-eval "($if #f 1 2)") 2)
+(ks-test "if: predicate"
+  (ks-eval "($if (<=? 1 2) ($quote yes) ($quote no))") "yes")
+(ks-test
+  "if: untaken branch not evaluated"
+  (ks-eval "($if #t 42 nope)")
+  42)
+
+;; ── $define! + arithmetic ───────────────────────────────────────
+(ks-test
+  "define!: returns value"
+  (let ((env (kernel-standard-env))) (ks-eval-in "($define! x 5)" env))
+  5)
+
+(ks-test
+  "define!: bound in env"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in "($define! x 5)" env)
+    (ks-eval-in "x" env))
+  5)
+
+(ks-test "arith: +" (ks-eval "(+ 2 3)") 5)
+(ks-test "arith: -" (ks-eval "(- 10 4)") 6)
+(ks-test "arith: *" (ks-eval "(* 6 7)") 42)
+(ks-test "arith: /" (ks-eval "(/ 20 5)") 4)
+(ks-test "cmp: <  true" (ks-eval "(< 1 2)") true)
+(ks-test "cmp: <  false" (ks-eval "(< 2 1)") false)
+(ks-test "cmp: >=" (ks-eval "(>=? 2 2)") true)
+(ks-test "cmp: <=" (ks-eval "(<=? 2 3)") true)
+(ks-test "cmp: =" (ks-eval "(=? 7 7)") true)
+
+;; ── $sequence ────────────────────────────────────────────────────
+(ks-test "sequence: empty" (ks-eval "($sequence)") nil)
+(ks-test "sequence: single" (ks-eval "($sequence 99)") 99)
+(ks-test
+  "sequence: multi-effect"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in "($sequence ($define! a 1) ($define! b 2) (+ a b))" env))
+  3)
+
+;; ── list primitives ──────────────────────────────────────────────
+(ks-test
+  "list: builds"
+  (ks-eval "(list 1 2 3)")
+  (list 1 2 3))
+(ks-test "list: empty" (ks-eval "(list)") (list))
+(ks-test
+  "cons: prepend"
+  (ks-eval "(cons 0 (list 1 2 3))")
+  (list 0 1 2 3))
+(ks-test "car: head" (ks-eval "(car (list 10 20 30))") 10)
+(ks-test
+  "cdr: tail"
+  (ks-eval "(cdr (list 10 20 30))")
+  (list 20 30))
+(ks-test "length: 3" (ks-eval "(length (list 1 2 3))") 3)
+(ks-test "length: 0" (ks-eval "(length (list))") 0)
+(ks-test "null?: empty" (ks-eval "(null? (list))") true)
+(ks-test "null?: nonempty" (ks-eval "(null? (list 1))") false)
+(ks-test "pair?: empty" (ks-eval "(pair? (list))") false)
+(ks-test "pair?: nonempty" (ks-eval "(pair? (list 1))") true)
+
+;; ── $quote ───────────────────────────────────────────────────────
+(ks-test "quote: symbol" (ks-eval "($quote foo)") "foo")
+(ks-test
+  "quote: list"
+  (ks-eval "($quote (+ 1 2))")
+  (list "+" 1 2))
+
+;; ── boolean / not ────────────────────────────────────────────────
+(ks-test "not: true" (ks-eval "(not #t)") false)
+(ks-test "not: false" (ks-eval "(not #f)") true)
+
+;; ── factorial ────────────────────────────────────────────────────
+(ks-test
+  "factorial: 5!"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! factorial ($lambda (n) ($if (<=? n 1) 1 (* n (factorial (- n 1))))))"
+      env)
+    (ks-eval-in "(factorial 5)" env))
+  120)
+
+(ks-test
+  "factorial: 0! = 1"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! factorial ($lambda (n) ($if (<=? n 1) 1 (* n (factorial (- n 1))))))"
+      env)
+    (ks-eval-in "(factorial 0)" env))
+  1)
+
+(ks-test
+  "factorial: 10!"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! factorial ($lambda (n) ($if (<=? n 1) 1 (* n (factorial (- n 1))))))"
+      env)
+    (ks-eval-in "(factorial 10)" env))
+  3628800)
+
+;; ── recursive list operations ────────────────────────────────────
+(ks-test
+  "sum: recursive over list"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! sum ($lambda (xs) ($if (null? xs) 0 (+ (car xs) (sum (cdr xs))))))"
+      env)
+    (ks-eval-in "(sum (list 1 2 3 4 5))" env))
+  15)
+
+(ks-test
+  "len: recursive count"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! mylen ($lambda (xs) ($if (null? xs) 0 (+ 1 (mylen (cdr xs))))))"
+      env)
+    (ks-eval-in "(mylen (list 1 2 3 4))" env))
+  4)
+
+(ks-test
+  "map-add1: build new list"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! add1-all ($lambda (xs) ($if (null? xs) (list) (cons (+ 1 (car xs)) (add1-all (cdr xs))))))"
+      env)
+    (ks-eval-in "(add1-all (list 10 20 30))" env))
+  (list 11 21 31))
+
+;; ── eval as a first-class applicative ────────────────────────────
+(ks-test
+  "eval: applies to constructed form"
+  (ks-eval "(eval (list ($quote +) 2 3) (get-current-environment))")
+  5)
+
+(ks-test
+  "eval: with a fresh make-environment"
+  (guard
+    (e (true :raised))
+    (ks-eval "(eval ($quote (+ 1 2)) (make-environment))"))
+  :raised)
+
+(ks-test
+  "eval: in extended env sees parent's bindings"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in "($define! shared 7)" env)
+    (ks-eval-in
+      "(eval ($quote shared) (make-environment (get-current-environment)))"
+      env))
+  7)
+
+;; ── get-current-environment ──────────────────────────────────────
+(ks-test
+  "get-current-environment: returns env"
+  (kernel-env? (ks-eval "(get-current-environment)"))
+  true)
+
+(ks-test
+  "get-current-environment: contains $if"
+  (let
+    ((env (ks-eval "(get-current-environment)")))
+    (kernel-env-has? env "$if"))
+  true)
+
+(ks-test
+  "make-environment: empty"
+  (let ((env (ks-eval "(make-environment)"))) (kernel-env-has? env "$if"))
+  false)
+
+(ks-test
+  "make-environment: child sees parent"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in "($define! marker 123)" env)
+    (let
+      ((child (ks-eval-in "(make-environment (get-current-environment))" env)))
+      (kernel-env-has? child "marker")))
+  true)
+
+;; ── closures and lexical scope ───────────────────────────────────
+(ks-test
+  "closure: captures binding"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! make-adder ($lambda (n) ($lambda (x) (+ x n))))"
+      env)
+    (ks-eval-in "($define! add5 (make-adder 5))" env)
+    (ks-eval-in "(add5 10)" env))
+  15)
+
+(ks-test
+  "closure: nested lookups"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! curry-add ($lambda (a) ($lambda (b) ($lambda (c) (+ a (+ b c))))))"
+      env)
+    (ks-eval-in "(((curry-add 1) 2) 3)" env))
+  6)
+
+;; ── operative defined in standard env can reach $define! ─────────
+(ks-test
+  "custom: define-via-vau"
+  (let
+    ((env (kernel-standard-env)))
+    (ks-eval-in
+      "($define! $let-it ($vau (name expr) e ($sequence ($define! tmp (eval expr e)) (eval (list ($quote $define!) name (list ($quote $quote) tmp)) e) tmp)))"
+      env)
+    (ks-eval-in "($let-it z 77)" env)
+    (ks-eval-in "z" env))
+  77)
+
+;; ── quasiquote ──────────────────────────────────────────────────
+(ks-test "qq: plain atom"      (ks-eval "`hello") "hello")
+(ks-test "qq: plain list"      (ks-eval "`(a b c)") (list "a" "b" "c"))
+(ks-test "qq: unquote splices value"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! x 42)" env)
+    (ks-eval-in "`(a ,x b)" env)) (list "a" 42 "b"))
+(ks-test "qq: unquote-splicing splices list"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! xs (list 1 2 3))" env)
+    (ks-eval-in "`(a ,@xs b)" env)) (list "a" 1 2 3 "b"))
+(ks-test "qq: unquote-splicing at end"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! xs (list 9 8))" env)
+    (ks-eval-in "`(a b ,@xs)" env)) (list "a" "b" 9 8))
+(ks-test "qq: unquote-splicing at start"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! xs (list 1 2))" env)
+    (ks-eval-in "`(,@xs c)" env)) (list 1 2 "c"))
+(ks-test "qq: nested list with unquote inside"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! x 5)" env)
+    (ks-eval-in "`(a (b ,x) c)" env))
+  (list "a" (list "b" 5) "c"))
+(ks-test "qq: error on bare unquote-splicing into non-list"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! x 42)" env)
+    (guard (e (true :raised))
+      (ks-eval-in "`(a ,@x b)" env)))
+  :raised)
+
+;; ── $cond / $when / $unless ─────────────────────────────────────
+(ks-test "cond: first match"
+  (ks-eval "($cond (#f 1) (#t 2) (#t 3))") 2)
+(ks-test "cond: else fallback"
+  (ks-eval "($cond (#f 1) (else 99))") 99)
+(ks-test "cond: no match returns nil"
+  (ks-eval "($cond (#f 1) (#f 2))") nil)
+(ks-test "cond: empty clauses returns nil"
+  (ks-eval "($cond)") nil)
+(ks-test "cond: multi-expr body"
+  (ks-eval "($cond (#t 1 2 3))") 3)
+(ks-test "cond: doesn't evaluate untaken clauses"
+  ;; If the second clause's test were evaluated, the unbound `nope` would error.
+  (ks-eval "($cond (#t 7) (nope ignored))") 7)
+(ks-test "cond: predicate evaluation"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! n 5)" env)
+    (ks-eval-in "($cond ((< n 0) ($quote negative)) ((= n 0) ($quote zero)) (else ($quote positive)))" env))
+  "positive")
+
+(ks-test "when: true runs body"
+  (ks-eval "($when #t 1 2 3)") 3)
+(ks-test "when: false returns nil"
+  (ks-eval "($when #f 1 2 3)") nil)
+(ks-test "when: skips body when false"
+  (ks-eval "($when #f nope)") nil)
+
+(ks-test "unless: false runs body"
+  (ks-eval "($unless #f 99)") 99)
+(ks-test "unless: true returns nil"
+  (ks-eval "($unless #t 99)") nil)
+(ks-test "unless: skips body when true"
+  (ks-eval "($unless #t nope)") nil)
+
+;; ── $and? / $or? short-circuit ──────────────────────────────────
+(ks-test "and: empty returns true"   (ks-eval "($and?)") true)
+(ks-test "and: single returns value" (ks-eval "($and? 42)") 42)
+(ks-test "and: all true returns last"
+  (ks-eval "($and? 1 2 3)") 3)
+(ks-test "and: first false short-circuits"
+  (ks-eval "($and? #f nope)") false)
+(ks-test "and: false in middle short-circuits"
+  (ks-eval "($and? 1 #f nope)") false)
+(ks-test "or: empty returns false"  (ks-eval "($or?)") false)
+(ks-test "or: single returns value" (ks-eval "($or? 42)") 42)
+(ks-test "or: first truthy short-circuits"
+  (ks-eval "($or? 99 nope)") 99)
+(ks-test "or: all false returns last"
+  (ks-eval "($or? #f #f #f)") false)
+(ks-test "or: middle truthy"
+  (ks-eval "($or? #f 42 nope)") 42)
+
+;; ── variadic arithmetic ─────────────────────────────────────────
+(ks-test "+: zero args = 0"    (ks-eval "(+)") 0)
+(ks-test "+: one arg = arg"    (ks-eval "(+ 7)") 7)
+(ks-test "+: two args"         (ks-eval "(+ 3 4)") 7)
+(ks-test "+: five args"        (ks-eval "(+ 1 2 3 4 5)") 15)
+
+(ks-test "*: zero args = 1"    (ks-eval "(*)") 1)
+(ks-test "*: one arg"          (ks-eval "(* 7)") 7)
+(ks-test "*: four args"        (ks-eval "(* 1 2 3 4)") 24)
+
+(ks-test "-: one arg negates"  (ks-eval "(- 10)") -10)
+(ks-test "-: two args"         (ks-eval "(- 10 3)") 7)
+(ks-test "-: four args fold"   (ks-eval "(- 100 1 2 3)") 94)
+
+(ks-test "/: two args"         (ks-eval "(/ 20 5)") 4)
+(ks-test "/: three args fold"  (ks-eval "(/ 100 2 5)") 10)
+
+;; ── variadic chained comparison ─────────────────────────────────
+(ks-test "<: chained ascending"  (ks-eval "(< 1 2 3 4 5)") true)
+(ks-test "<: not strict"          (ks-eval "(< 1 2 2 3)") false)
+(ks-test "<: anti-monotonic"      (ks-eval "(< 5 3)") false)
+(ks-test ">: chained descending" (ks-eval "(> 5 4 3 2 1)") true)
+(ks-test "<=? ascending equals"   (ks-eval "(<=? 1 1 2 3 3)") true)
+(ks-test "<=? violation"          (ks-eval "(<=? 1 2 1)") false)
+(ks-test ">=? descending equals" (ks-eval "(>=? 3 3 2 1)") true)
+
+;; ── list combinators ────────────────────────────────────────────
+(ks-test "map: square"
+  (ks-eval "(map ($lambda (x) (* x x)) (list 1 2 3 4))")
+  (list 1 4 9 16))
+(ks-test "map: empty list"
+  (ks-eval "(map ($lambda (x) x) (list))") (list))
+(ks-test "map: identity preserves"
+  (ks-eval "(map ($lambda (x) x) (list 1 2 3))") (list 1 2 3))
+(ks-test "map: with closure over outer"
+  (let ((env (kernel-standard-env)))
+    (ks-eval-in "($define! k 10)" env)
+    (ks-eval-in "(map ($lambda (x) (+ x k)) (list 1 2 3))" env))
+  (list 11 12 13))
+
+(ks-test "filter: positives"
+  (ks-eval "(filter ($lambda (x) (< 0 x)) (list -2 -1 0 1 2))")
+  (list 1 2))
+(ks-test "filter: empty result"
+  (ks-eval "(filter ($lambda (x) #f) (list 1 2 3))") (list))
+(ks-test "filter: all match"
+  (ks-eval "(filter ($lambda (x) #t) (list 1 2 3))") (list 1 2 3))
+
+(ks-test "reduce: sum"
+  (ks-eval "(reduce ($lambda (a b) (+ a b)) 0 (list 1 2 3 4 5))") 15)
+(ks-test "reduce: product"
+  (ks-eval "(reduce ($lambda (a b) (* a b)) 1 (list 1 2 3 4))") 24)
+(ks-test "reduce: empty returns init"
+  (ks-eval "(reduce ($lambda (a b) (+ a b)) 42 (list))") 42)
+(ks-test "reduce: build list"
+  (ks-eval "(reduce ($lambda (acc x) (cons x acc)) () (list 1 2 3))")
+  (list 3 2 1))
+
+;; ── apply ────────────────────────────────────────────────────────
+(ks-test "apply: + over list"
+  (ks-eval "(apply + (list 1 2 3 4 5))") 15)
+(ks-test "apply: lambda"
+  (ks-eval "(apply ($lambda (a b c) (* a (+ b c))) (list 2 3 4))") 14)
+(ks-test "apply: list identity"
+  (ks-eval "(apply list (list 1 2 3))") (list 1 2 3))
+(ks-test "apply: empty args list"
+  (ks-eval "(apply + (list))") 0)
+(ks-test "apply: single arg list"
+  (ks-eval "(apply ($lambda (x) (* x 10)) (list 7))") 70)
+(ks-test "apply: built via map+apply"
+  ;; (apply + (map ($lambda (x) (* x x)) (list 1 2 3))) → 1+4+9 = 14
+  (ks-eval
+    "(apply + (map ($lambda (x) (* x x)) (list 1 2 3)))") 14)
+(ks-test "apply: error on non-list args"
+  (guard (e (true :raised))
+    (ks-eval "(apply + 5)"))
+  :raised)
+
+;; ── append / reverse ────────────────────────────────────────────
+(ks-test "append: two lists"
+  (ks-eval "(append (list 1 2) (list 3 4))") (list 1 2 3 4))
+(ks-test "append: three lists"
+  (ks-eval "(append (list 1) (list 2) (list 3))") (list 1 2 3))
+(ks-test "append: empty list"
+  (ks-eval "(append)") (list))
+(ks-test "append: one list"
+  (ks-eval "(append (list 1 2 3))") (list 1 2 3))
+(ks-test "append: empty + nonempty"
+  (ks-eval "(append (list) (list 1 2))") (list 1 2))
+(ks-test "append: nonempty + empty"
+  (ks-eval "(append (list 1 2) (list))") (list 1 2))
+(ks-test "append: error on non-list"
+  (guard (e (true :raised))
+    (ks-eval "(append (list 1) 5)"))
+  :raised)
+
+(ks-test "reverse: four elements"
+  (ks-eval "(reverse (list 1 2 3 4))") (list 4 3 2 1))
+(ks-test "reverse: empty"
+  (ks-eval "(reverse (list))") (list))
+(ks-test "reverse: single"
+  (ks-eval "(reverse (list 99))") (list 99))
+(ks-test "reverse: double reverse is identity"
+  (ks-eval "(reverse (reverse (list 1 2 3)))") (list 1 2 3))
+
+(define ks-tests-run! (fn () {:total (+ ks-test-pass ks-test-fail) :passed ks-test-pass :failed ks-test-fail :fails ks-test-fails}))

lib/kernel/tests/vau.sx

@@ -0,0 +1,309 @@
+;; lib/kernel/tests/vau.sx — exercises lib/kernel/runtime.sx.
+;;
+;; Verifies the Phase 3 promise: user-defined operatives and applicatives
+;; constructible from inside the language. Tests build a Kernel
+;; base-env, bind a few helper applicatives (+, *, list, =, $if), and
+;; run programs that construct and use custom combiners.
+
+(define kv-test-pass 0)
+(define kv-test-fail 0)
+(define kv-test-fails (list))
+
+(define
+  kv-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! kv-test-pass (+ kv-test-pass 1))
+      (begin
+        (set! kv-test-fail (+ kv-test-fail 1))
+        (append! kv-test-fails {:name name :actual actual :expected expected})))))
+
+(define kv-eval-src (fn (src env) (kernel-eval (kernel-parse src) env)))
+
+(define
+  kv-make-env
+  (fn
+    ()
+    (let
+      ((env (kernel-base-env)))
+      (kernel-env-bind!
+        env
+        "+"
+        (kernel-make-primitive-applicative
+          (fn (args) (+ (first args) (nth args 1)))))
+      (kernel-env-bind!
+        env
+        "*"
+        (kernel-make-primitive-applicative
+          (fn (args) (* (first args) (nth args 1)))))
+      (kernel-env-bind!
+        env
+        "-"
+        (kernel-make-primitive-applicative
+          (fn (args) (- (first args) (nth args 1)))))
+      (kernel-env-bind!
+        env
+        "="
+        (kernel-make-primitive-applicative
+          (fn (args) (= (first args) (nth args 1)))))
+      (kernel-env-bind!
+        env
+        "list"
+        (kernel-make-primitive-applicative (fn (args) args)))
+      (kernel-env-bind!
+        env
+        "cons"
+        (kernel-make-primitive-applicative
+          (fn (args) (cons (first args) (nth args 1)))))
+      (kernel-env-bind!
+        env
+        "$quote"
+        (kernel-make-primitive-operative (fn (args dyn-env) (first args))))
+      (kernel-env-bind!
+        env
+        "$if"
+        (kernel-make-primitive-operative
+          (fn
+            (args dyn-env)
+            (if
+              (kernel-eval (first args) dyn-env)
+              (kernel-eval (nth args 1) dyn-env)
+              (kernel-eval (nth args 2) dyn-env)))))
+      env)))
+
+;; ── $vau: builds an operative ───────────────────────────────────
+(kv-test
+  "vau: identity returns first arg unevaluated"
+  (kv-eval-src "(($vau (a) _ a) hello)" (kv-make-env))
+  "hello")
+
+(kv-test
+  "vau: returns args as raw expressions"
+  (kv-eval-src "(($vau (a b) _ (list a b)) (+ 1 2) (+ 3 4))" (kv-make-env))
+  (list (list "+" 1 2) (list "+" 3 4)))
+
+(kv-test
+  "vau: env-param is a kernel env"
+  (kernel-env? (kv-eval-src "(($vau () e e))" (kv-make-env)))
+  true)
+
+(kv-test
+  "vau: returns operative"
+  (kernel-operative? (kv-eval-src "($vau (x) _ x)" (kv-make-env)))
+  true)
+
+(kv-test
+  "vau: returns operative not applicative"
+  (kernel-applicative? (kv-eval-src "($vau (x) _ x)" (kv-make-env)))
+  false)
+
+(kv-test
+  "vau: zero-arg body"
+  (kv-eval-src "(($vau () _ 42))" (kv-make-env))
+  42)
+
+(kv-test
+  "vau: static-env closure captured"
+  (let
+    ((outer (kv-make-env)))
+    (kernel-env-bind! outer "captured" 17)
+    (let
+      ((op (kv-eval-src "($vau () _ captured)" outer))
+        (caller (kv-make-env)))
+      (kernel-env-bind! caller "captured" 99)
+      (kernel-combine op (list) caller)))
+  17)
+
+(kv-test
+  "vau: env-param exposes caller's dynamic env"
+  (let
+    ((outer (kv-make-env)))
+    (kernel-env-bind! outer "x" 1)
+    (let
+      ((op (kv-eval-src "($vau () e e)" outer)) (caller (kv-make-env)))
+      (kernel-env-bind! caller "x" 2)
+      (let
+        ((e-val (kernel-combine op (list) caller)))
+        (kernel-env-lookup e-val "x"))))
+  2)
+
+;; ── $lambda: applicatives evaluate their args ───────────────────
+(kv-test
+  "lambda: identity"
+  (kv-eval-src "(($lambda (x) x) 42)" (kv-make-env))
+  42)
+
+(kv-test
+  "lambda: addition"
+  (kv-eval-src "(($lambda (x y) (+ x y)) 3 4)" (kv-make-env))
+  7)
+
+(kv-test
+  "lambda: args are evaluated before bind"
+  (kv-eval-src "(($lambda (x) x) (+ 2 3))" (kv-make-env))
+  5)
+
+(kv-test
+  "lambda: zero args"
+  (kv-eval-src "(($lambda () 99))" (kv-make-env))
+  99)
+
+(kv-test
+  "lambda: returns applicative"
+  (kernel-applicative? (kv-eval-src "($lambda (x) x)" (kv-make-env)))
+  true)
+
+(kv-test
+  "lambda: returns applicative not operative"
+  (kernel-operative? (kv-eval-src "($lambda (x) x)" (kv-make-env)))
+  false)
+
+(kv-test
+  "lambda: higher-order"
+  (kv-eval-src "(($lambda (f) (f 10)) ($lambda (x) (+ x 1)))" (kv-make-env))
+  11)
+
+;; ── wrap / unwrap as user-callable applicatives ─────────────────
+
+(kv-test
+  "wrap: makes applicative from operative"
+  (kernel-applicative? (kv-eval-src "(wrap ($vau (x) _ x))" (kv-make-env)))
+  true)
+
+(kv-test
+  "wrap: result evaluates its arg"
+  (kv-eval-src "((wrap ($vau (x) _ x)) (+ 1 2))" (kv-make-env))
+  3)
+
+(kv-test
+  "unwrap: extracts operative from applicative"
+  (kernel-operative? (kv-eval-src "(unwrap ($lambda (x) x))" (kv-make-env)))
+  true)
+
+(kv-test
+  "wrap/unwrap roundtrip preserves identity"
+  (kv-eval-src
+    "(($lambda (op) (= op (unwrap (wrap op)))) ($vau (x) _ x))"
+    (kv-make-env))
+  true)
+
+;; ── operative? / applicative? as user-visible predicates ────────
+
+(kv-test
+  "operative? on vau result"
+  (kv-eval-src "(operative? ($vau (x) _ x))" (kv-make-env))
+  true)
+
+(kv-test
+  "operative? on lambda result"
+  (kv-eval-src "(operative? ($lambda (x) x))" (kv-make-env))
+  false)
+
+(kv-test
+  "applicative? on lambda result"
+  (kv-eval-src "(applicative? ($lambda (x) x))" (kv-make-env))
+  true)
+
+(kv-test
+  "applicative? on vau result"
+  (kv-eval-src "(applicative? ($vau (x) _ x))" (kv-make-env))
+  false)
+
+(kv-test
+  "operative? on number"
+  (kv-eval-src "(operative? 42)" (kv-make-env))
+  false)
+
+;; ── Build BOTH layers from user code ────────────────────────────
+;; The headline Phase 3 test: defining an operative on top of an
+;; applicative defined on top of a vau.
+
+(kv-test
+  "custom: applicative + operative compose"
+  (let
+    ((env (kv-make-env)))
+    (kernel-env-bind! env "square" (kv-eval-src "($lambda (x) (* x x))" env))
+    (kv-eval-src "(square 4)" env))
+  16)
+
+(kv-test "custom: operative captures argument syntax"
+  ;; ($capture x) returns the raw expression `x`, regardless of value.
+  (let ((env (kv-make-env)))
+    (kernel-env-bind! env "$capture"
+      (kv-eval-src "($vau (form) _ form)" env))
+    (kv-eval-src "($capture (+ 1 2))" env))
+  (list "+" 1 2))
+
+(kv-test "custom: applicative re-wraps an operative"
+  ;; Build a captured operative, then wrap it into an applicative that
+  ;; evaluates args before re-entry. This exercises wrap+$vau composed.
+  (let ((env (kv-make-env)))
+    (kernel-env-bind! env "id-app"
+      (kv-eval-src "(wrap ($vau (x) _ x))" env))
+    (kv-eval-src "(id-app (+ 10 20))" env))
+  30)
+
+;; ── Error cases ──────────────────────────────────────────────────
+
+(kv-test
+  "vau: rejects non-list formals"
+  (guard (e (true :raised)) (kv-eval-src "($vau x _ x)" (kv-make-env)))
+  :raised)
+
+(kv-test
+  "vau: rejects non-symbol formal"
+  (guard (e (true :raised)) (kv-eval-src "($vau (1) _ x)" (kv-make-env)))
+  :raised)
+
+(kv-test
+  "vau: rejects non-symbol env-param"
+  (guard (e (true :raised)) (kv-eval-src "($vau (x) 7 x)" (kv-make-env)))
+  :raised)
+
+(kv-test
+  "vau: too few args at call site"
+  (guard
+    (e (true :raised))
+    (kv-eval-src "(($vau (x y) _ x) 1)" (kv-make-env)))
+  :raised)
+
+(kv-test
+  "vau: too many args at call site"
+  (guard
+    (e (true :raised))
+    (kv-eval-src "(($vau (x) _ x) 1 2)" (kv-make-env)))
+  :raised)
+
+(kv-test
+  "wrap: rejects non-operative"
+  (guard (e (true :raised)) (kv-eval-src "(wrap 42)" (kv-make-env)))
+  :raised)
+
+(kv-test
+  "unwrap: rejects non-applicative"
+  (guard (e (true :raised)) (kv-eval-src "(unwrap 42)" (kv-make-env)))
+  :raised)
+
+;; ── Multi-expression body (implicit $sequence) ──────────────────
+
+(kv-test "lambda: two body forms — value of last"
+  (kv-eval-src "(($lambda (n) (+ n 1) (+ n 10)) 5)" (kv-make-env)) 15)
+
+(kv-test "lambda: three body forms"
+  (kv-eval-src "(($lambda (n) n (+ n 1) (+ n 2)) 10)" (kv-make-env)) 12)
+
+(kv-test "vau: two body forms"
+  (kv-eval-src "(($vau (a b) _ a (list a b)) 7 8)" (kv-make-env))
+  (list 7 8))
+
+(kv-test "lambda: $define! in early body visible in later body"
+  (kv-eval-src
+    "(($lambda (n) ($define! double (+ n n)) double) 6)"
+    (kv-make-env)) 12)
+
+(kv-test "lambda: zero-arg multi-body"
+  (kv-eval-src "(($lambda () 1 2 3))" (kv-make-env)) 3)
+
+(define kv-tests-run! (fn () {:total (+ kv-test-pass kv-test-fail) :passed kv-test-pass :failed kv-test-fail :fails kv-test-fails}))

lib/scheme/runtime.sx

@@ -0,0 +1,649 @@
+;; lib/scheme/runtime.sx — R7RS-small standard environment.
+;;
+;; Builds scheme-standard-env from scheme-make-env, populating it with
+;; arithmetic, comparison, type predicates, list/pair/vector/string/char
+;; primitives, and the higher-order combinators (map/filter/fold).
+;;
+;; Primitives are bound as SX fns taking a list of evaluated arguments.
+;; Combinators that re-enter the evaluator (map, filter, fold, apply,
+;; for-each) call `scheme-apply` directly on user-supplied procedures.
+;;
+;; Public API
+;;   (scheme-standard-env)  — fresh env with the full R7RS-base surface
+;;
+;; Consumes: lib/scheme/eval.sx (scheme-apply, scheme-make-env,
+;;           scheme-env-bind!, scheme-string?, scheme-char?,
+;;           scheme-vector?, scheme-vector-elements,
+;;           scheme-string-value, scheme-char-value,
+;;           scheme-string-make, scheme-char-make,
+;;           scheme-vector-make).
+
+;; ── Arity / fold helpers ─────────────────────────────────────────
+
+(define
+  scm-unary
+  (fn
+    (name f)
+    (fn
+      (args)
+      (cond
+        ((not (= (length args) 1))
+          (error (str name ": expects 1 argument")))
+        (:else (f (first args)))))))
+
+(define
+  scm-binary
+  (fn
+    (name f)
+    (fn
+      (args)
+      (cond
+        ((not (= (length args) 2))
+          (error (str name ": expects 2 arguments")))
+        (:else (f (first args) (nth args 1)))))))
+
+;; Variadic left-fold helper. zero-id is the identity (`(+)` → 0).
+;; one-fn handles single-arg case (`(- x)` negates).
+(define
+  scm-fold-step
+  (fn
+    (f acc rest-args)
+    (cond
+      ((or (nil? rest-args) (= (length rest-args) 0)) acc)
+      (:else (scm-fold-step f (f acc (first rest-args)) (rest rest-args))))))
+
+(define
+  scm-fold
+  (fn
+    (name f zero-id one-fn)
+    (fn
+      (args)
+      (cond
+        ((= (length args) 0) zero-id)
+        ((= (length args) 1) (one-fn (first args)))
+        (:else (scm-fold-step f (first args) (rest args)))))))
+
+;; n-ary chained comparison: (< 1 2 3) ≡ (< 1 2) ∧ (< 2 3).
+(define
+  scm-chain-step
+  (fn
+    (cmp prev rest-args)
+    (cond
+      ((or (nil? rest-args) (= (length rest-args) 0)) true)
+      (:else
+        (let
+          ((next (first rest-args)))
+          (cond
+            ((cmp prev next) (scm-chain-step cmp next (rest rest-args)))
+            (:else false)))))))
+
+(define
+  scm-chain
+  (fn
+    (name cmp)
+    (fn
+      (args)
+      (cond
+        ((< (length args) 2)
+          (error (str name ": expects at least 2 arguments")))
+        (:else (scm-chain-step cmp (first args) (rest args)))))))
+
+;; ── List helpers ─────────────────────────────────────────────────
+
+(define
+  scm-list-append
+  (fn
+    (xs ys)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) ys)
+      (:else (cons (first xs) (scm-list-append (rest xs) ys))))))
+
+(define
+  scm-list-reverse-step
+  (fn
+    (xs acc)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) acc)
+      (:else (scm-list-reverse-step (rest xs) (cons (first xs) acc))))))
+
+(define
+  scm-all-lists?
+  (fn
+    (xs)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) true)
+      ((list? (first xs)) (scm-all-lists? (rest xs)))
+      (:else false))))
+
+(define
+  scm-append-all
+  (fn
+    (lists)
+    (cond
+      ((or (nil? lists) (= (length lists) 0)) (list))
+      ((= (length lists) 1) (first lists))
+      (:else (scm-list-append (first lists) (scm-append-all (rest lists)))))))
+
+;; ── Map / Filter / Fold ──────────────────────────────────────────
+;; These call scheme-apply directly so closures and primitives both work.
+
+(define
+  scm-map-step
+  (fn
+    (proc xs)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) (list))
+      (:else
+        (cons
+          (scheme-apply proc (list (first xs)))
+          (scm-map-step proc (rest xs)))))))
+
+(define
+  scm-filter-step
+  (fn
+    (pred xs)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) (list))
+      (:else
+        (let
+          ((keep? (scheme-apply pred (list (first xs)))))
+          (cond
+            ((not (= keep? false))
+              (cons (first xs) (scm-filter-step pred (rest xs))))
+            (:else (scm-filter-step pred (rest xs)))))))))
+
+(define
+  scm-fold-left-step
+  (fn
+    (proc acc xs)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) acc)
+      (:else
+        (scm-fold-left-step
+          proc
+          (scheme-apply proc (list acc (first xs)))
+          (rest xs))))))
+
+(define
+  scm-fold-right-step
+  (fn
+    (proc init xs)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) init)
+      (:else
+        (scheme-apply
+          proc
+          (list (first xs) (scm-fold-right-step proc init (rest xs))))))))
+
+(define
+  scm-for-each-step
+  (fn
+    (proc xs)
+    (cond
+      ((or (nil? xs) (= (length xs) 0)) nil)
+      (:else
+        (begin
+          (scheme-apply proc (list (first xs)))
+          (scm-for-each-step proc (rest xs)))))))
+
+;; ── Vector helpers ──────────────────────────────────────────────
+
+(define
+  scm-make-vector-step
+  (fn
+    (n fill acc)
+    (cond
+      ((<= n 0) acc)
+      (:else (scm-make-vector-step (- n 1) fill (cons fill acc))))))
+
+;; ── Standard env ─────────────────────────────────────────────────
+
+(define
+  scheme-standard-env
+  (fn
+    ()
+    (let
+      ((env (scheme-make-env)))
+      (scheme-env-bind!
+        env
+        "+"
+        (scm-fold "+" (fn (a b) (+ a b)) 0 (fn (x) x)))
+      (scheme-env-bind!
+        env
+        "-"
+        (scm-fold
+          "-"
+          (fn (a b) (- a b))
+          0
+          (fn (x) (- 0 x))))
+      (scheme-env-bind!
+        env
+        "*"
+        (scm-fold "*" (fn (a b) (* a b)) 1 (fn (x) x)))
+      (scheme-env-bind!
+        env
+        "/"
+        (scm-fold
+          "/"
+          (fn (a b) (/ a b))
+          1
+          (fn (x) (/ 1 x))))
+      (scheme-env-bind!
+        env
+        "abs"
+        (scm-unary
+          "abs"
+          (fn (n) (if (< n 0) (- 0 n) n))))
+      (scheme-env-bind!
+        env
+        "min"
+        (scm-fold "min" (fn (a b) (if (< a b) a b)) nil (fn (x) x)))
+      (scheme-env-bind!
+        env
+        "max"
+        (scm-fold "max" (fn (a b) (if (< a b) b a)) nil (fn (x) x)))
+      (scheme-env-bind!
+        env
+        "modulo"
+        (scm-binary "modulo" (fn (a b) (- a (* b (floor (/ a b)))))))
+      (scheme-env-bind!
+        env
+        "quotient"
+        (scm-binary "quotient" (fn (a b) (floor (/ a b)))))
+      (scheme-env-bind!
+        env
+        "remainder"
+        (scm-binary "remainder" (fn (a b) (- a (* b (floor (/ a b)))))))
+      (scheme-env-bind!
+        env
+        "zero?"
+        (scm-unary "zero?" (fn (n) (= n 0))))
+      (scheme-env-bind!
+        env
+        "positive?"
+        (scm-unary "positive?" (fn (n) (> n 0))))
+      (scheme-env-bind!
+        env
+        "negative?"
+        (scm-unary "negative?" (fn (n) (< n 0))))
+      (scheme-env-bind! env "=" (scm-chain "=" (fn (a b) (= a b))))
+      (scheme-env-bind! env "<" (scm-chain "<" (fn (a b) (< a b))))
+      (scheme-env-bind! env ">" (scm-chain ">" (fn (a b) (> a b))))
+      (scheme-env-bind! env "<=" (scm-chain "<=" (fn (a b) (<= a b))))
+      (scheme-env-bind! env ">=" (scm-chain ">=" (fn (a b) (>= a b))))
+      (scheme-env-bind!
+        env
+        "number?"
+        (scm-unary "number?" (fn (v) (number? v))))
+      (scheme-env-bind!
+        env
+        "boolean?"
+        (scm-unary "boolean?" (fn (v) (boolean? v))))
+      (scheme-env-bind!
+        env
+        "symbol?"
+        (scm-unary "symbol?" (fn (v) (string? v))))
+      (scheme-env-bind!
+        env
+        "string?"
+        (scm-unary "string?" (fn (v) (scheme-string? v))))
+      (scheme-env-bind!
+        env
+        "char?"
+        (scm-unary "char?" (fn (v) (scheme-char? v))))
+      (scheme-env-bind!
+        env
+        "vector?"
+        (scm-unary "vector?" (fn (v) (scheme-vector? v))))
+      (scheme-env-bind!
+        env
+        "null?"
+        (scm-unary
+          "null?"
+          (fn
+            (v)
+            (or (nil? v) (and (list? v) (= (length v) 0))))))
+      (scheme-env-bind!
+        env
+        "pair?"
+        (scm-unary
+          "pair?"
+          (fn (v) (and (list? v) (> (length v) 0)))))
+      (scheme-env-bind!
+        env
+        "procedure?"
+        (scm-unary
+          "procedure?"
+          (fn
+            (v)
+            (or
+              (callable? v)
+              (and (dict? v) (= (get v :scm-tag) :closure))))))
+      (scheme-env-bind! env "not" (scm-unary "not" (fn (v) (= v false))))
+      (scheme-env-bind!
+        env
+        "cons"
+        (scm-binary "cons" (fn (a b) (cons a b))))
+      (scheme-env-bind!
+        env
+        "car"
+        (scm-unary
+          "car"
+          (fn
+            (xs)
+            (cond
+              ((or (nil? xs) (and (list? xs) (= (length xs) 0)))
+                (error "car: empty list"))
+              (:else (first xs))))))
+      (scheme-env-bind!
+        env
+        "cdr"
+        (scm-unary
+          "cdr"
+          (fn
+            (xs)
+            (cond
+              ((or (nil? xs) (and (list? xs) (= (length xs) 0)))
+                (error "cdr: empty list"))
+              (:else (rest xs))))))
+      (scheme-env-bind! env "list" (fn (args) args))
+      (scheme-env-bind!
+        env
+        "length"
+        (scm-unary "length" (fn (xs) (length xs))))
+      (scheme-env-bind!
+        env
+        "reverse"
+        (scm-unary "reverse" (fn (xs) (scm-list-reverse-step xs (list)))))
+      (scheme-env-bind!
+        env
+        "append"
+        (fn
+          (args)
+          (cond
+            ((scm-all-lists? args) (scm-append-all args))
+            (:else (error "append: all arguments must be lists")))))
+      (scheme-env-bind!
+        env
+        "map"
+        (fn
+          (args)
+          (cond
+            ((not (= (length args) 2))
+              (error "map: expects (proc list)"))
+            (:else (scm-map-step (first args) (nth args 1))))))
+      (scheme-env-bind!
+        env
+        "filter"
+        (fn
+          (args)
+          (cond
+            ((not (= (length args) 2))
+              (error "filter: expects (pred list)"))
+            (:else (scm-filter-step (first args) (nth args 1))))))
+      (scheme-env-bind!
+        env
+        "fold-left"
+        (fn
+          (args)
+          (cond
+            ((not (= (length args) 3))
+              (error "fold-left: expects (proc init list)"))
+            (:else
+              (scm-fold-left-step
+                (first args)
+                (nth args 1)
+                (nth args 2))))))
+      (scheme-env-bind!
+        env
+        "fold-right"
+        (fn
+          (args)
+          (cond
+            ((not (= (length args) 3))
+              (error "fold-right: expects (proc init list)"))
+            (:else
+              (scm-fold-right-step
+                (first args)
+                (nth args 1)
+                (nth args 2))))))
+      (scheme-env-bind!
+        env
+        "for-each"
+        (fn
+          (args)
+          (cond
+            ((not (= (length args) 2))
+              (error "for-each: expects (proc list)"))
+            (:else (scm-for-each-step (first args) (nth args 1))))))
+      (scheme-env-bind!
+        env
+        "apply"
+        (fn
+          (args)
+          (cond
+            ((not (= (length args) 2))
+              (error "apply: expects (proc args-list)"))
+            (:else (scheme-apply (first args) (nth args 1))))))
+      (scheme-env-bind!
+        env
+        "string-length"
+        (scm-unary
+          "string-length"
+          (fn (s) (string-length (scheme-string-value s)))))
+      (scheme-env-bind!
+        env
+        "string=?"
+        (scm-binary
+          "string=?"
+          (fn (a b) (= (scheme-string-value a) (scheme-string-value b)))))
+      (scheme-env-bind!
+        env
+        "string-append"
+        (fn
+          (args)
+          (scheme-string-make
+            (scm-fold-step
+              (fn (acc s) (str acc (scheme-string-value s)))
+              ""
+              args))))
+      (scheme-env-bind!
+        env
+        "substring"
+        (fn
+          (args)
+          (cond
+            ((not (= (length args) 3))
+              (error "substring: expects (str start end)"))
+            (:else
+              (scheme-string-make
+                (substring
+                  (scheme-string-value (first args))
+                  (nth args 1)
+                  (nth args 2)))))))
+      (scheme-env-bind!
+        env
+        "char=?"
+        (scm-binary
+          "char=?"
+          (fn (a b) (= (scheme-char-value a) (scheme-char-value b)))))
+      (scheme-env-bind! env "vector" (fn (args) (scheme-vector-make args)))
+      (scheme-env-bind!
+        env
+        "vector-length"
+        (scm-unary
+          "vector-length"
+          (fn (v) (length (scheme-vector-elements v)))))
+      (scheme-env-bind!
+        env
+        "vector-ref"
+        (scm-binary
+          "vector-ref"
+          (fn (v i) (nth (scheme-vector-elements v) i))))
+      (scheme-env-bind!
+        env
+        "vector->list"
+        (scm-unary "vector->list" (fn (v) (scheme-vector-elements v))))
+      (scheme-env-bind!
+        env
+        "list->vector"
+        (scm-unary "list->vector" (fn (xs) (scheme-vector-make xs))))
+      (scheme-env-bind!
+        env
+        "make-vector"
+        (fn
+          (args)
+          (cond
+            ((= (length args) 1)
+              (scheme-vector-make
+                (scm-make-vector-step (first args) nil (list))))
+            ((= (length args) 2)
+              (scheme-vector-make
+                (scm-make-vector-step
+                  (first args)
+                  (nth args 1)
+                  (list))))
+            (:else (error "make-vector: expects (n [fill])")))))
+      (scheme-env-bind! env "eqv?" (scm-binary "eqv?" (fn (a b) (= a b))))
+      (scheme-env-bind!
+        env
+        "equal?"
+        (scm-binary "equal?" (fn (a b) (= a b))))
+      (scheme-env-bind! env "eq?" (scm-binary "eq?" (fn (a b) (= a b))))
+      ;; ── call/cc (R7RS first-class continuations) ────────────
+      ;; Captures the host SX continuation, wraps it as a Scheme
+      ;; procedure (fn (vargs) ...) and passes it to the user proc.
+      ;; Calling the captured k with one value re-enters the
+      ;; continuation; with multiple values, passes them as a list.
+      (scheme-env-bind! env "call/cc"
+        (fn (args)
+          (cond
+            ((not (= (length args) 1))
+              (error "call/cc: expects 1 argument"))
+            (:else
+              (call/cc
+                (fn (k)
+                  (let ((scheme-k
+                          (fn (vargs)
+                            (cond
+                              ((= (length vargs) 1) (k (first vargs)))
+                              (:else (k vargs))))))
+                    (scheme-apply (first args) (list scheme-k)))))))))
+      (scheme-env-bind! env "call-with-current-continuation"
+        (refl-env-lookup env "call/cc"))
+      ;; ── R7RS exception primitives ──────────────────────────
+      ;; raise V — raises V as exception (host SX raise).
+      (scheme-env-bind! env "raise"
+        (fn (args)
+          (cond
+            ((not (= (length args) 1))
+              (error "raise: expects 1 argument"))
+            (:else (raise (first args))))))
+      ;; error MSG IRRITANTS... — convention: raise an error-object
+      ;; that's a dict {:scm-error MSG :irritants LIST}. The print
+      ;; surface (error-object-message / error-object-irritants)
+      ;; can pull these apart.
+      (scheme-env-bind! env "error"
+        (fn (args)
+          (cond
+            ((= (length args) 0) (error "error: expects (message [irritant...])"))
+            (:else
+              (raise {:scm-error (cond
+                                   ((scheme-string? (first args))
+                                     (scheme-string-value (first args)))
+                                   (:else (first args)))
+                      :irritants (rest args)})))))
+      (scheme-env-bind! env "error-object?"
+        (scm-unary "error-object?"
+          (fn (v) (and (dict? v) (string? (get v :scm-error))))))
+      (scheme-env-bind! env "error-object-message"
+        (scm-unary "error-object-message"
+          (fn (v) (scheme-string-make (get v :scm-error)))))
+      (scheme-env-bind! env "error-object-irritants"
+        (scm-unary "error-object-irritants"
+          (fn (v) (get v :irritants))))
+      ;; with-exception-handler HANDLER THUNK — runs THUNK; if it
+      ;; raises, calls HANDLER with the raised value (handler can
+      ;; itself raise or return a value). Implemented via host guard.
+      ;; with-exception-handler — catch THUNK's raise; if caught,
+      ;; call HANDLER. If HANDLER itself raises, propagate that to
+      ;; the outer scope (don't re-catch in this same guard, which
+      ;; would loop). The two-step outcome-sentinel pattern mirrors
+      ;; the `guard` special form's escape.
+      (scheme-env-bind! env "with-exception-handler"
+        (fn (args)
+          (cond
+            ((not (= (length args) 2))
+              (error "with-exception-handler: expects 2 arguments"))
+            (:else
+              (let ((handler (first args))
+                    (thunk (nth args 1)))
+                (let ((outcome
+                        (guard
+                          (e (true {:scm-weh-raised true :value e}))
+                          (scheme-apply thunk (list)))))
+                  (cond
+                    ((and (dict? outcome) (get outcome :scm-weh-raised))
+                      (scheme-apply handler (list (get outcome :value))))
+                    (:else outcome))))))))
+      ;; ── R7RS reflection: eval / environment accessors ───────
+      ;; eval EXPR ENV — apply the evaluator to a user-supplied AST.
+      (scheme-env-bind! env "eval"
+        (fn (args)
+          (cond
+            ((not (= (length args) 2))
+              (error "eval: expects (eval expr env)"))
+            (:else (scheme-eval (first args) (nth args 1))))))
+      ;; interaction-environment — the env we're currently building.
+      ;; The closure captures `env`, so each invocation of
+      ;; scheme-standard-env produces a distinct interaction env
+      ;; whose interaction-environment fn returns itself.
+      (scheme-env-bind! env "interaction-environment"
+        (fn (args)
+          (cond
+            ((not (= (length args) 0))
+              (error "interaction-environment: expects 0 args"))
+            (:else env))))
+      ;; null-environment — fresh empty env. R7RS ignores version arg.
+      (scheme-env-bind! env "null-environment"
+        (fn (args)
+          (cond
+            ((not (= (length args) 1))
+              (error "null-environment: expects (version)"))
+            (:else (scheme-make-env)))))
+      ;; scheme-report-environment — fresh full standard env.
+      (scheme-env-bind! env "scheme-report-environment"
+        (fn (args)
+          (cond
+            ((not (= (length args) 1))
+              (error "scheme-report-environment: expects (version)"))
+            (:else (scheme-standard-env)))))
+      (scheme-env-bind! env "environment?"
+        (scm-unary "environment?" (fn (v) (scheme-env? v))))
+      ;; dynamic-wind BEFORE THUNK AFTER — runs BEFORE, then THUNK,
+      ;; then AFTER. If THUNK raises, AFTER still runs before the
+      ;; raise propagates. This is the basic-correctness version;
+      ;; proper call/cc-escape interaction would need dynamic-extent
+      ;; tracking, deferred until needed.
+      (scheme-env-bind! env "dynamic-wind"
+        (fn (args)
+          (cond
+            ((not (= (length args) 3))
+              (error "dynamic-wind: expects (before thunk after)"))
+            (:else
+              (let ((before-thunk (first args))
+                    (mid-thunk (nth args 1))
+                    (after-thunk (nth args 2)))
+                (begin
+                  (scheme-apply before-thunk (list))
+                  (let ((outcome
+                          (guard
+                            (e (true {:scm-dw-raised true :value e}))
+                            (scheme-apply mid-thunk (list)))))
+                    (begin
+                      (scheme-apply after-thunk (list))
+                      (cond
+                        ((and (dict? outcome) (get outcome :scm-dw-raised))
+                          (raise (get outcome :value)))
+                        (:else outcome))))))))))
+      env)))

lib/scheme/scoreboard.md

@@ -0,0 +1,83 @@
+# Scheme-on-SX Scoreboard
+
+**All tests pass: 296 / 296 across 9 suites.**
+
+## Per-suite breakdown
+
+| Suite       | Passing | Covers |
+|-------------|--------:|--------|
+| parse       |     62  | R7RS lexer: numbers, strings, chars, vectors, lists, quote/quasi/unquote, line/block/datum comments |
+| eval        |     23  | Self-evaluating literals, symbol lookup, quote, primitive application |
+| syntax      |     49  | if/define/set!/begin/lambda/closures + let/let*/cond/when/unless/and/or |
+| runtime     |     78  | Standard env: variadic arithmetic, type predicates, list/string/char/vector ops, higher-order combinators |
+| control     |     25  | call/cc (escape), raise/guard/with-exception-handler, dynamic-wind |
+| macros      |     20  | define-syntax / syntax-rules incl. tail-rest ellipsis |
+| reflection  |     23  | eval / interaction-environment / null-environment / scheme-report-environment + quasiquote runtime |
+| records     |      9  | define-record-type with constructor / predicate / accessor / mutator |
+| modules     |      7  | define-library + import (minimal — no cond-expand / include / rename) |
+
+## Phases implemented
+
+- [x] Phase 1 — Parser
+- [x] Phase 2 — Evaluator + env.sx **third consumer**
+- [x] Phase 3 — Syntactic operators (if/lambda/define/set!/begin)
+- [x] Phase 3.5 — let/let*/cond/when/unless/and/or
+- [x] Phase 4 — Standard environment + set! cond-bugfix
+- [x] Phase 5a — call/cc
+- [x] Phase 5b — exceptions (raise/guard/with-exception-handler/error)
+- [x] Phase 5c — dynamic-wind (basic, no call/cc-escape tracking)
+- [x] Phase 6a — define-syntax + syntax-rules (no ellipsis)
+- [x] Phase 6b — syntax-rules ellipsis (tail-rest, single variable)
+- [x] Phase 7 — eval / interaction-environment **second consumer for evaluator.sx**
+- [x] Phase 8 — define-library + import (minimal)
+- [x] Phase 9 — define-record-type
+- [x] Phase 10 — quasiquote runtime **second consumer for quoting.sx**
+- [x] Phase 11 — test.sh + scoreboard
+
+## Deferred
+
+- **Phase 6c — hygiene** (scope-set / lifted-symbol Dybvig-style algorithm).
+  Would be the second consumer for the deferred `lib/guest/reflective/hygiene.sx`
+  research-grade kit. Current macros work for common patterns but can capture
+  caller bindings if a macro introduces same-named identifiers.
+
+- **Nested quasiquote depth tracking** — `` `\`x\` `` is not properly depth-aware;
+  matches Kernel's deferred state.
+
+- **R7RS module rich features**: cond-expand, include, include-library-declarations,
+  `(only ...)` / `(except ...)` / `(prefix ...)` / `(rename ...)` import sets.
+
+- **Dotted-pair `(a b . rest)` syntax** at the parser level. Lambda rest-args
+  currently use the `(lambda args ...)` form (bare symbol) instead.
+
+- **Full call/cc + dynamic-wind interaction**: re-entry/re-exit of dynamic
+  extents via continuations is not tracked. Pure-eval programs work; call/cc-
+  heavy code with dynamic-wind interleaving doesn't.
+
+## Reflective-kit consumption (chisel ledger)
+
+This Scheme port unlocks three reflective-kit extractions from the kernel-on-sx
+loop's original six-candidate list:
+
+| Kit                  | Status                                      |
+|----------------------|---------------------------------------------|
+| env.sx               | **Extracted** (third consumer; no adapter)  |
+| class-chain.sx       | n/a (no OO in Scheme)                       |
+| evaluator.sx         | **Unblocked** (second consumer ready)       |
+| quoting.sx           | **Unblocked** (second consumer ready)       |
+| hygiene.sx           | Awaiting Phase 6c (research-grade)          |
+| combiner.sx          | n/a (no fexprs in Scheme)                   |
+| short-circuit.sx     | n/a (Scheme `and`/`or` are syntactic, not operative) |
+
+The kit-extraction commits themselves are follow-on work — kit code is staged
+in the proposed sections of `plans/kernel-on-sx.md`; Scheme's consumer code
+satisfies the two-consumer rule for `evaluator.sx` and `quoting.sx`.
+
+## Substrate stats
+
+- parser.sx — 281 LoC
+- eval.sx — ~970 LoC
+- runtime.sx — ~580 LoC
+- Tests — ~1500 LoC across 9 files
+
+Total Scheme implementation ≈ 1830 LoC.

lib/scheme/test.sh

@@ -0,0 +1,93 @@
+#!/usr/bin/env bash
+# Scheme-on-SX test runner — runs all tests in one sx_server process.
+#
+# Usage:
+#   bash lib/scheme/test.sh          # run all suites
+#   bash lib/scheme/test.sh -v       # verbose (list each suite)
+
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
+if [ ! -x "$SX_SERVER" ]; then
+  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
+fi
+if [ ! -x "$SX_SERVER" ]; then
+  echo "ERROR: sx_server.exe not found." >&2
+  exit 1
+fi
+
+VERBOSE="${1:-}"
+
+# Suites: NAME RUNNER-FN PATH
+SUITES=(
+  "parse       scm-tests-run!         lib/scheme/tests/parse.sx"
+  "eval        scm-eval-tests-run!    lib/scheme/tests/eval.sx"
+  "syntax      scm-syn-tests-run!     lib/scheme/tests/syntax.sx"
+  "runtime     scm-rt-tests-run!      lib/scheme/tests/runtime.sx"
+  "control     scm-ctl-tests-run!     lib/scheme/tests/control.sx"
+  "macros      scm-mac-tests-run!     lib/scheme/tests/macros.sx"
+  "reflection  scm-ref-tests-run!     lib/scheme/tests/reflection.sx"
+  "records     scm-rec-tests-run!     lib/scheme/tests/records.sx"
+  "modules     scm-mod-tests-run!     lib/scheme/tests/modules.sx"
+)
+
+TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
+EPOCH=1
+
+emit_load () { echo "(epoch $EPOCH)"; echo "(load \"$1\")"; EPOCH=$((EPOCH+1)); }
+emit_eval () { echo "(epoch $EPOCH)"; echo "(eval \"$1\")"; EPOCH=$((EPOCH+1)); }
+
+{
+  emit_load "lib/guest/lex.sx"
+  emit_load "lib/guest/reflective/env.sx"
+  emit_load "lib/guest/reflective/quoting.sx"
+  emit_load "lib/scheme/parser.sx"
+  emit_load "lib/scheme/eval.sx"
+  emit_load "lib/scheme/runtime.sx"
+  for SUITE in "${SUITES[@]}"; do
+    read -r _NAME _RUNNER FILE <<< "$SUITE"
+    emit_load "$FILE"
+    emit_eval "($_RUNNER)"
+  done
+} > "$TMPFILE"
+
+OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
+
+# Final 9 outputs are the suite results. Parse each "{:passed N :failed N ..}".
+TOTAL_PASS=0
+TOTAL_FAIL=0
+FAILED_SUITES=()
+
+# Walk the output; for each suite, extract the {:passed ...} line.
+# The dict format from sx_server is {:passed N :failed N :total N :fails (...)}.
+LAST_DICT_LINES=$(echo "$OUTPUT" | grep -E '^\{:' || true)
+
+I=0
+while read -r LINE; do
+  [ -z "$LINE" ] && continue
+  P=$(echo "$LINE" | grep -oE ':passed [0-9]+' | awk '{print $2}')
+  F=$(echo "$LINE" | grep -oE ':failed [0-9]+' | awk '{print $2}')
+  [ -z "$P" ] && P=0
+  [ -z "$F" ] && F=0
+  SUITE_INFO="${SUITES[$I]}"
+  SUITE_NAME=$(echo "$SUITE_INFO" | awk '{print $1}')
+  TOTAL_PASS=$((TOTAL_PASS + P))
+  TOTAL_FAIL=$((TOTAL_FAIL + F))
+  if [ "$F" -gt 0 ]; then
+    FAILED_SUITES+=("$SUITE_NAME: $P/$((P+F))")
+    printf 'X %-12s %d/%d\n' "$SUITE_NAME" "$P" "$((P+F))"
+  elif [ "$VERBOSE" = "-v" ]; then
+    printf 'ok %-12s %d passed\n' "$SUITE_NAME" "$P"
+  fi
+  I=$((I+1))
+done <<< "$LAST_DICT_LINES"
+
+TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
+if [ $TOTAL_FAIL -eq 0 ]; then
+  echo "ok $TOTAL_PASS/$TOTAL scheme-on-sx tests passed (${#SUITES[@]} suites)"
+else
+  echo "FAIL $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed:"
+  for S in "${FAILED_SUITES[@]}"; do echo "  $S"; done
+  exit 1
+fi

lib/scheme/tests/control.sx

@@ -0,0 +1,168 @@
+;; lib/scheme/tests/control.sx — call/cc, dynamic-wind, exceptions.
+
+(define scm-ctl-pass 0)
+(define scm-ctl-fail 0)
+(define scm-ctl-fails (list))
+
+(define
+  scm-ctl-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! scm-ctl-pass (+ scm-ctl-pass 1))
+      (begin
+        (set! scm-ctl-fail (+ scm-ctl-fail 1))
+        (append! scm-ctl-fails {:name name :actual actual :expected expected})))))
+
+(define
+  scm-ctl
+  (fn (src) (scheme-eval (scheme-parse src) (scheme-standard-env))))
+
+(define
+  scm-ctl-all
+  (fn
+    (src)
+    (scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
+
+;; ── call/cc — escape continuations ──────────────────────────────
+;; Single-shot only: when k is invoked, control jumps out of the
+;; surrounding call/cc and the result of the entire call/cc form is
+;; whatever was passed to k.
+
+(scm-ctl-test
+  "call/cc: no escape"
+  (scm-ctl "(call/cc (lambda (k) 42))")
+  42)
+(scm-ctl-test
+  "call/cc: simple escape"
+  (scm-ctl "(call/cc (lambda (k) (+ 1 (k 42))))")
+  42)
+(scm-ctl-test
+  "call/cc: escape past *"
+  (scm-ctl "(+ 10 (call/cc (lambda (k) (* 2 (k 5)))))")
+  15)
+(scm-ctl-test
+  "call/cc: alias call-with-current-continuation"
+  (scm-ctl "(call-with-current-continuation (lambda (k) (k 99)))")
+  99)
+(scm-ctl-test
+  "call/cc: doesn't escape if k unused"
+  (scm-ctl "(+ 1 (call/cc (lambda (k) (* 100 1))))")
+  101)
+
+;; ── call/cc as early-exit for list search ───────────────────────
+(scm-ctl-test
+  "call/cc: detect-via-escape"
+  (scm-ctl-all
+    "(define (detect pred xs)\n       (call/cc\n         (lambda (return)\n           (for-each\n             (lambda (x) (if (pred x) (return x) #f))\n             xs)\n           #f)))\n     (detect (lambda (x) (> x 10)) '(1 5 7 12 20))")
+  12)
+(scm-ctl-test
+  "call/cc: detect returns #f when no match"
+  (scm-ctl-all
+    "(define (detect pred xs)\n       (call/cc\n         (lambda (return)\n           (for-each\n             (lambda (x) (if (pred x) (return x) #f))\n             xs)\n           #f)))\n     (detect (lambda (x) (> x 100)) '(1 5 7))")
+  false)
+
+;; ── call/cc producing the captured k value ──────────────────────
+(scm-ctl-test
+  "call/cc: k is a procedure"
+  (scm-ctl "(procedure? (call/cc (lambda (k) k)))")
+  true)
+
+;; ── Exceptions: raise / guard / with-exception-handler / error ──
+(scm-ctl-test "raise + guard caught"
+  (scm-ctl "(guard (e (else 'caught)) (raise 'boom))") "caught")
+(scm-ctl-test "guard: number? matches"
+  (scm-ctl "(guard (e ((number? e) e) (else 'other)) (raise 42))") 42)
+(scm-ctl-test "guard: number? mismatches → else"
+  (scm-ctl "(guard (e ((number? e) e) (else 'other)) (raise 'sym))")
+  "other")
+(scm-ctl-test "guard: no error → body value"
+  (scm-ctl "(guard (e (else 'never)) 42)") 42)
+(scm-ctl-test "guard: first matching clause wins"
+  (scm-ctl
+    "(guard (e ((number? e) 'num) ((symbol? e) 'sym) (else 'other)) (raise 'foo))")
+  "sym")
+(scm-ctl-test "guard: re-raises when no clause matches"
+  (scm-ctl
+    "(guard (e (else 'outer)) (guard (e ((number? e) 'inner)) (raise 'not-a-number)))")
+  "outer")
+(scm-ctl-test "guard: var bound in clause body"
+  (scm-ctl "(guard (e ((symbol? e) e)) (raise 'the-symbol))")
+  "the-symbol")
+(scm-ctl-test "with-exception-handler: caught"
+  (scm-ctl
+    "(with-exception-handler (lambda (e) 'caught) (lambda () (raise 'oops)))")
+  "caught")
+(scm-ctl-test "with-exception-handler: no raise"
+  (scm-ctl
+    "(with-exception-handler (lambda (e) 99) (lambda () 42))")
+  42)
+(scm-ctl-test "with-exception-handler: handler sees the value"
+  (scm-ctl
+    "(with-exception-handler (lambda (e) (+ e 1)) (lambda () (raise 41)))")
+  42)
+(scm-ctl-test "error: irritants accessible"
+  (scm-ctl
+    "(guard (e ((error-object? e) (error-object-irritants e))) (error \"msg\" 1 2 3))")
+  (list 1 2 3))
+(scm-ctl-test "error: message accessible"
+  (scheme-string-value
+    (scm-ctl
+      "(guard (e ((error-object? e) (error-object-message e))) (error \"the-msg\"))"))
+  "the-msg")
+
+;; ── dynamic-wind ────────────────────────────────────────────────
+;; Basic version: runs before/thunk/after on success; before/after
+;; on raise (with the raise still propagating after the after-thunk).
+;; call/cc escape-out interaction is NOT yet tracked — deferred.
+
+(scm-ctl-test "dynamic-wind: ordering on success"
+  (scm-ctl-all
+    "(define log '())
+     (define (note x) (set! log (cons x log)))
+     (dynamic-wind
+       (lambda () (note 'before))
+       (lambda () (note 'thunk) 42)
+       (lambda () (note 'after)))
+     (reverse log)")
+  (list "before" "thunk" "after"))
+(scm-ctl-test "dynamic-wind: returns thunk value"
+  (scm-ctl
+    "(dynamic-wind (lambda () 'b) (lambda () 42) (lambda () 'a))") 42)
+(scm-ctl-test "dynamic-wind: after runs on raise"
+  (scm-ctl-all
+    "(define log '())
+     (define (note x) (set! log (cons x log)))
+     (guard (e (else 'caught))
+       (dynamic-wind
+         (lambda () (note 'before))
+         (lambda () (raise 'boom))
+         (lambda () (note 'after))))
+     (reverse log)")
+  (list "before" "after"))
+(scm-ctl-test "dynamic-wind: raise propagates after after-thunk"
+  (scm-ctl-all
+    "(guard (e (else e))
+       (dynamic-wind
+         (lambda () 'b)
+         (lambda () (raise 'the-raised))
+         (lambda () 'a)))")
+  "the-raised")
+(scm-ctl-test "dynamic-wind: nested"
+  (scm-ctl-all
+    "(define log '())
+     (define (note x) (set! log (cons x log)))
+     (dynamic-wind
+       (lambda () (note 'outer-before))
+       (lambda ()
+         (dynamic-wind
+           (lambda () (note 'inner-before))
+           (lambda () (note 'inner-thunk))
+           (lambda () (note 'inner-after))))
+       (lambda () (note 'outer-after)))
+     (reverse log)")
+  (list "outer-before" "inner-before" "inner-thunk"
+        "inner-after" "outer-after"))
+
+(define scm-ctl-tests-run! (fn () {:total (+ scm-ctl-pass scm-ctl-fail) :passed scm-ctl-pass :failed scm-ctl-fail :fails scm-ctl-fails}))

lib/scheme/tests/eval.sx

@@ -0,0 +1,162 @@
+;; lib/scheme/tests/eval.sx — exercises lib/scheme/eval.sx (Phase 2).
+
+(define scm-eval-pass 0)
+(define scm-eval-fail 0)
+(define scm-eval-fails (list))
+
+(define
+  scm-eval-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! scm-eval-pass (+ scm-eval-pass 1))
+      (begin
+        (set! scm-eval-fail (+ scm-eval-fail 1))
+        (append! scm-eval-fails {:name name :actual actual :expected expected})))))
+
+(define scm-eval-src (fn (src env) (scheme-eval (scheme-parse src) env)))
+
+;; A toy env with arithmetic + list primitives.
+(define
+  scm-test-env
+  (fn
+    ()
+    (let
+      ((env (scheme-make-env)))
+      (scheme-env-bind!
+        env
+        "+"
+        (fn (args) (+ (first args) (nth args 1))))
+      (scheme-env-bind!
+        env
+        "-"
+        (fn (args) (- (first args) (nth args 1))))
+      (scheme-env-bind!
+        env
+        "*"
+        (fn (args) (* (first args) (nth args 1))))
+      (scheme-env-bind! env "list" (fn (args) args))
+      env)))
+
+;; ── self-evaluating ──────────────────────────────────────────────
+(scm-eval-test
+  "lit: integer"
+  (scm-eval-src "42" (scheme-make-env))
+  42)
+(scm-eval-test "lit: float" (scm-eval-src "3.14" (scheme-make-env)) 3.14)
+(scm-eval-test "lit: #t" (scm-eval-src "#t" (scheme-make-env)) true)
+(scm-eval-test "lit: #f" (scm-eval-src "#f" (scheme-make-env)) false)
+(scm-eval-test
+  "lit: empty list"
+  (scm-eval-src "()" (scheme-make-env))
+  (list))
+(scm-eval-test
+  "lit: string"
+  (scheme-string? (scm-eval-src "\"hello\"" (scheme-make-env)))
+  true)
+(scm-eval-test
+  "lit: char"
+  (scheme-char? (scm-eval-src "#\\a" (scheme-make-env)))
+  true)
+(scm-eval-test
+  "lit: vector"
+  (scheme-vector? (scm-eval-src "#(1 2 3)" (scheme-make-env)))
+  true)
+
+;; ── symbol lookup ────────────────────────────────────────────────
+(scm-eval-test
+  "sym: bound"
+  (let
+    ((env (scheme-make-env)))
+    (scheme-env-bind! env "x" 100)
+    (scm-eval-src "x" env))
+  100)
+(scm-eval-test
+  "sym: parent chain"
+  (let
+    ((p (scheme-make-env)))
+    (scheme-env-bind! p "outer" 1)
+    (let
+      ((c (scheme-extend-env p)))
+      (scheme-env-bind! c "inner" 2)
+      (+ (scm-eval-src "outer" c) (scm-eval-src "inner" c))))
+  3)
+(scm-eval-test
+  "sym: shadowing"
+  (let
+    ((p (scheme-make-env)))
+    (scheme-env-bind! p "x" 1)
+    (let
+      ((c (scheme-extend-env p)))
+      (scheme-env-bind! c "x" 2)
+      (scm-eval-src "x" c)))
+  2)
+
+;; ── quote ────────────────────────────────────────────────────────
+(scm-eval-test
+  "quote: symbol"
+  (scm-eval-src "(quote foo)" (scheme-make-env))
+  "foo")
+(scm-eval-test
+  "quote: list"
+  (scm-eval-src "(quote (+ 1 2))" (scheme-make-env))
+  (list "+" 1 2))
+(scm-eval-test "quote: sugar 'x" (scm-eval-src "'x" (scheme-make-env)) "x")
+(scm-eval-test
+  "quote: sugar list"
+  (scm-eval-src "'(a b c)" (scheme-make-env))
+  (list "a" "b" "c"))
+(scm-eval-test
+  "quote: nested"
+  (scm-eval-src "''x" (scheme-make-env))
+  (list "quote" "x"))
+
+;; ── primitive application ────────────────────────────────────────
+(scm-eval-test "prim: +" (scm-eval-src "(+ 2 3)" (scm-test-env)) 5)
+(scm-eval-test
+  "prim: nested +"
+  (scm-eval-src "(+ (+ 1 2) (+ 3 4))" (scm-test-env))
+  10)
+(scm-eval-test
+  "prim: mixed ops"
+  (scm-eval-src "(- (* 4 5) (+ 3 2))" (scm-test-env))
+  15)
+(scm-eval-test
+  "prim: list builds SX list"
+  (scm-eval-src "(list 1 2 3)" (scm-test-env))
+  (list 1 2 3))
+(scm-eval-test
+  "prim: args eval in order"
+  (let
+    ((env (scm-test-env)))
+    (scheme-env-bind! env "a" 10)
+    (scheme-env-bind! env "b" 20)
+    (scm-eval-src "(+ a b)" env))
+  30)
+
+;; ── env-as-value (the third-consumer demonstration) ─────────────
+;; Scheme's env IS lib/guest/reflective/env.sx's canonical wire shape
+;; with no adapter cfg. Verify the kit primitives work directly.
+(scm-eval-test
+  "env: refl-env? on Scheme env"
+  (refl-env? (scheme-make-env))
+  true)
+(scm-eval-test
+  "env: lookup via kit"
+  (let
+    ((env (scheme-make-env)))
+    (refl-env-bind! env "name" "scheme")
+    (refl-env-lookup env "name"))
+  "scheme")
+(scm-eval-test
+  "env: find-frame walks parent"
+  (let
+    ((p (scheme-make-env)))
+    (refl-env-bind! p "root-binding" 99)
+    (let
+      ((c (scheme-extend-env p)))
+      (= (refl-env-find-frame c "root-binding") p)))
+  true)
+
+(define scm-eval-tests-run! (fn () {:total (+ scm-eval-pass scm-eval-fail) :passed scm-eval-pass :failed scm-eval-fail :fails scm-eval-fails}))

lib/scheme/tests/macros.sx

@@ -0,0 +1,155 @@
+;; lib/scheme/tests/macros.sx — define-syntax + syntax-rules.
+
+(define scm-mac-pass 0)
+(define scm-mac-fail 0)
+(define scm-mac-fails (list))
+
+(define
+  scm-mac-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! scm-mac-pass (+ scm-mac-pass 1))
+      (begin
+        (set! scm-mac-fail (+ scm-mac-fail 1))
+        (append! scm-mac-fails {:name name :actual actual :expected expected})))))
+
+(define
+  scm-mac
+  (fn
+    (src)
+    (scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
+
+;; ── Basic syntax-rules ──────────────────────────────────────────
+
+(scm-mac-test
+  "my-if true"
+  (scm-mac
+    "(define-syntax my-if (syntax-rules () ((_ c t e) (cond (c t) (else e)))))\n     (my-if #t 'yes 'no)")
+  "yes")
+(scm-mac-test
+  "my-if false"
+  (scm-mac
+    "(define-syntax my-if (syntax-rules () ((_ c t e) (cond (c t) (else e)))))\n     (my-if #f 'yes 'no)")
+  "no")
+(scm-mac-test
+  "double"
+  (scm-mac
+    "(define-syntax double (syntax-rules () ((_ x) (+ x x))))\n     (double 21)")
+  42)
+(scm-mac-test
+  "nested macro use"
+  (scm-mac
+    "(define-syntax double (syntax-rules () ((_ x) (+ x x))))\n     (double (double 5))")
+  20)
+
+;; ── Macro with multiple rules ───────────────────────────────────
+
+(scm-mac-test
+  "multi-rule: matches first"
+  (scm-mac
+    "(define-syntax twin (syntax-rules () ((_ a) a) ((_ a b) (+ a b))))\n     (twin 7)")
+  7)
+(scm-mac-test
+  "multi-rule: matches second"
+  (scm-mac
+    "(define-syntax twin (syntax-rules () ((_ a) a) ((_ a b) (+ a b))))\n     (twin 3 4)")
+  7)
+
+;; ── Macros wrapping control flow ────────────────────────────────
+
+(scm-mac-test
+  "swap idiom"
+  (scm-mac
+    "(define-syntax swap! (syntax-rules () ((_ a b) (let ((tmp a)) (set! a b) (set! b tmp)))))\n     (define x 1) (define y 2)\n     (swap! x y)\n     (list x y)")
+  (list 2 1))
+
+;; ── Macros that expand to expressions, not values ──────────────
+
+(scm-mac-test
+  "my-unless: true → empty"
+  (scm-mac
+    "(define-syntax my-unless (syntax-rules () ((_ c body) (if c 'skipped body))))\n     (my-unless #t 99)")
+  "skipped")
+(scm-mac-test
+  "my-unless: false → body"
+  (scm-mac
+    "(define-syntax my-unless (syntax-rules () ((_ c body) (if c 'skipped body))))\n     (my-unless #f 99)")
+  99)
+
+;; ── Macro with literal keyword ─────────────────────────────────
+
+(scm-mac-test
+  "literal: => recognised"
+  (scm-mac
+    "(define-syntax tag-arrow (syntax-rules (=>) ((_ a => b) (list 'arrow a b))))\n     (tag-arrow 1 => 2)")
+  (list "arrow" 1 2))
+
+;; ── Macro keyword passed through unevaluated ────────────────────
+
+(scm-mac-test
+  "list expansion preserves arg order"
+  (scm-mac
+    "(define-syntax tuple (syntax-rules () ((_ a b c) (list a b c))))\n     (tuple 1 2 3)")
+  (list 1 2 3))
+
+;; ── Macros + lambdas ────────────────────────────────────────────
+
+(scm-mac-test
+  "macro inside lambda"
+  (scm-mac
+    "(define-syntax sq (syntax-rules () ((_ x) (* x x))))\n     (define (f n) (+ (sq n) 1))\n     (f 5)")
+  26)
+
+;; ── Ellipsis patterns (Phase 6b — tail-rest single-variable) ────
+(scm-mac-test "ellipsis: empty rest"
+  (scm-mac
+    "(define-syntax my-list (syntax-rules () ((_ xs ...) (list xs ...))))
+     (my-list)")
+  (list))
+(scm-mac-test "ellipsis: list of values"
+  (scm-mac
+    "(define-syntax my-list (syntax-rules () ((_ xs ...) (list xs ...))))
+     (my-list 1 2 3 4)")
+  (list 1 2 3 4))
+(scm-mac-test "ellipsis: my-when truthy"
+  (scm-mac
+    "(define-syntax my-when (syntax-rules () ((_ c body ...) (if c (begin body ...)))))
+     (my-when #t 1 2 3)")
+  3)
+(scm-mac-test "ellipsis: my-when falsy returns nil"
+  (scm-mac
+    "(define-syntax my-when (syntax-rules () ((_ c body ...) (if c (begin body ...)))))
+     (my-when #f 1 2 3)")
+  nil)
+(scm-mac-test "ellipsis: begin-rebuild"
+  (scm-mac
+    "(define-syntax my-begin (syntax-rules () ((_ body ...) (let () body ...))))
+     (my-begin (define x 5) (define y 10) (+ x y))")
+  15)
+(scm-mac-test "ellipsis: variadic sum-em via fold"
+  (scm-mac
+    "(define-syntax sum-em (syntax-rules () ((_ xs ...) (fold-left + 0 (list xs ...)))))
+     (sum-em 1 2 3 4 5)")
+  15)
+(scm-mac-test "ellipsis: recursive my-and"
+  (scm-mac
+    "(define-syntax my-and
+       (syntax-rules ()
+         ((_) #t)
+         ((_ x) x)
+         ((_ x xs ...) (if x (my-and xs ...) #f))))
+     (my-and 1 2 3)")
+  3)
+(scm-mac-test "ellipsis: my-and short-circuits"
+  (scm-mac
+    "(define-syntax my-and
+       (syntax-rules ()
+         ((_) #t)
+         ((_ x) x)
+         ((_ x xs ...) (if x (my-and xs ...) #f))))
+     (my-and 1 #f 3)")
+  false)
+
+(define scm-mac-tests-run! (fn () {:total (+ scm-mac-pass scm-mac-fail) :passed scm-mac-pass :failed scm-mac-fail :fails scm-mac-fails}))

lib/scheme/tests/modules.sx

@@ -0,0 +1,73 @@
+;; lib/scheme/tests/modules.sx — define-library + import.
+
+(define scm-mod-pass 0)
+(define scm-mod-fail 0)
+(define scm-mod-fails (list))
+
+(define
+  scm-mod-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! scm-mod-pass (+ scm-mod-pass 1))
+      (begin
+        (set! scm-mod-fail (+ scm-mod-fail 1))
+        (append! scm-mod-fails {:name name :actual actual :expected expected})))))
+
+(define
+  scm-mod
+  (fn
+    (src)
+    (scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
+
+;; ── Basic define-library + import ───────────────────────────────
+
+(scm-mod-test
+  "simple lib: sq exported"
+  (scm-mod
+    "(define-library (my math)\n       (export sq)\n       (begin (define (sq x) (* x x))))\n     (import (my math))\n     (sq 5)")
+  25)
+(scm-mod-test
+  "lib: multiple exports"
+  (scm-mod
+    "(define-library (my math)\n       (export sq cube)\n       (begin\n         (define (sq x) (* x x))\n         (define (cube x) (* x x x))))\n     (import (my math))\n     (list (sq 5) (cube 3))")
+  (list 25 27))
+(scm-mod-test
+  "lib: single-symbol name"
+  (scm-mod
+    "(define-library (utils)\n       (export greet)\n       (begin (define (greet name) (string-append \"hi \" name))))\n     (import (utils))\n     (string=? (greet \"world\") \"hi world\")")
+  true)
+
+;; ── Unexported names are not visible ───────────────────────────
+
+(scm-mod-test
+  "lib: private name not exported"
+  (scm-mod
+    "(define-library (my math)\n       (export sq)\n       (begin\n         (define (sq x) (* x x))\n         (define (private-helper x) (+ x 1))))\n     (import (my math))\n     (guard (e (else 'unbound)) private-helper)")
+  "unbound")
+
+;; ── Library calls its own internals ─────────────────────────────
+
+(scm-mod-test
+  "lib: internal calls private fn"
+  (scm-mod
+    "(define-library (my math)\n       (export public-add1)\n       (begin\n         (define (private-inc x) (+ x 1))\n         (define (public-add1 x) (private-inc x))))\n     (import (my math))\n     (public-add1 41)")
+  42)
+
+;; ── Two libs, both imported ────────────────────────────────────
+
+(scm-mod-test
+  "two libs: both imported"
+  (scm-mod
+    "(define-library (a) (export af) (begin (define (af) 1)))\n     (define-library (b) (export bf) (begin (define (bf) 2)))\n     (import (a) (b))\n     (+ (af) (bf))")
+  3)
+
+;; ── Unknown library import errors ──────────────────────────────
+
+(scm-mod-test
+  "import: unknown lib errors"
+  (scm-mod "(guard (e (else 'unknown-lib)) (import (no such lib)))")
+  "unknown-lib")
+
+(define scm-mod-tests-run! (fn () {:total (+ scm-mod-pass scm-mod-fail) :passed scm-mod-pass :failed scm-mod-fail :fails scm-mod-fails}))

lib/scheme/tests/parse.sx

@@ -0,0 +1,177 @@
+;; lib/scheme/tests/parse.sx — exercises lib/scheme/parser.sx.
+
+(define scm-test-pass 0)
+(define scm-test-fail 0)
+(define scm-test-fails (list))
+
+(define
+  scm-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! scm-test-pass (+ scm-test-pass 1))
+      (begin
+        (set! scm-test-fail (+ scm-test-fail 1))
+        (append! scm-test-fails {:name name :actual actual :expected expected})))))
+
+;; ── numbers ───────────────────────────────────────────────────────
+(scm-test "num: integer" (scheme-parse "42") 42)
+(scm-test "num: zero" (scheme-parse "0") 0)
+(scm-test "num: negative" (scheme-parse "-17") -17)
+(scm-test "num: float" (scheme-parse "3.14") 3.14)
+(scm-test "num: exponent" (scheme-parse "1e3") 1000)
+(scm-test "num: negative float" (scheme-parse "-2.5") -2.5)
+
+;; ── booleans ──────────────────────────────────────────────────────
+(scm-test "bool: #t" (scheme-parse "#t") true)
+(scm-test "bool: #true" (scheme-parse "#true") true)
+(scm-test "bool: #f" (scheme-parse "#f") false)
+(scm-test "bool: #false" (scheme-parse "#false") false)
+
+;; ── strings ───────────────────────────────────────────────────────
+(scm-test "str: empty" (scheme-string-value (scheme-parse "\"\"")) "")
+(scm-test
+  "str: hello"
+  (scheme-string-value (scheme-parse "\"hello\""))
+  "hello")
+(scm-test "str: predicate" (scheme-string? (scheme-parse "\"x\"")) true)
+(scm-test "str: not symbol" (scheme-string? (scheme-parse "x")) false)
+(scm-test
+  "str: escape newline"
+  (scheme-string-value (scheme-parse "\"a\\nb\""))
+  "a\nb")
+(scm-test
+  "str: escape tab"
+  (scheme-string-value (scheme-parse "\"a\\tb\""))
+  "a\tb")
+(scm-test
+  "str: escape quote"
+  (scheme-string-value (scheme-parse "\"a\\\"b\""))
+  "a\"b")
+
+;; ── symbols ───────────────────────────────────────────────────────
+(scm-test "sym: word" (scheme-parse "foo") "foo")
+(scm-test "sym: hyphenated" (scheme-parse "set-car!") "set-car!")
+(scm-test "sym: question mark" (scheme-parse "null?") "null?")
+(scm-test "sym: arrow" (scheme-parse "->") "->")
+(scm-test "sym: lt-eq" (scheme-parse "<=") "<=")
+(scm-test "sym: bare plus" (scheme-parse "+") "+")
+(scm-test "sym: bare minus" (scheme-parse "-") "-")
+(scm-test "sym: dot-prefixed" (scheme-parse ".foo") ".foo")
+
+;; ── characters ────────────────────────────────────────────────────
+(scm-test "char: single" (scheme-char-value (scheme-parse "#\\a")) "a")
+(scm-test "char: space" (scheme-char-value (scheme-parse "#\\space")) " ")
+(scm-test "char: newline" (scheme-char-value (scheme-parse "#\\newline")) "\n")
+(scm-test "char: tab" (scheme-char-value (scheme-parse "#\\tab")) "\t")
+(scm-test "char: predicate" (scheme-char? (scheme-parse "#\\x")) true)
+(scm-test "char: digit" (scheme-char-value (scheme-parse "#\\5")) "5")
+
+;; ── vectors ───────────────────────────────────────────────────────
+(scm-test "vec: empty" (scheme-vector-elements (scheme-parse "#()")) (list))
+(scm-test
+  "vec: numbers"
+  (scheme-vector-elements (scheme-parse "#(1 2 3)"))
+  (list 1 2 3))
+(scm-test "vec: predicate" (scheme-vector? (scheme-parse "#(1)")) true)
+(scm-test "vec: not list" (scheme-vector? (scheme-parse "(1)")) false)
+;; Nested vector: SX `=` doesn't deep-compare dicts-with-list-values
+;; reliably under this CEK path, so check structure piecewise.
+(scm-test "vec: nested first"
+  (first (scheme-vector-elements (scheme-parse "#(a #(b c) d)"))) "a")
+(scm-test "vec: nested second is vector"
+  (scheme-vector?
+    (nth (scheme-vector-elements (scheme-parse "#(a #(b c) d)")) 1))
+  true)
+(scm-test "vec: nested second elements"
+  (scheme-vector-elements
+    (nth (scheme-vector-elements (scheme-parse "#(a #(b c) d)")) 1))
+  (list "b" "c"))
+
+;; ── lists ─────────────────────────────────────────────────────────
+(scm-test "list: empty" (scheme-parse "()") (list))
+(scm-test "list: flat" (scheme-parse "(a b c)") (list "a" "b" "c"))
+(scm-test
+  "list: nested"
+  (scheme-parse "(a (b c) d)")
+  (list "a" (list "b" "c") "d"))
+(scm-test
+  "list: mixed atoms"
+  (scheme-parse "(1 #t foo)")
+  (list 1 true "foo"))
+
+;; ── reader macros ─────────────────────────────────────────────────
+(scm-test "quote: 'foo" (scheme-parse "'foo") (list "quote" "foo"))
+(scm-test
+  "quote: '(a b c)"
+  (scheme-parse "'(a b c)")
+  (list "quote" (list "a" "b" "c")))
+(scm-test "quasiquote: `x" (scheme-parse "`x") (list "quasiquote" "x"))
+(scm-test "unquote: ,x" (scheme-parse ",x") (list "unquote" "x"))
+(scm-test
+  "unquote-splicing: ,@x"
+  (scheme-parse ",@x")
+  (list "unquote-splicing" "x"))
+(scm-test
+  "qq mix"
+  (scheme-parse "`(a ,b ,@c)")
+  (list
+    "quasiquote"
+    (list "a" (list "unquote" "b") (list "unquote-splicing" "c"))))
+
+;; ── comments ──────────────────────────────────────────────────────
+(scm-test "comment: line" (scheme-parse "; nope\n42") 42)
+(scm-test "comment: trailing" (scheme-parse "42 ; tail") 42)
+(scm-test
+  "comment: inside list"
+  (scheme-parse "(a ; mid\n  b)")
+  (list "a" "b"))
+(scm-test "comment: block simple" (scheme-parse "#| skip |# 42") 42)
+(scm-test
+  "comment: block nested"
+  (scheme-parse "#| outer #| inner |# done |# 42")
+  42)
+(scm-test "comment: datum #;" (scheme-parse "#;skipme 42") 42)
+(scm-test
+  "comment: datum skips list"
+  (scheme-parse "#;(1 2 3) 42")
+  42)
+
+;; ── parse-all ─────────────────────────────────────────────────────
+(scm-test "all: empty" (scheme-parse-all "") (list))
+(scm-test
+  "all: three forms"
+  (scheme-parse-all "1 2 3")
+  (list 1 2 3))
+(scm-test
+  "all: mixed"
+  (scheme-parse-all "(if #t 1 2) foo")
+  (list (list "if" true 1 2) "foo"))
+
+;; ── classic Scheme idioms ─────────────────────────────────────────
+(scm-test
+  "classic: lambda"
+  (scheme-parse "(lambda (x) (+ x 1))")
+  (list "lambda" (list "x") (list "+" "x" 1)))
+(scm-test
+  "classic: define"
+  (scheme-parse "(define (sq x) (* x x))")
+  (list "define" (list "sq" "x") (list "*" "x" "x")))
+(scm-test
+  "classic: let"
+  (scheme-parse "(let ((x 1) (y 2)) (+ x y))")
+  (list
+    "let"
+    (list (list "x" 1) (list "y" 2))
+    (list "+" "x" "y")))
+(scm-test
+  "classic: if"
+  (scheme-parse "(if (zero? n) 1 (* n (fact (- n 1))))")
+  (list
+    "if"
+    (list "zero?" "n")
+    1
+    (list "*" "n" (list "fact" (list "-" "n" 1)))))
+
+(define scm-tests-run! (fn () {:total (+ scm-test-pass scm-test-fail) :passed scm-test-pass :failed scm-test-fail :fails scm-test-fails}))

lib/scheme/tests/records.sx

@@ -0,0 +1,96 @@
+;; lib/scheme/tests/records.sx — define-record-type.
+
+(define scm-rec-pass 0)
+(define scm-rec-fail 0)
+(define scm-rec-fails (list))
+
+(define
+  scm-rec-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! scm-rec-pass (+ scm-rec-pass 1))
+      (begin
+        (set! scm-rec-fail (+ scm-rec-fail 1))
+        (append! scm-rec-fails {:name name :actual actual :expected expected})))))
+
+(define
+  scm-rec
+  (fn (src) (scheme-eval (scheme-parse src) (scheme-standard-env))))
+
+(define
+  scm-rec-all
+  (fn
+    (src)
+    (scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
+
+;; ── Basic record: point ─────────────────────────────────────────
+
+(scm-rec-test
+  "point: constructor + predicate"
+  (scm-rec-all
+    "(define-record-type point\n       (make-point x y) point?\n       (x point-x) (y point-y))\n     (point? (make-point 3 4))")
+  true)
+(scm-rec-test
+  "point: accessor x"
+  (scm-rec-all
+    "(define-record-type point\n       (make-point x y) point?\n       (x point-x) (y point-y))\n     (point-x (make-point 3 4))")
+  3)
+(scm-rec-test
+  "point: accessor y"
+  (scm-rec-all
+    "(define-record-type point\n       (make-point x y) point?\n       (x point-x) (y point-y))\n     (point-y (make-point 3 4))")
+  4)
+(scm-rec-test
+  "point: predicate false on number"
+  (scm-rec-all
+    "(define-record-type point\n       (make-point x y) point?\n       (x point-x) (y point-y))\n     (point? 42)")
+  false)
+
+;; ── Mutator ─────────────────────────────────────────────────────
+
+(scm-rec-test
+  "point: mutator"
+  (scm-rec-all
+    "(define-record-type point\n       (make-point x y) point?\n       (x point-x) (y point-y set-point-y!))\n     (define p (make-point 3 4))\n     (set-point-y! p 99)\n     (point-y p)")
+  99)
+
+;; ── Multiple record types are distinct ──────────────────────────
+
+(scm-rec-test
+  "distinct types: point? false on circle"
+  (scm-rec-all
+    "(define-record-type point\n       (make-point x y) point? (x point-x) (y point-y))\n     (define-record-type circle\n       (make-circle r) circle? (r circle-r))\n     (point? (make-circle 5))")
+  false)
+(scm-rec-test
+  "distinct types: circle? true on circle"
+  (scm-rec-all
+    "(define-record-type point\n       (make-point x y) point? (x point-x) (y point-y))\n     (define-record-type circle\n       (make-circle r) circle? (r circle-r))\n     (circle? (make-circle 5))")
+  true)
+
+;; ── Records as first-class values ───────────────────────────────
+
+(scm-rec-test
+  "record in a list"
+  (scm-rec-all
+    "(define-record-type box\n       (make-box v) box? (v box-v))\n     (map box-v (list (make-box 1) (make-box 2) (make-box 3)))")
+  (list 1 2 3))
+
+;; ── Records via map/filter ──────────────────────────────────────
+
+(scm-rec-test
+  "filter records by predicate"
+  (scm-rec-all
+    "(define-record-type box\n       (make-box v) box? (v box-v))\n     (length\n       (filter (lambda (b) (> (box-v b) 5))\n               (list (make-box 1) (make-box 7) (make-box 3) (make-box 10)))))")
+  2)
+
+;; ── Constructor arity errors ────────────────────────────────────
+
+(scm-rec-test
+  "ctor: wrong arity errors"
+  (scm-rec-all
+    "(define-record-type point (make-point x y) point? (x point-x) (y point-y))\n     (guard (e (else 'arity-err)) (make-point 1))")
+  "arity-err")
+
+(define scm-rec-tests-run! (fn () {:total (+ scm-rec-pass scm-rec-fail) :passed scm-rec-pass :failed scm-rec-fail :fails scm-rec-fails}))

lib/scheme/tests/reflection.sx

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

lib/scheme/tests/runtime.sx

@@ -0,0 +1,213 @@
+;; lib/scheme/tests/runtime.sx — exercises the standard env.
+
+(define scm-rt-pass 0)
+(define scm-rt-fail 0)
+(define scm-rt-fails (list))
+
+(define
+  scm-rt-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! scm-rt-pass (+ scm-rt-pass 1))
+      (begin
+        (set! scm-rt-fail (+ scm-rt-fail 1))
+        (append! scm-rt-fails {:name name :actual actual :expected expected})))))
+
+(define
+  scm-rt
+  (fn (src) (scheme-eval (scheme-parse src) (scheme-standard-env))))
+
+(define
+  scm-rt-all
+  (fn
+    (src)
+    (scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
+
+;; ── Variadic arithmetic ─────────────────────────────────────────
+(scm-rt-test "+: zero" (scm-rt "(+)") 0)
+(scm-rt-test "+: one" (scm-rt "(+ 7)") 7)
+(scm-rt-test "+: many" (scm-rt "(+ 1 2 3 4 5)") 15)
+(scm-rt-test "-: one" (scm-rt "(- 10)") -10)
+(scm-rt-test "-: many" (scm-rt "(- 100 1 2 3)") 94)
+(scm-rt-test "*: zero" (scm-rt "(*)") 1)
+(scm-rt-test "*: many" (scm-rt "(* 1 2 3 4)") 24)
+(scm-rt-test "/: two" (scm-rt "(/ 20 5)") 4)
+
+;; ── Chained comparison ──────────────────────────────────────────
+(scm-rt-test "<: chained" (scm-rt "(< 1 2 3 4 5)") true)
+(scm-rt-test "<: not strict" (scm-rt "(< 1 2 2 3)") false)
+(scm-rt-test ">: chained" (scm-rt "(> 5 4 3 2 1)") true)
+(scm-rt-test "<=: with equality" (scm-rt "(<= 1 1 2 3 3)") true)
+(scm-rt-test "=: chained" (scm-rt "(= 7 7 7)") true)
+
+;; ── Numerical ───────────────────────────────────────────────────
+(scm-rt-test "abs neg" (scm-rt "(abs -5)") 5)
+(scm-rt-test "abs pos" (scm-rt "(abs 5)") 5)
+(scm-rt-test "min" (scm-rt "(min 3 1 4 1 5)") 1)
+(scm-rt-test "max" (scm-rt "(max 3 1 4 1 5)") 5)
+(scm-rt-test "modulo" (scm-rt "(modulo 10 3)") 1)
+(scm-rt-test "zero? 0" (scm-rt "(zero? 0)") true)
+(scm-rt-test "zero? 1" (scm-rt "(zero? 1)") false)
+(scm-rt-test "positive?" (scm-rt "(positive? 5)") true)
+(scm-rt-test "negative?" (scm-rt "(negative? -5)") true)
+
+;; ── Type predicates ─────────────────────────────────────────────
+(scm-rt-test "number? int" (scm-rt "(number? 42)") true)
+(scm-rt-test "number? str" (scm-rt "(number? \"hi\")") false)
+(scm-rt-test "boolean? #t" (scm-rt "(boolean? #t)") true)
+(scm-rt-test "boolean? 0" (scm-rt "(boolean? 0)") false)
+(scm-rt-test "string? str" (scm-rt "(string? \"hi\")") true)
+(scm-rt-test "string? sym" (scm-rt "(string? 'foo)") false)
+(scm-rt-test "symbol? sym" (scm-rt "(symbol? 'foo)") true)
+(scm-rt-test "null? ()" (scm-rt "(null? '())") true)
+(scm-rt-test "null? (1)" (scm-rt "(null? '(1))") false)
+(scm-rt-test "pair? (1)" (scm-rt "(pair? '(1))") true)
+(scm-rt-test "pair? ()" (scm-rt "(pair? '())") false)
+(scm-rt-test "procedure? lambda" (scm-rt "(procedure? (lambda (x) x))") true)
+(scm-rt-test "procedure? +" (scm-rt "(procedure? +)") true)
+(scm-rt-test "procedure? 42" (scm-rt "(procedure? 42)") false)
+(scm-rt-test "not #t" (scm-rt "(not #t)") false)
+(scm-rt-test "not #f" (scm-rt "(not #f)") true)
+(scm-rt-test "not 0" (scm-rt "(not 0)") false)
+
+;; ── List operations ─────────────────────────────────────────────
+(scm-rt-test
+  "cons"
+  (scm-rt "(cons 1 '(2 3))")
+  (list 1 2 3))
+(scm-rt-test "car" (scm-rt "(car '(1 2 3))") 1)
+(scm-rt-test "cdr" (scm-rt "(cdr '(1 2 3))") (list 2 3))
+(scm-rt-test
+  "list builds"
+  (scm-rt "(list 1 2 3)")
+  (list 1 2 3))
+(scm-rt-test "list empty" (scm-rt "(list)") (list))
+(scm-rt-test "length 3" (scm-rt "(length '(a b c))") 3)
+(scm-rt-test "length 0" (scm-rt "(length '())") 0)
+(scm-rt-test
+  "reverse"
+  (scm-rt "(reverse '(1 2 3))")
+  (list 3 2 1))
+(scm-rt-test "reverse empty" (scm-rt "(reverse '())") (list))
+(scm-rt-test
+  "append two"
+  (scm-rt "(append '(1 2) '(3 4))")
+  (list 1 2 3 4))
+(scm-rt-test
+  "append three"
+  (scm-rt "(append '(1) '(2) '(3))")
+  (list 1 2 3))
+(scm-rt-test "append empty" (scm-rt "(append)") (list))
+
+;; ── Higher-order combinators ────────────────────────────────────
+(scm-rt-test
+  "map square"
+  (scm-rt "(map (lambda (x) (* x x)) '(1 2 3 4))")
+  (list 1 4 9 16))
+(scm-rt-test
+  "map with primitive"
+  (scm-rt-all "(define inc (lambda (x) (+ x 1))) (map inc '(10 20 30))")
+  (list 11 21 31))
+(scm-rt-test
+  "filter positives"
+  (scm-rt "(filter positive? '(-2 -1 0 1 2))")
+  (list 1 2))
+(scm-rt-test
+  "filter empty result"
+  (scm-rt "(filter (lambda (x) #f) '(1 2 3))")
+  (list))
+(scm-rt-test
+  "fold-left sum"
+  (scm-rt "(fold-left + 0 '(1 2 3 4 5))")
+  15)
+(scm-rt-test
+  "fold-left build list"
+  (scm-rt "(fold-left (lambda (acc x) (cons x acc)) '() '(1 2 3))")
+  (list 3 2 1))
+(scm-rt-test
+  "fold-right preserves order"
+  (scm-rt "(fold-right cons '() '(1 2 3))")
+  (list 1 2 3))
+(scm-rt-test
+  "for-each side effect"
+  (let
+    ((env (scheme-standard-env)))
+    (scheme-eval-program
+      (scheme-parse-all
+        "(define sum 0) (for-each (lambda (n) (set! sum (+ sum n))) '(1 2 3 4 5)) sum")
+      env))
+  15)
+
+;; ── apply ───────────────────────────────────────────────────────
+(scm-rt-test "apply +" (scm-rt "(apply + '(1 2 3 4 5))") 15)
+(scm-rt-test
+  "apply lambda"
+  (scm-rt "(apply (lambda (a b c) (+ a (* b c))) '(1 2 3))")
+  7)
+(scm-rt-test
+  "apply via map"
+  (scm-rt "(apply + (map (lambda (x) (* x x)) '(1 2 3)))")
+  14)
+
+;; ── String / char / vector ──────────────────────────────────────
+(scm-rt-test "string-length" (scm-rt "(string-length \"hello\")") 5)
+(scm-rt-test "string=? same" (scm-rt "(string=? \"abc\" \"abc\")") true)
+(scm-rt-test "string=? diff" (scm-rt "(string=? \"abc\" \"abd\")") false)
+(scm-rt-test
+  "string-append"
+  (scheme-string-value (scm-rt "(string-append \"hello\" \" \" \"world\")"))
+  "hello world")
+(scm-rt-test "vector?" (scm-rt "(vector? #(1 2 3))") true)
+(scm-rt-test "vector-length" (scm-rt "(vector-length #(1 2 3))") 3)
+(scm-rt-test "vector-ref" (scm-rt "(vector-ref #(10 20 30) 1)") 20)
+(scm-rt-test
+  "vector->list"
+  (scm-rt "(vector->list #(1 2 3))")
+  (list 1 2 3))
+
+;; ── Classic Scheme programs ─────────────────────────────────────
+(scm-rt-test
+  "factorial 5"
+  (scm-rt-all
+    "(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 5)")
+  120)
+(scm-rt-test
+  "factorial 10"
+  (scm-rt-all
+    "(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 10)")
+  3628800)
+(scm-rt-test
+  "fib 10"
+  (scm-rt-all
+    "(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 10)")
+  55)
+(scm-rt-test
+  "sum via reduce"
+  (scm-rt "(fold-left + 0 (map (lambda (x) (* x x)) '(1 2 3 4 5)))")
+  55)
+(scm-rt-test
+  "length via reduce"
+  (scm-rt-all
+    "(define (len xs) (fold-left (lambda (acc _) (+ acc 1)) 0 xs)) (len '(a b c d))")
+  4)
+(scm-rt-test
+  "Y-ish reverse"
+  (scm-rt-all
+    "(define (rev xs) (if (null? xs) '() (append (rev (cdr xs)) (list (car xs))))) (rev '(1 2 3 4))")
+  (list 4 3 2 1))
+
+;; ── env-as-value (kit consumer demo) ────────────────────────────
+(scm-rt-test
+  "env: standard-env is refl-env"
+  (refl-env? (scheme-standard-env))
+  true)
+(scm-rt-test
+  "env: kit lookup finds primitive"
+  (let
+    ((env (scheme-standard-env)))
+    (callable? (refl-env-lookup env "+")))
+  true)
+
+(define scm-rt-tests-run! (fn () {:total (+ scm-rt-pass scm-rt-fail) :passed scm-rt-pass :failed scm-rt-fail :fails scm-rt-fails}))

lib/scheme/tests/syntax.sx

@@ -0,0 +1,288 @@
+;; lib/scheme/tests/syntax.sx — exercises Phase 3 syntactic operators.
+
+(define scm-syn-pass 0)
+(define scm-syn-fail 0)
+(define scm-syn-fails (list))
+
+(define
+  scm-syn-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! scm-syn-pass (+ scm-syn-pass 1))
+      (begin
+        (set! scm-syn-fail (+ scm-syn-fail 1))
+        (append! scm-syn-fails {:name name :actual actual :expected expected})))))
+
+(define scm-syn-eval (fn (src env) (scheme-eval (scheme-parse src) env)))
+
+(define
+  scm-syn-eval-all
+  (fn (src env) (scheme-eval-program (scheme-parse-all src) env)))
+
+;; Test env with arithmetic primitives.
+(define
+  scm-syn-env
+  (fn
+    ()
+    (let
+      ((env (scheme-make-env)))
+      (scheme-env-bind!
+        env
+        "+"
+        (fn (args) (+ (first args) (nth args 1))))
+      (scheme-env-bind!
+        env
+        "-"
+        (fn (args) (- (first args) (nth args 1))))
+      (scheme-env-bind!
+        env
+        "*"
+        (fn (args) (* (first args) (nth args 1))))
+      (scheme-env-bind!
+        env
+        "/"
+        (fn (args) (/ (first args) (nth args 1))))
+      (scheme-env-bind!
+        env
+        "<="
+        (fn (args) (<= (first args) (nth args 1))))
+      (scheme-env-bind!
+        env
+        "<"
+        (fn (args) (< (first args) (nth args 1))))
+      (scheme-env-bind!
+        env
+        "="
+        (fn (args) (= (first args) (nth args 1))))
+      (scheme-env-bind! env "list" (fn (args) args))
+      (scheme-env-bind!
+        env
+        "cons"
+        (fn (args) (cons (first args) (nth args 1))))
+      (scheme-env-bind! env "car" (fn (args) (first (first args))))
+      (scheme-env-bind! env "cdr" (fn (args) (rest (first args))))
+      env)))
+
+;; ── if ───────────────────────────────────────────────────────────
+(scm-syn-test
+  "if: true"
+  (scm-syn-eval "(if #t 1 2)" (scm-syn-env))
+  1)
+(scm-syn-test
+  "if: false"
+  (scm-syn-eval "(if #f 1 2)" (scm-syn-env))
+  2)
+(scm-syn-test
+  "if: predicate"
+  (scm-syn-eval "(if (<= 1 2) 99 nope)" (scm-syn-env))
+  99)
+(scm-syn-test
+  "if: no else returns nil"
+  (scm-syn-eval "(if #f 99)" (scm-syn-env))
+  nil)
+(scm-syn-test
+  "if: truthy non-#f"
+  (scm-syn-eval "(if 0 'yes 'no)" (scm-syn-env))
+  "yes")
+
+;; ── define ───────────────────────────────────────────────────────
+(scm-syn-test
+  "define: bind value"
+  (let
+    ((env (scm-syn-env)))
+    (scm-syn-eval "(define x 42)" env)
+    (scm-syn-eval "x" env))
+  42)
+(scm-syn-test
+  "define: function sugar"
+  (let
+    ((env (scm-syn-env)))
+    (scm-syn-eval-all "(define (double n) (+ n n)) (double 21)" env))
+  42)
+(scm-syn-test
+  "define: redefine"
+  (let
+    ((env (scm-syn-env)))
+    (scm-syn-eval-all "(define x 1) (define x 2) x" env))
+  2)
+
+;; ── set! ─────────────────────────────────────────────────────────
+(scm-syn-test
+  "set!: mutate"
+  (let
+    ((env (scm-syn-env)))
+    (scm-syn-eval-all "(define x 1) (set! x 99) x" env))
+  99)
+(scm-syn-test
+  "set!: walks parent"
+  (let
+    ((env (scm-syn-env)))
+    (scm-syn-eval-all "(define x 1) ((lambda () (set! x 100))) x" env))
+  100)
+(scm-syn-test
+  "set!: errors on unbound"
+  (guard
+    (e (true :raised))
+    (scm-syn-eval-all "(set! never-defined 1)" (scm-syn-env)))
+  :raised)
+
+;; ── begin ────────────────────────────────────────────────────────
+(scm-syn-test
+  "begin: empty returns nil"
+  (scm-syn-eval "(begin)" (scm-syn-env))
+  nil)
+(scm-syn-test
+  "begin: returns last"
+  (scm-syn-eval "(begin 1 2 3)" (scm-syn-env))
+  3)
+(scm-syn-test
+  "begin: side effects in order"
+  (let
+    ((env (scm-syn-env)))
+    (scm-syn-eval-all
+      "(define x 0) (begin (set! x 1) (set! x 2) (set! x 3)) x"
+      env))
+  3)
+
+;; ── lambda ───────────────────────────────────────────────────────
+(scm-syn-test
+  "lambda: identity"
+  (scm-syn-eval "((lambda (x) x) 42)" (scm-syn-env))
+  42)
+(scm-syn-test
+  "lambda: arithmetic"
+  (scm-syn-eval "((lambda (x y) (+ x y)) 3 4)" (scm-syn-env))
+  7)
+(scm-syn-test
+  "lambda: zero args"
+  (scm-syn-eval "((lambda () 99))" (scm-syn-env))
+  99)
+(scm-syn-test
+  "lambda: multi-body"
+  (scm-syn-eval "((lambda (x) (define t (+ x 1)) (+ t t)) 5)" (scm-syn-env))
+  12)
+(scm-syn-test
+  "lambda: rest-arg as bare symbol"
+  (scm-syn-eval "((lambda args args) 1 2 3)" (scm-syn-env))
+  (list 1 2 3))
+
+;; ── closures ─────────────────────────────────────────────────────
+(scm-syn-test
+  "closure: captures binding"
+  (let
+    ((env (scm-syn-env)))
+    (scm-syn-eval-all
+      "(define (make-adder n) (lambda (x) (+ x n))) ((make-adder 10) 5)"
+      env))
+  15)
+(scm-syn-test
+  "closure: counter via set!"
+  (let
+    ((env (scm-syn-env)))
+    (scm-syn-eval-all
+      "(define (make-counter) (define n 0) (lambda () (set! n (+ n 1)) n)) (define c (make-counter)) (c) (c) (c)"
+      env))
+  3)
+(scm-syn-test
+  "closure: curried"
+  (let
+    ((env (scm-syn-env)))
+    (scm-syn-eval-all
+      "(define curry+ (lambda (a) (lambda (b) (lambda (c) (+ a (+ b c)))))) (((curry+ 1) 2) 3)"
+      env))
+  6)
+
+;; ── recursion ────────────────────────────────────────────────────
+(scm-syn-test
+  "recursive: factorial 5"
+  (let
+    ((env (scm-syn-env)))
+    (scm-syn-eval-all
+      "(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 5)"
+      env))
+  120)
+(scm-syn-test
+  "recursive: factorial 10"
+  (let
+    ((env (scm-syn-env)))
+    (scm-syn-eval-all
+      "(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 10)"
+      env))
+  3628800)
+(scm-syn-test
+  "recursive: list length"
+  (let
+    ((env (scm-syn-env)))
+    (scm-syn-eval-all
+      "(define (len xs) (if (= 0 (- 0 0)) (if (= xs (quote ())) 0 (+ 1 (len (cdr xs)))) 0)) (len '(a b c d))"
+      env))
+  4)
+
+;; ── quote vs eval distinction ────────────────────────────────────
+(scm-syn-test
+  "quote: list literal"
+  (scm-syn-eval "'(1 2 3)" (scm-syn-env))
+  (list 1 2 3))
+(scm-syn-test
+  "quote: nested"
+  (scm-syn-eval "'(a (b c) d)" (scm-syn-env))
+  (list "a" (list "b" "c") "d"))
+(scm-syn-test
+  "quote: symbol vs evaluated"
+  (let ((env (scm-syn-env))) (scm-syn-eval-all "(define x 42) 'x" env))
+  "x")
+
+;; ── let / let* ───────────────────────────────────────────────────
+(scm-syn-test "let: returns body"
+  (scm-syn-eval "(let ((x 5)) (+ x 1))" (scm-syn-env)) 6)
+(scm-syn-test "let: multiple bindings"
+  (scm-syn-eval "(let ((x 3) (y 4)) (+ x y))" (scm-syn-env)) 7)
+(scm-syn-test "let: parallel (RHS sees outer)"
+  (let ((env (scm-syn-env)))
+    (scm-syn-eval-all "(define x 1) (let ((x 10) (y x)) y)" env)) 1)
+(scm-syn-test "let: bindings don't leak"
+  (let ((env (scm-syn-env)))
+    (scm-syn-eval-all "(define x 1) (let ((x 99)) x) x" env)) 1)
+(scm-syn-test "let*: sequential"
+  (scm-syn-eval "(let* ((x 1) (y (+ x 1)) (z (+ y 1))) z)"
+                (scm-syn-env)) 3)
+(scm-syn-test "let*: shadow earlier"
+  (scm-syn-eval "(let* ((x 1) (x 2)) x)" (scm-syn-env)) 2)
+
+;; ── cond / when / unless ─────────────────────────────────────────
+(scm-syn-test "cond: first match"
+  (scm-syn-eval "(cond (#f 1) (#t 2) (#t 3))" (scm-syn-env)) 2)
+(scm-syn-test "cond: else"
+  (scm-syn-eval "(cond (#f 1) (else 99))" (scm-syn-env)) 99)
+(scm-syn-test "cond: untaken not evaluated"
+  (scm-syn-eval "(cond (#t 7) (nope ignored))" (scm-syn-env)) 7)
+(scm-syn-test "cond: no match returns nil"
+  (scm-syn-eval "(cond (#f 1) (#f 2))" (scm-syn-env)) nil)
+(scm-syn-test "cond: test-only clause"
+  (scm-syn-eval "(cond (42))" (scm-syn-env)) 42)
+(scm-syn-test "when: true"
+  (scm-syn-eval "(when #t 1 2 3)" (scm-syn-env)) 3)
+(scm-syn-test "when: false"
+  (scm-syn-eval "(when #f nope)" (scm-syn-env)) nil)
+(scm-syn-test "unless: false"
+  (scm-syn-eval "(unless #f 42)" (scm-syn-env)) 42)
+(scm-syn-test "unless: true"
+  (scm-syn-eval "(unless #t nope)" (scm-syn-env)) nil)
+
+;; ── and / or ─────────────────────────────────────────────────────
+(scm-syn-test "and: empty"
+  (scm-syn-eval "(and)" (scm-syn-env)) true)
+(scm-syn-test "and: all truthy returns last"
+  (scm-syn-eval "(and 1 2 3)" (scm-syn-env)) 3)
+(scm-syn-test "and: short-circuit on #f"
+  (scm-syn-eval "(and 1 #f nope)" (scm-syn-env)) false)
+(scm-syn-test "or: empty"
+  (scm-syn-eval "(or)" (scm-syn-env)) false)
+(scm-syn-test "or: first truthy"
+  (scm-syn-eval "(or #f 42 nope)" (scm-syn-env)) 42)
+(scm-syn-test "or: all #f"
+  (scm-syn-eval "(or #f #f #f)" (scm-syn-env)) false)
+
+(define scm-syn-tests-run! (fn () {:total (+ scm-syn-pass scm-syn-fail) :passed scm-syn-pass :failed scm-syn-fail :fails scm-syn-fails}))

lib/smalltalk/compare.sh

@@ -41,6 +41,7 @@ run_sx () {
 (load "lib/smalltalk/tokenizer.sx")
 (load "lib/smalltalk/parser.sx")
 (load "lib/smalltalk/runtime.sx")
+(load "lib/guest/reflective/env.sx")
 (load "lib/smalltalk/eval.sx")
 (epoch 2)
 (eval "(begin (st-bootstrap-classes!) (smalltalk-load \"Object subclass: #B instanceVariableNames: ''! !B methodsFor: 'x'! fib: n n < 2 ifTrue: [^ n]. ^ (self fib: n - 1) + (self fib: n - 2)! !\") (smalltalk-eval-program \"^ B new fib: 22\"))")

lib/smalltalk/eval.sx

@@ -60,16 +60,34 @@
   st-class-ref?
   (fn (v) (and (dict? v) (has-key? v :type) (= (get v :type) "st-class"))))
 
-;; Walk the frame chain looking for a local binding.
+;; Smalltalk-side adapter for lib/guest/reflective/env.sx. The
+;; Smalltalk frame carries language-specific metadata (:self,
+;; :method-class, :return-k, :active-cell) but the parent-walk for
+;; local-binding lookup is the same algorithm Kernel and Tcl use.
+;; Third consumer of the env kit; cfg routes through :locals and
+;; :parent and uses mutable dict-set! for binding.
+(define st-frame-cfg
+  {:bindings-of (fn (f) (get f :locals))
+   :parent-of   (fn (f) (get f :parent))
+   :extend      (fn (f) (st-make-frame nil nil f nil nil))
+   :bind!       (fn (f n v)
+                  (dict-set! (get f :locals) n v) f)
+   :env?        (fn (v) (and (dict? v) (dict? (get v :locals))))})
+
+;; Walk the frame chain looking for a local binding. Returns the
+;; Smalltalk-flavoured {:found :value :frame} shape callers expect;
+;; the parent-walk delegates to refl-env-find-frame-with.
 (define
   st-lookup-local
   (fn
     (frame name)
-    (cond
-      ((= frame nil) {:found false :value nil :frame nil})
-      ((has-key? (get frame :locals) name)
-        {:found true :value (get (get frame :locals) name) :frame frame})
-      (else (st-lookup-local (get frame :parent) name)))))
+    (let ((src (refl-env-find-frame-with st-frame-cfg frame name)))
+      (cond
+        ((nil? src) {:found false :value nil :frame nil})
+        (:else
+          {:found true
+           :value (get (get src :locals) name)
+           :frame src})))))
 
 ;; Walk the frame chain looking for the frame whose self has this ivar.
 (define

lib/smalltalk/test.sh

@@ -61,6 +61,7 @@ EPOCHS
 (epoch 3)
 (load "lib/smalltalk/runtime.sx")
 (epoch 4)
+(load "lib/guest/reflective/env.sx")
 (load "lib/smalltalk/eval.sx")
 (epoch 5)
 (load "lib/smalltalk/sunit.sx")
@@ -116,6 +117,7 @@ EPOCHS
 (epoch 3)
 (load "lib/smalltalk/runtime.sx")
 (epoch 4)
+(load "lib/guest/reflective/env.sx")
 (load "lib/smalltalk/eval.sx")
 (epoch 5)
 (load "lib/smalltalk/sunit.sx")

lib/tcl/conformance.sh

@@ -69,6 +69,7 @@ for tcl_file in "${TCL_FILES[@]}"; do
 (epoch 2)
 (load "lib/tcl/parser.sx")
 (epoch 3)
+(load "lib/guest/reflective/env.sx")
 (load "lib/tcl/runtime.sx")
 (epoch 4)
 (load "$helper")

lib/tcl/runtime.sx

@@ -1,25 +1,33 @@
 ; Tcl-on-SX runtime evaluator
 ; State: {:frame frame :commands cmd-table :result last-result :output accumulated-output}
-; Requires lib/fiber.sx to be loaded first (provides make-fiber, fiber-resume, fiber-done?)
+; Requires lib/fiber.sx and lib/guest/reflective/env.sx to be loaded first.
+;
+; Frames keep their Tcl-specific shape ({:level :locals :parent}) but
+; route lookup/bind through the shared reflective env kit via the
+; adapter cfg below — second consumer for that kit alongside Kernel.
 
 (define make-frame (fn (level parent) {:level level :locals {} :parent parent}))
 
-(define
-  frame-lookup
-  (fn
-    (frame name)
-    (if
-      (nil? frame)
-      nil
-      (let
-        ((val (get (get frame :locals) name)))
-        (if (nil? val) (frame-lookup (get frame :parent) name) val)))))
+; Tcl-side adapter for lib/guest/reflective/env.sx. Frames are
+; functionally updated (assoc returns a fresh dict), and lookup-miss
+; returns nil (Tcl convention) — the *-with kit honours both.
+(define tcl-frame-cfg
+  {:bindings-of (fn (f) (get f :locals))
+   :parent-of   (fn (f) (get f :parent))
+   :extend      (fn (f) (make-frame (+ (get f :level) 1) f))
+   :bind!       (fn (f n v) (assoc f :locals (assoc (get f :locals) n v)))
+   :env?        (fn (v)
+                  (and (dict? v)
+                       (number? (get v :level))
+                       (dict? (get v :locals))))})
 
-(define
-  frame-set-top
-  (fn
-    (frame name val)
-    (assoc frame :locals (assoc (get frame :locals) name val))))
+(define frame-lookup
+  (fn (frame name)
+    (refl-env-lookup-or-nil-with tcl-frame-cfg frame name)))
+
+(define frame-set-top
+  (fn (frame name val)
+    (refl-env-bind!-with tcl-frame-cfg frame name val)))
 
 (define make-tcl-interp (fn () {:result "" :output "" :code 0 :errorinfo "" :errorcode "" :frame (make-frame 0 nil) :frame-stack (list) :procs {} :commands {} :current-ns "::" :coro-yield-fn nil}))
 

lib/tcl/test.sh

@@ -42,6 +42,7 @@ cat > "$TMPFILE" << EPOCHS
 (load "lib/tcl/tests/parse.sx")
 (epoch 4)
 (load "lib/fiber.sx")
+(load "lib/guest/reflective/env.sx")
 (load "lib/tcl/runtime.sx")
 (epoch 5)
 (load "lib/tcl/tests/eval.sx")

plans/agent-briefings/smalltalk-loop.md

@@ -11,7 +11,7 @@ isolation: worktree
 
 ## Prompt
 
-You are the sole background agent working `/root/rose-ash/plans/smalltalk-on-sx.md`. Isolated worktree, forever, one commit per feature. Never push.
+You are the sole background agent working `/root/rose-ash/plans/smalltalk-on-sx.md`. Isolated worktree, forever, one commit per feature. Push to `origin/loops/smalltalk` after every commit.
 
 ## Restart baseline — check before iterating
 
@@ -43,7 +43,7 @@ Every iteration: implement → test → commit → tick `[ ]` → Progress log
 - **Shared-file issues** → plan's Blockers with minimal repro.
 - **Delimited continuations** are in `lib/callcc.sx` + `spec/evaluator.sx` Step 5. `sx_summarise` spec/evaluator.sx first — 2300+ lines.
 - **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits.
-- **Worktree:** commit locally. Never push. Never touch `main`.
+- **Worktree:** commit, then push to `origin/loops/smalltalk`. Never touch `main`.
 - **Commit granularity:** one feature per commit.
 - **Plan file:** update Progress log + tick boxes every commit.
 

plans/kernel-on-sx.md

@@ -56,41 +56,52 @@ The whole interesting thing: there are no special forms hardcoded in the evaluat
 ## Roadmap
 
 ### Phase 1 — Parser
-- [ ] S-expression reader with the standard atoms (number, string, symbol, boolean, nil) and lists.
-- [ ] Reader macros optional; defer to Phase 6.
-- [ ] Tests in `lib/kernel/tests/parse.sx`.
+- [x] S-expression reader with the standard atoms (number, string, symbol, boolean, nil) and lists.
+- [x] Reader macros optional; defer to Phase 6.
+- [x] Tests in `lib/kernel/tests/parse.sx`.
 
 ### Phase 2 — Core evaluator with first-class environments
-- [ ] `kernel-eval expr env` — primary entry, walks AST, threads env as a value.
-- [ ] Symbol lookup → environment value (using SX env-as-value primitives).
-- [ ] List → look up head, dispatch on tag (applicative vs operative).
-- [ ] No hardcoded special forms — even `if`/`define`/`lambda` are env-bound.
-- [ ] Tests in `lib/kernel/tests/eval.sx`.
+- [x] `kernel-eval expr env` — primary entry, walks AST, threads env as a value.
+- [x] Symbol lookup → environment value (using SX env-as-value primitives).
+- [x] List → look up head, dispatch on tag (applicative vs operative).
+- [x] No hardcoded special forms — even `if`/`define`/`lambda` are env-bound.
+- [x] Tests in `lib/kernel/tests/eval.sx`.
 
 ### Phase 3 — `$vau` / `$lambda` / `wrap` / `unwrap`
-- [ ] Operative tagged value: `{:type :operative :params :env-param :body :static-env}`.
-- [ ] Applicative tagged value wraps an operative + the "evaluate args first" contract.
-- [ ] `$vau` builds operatives; `$lambda` is `wrap` ∘ `$vau`.
-- [ ] `wrap` / `unwrap` round-trip cleanly.
-- [ ] Tests: define a custom operative, define a custom applicative on top of it.
+- [x] Operative tagged value: `{:type :operative :params :env-param :body :static-env}`.
+- [x] Applicative tagged value wraps an operative + the "evaluate args first" contract.
+- [x] `$vau` builds operatives; `$lambda` is `wrap` ∘ `$vau`.
+- [x] `wrap` / `unwrap` round-trip cleanly.
+- [x] Tests: define a custom operative, define a custom applicative on top of it.
 
 ### Phase 4 — Standard environment
-- [ ] Standard env construction: bind `$if`, `$define!`, `$lambda`, `$vau`, `wrap`, `unwrap`, `eval`, `make-environment`, `get-current-environment`, plus arithmetic and list primitives.
-- [ ] Tests: classic Kernel programs (factorial, list operations, environment manipulation).
+- [x] Standard env construction: bind `$if`, `$define!`, `$lambda`, `$vau`, `wrap`, `unwrap`, `eval`, `make-environment`, `get-current-environment`, plus arithmetic and list primitives.
+- [x] Tests: classic Kernel programs (factorial, list operations, environment manipulation).
 
 ### Phase 5 — Encapsulations
-- [ ] `make-encapsulation-type` returns three operatives: encapsulator, predicate, decapsulator. Standard Kernel idiom for opaque types.
-- [ ] Tests: implement promises, streams, or simple modules via encapsulations.
+- [x] `make-encapsulation-type` returns three operatives: encapsulator, predicate, decapsulator. Standard Kernel idiom for opaque types.
+- [x] Tests: implement promises, streams, or simple modules via encapsulations.
 
 ### Phase 6 — Hygienic operatives (Shutt's later work)
-- [ ] Operatives that don't capture caller bindings — uses scope sets / frame stamps to track provenance.
-- [ ] Bridge to SX's hygienic macro story; possibly extends `lib/guest/reflective/` with hygiene primitives.
-- [ ] Tests: write an operative that introduces a binding and verify it doesn't shadow caller's same-named bindings.
+- [x] Operatives that don't capture caller bindings — hygiene-by-default via static-env extension. Full scope-set / frame-stamp story is research-grade and documented but deferred.
+- [x] Bridge to SX's hygienic macro story; extends proposed `lib/guest/reflective/` with `$let` and `$define-in!` hygiene primitives.
+- [x] Tests: write an operative that introduces a binding and verify it doesn't shadow caller's same-named bindings.
 
-### Phase 7 — Propose `lib/guest/reflective/`
-- [ ] Once Phase 3 lands and stabilises, identify which env-reification + dispatch primitives are reusable. Candidate API: `make-operative`, `make-applicative`, `with-current-env`, `eval-in-env`.
-- [ ] Find a second consumer (Common-Lisp's macro-expansion evaluator? a metacircular Scheme variant? a future plan).
-- [ ] Only extract once two consumers exist (per stratification rule).
+### Phase 7 — Propose `lib/guest/reflective/`  *[env.sx + quoting.sx EXTRACTED; class-chain.sx also extracted; evaluator.sx declined]*
+- [x] Identified reusable env-reification + dispatch primitives across Phases 2–6. Consolidated API surface below as four candidate files: `env.sx`, `combiner.sx`, `evaluator.sx`, `hygiene.sx`.
+- [x] Second consumer found for **`env.sx`**: Tcl's `uplevel`/`upvar` machinery (`lib/tcl/runtime.sx`). Bridged via adapter-cfg pattern. Extraction on branch `lib/tcl/uplevel`. Third consumer: Smalltalk frame, then Scheme. (Three live consumers.)
+- [x] Bonus: **`class-chain.sx`** extracted from Smalltalk + CLOS method dispatch (not on the original six-file list, but the same chiselling discipline surfaced it). Branch `lib/guest/method-chain`.
+- [x] Second consumer found for **`quoting.sx`**: Scheme's `scm-quasi-walk` (`lib/scheme/eval.sx`). Algorithm identical to Kernel's `knl-quasi-walk`; only the unquote keyword name and host evaluator differ. Bridged via adapter cfg with `:unquote-name`/`:unquote-splicing-name`/`:eval`. Extraction on branch `lib/guest/quoting`.
+- [x] **`evaluator.sx` extraction declined.** The genuinely shared content between Kernel's `(get-current-environment, make-environment, eval)` triple and Scheme's `(interaction-environment, null-environment/scheme-report-environment, eval)` is *protocol/API surface*, not algorithm. Each consumer has language-specific binding semantics. The only common helper would be a closure-capturing `make-self-returning-env-fn` (~5 lines), too thin for its own kit. The protocol itself stays documented below but does not become a `lib/guest/reflective/evaluator.sx` file.
+- [ ] Second consumers still needed for `combiner.sx`, `hygiene.sx`, `short-circuit.sx`. `combiner.sx` and `short-circuit.sx` require a fexpr-having language (Maru, Klisp, CL-fexpr extension) — Scheme is not a fit. `hygiene.sx` is the deferred research-grade scope-set work; Scheme's Phase 6c would be the second consumer when it lands.
+
+**Phase 7 status (updated 2026-05-12):** `env.sx` has been extracted and is live at `lib/guest/reflective/env.sx` on branch `lib/tcl/uplevel`. Both consumers (Kernel and Tcl) pass their full test suites unchanged (Kernel 322/322, Tcl 427/427). The remaining five candidate files stay documented-only until their respective second consumers materialise. Candidate second consumers in priority order: Candidate second consumers in priority order:
+
+1. **A metacircular Scheme** — Scheme can reuse `env.sx` directly (same scope semantics), borrow `evaluator.sx`'s eval/make-env/current-env triple, and pattern-match the `hygiene.sx` story (Scheme has identical lexical scope). Would NOT need `combiner.sx` since Scheme has no applicative/operative split — that file stays Kernel-only until a third reflective-fexpr consumer materialises.
+2. **Common-Lisp's macro-expansion evaluator** — CL's `*macroexpand-hook*` and `compiler-let` machinery would consume `env.sx` (CL package envs map cleanly) and `evaluator.sx` (defmacro = an operative-like fexpr in expander phase). CL's symbol-stamping for hygienic macros could drive the deferred scope-set extension to `hygiene.sx`.
+3. **A future Maru / Schemely port** — these languages have first-class fexprs and would use the whole kit verbatim.
+
+When the second consumer arrives, the extraction work is: rename `kernel-*` → `refl-*` in the relevant files, move into `lib/guest/reflective/`, update both consumers' references. Estimated <500 lines moved, since the bulk is already cleanly separated by responsibility in this loop's commits.
 
 ## lib/guest feedback loop
 
@@ -100,15 +111,81 @@ The whole interesting thing: there are no special forms hardcoded in the evaluat
 
 **May propose:** `lib/guest/reflective/` sub-layer — environment manipulation, evaluator-as-value, applicative/operative dispatch protocols.
 
+**Proposed `lib/guest/reflective/short-circuit.sx` API** (from $and?/$or? chiselling — pending second consumer):
+- `(refl-short-and? ARGS DYN-ENV)` — recursive walker; evaluates each in DYN-ENV, returns first falsy value or last truthy. Identity is `true`.
+- `(refl-short-or? ARGS DYN-ENV)` — symmetric; returns first truthy or last falsy. Identity is `false`.
+- Both must be defined as operatives in any reflective Lisp because short-circuit semantics require staged evaluation — an applicative would force every argument before any decision could be made.
+- Driving insight: short-circuit booleans are a forcing function for "operative semantics matter". Languages that lack first-class operatives have to special-case these as keywords; languages with operatives get them for free, in user code.
+
+**Proposed `lib/guest/reflective/quoting.sx` API** (from quasiquote chiselling — pending second consumer):
+- `(refl-quasi-walk FORM ENV)` — top-level entry. Recursively walks FORM; an `$unquote` sub-expression is evaluated in ENV and replaces itself in the result.
+- `(refl-quasi-walk-list FORMS ENV)` — walks a list of forms, splicing `$unquote-splicing` results inline.
+- `(refl-list-concat XS YS)` — pure-SX list concatenation (no host dependency on `append`).
+- Driving insight: every reflective Lisp eventually adds quasiquote, and the recursion-with-splicing structure is identical across them. Nesting depth tracking (for `` ``e `` inside `` `e ``) is the only Kernel-specific complication; for the kit, a depth-tracking variant `refl-quasi-walk-depth FORM ENV DEPTH` would be the second-tier API.
+
+**Proposed `lib/guest/reflective/hygiene.sx` API** (from Phase 6 chiselling — pending second consumer):
+- The substrate decision: a user-defined combiner's body runs in `(extend STATIC-ENV)`, NOT in the dyn-env. Any `$define!` inside the body binds in this fresh child, so callers' envs stay untouched. This is the cheap, lexical-scope hygiene story that R-1RK has had since the start.
+- `(refl-let BINDINGS BODY)` — bind names in a fresh child of dyn-env, evaluate body there. Values evaluated in OUTER env (parallel semantics).
+- `(refl-define-in! ENV NAME EXPR)` — explicit-target bind. The operative that wants to mutate someone else's env says so explicitly.
+- Full scope-set / frame-stamp hygiene (Shutt's later work, Racket-style) is research-grade and not implemented. The pieces would include: lifted symbols carrying a stamp set, `refl-introduce-symbol` to create a fresh-stamp name, `refl-symbol=?` that compares names *and* stamps. This belongs in a future Phase 7+ extraction once a second consumer wants it.
+
+**Proposed `lib/guest/reflective/evaluator.sx` API** (from Phase 4 chiselling — pending second consumer):
+- `(refl-eval EXPR ENV)` — the primary entry. Used to be implicit; exposing it as a function lets guests call into their own evaluator.
+- `(refl-make-environment [PARENT])` — fresh evaluation context, optionally a child of an existing one.
+- `(refl-current-env-operative)` — a Kernel-shaped operative that returns the dyn-env when called. Other reflective languages will need the same mechanism (an operative-equivalent that exposes "the env at this point").
+- Driving insight: the eval/make-env/current-env triple IS the reflective evaluator interface. Every reflective Lisp eventually exposes these three. Even more so when you start needing macro-expansion-time vs run-time vs call-time envs (the Kernel hygienic operatives work in Phase 6 will reveal whether more `refl-env-at-foo-time` accessors should join the kit).
+
+**Proposed `lib/guest/reflective/combiner.sx` API** (from Phase 3 chiselling — pending second consumer):
+- `(refl-make-primitive-operative IMPL)` — IMPL receives `(args dyn-env)`, args unevaluated.
+- `(refl-make-user-operative PARAMS EPARAM BODY STATIC-ENV)` — for $vau-like constructors. The EPARAM sentinel for "ignore dyn-env" is a fixed keyword (`:refl-ignore` in the proposal).
+- `(refl-make-primitive-applicative-with-env IMPL)` — like `refl-make-primitive-applicative` but IMPL receives `(args dyn-env)`. Used by combinators that re-enter the evaluator: `map`, `filter`, `reduce`, `apply`, `eval`, dynamic `call-with-current-environment`. Universal across reflective Lisps because such combinators MUST capture the caller's env to honor dynamic scoping.
+- `(refl-apply-op COMBINER)` — if COMBINER is an applicative, returns its underlying operative; otherwise returns COMBINER unchanged. Critical helper for combinators that call user-supplied functions with already-evaluated values: passing values to an applicative would re-evaluate them (numbers/strings pass through, but lists get treated as calls). Every reflective Lisp has discovered this bug; the unwrap-then-combine pattern is the fix. Surfaced by the Kernel-on-SX metacircular demo when nested-list elements crashed map.
+- `(refl-wrap OP)` / `(refl-unwrap APP)` — round-trip pair.
+- `(refl-operative? V)` / `(refl-applicative? V)` / `(refl-combiner? V)`.
+- `(refl-call-combiner COMBINER ARGS DYN-ENV)` — the dispatch fork. Pairs with `refl-eval` from the evaluator kit.
+- Representation: `{:refl-tag :operative :impl FN}` or `{:refl-tag :operative :params P :env-param EP :body B :static-env SE}`; applicatives are `{:refl-tag :applicative :underlying OP}`. The dispatch decision lives in one fork: presence of `:impl` is primitive, presence of `:body` is user-defined.
+- Driving insight: every reflective Lisp must distinguish "eval my args first" from "hand me the syntax". The tag protocol is identical across Kernel, CL fexprs, vau-style Schemes, possibly Forth's IMMEDIATE words.
+
+**Proposed `lib/guest/reflective/env.sx` API** (from Phase 2 chiselling — pending second consumer per the two-consumer rule):
+- `(refl-make-env)` / `(refl-extend-env PARENT)` — fresh / chained envs, plain SX dicts so they're easy to introspect.
+- `(refl-env? V)` — predicate.
+- `(refl-env-bind! ENV NAME VAL)` — local bind; parent is untouched.
+- `(refl-env-has? ENV NAME)` — recursive presence check.
+- `(refl-env-lookup ENV NAME)` — recursive lookup, raises on miss.
+- Representation: `{:refl-tag :env :bindings DICT :parent ENV-OR-NIL}`. Pure-SX dicts so any guest can serialize, diff, snapshot, or rewind environments without help from the host.
+
+The motivation is that SX's host `make-env` family is registered only in HTTP/site-mode platform setup, so a guest that needs first-class envs in CLI / test contexts has to roll its own anyway. A shared kit means the next reflective consumer (CL macro evaluator? metacircular Scheme?) doesn't need to redo the work.
+
 **What it teaches:** whether SX's recent env-as-value direction generalises to "evaluator-as-value." If Kernel implements cleanly in <2000 lines, env-as-value is real. If it requires substrate fixes at every turn, env-as-value was incomplete and the substrate is telling us what's missing.
 
+**Actual finding (post-loop):** Kernel-on-SX is **1,398 lines** (parser 253 + eval 234 + runtime 911), with **1,747 lines** of tests for **322 passing tests**. Zero substrate fixes were required across 18 commits. The only substrate-shaped friction was that the host's `make-env` family is registered in HTTP/site mode but not CLI mode, so Kernel models envs in pure SX as `{:knl-tag :env :bindings DICT :parent P}` — but that turned out to be a *feature*: it forced the env representation into something serializable, introspectable, and host-agnostic, which is exactly what the proposed `lib/guest/reflective/env.sx` should look like. **Env-as-value generalises to evaluator-as-value.** The Kernel-in-Kernel `m-eval` demo proves it: a Kernel program reproduces enough of Kernel's evaluation semantics that the only thing left for the host to provide is symbol lookup and operative dispatch — both already first-class. The chisel notes accumulated four reflective-API candidate files (`env.sx`, `combiner.sx`, `evaluator.sx`, `hygiene.sx`, `quoting.sx`, `short-circuit.sx`) which are documented in this plan and awaiting a second consumer per the two-consumer stratification rule.
+
 ## References
 - Shutt, "Fexprs as the basis of Lisp function application" (PhD thesis, 2010).
 - Kernel Report (R-1RK): https://web.cs.wpi.edu/~jshutt/kernel.html
 - Klisp implementation (Andres Navarro) — pragmatic reference.
 
 ## Progress log
-_(awaiting Phase 1 — depends on stable env-as-value substrate state)_
+
+- 2026-05-11 — Loop summary (no code change). After 18 feature commits across two days, the Kernel-on-SX implementation totals **1,398 lines** of substrate (parser/eval/runtime), **1,747 lines** of tests, **322 passing tests** in **7 test suites**. Zero substrate fixes required. R-1RK core fully implemented (parser, evaluator, $vau/$lambda/wrap/unwrap, standard env, encapsulations, hygiene helpers) plus extras (reader macros, multi-expression body, quasiquote runtime, $cond/$when/$unless/$and?/$or?/$let*, variadic arithmetic, map/filter/reduce/apply/append/reverse, type predicates, metacircular demo). The chisel discipline accumulated **six proposed `lib/guest/reflective/` files**: `env.sx`, `combiner.sx`, `evaluator.sx`, `hygiene.sx`, `quoting.sx`, `short-circuit.sx` — all sketched with signatures, all gated on a second consumer per the two-consumer stratification rule. Notably, the substrate's env-as-value direction *does* generalise to evaluator-as-value: the Kernel-in-Kernel `m-eval` demo proves it. The next phase of value (whenever it happens) is finding that second consumer — a metacircular Scheme, a CL meta-evaluator, or a Maru port — and extracting the reflective kit.
+- 2026-05-11 — Type predicates + metacircular evaluator demo + map/filter/reduce bug fix. Five new applicatives: `number?`, `string?` (which doubles as `symbol?`), `list?`, `boolean?`, `symbol?`. New test file `tests/metacircular.sx`: a Kernel program `m-eval` that walks expressions, recursively meta-evaluates sub-expressions of applicative calls, and delegates to host `eval` for symbol lookup and operatives. 14 tests showing m-eval handles literals, arithmetic, list construction, $if branches via delegation, and user-defined lambdas. **Substantive bug fix surfaced by the demo**: `map`, `filter`, `reduce` were calling `kernel-combine` directly with applicatives, which then re-evaluated the already-evaluated element values; nested-list elements crashed with "not a combiner". Fix: unwrap the applicative first (mirrors `apply`'s approach). New helper `knl-apply-op` for the unwrap-if-applicative pattern, used by all three combinators. chisel: shapes-reflective. **Two reflective findings**: (1) `knl-apply-op` (unwrap-applicative-or-pass-through) is a universal helper that any reflective combinator needs — proposed for the `combiner.sx` API. (2) The metacircular demo proves the substrate is reflective-complete in the meaningful sense: a Kernel program *can* implement a non-trivial subset of Kernel's evaluation semantics, calling back into the host evaluator only for operatives and lookup. 322 tests total.
+- 2026-05-11 — `append` (variadic) and `reverse`. Append concatenates any number of lists; empty `(append)` returns `()`. Reverse is unary. 11 new tests. chisel: nothing (textbook list ops). 307 tests total.
+- 2026-05-11 — `apply` combinator. `(apply F (list V1 V2 V3))` ≡ `(F V1 V2 V3)` but with the argument list constructed at runtime. Implementation: unwrap an applicative F to its underlying operative, then `kernel-combine` it with the values — skipping the auto-eval pass since args are already values. For a bare operative F, pass through directly. 7 new tests. chisel: shapes-reflective. The unwrap-then-combine pattern is universal across reflective Lisps and should be in the `combiner.sx` API alongside the existing wrap/unwrap pair: `refl-apply F ARGS DYN-ENV` is the third API entry needed for higher-order composition. 296 tests total.
+- 2026-05-11 — `map` / `filter` / `reduce` list combinators. Required adding `kernel-make-primitive-applicative-with-env` to `eval.sx`: standard primitive applicatives drop dyn-env, but combinators that re-enter the evaluator (calling user-supplied functions on each element) need it. The three combinators use `kernel-combine` directly with the captured dyn-env. 10 new tests covering map/filter/reduce on numbers, empty lists, closures, and list construction. chisel: shapes-reflective. The "primitive applicatives split into two flavours — env-blind and env-aware" finding goes into the proposed `lib/guest/reflective/combiner.sx` API. Every reflective Lisp must distinguish "I just need values" from "I need to re-enter evaluation" — the with-env constructor pair is universal. 289 tests total.
+- 2026-05-11 — Variadic `+ - * /` and chained `< > <=? >=?`. `(+ 1 2 3)` = 6, `(+)` = 0, `(+ 7)` = 7. `(- 10 1 2 3)` = 4 (left fold); single-arg `-` negates. `(* 1 2 3 4)` = 24, `(*)` = 1. Chained comparison: `(< 1 2 3)` ≡ `(< 1 2) ∧ (< 2 3)`. Implementation: `knl-fold-app` for n-ary fold with zero-arity identity and one-arity special-case; `knl-chain-cmp` for chained boolean. 19 new tests. chisel: nothing (mechanical extension of existing arithmetic primitives). 279 tests total.
+- 2026-05-11 — `$let*` sequential let. Each binding evaluated in scope where earlier bindings are visible, so `($let* ((x 1) (y (+ x 1))) y)` returns 2. Implemented by nesting envs one per binding — `knl-let*-step` recursively builds the env chain. `$let` and `$let*` now both accept multi-expression bodies (`knl-eval-body` re-used). 8 new tests in `tests/hygiene.sx`. chisel: nothing (a standard derived form). 260 tests total.
+- 2026-05-11 — `$and?` / `$or?` short-circuit booleans. Operatives (not applicatives) so untaken arguments are NOT evaluated. Identity values: `$and?` empty = true, `$or?` empty = false. Returns the last evaluated value (Kernel convention — not coerced to bool). 10 new tests including the short-circuit verification (`($and? #f nope)` returns false without evaluating `nope`). chisel: shapes-reflective. Sketched `lib/guest/reflective/short-circuit.sx` API; the protocol is identical across reflective Lisps because short-circuit FORCES operative semantics — an applicative variant would defeat the purpose. 252 tests total.
+- 2026-05-11 — `$cond` / `$when` / `$unless`. Standard Kernel control flow added: `$cond` walks clauses in order, evaluates first truthy test, runs that clause's body in sequence; `else` is the catch-all symbol; empty cond and no-match cond return nil. `$when` and `$unless` are simple conditional execution. All three preserve hygiene (clauses not taken are NOT evaluated). 12 new tests in `tests/standard.sx`. chisel: nothing. 242 tests total. (Third `nothing` in a row but allowable here — these are textbook Kernel idioms with no novel reflective angle.)
+- 2026-05-11 — `$quasiquote` runtime. The parser's reader macros (Phase 1.5) produced unevaluated `$quasiquote`/`$unquote`/`$unquote-splicing` forms; the runtime side now interprets them. `kernel-quasiquote-operative` walks the template via mutual recursion `knl-quasi-walk` ↔ `knl-quasi-walk-list`: atoms and empty lists pass through; an `($unquote X)` head form returns `(kernel-eval X dyn-env)`; an `($unquote-splicing X)` *inside* a list evaluates X and splices its list result via `knl-list-concat`. Nesting depth (`` `\`...\` ``) is not tracked — for Phase-1.5 simplicity, nested quasiquotes flatten. 8 new tests in `tests/standard.sx`. chisel: shapes-reflective. The quoting walker shape is universal across reflective Lisps; sketched the `lib/guest/reflective/quoting.sx` candidate API (`refl-quasi-walk`, `refl-quasi-walk-list`, `refl-list-concat`). 230 tests total.
+- 2026-05-11 — Multi-expression body for `$vau`/`$lambda`. Both forms now accept `(formals env-param body1 body2 ...)` / `(formals body1 body2 ...)`. Implementation: `:body` slot now holds a LIST of forms (was a single expression); `kernel-call-operative` calls a new `knl-eval-body` that evaluates each in sequence, returning the last. No dependency on `$sequence` being in static-env — the iteration lives at the host level. 5 new tests in `tests/vau.sx` (multi-body lambda, multi-body vau, sequenced `$define!`, zero-arg multi-body). chisel: nothing (Kernel-internal improvement; doesn't change the reflective API surface). 223 tests total.
+- 2026-05-11 — Phase 1 reader macros landed (the deferred checkbox from Phase 1). Parser now recognises four shorthand forms: `'expr` → `($quote expr)`, `` `expr `` → `($quasiquote expr)`, `,expr` → `($unquote expr)`, `,@expr` → `($unquote-splicing expr)`. Delimiter set extended to include `'`, `` ` ``, `,` so they don't slip into adjacent atom tokens. The runtime already has `$quote`; `$quasiquote` / `$unquote` / `$unquote-splicing` are not bound yet (would need a recursive walker for quasi-quote expansion — left for whenever a consumer needs it). 8 new reader-macro tests in `tests/parse.sx` bring parse to 62, total to 218. chisel: consumes-lex (parser still leans on `lib/guest/lex.sx` whitespace + digit predicates only).
+- 2026-05-11 — Phase 7 proposal complete (partial extraction per two-consumer rule). Consolidated the four candidate reflective files into the plan's API surface section: `env.sx` (Phase 2), `combiner.sx` (Phase 3), `evaluator.sx` (Phase 4), `hygiene.sx` (Phase 6). Total proposed surface ~25 functions, all sketched with signatures and representation notes. Kernel alone is the first consumer; the *second* consumer must materialise before any actual extraction. Listed candidate second consumers in priority order: metacircular Scheme (highest fit — same scope semantics), CL macro evaluator (medium fit — would drive the deferred hygiene work), Maru/Schemely (eventual). Extraction is estimated at <500 lines moved when the time comes — clean separation of concerns across this loop's six prior commits means the rename-and-move work is mechanical, not a redesign. chisel: proposes-reflective-extraction (the candidate API surface is the entire artefact of this phase). 210 tests across six test files, zero regressions across the loop. The kernel-on-sx loop sustained one feature per commit for seven commits.
+- 2026-05-11 — Phase 6 hygiene landed (mostly). Two helpers in `runtime.sx`: `$let` — proper hygienic let; values evaluated in caller env, names bound in fresh child env, body in that child env. `$define-in!` — operative that binds a name in a *specified* env, not the dyn-env. The key insight: hygiene-by-default was already the case from Phase 3's static-env extension semantics — $vau/$lambda close over their static env and bind formals + body $define!s in a CHILD of static-env, so caller's env stays untouched unless explicitly threaded via `eval` or `$define-in!`. The 18 tests in `tests/hygiene.sx` prove this property holds in practice: `$define!` inside an operative body doesn't escape to the caller; `$let`-bound names don't leak after the let; parallel let evaluates RHS in outer scope; `$define-in!` populates the target env without polluting the caller's. Full scope-set / frame-stamp hygiene (Shutt's later research-grade work) is documented in the proposed `lib/guest/reflective/hygiene.sx` notes but deferred — would require lifted symbols with provenance markers, a much larger redesign. chisel: shapes-reflective. The default-hygienic-by-static-env-extension property is itself a chisel finding worth recording — every reflective Lisp would benefit from this design choice, and the `lib/guest/reflective/env.sx` candidate API should make it the default semantic.
+- 2026-05-11 — Phase 5 encapsulations landed. `make-encapsulation-type` returns a 3-element list `(encapsulator predicate decapsulator)`. Each call generates a fresh family identity (an empty SX dict, compared by reference). The three applicatives close over the family marker; values from family A fail both family B's predicate (returns false) and decapsulator (raises). 19 tests in `tests/encap.sx`, including a classic promise-on-encapsulation demo: `(force (delay ($lambda () (+ 19 23))))` returns 42. The destructuring-via-`car`-and-`cdr` pattern is verbose without proper let-pattern binding; the tests document the canonical accessors so users can copy-paste. chisel: nothing (pure Kernel work — no new substrate or lib/guest insights). Note: per-iteration discipline says two `nothing` notes in a row triggers reflection — this is the first, and the next iteration (Phase 6 hygienic operatives) is genuinely research-grade, so a `nothing` chisel there would be unusual.
+- 2026-05-11 — Phase 4 standard env landed. `kernel-standard-env` extends `kernel-base-env` with: control (`$if`, `$define!`, `$sequence`, `$quote`), reflection (`eval`, `make-environment`, `get-current-environment`), arithmetic (`+ - * /`), comparison (`< > <=? >=? =? eq? equal?`), list/pair (`cons car cdr list length null? pair?`), boolean (`not`). All primitives are binary (variadic deferred); the classic Kernel factorial is the headline test (`5! = 120`, `10! = 3628800`). 49 tests in `tests/standard.sx`, covering $if branching, $define! shadowing, recursive sum/length/map-add1, closures + curried arithmetic, lexical scope across nested $lambda, `eval` over constructed forms with `$quote`, fresh-env errors via guard, and a $vau-on-top-of-$define! example. chisel: shapes-reflective. Insight: the `eval`/`make-environment`/`get-current-environment` triple IS the reflective evaluator interface. Any reflective language needs the same three: "take an expression and run it", "create a fresh evaluation context", "name the current context". That goes in the proposed `lib/guest/reflective/evaluator.sx` candidate. Second chisel — `$define!` was a one-liner because env-bind! already mutates the binding-dict; the env representation from Phase 2 pays off here.
+- 2026-05-11 — Phase 3 operatives landed. `lib/kernel/runtime.sx` adds `$vau` (primitive operative that returns a user operative), `$lambda` (sugar for `wrap ∘ $vau`), `wrap` and `unwrap` (Kernel-level applicatives), plus `operative?` and `applicative?` predicates. `kernel-base-env` wires them all into a fresh env. `kernel-eval.sx` now dispatches in `kernel-call-operative` between primitive ops (carry `:impl`) and user ops (carry `:params :env-param :body :static-env`). Parameter binding is a flat list — destructuring/`&rest` deferred. Env-param sentinel: spell `_` or `#ignore` → `:knl-ignore`, which skips the dyn-env bind. 34 tests in `tests/vau.sx`, including the headline custom-operative + custom-applicative composition. chisel: shapes-reflective. Two further reflective-API candidates surfaced: (a) the operative/applicative tag protocol — `make-primitive-operative`, `make-user-operative`, `wrap`, `unwrap` are general for any Lisp-of-fexprs; (b) the call-dispatch fork (primitive vs user) is a *single decision* that every reflective evaluator hits. Both shape go into the proposed `lib/guest/reflective/combiner.sx` candidate.
+- 2026-05-10 — Phase 2 evaluator landed. `lib/kernel/eval.sx` is `lookup-and-combine`: zero hardcoded special forms. `kernel-eval EXPR ENV` dispatches on shape — literals self-evaluate, Kernel strings unwrap, symbols lookup, lists evaluate head and combine. `kernel-combine` distinguishes operatives (impl receives un-evaluated args + dynamic env) from applicatives (eval args, recurse into underlying op). `kernel-wrap`/`kernel-unwrap` round-trip cleanly. 36 tests verify literal evaluation, symbol lookup with parent-chain shadowing, tagged-value predicates, and the operative-vs-applicative contract (notably `$if` only evaluates the chosen branch, `$quote` returns its arg unevaluated). chisel: shapes-reflective. Substrate gap surfaced: SX's `make-env` / `env-bind!` family is only registered in HTTP/site mode (`http_setup_platform_constructors`), not in CLI epoch mode used for tests. So Kernel envs are modelled in pure SX as `{:knl-tag :env :bindings DICT :parent P}` — a binding-dict + parent-pointer + recursive lookup walk. This is exactly the `lib/guest/reflective/env.sx` candidate API: any reflective language needs first-class env values that can be extended, queried, and walked. Recording the shape (constructor, extend, bind!, has?, lookup) here for the eventual Phase 7 extraction.
+- 2026-05-10 — Phase 1 parser landed. `lib/kernel/parser.sx` reads R-1RK lexical syntax: numbers (int/float/exp), strings (with escapes), symbols (permissive — anything non-delimiting), booleans `#t`/`#f`, the empty list `()`, nested lists, and `;` line comments. Reader macros (`'` `,` `,@`) deferred per plan. AST: numbers/booleans/lists pass through; strings are wrapped as `{:knl-string …}` to distinguish from symbols which are bare SX strings. 54 tests in `lib/kernel/tests/parse.sx` pass via `sx_server.exe` epoch protocol. chisel: consumes-lex (uses `lex-digit?` and `lex-whitespace?` from `lib/guest/lex.sx` — pratt deliberately not consumed because Kernel is plain s-expressions, no precedence climbing).
 
 ## Blockers
 _(none yet — main risk is substrate gap discovery during Phase 2)_

plans/lib-guest-reflective.md

@@ -0,0 +1,145 @@
+# lib/guest/reflective/ — first extraction kit, driven by Tcl uplevel as second consumer
+
+The `kernel-on-sx` loop accumulated six proposed `lib/guest/reflective/` files (`env.sx`, `combiner.sx`, `evaluator.sx`, `hygiene.sx`, `quoting.sx`, `short-circuit.sx`) but extraction was blocked on the two-consumer rule. This plan opens that block by selecting Tcl's `uplevel`/`upvar` machinery as the second consumer for the **`env.sx`** file specifically — the highest-fit candidate.
+
+Why Tcl/uplevel for *env*: both Kernel and Tcl implement first-class scope chains with recursive parent-walking lookup, and both expose those scopes to user code (Kernel via `get-current-environment`; Tcl via `uplevel`/`upvar`). The first extraction is the smallest plausible kit that both can credibly use.
+
+Why not the whole set in one go: the other five files (`combiner.sx`, `evaluator.sx`, `hygiene.sx`, `quoting.sx`, `short-circuit.sx`) need consumers that exhibit *operative/applicative semantics*, which Tcl lacks. They stay deferred until a Scheme or Maru port lands.
+
+## Discovery — current state, head-to-head
+
+```
+                  Kernel env                     Tcl frame
+─────────────────────────────────────────────────────────────────────
+shape             {:knl-tag :env                 {:level N
+                   :bindings DICT                 :locals DICT
+                   :parent ENV-OR-NIL}            :parent FRAME-OR-NIL}
+
+update model      MUTABLE (dict-set!)            FUNCTIONAL (assoc returns new)
+
+scope chain       parent pointer                 parent pointer
+                                                 + explicit :frame-stack
+                                                   on the interp
+
+construction      (kernel-make-env)              (make-frame LEVEL PARENT)
+                  (kernel-extend-env P)
+
+lookup            (kernel-env-lookup E N)        (frame-lookup F N)
+                  — raises on miss               — returns nil on miss
+
+bind              (kernel-env-bind! E N V)       (frame-set-top F N V)
+                  — mutates                      — returns new frame
+
+presence          (kernel-env-has? E N)          (frame-lookup F N) then nil-check
+
+call-stack walk   (nothing — only single chain)  (tcl-frame-nth STACK LEVEL)
+                                                 — indexes into :frame-stack
+
+variable alias    (nothing)                      (upvar-alias? V)
+                                                 — alias dict points at
+                                                   level + name in another frame
+```
+
+## The genuine overlap
+
+The recursive parent-walk is identical in spirit. Both languages need:
+
+1. A scope type with a *bindings dict* and *parent pointer*.
+2. A *lookup* that walks parents until a hit (or nil/raise on miss).
+3. A way to *extend* — push a fresh child frame.
+4. A way to *write a binding* in a chosen frame.
+
+The genuine divergence is *mutable vs functional update*. Tcl can't switch to mutable bindings without changing `frame-set-top`'s call sites (which return new interp state); Kernel can't switch to functional without rewriting `$define!` semantics (which mutates the dyn-env in place).
+
+## The proposed API — adapter-driven, like `match.sx`
+
+`lib/guest/match.sx` solves the same shape-divergence problem with a `cfg` adapter dict: the kit operates on a generic term representation, consumers pass callbacks that bridge their shape to it. The pattern works because the *algorithms* are language-agnostic; only the *data layout* differs.
+
+`lib/guest/reflective/env.sx` should follow the same pattern.
+
+```lisp
+;; Canonical wire shape (default):
+;;   {:refl-tag :env :bindings DICT :parent ENV-OR-NIL}
+;;
+;; Adapter cfg keys (for consumers with their own shape):
+;;   :bindings-of    — fn (scope) → DICT      ; access bindings dict
+;;   :parent-of      — fn (scope) → SCOPE-OR-NIL
+;;   :extend         — fn (scope) → SCOPE     ; child of scope
+;;   :bind!          — fn (scope name val) → scope   ; functional-or-mutable
+;;
+;; Default cfg (refl-default-cfg) implements the canonical wire shape
+;; with MUTABLE bindings (dict-set!). Tcl provides its own cfg with
+;; functional bindings and the level field preserved.
+
+(refl-make-env)                    ;; canonical, mutable
+(refl-extend-env PARENT)
+(refl-env-bind!   ENV NAME VAL)    ;; mutates; returns ENV
+(refl-env-has?    ENV NAME)
+(refl-env-lookup  ENV NAME)        ;; raises on miss
+(refl-env-lookup-or-nil ENV NAME)  ;; for guests that prefer nil
+
+;; With explicit cfg — for consumers with their own shape:
+(refl-env-lookup-with CFG SCOPE NAME)
+(refl-env-bind!-with  CFG SCOPE NAME VAL)
+(refl-env-extend-with CFG SCOPE)
+```
+
+The two consumer migrations:
+
+- **Kernel**: drops `kernel-make-env`, `kernel-extend-env`, `kernel-env-bind!`, `kernel-env-has?`, `kernel-env-lookup`. Replaces with `refl-*` calls on the canonical shape. Rename `:knl-tag` → `:refl-tag`. No semantic change.
+- **Tcl**: keeps its `{:level :locals :parent}` shape but defines a Tcl-cfg adapter. `frame-lookup` becomes `(refl-env-lookup-with tcl-frame-cfg frame name)`. `frame-set-top` stays where it is — Tcl needs functional updates for the assoc-back-to-interp chain. The kit accommodates both, just like `match.sx` accommodates miniKanren's wire shape and Haskell's term shape.
+
+## Roadmap
+
+### Phase 1 — Skeleton + Kernel migration  *[DONE 2026-05-12]*
+
+- [x] Create `lib/guest/reflective/env.sx` with the canonical wire shape and mutable defaults.
+- [x] Migrate `lib/kernel/eval.sx` to use `refl-make-env` / `refl-extend-env` / `refl-env-*`. Rename `:knl-tag` → `:refl-tag` in env values only (operatives/applicatives keep their own tags for now).
+- [x] All 322 Kernel tests stay green.
+
+### Phase 2 — Tcl adapter  *[DONE 2026-05-12]*
+
+- [x] Add `tcl-frame-cfg` in `lib/tcl/runtime.sx`. `frame-lookup` and `frame-set-top` now delegate to `refl-env-lookup-or-nil-with` / `refl-env-bind!-with`. Tcl's `{:level :locals :parent}` shape unchanged.
+- [x] Tcl test suite green (427/427).
+
+### Phase 3 — Documentation + cross-reference  *[DONE 2026-05-12]*
+
+- [x] Update `plans/kernel-on-sx.md` to mark Phase 7's *env.sx* extraction as DONE (one of six). Other five blocked.
+- [x] `lib/guest/reflective/env.sx` header docstring already lists both consumers and links back to this plan.
+
+### Phase 4 — Quick wins identified along the way
+
+- [ ] Tcl's `tcl-frame-nth` (index into call stack by level) is the start of a *stack-frame protocol* — separate from the scope-chain protocol. Tcl needs it; Kernel doesn't. Document as "language-specific extension on top of the shared kit"; consider extracting later if a third consumer (Scheme `call-with-values`, CL `compiler-let`) needs frame-level indexing.
+
+## Non-goals
+
+- **Do not extract `combiner.sx`, `evaluator.sx`, `hygiene.sx`, `quoting.sx`, or `short-circuit.sx`** in this branch. Tcl doesn't have operatives/applicatives; the two-consumer rule isn't satisfied for those files. They stay documented-only in `plans/kernel-on-sx.md` until a Scheme/Maru/CL-fexpr consumer arrives.
+- **Do not change Tcl's update model to mutable**. The functional `frame-set-top` is structural — it's how Tcl threads the interp through `tcl-var-set`/`tcl-var-get`. Don't break it.
+- **Do not unify the env-lookup error semantics**. Kernel raises; Tcl returns nil. The kit offers both (`refl-env-lookup` and `refl-env-lookup-or-nil`) and consumers pick.
+
+## Validation criteria
+
+The extraction is real iff:
+
+1. Both consumers compile and pass their full test suites unchanged.
+2. The shared `env.sx` file is ≥80 LoC (substantial enough to be worth sharing) and ≤200 LoC (small enough that the cfg adapter pattern doesn't become its own framework).
+3. A third consumer in the future can adopt the kit by writing only the cfg dict — no algorithm changes to `env.sx`.
+
+## Outcome (2026-05-12)
+
+Three commits on `lib/tcl/uplevel`:
+
+1. Plan committed.
+2. **`reflective: extract env.sx + migrate Kernel — 322 tests green`** — kit landed; Kernel's env block collapsed from ~30 lines to 6 thin wrappers (`kernel-env? = refl-env?` etc.). Envs now carry `:refl-tag :env`. All 7 Kernel suites unchanged.
+3. **`reflective: Tcl adapter cfg — second consumer wired, 427+322 tests green`** — `tcl-frame-cfg` defined, `frame-lookup`/`frame-set-top` delegate to the kit. Tcl's frame shape unchanged. Functional update preserved.
+
+**File stats:** `lib/guest/reflective/env.sx` is 124 lines, 13 forms. Within the 80–200 LoC validation bound. Adapter-cfg pattern proven to bridge mutable-canonical (Kernel) and functional-frame (Tcl) wire shapes via a single ~7-line cfg dict per consumer.
+
+**Third-consumer test:** any future guest can adopt the kit by writing its own cfg with five keys (`:bindings-of`, `:parent-of`, `:extend`, `:bind!`, `:env?`) — no changes to `env.sx`. The shape-divergence problem is solved by parameterisation, not by forcing both consumers onto one wire shape.
+
+## References
+
+- `plans/kernel-on-sx.md` — the kernel-on-sx loop's chisel notes; the six candidate API surfaces are documented there.
+- `lib/guest/match.sx` — precedent for the adapter-cfg extraction pattern.
+- `lib/tcl/runtime.sx` lines 5–22 (`make-frame`, `frame-lookup`, `frame-set-top`) — the Tcl consumer's current implementation.
+- `lib/kernel/eval.sx` lines 39–82 (env block) — the Kernel consumer's current implementation.

plans/scheme-on-sx.md

@@ -0,0 +1,191 @@
+# Scheme-on-SX: the reflective-kit second-consumer port
+
+The kernel-on-sx loop documented six reflective API candidates; two are now live (`env.sx`, `class-chain.sx`). Three more — `evaluator.sx`, `hygiene.sx`, `quoting.sx` — wait on a guest with operative-free lexical scope, hygienic syntax-transformer infrastructure, and quasiquote. **Scheme is exactly that guest.**
+
+A correct R7RS-small implementation acts as second consumer for those three kits in one stroke. It also confirms a third independent consumer for `env.sx` (after Kernel + Tcl + Smalltalk), and a candidate fourth consumer for `class-chain.sx` (Scheme's record types have parent fields — though OO is non-core in Scheme so the fit is weaker).
+
+## Strategic note on `combiner.sx`
+
+Scheme has *no fexprs*. `combiner.sx`'s applicative/operative split is Kernel-specific machinery. **Scheme is not a second consumer for `combiner.sx`** — that file stays Kernel-only until a Maru, Klisp, or CL-fexpr port arrives. The current session's earlier claim that Scheme "unlocks four more reflective kits" was over-counted; the correct number is **three**.
+
+## Scope decisions
+
+- **Target dialect:** R7RS-small. Source-only — no images, no FFI, no C extensions, no JIT.
+- **Numbers:** integers + floats. Rationals optional (defer to phase N+1). Complex out.
+- **Tail-call optimisation:** required. Implemented via the existing SX CEK machinery — call recursion in the evaluator uses iterative `cek-call` rather than host recursion.
+- **Continuations:** `call/cc` required for R7RS. Use SX's `call/cc` primitive directly.
+- **Hygienic macros:** `syntax-rules` required. `syntax-case` deferred.
+- **Char/string semantics:** Unicode codepoints; surface API matches R7RS section 6.
+- **I/O:** minimal stub (`display`, `write`, `newline`, `read`) on SX's IO surface.
+- **`define-library`:** required for module testing; implementation reuses SX's `define-library` if it's exposed, else hand-rolls a flat module registry.
+
+## Architecture sketch
+
+```
+lib/scheme/parser.sx     — reader: numbers, strings, symbols, booleans,
+                            chars #\c, vectors #(...), dotted-pairs (a . b),
+                            quasi-quote sugar, datum comments #;, block
+                            comments #| ... |#
+
+lib/scheme/eval.sx       — eval-expr ENV: walks AST. Symbols → env-lookup.
+                            Lists → look up head; if syntactic operator
+                            (if/lambda/define/set!/quote/quasiquote/
+                             let/let*/letrec/begin/cond/case/and/or/when/
+                             unless/do), dispatch to native handler. Else
+                            apply combiner (always applicative).
+
+                          ENV is `lib/guest/reflective/env.sx` directly
+                          — Scheme is the third consumer for env.sx with
+                          NO adapter cfg (canonical wire shape).
+
+lib/scheme/runtime.sx    — Standard environment, primitives, R7RS base.
+                            Variadic arithmetic, list ops, string ops,
+                            char ops, vector ops, define-record-type,
+                            syntax-rules, etc.
+
+lib/scheme/tests/        — Standard pattern: parse, eval, lambda+closure,
+                            macros (syntax-rules), call/cc, define-library,
+                            classic programs (factorial, Y, tree-walking,
+                            named let, do-loop), R7RS conformance subset.
+```
+
+## Roadmap
+
+### Phase 1 — Parser
+- [ ] Reader for R7RS lexical syntax: integers, floats, strings (with escapes), symbols (extended-identifier-character set), booleans `#t`/`#f`/`#true`/`#false`, characters `#\c` `#\space` `#\newline`, vectors `#(...)`, dotted pairs `(a . b)`, quote/quasiquote/unquote/unquote-splicing sugar (same reader macros as Kernel).
+- [ ] Datum comments `#;<datum>` (skip one whole expression).
+- [ ] Block comments `#| ... |#` (nestable).
+- [ ] Tests in `lib/scheme/tests/parse.sx`.
+
+### Phase 2 — Evaluator + env
+- [ ] `scheme-eval EXPR ENV` — primary entry, uses `lib/guest/reflective/env.sx` directly as the canonical scope chain. **Third consumer for env.sx.**
+- [ ] Self-evaluating: numbers, booleans, strings, chars, vectors.
+- [ ] Symbol lookup → `refl-env-lookup-with`.
+- [ ] List → look up head; syntactic operators dispatch natively; otherwise applicative call with evaluated args.
+- [ ] Tests in `lib/scheme/tests/eval.sx`.
+
+### Phase 3 — Syntactic operators
+- [ ] `if`, `quote`, `set!`, `define` (top-level + internal).
+- [ ] `lambda` — fixed-arity, rest-arg via dot, multi-body via implicit `begin`.
+- [ ] `let`, `let*`, `letrec`, `letrec*` — including named-let.
+- [ ] `begin` — implicit + explicit.
+- [ ] `cond`, `case`, `when`, `unless`, `and`, `or`, `do`.
+- [ ] Tests for each.
+
+### Phase 4 — Standard environment
+- [ ] Variadic `+ - * /` and chained comparison.
+- [ ] Type predicates (R7RS `number?`, `pair?`, `null?`, `symbol?`, `string?`, `procedure?`, `vector?`, `char?`, `boolean?`).
+- [ ] List ops: `cons car cdr caar cadr ... cddddr` (or just a subset), `list length reverse append map filter fold-left fold-right for-each`.
+- [ ] String ops: `string-length string-ref substring string-append string=? string<? char->integer integer->char`.
+- [ ] Char ops: `char->integer integer->char char-alphabetic? char-numeric?` etc.
+- [ ] Vector ops: `vector make-vector vector-length vector-ref vector-set! vector->list list->vector`.
+- [ ] I/O: `display write newline read`.
+- [ ] Numerical: `abs floor ceiling round truncate min max modulo quotient remainder gcd lcm expt`.
+- [ ] Classic programs: factorial, fib, list reversal, tree map.
+
+### Phase 5 — call/cc + dynamic-wind
+- [ ] `call-with-current-continuation` / `call/cc`.
+- [ ] `dynamic-wind`.
+- [ ] `with-exception-handler`, `raise`, `error`.
+- [ ] Tests: escape continuations, multi-shot via call/cc (chosen via host SX `call/cc`).
+
+### Phase 6 — `syntax-rules` + hygiene
+- [ ] `define-syntax`, `let-syntax`, `letrec-syntax`.
+- [ ] `syntax-rules` pattern matching, ellipsis, template instantiation.
+- [ ] Hygiene: scope-set / lifted-symbol implementation. **Second consumer for `lib/guest/reflective/hygiene.sx` extraction once that kit's API surface stabilises.**
+- [ ] Tests: hygienic identifier capture, ellipsis patterns, recursive macros.
+
+### Phase 7 — Reflection: `eval`, `interaction-environment`, etc.
+- [ ] `eval EXPR ENV` — applicative form of the evaluator. **Second consumer for `lib/guest/reflective/evaluator.sx` extraction.**
+- [ ] `interaction-environment`, `null-environment`, `scheme-report-environment`.
+- [ ] `environment?` predicate.
+
+### Phase 8 — `define-library` + module hygiene
+- [ ] `define-library`, `import`, `export`.
+- [ ] `cond-expand` for feature-flag conditionals.
+- [ ] Tests: cross-library imports, identifier renaming.
+
+### Phase 9 — Records
+- [ ] `define-record-type` with constructor/predicate/accessors/mutators.
+- [ ] Tests: typical record idioms.
+
+### Phase 10 — Quasiquote runtime
+- [ ] Backquote walker with depth tracking. **Second consumer for `lib/guest/reflective/quoting.sx` extraction.**
+- [ ] Tests including nested quasiquote.
+
+### Phase 11 — Conformance + scoreboard
+- [ ] Curated R7RS test slice (Chibi, Larceny, or hand-picked).
+- [ ] `lib/scheme/conformance.sh` + scoreboard.
+- [ ] Drive conformance toward 100% on chosen slice.
+
+## Reflective kit consumption — explicit mapping
+
+| Kit | When it lands | How Scheme uses it |
+|-----|--------------|-------------------|
+| `lib/guest/reflective/env.sx` | Phase 2 | Direct — canonical wire shape, no cfg needed. Third consumer. |
+| `lib/guest/reflective/evaluator.sx` | Phase 7 (will trigger the extraction) | Scheme's `eval`/`interaction-environment`/`null-environment` mirror the proposed `refl-eval`/`refl-make-environment`/`refl-current-env` triple. Second consumer → extraction unblocked. |
+| `lib/guest/reflective/hygiene.sx` | Phase 6 | Scheme's hygienic `syntax-rules` is the canonical implementation of scope sets / lifted symbols. Second consumer for the deferred Shutt-style hygiene work — Scheme's hygiene goes BEYOND Kernel's by-default-static-env-extension into proper scope-set lifting. Drives the deferred research-grade kit. |
+| `lib/guest/reflective/quoting.sx` | Phase 10 | Scheme's backquote walker is structurally identical to Kernel's `knl-quasi-walk`, with depth tracking added. Second consumer → extraction unblocked. |
+| `lib/guest/reflective/combiner.sx` | NEVER (no fexprs) | Not applicable. Stays Kernel-only until a fexpr-having consumer arrives. |
+| `lib/guest/reflective/short-circuit.sx` | Possibly Phase 3 | Scheme's `and`/`or` are syntactic, not operative; could be second consumer but adapter would need to bridge "macro that short-circuits" vs "operative that short-circuits". Marginal. |
+
+## Ground rules
+
+- **Scope:** only `lib/scheme/**` and `plans/scheme-on-sx.md` and `lib/guest/reflective/**` (for extraction work). Don't edit `spec/`, `hosts/`, `shared/`, or other `lib/<lang>/` directories.
+- **Consume:** `lib/guest/lex.sx` (character predicates), `lib/guest/reflective/env.sx` (scope chain), eventually `evaluator.sx`/`hygiene.sx`/`quoting.sx` once extracted with Scheme as second consumer.
+- **Commits:** one feature per commit. Short factual messages.
+- **Tests:** every phase ends with a test file. Conformance scoreboard at the end.
+- **Branch:** `loops/scheme`. Worktree pattern (already set up at `/root/rose-ash-loops/scheme`).
+- **Substrate gaps:** filed to `sx-improvements.md`, not fixed in this loop.
+
+## References
+
+- R7RS-small: https://small.r7rs.org/attachment/r7rs.pdf
+- Chibi Scheme — a small, readable R7RS implementation.
+- Dybvig, "Three Implementation Models for Scheme" — for the hygiene story.
+- Existing kernel-on-sx code in `lib/kernel/` — much of the parser, evaluator structure, and env handling carries over near-verbatim because Kernel and Scheme share lexical scope.
+
+## Progress log
+
+- 2026-05-14 — **Phases 1, 2, 3, 3.5, 4, 5abc, 6ab, 7, 8, 9, 10, 11 landed in one loop session.** 296 Scheme tests across 9 suites; ~1830 LoC of substrate. Test runner + scoreboard at `lib/scheme/test.sh` and `lib/scheme/scoreboard.md`. Three reflective kits unlocked: `env.sx` extracted directly as third consumer, `evaluator.sx` and `quoting.sx` second-consumer-ready for the kit-extraction commits (kit code is documented in `plans/kernel-on-sx.md`; Scheme consumer code is in place).
+
+### Phase-by-phase outcomes
+
+- Phase 1 (Parser, 62 tests): R7RS lexical syntax with reader macros, three comment flavours (`;`, `#;`, `#| |#`).
+- Phase 2 (Eval + env third-consumer, 23 tests): `scheme-make-env` etc. are thin aliases for `refl-env-*` from `lib/guest/reflective/env.sx`. No adapter cfg needed — Scheme uses the canonical wire shape directly.
+- Phase 3 (if/define/set!/begin/lambda + closures, 24 tests): factorial 10 → 3628800, counter via closed-over `set!`, curried lambda.
+- Phase 3.5 (let/let*/cond/when/unless/and/or, 21 tests).
+- Phase 4 (standard env + set! bugfix, 82 tests): variadic arithmetic, type predicates, list/string/char/vector ops, higher-order combinators. **Found and fixed an SX cond multi-expression branch bug** affecting set!. Bugfix unblocked 4 silently-failing tests in Phase 3.
+- Phase 5a (call/cc, 8 tests): single-shot escape continuations.
+- Phase 5b (raise/guard/with-exception-handler/error, 12 tests): catch-once-then-rehandle-outside pattern avoids handler-self-raise loops.
+- Phase 5c (dynamic-wind, 5 tests): basic before-thunk-after with raise propagation. call/cc-escape tracking deferred.
+- Phase 6a (define-syntax + syntax-rules, 12 tests): pattern matching with literals + pattern variables + list structure; template substitution.
+- Phase 6b (syntax-rules ellipsis, 8 tests): tail-rest single-variable form. `(my-and 1 2 3)` etc. work.
+- Phase 7 (eval / interaction-environment, 13 tests): **second consumer for evaluator.sx**. `interaction-environment` closes over the env being built, so user-side defines via `(eval ... ie)` persist across calls.
+- Phase 8 (define-library + import, 7 tests): minimal module system. Private definitions stay in library env; only exports are visible after import.
+- Phase 9 (define-record-type, 9 tests): tagged-dict records with optional mutators.
+- Phase 10 (quasiquote runtime, 10 tests): **second consumer for quoting.sx**. Identical algorithm to Kernel's `knl-quasi-walk` — universal across reflective Lisps.
+- Phase 11 (test.sh + scoreboard): single-process aggregating runner, scoreboard markdown.
+
+### Deferred phases
+
+- **Phase 6c — full hygiene**. Dybvig-style scope-sets / lifted-symbol algorithm. Would be the second consumer for the deferred `lib/guest/reflective/hygiene.sx`. Current macros work for common patterns but don't prevent introduced-binding capture. Research-grade work; warrants its own loop iteration.
+- **Nested quasiquote depth tracking**.
+- **R7RS module rich features** (`cond-expand`, `include`, import sets like `only`/`except`/`prefix`/`rename`).
+- **Dotted-pair `(a b . rest)` parser syntax** + lambda rest-args.
+- **Full call/cc + dynamic-wind interaction**: dynamic-extent re-entry/re-exit tracking.
+
+### Chisel ledger update
+
+This Scheme port satisfies the two-consumer rule for **three** reflective kits documented in the kernel-on-sx loop:
+
+| Kit | Status |
+|-----|--------|
+| `env.sx` | Extracted — Scheme is the third consumer (after Kernel + Tcl/Smalltalk), uses the canonical shape directly with no cfg |
+| `evaluator.sx` | Second consumer ready — Scheme `eval`/`interaction-environment`/`null-environment`/`scheme-report-environment` mirror the proposed `refl-eval`/`refl-current-env`/`refl-make-environment` triple |
+| `quoting.sx` | Second consumer ready — Scheme `scm-quasi-walk` is structurally identical to Kernel's `knl-quasi-walk`; the only difference is the unquote keyword names (cfg parameterisation) |
+| `hygiene.sx` | Still awaiting (needs Phase 6c) |
+| `combiner.sx` | N/A — Scheme has no fexprs |
+| `short-circuit.sx` | N/A — Scheme `and`/`or` are syntactic, not operative |
+
+The kit-extraction commits themselves are follow-on work; this Scheme port is the consumer-side foundation.