Compare commits

...

7 Commits

Author SHA1 Message Date
03d4e350d7 test-runner: plan — per-guest migration playbook for Phase 2
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 27s
Documents what's already done (kit + Kernel 7 files) and what's left
across 7 guests (35 std-pattern files + variant flavours in Tcl/APL).

Each guest is its own commit due to local naming and shape variants.
Prolog is the biggest single migration (23 files). Tcl and APL need
small variant adapters because their failure-records hold strings or
use slightly different signatures.

Reference: /tmp/migrate_harness.py is the regex-driven mechanical
migration tool; works on the standard pattern, skips variants for
human review.
2026-05-12 19:41:29 +00:00
4504b8ae5e test-runner: extract harness kit + migrate Kernel (7 files, 84 LoC saved)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 33s
lib/guest/test-runner.sx — per-suite mutable state {:pass :fail :fails}
+ refl-test recorder + refl-test-report. Replaces the identical
4-define harness that appears in 142+ test files across the codebase.

Each migrated file goes from:
  (define X-test-pass 0)
  (define X-test-fail 0)
  (define X-test-fails (list))
  (define X-test (fn (name actual expected) (if (= actual expected)
    (set! X-test-pass (+ X-test-pass 1)) (begin ...))))
  ;; ... tests ...
  (define X-tests-run! (fn () {:total ... :passed ... :failed ... :fails ...}))

to:
  (define X-suite (refl-make-test-suite))
  (define X-test  (fn (n a e) (refl-test X-suite n a e)))
  ;; ... tests ...
  (define X-tests-run! (fn () (refl-test-report X-suite)))

All 322 Kernel tests pass unchanged (parse 62, eval 36, vau 38,
standard 127, encap 19, hygiene 26, metacircular 14). 84 LoC removed.

Migration is mechanical (the prefix is the only difference between
suites); /tmp/migrate_harness.py drives the regex. Other guests
(Tcl, Smalltalk, APL, CL, Erlang, Haskell, etc.) migrated in
subsequent commits.
2026-05-12 19:39:45 +00:00
9efbf4ad38 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.
2026-05-12 15:19:19 +00:00
4e904a2782 merge: loops/smalltalk into lib/smalltalk/refl-env — bring in third consumer 2026-05-12 14:50:05 +00:00
c27db9b78f reflective: Phase 3 docs — mark env.sx extraction DONE, others still blocked
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
plans/kernel-on-sx.md — Phase 7 header updated from "partial" to
"env.sx EXTRACTED 2026-05-12"; second-consumer-found checkbox ticked
for env.sx specifically. Other five files (combiner, evaluator,
hygiene, quoting, short-circuit) stay blocked pending their own
second consumers.

plans/lib-guest-reflective.md — Phases 1-3 ticked off with date
stamps; Outcome section added summarising the three commits, file
stats (124 LoC, within 80-200 bound), and the third-consumer
adoption protocol (cfg with five keys, no changes to env.sx).
2026-05-12 07:04:17 +00:00
39381fda92 reflective: Tcl adapter cfg — second consumer wired, 427+322 tests green
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
Phase 2 of the lib-guest-reflective extraction.

lib/tcl/runtime.sx — frame-lookup and frame-set-top now delegate to
refl-env-lookup-or-nil-with and refl-env-bind!-with via a new
tcl-frame-cfg adapter. Tcl keeps its existing {:level :locals :parent}
frame shape unchanged; the cfg bridges it to the kit's generic
algorithms. Functional update semantics preserved (cfg's :bind!
returns the new frame via assoc).

lib/tcl/test.sh + conformance.sh — load lib/guest/reflective/env.sx
before lib/tcl/runtime.sx.

Both consumers' full test suites unchanged:
- Tcl: 427/427 (parse 67, eval 169, error 39, namespace 22, coro 20,
       idiom 110)
- Kernel: 322/322 across 7 suites

The extraction is now real: two consumers, two genuinely different
wire shapes (mutable canonical vs functional frame), sharing the
parent-walk algorithm via cfg adapter — same pattern as
lib/guest/match.sx.
2026-05-12 07:02:56 +00:00
6fa0cdeedc briefing: push to origin/loops/smalltalk after each commit
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 43s
2026-05-06 06:47:30 +00:00
19 changed files with 256 additions and 143 deletions

View File

@@ -42,6 +42,9 @@
;; (refl-env-has?-with CFG SCOPE NAME) ;; (refl-env-has?-with CFG SCOPE NAME)
;; (refl-env-lookup-with CFG SCOPE NAME) ;; (refl-env-lookup-with CFG SCOPE NAME)
;; (refl-env-lookup-or-nil-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 ;; (refl-canonical-cfg) — the default cfg, exposed so consumers
;; can compare or extend it. ;; can compare or extend it.
@@ -131,6 +134,24 @@
(:else (:else
(refl-env-lookup-or-nil-with cfg ((get cfg :parent-of) scope) name))))) (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 ─────────────────────────────────────── ;; ── Default canonical cfg ───────────────────────────────────────
;; Exposed so consumers can use it explicitly, compose with it, or ;; Exposed so consumers can use it explicitly, compose with it, or
;; check adapter-correctness against the canonical implementation. ;; check adapter-correctness against the canonical implementation.

50
lib/guest/test-runner.sx Normal file
View File

@@ -0,0 +1,50 @@
;; lib/guest/test-runner.sx — per-suite test harness for guest test files.
;;
;; Across the codebase 142+ test files implement the identical four-form
;; boilerplate: `<X>-test-pass`, `<X>-test-fail`, `<X>-test-fails`, and
;; an `<X>-test` recording function. Only the prefix differs. This kit
;; collapses the boilerplate to a per-suite mutable dict + a recording
;; helper, so each test file goes from ~12 lines of harness to ~3:
;;
;; (define ke-suite (refl-make-test-suite))
;; (define ke-test (fn (n a e) (refl-test ke-suite n a e)))
;; (define ke-tests-run! (fn () (refl-test-report ke-suite)))
;;
;; The suite is a mutable dict `{:pass N :fail N :fails LIST}`. Each
;; failed assertion appends `{:name NAME :expected EXPECTED :actual ACT}`
;; to :fails — same shape every existing harness already produces.
;;
;; The `:fails` list is mutated in place via `append!`, so callers who
;; have a reference to it see the same updates. (Same semantic the
;; existing per-suite globals had — just held in the suite dict now.)
;;
;; Public API
;; (refl-make-test-suite) — fresh suite
;; (refl-test SUITE NAME ACT EXP) — record one assertion
;; (refl-test-report SUITE) — return {:total :passed :failed :fails}
;; (refl-test-pass? SUITE) — convenience: all green?
;; (refl-test-suite? V) — predicate
(define refl-make-test-suite (fn () {:fail 0 :pass 0 :fails (list)}))
(define
refl-test-suite?
(fn
(v)
(and (dict? v) (number? (get v :pass)) (number? (get v :fail)))))
(define
refl-test
(fn
(suite name actual expected)
(cond
((= actual expected)
(dict-set! suite :pass (+ (get suite :pass) 1)))
(:else
(begin
(dict-set! suite :fail (+ (get suite :fail) 1))
(append! (get suite :fails) {:name name :actual actual :expected expected}))))))
(define refl-test-report (fn (suite) {:total (+ (get suite :pass) (get suite :fail)) :passed (get suite :pass) :failed (get suite :fail) :fails (get suite :fails)}))
(define refl-test-pass? (fn (suite) (= (get suite :fail) 0)))

View File

@@ -5,20 +5,8 @@
;; identity is per-call, so two `(make-encapsulation-type)` calls ;; identity is per-call, so two `(make-encapsulation-type)` calls
;; produce non-interchangeable families. ;; produce non-interchangeable families.
(define ken-test-pass 0) (define ken-suite (refl-make-test-suite))
(define ken-test-fail 0) (define ken-test (fn (n a e) (refl-test ken-suite n a e)))
(define ken-test-fails (list))
(define
ken-test
(fn
(name actual expected)
(if
(= actual expected)
(set! ken-test-pass (+ ken-test-pass 1))
(begin
(set! ken-test-fail (+ ken-test-fail 1))
(append! ken-test-fails {:name name :actual actual :expected expected})))))
(define ken-eval-in (fn (src env) (kernel-eval (kernel-parse src) env))) (define ken-eval-in (fn (src env) (kernel-eval (kernel-parse src) env)))
@@ -180,4 +168,4 @@
env)) env))
(list true 7)) (list true 7))
(define ken-tests-run! (fn () {:total (+ ken-test-pass ken-test-fail) :passed ken-test-pass :failed ken-test-fail :fails ken-test-fails})) (define ken-tests-run! (fn () (refl-test-report ken-suite)))

View File

