- (collect ((res))
- (when (eq (array-type-dimensions stype) '*)
- (res `(= (array-rank ,obj) ,(length dims))))
- (do ((i 0 (1+ i))
- (dim dims (cdr dim)))
- ((null dim))
- (let ((dim (car dim)))
- (unless (eq dim '*)
- (res `(= (array-dimension ,obj ,i) ,dim)))))
- (res)))))
+ (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))))))