- (constructor
- `(truly-the ,spec
- (allocate-vector ,typecode length ,n-words-form))))
- (values
- (cond ((and default-initial-element
- (or (null initial-element)
- (and (constant-continuation-p initial-element)
- (eql (continuation-value initial-element)
- default-initial-element))))
- (unless (csubtypep (ctype-of default-initial-element)
- eltype-type)
- ;; This situation arises e.g. in
- ;; (MAKE-ARRAY 4 :ELEMENT-TYPE '(INTEGER 1 5))
- ;; ANSI's definition of MAKE-ARRAY says "If
- ;; INITIAL-ELEMENT is not supplied, the consequences
- ;; of later reading an uninitialized element of
- ;; new-array are undefined," so this could be legal
- ;; code as long as the user plans to write before he
- ;; reads, and if he doesn't we're free to do
- ;; anything we like. But in case the user doesn't
- ;; know to write before he reads, we'll signal a
- ;; STYLE-WARNING in case he didn't realize this.
- ;;
- ;; FIXME: should be STYLE-WARNING, not note
- (compiler-note "The default initial element ~S is not a ~S."
- default-initial-element
- eltype))
- constructor)
- (t
- `(truly-the ,spec (fill ,constructor initial-element))))
- '((declare (type index length)))))))
+ (bare-constructor-form
+ `(truly-the ,result-type-spec
+ (allocate-vector ,typecode length ,n-words-form)))
+ (initial-element-form (if initial-element
+ 'initial-element
+ initial-element-default)))
+ (values
+ (cond (;; Can we skip the FILL step?
+ (or (null initial-element)
+ (and (constant-continuation-p initial-element)
+ (eql (continuation-value initial-element)
+ initial-element-default)))
+ (unless (csubtypep (ctype-of initial-element-default)
+ eltype-type)
+ ;; This situation arises e.g. in
+ ;; (MAKE-ARRAY 4 :ELEMENT-TYPE '(INTEGER 1 5))
+ ;; ANSI's definition of MAKE-ARRAY says "If
+ ;; INITIAL-ELEMENT is not supplied, the consequences
+ ;; of later reading an uninitialized element of
+ ;; new-array are undefined," so this could be legal
+ ;; code as long as the user plans to write before he
+ ;; reads, and if he doesn't we're free to do anything
+ ;; we like. But in case the user doesn't know to write
+ ;; elements before he reads elements (or to read
+ ;; manuals before he writes code:-), we'll signal a
+ ;; STYLE-WARNING in case he didn't realize this.
+ (compiler-note "The default initial element ~S is not a ~S."
+ initial-element-default
+ eltype))
+ bare-constructor-form)
+ (t
+ `(truly-the ,result-type-spec
+ (fill ,bare-constructor-form
+ ,initial-element-form))))
+ '((declare (type index length)))))))