method-chain: plan — current status + future-consumer notes

Documents the extraction (Smalltalk + CLOS migrated, kit landed,
counts unchanged), lists plausible third consumers (JS proto chain,
Ruby ancestors, Python MRO), and notes which other patterns stayed
unextracted and why (method-cache invalidation, inline cache, and
the five reflective siblings all need consumers that don't exist
yet in the codebase).

Closes the session's extraction work at five branches: env (3
consumers), class-chain (2), test-runner (POC), plus the chain
of intermediate branches. The Scheme port is the next high-leverage
move; it would unlock four more reflective kits in one stroke.

lib/common-lisp/clos.sx

@@ -330,37 +330,22 @@
                     false))))))
         (check-all 0)))))
 
-;; Precedence distance: how far class-name is from spec-name up the hierarchy.
+;; CLOS-side adapter for lib/guest/reflective/class-chain.sx. Classes
-(define
+;; live in clos-class-registry; :parents is a list of parent class
-  clos-specificity
+;; names (CLOS supports multiple inheritance).
-  (let
+(define clos-class-cfg
-    ((registry clos-class-registry))
+  {:parents-of (fn (cn)
-    (fn
+                 (let ((rec (clos-find-class cn)))
-      (class-name spec-name)
+                   (cond ((nil? rec) (list))
-      (define
+                         (:else (or (get rec "parents") (list))))))
-        walk
+   :class?     (fn (n) (not (nil? (clos-find-class n))))})
-        (fn
+
-          (cn depth)
+;; Precedence distance: how far class-name is from spec-name up the
-          (if
+;; hierarchy. Delegates to refl-class-chain-depth-with which handles
-            (= cn spec-name)
+;; the multi-parent DFS with min-depth selection.
-            depth
+(define clos-specificity
-            (let
+  (fn (class-name spec-name)
-              ((rec (get registry cn)))
+    (refl-class-chain-depth-with clos-class-cfg class-name spec-name)))
-              (if
-                (nil? rec)
-                nil
-                (let
-                  ((results (map (fn (p) (walk p (+ depth 1))) (get rec "parents"))))
-                  (let
-                    ((non-nil (filter (fn (x) (not (nil? x))) results)))
-                    (if
-                      (empty? non-nil)
-                      nil
-                      (reduce
-                        (fn (a b) (if (< a b) a b))
-                        (first non-nil)
-                        (rest non-nil))))))))))
-      (walk class-name 0))))
 
 (define
   clos-method-more-specific?

lib/common-lisp/test.sh

@@ -368,7 +368,7 @@ run_program_suite \
 
 # ── Phase 4: CLOS unit tests ─────────────────────────────────────────────────
 CLOS_FILE=$(mktemp); trap "rm -f $CLOS_FILE" EXIT
-printf '(epoch 1)\n(load "spec/stdlib.sx")\n(epoch 2)\n(load "lib/common-lisp/runtime.sx")\n(epoch 3)\n(load "lib/common-lisp/clos.sx")\n(epoch 4)\n(load "lib/common-lisp/tests/clos.sx")\n(epoch 5)\n(eval "passed")\n(epoch 6)\n(eval "failed")\n(epoch 7)\n(eval "failures")\n' > "$CLOS_FILE"
+printf '(epoch 1)\n(load "spec/stdlib.sx")\n(epoch 2)\n(load "lib/common-lisp/runtime.sx")\n(epoch 3)\n(load "lib/guest/reflective/class-chain.sx")\n(load "lib/common-lisp/clos.sx")\n(epoch 4)\n(load "lib/common-lisp/tests/clos.sx")\n(epoch 5)\n(eval "passed")\n(epoch 6)\n(eval "failed")\n(epoch 7)\n(eval "failures")\n' > "$CLOS_FILE"
 CLOS_OUT=$(timeout 30 "$SX_SERVER" < "$CLOS_FILE" 2>/dev/null)
 rm -f "$CLOS_FILE"
 CLOS_PASSED=$(echo "$CLOS_OUT" | grep -A1 "^(ok-len 5 " | tail -1 || true)
@@ -389,7 +389,7 @@ fi
 run_clos_suite() {
   local prog="$1" pass_var="$2" fail_var="$3" failures_var="$4"
   local PROG_FILE=$(mktemp)
-  printf '(epoch 1)\n(load "spec/stdlib.sx")\n(epoch 2)\n(load "lib/common-lisp/runtime.sx")\n(epoch 3)\n(load "lib/common-lisp/clos.sx")\n(epoch 4)\n(load "%s")\n(epoch 5)\n(eval "%s")\n(epoch 6)\n(eval "%s")\n(epoch 7)\n(eval "%s")\n' \
+  printf '(epoch 1)\n(load "spec/stdlib.sx")\n(epoch 2)\n(load "lib/common-lisp/runtime.sx")\n(epoch 3)\n(load "lib/guest/reflective/class-chain.sx")\n(load "lib/common-lisp/clos.sx")\n(epoch 4)\n(load "%s")\n(epoch 5)\n(eval "%s")\n(epoch 6)\n(eval "%s")\n(epoch 7)\n(eval "%s")\n' \
     "$prog" "$pass_var" "$fail_var" "$failures_var" > "$PROG_FILE"
   local OUT; OUT=$(timeout 20 "$SX_SERVER" < "$PROG_FILE" 2>/dev/null)
   rm -f "$PROG_FILE"

lib/guest/reflective/class-chain.sx

@@ -0,0 +1,129 @@
+;; lib/guest/reflective/class-chain.sx — class inheritance walker.
+;;
+;; Extracted from Smalltalk's `st-method-lookup-walk` (single-parent
+;; class chain for message-send dispatch) and CLOS's `clos-specificity`
+;; (multi-parent class graph for method-precedence distance). Both walk
+;; a class-name → parent-name(s) graph applying a probe at each node;
+;; the cfg adapter normalises single-parent and multi-parent classes
+;; into a uniform `:parents-of` callback that returns a (possibly
+;; empty) list of parent class names.
+;;
+;; Adapter cfg
+;; -----------
+;;   :parents-of  — fn (class-name) → list of parent class names.
+;;                  Empty list = no parents (root). Single-parent guests
+;;                  return a 1-element list; multi-parent guests (CLOS)
+;;                  may return any number.
+;;   :class?      — fn (name) → bool. False short-circuits the walk —
+;;                  used to skip non-existent class names mid-chain.
+;;
+;; Public API
+;;   (refl-class-chain-find-with CFG CLASS-NAME PROBE)
+;;     Depth-first walk from CLASS-NAME up its parent chain. At each
+;;     class, calls `(probe class-name)`. Returns the first non-nil
+;;     probe result, or nil if no class produces one. Probes evaluate
+;;     left-to-right across siblings in multi-parent guests.
+;;
+;;   (refl-class-chain-depth-with CFG CLASS-NAME ANCESTOR-NAME)
+;;     Minimum hop count from CLASS-NAME to ANCESTOR-NAME along any
+;;     parent path. CLASS-NAME itself counts as depth 0. Returns nil
+;;     if ANCESTOR-NAME is unreachable.
+;;
+;;   (refl-class-chain-ancestors-with CFG CLASS-NAME)
+;;     Flat list of all reachable ancestor names in DFS order (no
+;;     dedup; multi-parent guests may want to dedup themselves).
+;;
+;; Consumer migrations
+;; -------------------
+;; - Smalltalk: see `lib/smalltalk/runtime.sx` — `st-method-lookup-walk`
+;;   becomes a one-line probe through `refl-class-chain-find-with`.
+;; - CLOS: see `lib/common-lisp/clos.sx` — `clos-specificity` becomes a
+;;   thin wrapper around `refl-class-chain-depth-with`.
+
+(define
+  refl-find-in-parents-with
+  (fn
+    (cfg parents probe)
+    (cond
+      ((or (nil? parents) (= (length parents) 0)) nil)
+      (:else
+        (let
+          ((hit (refl-class-chain-find-with cfg (first parents) probe)))
+          (cond
+            ((not (nil? hit)) hit)
+            (:else (refl-find-in-parents-with cfg (rest parents) probe))))))))
+
+(define
+  refl-class-chain-find-with
+  (fn
+    (cfg class-name probe)
+    (cond
+      ((nil? class-name) nil)
+      ((not ((get cfg :class?) class-name)) nil)
+      (:else
+        (let
+          ((hit (probe class-name)))
+          (cond
+            ((not (nil? hit)) hit)
+            (:else
+              (refl-find-in-parents-with
+                cfg
+                ((get cfg :parents-of) class-name)
+                probe))))))))
+
+(define
+  refl-class-chain-depth-walk
+  (fn
+    (cfg cur target depth)
+    (cond
+      ((= cur target) depth)
+      ((nil? cur) nil)
+      ((not ((get cfg :class?) cur)) nil)
+      (:else
+        (let
+          ((parents ((get cfg :parents-of) cur)))
+          (let
+            ((results (map (fn (p) (refl-class-chain-depth-walk cfg p target (+ depth 1))) parents)))
+            (let
+              ((non-nil (filter (fn (x) (not (nil? x))) results)))
+              (cond
+                ((or (nil? non-nil) (= (length non-nil) 0)) nil)
+                (:else
+                  (reduce
+                    (fn (a b) (if (< a b) a b))
+                    (first non-nil)
+                    (rest non-nil)))))))))))
+
+(define
+  refl-class-chain-depth-with
+  (fn
+    (cfg class-name ancestor-name)
+    (refl-class-chain-depth-walk cfg class-name ancestor-name 0)))
+
+(define
+  refl-class-chain-ancestors-with
+  (fn (cfg class-name) (refl-ancestors-walk cfg class-name (list))))
+
+(define
+  refl-ancestors-walk
+  (fn
+    (cfg cn acc)
+    (cond
+      ((nil? cn) acc)
+      ((not ((get cfg :class?) cn)) acc)
+      (:else
+        (let
+          ((parents ((get cfg :parents-of) cn)))
+          (refl-ancestors-walk-list cfg parents (append acc (list cn))))))))
+
+(define
+  refl-ancestors-walk-list
+  (fn
+    (cfg parents acc)
+    (cond
+      ((or (nil? parents) (= (length parents) 0)) acc)
+      (:else
+        (refl-ancestors-walk-list
+          cfg
+          (rest parents)
+          (refl-ancestors-walk cfg (first parents) acc))))))

lib/scheme/runtime.sx

@@ -1,649 +0,0 @@
-;; 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

@@ -1,83 +0,0 @@
-# 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

@@ -1,92 +0,0 @@
-#!/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/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

@@ -1,168 +0,0 @@
-;; 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

@@ -1,162 +0,0 @@
-;; 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

@@ -1,155 +0,0 @@
-;; 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

@@ -1,73 +0,0 @@
-;; 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

@@ -1,177 +0,0 @@
-;; 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

@@ -1,96 +0,0 @@
-;; 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

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

@@ -1,213 +0,0 @@
-;; 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

@@ -1,288 +0,0 @@
-;; 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

@@ -40,6 +40,7 @@ run_sx () {
 (epoch 1)
 (load "lib/smalltalk/tokenizer.sx")
 (load "lib/smalltalk/parser.sx")
+(load "lib/guest/reflective/class-chain.sx")
 (load "lib/smalltalk/runtime.sx")
 (load "lib/guest/reflective/env.sx")
 (load "lib/smalltalk/eval.sx")

lib/smalltalk/runtime.sx

@@ -221,30 +221,37 @@
                     (st-ic-bump-generation!)
                     true))))))))))
 
