reflective: third consumer — Smalltalk frame adopts env.sx — 847+322+427 tests green
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 43s

lib/guest/reflective/env.sx — added refl-env-find-frame-with (returns
the scope where NAME is bound, or nil). Needed by consumers like
Smalltalk that mutate variables at the source frame rather than
shadowing at the current one. Also added refl-env-find-frame for
the canonical shape.

lib/smalltalk/eval.sx — new st-frame-cfg adapter for the kit.
st-lookup-local now delegates parent-walk to refl-env-find-frame-with
while preserving its Smalltalk-flavoured {:found :value :frame}
return shape (which is used to mutate at the binding's source
frame, not the current one).

lib/smalltalk/test.sh + compare.sh — load lib/guest/reflective/env.sx
before lib/smalltalk/eval.sx.

Three genuinely different wire shapes now share the parent-walk:
- Kernel: {:refl-tag :env :bindings :parent}      mutable bindings
- Tcl:    {:level :locals :parent}                 functional update
- Smalltalk: {:self :method-class :locals :parent  mutable bindings,
              :return-k :active-cell}              rich metadata

All three consumers' full test suites unchanged: Smalltalk 847/847,
Kernel 322/322, Tcl 427/427. The cfg adapter pattern (modelled after
lib/guest/match.sx) cleanly handles all three.
This commit is contained in:
2026-05-12 15:19:19 +00:00
parent 4e904a2782
commit 9efbf4ad38
4 changed files with 48 additions and 6 deletions

View File

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

View File

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

View File

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

View File

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