5  Unwind-protect that recognizes only last-use continuations

call/cc-l takes a single procedure argument (just like the standard call/cc), but the continuation it captures takes two arguments: The first argument, if true, marks that call as the last use of the continuation. The second argument is the usual transfer value of the continuation.

The corresponding unwind-protect's postlude is triggered by a continuation only on its last use.

call/cc-l, like call/cc-e, is implemented with a cob. (Unlike call/cc-e, call/cc-l does not create two types of continuations, so it doesn't need two types of cobs.) The call/cc-l cob looks very much like the union of the cobs for call/cc-e, except of course that whereas the call/cc-e triggers postludes for escaping continuations, the call/cc-l cob triggers them for continuations on their last use. Another difference is that the call/cc-l cob takes two arguments, like the user continuation it stands for. We use the cob's first argument for the message, which can be update and delete for manipulating the postludes, #f for marking non-last use, and any other value for last use.

As in the call/cc-e case, the cob is available as the fluid variable *curr-call/cc-cob* to an enclosed unwind-protect; and unwind-protect has a fluid variable *curr-u-p-alive?* so continuations can check it to avoid re-entering an exited unwind-protect. But we also associate another fluid variable with unwind-protect, viz., *curr-u-p-local-conts* -- this is to keep track of continuations that were captured within the unwind-protect, for we view the call of a continuation whose capture and invocation are both local to the unwind-protect as non-exiting, and thus not worthy of triggering the postlude, even if it happens to be last-use. Each call/cc-l updates its enclosing *curr-u-p-local-conts*, and its cob's last call checks its current *curr-u-p-local-conts* before triggering postludes.

(define call/cc-l #f)

(define-fluid *curr-call/cc-cob* (lambda (b v) #f))
(define-fluid *curr-u-p-local-conts* '())

The following replaces (set! call/cc-e ...) in the code in section 4:

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

The following replaces (set! unwind-protect-proc ...) in the code in section 4:

(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?)]
                  [*curr-u-p-local-conts* '()])
        (letrec ([pl (lambda ()
                       (set! alive? #f)
                       (postlude)
                       (curr-call/cc-cob delete pl))])
          (curr-call/cc-cob update pl)
          (let ([res (body)])
            (pl)
            res))))))

The only significant difference between this unwind-protect-proc and the one in section 4 is that it initializes the fluid variable *curr-u-p-local-conts*, which dynamically enclosed calls to call/cc-l can update.