Skip to content
Snippets Groups Projects
Commit 18b678ff authored by wlott's avatar wlott
Browse files

Hacked on equal and equalp to make them work now that structures are not

simple-vectors.
parent 7669bee9
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.11 1990/10/09 23:05:12 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.12 1990/10/10 16:31:39 wlott Exp $
;;; ;;;
;;; Predicate functions for CMU Common Lisp. ;;; Predicate functions for CMU Common Lisp.
;;; ;;;
...@@ -342,11 +342,11 @@ ...@@ -342,11 +342,11 @@
((pathnamep x) ((pathnamep x)
(and (pathnamep y) (and (pathnamep y)
(do* ((i 1 (1+ i)) (do* ((i 1 (1+ i))
(len (length x))) (len (c::structure-length x)))
((>= i len) t) ((>= i len) t)
(declare (fixnum i len)) (declare (fixnum i len))
(let ((x-el (svref x i)) (let ((x-el (c::structure-ref x i))
(y-el (svref y i))) (y-el (c::structure-ref y i)))
(if (and (simple-vector-p x-el) (if (and (simple-vector-p x-el)
(simple-vector-p y-el)) (simple-vector-p y-el))
(let ((lx (length x-el)) (let ((lx (length x-el))
...@@ -381,13 +381,23 @@ ...@@ -381,13 +381,23 @@
after coercion. Characters may differ in alphabetic case. Vectors and after coercion. Characters may differ in alphabetic case. Vectors and
arrays must have identical dimensions and EQUALP elements, but may differ arrays must have identical dimensions and EQUALP elements, but may differ
in their type restriction." in their type restriction."
(cond ((eql x y) t) (cond ((eq x y) t)
((characterp x) (char-equal x y)) ((characterp x) (char-equal x y))
((numberp x) (and (numberp y) (= x y))) ((numberp x) (and (numberp y) (= x y)))
((consp x) ((consp x)
(and (consp y) (and (consp y)
(equalp (car x) (car y)) (equalp (car x) (car y))
(equalp (cdr x) (cdr y)))) (equalp (cdr x) (cdr y))))
((structurep x)
(let ((length (c::structure-length x)))
(and (structurep y)
(= length (c::structure-length y))
(dotimes (i length t)
(let ((x-el (c::structure-ref x i))
(y-el (c::structure-ref y i)))
(unless (or (eq x-el y-el)
(equalp x-el y-el))
(return nil)))))))
((vectorp x) ((vectorp x)
(let ((length (length x))) (let ((length (length x)))
(and (vectorp y) (and (vectorp y)
...@@ -395,7 +405,7 @@ ...@@ -395,7 +405,7 @@
(dotimes (i length t) (dotimes (i length t)
(let ((x-el (aref x i)) (let ((x-el (aref x i))
(y-el (aref y i))) (y-el (aref y i)))
(unless (or (eql x-el y-el) (unless (or (eq x-el y-el)
(equalp x-el y-el)) (equalp x-el y-el))
(return nil))))))) (return nil)))))))
((arrayp x) ((arrayp x)
...@@ -406,7 +416,9 @@ ...@@ -406,7 +416,9 @@
(array-dimension y axis)) (array-dimension y axis))
(return nil))) (return nil)))
(dotimes (index (array-total-size x) t) (dotimes (index (array-total-size x) t)
(unless (equalp (row-major-aref x index) (let ((x-el (row-major-aref x index))
(row-major-aref y index)) (y-el (row-major-aref y index)))
(return nil))))) (unless (or (eq x-el y-el)
(equalp x-el y-el))
(return nil))))))
(t nil))) (t nil)))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment