Fix bug: ustrings may be equal but still have different type codes.
authorChris Hanson <org/chris-hanson/cph>
Mon, 30 Jan 2017 03:16:35 +0000 (19:16 -0800)
committerChris Hanson <org/chris-hanson/cph>
Mon, 30 Jan 2017 03:16:35 +0000 (19:16 -0800)
Also simplify implementations of eqv? and equal?, and remove eqv? handling of
empty vectors.

src/runtime/equals.scm

index 7ce4f8c2b736c739e6f45d0cd794b115da96ebdd..e757e5d46c357bbf9740adea25c289daf37021fa 100644 (file)
@@ -34,48 +34,45 @@ USA.
   ;; numbers specially, but it turns out that EQ? does the right thing
   ;; for everything but numbers, so we take advantage of that.
   (or (eq? x y)
-      (if (object-type? (object-type x) y)
-         (and (not (fix:fixnum? x))
-              (if (number? y)
-                  (number:eqv? x y)
-                  (and (object-type? (ucode-type vector) y)
-                       (fix:zero? (vector-length x))
-                       (fix:zero? (vector-length y)))))
-         (and (number? x)
-              (number? y)
-              (number:eqv? x y)))))
+      (and (number? x)
+          (number? y)
+          (number:eqv? x y))))
 
 (define (equal? x y)
   (or (eq? x y)
-      (if (object-type? (object-type x) y)
-         (cond ((pair? y)
-                (and (equal? (car x) (car y))
-                     (equal? (cdr x) (cdr y))))
-               ((vector? y)
-                (let ((size (vector-length x)))
-                  (and (fix:= size (vector-length y))
-                       (let loop ((index 0))
-                         (or (fix:= index size)
-                             (and (equal? (vector-ref x index)
-                                          (vector-ref y index))
-                                  (loop (fix:+ index 1))))))))
-               ((bytevector? y)
-                (bytevector=? x y))
-               ((ustring? y)
-                (ustring=? x y))
-               ((number? y)
-                (number:eqv? x y))
-               ((cell? y)
-                (equal? (cell-contents x) (cell-contents y)))
-               ((bit-string? y)
-                (bit-string=? x y))
-               ((pathname? x)
-                (and (pathname? y)
-                     (pathname=? x y)))
-               ((char-set? x)
-                (and (char-set? y)
-                     (char-set=? x y)))
-               (else #f))
-         (and (number? x)
-              (number? y)
-              (number:eqv? x y)))))
\ No newline at end of file
+      (cond ((pair? x)
+            (and (pair? y)
+                 (equal? (car x) (car y))
+                 (equal? (cdr x) (cdr y))))
+           ((vector? x)
+            (and (vector? y)
+                 (let ((size (vector-length x)))
+                   (and (fix:= size (vector-length y))
+                        (let loop ((index 0))
+                          (or (fix:= index size)
+                              (and (equal? (vector-ref x index)
+                                           (vector-ref y index))
+                                   (loop (fix:+ index 1)))))))))
+           ((number? x)
+            (and (number? y)
+                 (number:eqv? x y)))
+           ((bytevector? x)
+            (and (bytevector? y)
+                 (bytevector=? x y)))
+           ((ustring? x)
+            (and (ustring? y)
+                 (ustring=? x y)))
+           ((cell? x)
+            (and (cell? y)
+                 (equal? (cell-contents x)
+                         (cell-contents y))))
+           ((bit-string? x)
+            (and (bit-string? y)
+                 (bit-string=? x y)))
+           ((pathname? x)
+            (and (pathname? y)
+                 (pathname=? x y)))
+           ((char-set? x)
+            (and (char-set? y)
+                 (char-set=? x y)))
+           (else #f))))
\ No newline at end of file