Allow IGNORE-ERRORS to take an optional second argument that maps the

error condition to something else.

diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm
index 8352bea6267d68da3d283926bbcc7577a4d18171..a516db57ab7717edb3e9431e898570067dbb1c5a 100644 (file)
--- a/v7/src/runtime/error.scm
+++ b/v7/src/runtime/error.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: error.scm,v 14.62 2003/03/10 20:53:34 cph Exp $
+$Id: error.scm,v 14.63 2003/10/10 17:35:01 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
 Copyright 1992,1993,1995,2000,2001,2002 Massachusetts Institute of Technology
@@ -499,12 +499,6 @@ USA.
               (cons (cons types handler) dynamic-handler-frames)))
     (thunk)))
 
-(define (ignore-errors thunk)
-  (call-with-current-continuation
-   (lambda (continuation)
-     (bind-condition-handler (list condition-type:error) continuation
-       thunk))))
-
 (define (break-on-signals types)
   (guarantee-condition-types types 'BREAK-ON-SIGNALS)
   (set! break-on-signals-types types)
@@ -1165,6 +1159,24 @@ USA.
 \f
 ;;;; Utilities
 
+(define (ignore-errors thunk #!optional map-error)
+  (let ((handler
+        (cond ((or (default-object? map-error)
+                   (not map-error))
+               k)
+              ((and (procedure? map-error)
+                    (procedure-arity-valid? map-error 1))
+               (lambda (condition)
+                 (k (map-error condition))))
+              (else
+               (error:wrong-type-argument map-error
+                                          "map-error procedure"
+                                          'IGNORE-ERRORS)))))
+    (call-with-current-continuation
+     (lambda (k)
+       (bind-condition-handler (list condition-type:error) handler
+        thunk)))))
+
 (define (format-error-message message irritants port)
   (fluid-let ((*unparser-list-depth-limit* 2)
              (*unparser-list-breadth-limit* 5))