Compare commits
5 Commits
2e7e3141d4
...
lib/smallt
| Author | SHA1 | Date | |
|---|---|---|---|
| 9efbf4ad38 | |||
| 4e904a2782 | |||
| c27db9b78f | |||
| 39381fda92 | |||
| 6fa0cdeedc |
@@ -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.
|
||||||
|
|||||||
@@ -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\"))")
|
||||||
|
|||||||
@@ -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
|
||||||
|
|||||||
@@ -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")
|
||||||
|
|||||||
@@ -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")
|
||||||
|
|||||||
@@ -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}))
|
||||||
|
|
||||||
|
|||||||
@@ -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")
|
||||||
|
|||||||
@@ -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.
|
||||||
|
|
||||||
|
|||||||
@@ -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 2–6. 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 2–6. 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`.
|
||||||
|
|||||||
@@ -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 80–200 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.
|
||||||
|
|||||||
Reference in New Issue
Block a user