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

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