[Guile-commits] 02/04: Add `record-type-has-parent?'.

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 90d52a9e1dd6419e0fef13e7b09e284e9d895920
Author: Andy Wingo <address@hidden>
Date:   Sun Nov 3 21:36:39 2019 +0100

    Add `record-type-has-parent?'.
    
    * module/ice-9/boot-9.scm (record-type-has-parent?): New function.
    * module/srfi/srfi-35.scm (condition-type?): Use it.
---
 module/ice-9/boot-9.scm | 6 ++++++
 module/srfi/srfi-35.scm | 8 ++------
 2 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index dcff0ed..3b98aaf 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1241,6 +1241,12 @@ VALUE."
          (nparents (vector-length parents)))
     (and (not (zero? nparents))
          (vector-ref parents (1- nparents)))))
+(define (record-type-has-parent? rtd parent)
+  (or (eq? rtd parent)
+      (let ((parents (record-type-parents rtd))
+            (nparents (vector-length (record-type-parents parent))))
+        (and (< nparents (vector-length parents))
+             (eq? (vector-ref parents nparents) parent)))))
 
 (define (record-type-mutable-fields rtd)
   (unless (record-type? rtd)
diff --git a/module/srfi/srfi-35.scm b/module/srfi/srfi-35.scm
index e4246bb..73e9394 100644
--- a/module/srfi/srfi-35.scm
+++ b/module/srfi/srfi-35.scm
@@ -77,12 +77,8 @@ supertypes."
 
 (define (condition-type? obj)
   "Return true if OBJ is a condition type."
-  ;; FIXME: Use record-type-is-a? or something like that.
-  (or (eq? obj &condition)
-      (and (record-type? obj)
-           (let ((parents (record-type-parents obj)))
-             (and (< 0 (vector-length parents))
-                  (eq? (vector-ref parents 0) &condition))))))
+  (and (record-type? obj)
+       (record-type-has-parent? obj &condition)))
 
 (define simple-condition?
   (record-predicate &condition))