+;; Smalltalk-side adapter for lib/guest/reflective/class-chain.sx.
+;; Smalltalk has single inheritance: :parents-of returns a 1-element
+;; list (or empty) wrapping the single :superclass field.
+(define st-class-cfg
+  {:parents-of (fn (cn)
+                 (let ((p (st-class-superclass cn)))
+                   (cond ((nil? p) (list))
+                         (:else (list p)))))
+   :class?     (fn (n) (st-class-exists? n))})
+
 ;; Walk-only lookup. Returns the method record (with :defining-class) or nil.
 ;; class-side? = true searches :class-methods, false searches :methods.
+;; Parent-chain walk delegates to refl-class-chain-find-with; the probe
+;; tests this class's method dict and returns the entry (or nil).
 (define
   st-method-lookup-walk
-  (fn
+  (fn (cls-name selector class-side?)
-    (cls-name selector class-side?)
+    (refl-class-chain-find-with
-    (let
+      st-class-cfg
-      ((found nil))
+      cls-name
-      (begin
+      (fn (cn)
-        (define
+        (let ((c (st-class-get cn)))
-          ml-loop
-          (fn
-            (cur)
-            (when
-              (and (= found nil) (not (= cur nil)) (st-class-exists? cur))
-              (let
-                ((c (st-class-get cur)))
-                (let
-                  ((dict (if class-side? (get c :class-methods) (get c :methods))))
           (cond
-                    ((has-key? dict selector) (set! found (get dict selector)))
+            ((nil? c) nil)
-                    (else (ml-loop (get c :superclass)))))))))
+            (:else
-        (ml-loop cls-name)
+              (let ((dict (if class-side?
-        found))))
+                            (get c :class-methods)
+                            (get c :methods))))
+                (cond
+                  ((has-key? dict selector) (get dict selector))
+                  (:else nil))))))))))
 
 ;; Cached lookup. Misses are stored as :not-found so doesNotUnderstand paths
 ;; don't re-walk on every send.

