4  Unwind-protect that recognizes only escaping continuations

call/cc-e (unlike the standard call/cc) takes two arguments: The second argument is the procedure that is applied to the current continuation. Whether this continuation is an escaping or a full continuation depends on whether the first argument is true or false.

We implement call/cc-e by applying its second argument (the procedure) to a cob created using call/cc-f. The cobs created for call/cc-e #t (escaping continuations) and call/cc-e #f (full continuations) are different.

unwind-protect interacts with call/cc-e as follows: If the body is exited by a escaping continuation provided by a dynamically enclosing call/cc-e #t, then the postlude is performed. The postlude is not performed by full continuations or by escaping continuations created by a call/cc-e #t within the unwind-protect. To accomplish this, the cob generated by call/cc-e #t keeps a list (my-postludes) of all the postludes within its dynamic extent. Since a call to call/cc-e #t cannot know of the unwind-protects that will be called in its dynamic extent, it is the job of each unwind-protect to update the my-postludes of its enclosing call/cc-e #ts. To allow the unwind-protect to access its enclosing call/cc-e #t, the latter records its cob in a fluid variable *curr-call/cc-cob*.

The following is the entire code for call/cc-e and its unwind-protect-proc, a procedural form of unwind-protect:

(define call/cc-e #f)
(define unwind-protect-proc #f)

(define-fluid *curr-call/cc-cob* 
  (lambda (v) (lambda (x) #f)))
(define-fluid *curr-u-p-alive?* (lambda () #t))

(let ([update (list 'update)]
      [delete (list 'delete)])

  (set! call/cc-e
    (lambda (once? proc)
      (if once?
          (call/cc-f
            (lambda (k)
              (let* 
                ([cob (fluid *curr-call/cc-cob*)]
                 [my-postludes '()]
                 [already-used? #f]
                 [cob
                   (lambda (v)
                     (cond 
                       [(eq? v update)
                        (lambda (pl)
                          (set! my-postludes
                            (cons pl my-postludes))
                          ((cob update) pl))]
                       [(eq? v delete)
                        (lambda (pl)
                          (set! my-postludes
                            (delq!  pl my-postludes))
                          ((cob delete) pl))]
                       [already-used?
                         (error 'dead-continuation)]
                       [else
                         (set! already-used?  #t)
                         (for-each 
                           (lambda (pl) (pl))
                           my-postludes)
                         (k v)]))])
               (let-fluid ([*curr-call/cc-cob* cob])
                 (cob (proc cob))))))
           (call/cc-f
             (lambda (k)
               (let* 
                 ([my-u-p-alive? (fluid *curr-u-p-alive?*)]
                  [cob
                    (lambda (v)
                      (if (my-u-p-alive?)
                          (k v)
                          (error 'dead-unwind-protect)))])
                 (cob (proc cob))))))))

  (set! unwind-protect-proc
    (lambda (body postlude)
      (let ([curr-call/cc-cob (fluid *curr-call/cc-cob*)]
            [alive? #t])
        (let-fluid ([*curr-u-p-alive?* (lambda () alive?)])
          (letrec ([pl (lambda ()
                         (set! alive? #f)
                         (postlude)
                         ((curr-call/cc-cob delete) pl))])
            ((curr-call/cc-cob update) pl)
            (let ([res (body)])
              (pl)
              res))))))

  )

As we can see, the cob employed by call/cc-e #t (i.e., the part of the call/cc-e body that is active when its once? argument is true) is fairly involved. This is because, in addition to performing the jump, it has to respond to update and delete messages pertaining to its my-postludes. We have defined lexical variables delete and update so they are guaranteed to be different from any user values given to the cob. The cob also remembers its nearest enclosing cob (prev-cob), so that the update and delete messages can be propagated outward. (This is because any of the escaping continuations enclosing an unwind-protect can trigger the latter's postlude.) When the cob is called with a non-message, it performs all of its my-postludes, before calling its embedded continuation. It also remembers to set a local flag already-used?, because it is an error to call an escaping continuation more than once.²

The call/cc-e #f part, the one that produces full continuations, is fairly simple. Its cob simply remembers if its enclosing unwind-protect is alive, via the fluid variable *curr-u-p-alive?*. This is to prevent entry into an unwind-protect body that is known to have exited.

The corresponding unwind-protect-proc notes its nearest enclosing call/cc-e #t's cob, to let it know of its postlude. It also adds wrapper code to the postlude so that the latter can delete itself when it is done, and flag the unwind-protect as no longer alive. The body and the wrapped postlude are performed in sequence, with the body's result being returned.

The macro unwind-protect is defined as follows:

(define-syntax unwind-protect
  (syntax-rules ()
    [(unwind-protect body postlude)
     (unwind-protect-proc 
       (lambda () body) (lambda () postlude))]))

The helper procedure delq! is used to delete a postlude from a list:

(define delq!
  (lambda (x s)
    (let loop ([s s])
      (cond [(null? s) s]
            [(eq? (car s) x) (loop (cdr s))]
            [else (set-cdr! s (loop (cdr s)))
                  s]))))