[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Here is code which I beleive implements the proposed DYNAMIC-WIND
procedre for any R4RS compliant Scheme. Is this correct? If so, I
will add it to SLIB. Notice that it works for
call-with-current-continuation in <thunk2>. I have tried to make it
consistent for <thunk1> and <thunk3> as well but I am not clear as to
what should happen in this case.
; "dynwind.scm", wind-unwind-protect for Scheme
; Copyright (c) 1992, Aubrey Jaffer
;This facility is a generalization of Common Lisp `unwind-protect',
;designed to take into account the fact that continuations produced by
;CALL-WITH-CURRENT-CONTINUATION may be reentered.
; (dynamic-wind <thunk1> <thunk2> <thunk3>) procedure
;The arguments <thunk1>, <thunk2>, and <thunk3> must all be procedures
;of no arguments (thunks).
;DYNAMIC-WIND calls <thunk1>, <thunk2>, and then <thunk3>. The value
;returned of <thunk2> is returned as the result of DYNAMIC-WIND.
;<thunk3> is also called just before <thunk2> calls any continuations
;created by CALL-WITH-CURRENT-CONTINUATION. If <thunk2> captures its
;continuation as an escape procedure, <thunk1> is invoked just before
;continuing that continuation.
(define *winds* '())
(define (dynamic-wind <thunk1> <thunk2> <thunk3>)
(set! *winds* (cons (cons <thunk1> <thunk3>) *winds*))
(let ((ans (<thunk2>)))
(set! *winds* (cdr *winds*))
(let ((oldcc call-with-current-continuation))
(let ((winds *winds*))
(proc (lambda (c2)
(dynamic:do-winds *winds* winds)
(define (dynamic:do-winds from to)
(set! *winds* from)
(cond ((eq? from to))
(dynamic:do-winds from (cdr to))
(dynamic:do-winds (cdr from) to))
(dynamic:do-winds (cdr from) (cdr to))
(set! *winds* to))