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

spec: dynamic-wind — after-thunk fires on normal return, raise, and call/cc escape

Browse Source 
- Add make-wind-after-frame / make-wind-return-frame CEK frame types
- Add *winders* global stack tracking active after-thunks
- Add kont-unwind-to-handler (replaces kont-find-handler in raise-eval) — calls
  after-thunks for wind frames encountered while unwinding to handler
- Add wind-escape-to — pops and calls after-thunks down to captured winders-len
- Replace sf-dynamic-wind with step-sf-dynamic-wind (full CEK dispatch)
- Fix "callcc" frame: store winders-len in continuation object
- Fix callcc-continuation? case: call wind-escape-to before escape
- JS platform: extend SxCallccContinuation to store windersLen; add
  callcc-continuation-winders-len accessor
- 8 tests: normal return, raise escape, call/cc escape, nested LIFO, guard ordering
- 1948/2500 (was 1940); zero regressions

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-26 14:19:17 +00:00
parent 0577f245e2
commit a9d5a1082f
4 changed files with 270 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
hosts/javascript/platform.py
View File

@@ -929,11 +929,12 @@ PREAMBLE = '''\
function parameterUid(p) { return p._uid; }
function parameterDefault(p) { return p._default; }
function SxCallccContinuation(capturedKont) { this._captured = capturedKont; }
function SxCallccContinuation(capturedKont, windersLen) { this._captured = capturedKont; this._winders_len = windersLen !== undefined ? windersLen : 0; }
SxCallccContinuation.prototype._callcc = true;
function makeCallccContinuation(kont) { return new SxCallccContinuation(kont); }
function makeCallccContinuation(kont, windersLen) { return new SxCallccContinuation(kont, windersLen !== undefined ? windersLen : 0); }
function callccContinuation_p(x) { return x != null && x._callcc === true; }
function callccContinuationData(x) { return x._captured; }
function callccContinuationWindersLen(x) { return x._winders_len !== undefined ? x._winders_len : 0; }
function evalError_p(v) {
return v != null && typeof v === "object" && v["__eval_error__"] === true;

72
shared/static/scripts/sx-browser.js
View File

@@ -31,7 +31,7 @@
// =========================================================================
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
var SX_VERSION = "2026-04-26T12:42:00Z";
var SX_VERSION = "2026-04-26T14:13:13Z";
function isNil(x) { return x === NIL || x === null || x === undefined; }
function isSxTruthy(x) { return x !== false && !isNil(x); }
@@ -103,11 +103,12 @@
function parameterUid(p) { return p._uid; }
function parameterDefault(p) { return p._default; }
function SxCallccContinuation(capturedKont) { this._captured = capturedKont; }
function SxCallccContinuation(capturedKont, windersLen) { this._captured = capturedKont; this._winders_len = windersLen !== undefined ? windersLen : 0; }
SxCallccContinuation.prototype._callcc = true;
function makeCallccContinuation(kont) { return new SxCallccContinuation(kont); }
function makeCallccContinuation(kont, windersLen) { return new SxCallccContinuation(kont, windersLen !== undefined ? windersLen : 0); }
function callccContinuation_p(x) { return x != null && x._callcc === true; }
function callccContinuationData(x) { return x._captured; }
function callccContinuationWindersLen(x) { return x._winders_len !== undefined ? x._winders_len : 0; }
function evalError_p(v) {
return v != null && typeof v === "object" && v["__eval_error__"] === true;
@@ -1257,6 +1258,14 @@ PRIMITIVES["make-reactive-reset-frame"] = makeReactiveResetFrame;
var makeCallccFrame = function(env) { return {"env": env, "type": "callcc"}; };
PRIMITIVES["make-callcc-frame"] = makeCallccFrame;
// make-wind-after-frame
var makeWindAfterFrame = function(afterThunk, windersLen, env) { return {"winders-len": windersLen, "env": env, "after-thunk": afterThunk, "type": "wind-after"}; };
PRIMITIVES["make-wind-after-frame"] = makeWindAfterFrame;
// make-wind-return-frame
var makeWindReturnFrame = function(bodyResult, env) { return {"body-result": bodyResult, "env": env, "type": "wind-return"}; };
PRIMITIVES["make-wind-return-frame"] = makeWindReturnFrame;
// make-deref-frame
var makeDerefFrame = function(env) { return {"env": env, "type": "deref"}; };
PRIMITIVES["make-deref-frame"] = makeDerefFrame;
@@ -1333,6 +1342,26 @@ PRIMITIVES["find-matching-handler"] = findMatchingHandler;
})()); };
PRIMITIVES["kont-find-handler"] = kontFindHandler;
// kont-unwind-to-handler
var kontUnwindToHandler = function(kont, condition) { return (isSxTruthy(isEmpty(kont)) ? {"handler": NIL, "kont": kont} : (function() {
var frame = first(kont);
var restK = rest(kont);
return (isSxTruthy(sxEq(frameType(frame), "handler")) ? (function() {
var match = findMatchingHandler(get(frame, "f"), condition);
return (isSxTruthy(isNil(match)) ? kontUnwindToHandler(restK, condition) : {"handler": match, "kont": kont});
})() : (isSxTruthy(sxEq(frameType(frame), "wind-after")) ? ((isSxTruthy((len(_winders_) > get(frame, "winders-len"))) ? (_winders_ = rest(_winders_)) : NIL), cekCall(get(frame, "after-thunk"), []), kontUnwindToHandler(restK, condition)) : kontUnwindToHandler(restK, condition)));
})()); };
PRIMITIVES["kont-unwind-to-handler"] = kontUnwindToHandler;
// wind-escape-to
var windEscapeTo = function(targetLen) { return (isSxTruthy((len(_winders_) > targetLen)) ? (function() {
var afterThunk = first(_winders_);
_winders_ = rest(_winders_);
cekCall(afterThunk, []);
return windEscapeTo(targetLen);
})() : NIL); };
PRIMITIVES["wind-escape-to"] = windEscapeTo;
// find-named-restart
var findNamedRestart = function(restarts, name) { return (isSxTruthy(isEmpty(restarts)) ? NIL : (function() {
var entry = first(restarts);
@@ -1445,6 +1474,10 @@ PRIMITIVES["*provide-batch-queue*"] = _provideBatchQueue_;
var _provideSubscribers_ = {};
PRIMITIVES["*provide-subscribers*"] = _provideSubscribers_;
// *winders*
var _winders_ = [];
PRIMITIVES["*winders*"] = _winders_;
// *library-registry*
var _libraryRegistry_ = {};
PRIMITIVES["*library-registry*"] = _libraryRegistry_;
@@ -1950,14 +1983,18 @@ PRIMITIVES["sf-letrec"] = sfLetrec;
})(); };
PRIMITIVES["step-sf-letrec"] = stepSfLetrec;
// sf-dynamic-wind
var sfDynamicWind = function(args, env) { return (function() {
// step-sf-dynamic-wind
var stepSfDynamicWind = function(args, env, kont) { return (function() {
var before = trampoline(evalExpr(first(args), env));
var body = trampoline(evalExpr(nth(args, 1), env));
var after = trampoline(evalExpr(nth(args, 2), env));
return dynamicWindCall(before, body, after, env);
return (cekCall(before, []), (function() {
var windersLen = len(_winders_);
_winders_ = cons(after, _winders_);
return continueWithCall(body, [], env, [], kontPush(makeWindAfterFrame(after, windersLen, env), kont));
})());
})(); };
PRIMITIVES["sf-dynamic-wind"] = sfDynamicWind;
PRIMITIVES["step-sf-dynamic-wind"] = stepSfDynamicWind;
// sf-scope
var sfScope = function(args, env) { return (function() {
@@ -2099,7 +2136,7 @@ PRIMITIVES["step-sf-let-match"] = stepSfLetMatch;
var test = first(testClause);
var result = rest(testClause);
return stepEvalList(cons(new Symbol("let"), cons(new Symbol("__do-loop"), cons(map(function(b) { return [first(b), nth(b, 1)]; }, bindings), [cons(new Symbol("if"), cons(test, cons((isSxTruthy(isEmpty(result)) ? NIL : cons(new Symbol("begin"), result)), [cons(new Symbol("begin"), append(body, [cons(new Symbol("__do-loop"), steps)]))])))]))), env, kont);
})() : stepSfBegin(args, env, kont)); if (_m == "guard") return stepSfGuard(args, env, kont); if (_m == "quote") return makeCekValue((isSxTruthy(isEmpty(args)) ? NIL : first(args)), env, kont); if (_m == "quasiquote") return makeCekValue(qqExpand(first(args), env), env, kont); if (_m == "->") return stepSfThreadFirst(args, env, kont); if (_m == "->>") return stepSfThreadLast(args, env, kont); if (_m == "|>") return stepSfThreadLast(args, env, kont); if (_m == "as->") return stepSfThreadAs(args, env, kont); if (_m == "set!") return stepSfSet(args, env, kont); if (_m == "letrec") return stepSfLetrec(args, env, kont); if (_m == "reset") return stepSfReset(args, env, kont); if (_m == "shift") return stepSfShift(args, env, kont); if (_m == "deref") return stepSfDeref(args, env, kont); if (_m == "scope") return stepSfScope(args, env, kont); if (_m == "provide") return stepSfProvide(args, env, kont); if (_m == "peek") return stepSfPeek(args, env, kont); if (_m == "provide!") return stepSfProvide_b(args, env, kont); if (_m == "context") return stepSfContext(args, env, kont); if (_m == "bind") return stepSfBind(args, env, kont); if (_m == "emit!") return stepSfEmit(args, env, kont); if (_m == "emitted") return stepSfEmitted(args, env, kont); if (_m == "handler-bind") return stepSfHandlerBind(args, env, kont); if (_m == "restart-case") return stepSfRestartCase(args, env, kont); if (_m == "signal-condition") return stepSfSignal(args, env, kont); if (_m == "invoke-restart") return stepSfInvokeRestart(args, env, kont); if (_m == "match") return stepSfMatch(args, env, kont); if (_m == "let-match") return stepSfLetMatch(args, env, kont); if (_m == "dynamic-wind") return makeCekValue(sfDynamicWind(args, env), env, kont); if (_m == "map") return stepHoMap(args, env, kont); if (_m == "map-indexed") return stepHoMapIndexed(args, env, kont); if (_m == "filter") return stepHoFilter(args, env, kont); if (_m == "reduce") return stepHoReduce(args, env, kont); if (_m == "some") return stepHoSome(args, env, kont); if (_m == "every?") return stepHoEvery(args, env, kont); if (_m == "for-each") return stepHoForEach(args, env, kont); if (_m == "raise") return stepSfRaise(args, env, kont); if (_m == "raise-continuable") return makeCekState(first(args), env, kontPush(makeRaiseEvalFrame(env, true), kont)); if (_m == "call/cc") return stepSfCallcc(args, env, kont); if (_m == "call-with-current-continuation") return stepSfCallcc(args, env, kont); if (_m == "perform") return stepSfPerform(args, env, kont); if (_m == "define-library") return stepSfDefineLibrary(args, env, kont); if (_m == "import") return stepSfImport(args, env, kont); if (_m == "define-record-type") return makeCekValue(sfDefineRecordType(args, env), env, kont); if (_m == "define-protocol") return makeCekValue(sfDefineProtocol(args, env), env, kont); if (_m == "implement") return makeCekValue(sfImplement(args, env), env, kont); if (_m == "parameterize") return stepSfParameterize(args, env, kont); if (_m == "syntax-rules") return makeCekValue(sfSyntaxRules(args, env), env, kont); if (_m == "define-syntax") return stepSfDefine(args, env, kont); return (isSxTruthy((isSxTruthy(dictHas(_customSpecialForms, name)) && !isSxTruthy(envHas(env, name)))) ? makeCekValue((get(_customSpecialForms, name))(args, env), env, kont) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? (function() {
})() : stepSfBegin(args, env, kont)); if (_m == "guard") return stepSfGuard(args, env, kont); if (_m == "quote") return makeCekValue((isSxTruthy(isEmpty(args)) ? NIL : first(args)), env, kont); if (_m == "quasiquote") return makeCekValue(qqExpand(first(args), env), env, kont); if (_m == "->") return stepSfThreadFirst(args, env, kont); if (_m == "->>") return stepSfThreadLast(args, env, kont); if (_m == "|>") return stepSfThreadLast(args, env, kont); if (_m == "as->") return stepSfThreadAs(args, env, kont); if (_m == "set!") return stepSfSet(args, env, kont); if (_m == "letrec") return stepSfLetrec(args, env, kont); if (_m == "reset") return stepSfReset(args, env, kont); if (_m == "shift") return stepSfShift(args, env, kont); if (_m == "deref") return stepSfDeref(args, env, kont); if (_m == "scope") return stepSfScope(args, env, kont); if (_m == "provide") return stepSfProvide(args, env, kont); if (_m == "peek") return stepSfPeek(args, env, kont); if (_m == "provide!") return stepSfProvide_b(args, env, kont); if (_m == "context") return stepSfContext(args, env, kont); if (_m == "bind") return stepSfBind(args, env, kont); if (_m == "emit!") return stepSfEmit(args, env, kont); if (_m == "emitted") return stepSfEmitted(args, env, kont); if (_m == "handler-bind") return stepSfHandlerBind(args, env, kont); if (_m == "restart-case") return stepSfRestartCase(args, env, kont); if (_m == "signal-condition") return stepSfSignal(args, env, kont); if (_m == "invoke-restart") return stepSfInvokeRestart(args, env, kont); if (_m == "match") return stepSfMatch(args, env, kont); if (_m == "let-match") return stepSfLetMatch(args, env, kont); if (_m == "dynamic-wind") return stepSfDynamicWind(args, env, kont); if (_m == "map") return stepHoMap(args, env, kont); if (_m == "map-indexed") return stepHoMapIndexed(args, env, kont); if (_m == "filter") return stepHoFilter(args, env, kont); if (_m == "reduce") return stepHoReduce(args, env, kont); if (_m == "some") return stepHoSome(args, env, kont); if (_m == "every?") return stepHoEvery(args, env, kont); if (_m == "for-each") return stepHoForEach(args, env, kont); if (_m == "raise") return stepSfRaise(args, env, kont); if (_m == "raise-continuable") return makeCekState(first(args), env, kontPush(makeRaiseEvalFrame(env, true), kont)); if (_m == "call/cc") return stepSfCallcc(args, env, kont); if (_m == "call-with-current-continuation") return stepSfCallcc(args, env, kont); if (_m == "perform") return stepSfPerform(args, env, kont); if (_m == "define-library") return stepSfDefineLibrary(args, env, kont); if (_m == "import") return stepSfImport(args, env, kont); if (_m == "define-record-type") return makeCekValue(sfDefineRecordType(args, env), env, kont); if (_m == "define-protocol") return makeCekValue(sfDefineProtocol(args, env), env, kont); if (_m == "implement") return makeCekValue(sfImplement(args, env), env, kont); if (_m == "parameterize") return stepSfParameterize(args, env, kont); if (_m == "syntax-rules") return makeCekValue(sfSyntaxRules(args, env), env, kont); if (_m == "define-syntax") return stepSfDefine(args, env, kont); return (isSxTruthy((isSxTruthy(dictHas(_customSpecialForms, name)) && !isSxTruthy(envHas(env, name)))) ? makeCekValue((get(_customSpecialForms, name))(args, env), env, kont) : (isSxTruthy((isSxTruthy(envHas(env, name)) && isMacro(envGet(env, name)))) ? (function() {
var mac = envGet(env, name);
return makeCekState(expandMacro(mac, args, env), env, kont);
})() : (isSxTruthy((isSxTruthy(_renderCheck) && isSxTruthy(!isSxTruthy(envHas(env, name))) && _renderCheck(expr, env))) ? makeCekValue(_renderFn(expr, env), env, kont) : stepEvalCall(head, args, env, kont)))); })();
@@ -3142,12 +3179,20 @@ PRIMITIVES["step-ho-for-each"] = stepHoForEach;
var testValue = get(frame, "match-val");
var fenv = get(frame, "env");
return continueWithCall(value, [testValue], fenv, [testValue], restK);
})(); if (_m == "raise-eval") return (function() {
})(); if (_m == "wind-after") return (function() {
var afterThunk = get(frame, "after-thunk");
var windersLen = get(frame, "winders-len");
var bodyResult = value;
var fenv = get(frame, "env");
return ((isSxTruthy((len(_winders_) > windersLen)) ? (_winders_ = rest(_winders_)) : NIL), continueWithCall(afterThunk, [], fenv, [], kontPush(makeWindReturnFrame(bodyResult, fenv), restK)));
})(); if (_m == "wind-return") return makeCekValue(get(frame, "body-result"), get(frame, "env"), restK); if (_m == "raise-eval") return (function() {
var condition = value;
var fenv = get(frame, "env");
var continuable_p = get(frame, "scheme");
var handlerFn = kontFindHandler(restK, condition);
return (isSxTruthy(isNil(handlerFn)) ? ((_lastErrorKont_ = restK), hostError((String("Unhandled exception: ") + String(inspect(condition))))) : continueWithCall(handlerFn, [condition], fenv, [condition], (isSxTruthy(continuable_p) ? kontPush(makeSignalReturnFrame(fenv, restK), restK) : kontPush(makeRaiseGuardFrame(fenv, restK), restK))));
var unwindResult = kontUnwindToHandler(restK, condition);
var handlerFn = get(unwindResult, "handler");
var unwoundK = get(unwindResult, "kont");
return (isSxTruthy(isNil(handlerFn)) ? ((_lastErrorKont_ = unwoundK), hostError((String("Unhandled exception: ") + String(inspect(condition))))) : continueWithCall(handlerFn, [condition], fenv, [condition], (isSxTruthy(continuable_p) ? kontPush(makeSignalReturnFrame(fenv, unwoundK), unwoundK) : kontPush(makeRaiseGuardFrame(fenv, unwoundK), unwoundK))));
})(); if (_m == "raise-guard") return ((_lastErrorKont_ = restK), hostError("exception handler returned from non-continuable raise")); if (_m == "multi-map") return (function() {
var f = get(frame, "f");
var remaining = get(frame, "remaining");
@@ -3159,7 +3204,7 @@ PRIMITIVES["step-ho-for-each"] = stepHoForEach;
return continueWithCall(f, heads, fenv, [], kontPush(makeMultiMapFrame(f, tails, newResults, fenv), restK));
})());
})(); if (_m == "callcc") return (function() {
var k = makeCallccContinuation(restK);
var k = makeCallccContinuation(restK, len(_winders_));
return continueWithCall(value, [k], get(frame, "env"), [k], restK);
})(); if (_m == "vm-resume") return (function() {
var resumeFn = get(frame, "f");
@@ -3205,7 +3250,8 @@ PRIMITIVES["step-continue"] = stepContinue;
})() : (isSxTruthy(callccContinuation_p(f)) ? (function() {
var arg = (isSxTruthy(isEmpty(args)) ? NIL : first(args));
var captured = callccContinuationData(f);
return makeCekValue(arg, env, captured);
var wLen = callccContinuationWindersLen(f);
return (windEscapeTo(wLen), makeCekValue(arg, env, captured));
})() : (isSxTruthy(continuation_p(f)) ? (function() {
var arg = (isSxTruthy(isEmpty(args)) ? NIL : first(args));
var contData = continuationData(f);

108
spec/evaluator.sx
View File

@@ -142,6 +142,16 @@
(define make-callcc-frame (fn (env) {:env env :type "callcc"}))
(define
make-wind-after-frame
(fn (after-thunk winders-len env)
{:type "wind-after" :after-thunk after-thunk :winders-len winders-len :env env}))
(define
make-wind-return-frame
(fn (body-result env)
{:type "wind-return" :body-result body-result :env env}))
;; R7RS exception frames (raise, guard)
(define make-deref-frame (fn (env) {:env env :type "deref"}))
@@ -228,6 +238,44 @@
match))
(kont-find-handler (rest kont) condition))))))
(define
kont-unwind-to-handler
(fn (kont condition)
(if
(empty? kont)
{:handler nil :kont kont}
(let
((frame (first kont)) (rest-k (rest kont)))
(cond
(= (frame-type frame) "handler")
(let
((match (find-matching-handler (get frame "f") condition)))
(if
(nil? match)
(kont-unwind-to-handler rest-k condition)
{:handler match :kont kont}))
(= (frame-type frame) "wind-after")
(do
(when
(> (len *winders*) (get frame "winders-len"))
(set! *winders* (rest *winders*)))
(cek-call (get frame "after-thunk") (list))
(kont-unwind-to-handler rest-k condition))
:else
(kont-unwind-to-handler rest-k condition))))))
(define
wind-escape-to
(fn
(target-len)
(when
(> (len *winders*) target-len)
(let
((after-thunk (first *winders*)))
(set! *winders* (rest *winders*))
(cek-call after-thunk (list))
(wind-escape-to target-len)))))
(define
find-named-restart
(fn
@@ -410,6 +458,8 @@
(define *provide-subscribers* (dict))
(define *winders* (list))
(define *library-registry* (dict))
(define
@@ -1343,14 +1393,24 @@
(make-cek-state (thunk-expr thk) (thunk-env thk) kont))))
(define
sf-dynamic-wind
step-sf-dynamic-wind
(fn
((args :as list) (env :as dict))
(args env kont)
(let
((before (trampoline (eval-expr (first args) env)))
(body (trampoline (eval-expr (nth args 1) env)))
(after (trampoline (eval-expr (nth args 2) env))))
(dynamic-wind-call before body after env))))
(do
(cek-call before (list))
(let
((winders-len (len *winders*)))
(set! *winders* (cons after *winders*))
(continue-with-call
body
(list)
env
(list)
(kont-push (make-wind-after-frame after winders-len env) kont)))))))
;; R7RS records (SRFI-9)
;;
@@ -1788,8 +1848,7 @@
("invoke-restart" (step-sf-invoke-restart args env kont))
("match" (step-sf-match args env kont))
("let-match" (step-sf-let-match args env kont))
("dynamic-wind"
(make-cek-value (sf-dynamic-wind args env) env kont))
("dynamic-wind" (step-sf-dynamic-wind args env kont))
("map" (step-ho-map args env kont))
("map-indexed" (step-ho-map-indexed args env kont))
("filter" (step-ho-filter args env kont))
@@ -4082,16 +4141,36 @@
fenv
(list test-value)
rest-k)))
("wind-after"
(let
((after-thunk (get frame "after-thunk"))
(winders-len (get frame "winders-len"))
(body-result value)
(fenv (get frame "env")))
(do
(when
(> (len *winders*) winders-len)
(set! *winders* (rest *winders*)))
(continue-with-call
after-thunk
(list)
fenv
(list)
(kont-push (make-wind-return-frame body-result fenv) rest-k)))))
("wind-return"
(make-cek-value (get frame "body-result") (get frame "env") rest-k))
("raise-eval"
(let
((condition value)
(fenv (get frame "env"))
(continuable? (get frame "scheme"))
(handler-fn (kont-find-handler rest-k condition)))
(unwind-result (kont-unwind-to-handler rest-k condition))
(handler-fn (get unwind-result "handler"))
(unwound-k (get unwind-result "kont")))
(if
(nil? handler-fn)
(do
(set! *last-error-kont* rest-k)
(set! *last-error-kont* unwound-k)
(host-error
(str "Unhandled exception: " (inspect condition))))
(continue-with-call
@@ -4102,9 +4181,9 @@
(if
continuable?
(kont-push
(make-signal-return-frame fenv rest-k)
rest-k)
(kont-push (make-raise-guard-frame fenv rest-k) rest-k))))))
(make-signal-return-frame fenv unwound-k)
unwound-k)
(kont-push (make-raise-guard-frame fenv unwound-k) unwound-k))))))
("raise-guard"
(do
(set! *last-error-kont* rest-k)
@@ -4132,7 +4211,7 @@
rest-k))))))
("callcc"
(let
((k (make-callcc-continuation rest-k)))
((k (make-callcc-continuation rest-k (len *winders*))))
(continue-with-call
value
(list k)
@@ -4236,8 +4315,11 @@
(callcc-continuation? f)
(let
((arg (if (empty? args) nil (first args)))
(captured (callcc-continuation-data f)))
(make-cek-value arg env captured))
(captured (callcc-continuation-data f))
(w-len (callcc-continuation-winders-len f)))
(do
(wind-escape-to w-len)
(make-cek-value arg env captured)))
(continuation? f)
(let
((arg (if (empty? args) nil (first args)))

113
spec/tests/test-dynamic-wind.sx Normal file
View File

@@ -0,0 +1,113 @@
;; Tests for dynamic-wind: after-thunk fires on normal return,
;; non-local exit via raise/guard, and call/cc escape.
(defsuite
"dynamic-wind-basic"
(deftest
"after fires on normal return"
(let
((log (list)))
(dynamic-wind
(fn () (append! log "before"))
(fn () (append! log "body"))
(fn () (append! log "after")))
(assert= 3 (len log))
(assert= "before" (nth log 0))
(assert= "body" (nth log 1))
(assert= "after" (nth log 2))))
(deftest
"after fires on raise escape"
(let
((log (list)))
(guard
(e (true nil))
(dynamic-wind
(fn () (append! log "before"))
(fn () (append! log "body") (error "boom"))
(fn () (append! log "after"))))
(assert= 3 (len log))
(assert= "before" (nth log 0))
(assert= "body" (nth log 1))
(assert= "after" (nth log 2))))
(deftest
"after fires on call/cc escape"
(let
((log (list)))
(call/cc
(fn
(k)
(dynamic-wind
(fn () (append! log "before"))
(fn () (append! log "body") (k nil))
(fn () (append! log "after")))))
(assert= 3 (len log))
(assert= "before" (nth log 0))
(assert= "body" (nth log 1))
(assert= "after" (nth log 2))))
(deftest
"nested dynamic-wind after-thunks fire LIFO on normal return"
(let
((log (list)))
(dynamic-wind
(fn () (append! log "outer-before"))
(fn
()
(dynamic-wind
(fn () (append! log "inner-before"))
(fn () (append! log "inner-body"))
(fn () (append! log "inner-after"))))
(fn () (append! log "outer-after")))
(assert= 5 (len log))
(assert= "outer-before" (nth log 0))
(assert= "inner-before" (nth log 1))
(assert= "inner-body" (nth log 2))
(assert= "inner-after" (nth log 3))
(assert= "outer-after" (nth log 4))))
(deftest
"nested dynamic-wind after-thunks fire LIFO on raise"
(let
((log (list)))
(guard
(e (true nil))
(dynamic-wind
(fn () (append! log "outer-before"))
(fn
()
(dynamic-wind
(fn () (append! log "inner-before"))
(fn () (append! log "inner-body") (error "boom"))
(fn () (append! log "inner-after"))))
(fn () (append! log "outer-after"))))
(assert= 5 (len log))
(assert= "outer-before" (nth log 0))
(assert= "inner-before" (nth log 1))
(assert= "inner-body" (nth log 2))
(assert= "inner-after" (nth log 3))
(assert= "outer-after" (nth log 4))))
(deftest
"before and after are called"
(let
((count 0))
(dynamic-wind
(fn () (set! count (+ count 1)))
(fn () nil)
(fn () (set! count (+ count 10))))
(assert= 11 count)))
(deftest
"dynamic-wind return value is body result"
(let
((result (dynamic-wind (fn () nil) (fn () 42) (fn () nil))))
(assert= 42 result)))
(deftest
"after fires before guard handler"
(let
((log (list)))
(guard
(e (true (append! log "guard-handler")))
(dynamic-wind
(fn () nil)
(fn () (error "boom"))
(fn () (append! log "after"))))
(assert= 2 (len log))
(assert= "after" (nth log 0))
(assert= "guard-handler" (nth log 1)))))