suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix equal?

Browse Source 
svn: r11909
This commit is contained in:
Chongkai Zhu 2008-09-30 01:46:37 +00:00
parent 07cfcb4f07
commit cd8e24b02b
1 changed files with 37 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
collects/srfi/63/63.ss
View File

@ -138,29 +138,31 @@
(define (s:equal? obj1 obj2) (define (s:equal? obj1 obj2)
(or (equal? obj1 obj2) (or (equal? obj1 obj2)
(and (box? obj1) (cond ((and (box? obj1)
(box? obj2) (box? obj2))
(s:equal? (unbox obj1) (s:equal? (unbox obj1)
(unbox obj2))) (unbox obj2)))
(and (pair? obj1) ((and (pair? obj1)
(pair? obj2) (pair? obj2))
(s:equal? (car obj1) (car obj2)) (and (s:equal? (car obj1) (car obj2))
(s:equal? (cdr obj1) (cdr obj2))) (s:equal? (cdr obj1) (cdr obj2))))
(if (vector? obj1) ((and (vector? obj1)
(and (vector? obj2) (vector? obj2))
(equal? (vector-length obj1) (vector-length obj2)) (and (equal? (vector-length obj1) (vector-length obj2))
(let lp ((idx (sub1 (vector-length obj1)))) (let lp ((idx (sub1 (vector-length obj1))))
(or (negative? idx) (or (negative? idx)
(and (s:equal? (vector-ref obj1 idx) (and (s:equal? (vector-ref obj1 idx)
(vector-ref obj2 idx)) (vector-ref obj2 idx))
(lp (sub1 idx)))))) (lp (sub1 idx)))))))
;; Not a vector ((and (string? obj1)
(or (and (array? obj1) (string? obj2))
(array? obj2) (string=? obj1 obj2))
(equal? (array-dimensions obj1) (array-dimensions obj2)) ((and (array? obj1)
(s:equal? (array->vector obj1) (array->vector obj2))) (array? obj2))
(and (struct? obj1) (and (equal? (array-dimensions obj1) (array-dimensions obj2))
(struct? obj2) (s:equal? (array->vector obj1) (array->vector obj2))))
((and (struct? obj1)
(struct? obj2))
(let-values (((obj1-type obj1-skipped?) (let-values (((obj1-type obj1-skipped?)
(struct-info obj1)) (struct-info obj1))
((obj2-type obj2-skipped?) ((obj2-type obj2-skipped?)
@ -169,7 +171,8 @@
(not obj1-skipped?) (not obj1-skipped?)
(not obj2-skipped?) (not obj2-skipped?)
(s:equal? (struct->vector obj1) (s:equal? (struct->vector obj1)
(struct->vector obj2))))))))) (struct->vector obj2)))))
(else #f))))
(define (array-rank obj) (define (array-rank obj)
(if (array? obj) (length (array-dimensions obj)) 0)) (if (array? obj) (length (array-dimensions obj)) 0))