@@ -5,20 +5,8 @@
;; ($if, $define!, $lambda, …) arrive in Phase 4, so tests build a ;; ($if, $define!, $lambda, …) arrive in Phase 4, so tests build a
;; minimal env on the fly and verify the dispatch contract directly. ;; minimal env on the fly and verify the dispatch contract directly.
(define ke-test-pass 0) (define ke-suite (refl-make-test-suite))
(define ke-test-fail 0) (define ke-test (fn (n a e) (refl-test ke-suite n a e)))
(define ke-test-fails (list))
(define
ke-test
(fn
(name actual expected)
(if
(= actual expected)
(set! ke-test-pass (+ ke-test-pass 1))
(begin
(set! ke-test-fail (+ ke-test-fail 1))
(append! ke-test-fails {:name name :actual actual :expected expected})))))
;; ── helpers ────────────────────────────────────────────────────── ;; ── helpers ──────────────────────────────────────────────────────
@@ -267,4 +255,4 @@
(kernel-eval (kernel-parse "(x 1)") env))) (kernel-eval (kernel-parse "(x 1)") env)))
:raised) :raised)
(define ke-tests-run! (fn () {:total (+ ke-test-pass ke-test-fail) :passed ke-test-pass :failed ke-test-fail :fails ke-test-fails})) (define ke-tests-run! (fn () (refl-test-report ke-suite)))

View File

@@ -10,20 +10,8 @@
;; provenance markers) is research-grade and is NOT implemented — see ;; provenance markers) is research-grade and is NOT implemented — see
;; the plan's reflective-API notes for the proposed approach. ;; the plan's reflective-API notes for the proposed approach.
(define kh-test-pass 0) (define kh-suite (refl-make-test-suite))
(define kh-test-fail 0) (define kh-test (fn (n a e) (refl-test kh-suite n a e)))
(define kh-test-fails (list))
(define
kh-test
(fn
(name actual expected)
(if
(= actual expected)
(set! kh-test-pass (+ kh-test-pass 1))
(begin
(set! kh-test-fail (+ kh-test-fail 1))
(append! kh-test-fails {:name name :actual actual :expected expected})))))
(define kh-eval-in (fn (src env) (kernel-eval (kernel-parse src) env))) (define kh-eval-in (fn (src env) (kernel-eval (kernel-parse src) env)))
@@ -217,4 +205,4 @@
(kh-eval-in "($let ((x 5)) ($define! tmp (+ x 1)) tmp)" (kh-eval-in "($let ((x 5)) ($define! tmp (+ x 1)) tmp)"
(kernel-standard-env)) 6) (kernel-standard-env)) 6)
(define kh-tests-run! (fn () {:total (+ kh-test-pass kh-test-fail) :passed kh-test-pass :failed kh-test-fail :fails kh-test-fails})) (define kh-tests-run! (fn () (refl-test-report kh-suite)))

View File

@@ -12,20 +12,8 @@
;; first-class evaluators all line up — enough so a Kernel program ;; first-class evaluators all line up — enough so a Kernel program
;; can itself reason about Kernel programs. ;; can itself reason about Kernel programs.
(define kmc-test-pass 0) (define kmc-suite (refl-make-test-suite))
(define kmc-test-fail 0) (define kmc-test (fn (n a e) (refl-test kmc-suite n a e)))
(define kmc-test-fails (list))
(define
kmc-test
(fn
(name actual expected)
(if
(= actual expected)
(set! kmc-test-pass (+ kmc-test-pass 1))
(begin
(set! kmc-test-fail (+ kmc-test-fail 1))
(append! kmc-test-fails {:name name :actual actual :expected expected})))))
;; Build a Kernel env with m-eval and m-apply defined. The two refer ;; Build a Kernel env with m-eval and m-apply defined. The two refer
;; to each other and to standard primitives, so we use the standard ;; to each other and to standard primitives, so we use the standard
@@ -159,4 +147,4 @@
env)) env))
49) 49)
(define kmc-tests-run! (fn () {:total (+ kmc-test-pass kmc-test-fail) :passed kmc-test-pass :failed kmc-test-fail :fails kmc-test-fails})) (define kmc-tests-run! (fn () (refl-test-report kmc-suite)))

View File

