fix SRFI 63 'equal?'
svn: r11864
This commit is contained in:
parent
516647216d
commit
cc5a495f87
|
@ -146,29 +146,30 @@
|
|||
(pair? obj2)
|
||||
(s:equal? (car obj1) (car obj2))
|
||||
(s:equal? (cdr obj1) (cdr obj2)))
|
||||
(and (vector? obj1)
|
||||
(vector? obj2)
|
||||
(equal? (vector-length obj1) (vector-length obj2))
|
||||
(let lp ((idx (sub1 (vector-length obj1))))
|
||||
(or (negative? idx)
|
||||
(and (s:equal? (vector-ref obj1 idx)
|
||||
(vector-ref obj2 idx))
|
||||
(lp (sub1 idx))))))
|
||||
(and (array? obj1)
|
||||
(array? obj2)
|
||||
(equal? (array-dimensions obj1) (array-dimensions obj2))
|
||||
(s:equal? (array->vector obj1) (array->vector obj2)))
|
||||
(and (struct? obj1)
|
||||
(struct? obj2)
|
||||
(let-values (((obj1-type obj1-skipped?)
|
||||
(struct-info obj1))
|
||||
((obj2-type obj2-skipped?)
|
||||
(struct-info obj2)))
|
||||
(and (eq? obj1-type obj2-type)
|
||||
(not obj1-skipped?)
|
||||
(not obj2-skipped?)
|
||||
(s:equal? (struct->vector obj1)
|
||||
(struct->vector obj2)))))))
|
||||
(if (vector? obj1)
|
||||
(and (vector? obj2)
|
||||
(equal? (vector-length obj1) (vector-length obj2))
|
||||
(let lp ((idx (sub1 (vector-length obj1))))
|
||||
(or (negative? idx)
|
||||
(and (s:equal? (vector-ref obj1 idx)
|
||||
(vector-ref obj2 idx))
|
||||
(lp (sub1 idx))))))
|
||||
;; Not a vector
|
||||
(or (and (array? obj1)
|
||||
(array? obj2)
|
||||
(equal? (array-dimensions obj1) (array-dimensions obj2))
|
||||
(s:equal? (array->vector obj1) (array->vector obj2)))
|
||||
(and (struct? obj1)
|
||||
(struct? obj2)
|
||||
(let-values (((obj1-type obj1-skipped?)
|
||||
(struct-info obj1))
|
||||
((obj2-type obj2-skipped?)
|
||||
(struct-info obj2)))
|
||||
(and (eq? obj1-type obj2-type)
|
||||
(not obj1-skipped?)
|
||||
(not obj2-skipped?)
|
||||
(s:equal? (struct->vector obj1)
|
||||
(struct->vector obj2)))))))))
|
||||
|
||||
(define (array-rank obj)
|
||||
(if (array? obj) (length (array-dimensions obj)) 0))
|
||||
|
|
Loading…
Reference in New Issue
Block a user