scheme: Phase 5c — dynamic-wind (basic, no call/cc tracking) + 5 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s

(dynamic-wind BEFORE THUNK AFTER)
  - Calls BEFORE; runs THUNK; calls AFTER; returns THUNK's value.
  - If THUNK raises, AFTER still runs before the raise propagates.
  - Implementation: outcome-sentinel pattern (same trick as guard
    and with-exception-handler) — catch THUNK's raise inside a
    host guard, run AFTER unconditionally, then either return the
    value or re-raise outside the catch.

Not implemented: call/cc-escape tracking. R7RS specifies that
dynamic-wind's BEFORE and AFTER thunks should re-run when control
re-enters or exits the dynamic extent via continuations. That
requires explicit dynamic-extent stack tracking, deferred until
a consumer needs it (probably never needed for pure-eval Scheme
programs; matters for first-class-continuation-heavy code).

5 tests: success ordering, return value, after-on-raise,
raise propagation, nested wind.

237 total Scheme tests now (62 + 23 + 49 + 78 + 25).
This commit is contained in:
2026-05-14 06:37:51 +00:00
parent 55c376f559
commit a90f56e3f3
2 changed files with 79 additions and 0 deletions

View File

@@ -586,4 +586,30 @@
((and (dict? outcome) (get outcome :scm-weh-raised))
(scheme-apply handler (list (get outcome :value))))
(:else outcome))))))))
;; dynamic-wind BEFORE THUNK AFTER — runs BEFORE, then THUNK,
;; then AFTER. If THUNK raises, AFTER still runs before the
;; raise propagates. This is the basic-correctness version;
;; proper call/cc-escape interaction would need dynamic-extent
;; tracking, deferred until needed.
(scheme-env-bind! env "dynamic-wind"
(fn (args)
(cond
((not (= (length args) 3))
(error "dynamic-wind: expects (before thunk after)"))
(:else
(let ((before-thunk (first args))
(mid-thunk (nth args 1))
(after-thunk (nth args 2)))
(begin
(scheme-apply before-thunk (list))
(let ((outcome
(guard
(e (true {:scm-dw-raised true :value e}))
(scheme-apply mid-thunk (list)))))
(begin
(scheme-apply after-thunk (list))
(cond
((and (dict? outcome) (get outcome :scm-dw-raised))
(raise (get outcome :value)))
(:else outcome))))))))))
env)))