On Thu, Jan 6, 2011 at 10:08 AM, Keiko Nakata
<ke...@kurims.kyoto-u.ac.jp> wrote:
> On Thu, Jan 6, 2011 at 3:20 PM, Casey Klein <clkl...@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")
_________________________________________________
For list-related administrative tasks:
http://lists.racket-lang.org/listinfo/users
