mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Add `record-type-has-parent?'.

Browse source 
* module/ice-9/boot-9.scm (record-type-has-parent?): New function.
* module/srfi/srfi-35.scm (condition-type?): Use it.
This commit is contained in:
Andy Wingo 2019-11-03 21:36:39 +01:00
parent 9f1a671734
commit 90d52a9e1d
2 changed files with 8 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/ice-9/boot-9.scm
View file

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

8
module/srfi/srfi-35.scm
View file

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