apply (a variant of) Derick Eddington's patch to simulate an initial R6RS exception handler that returns for non-&serious conditions

svn: r10685
This commit is contained in:
Matthew Flatt 2008-07-09 01:17:25 +00:00
parent 0536cbf54a
commit 9af966f378
2 changed files with 40 additions and 6 deletions

View File

@ -11,7 +11,9 @@
rnrs/r5rs-6
(only-in scheme/base
lib
current-library-collection-paths)))
current-library-collection-paths
parameterize
uncaught-exception-handler)))
@(define guide-src '(lib "scribblings/guide/guide.scrbl"))
@ -254,6 +256,10 @@ several known ways:
cannot be invoked after control escapes from the raise.
The initial exception handler does not return for
non-@scheme[&serious] conditions, but @scheme[raise] and
@scheme[raise-continuable] both install an uncaught-exception
handler (via @scheme[parameterize] and
@scheme[uncaught-exception-handler]) to one that returns for
non-@scheme[&serious] conditions.}
@item{Inexact numbers are printed without a precision indicator, and
@ -650,7 +656,7 @@ several known ways:
(record-field-mutable? #f "r6rs-lib-Z-H-7.html" "node_idx_360")]
@r6rs-module[rnrs/exceptions-6 (rnrs exceptions (6))
"r6rs-lib-Z-H-8.html" "node_idx_364" "Exceptions and Conditions"
"r6rs-lib-Z-H-8.html" "node_idx_364" "Exceptions"
(with-exception-handler #f "r6rs-lib-Z-H-8.html" "node_idx_368")
(raise-continuable #f "r6rs-lib-Z-H-8.html" "node_idx_378")
(raise #f "r6rs-lib-Z-H-8.html" "node_idx_376")
@ -661,7 +667,7 @@ several known ways:
See also @secref["conformance"].
@r6rs-module[rnrs/conditions-6 (rnrs conditions (6))
"r6rs-lib-Z-H-8.html" "node_idx_382" "Exceptions and Conditions"
"r6rs-lib-Z-H-8.html" "node_idx_382" "Conditions"
(who-condition? #f "r6rs-lib-Z-H-8.html" "node_idx_456")
(warning? #f "r6rs-lib-Z-H-8.html" "node_idx_418")
(violation? #f "r6rs-lib-Z-H-8.html" "node_idx_436")

View File

@ -1,6 +1,8 @@
#lang scheme/base
(require r6rs/private/exns)
(require r6rs/private/exns
(only-in r6rs/private/conds serious-condition? simple-conditions condition?)
(only-in rnrs/io/ports-6 standard-error-port))
(provide with-exception-handler
guard else =>
@ -79,8 +81,34 @@
(raise id)]))
(define (r6rs:raise exn)
;; No barrier
(raise exn #f))
(parameterize ([uncaught-exception-handler
;; Simulate an initial exception handler that
;; behaves as specified in R6RS for non-&serious
;; exceptions:
(let ([ueh (uncaught-exception-handler)])
(lambda (exn)
(let ([base (if (exn:continuable? exn)
(exn:continuable-base exn)
exn)])
(if (serious-condition? base)
(ueh base)
;; Not &serious, so try to "continue":
(begin
((error-display-handler)
(if (exn? exn)
(exn-message exn)
(format "uncaught exception: ~s"
exn))
exn)
;; If it's continuable, then continue
;; by resuming the old continuation.
;; (Otherwise, let the a handler-
;; didn't-escape error get reported.)
(when (exn:continuable? exn)
((exn:continuable-continuation exn)
(lambda () (values)))))))))])
;; No barrier:
(raise exn #f)))
(define (raise-continuable exn)
((let/cc cont