+(deftransform make-array ((dims &key initial-element element-type
+ adjustable fill-pointer)
+ (t &rest *))
+ (when (null initial-element)
+ (give-up-ir1-transform))
+ (let* ((eltype (cond ((not element-type) t)
+ ((not (constant-continuation-p element-type))
+ (give-up-ir1-transform
+ "ELEMENT-TYPE is not constant."))
+ (t
+ (continuation-value element-type))))
+ (eltype-type (ir1-transform-specifier-type eltype))
+ (saetp (find-if (lambda (saetp)
+ (csubtypep eltype-type (saetp-ctype saetp)))
+ *specialized-array-element-type-properties*))
+ (creation-form `(make-array dims :element-type ',eltype
+ ,@(when fill-pointer
+ '(:fill-pointer fill-pointer))
+ ,@(when adjustable
+ '(:adjustable adjustable)))))
+
+ (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)
+ (saetp-initial-element-default saetp))))
+ (unless (csubtypep (ctype-of (saetp-initial-element-default saetp))
+ 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-style-warn "The default initial element ~S is not a ~S."
+ (saetp-initial-element-default saetp)
+ eltype))
+ creation-form)
+ (t
+ `(let ((array ,creation-form))
+ (multiple-value-bind (vector)
+ (%data-vector-and-index array 0)
+ (fill vector initial-element))
+ array)))))
+