Non-native shift/reset with exceptions, revisited

Filinski's implementation of shift and reset in terms of undelimited continuations and a mutable cell doesn't interact well with exceptions out of the box, but it turns out we can get the right behavior with only a slight modification. (Ryan, Jacob and I came up with this after John Reppy suggested it to me as a challenge that, if possible, would be far simpler to implement than a native implementation in SML/NJ.)

The problem is that, as Shan and Kiselyov point out, a delimited continuation should only close over the exception handlers (and dynamic parameters in general) bound up to its prompt, and when invoked, it should be invoked in the context of the handlers of the current global continuation extended by the handlers closed over by the delimited continuation. This really is the expected behavior; an exception raised in a delimited continuation should either be handled by an appropriate handler installed within the delimited context, or if there isn't one, by the global context in which the delimited continuation is being invoked.

For example, both of the following programs should evaluate to 100, since the exception inside the delimited continuation is raised within a new context that installs a handler for it:

;; handler installed in body of shift
(reset (lambda ()
         (+ (shift (lambda (k)
                     (with-handlers ([symbol? (lambda (exn) 100)])
                       (k 1))))
            (raise 'boo))))

;; handler installed in new context
(let ([k (reset (lambda ()
                  (shift (lambda (k) k))
                  (raise 'boo)))])
  (with-handlers ([symbol? (lambda (exn) 100)])
    (k 1)))

However, with Filinski's implementation applied naively to a language with exceptions, neither example manages to catch the exception because the delimited continuations close over the wrong exception handlers. However, we can get the right behavior with only a slight modification to the implementation. The trick is to modify the protocol between the captured Scheme continuations to pass an exception along from one context to another to be re-raised.

As before, we store the global continuation (or "meta-continuation") in the single mutable cell:

(define meta-k (lambda (x) (raise 'missing-reset)))

But we'll change the contract of the meta-continuation to accept two different variants of results, those representing a normal return from a delimited continuation, and those representing an unhandled exception that should be re-raised in the context of the meta-continuation's handlers:

(define-struct succeeded (result))
(define-struct failed (exception))

(This is the familiar pattern of representing different return paths in the exception monad.)

Now, reset needs to be modified to ensure that evaluation of the body of the prompt is wrapped in a handler to prevent uncaught exceptions from escaping to the original global continuation. The wrapped result is sent to the meta-continuation, and the context of the call/cc performs the unwrapping, either to return the ordinary value or re-raised the exception. (I've highlighted the new parts.)

(define (reset thunk)
  (let ([result
         (call/cc (lambda (k)
                    (let ([meta-k0 meta-k])
                      (set! meta-k (lambda (r)
                                     (set! meta-k meta-k0)
                                     (k r)))
                      (let ([v (with-handlers
                                   ([(lambda (exn) #t) make-failed])
                                 (make-succeeded (thunk)))])
                        (meta-k v)))))])
    (if (succeeded? result)
        (succeeded-result result)
        (raise (failed-exception result)))))

The only change to shift is that again, where it invokes the meta-continuation, it needs to wrap the result in this variant type. Because the meta-continuation is called here to represent the case where evaluation of the delimited continuation terminates successfully, we wrap the result with make-succeeded.

(define (shift f)
  (call/cc (lambda (k)
             (let ([v (f (lambda (v)
                           (reset (lambda ()
                                    (k v)))))])
               (meta-k (make-succeeded v))))))

That's it! Trying out the test cases above, we get 100 and 100, as we should.

This is also well-typed and implementable in SML, for example as a modification to Oleg's code.