diff --git a/collects/r6rs/scribblings/r6rs.scrbl b/collects/r6rs/scribblings/r6rs.scrbl index 2ecacab46e..695103be31 100644 --- a/collects/r6rs/scribblings/r6rs.scrbl +++ b/collects/r6rs/scribblings/r6rs.scrbl @@ -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") diff --git a/collects/rnrs/exceptions-6.ss b/collects/rnrs/exceptions-6.ss index 7e955f9b05..6a20899a05 100644 --- a/collects/rnrs/exceptions-6.ss +++ b/collects/rnrs/exceptions-6.ss @@ -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