Created
August 11, 2012 12:45
-
-
Save manuel/3324230 to your computer and use it in GitHub Desktop.
Commenting on Oleg's dyn-wind.scm
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;; See http://okmij.org/ftp/continuations/implementations.html#dynamic-wind | |
;; and http://axisofeval.blogspot.com/2012/08/delimited-continuations-do-dynamic-wind.html | |
;; Slight trick here: use identity of yield-record-tag function as the actual tag | |
(define (yield-record-tag) yield-record-tag) | |
(define (make-yield-record v k) | |
(list yield-record-tag v k)) | |
;; Yield simply aborts up to the generator's caller, delivering to it | |
;; the yielded value and the continuation for resuming after the call | |
;; to yield. | |
(define (yield v) (shift k (make-yield-record v k))) | |
;; I think this should really be a procedure and not a macro, for clarity. | |
;; Anyway, try-yield receives whatever a generator either returned ordinarily, | |
;; or yielded, and takes it apart. If it's an ordinary returned value, it | |
;; executes the on-r expression. If it's a yield record, containing a value | |
;; and resume continuation, execute the on-y block. We'll see this in action | |
;; below. | |
(define-syntax try-yield | |
(syntax-rules () | |
((try-yield exp (r on-r) (v k on-y)) | |
(let ((exp-r exp)) | |
(if (and (pair? exp-r) (eq? (car exp-r) yield-record-tag)) | |
(let ((v (cadr exp-r)) (k (caddr exp-r))) on-y) | |
(let ((r exp-r)) on-r)))))) | |
;; Here's a for loop for looping over the values yielded by a generator. | |
;; It takes a generator thunk, and a body function taking a yielded value. | |
;; It wraps a prompt around the generator with reset. Then it takes apart | |
;; what the generator returned: if it's an ordinary value R, return it. If it's | |
;; yield record containing a value V and a resumption continuation K, call | |
;; the body function with the value, and after that resume our loop, returning | |
;; #f to the yield call inside the generator (here one could also pass another | |
;; value back into the generator). | |
(define (for-loop generator body) | |
(let loop ((thr (reset (generator)))) | |
(try-yield thr | |
(r r) | |
(v k | |
(begin | |
(body v) | |
(loop (k #f))))))) | |
;; For example, this will print 1 and 2: | |
(for-loop | |
(lambda () (yield 1) (yield 2)) | |
(lambda (v) (display v))) | |
;; Dynamic-wind ain't difficult either (in Oleg's file this is called | |
;; dyn-wind-yield but I've called it dynamic-wind here for clarity.) | |
;; Dynamic-wind must itself be used inside a generator prompt, if the | |
;; protected thunk may yield. | |
;; It simply calls the before thunk, protected thunk, and after thunk in order. | |
;; If the protected thunk returned ordinarily, its result value R is returned. | |
;; If it yielded, dynamic-wind also yields (the value yielded by the | |
;; protected thunk). When the outside code reenters, passing the value REENTER, | |
;; we again perform the before and after thunks, but this time with a new | |
;; protected thunk that passes the reentered value to the original protected | |
;; thunk's continuation, K. | |
(define (dynamic-wind before-thunk thunk after-thunk) | |
(let loop ((th (lambda () (reset (thunk))))) | |
(before-thunk) | |
(let ((res (th))) | |
(after-thunk) | |
(try-yield res | |
(r r) ; return the result | |
(v k | |
(let ((reenter (yield v))) | |
(loop (lambda () (k reenter))))))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment