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

svn: r10685

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")

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
+  (parameterize ([uncaught-exception-handler
-  (raise exn #f))
+                  ;; 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