array
(make-array-type :complexp t
:element-type *wild-type*)
- (lexenv-policy (node-lexenv (continuation-dest array)))))
+ (lexenv-policy (node-lexenv (continuation-dest array))))
+ nil)
;;; Return true if ARG is NIL, or is a constant-continuation whose
;;; value is NIL, false otherwise.
(defoptimizer (%with-array-data derive-type) ((array start end))
(let ((atype (continuation-type array)))
(when (array-type-p atype)
- (values-specifier-type
- `(values (simple-array ,(type-specifier
- (array-type-specialized-element-type atype))
- (*))
- index index index)))))
+ (specifier-type
+ `(simple-array ,(type-specifier
+ (array-type-specialized-element-type atype))
+ (*))))))
(defoptimizer (array-row-major-index derive-type) ((array &rest indices))
(assert-array-rank array (length indices))
(continuation-value element-type))
(t
'*))
- ,(cond ((not simple)
- '*)
- ((constant-continuation-p dims)
- (let ((val (continuation-value dims)))
- (if (listp val) val (list val))))
+ ,(cond ((constant-continuation-p dims)
+ (let* ((val (continuation-value dims))
+ (cdims (if (listp val) val (list val))))
+ (if (or simple (/= (length cdims) 1))
+ cdims
+ '(*))))
((csubtypep (continuation-type dims)
(specifier-type 'integer))
'(*))
,n-vec))))
;;; Just convert it into a MAKE-ARRAY.
-(define-source-transform make-string (length &key
- (element-type ''base-char)
- (initial-element
- '#.*default-init-char-form*))
- `(make-array (the index ,length)
- :element-type ,element-type
- :initial-element ,initial-element))
+(deftransform make-string ((length &key
+ (element-type 'base-char)
+ (initial-element
+ #.*default-init-char-form*)))
+ '(make-array (the index length)
+ :element-type element-type
+ :initial-element initial-element))
(defstruct (specialized-array-element-type-properties
(:conc-name saetp-)
(destructuring-bind (type-spec &rest rest) args
(let ((ctype (specifier-type type-spec)))
(apply #'!make-saetp ctype rest))))
- `((base-char ,(code-char 0) 8 ,sb!vm:simple-string-widetag
+ `(;; Erm. Yeah. There aren't a lot of things that make sense
+ ;; for an initial element for (ARRAY NIL). -- CSR, 2002-03-07
+ (nil '#:mu 0 ,sb!vm:simple-array-nil-widetag)
+ (base-char ,(code-char 0) 8 ,sb!vm:simple-string-widetag
;; (SIMPLE-STRINGs are stored with an extra trailing
;; #\NULL for convenience in calling out to C.)
:n-pad-elements 1)
(when (constant-continuation-p initial-element)
(let ((value (continuation-value initial-element)))
(cond
- ((not (csubtypep (ctype-of value)
- (saetp-ctype saetp)))
+ ((not (ctypep value (saetp-ctype saetp)))
;; this case will cause an error at runtime, so we'd
;; better WARN about it now.
(compiler-warn "~@<~S is not a ~S (which is the ~
value
(type-specifier (saetp-ctype saetp))
eltype))
- ((not (csubtypep (ctype-of value) eltype-type))
+ ((not (ctypep value eltype-type))
;; this case will not cause an error at runtime, but
;; it's still worth STYLE-WARNing about.
(compiler-style-warn "~S is not a ~S."
'length
`(+ length ,n-pad-elements)))
(n-words-form
- (if (>= n-bits-per-element sb!vm:n-word-bits)
- `(* ,padded-length-form
- (the fixnum ; i.e., not RATIO
- ,(/ n-bits-per-element sb!vm:n-word-bits)))
- (let ((n-elements-per-word (/ sb!vm:n-word-bits
- n-bits-per-element)))
- (declare (type index n-elements-per-word)) ; i.e., not RATIO
- `(ceiling ,padded-length-form ,n-elements-per-word)))))
+ (cond
+ ((= n-bits-per-element 0) 0)
+ ((>= n-bits-per-element sb!vm:n-word-bits)
+ `(* ,padded-length-form
+ (the fixnum ; i.e., not RATIO
+ ,(/ n-bits-per-element sb!vm:n-word-bits))))
+ (t
+ (let ((n-elements-per-word (/ sb!vm:n-word-bits
+ n-bits-per-element)))
+ (declare (type index n-elements-per-word)) ; i.e., not RATIO
+ `(ceiling ,padded-length-form ,n-elements-per-word))))))
(values
`(truly-the ,result-type-spec
(allocate-vector ,typecode length ,n-words-form))
;;; If a simple array with known dimensions, then VECTOR-LENGTH is a
;;; compile-time constant.
-(deftransform vector-length ((vector) ((simple-array * (*))))
+(deftransform vector-length ((vector))
(let ((vtype (continuation-type vector)))
- (if (array-type-p vtype)
+ (if (and (array-type-p vtype)
+ (not (array-type-complexp vtype)))
(let ((dim (first (array-type-dimensions vtype))))
(when (eq dim '*) (give-up-ir1-transform))
dim)
(element-type '*)
unsafe?
fail-inline?)
- (let ((size (gensym "SIZE-"))
- (defaulted-end (gensym "DEFAULTED-END-"))
- (data (gensym "DATA-"))
- (cumulative-offset (gensym "CUMULATIVE-OFFSET-")))
+ (with-unique-names (size defaulted-end data cumulative-offset)
`(let* ((,size (array-total-size ,array))
(,defaulted-end
(cond (,end
`(aref (the ,',type ,a) ,@i))
(define-source-transform ,setter (a &rest i)
`(%aset (the ,',type ,a) ,@i)))))
- (define-frob svref %svset simple-vector)
- (define-frob schar %scharset simple-string)
- (define-frob char %charset string)
(define-frob sbit %sbitset (simple-array bit))
(define-frob bit %bitset (array bit)))
+(macrolet ((define-frob (reffer setter type)
+ `(progn
+ (define-source-transform ,reffer (a i)
+ `(aref (the ,',type ,a) ,i))
+ (define-source-transform ,setter (a i v)
+ `(%aset (the ,',type ,a) ,i ,v)))))
+ (define-frob svref %svset simple-vector)
+ (define-frob schar %scharset simple-string)
+ (define-frob char %charset string))
(macrolet (;; This is a handy macro for computing the row-major index
;; given a set of indices. We wrap each index with a call
(cond ((csubtypep type (specifier-type '(simple-array * (*))))
;; no array header
nil)
- ((and (listp dims) (> (length dims) 1))
+ ((and (listp dims) (/= (length dims) 1))
;; multi-dimensional array, will have a header
t)
(t