(block nil
(let ((dimensions (array-type-dimensions-or-give-up
(lvar-conservative-type array))))
+ ;; Might be *. (Note: currently this is never true, because the type
+ ;; derivation infers the rank from the call to ARRAY-IN-BOUNDS-P, but
+ ;; let's keep this future proof.)
+ (when (eq '* dimensions)
+ (give-up-ir1-transform "array bounds unknown"))
;; shortcut for zero dimensions
(when (some (lambda (dim)
(and (bound-known-p dim) (zerop dim)))
(flet ((subscript-bounds (subscript)
(let* ((type1 (lvar-type subscript))
(type2 (if (csubtypep type1 (specifier-type 'integer))
- (weaken-integer-type type1)
+ (weaken-integer-type type1 :range-only t)
(give-up)))
- (low (numeric-type-low type2))
+ (low (if (integer-type-p type2)
+ (numeric-type-low type2)
+ (give-up)))
(high (numeric-type-high type2)))
(cond
((and (or (not (bound-known-p low)) (minusp low))
(values dimensions nil))))
(let ((initial-contents (getf keyargs :initial-contents)))
(when (and initial-contents rank)
- (setf (getf keyargs :initial-contents)
+ (setf keyargs (copy-list keyargs)
+ (getf keyargs :initial-contents)
(rewrite-initial-contents rank initial-contents env))))
`(locally (declare (notinline list vector))
(make-array ,new-dimensions ,@keyargs)))))
(unless (constant-lvar-p dims)
(give-up-ir1-transform
"The dimension list is not constant; cannot open code array creation."))
- (let ((dims (lvar-value dims)))
+ (let ((dims (lvar-value dims))
+ (element-type-ctype (and (constant-lvar-p element-type)
+ (ir1-transform-specifier-type
+ (lvar-value element-type)))))
+ (when (unknown-type-p element-type-ctype)
+ (give-up-ir1-transform))
(unless (every #'integerp dims)
(give-up-ir1-transform
"The dimension list contains something other than an integer: ~S"
(rank (length dims))
(spec `(simple-array
,(cond ((null element-type) t)
- ((and (constant-lvar-p element-type)
- (ir1-transform-specifier-type
- (lvar-value element-type)))
+ (element-type-ctype
(sb!xc:upgraded-array-element-type
(lvar-value element-type)))
(t '*))
`(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))
+;;; We transform SVREF and %SVSET directly into DATA-VECTOR-REF/SET: this is
+;;; around 100 times faster than going through the general-purpose AREF
+;;; transform which ends up doing a lot of work -- and introducing many
+;;; intermediate lambdas, each meaning a new trip through the compiler -- to
+;;; get the same result.
+;;;
+;;; FIXME: [S]CHAR, and [S]BIT above would almost certainly benefit from a similar
+;;; treatment.
+(define-source-transform svref (vector index)
+ (let ((elt-type (or (when (symbolp vector)
+ (let ((var (lexenv-find vector vars)))
+ (when (lambda-var-p var)
+ (type-specifier
+ (array-type-declared-element-type (lambda-var-type var))))))
+ t)))
+ (with-unique-names (n-vector)
+ `(let ((,n-vector ,vector))
+ (the ,elt-type (data-vector-ref
+ (the simple-vector ,n-vector)
+ (%check-bound ,n-vector (length ,n-vector) ,index)))))))
+
+(define-source-transform %svset (vector index value)
+ (let ((elt-type (or (when (symbolp vector)
+ (let ((var (lexenv-find vector vars)))
+ (when (lambda-var-p var)
+ (type-specifier
+ (array-type-declared-element-type (lambda-var-type var))))))
+ t)))
+ (with-unique-names (n-vector)
+ `(let ((,n-vector ,vector))
+ (truly-the ,elt-type (data-vector-set
+ (the simple-vector ,n-vector)
+ (%check-bound ,n-vector (length ,n-vector) ,index)
+ (the ,elt-type ,value)))))))
+
(macrolet (;; This is a handy macro for computing the row-major index
;; given a set of indices. We wrap each index with a call
;; to %CHECK-BOUND to ensure that everything works out