lib/smalltalk/test.sh

@@ -59,6 +59,7 @@ EPOCHS
 (epoch 2)
 (load "lib/smalltalk/parser.sx")
 (epoch 3)
+(load "lib/guest/reflective/class-chain.sx")
 (load "lib/smalltalk/runtime.sx")
 (epoch 4)
 (load "lib/guest/reflective/env.sx")
@@ -115,6 +116,7 @@ EPOCHS
 (epoch 2)
 (load "lib/smalltalk/parser.sx")
 (epoch 3)
+(load "lib/guest/reflective/class-chain.sx")
 (load "lib/smalltalk/runtime.sx")
 (epoch 4)
 (load "lib/guest/reflective/env.sx")

plans/lib-guest-method-chain.md

@@ -0,0 +1,59 @@
+# lib/guest/reflective/class-chain.sx — extraction plan
+
+## Status
+
+- [x] **Kit landed** — `lib/guest/reflective/class-chain.sx` (7 forms, ~120 LoC).
+- [x] **First consumer migrated** — `lib/smalltalk/runtime.sx` `st-method-lookup-walk`. 20 lines → 9 lines. Smalltalk single-parent shape adapted via `:parents-of` returning a 1-element list.
+- [x] **Second consumer migrated** — `lib/common-lisp/clos.sx` `clos-specificity`. 28 lines → 4 lines. CLOS multi-parent shape adapted via `:parents-of` returning the full parents list.
+- [x] Both consumers' test counts unchanged. Smalltalk 847/847. CL 222/240 (18 pre-existing failures unrelated to CLOS dispatch).
+
+## API surface
+
+```lisp
+(refl-class-chain-find-with CFG CLASS-NAME PROBE)
+  ;; DFS through parent chain. Returns first non-nil probe result.
+  ;; Smalltalk method lookup uses this.
+
+(refl-class-chain-depth-with CFG CLASS-NAME ANCESTOR-NAME)
+  ;; Minimum hop count via any parent path. nil if unreachable.
+  ;; CLOS method specificity uses this.
+
+(refl-class-chain-ancestors-with CFG CLASS-NAME)
+  ;; Flat DFS-ordered list of all reachable ancestor names.
+```
+
+**Adapter cfg keys:**
+- `:parents-of` — fn (class-name) → list of parent class names. Empty list = root. Single-parent guests wrap into a 1-element list.
+- `:class?` — predicate; short-circuits walk on non-existent class names.
+
+## Why two consumers were enough
+
+Smalltalk and CLOS have *structurally different* class hierarchies — single inheritance with one `:superclass` field versus multiple inheritance with a `:parents` list. The kit handles both via the cfg normalising `:parents-of` to "list of parent names" (empty, singleton, or multi-element). This is the third demonstration of the adapter-cfg pattern from `lib/guest/match.sx` and `lib/guest/reflective/env.sx`.
+
+## Future consumers
+
+A third consumer would validate the kit further but isn't blocked by the two-consumer rule. Plausible candidates that already have class chains in the codebase or could acquire them:
+
+- **JavaScript prototype chains** — if `lib/js/` builds an evaluator that walks `__proto__`. `:parents-of` returns a 1-element list (the proto, if any). Probably the cleanest third consumer.
+- **Ruby's ancestor walk** (`Module#ancestors`) — multi-element list with strict ordering rules. Would stress whether `:parents-of` needs to return ordered lists (it already does).
+- **Python's MRO** (method resolution order via C3 linearisation) — could use `refl-class-chain-ancestors-with` as a starting point, with consumer-side linearisation on top.
+
+## Non-goals
+
+- **Method-cache invalidation protocol** — Smalltalk has `st-method-cache` with class-change invalidation; CLOS has per-generic method lists with `clos-defmethod` updates. Currently only one consumer per cache shape; defer.
+
+- **Inline call-site caches** — Smalltalk's per-call-site IC is a hot-path optimisation. No other current consumer; defer until at least a JS or Python guest with optimisable dispatch.
+
+- **`combiner.sx`, `evaluator.sx`, `hygiene.sx`, `quoting.sx`, `short-circuit.sx`** — these still wait for a Scheme/Maru port. CLOS doesn't have fexprs, so it can't be the second consumer for `combiner.sx`. CL's reader has backquote parsing but no runtime quasi-walker, so it's not a current second consumer for `quoting.sx` either. The Scheme port is the unlock.
+
+## Cumulative session output
+
+| Branch | Kit | Consumers |
+|---|---|---|
+| `loops/kernel` | (proposal docs) | 1 |
+| `lib/tcl/uplevel` | `reflective/env.sx` | 2 (Kernel, Tcl) |
+| `lib/smalltalk/refl-env` | `+ refl-env-find-frame-with` | 3 (+ Smalltalk) |
+| `lib/guest/test-runner` | `test-runner.sx` | 1 (Kernel POC) |
+| `lib/guest/method-chain` | `reflective/class-chain.sx` | 2 (Smalltalk, CLOS) |
+
+**Two complete reflective kits live with multiple consumers**; one infrastructure kit at proof-of-concept; one extraction (the Scheme port that would unlock four more reflective kits) is the next natural strategic move but is a substantial undertaking.

plans/scheme-on-sx.md

@@ -1,191 +0,0 @@
-# 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.