(let ((simple (and (unsupplied-or-nil adjustable)
(unsupplied-or-nil displaced-to)
(unsupplied-or-nil fill-pointer))))
- (specifier-type
- `(,(if simple 'simple-array 'array)
- ,(cond ((not element-type) t)
- ((constant-continuation-p element-type)
- (continuation-value element-type))
- (t
- '*))
- ,(cond ((not simple)
- '*)
- ((constant-continuation-p dims)
- (let ((val (continuation-value dims)))
- (if (listp val) val (list val))))
- ((csubtypep (continuation-type dims)
- (specifier-type 'integer))
- '(*))
- (t
- '*))))))
+ (or (careful-specifier-type
+ `(,(if simple 'simple-array 'array)
+ ,(cond ((not element-type) t)
+ ((constant-continuation-p element-type)
+ (continuation-value element-type))
+ (t
+ '*))
+ ,(cond ((not simple)
+ '*)
+ ((constant-continuation-p dims)
+ (let ((val (continuation-value dims)))
+ (if (listp val) val (list val))))
+ ((csubtypep (continuation-type dims)
+ (specifier-type 'integer))
+ '(*))
+ (t
+ '*))))
+ (specifier-type 'array))))
;;; Complex array operations should assert that their array argument
;;; is complex. In SBCL, vectors with fill-pointers are complex.
"ELEMENT-TYPE is not constant."))
(t
(continuation-value element-type))))
- (eltype-type (specifier-type eltype))
+ (eltype-type (ir1-transform-specifier-type eltype))
(saetp (find-if (lambda (saetp)
(csubtypep eltype-type (saetp-ctype saetp)))
*specialized-array-element-type-properties*))
(unless saetp
(give-up-ir1-transform "ELEMENT-TYPE not found in *SAETP*: ~S" eltype))
-
+
(cond ((or (null initial-element)
(and (constant-continuation-p initial-element)
(eql (continuation-value initial-element)
(%data-vector-and-index array 0)
(fill vector initial-element))
array)))))
-
+
;;; The integer type restriction on the length ensures that it will be
;;; a vector. The lack of :ADJUSTABLE, :FILL-POINTER, and
;;; :DISPLACED-TO keywords ensures that it will be simple; the lack of
(continuation-value length)
'*))
(result-type-spec `(simple-array ,eltype (,len)))
- (eltype-type (specifier-type eltype))
+ (eltype-type (ir1-transform-specifier-type eltype))
(saetp (find-if (lambda (saetp)
(csubtypep eltype-type (saetp-ctype saetp)))
*specialized-array-element-type-properties*)))
,@(when offset-var `(,offset-var)))
(if (not (array-header-p ,n-array))
(let ((,n-array ,n-array))
- (declare (type (simple-array * (*)) ,n-array))
+ ;; The #-CMU is because tonyms reported (sbcl-devel
+ ;; 2002-09-29) that this declaration confuses old CMU
+ ;; CL on x86 Debian 2.2. -- WHN 2002-10-02
+ #-cmu (declare (type (simple-array * (*)) ,n-array))
,(once-only ((n-len `(length ,n-array))
(n-end `(or ,n-evalue ,n-len)))
`(if (<= ,n-svalue ,n-end ,n-len)
;; success
(values ,n-array ,n-svalue ,n-end 0)
- (failed-%with-array-data ,n-array ,n-svalue ,n-evalue))))
+ (failed-%with-array-data ,n-array
+ ,n-svalue
+ ,n-evalue))))
(,(if force-inline '%with-array-data-macro '%with-array-data)
,n-array ,n-svalue ,n-evalue))
,@forms)))