@@ -1,19 +1,7 @@
;; lib/kernel/tests/parse.sx — exercises lib/kernel/parser.sx. ;; lib/kernel/tests/parse.sx — exercises lib/kernel/parser.sx.
(define knl-test-pass 0) (define knl-suite (refl-make-test-suite))
(define knl-test-fail 0) (define knl-test (fn (n a e) (refl-test knl-suite n a e)))
(define knl-test-fails (list))
(define
knl-test
(fn
(name actual expected)
(if
(= actual expected)
(set! knl-test-pass (+ knl-test-pass 1))
(begin
(set! knl-test-fail (+ knl-test-fail 1))
(append! knl-test-fails {:name name :actual actual :expected expected})))))
;; ── atoms: numbers ──────────────────────────────────────────────── ;; ── atoms: numbers ────────────────────────────────────────────────
(knl-test "num: integer" (kernel-parse "42") 42) (knl-test "num: integer" (kernel-parse "42") 42)
@@ -155,4 +143,4 @@
(kernel-parse "(a 'b c)") (kernel-parse "(a 'b c)")
(list "a" (list "$quote" "b") "c")) (list "a" (list "$quote" "b") "c"))
(define knl-tests-run! (fn () {:total (+ knl-test-pass knl-test-fail) :passed knl-test-pass :failed knl-test-fail :fails knl-test-fails})) (define knl-tests-run! (fn () (refl-test-report knl-suite)))

View File

