diff options
Diffstat (limited to 'module')
-rw-r--r-- | module/ice-9/boot-9.scm | 6 | ||||
-rw-r--r-- | 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 dcff0ed7a..3b98aaf75 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 e4246bb7d..73e9394ef 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)) |