- (replace (make-array (length x) :element-type 'character) x)))
- ;; Handle specialized element types for 1D arrays.
- ((csubtypep tspec (specifier-type '(array * (*))))
- ;; Can we avoid checking for dimension issues like (COERCE FOO
- ;; '(SIMPLE-VECTOR 5)) returning a vector of length 6?
- (if (or (policy node (< safety 3)) ; no need in unsafe code
- (and (array-type-p tspec) ; no need when no dimensions
- (equal (array-type-dimensions tspec) '(*))))
- ;; We can!
- (let ((array-type
- (if (csubtypep tspec (specifier-type 'simple-array))
- 'simple-array
- 'array)))
- (dolist (etype
- #+sb-xc-host '(t bit character)
- #-sb-xc-host sb!kernel::*specialized-array-element-types*
- (give-up-ir1-transform))
- (when etype
- (let ((spec `(,array-type ,etype (*))))
- (when (csubtypep tspec (specifier-type spec))
- ;; Is the result required to be non-simple?
- (let ((result-simple
- (or (eq 'simple-array array-type)
- (neq *empty-type*
- (type-intersection
- tspec (specifier-type 'simple-array))))))
- (return
- `(if (typep x ',spec)
- x
- (replace
- (make-array (length x) :element-type ',etype
- ,@(unless result-simple
- (list :fill-pointer t
- :adjustable t)))
- x)))))))))
- ;; No, duh. Dimension checking required.
- (give-up-ir1-transform
- "~@<~S specifies dimensions other than (*) in safe code.~:@>"
- tval)))
- (t
- (give-up-ir1-transform
- "~@<open coding coercion to ~S not implemented.~:@>"
- tval)))))))
+ (replace (make-array (length x) :element-type 'character) x))))
+ ;; Special case VECTOR
+ ((eq tval 'vector)
+ `(the ,tval
+ (if (vectorp x)
+ x
+ (replace (make-array (length x)) x))))
+ ;; Handle specialized element types for 1D arrays.
+ ((csubtypep tspec (specifier-type '(array * (*))))
+ ;; Can we avoid checking for dimension issues like (COERCE FOO
+ ;; '(SIMPLE-VECTOR 5)) returning a vector of length 6?
+ ;;
+ ;; CLHS actually allows this for all code with SAFETY < 3,
+ ;; but we're a conservative bunch.
+ (if (or (policy node (zerop safety)) ; no need in unsafe code
+ (and (array-type-p tspec) ; no need when no dimensions
+ (equal (array-type-dimensions tspec) '(*))))
+ ;; We can!
+ (multiple-value-bind (vtype etype complexp) (simplify-vector-type tspec)
+ (unless vtype
+ (give-up-ir1-transform))
+ `(the ,vtype
+ (if (typep x ',vtype)
+ x
+ (replace
+ (make-array (length x) :element-type ',etype
+ ,@(when complexp
+ (list :fill-pointer t
+ :adjustable t)))
+ x))))
+ ;; No, duh. Dimension checking required.
+ (give-up-ir1-transform
+ "~@<~S specifies dimensions other than (*) in safe code.~:@>"
+ tval)))
+ (t
+ (give-up-ir1-transform
+ "~@<open coding coercion to ~S not implemented.~:@>"
+ tval))))))