(assert-array-rank array (length indices))
(derive-aref-type array))
-(defoptimizer (%aset derive-type) ((array &rest stuff))
- (assert-array-rank array (1- (length stuff)))
- (assert-new-value-type (car (last stuff)) array))
+(defoptimizer ((setf aref) derive-type) ((new-value array &rest subscripts))
+ (assert-array-rank array (length subscripts))
+ (assert-new-value-type new-value array))
(macrolet ((define (name)
`(defoptimizer (,name derive-type) ((array index))
(t
(let ((n-elements-per-word (/ sb!vm:n-word-bits n-bits)))
(declare (type index n-elements-per-word)) ; i.e., not RATIO
- `(ceiling ,padded-length-form ,n-elements-per-word)))))))
+ `(ceiling (truly-the index ,padded-length-form)
+ ,n-elements-per-word)))))))
(result-spec
`(simple-array ,(sb!vm:saetp-specifier saetp) (,(or c-length '*))))
(alloc-form
- `(truly-the ,result-spec
- (allocate-vector ,typecode (the index length) ,n-words-form))))
+ `(truly-the ,result-spec
+ (allocate-vector ,typecode (the index length) ,n-words-form))))
(cond ((and initial-element initial-contents)
(abort-ir1-transform "Both ~S and ~S specified."
:initial-contents :initial-element))
(t :maybe)))
;;; If we can tell the rank from the type info, use it instead.
-(deftransform array-rank ((array))
+(deftransform array-rank ((array) (array) * :node node)
(let ((array-type (lvar-type array)))
(let ((dims (array-type-dimensions-or-give-up array-type)))
(cond ((listp dims)
(length dims))
- ((eq t (array-type-complexp array-type))
+ ((eq t (and (array-type-p array-type)
+ (array-type-complexp array-type)))
'(%array-rank array))
(t
+ (delay-ir1-transform node :constraint)
`(if (array-header-p array)
(%array-rank array)
1))))))
\f
;;;; array accessors
-;;; We convert all typed array accessors into AREF and %ASET with type
+;;; We convert all typed array accessors into AREF and (SETF AREF) with type
;;; assertions on the array.
-(macrolet ((define-bit-frob (reffer setter simplep)
+(macrolet ((define-bit-frob (reffer simplep)
`(progn
(define-source-transform ,reffer (a &rest i)
`(aref (the (,',(if simplep 'simple-array 'array)
bit
,(mapcar (constantly '*) i))
,a) ,@i))
- (define-source-transform ,setter (a &rest i)
- `(%aset (the (,',(if simplep 'simple-array 'array)
- bit
- ,(cdr (mapcar (constantly '*) i)))
- ,a) ,@i)))))
- (define-bit-frob sbit %sbitset t)
- (define-bit-frob bit %bitset nil))
+ (define-source-transform (setf ,reffer) (value a &rest i)
+ `(setf (aref (the (,',(if simplep 'simple-array 'array)
+ bit
+ ,(mapcar (constantly '*) i))
+ ,a) ,@i)
+ ,value)))))
+ (define-bit-frob sbit t)
+ (define-bit-frob bit nil))
+
(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)))))
+ `(setf (aref (the ,',type ,a) ,i) ,v)))))
(define-frob schar %scharset simple-string)
(define-frob char %charset string))
(define-source-transform svref (vector index)
(let ((elt-type (or (when (symbolp vector)
(let ((var (lexenv-find vector vars)))
- (when var
+ (when (lambda-var-p var)
(type-specifier
(array-type-declared-element-type (lambda-var-type var))))))
t)))
(define-source-transform %svset (vector index value)
(let ((elt-type (or (when (symbolp vector)
(let ((var (lexenv-find vector vars)))
- (when var
+ (when (lambda-var-p var)
(type-specifier
(array-type-declared-element-type (lambda-var-type var))))))
t)))
(push (make-symbol (format nil "DIM-~D" i)) dims))
(setf n-indices (nreverse n-indices))
(setf dims (nreverse dims))
- `(lambda (,',array ,@n-indices
- ,@',(when new-value (list new-value)))
+ `(lambda (,@',(when new-value (list new-value))
+ ,',array ,@n-indices)
+ (declare (ignorable ,',array))
(let* (,@(let ((,index -1))
(mapcar (lambda (name)
`(,name (array-dimension
(with-row-major-index (array indices index)
index))
- ;; Convert AREF and %ASET into a HAIRY-DATA-VECTOR-REF (or
+ ;; Convert AREF and (SETF AREF) into a HAIRY-DATA-VECTOR-REF (or
;; HAIRY-DATA-VECTOR-SET) with the set of indices replaced with the an
;; expression for the row major index.
(deftransform aref ((array &rest indices))
(with-row-major-index (array indices index)
(hairy-data-vector-ref array index)))
- (deftransform %aset ((array &rest stuff))
- (let ((indices (butlast stuff)))
- (with-row-major-index (array indices index new-value)
- (hairy-data-vector-set array index new-value)))))
+ (deftransform (setf aref) ((new-value array &rest subscripts))
+ (with-row-major-index (array subscripts index new-value)
+ (hairy-data-vector-set array index new-value))))
;; For AREF of vectors we do the bounds checking in the callee. This
;; lets us do a significantly more efficient check for simple-arrays
`(hairy-data-vector-ref array index))
(t `(hairy-data-vector-ref/check-bounds array index)))))
-(deftransform %aset ((array index new-value) (t t t) * :node node)
+(deftransform (setf aref) ((new-value array index) (t t t) * :node node)
(if (policy node (zerop insert-array-bounds-checks))
`(hairy-data-vector-set array index new-value)
`(hairy-data-vector-set/check-bounds array index new-value)))
projects / sbcl.git / blobdiff