[R6RS] basic semantic options for dynamic-wind

[William D Clinger]

;2. dynamic-wind (10 minutes)
;    published papers specify different semantics for the
;        dynamic environment of the in and out thunks
;    proposed: not in until in thunk completes; out as soon as
;        out thunk is called
;    Will will generate examples for which it matters

; Example 1.
;
; With the semantics proposed above, this example returns 1.
; With a semantics that winds as soon as the in thunk begins
; to execute, this example returns 2.

(define (example1)
  (let ((n 0))
    (call-with-current-continuation
     (lambda (k)
       (dynamic-wind
        (lambda ()
          (display "Executing in thunk") (newline)
          (set! n (+ n 1))
          (k #f))
        (lambda () #f)
        (lambda ()
          (display "Executing out thunk") (newline)
          (set! n (+ n 1))))))
    n))

; Example 2.
;
; With the semantics proposed above, this example returns 1.
; With a semantics that does not unwind until the out thunk
; completes its execution, this example returns 2 (if an
; escape from the out thunk unwinds) or goes into an
; infinite loop (if an escape from the out thunk does not
; unwind).

(define (example2)
  (let ((n 0))
    (call-with-current-continuation
     (lambda (k)
       (dynamic-wind
        (lambda ()
          (display "Executing in thunk") (newline))
        (lambda () #f)
        (lambda ()
          (display "Executing out thunk") (newline)
          (set! n (+ n 1))
          (k #f)))))
    n))

(let* ((result1 (example1))
       (result2 (example2)))
  (display "Example 1 returns ") (write result1) (newline)
  (display "Example 2 returns ") (write result2) (newline))

; Current behavior:
;
; System        Example 1       Example 2
;
; MIT Scheme    1               1
; Scheme 48     1               1
; MzScheme      1               1
; Gambit        1               1
; Bigloo        1               1
; Chicken       1               1
; Chez Scheme   1               1
; Larceny       2               1