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/guest/reflective/env.sx

@@ -42,6 +42,9 @@
 ;;   (refl-env-has?-with   CFG SCOPE NAME)
 ;;   (refl-env-lookup-with CFG SCOPE NAME)
 ;;   (refl-env-lookup-or-nil-with CFG SCOPE NAME)
+;;   (refl-env-find-frame-with CFG SCOPE NAME)
+;;     — returns the scope in the chain that contains NAME (or nil).
+;;       Consumers needing source-frame mutation use this.
 ;;
 ;;   (refl-canonical-cfg) — the default cfg, exposed so consumers
 ;;                          can compare or extend it.
@@ -131,6 +134,24 @@
       (:else
         (refl-env-lookup-or-nil-with cfg ((get cfg :parent-of) scope) name)))))
 
+;; Returns the SCOPE in the chain that contains NAME, or nil if no
+;; scope binds it. Consumers (e.g. Smalltalk) use this to mutate the
+;; binding at its source frame rather than introducing a new shadow
+;; binding at the current frame. Pairs with `refl-env-lookup-with`
+;; for callers that need both the value and the defining scope.
+
+(define refl-env-find-frame-with
+  (fn (cfg scope name)
+    (cond
+      ((nil? scope) nil)
+      ((not ((get cfg :env?) scope)) nil)
+      ((dict-has? ((get cfg :bindings-of) scope) name) scope)
+      (:else
+        (refl-env-find-frame-with cfg ((get cfg :parent-of) scope) name)))))
+
+(define refl-env-find-frame
+  (fn (env name) (refl-env-find-frame-with refl-canonical-cfg env name)))
+
 ;; ── Default canonical cfg ───────────────────────────────────────
 ;; Exposed so consumers can use it explicitly, compose with it, or
 ;; check adapter-correctness against the canonical implementation.

lib/smalltalk/compare.sh

@@ -40,7 +40,9 @@ 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")
 (epoch 2)
 (eval "(begin (st-bootstrap-classes!) (smalltalk-load \"Object subclass: #B instanceVariableNames: ''! !B methodsFor: 'x'! fib: n n < 2 ifTrue: [^ n]. ^ (self fib: n - 1) + (self fib: n - 2)! !\") (smalltalk-eval-program \"^ B new fib: 22\"))")

lib/smalltalk/eval.sx

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

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,8 +59,10 @@ 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")
 (load "lib/smalltalk/eval.sx")
 (epoch 5)
 (load "lib/smalltalk/sunit.sx")
@@ -114,8 +116,10 @@ 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")
 (load "lib/smalltalk/eval.sx")
 (epoch 5)
 (load "lib/smalltalk/sunit.sx")

plans/agent-briefings/smalltalk-loop.md

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

plans/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.