diff --git a/hosts/javascript/platform.py b/hosts/javascript/platform.py index ce980220..785c8d7b 100644 --- a/hosts/javascript/platform.py +++ b/hosts/javascript/platform.py @@ -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; diff --git a/shared/static/scripts/sx-browser.js b/shared/static/scripts/sx-browser.js index f4742f61..8ecc2132 100644 --- a/shared/static/scripts/sx-browser.js +++ b/shared/static/scripts/sx-browser.js @@ -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); diff --git a/spec/evaluator.sx b/spec/evaluator.sx index b4794575..75d7f399 100644 --- a/spec/evaluator.sx +++ b/spec/evaluator.sx @@ -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))) diff --git a/spec/tests/test-dynamic-wind.sx b/spec/tests/test-dynamic-wind.sx new file mode 100644 index 00000000..9e08260b --- /dev/null +++ b/spec/tests/test-dynamic-wind.sx @@ -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)))))