From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 18 Feb 2005 18:21:09 +0000 (+0000)
Subject: Implement CONDITION-OF-TYPE?.
X-Git-Tag: 20090517-FFI~1373
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=e6dc839acce55720a644cf13c3fd43a0b0397a9d;p=mit-scheme.git

Implement CONDITION-OF-TYPE?.
---

diff --git a/v7/src/runtime/error.scm b/v7/src/runtime/error.scm
index b37fa3f4e..79f3f2fce 100644
--- a/v7/src/runtime/error.scm
+++ b/v7/src/runtime/error.scm
@@ -1,10 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: error.scm,v 14.66 2004/11/19 17:25:28 cph Exp $
+$Id: error.scm,v 14.67 2005/02/18 18:20:55 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
 Copyright 1992,1993,1995,2000,2001,2002 Massachusetts Institute of Technology
-Copyright 2003,2004 Massachusetts Institute of Technology
+Copyright 2003,2004,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -220,12 +220,17 @@ USA.
 	 (guarantee-restarts restarts operator)
 	 (list-copy restarts))))
 
+(define (condition-of-type? object type)
+  (guarantee-condition-type type 'CONDITION-OF-TYPE?)
+  (%condition-of-type? object type))
+
 (define (condition-predicate type)
   (guarantee-condition-type type 'CONDITION-PREDICATE)
-  (lambda (object)
-    (and (condition? object)
-	 (memq type
-	       (%condition-type/generalizations (%condition/type object))))))
+  (lambda (object) (%condition-of-type? object type)))
+
+(define (%condition-of-type? object type)
+  (and (condition? object)
+       (memq type (%condition-type/generalizations (%condition/type object)))))
 
 (define (condition-accessor type field-name)
   (guarantee-condition-type type 'CONDITION-ACCESSOR)
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 53d1873ad..2852365b6 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.530 2005/02/08 00:10:55 cph Exp $
+$Id: runtime.pkg,v 14.531 2005/02/18 18:21:09 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -1445,6 +1445,7 @@ USA.
 	  break-on-signals
 	  condition-accessor
 	  condition-constructor
+	  condition-of-type?
 	  condition-predicate
 	  condition-signaller
 	  condition-type/error?