;;; Convert VECTOR into a MAKE-ARRAY followed by SETFs of all the
;;; elements.
-(def-source-transform vector (&rest elements)
- (if (byte-compiling)
- (values nil t)
- (let ((len (length elements))
- (n -1))
- (once-only ((n-vec `(make-array ,len)))
- `(progn
- ,@(mapcar #'(lambda (el)
- (once-only ((n-val el))
- `(locally (declare (optimize (safety 0)))
- (setf (svref ,n-vec ,(incf n))
- ,n-val))))
- elements)
- ,n-vec)))))
+(define-source-transform vector (&rest elements)
+ (let ((len (length elements))
+ (n -1))
+ (once-only ((n-vec `(make-array ,len)))
+ `(progn
+ ,@(mapcar #'(lambda (el)
+ (once-only ((n-val el))
+ `(locally (declare (optimize (safety 0)))
+ (setf (svref ,n-vec ,(incf n))
+ ,n-val))))
+ elements)
+ ,n-vec))))
;;; Just convert it into a MAKE-ARRAY.
-(def-source-transform make-string (length &key
- (element-type ''base-char)
- (initial-element
- '#.*default-init-char-form*))
- (if (byte-compiling)
- (values nil t)
- `(make-array (the index ,length)
- :element-type ,element-type
- :initial-element ,initial-element)))
+(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))
(defstruct (specialized-array-element-type-properties
(:conc-name saetp-)
(:copier nil))
;; the element type, e.g. #<BUILT-IN-CLASS BASE-CHAR (sealed)> or
;; #<SB-KERNEL:NUMERIC-TYPE (UNSIGNED-BYTE 4)>
- (ctype (required-argument) :type ctype :read-only t)
+ (ctype (missing-arg) :type ctype :read-only t)
;; what we get when the low-level vector-creation logic zeroes all
;; the bits (which also serves as the default value of MAKE-ARRAY's
;; :INITIAL-ELEMENT keyword)
- (initial-element-default (required-argument) :read-only t)
+ (initial-element-default (missing-arg) :read-only t)
;; how many bits per element
- (n-bits (required-argument) :type index :read-only t)
+ (n-bits (missing-arg) :type index :read-only t)
;; the low-level type code
- (typecode (required-argument) :type index :read-only t)
+ (typecode (missing-arg) :type index :read-only t)
;; the number of extra elements we use at the end of the array for
;; low level hackery (e.g., one element for arrays of BASE-CHAR,
;; which is used for a fixed #\NULL so that when we call out to C
;; we don't need to cons a new copy)
- (n-pad-elements (required-argument) :type index :read-only t))
+ (n-pad-elements (missing-arg) :type index :read-only t))
(defparameter *specialized-array-element-type-properties*
(map 'simple-vector
(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-type
+ `((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)
- (single-float 0.0s0 32 ,sb!vm:simple-array-single-float-type)
- (double-float 0.0d0 64 ,sb!vm:simple-array-double-float-type)
+ (single-float 0.0s0 32 ,sb!vm:simple-array-single-float-widetag)
+ (double-float 0.0d0 64 ,sb!vm:simple-array-double-float-widetag)
#!+long-float (long-float 0.0L0 #!+x86 96 #!+sparc 128
- ,sb!vm:simple-array-long-float-type)
- (bit 0 1 ,sb!vm:simple-bit-vector-type)
- ((unsigned-byte 2) 0 2 ,sb!vm:simple-array-unsigned-byte-2-type)
- ((unsigned-byte 4) 0 4 ,sb!vm:simple-array-unsigned-byte-4-type)
- ((unsigned-byte 8) 0 8 ,sb!vm:simple-array-unsigned-byte-8-type)
- ((unsigned-byte 16) 0 16 ,sb!vm:simple-array-unsigned-byte-16-type)
- ((unsigned-byte 32) 0 32 ,sb!vm:simple-array-unsigned-byte-32-type)
- ((signed-byte 8) 0 8 ,sb!vm:simple-array-signed-byte-8-type)
- ((signed-byte 16) 0 16 ,sb!vm:simple-array-signed-byte-16-type)
- ((signed-byte 30) 0 32 ,sb!vm:simple-array-signed-byte-30-type)
- ((signed-byte 32) 0 32 ,sb!vm:simple-array-signed-byte-32-type)
+ ,sb!vm:simple-array-long-float-widetag)
+ (bit 0 1 ,sb!vm:simple-bit-vector-widetag)
+ ((unsigned-byte 2) 0 2 ,sb!vm:simple-array-unsigned-byte-2-widetag)
+ ((unsigned-byte 4) 0 4 ,sb!vm:simple-array-unsigned-byte-4-widetag)
+ ((unsigned-byte 8) 0 8 ,sb!vm:simple-array-unsigned-byte-8-widetag)
+ ((unsigned-byte 16) 0 16 ,sb!vm:simple-array-unsigned-byte-16-widetag)
+ ((unsigned-byte 32) 0 32 ,sb!vm:simple-array-unsigned-byte-32-widetag)
+ ((signed-byte 8) 0 8 ,sb!vm:simple-array-signed-byte-8-widetag)
+ ((signed-byte 16) 0 16 ,sb!vm:simple-array-signed-byte-16-widetag)
+ ((signed-byte 30) 0 32 ,sb!vm:simple-array-signed-byte-30-widetag)
+ ((signed-byte 32) 0 32 ,sb!vm:simple-array-signed-byte-32-widetag)
((complex single-float) #C(0.0s0 0.0s0) 64
- ,sb!vm:simple-array-complex-single-float-type)
+ ,sb!vm:simple-array-complex-single-float-widetag)
((complex double-float) #C(0.0d0 0.0d0) 128
- ,sb!vm:simple-array-complex-double-float-type)
+ ,sb!vm:simple-array-complex-double-float-widetag)
#!+long-float ((complex long-float) #C(0.0L0 0.0L0)
#!+x86 192 #!+sparc 256
- ,sb!vm:simple-array-complex-long-float-type)
- (t 0 32 ,sb!vm:simple-vector-type))))
+ ,sb!vm:simple-array-complex-long-float-widetag)
+ (t 0 32 ,sb!vm:simple-vector-widetag))))
;;; The integer type restriction on the length ensures that it will be
;;; a vector. The lack of :ADJUSTABLE, :FILL-POINTER, and
'length
`(+ length ,n-pad-elements)))
(n-words-form
- (if (>= n-bits-per-element sb!vm:word-bits)
+ (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:word-bits)))
- (let ((n-elements-per-word (/ sb!vm:word-bits
+ ,(/ 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))))
(continuation-value element-type))
(t '*))
,(make-list rank :initial-element '*))))
- `(let ((header (make-array-header sb!vm:simple-array-type ,rank)))
+ `(let ((header (make-array-header sb!vm:simple-array-widetag ,rank)))
(setf (%array-fill-pointer header) ,total-size)
(setf (%array-fill-pointer-p header) nil)
(setf (%array-available-elements header) ,total-size)
(give-up-ir1-transform
"The array dimensions are unknown; must call ARRAY-DIMENSION at runtime."))
(unless (> (length dims) axis)
- (abort-ir1-transform "The array has dimensions ~S, ~D is too large."
+ (abort-ir1-transform "The array has dimensions ~S, ~W is too large."
dims
axis))
(let ((dim (nth axis dims)))
(cond (,end
(unless (or ,unsafe? (<= ,end ,size))
,(if fail-inline?
- `(error "End ~D is greater than total size ~D."
+ `(error "End ~W is greater than total size ~W."
,end ,size)
`(failed-%with-array-data ,array ,start ,end)))
,end)
(t ,size))))
(unless (or ,unsafe? (<= ,start ,defaulted-end))
,(if fail-inline?
- `(error "Start ~D is greater than end ~D." ,start ,defaulted-end)
+ `(error "Start ~W is greater than end ~W." ,start ,defaulted-end)
`(failed-%with-array-data ,array ,start ,end)))
(do ((,data ,array (%array-data-vector ,data))
(,cumulative-offset 0
;;; assertions on the array.
(macrolet ((define-frob (reffer setter type)
`(progn
- (def-source-transform ,reffer (a &rest i)
- (if (byte-compiling)
- (values nil t)
- `(aref (the ,',type ,a) ,@i)))
- (def-source-transform ,setter (a &rest i)
- (if (byte-compiling)
- (values nil t)
- `(%aset (the ,',type ,a) ,@i))))))
+ (define-source-transform ,reffer (a &rest i)
+ `(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)
projects / sbcl.git / blobdiff