+ (dims (array-type-dimensions type)))
+ (unless (or (eq dims '*)
+ (equal dims (array-type-dimensions stype)))
+ (cond ((cdr dims)
+ (values `((array-header-p ,obj)
+ ,@(when (eq (array-type-dimensions stype) '*)
+ `((= (%array-rank ,obj) ,(length dims))))
+ ,@(loop for d in dims
+ for i from 0
+ unless (eq '* d)
+ collect `(= (%array-dimension ,obj ,i) ,d)))
+ t))
+ ((not dims)
+ (values `((array-header-p ,obj)
+ (= (%array-rank ,obj) 0))
+ t))
+ ((not (array-type-complexp type))
+ (if (csubtypep stype (specifier-type 'vector))
+ (values (unless (eq '* (car dims))
+ `((= (vector-length ,obj) ,@dims)))
+ nil)
+ (values (if (eq '* (car dims))
+ `((not (array-header-p ,obj)))
+ `((not (array-header-p ,obj))
+ (= (vector-length ,obj) ,@dims)))
+ nil)))
+ (t
+ (values (unless (eq '* (car dims))
+ `((if (array-header-p ,obj)
+ (= (%array-dimension ,obj 0) ,@dims)
+ (= (vector-length ,obj) ,@dims))))
+ nil))))))
+
+;;; Return forms to test that OBJ has the element-type specified by type
+;;; specified by TYPE, where STYPE is the type we have checked against (which
+;;; is the same but for dimensions and element type). If HEADERP is true, OBJ
+;;; is guaranteed to be an array-header.
+(defun test-array-element-type (obj type stype headerp)
+ (declare (type array-type type stype))
+ (let ((obj `(truly-the ,(type-specifier stype) ,obj))
+ (eltype (array-type-specialized-element-type type)))
+ (unless (or (type= eltype (array-type-specialized-element-type stype))
+ (eq eltype *wild-type*))
+ (let ((typecode (sb!vm:saetp-typecode (find-saetp-by-ctype eltype))))
+ (with-unique-names (data)
+ (if (and headerp (not (array-type-complexp stype)))
+ ;; If we know OBJ is an array header, and that the array is
+ ;; simple, we also know there is exactly one indirection to
+ ;; follow.
+ `((eq (%other-pointer-widetag (%array-data-vector ,obj)) ,typecode))
+ `((do ((,data ,(if headerp `(%array-data-vector ,obj) obj)
+ (%array-data-vector ,data)))
+ ((not (array-header-p ,data))
+ (eq (%other-pointer-widetag ,data) ,typecode))))))))))