"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
,(sb!alien-internals:unparse-alien-type
(sb!alien-internals:alien-value-type object))))
(t
- (class-proper-name class)))
+ (classoid-proper-name classoid)))
name))))
\f
-;;; 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))))))
-\f
;;;; equality predicates
;;; This is real simple, 'cause the compiler takes care of it.
"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
"Return T if X and Y are EQL or if they are structured components
(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
(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))
(/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