X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fpred.lisp;h=dd6ccb2dd196a2641784873307fbfecb44ed7a3b;hb=df679ed627975948b1cee190f4d79c397588c43e;hp=1acb8741fdb2c458759b3117bb81ae5268c76c0c;hpb=0aafa73007d42f2bc8e626f98a243019b7e63284;p=sbcl.git

diff --git a/src/code/pred.lisp b/src/code/pred.lisp
index 1acb874..dd6ccb2 100644
--- a/src/code/pred.lisp
+++ b/src/code/pred.lisp
@@ -115,8 +115,8 @@
   "Return the type of OBJECT."
   (if (typep object '(or function array complex))
     (type-specifier (ctype-of object))
-    (let* ((class (layout-class (layout-of object)))
-	   (name (class-name class)))
+    (let* ((classoid (layout-classoid (layout-of object)))
+	   (name (classoid-name classoid)))
       (if (typep object 'instance)
       (case name
 	(sb!alien-internals:alien-value
@@ -124,19 +124,9 @@
 	   ,(sb!alien-internals:unparse-alien-type
 	     (sb!alien-internals:alien-value-type object))))
 	(t
-	 (class-proper-name class)))
+	 (classoid-proper-name classoid)))
       name))))
 
-;;; FIXME: This belongs somewhere else, perhaps in code/array.lisp.
-(defun upgraded-array-element-type (spec)
-  #!+sb-doc
-  "Return the element type that will actually be used to implement an array
-   with the specifier :ELEMENT-TYPE Spec."
-  (if (unknown-type-p (specifier-type spec))
-      (error "undefined type: ~S" spec)
-      (type-specifier (array-type-specialized-element-type
-		       (specifier-type `(array ,spec))))))
-
 ;;;; equality predicates
 
 ;;; This is real simple, 'cause the compiler takes care of it.
@@ -145,9 +135,22 @@
   "Return T if OBJ1 and OBJ2 are the same object, otherwise NIL."
   (eq obj1 obj2))
 
+(defun bit-vector-= (x y)
+  (declare (type bit-vector x y))
+  (if (and (simple-bit-vector-p x)
+	   (simple-bit-vector-p y))
+      (bit-vector-= x y) ; DEFTRANSFORM
+      (and (= (length x) (length y))
+	   (do ((i 0 (1+ i))
+		(length (length x)))
+	       ((= i length) t)
+	     (declare (fixnum i))
+	     (unless (= (bit x i) (bit y i))
+	       (return nil))))))
+
 (defun equal (x y)
   #!+sb-doc
-  "Returns T if X and Y are EQL or if they are structured components
+  "Return T if X and Y are EQL or if they are structured components
   whose elements are EQUAL. Strings and bit-vectors are EQUAL if they
   are the same length and have identical components. Other arrays must be
   EQ to be EQUAL."
@@ -162,15 +165,7 @@
 	 (and (pathnamep y) (pathname= x y)))
 	((bit-vector-p x)
 	 (and (bit-vector-p y)
-	      (= (the fixnum (length x))
-		 (the fixnum (length y)))
-	      (do ((i 0 (1+ i))
-		   (length (length x)))
-		  ((= i length) t)
-		(declare (fixnum i))
-		(or (= (the fixnum (bit x i))
-		       (the fixnum (bit y i)))
-		    (return nil)))))
+	      (bit-vector-= x y)))
 	(t nil)))
 
 ;;; EQUALP comparison of HASH-TABLE values
@@ -192,7 +187,7 @@
 (defun equalp (x y)
   #+nil ; KLUDGE: If doc string, should be accurate: Talk about structures
   ; and HASH-TABLEs.
-  "Just like EQUAL, but more liberal in several respects.
+  "This is like EQUAL, except more liberal in several respects.
   Numbers may be of different types, as long as the values are identical
   after coercion. Characters may differ in alphabetic case. Vectors and
   arrays must have identical dimensions and EQUALP elements, but may differ
@@ -214,7 +209,7 @@
 		(len (layout-length layout-x)))
 	   (and (typep y 'instance)
 		(eq layout-x (%instance-layout y))
-		(structure-class-p (layout-class layout-x))
+		(structure-classoid-p (layout-classoid layout-x))
 		(do ((i 1 (1+ i)))
 		    ((= i len) t)
 		  (declare (fixnum i))
@@ -250,7 +245,7 @@
 
 (/show0 "about to do test cases in pred.lisp")
 #!+sb-test
-(let ((test-cases '((0.0 -0.0 t)
+(let ((test-cases `((0.0 ,(load-time-value (make-unportable-float :single-float-negative-zero)) t)
 		    (0.0 1.0 nil)
 		    (#c(1 0) #c(1.0 0) t)
 		    (#c(1.1 0) #c(11/10 0) nil) ; due to roundoff error