Compare commits
3 Commits
lib/tcl/up
...
lib/smallt
| Author | SHA1 | Date | |
|---|---|---|---|
| 9efbf4ad38 | |||
| 4e904a2782 | |||
| 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")
|
||||||
|
|||||||
@@ -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.
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user