@@ -5,20 +5,8 @@
;; first-class environment manipulation. Each test starts from a fresh ;; first-class environment manipulation. Each test starts from a fresh
;; standard env via `(kernel-standard-env)`. ;; standard env via `(kernel-standard-env)`.
(define ks-test-pass 0) (define ks-suite (refl-make-test-suite))
(define ks-test-fail 0) (define ks-test (fn (n a e) (refl-test ks-suite n a e)))
(define ks-test-fails (list))
(define
ks-test
(fn
(name actual expected)
(if
(= actual expected)
(set! ks-test-pass (+ ks-test-pass 1))
(begin
(set! ks-test-fail (+ ks-test-fail 1))
(append! ks-test-fails {:name name :actual actual :expected expected})))))
(define (define
ks-eval ks-eval
@@ -442,4 +430,4 @@
(ks-test "reverse: double reverse is identity" (ks-test "reverse: double reverse is identity"
(ks-eval "(reverse (reverse (list 1 2 3)))") (list 1 2 3)) (ks-eval "(reverse (reverse (list 1 2 3)))") (list 1 2 3))
(define ks-tests-run! (fn () {:total (+ ks-test-pass ks-test-fail) :passed ks-test-pass :failed ks-test-fail :fails ks-test-fails})) (define ks-tests-run! (fn () (refl-test-report ks-suite)))

View File

@@ -5,20 +5,8 @@
;; base-env, bind a few helper applicatives (+, *, list, =, $if), and ;; base-env, bind a few helper applicatives (+, *, list, =, $if), and
;; run programs that construct and use custom combiners. ;; run programs that construct and use custom combiners.
(define kv-test-pass 0) (define kv-suite (refl-make-test-suite))
(define kv-test-fail 0) (define kv-test (fn (n a e) (refl-test kv-suite n a e)))
(define kv-test-fails (list))
(define
kv-test
(fn
(name actual expected)
(if
(= actual expected)
(set! kv-test-pass (+ kv-test-pass 1))
(begin
(set! kv-test-fail (+ kv-test-fail 1))
(append! kv-test-fails {:name name :actual actual :expected expected})))))
(define kv-eval-src (fn (src env) (kernel-eval (kernel-parse src) env))) (define kv-eval-src (fn (src env) (kernel-eval (kernel-parse src) env)))
@@ -306,4 +294,4 @@
(kv-test "lambda: zero-arg multi-body" (kv-test "lambda: zero-arg multi-body"
(kv-eval-src "(($lambda () 1 2 3))" (kv-make-env)) 3) (kv-eval-src "(($lambda () 1 2 3))" (kv-make-env)) 3)
(define kv-tests-run! (fn () {:total (+ kv-test-pass kv-test-fail) :passed kv-test-pass :failed kv-test-fail :fails kv-test-fails})) (define kv-tests-run! (fn () (refl-test-report kv-suite)))

View File

@@ -41,6 +41,7 @@ run_sx () {
(load "lib/smalltalk/tokenizer.sx") (load "lib/smalltalk/tokenizer.sx")
(load "lib/smalltalk/parser.sx") (load "lib/smalltalk/parser.sx")
(load "lib/smalltalk/runtime.sx") (load "lib/smalltalk/runtime.sx")
(load "lib/guest/reflective/env.sx")
(load "lib/smalltalk/eval.sx") (load "lib/smalltalk/eval.sx")
(epoch 2) (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\"))") (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? st-class-ref?
(fn (v) (and (dict? v) (has-key? v :type) (= (get v :type) "st-class")))) (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 (define
st-lookup-local st-lookup-local
(fn (fn
(frame name) (frame name)
(cond (let ((src (refl-env-find-frame-with st-frame-cfg frame name)))
((= frame nil) {:found false :value nil :frame nil}) (cond
((has-key? (get frame :locals) name) ((nil? src) {:found false :value nil :frame nil})
{:found true :value (get (get frame :locals) name) :frame frame}) (:else
(else (st-lookup-local (get frame :parent) name))))) {:found true
:value (get (get src :locals) name)
:frame src})))))
;; Walk the frame chain looking for the frame whose self has this ivar. ;; Walk the frame chain looking for the frame whose self has this ivar.
(define (define

View File

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

View File

@@ -69,6 +69,7 @@ for tcl_file in "${TCL_FILES[@]}"; do
(epoch 2) (epoch 2)
(load "lib/tcl/parser.sx") (load "lib/tcl/parser.sx")
(epoch 3) (epoch 3)
(load "lib/guest/reflective/env.sx")
(load "lib/tcl/runtime.sx") (load "lib/tcl/runtime.sx")
(epoch 4) (epoch 4)
(load "$helper") (load "$helper")

View File

@@ -1,25 +1,33 @@
; Tcl-on-SX runtime evaluator ; Tcl-on-SX runtime evaluator
; State: {:frame frame :commands cmd-table :result last-result :output accumulated-output} ; State: {:frame frame :commands cmd-table :result last-result :output accumulated-output}
; Requires lib/fiber.sx to be loaded first (provides make-fiber, fiber-resume, fiber-done?) ; Requires lib/fiber.sx and lib/guest/reflective/env.sx to be loaded first.
;
; Frames keep their Tcl-specific shape ({:level :locals :parent}) but
; route lookup/bind through the shared reflective env kit via the
; adapter cfg below — second consumer for that kit alongside Kernel.
(define make-frame (fn (level parent) {:level level :locals {} :parent parent})) (define make-frame (fn (level parent) {:level level :locals {} :parent parent}))
(define ; Tcl-side adapter for lib/guest/reflective/env.sx. Frames are
frame-lookup ; functionally updated (assoc returns a fresh dict), and lookup-miss
(fn ; returns nil (Tcl convention) — the *-with kit honours both.
(frame name) (define tcl-frame-cfg
(if {:bindings-of (fn (f) (get f :locals))
(nil? frame) :parent-of (fn (f) (get f :parent))
nil :extend (fn (f) (make-frame (+ (get f :level) 1) f))
(let :bind! (fn (f n v) (assoc f :locals (assoc (get f :locals) n v)))
((val (get (get frame :locals) name))) :env? (fn (v)
(if (nil? val) (frame-lookup (get frame :parent) name) val))))) (and (dict? v)
(number? (get v :level))
(dict? (get v :locals))))})
(define (define frame-lookup
frame-set-top (fn (frame name)
(fn (refl-env-lookup-or-nil-with tcl-frame-cfg frame name)))
(frame name val)
(assoc frame :locals (assoc (get frame :locals) name val)))) (define frame-set-top
(fn (frame name val)
(refl-env-bind!-with tcl-frame-cfg frame name val)))
(define make-tcl-interp (fn () {:result "" :output "" :code 0 :errorinfo "" :errorcode "" :frame (make-frame 0 nil) :frame-stack (list) :procs {} :commands {} :current-ns "::" :coro-yield-fn nil})) (define make-tcl-interp (fn () {:result "" :output "" :code 0 :errorinfo "" :errorcode "" :frame (make-frame 0 nil) :frame-stack (list) :procs {} :commands {} :current-ns "::" :coro-yield-fn nil}))

View File

@@ -42,6 +42,7 @@ cat > "$TMPFILE" << EPOCHS
(load "lib/tcl/tests/parse.sx") (load "lib/tcl/tests/parse.sx")
(epoch 4) (epoch 4)
(load "lib/fiber.sx") (load "lib/fiber.sx")
(load "lib/guest/reflective/env.sx")
(load "lib/tcl/runtime.sx") (load "lib/tcl/runtime.sx")
(epoch 5) (epoch 5)
(load "lib/tcl/tests/eval.sx") (load "lib/tcl/tests/eval.sx")

View File

@@ -11,7 +11,7 @@ isolation: worktree
## Prompt ## 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 ## 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. - **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. - **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. - **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. - **Commit granularity:** one feature per commit.
- **Plan file:** update Progress log + tick boxes every commit. - **Plan file:** update Progress log + tick boxes every commit.

View File

@@ -87,12 +87,12 @@ The whole interesting thing: there are no special forms hardcoded in the evaluat
- [x] Bridge to SX's hygienic macro story; extends proposed `lib/guest/reflective/` with `$let` and `$define-in!` hygiene primitives. - [x] Bridge to SX's hygienic macro story; extends proposed `lib/guest/reflective/` with `$let` and `$define-in!` hygiene primitives.
- [x] Tests: write an operative that introduces a binding and verify it doesn't shadow caller's same-named bindings. - [x] Tests: write an operative that introduces a binding and verify it doesn't shadow caller's same-named bindings.
### Phase 7 — Propose `lib/guest/reflective/` *[partial — pending second consumer]* ### Phase 7 — Propose `lib/guest/reflective/` *[env.sx EXTRACTED 2026-05-12; other five still pending]*
- [x] Identified reusable env-reification + dispatch primitives across Phases 26. Consolidated API surface below as four candidate files: `env.sx`, `combiner.sx`, `evaluator.sx`, `hygiene.sx`. - [x] Identified reusable env-reification + dispatch primitives across Phases 26. Consolidated API surface below as four candidate files: `env.sx`, `combiner.sx`, `evaluator.sx`, `hygiene.sx`.
- [ ] Find a second consumer (Common-Lisp's macro-expansion evaluator? a metacircular Scheme variant? a future plan). Until this lands, extraction is blocked by the two-consumer rule. - [x] Second consumer found for **`env.sx`**: Tcl's `uplevel`/`upvar` machinery (`lib/tcl/runtime.sx`). Same scope-chain semantics, divergent only in mutable-vs-functional update — bridged via adapter-cfg pattern from `lib/guest/match.sx`. Extraction landed on branch `lib/tcl/uplevel` (see `plans/lib-guest-reflective.md`).
- [ ] Only extract once two consumers exist (per stratification rule). **Do not extract from this loop** — Kernel is one consumer; we need another before `lib/guest/reflective/` is real. - [ ] Second consumers still needed for `combiner.sx`, `evaluator.sx`, `hygiene.sx`, `quoting.sx`, `short-circuit.sx` — all five wait for a language with operative/applicative semantics (Scheme, CL fexpr extension, Maru).
**Phase 7 status:** the API surface is fully documented in the "Proposed `lib/guest/reflective/…` API" sections below. Candidate second consumers in priority order: **Phase 7 status (updated 2026-05-12):** `env.sx` has been extracted and is live at `lib/guest/reflective/env.sx` on branch `lib/tcl/uplevel`. Both consumers (Kernel and Tcl) pass their full test suites unchanged (Kernel 322/322, Tcl 427/427). The remaining five candidate files stay documented-only until their respective second consumers materialise. Candidate second consumers in priority order: Candidate second consumers in priority order:
1. **A metacircular Scheme** — Scheme can reuse `env.sx` directly (same scope semantics), borrow `evaluator.sx`'s eval/make-env/current-env triple, and pattern-match the `hygiene.sx` story (Scheme has identical lexical scope). Would NOT need `combiner.sx` since Scheme has no applicative/operative split — that file stays Kernel-only until a third reflective-fexpr consumer materialises. 1. **A metacircular Scheme** — Scheme can reuse `env.sx` directly (same scope semantics), borrow `evaluator.sx`'s eval/make-env/current-env triple, and pattern-match the `hygiene.sx` story (Scheme has identical lexical scope). Would NOT need `combiner.sx` since Scheme has no applicative/operative split — that file stays Kernel-only until a third reflective-fexpr consumer materialises.
2. **Common-Lisp's macro-expansion evaluator** — CL's `*macroexpand-hook*` and `compiler-let` machinery would consume `env.sx` (CL package envs map cleanly) and `evaluator.sx` (defmacro = an operative-like fexpr in expander phase). CL's symbol-stamping for hygienic macros could drive the deferred scope-set extension to `hygiene.sx`. 2. **Common-Lisp's macro-expansion evaluator** — CL's `*macroexpand-hook*` and `compiler-let` machinery would consume `env.sx` (CL package envs map cleanly) and `evaluator.sx` (defmacro = an operative-like fexpr in expander phase). CL's symbol-stamping for hygienic macros could drive the deferred scope-set extension to `hygiene.sx`.

View File

@@ -91,21 +91,21 @@ The two consumer migrations:
## Roadmap ## Roadmap
### Phase 1 — Skeleton + Kernel migration ### Phase 1 — Skeleton + Kernel migration *[DONE 2026-05-12]*
- [ ] Create `lib/guest/reflective/env.sx` with the canonical wire shape and mutable defaults. - [x] Create `lib/guest/reflective/env.sx` with the canonical wire shape and mutable defaults.
- [ ] Migrate `lib/kernel/eval.sx` to use `refl-make-env` / `refl-extend-env` / `refl-env-*`. Rename `:knl-tag``:refl-tag` in env values only (operatives/applicatives keep their own tags for now). - [x] Migrate `lib/kernel/eval.sx` to use `refl-make-env` / `refl-extend-env` / `refl-env-*`. Rename `:knl-tag``:refl-tag` in env values only (operatives/applicatives keep their own tags for now).
- [ ] All 322 Kernel tests must stay green. - [x] All 322 Kernel tests stay green.
### Phase 2 — Tcl adapter ### Phase 2 — Tcl adapter *[DONE 2026-05-12]*
- [ ] Add `tcl-frame-cfg` in `lib/tcl/runtime.sx`. Wire it through `frame-lookup` and `tcl-frame-nth` callers via `refl-env-lookup-with`. Keep Tcl's level/locals/parent shape unchanged. - [x] Add `tcl-frame-cfg` in `lib/tcl/runtime.sx`. `frame-lookup` and `frame-set-top` now delegate to `refl-env-lookup-or-nil-with` / `refl-env-bind!-with`. Tcl's `{:level :locals :parent}` shape unchanged.
- [ ] Tcl test suite (must not regress). - [x] Tcl test suite green (427/427).
### Phase 3 — Documentation + cross-reference ### Phase 3 — Documentation + cross-reference *[DONE 2026-05-12]*
- [ ] Update `plans/kernel-on-sx.md` to mark Phase 7's *env.sx* extraction as DONE (one of six). Keep the other five blocked. - [x] Update `plans/kernel-on-sx.md` to mark Phase 7's *env.sx* extraction as DONE (one of six). Other five blocked.
- [ ] Add `lib/guest/reflective/env.sx` header docstring listing both consumers and pointing at this plan. - [x] `lib/guest/reflective/env.sx` header docstring already lists both consumers and links back to this plan.
### Phase 4 — Quick wins identified along the way ### Phase 4 — Quick wins identified along the way
@@ -125,6 +125,18 @@ The extraction is real iff:
2. The shared `env.sx` file is ≥80 LoC (substantial enough to be worth sharing) and ≤200 LoC (small enough that the cfg adapter pattern doesn't become its own framework). 2. The shared `env.sx` file is ≥80 LoC (substantial enough to be worth sharing) and ≤200 LoC (small enough that the cfg adapter pattern doesn't become its own framework).
3. A third consumer in the future can adopt the kit by writing only the cfg dict — no algorithm changes to `env.sx`. 3. A third consumer in the future can adopt the kit by writing only the cfg dict — no algorithm changes to `env.sx`.
## Outcome (2026-05-12)
Three commits on `lib/tcl/uplevel`:
1. Plan committed.
2. **`reflective: extract env.sx + migrate Kernel — 322 tests green`** — kit landed; Kernel's env block collapsed from ~30 lines to 6 thin wrappers (`kernel-env? = refl-env?` etc.). Envs now carry `:refl-tag :env`. All 7 Kernel suites unchanged.
3. **`reflective: Tcl adapter cfg — second consumer wired, 427+322 tests green`** — `tcl-frame-cfg` defined, `frame-lookup`/`frame-set-top` delegate to the kit. Tcl's frame shape unchanged. Functional update preserved.
**File stats:** `lib/guest/reflective/env.sx` is 124 lines, 13 forms. Within the 80200 LoC validation bound. Adapter-cfg pattern proven to bridge mutable-canonical (Kernel) and functional-frame (Tcl) wire shapes via a single ~7-line cfg dict per consumer.
**Third-consumer test:** any future guest can adopt the kit by writing its own cfg with five keys (`:bindings-of`, `:parent-of`, `:extend`, `:bind!`, `:env?`) — no changes to `env.sx`. The shape-divergence problem is solved by parameterisation, not by forcing both consumers onto one wire shape.
## References ## References
- `plans/kernel-on-sx.md` — the kernel-on-sx loop's chisel notes; the six candidate API surfaces are documented there. - `plans/kernel-on-sx.md` — the kernel-on-sx loop's chisel notes; the six candidate API surfaces are documented there.

View File

@@ -0,0 +1,83 @@
# lib/guest/test-runner.sx — extraction plan
## Status
- [x] **Phase 1 — Kit + Kernel.** `lib/guest/test-runner.sx` extracted (5 forms, ~50 LoC). Seven Kernel test files migrated (`parse.sx`, `eval.sx`, `vau.sx`, `standard.sx`, `encap.sx`, `hygiene.sx`, `metacircular.sx`). 322/322 tests unchanged. 84 LoC removed.
- [ ] **Phase 2 — Per-guest migrations.** 35 additional test files match the standard `(define X-test-pass 0)` pattern across 7 guests; each needs the test runner's `(load "lib/guest/test-runner.sx")` line and a per-file harness rewrite. Variant shapes (Tcl, Smalltalk, APL alternate) need *different* extraction targets.
## The kit
```lisp
(refl-make-test-suite) {:pass 0 :fail 0 :fails (list)}
(refl-test SUITE NAME ACT EXP) mutates suite (dict-set! + append!)
(refl-test-report SUITE) {:total :passed :failed :fails}
(refl-test-pass? SUITE) bool
(refl-test-suite? V) predicate
```
Each migrated test file collapses from a 14-line harness boilerplate to:
```lisp
(define X-suite (refl-make-test-suite))
(define X-test (fn (n a e) (refl-test X-suite n a e)))
;; ... tests ...
(define X-tests-run! (fn () (refl-test-report X-suite)))
```
## Per-guest migration status
| Guest | Std-pattern files | Variant? | Migration commit |
|--------------|------------------:|---------------------|------------------|
| kernel | 7 | - | landed (Phase 1) |
| prolog | 23 | - | pending |
| common-lisp | 4 | - | pending |
| erlang | 4 | sub-prefix per file | pending |
| apl | 1 | uses `set!` over `append`, args are `got expected` | needs variant adapter |
| forth | 1 | - | pending |
| minikanren | 1 | - | pending |
| ruby | 1 | - | pending |
| tcl | 0 (uses different shape — see below) | `tcl-X-pass/-failures`, append! a STRING | needs variant kit |
| smalltalk | 0 (uses SUnit) | own framework | not applicable |
| haskell, hyperscript, js, lua | 0 | no per-suite harness | not applicable |
## Variant shapes that need their own extractions
### Tcl-flavour (`lib/tcl/tests/*.sx`)
```lisp
(define tcl-X-pass 0)
(define tcl-X-fail 0)
(define tcl-X-failures (list)) ; not -fails
(define tcl-assert
(fn (label expected actual) ; arg order: label, expected, actual
(if (= expected actual)
(set! tcl-X-pass (+ tcl-X-pass 1))
(begin (set! tcl-X-fail (+ tcl-X-fail 1))
(append! tcl-X-failures
(str label ": expected=" (str expected) " got=" (str actual)))))))
```
Difference from canonical: failures hold formatted *strings*, not dicts. Could be unified by passing a formatter cfg, but the API divergence is real (Tcl's report just lists strings; the kit's `:fails` holds dicts). Either:
- Add `refl-make-string-formatting-test-suite` variant, or
- Migrate Tcl's reports to dict-of-name-expected-actual (preferred — converges the shape).
### APL-flavour
```lisp
(define apl-test
(fn (name got expected) ; arg order: name, got, expected
(if (= got expected) ...
(set! apl-test-fails (append apl-test-fails (list {:got got :expected expected :name name}))))))
```
Difference: uses functional `append`, not `append!`. Argument order: `got expected`, not `actual expected`. Minor; renaming `n a e` in the kit call site to `n got expected` is the only change.
## Migration playbook (for the loop that finishes Phase 2)
1. Pick a guest from the table.
2. Run `/tmp/migrate_harness.py lib/<guest>/tests/*.sx`. SKIP entries are variant-shaped; ignore them or hand-migrate.
3. Add `(load "lib/guest/test-runner.sx")` to that guest's `test.sh` and `conformance.sh` (before the first guest .sx load that uses the harness).
4. Run the guest's full test suite; counts should be unchanged.
5. Commit `test-runner: migrate <guest> — N files, NN LoC saved`.
Estimated effort: 12 hours per guest, dominated by verification time. Prolog (23 files) is the biggest single commit but the most mechanical.