reflective: extract class-chain.sx — Smalltalk + CLOS method dispatch share parent-walk
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s

lib/guest/reflective/class-chain.sx — class inheritance walker with
adapter cfg for single-parent (Smalltalk) and multi-parent (CLOS)
hierarchies. Three primitives:

- refl-class-chain-find-with CFG CN PROBE
    DFS through parents, returns first non-nil probe result.
    Smalltalk method lookup uses this.

- refl-class-chain-depth-with CFG CN ANCESTOR
    Min hop distance via any parent path, or nil if unreachable.
    CLOS method specificity uses this.

- refl-class-chain-ancestors-with CFG CN
    Flat DFS-ordered list of all reachable ancestor names.

Adapter cfg has two keys: :parents-of (CN → list of parent names,
possibly empty) and :class? (predicate; short-circuits walk on
non-existent class names mid-chain).

Migrations:
- lib/smalltalk/runtime.sx: st-method-lookup-walk now a 9-line
  thin probe through the kit (was 20 lines of inline recursion);
  st-class-cfg wraps the single-parent :superclass field into a
  1-element list for the cfg.

- lib/common-lisp/clos.sx: clos-specificity is a one-line wrapper
  around refl-class-chain-depth-with (was 28 lines); clos-class-cfg
  reads the multi-parent :parents field.

Both consumers green:
- Smalltalk: 847/847 (unchanged)
- CL: 222/240 (unchanged baseline; 18 pre-existing failures, all
  in stdlib functions like cl-set-memberp, unrelated to CLOS).

This is the second extracted reflective kit (env.sx was first).
The adapter-cfg pattern continues to bridge structurally divergent
consumers (Smalltalk single-inheritance vs CLOS multiple-inheritance
with method-precedence distance) via a uniform :parents-of callback.
This commit is contained in:
2026-05-12 21:09:07 +00:00
parent 9efbf4ad38
commit 2981a479e8
6 changed files with 177 additions and 53 deletions

View File

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