/usr/share/slib/dynwind.scm is in slib 3b1-3.1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 | ; "dynwind.scm", wind-unwind-protect for Scheme
; Copyright (c) 1992, 1993 Aubrey Jaffer
;
;Permission to copy this software, to modify it, to redistribute it,
;to distribute modified versions, and to use it for any purpose is
;granted, subject to the following restrictions and understandings.
;
;1. Any copy made of this software must include this copyright notice
;in full.
;
;2. I have made no warranty or representation that the operation of
;this software will be error-free, and I am under no obligation to
;provide any services, by way of maintenance, update, or otherwise.
;
;3. In conjunction with products arising from the use of this
;material, there shall be no use of my name in any advertising,
;promotional, or sales literature without prior written consent in
;each case.
;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 by <thunk2> is returned as the result of DYNAMIC-WIND.
;<thunk3> is also called just before control leaves the dynamic
;context of <thunk2> by calling a continuation created outside that
;context. Furthermore, <thunk1> is called before reentering the
;dynamic context of <thunk2> by calling a continuation created inside
;that context. (Control is inside the context of <thunk2> if <thunk2>
;is on the current return stack).
;;;WARNING: This code has no provision for dealing with errors or
;;;interrupts. If an error or interrupt occurs while using
;;;dynamic-wind, the dynamic environment will be that in effect at the
;;;time of the error or interrupt.
(define dynamic:winds '())
;@
(define (dynamic-wind <thunk1> <thunk2> <thunk3>)
(<thunk1>)
(set! dynamic:winds (cons (cons <thunk1> <thunk3>) dynamic:winds))
(let ((ans (<thunk2>)))
(set! dynamic:winds (cdr dynamic:winds))
(<thunk3>)
ans))
;@
(define call-with-current-continuation
(let ((oldcc call-with-current-continuation))
(lambda (proc)
(let ((winds dynamic:winds))
(oldcc
(lambda (cont)
(proc (lambda (c2)
(dynamic:do-winds winds (- (length dynamic:winds)
(length winds)))
(cont c2)))))))))
(define (dynamic:do-winds to delta)
(cond ((eq? dynamic:winds to))
((negative? delta)
(dynamic:do-winds (cdr to) (+ 1 delta))
((caar to))
(set! dynamic:winds to))
(else
(let ((from (cdar dynamic:winds)))
(set! dynamic:winds (cdr dynamic:winds))
(from)
(dynamic:do-winds to (+ -1 delta))))))
|