coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

smalltalk: cannotReturn: stale-block detection + 5 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source
This commit is contained in:
giles
2026-04-25 05:11:14 +00:00
parent c7d0801850
commit c444bbe256
3 changed files with 188 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

141
lib/smalltalk/eval.sx
View File

@@ -17,12 +17,18 @@
(define
st-make-frame
(fn
(self method-class parent return-k)
(self method-class parent return-k active-cell)
{:self self
:method-class method-class
:locals {}
:parent parent
:return-k return-k}))
:return-k return-k
;; A small mutable dict shared between the method-frame and any
;; block created in its scope. While the method is on the stack
;; :active is true; once st-invoke finishes (normally or via the
;; captured ^k) it flips to false. ^expr from a block whose
;; active-cell is dead raises cannotReturn:.
:active-cell active-cell}))
(define
st-make-block
@@ -35,7 +41,10 @@
:env frame
;; capture the creating method's return continuation so that `^expr`
;; from inside this block always returns from that method
:return-k (if (= frame nil) nil (get frame :return-k))}))
:return-k (if (= frame nil) nil (get frame :return-k))
;; Pair the captured ^k with the active-cell — invoking ^k after
;; the originating method has returned must raise cannotReturn:.
:active-cell (if (= frame nil) nil (get frame :active-cell))}))
(define
st-block?
@@ -153,10 +162,19 @@
(st-assign! frame (get ast :name) (smalltalk-eval-ast (get ast :expr) frame)))
((= ty "return")
(let ((v (smalltalk-eval-ast (get ast :expr) frame)))
(let ((k (get frame :return-k)))
(let
((k (get frame :return-k))
(cell (get frame :active-cell)))
(cond
((= k nil)
(error "smalltalk-eval-ast: return outside method context"))
((and (not (= cell nil))
(not (get cell :active)))
(error
(str
"BlockContext>>cannotReturn: — ^expr after the "
"creating method has already returned (value was "
v ")")))
(else (k v))))))
((= ty "block") (st-make-block ast frame))
((= ty "seq") (st-eval-seq (get ast :exprs) frame))
@@ -340,35 +358,43 @@
(get method :selector)
" expected " (len params) " got " (len args))))
(else
(call/cc
(fn (k)
(let ((frame (st-make-frame receiver defining-class nil k)))
(begin
;; Bind params
(let ((i 0))
(begin
(define
pb-loop
(fn
()
(when
(< i (len params))
(begin
(dict-set!
(get frame :locals)
(nth params i)
(nth args i))
(set! i (+ i 1))
(pb-loop)))))
(pb-loop)))
;; Bind temps to nil
(for-each
(fn (t) (dict-set! (get frame :locals) t nil))
temps)
;; Execute body. If body finishes without ^, the implicit
;; return value in Smalltalk is `self` — match that.
(st-eval-seq body frame)
receiver)))))))))
(let ((cell {:active true}))
(let
((result
(call/cc
(fn (k)
(let ((frame (st-make-frame receiver defining-class nil k cell)))
(begin
;; Bind params
(let ((i 0))
(begin
(define
pb-loop
(fn
()
(when
(< i (len params))
(begin
(dict-set!
(get frame :locals)
(nth params i)
(nth args i))
(set! i (+ i 1))
(pb-loop)))))
(pb-loop)))
;; Bind temps to nil
(for-each
(fn (t) (dict-set! (get frame :locals) t nil))
temps)
;; Execute body. If body finishes without ^, the implicit
;; return value in Smalltalk is `self` — match that.
(st-eval-seq body frame)
receiver))))))
(begin
;; Method invocation is finished — flip the cell so any block
;; that captured this method's ^k can no longer return.
(dict-set! cell :active false)
result))))))))
;; ── Block dispatch ─────────────────────────────────────────────────────
(define
@@ -423,7 +449,11 @@
env
;; Use the block's captured ^k so `^expr` returns from
;; the *creating* method, not whoever invoked the block.
(get block :return-k))))
(get block :return-k)
;; Same active-cell as the creating method's frame; if
;; the method has returned, ^expr through this frame
;; raises cannotReturn:.
(get block :active-cell))))
(begin
(let ((i 0))
(begin
@@ -694,26 +724,35 @@
smalltalk-eval
(fn
(src)
(call/cc
(fn (k)
(let
((ast (st-parse-expr src))
(frame (st-make-frame nil nil nil k)))
(smalltalk-eval-ast ast frame))))))
(let ((cell {:active true}))
(let
((result
(call/cc
(fn (k)
(let
((ast (st-parse-expr src))
(frame (st-make-frame nil nil nil k cell)))
(smalltalk-eval-ast ast frame))))))
(begin (dict-set! cell :active false) result)))))
;; Evaluate a sequence of statements at the top level.
(define
smalltalk-eval-program
(fn
(src)
(call/cc
(fn (k)
(let
((ast (st-parse src)) (frame (st-make-frame nil nil nil k)))
(begin
(when
(and (dict? ast) (has-key? ast :temps))
(for-each
(fn (t) (dict-set! (get frame :locals) t nil))
(get ast :temps)))
(smalltalk-eval-ast ast frame)))))))
(let ((cell {:active true}))
(let
((result
(call/cc
(fn (k)
(let
((ast (st-parse src))
(frame (st-make-frame nil nil nil k cell)))
(begin
(when
(and (dict? ast) (has-key? ast :temps))
(for-each
(fn (t) (dict-set! (get frame :locals) t nil))
(get ast :temps)))
(smalltalk-eval-ast ast frame)))))))
(begin (dict-set! cell :active false) result)))))