[racket] raise vs abort

On Thu, Jan 6, 2011 at 10:08 AM, Keiko Nakata
<keiko at kurims.kyoto-u.ac.jp> wrote:
> On Thu, Jan 6, 2011 at 3:20 PM, Casey Klein <clklein at eecs.northwestern.edu> wrote:
>> > Still I am not certain that this behavior of 'raise' cannot be implemented
>> > by other (delimited) control operators. And, probably I do not still
>> > understand why 'raise' has to be a primitive.
>>
>> It can be implemented in terms of continuation marks (if you know the
>> key for exception handlers).
>
> You are probably saying 'raise' is different from 'abort' as 'raise' installs a barrier,
> which renders it to be a primitive.

No, that's not what I mean. `raise' can be instructed not to install
the barrier (via its optional second argument), and even in that mode,
it's still different than `abort'.

`raise' just calls the installed exception handlers in turn, until one
does not return. It does not unwind the stack as `abort' does. It's
something like the following (very lightly tested) code.

Note the second two test cases. In these, it's crucial that `raise'
does not unwind the stack, because it cannot be transparently rebuilt.

#lang racket

(require rackunit)

(define exception-handlers-key (gensym))
(define the-very-top (make-continuation-prompt-tag))

(define-syntax-rule (make-program p)
  (call-with-continuation-prompt (λ () p) the-very-top values))

(define (call-with-exception-handler handler thunk)
  ((λ (x) x) ; avoid clobbering current continuation's key
   (with-continuation-mark exception-handlers-key handler
     (thunk))))

(define uncaught-exception-handler
  (make-parameter
   (λ (exn)
     (fprintf (current-error-port) "uncaught exception ~s" exn)
     (abort-current-continuation the-very-top))))

(define (raise value)
  (let loop ([handlers (continuation-mark-set->list
                        (current-continuation-marks the-very-top)
                        exception-handlers-key)])
    (match handlers
      ['()
       (begin
         ((uncaught-exception-handler) value)
         (error 'raise "uncaught-exception-handler returned"))]
      [(cons h hs)
       (begin
         (call-with-continuation-barrier (λ () (h value)))
         (loop hs))])))

(define-syntax (test-program stx)
  (syntax-case stx ()
    [(_ program expected-results expected-output)
     #`(let* ([output (open-output-string)]
              [results (call-with-values
                        (λ ()
                          (parameterize ([current-output-port output])
                            (make-program program)))
                        list)])
         #,(syntax/loc #'expected-results
             (check-equal? results expected-results))
         #,(syntax/loc #'expected-output
             (check-equal? (get-output-string output) expected-output)))]))

(test-program
 (call-with-exception-handler
  (λ (_)
    (displayln "outer")
    (abort-current-continuation the-very-top))
  (λ ()
    (call-with-exception-handler
     (λ (_) (displayln "inner"))
     (λ ()
       (raise 3)))))
 (list)
 "inner\nouter\n")

(test-program
 (call-with-exception-handler
  (λ (exn)
    (displayln (continuation-mark-set->list (current-continuation-marks) 1))
    (abort-current-continuation the-very-top))
  (λ ()
    (with-continuation-mark 1 'a
      (call-with-continuation-barrier
       (λ () (raise 3))))))
 (list)
 "(a)\n")

(test-program
 (call-with-exception-handler
  (λ (exn)
    (displayln (continuation-mark-set->list (current-continuation-marks) 1))
    (abort-current-continuation the-very-top))
  (λ ()
    (with-continuation-mark 1 'a
      (dynamic-wind
       (λ () (displayln "enter"))
       (λ () (raise 3))
       (λ () (displayln "exit"))))))
 (list)
 "enter\n(a)\nexit\n")