projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
(I seem to've screwed up during the checkin of 0.pre7.131 before, so
[sbcl.git]
/
src
/
code
/
array.lisp
diff --git
a/src/code/array.lisp
b/src/code/array.lisp
index
5d86d2f
..
8adb473
100644
(file)
--- a/
src/code/array.lisp
+++ b/
src/code/array.lisp
@@
-61,11
+61,11
@@
(eval-when (:compile-toplevel :execute)
(sb!xc:defmacro pick-vector-type (type &rest specs)
(eval-when (:compile-toplevel :execute)
(sb!xc:defmacro pick-vector-type (type &rest specs)
- `(cond ,@(mapcar #'(lambda (spec)
- `(,(if (eq (car spec) t)
- t
- `(subtypep ,type ',(car spec)))
- ,@(cdr spec)))
+ `(cond ,@(mapcar (lambda (spec)
+ `(,(if (eq (car spec) t)
+ t
+ `(subtypep ,type ',(car spec)))
+ ,@(cdr spec)))
specs))))
;;; These functions are used in the implementation of MAKE-ARRAY for
specs))))
;;; These functions are used in the implementation of MAKE-ARRAY for
@@
-86,7
+86,7
@@
((t)
(values #.sb!vm:simple-vector-widetag #.sb!vm:n-word-bits))
((character base-char standard-char)
((t)
(values #.sb!vm:simple-vector-widetag #.sb!vm:n-word-bits))
((character base-char standard-char)
- (values #.sb!vm:simple-string-widetag #.sb!vm:byte-bits))
+ (values #.sb!vm:simple-string-widetag #.sb!vm:n-byte-bits))
((bit)
(values #.sb!vm:simple-bit-vector-widetag 1))
;; OK, we have to wade into SUBTYPEPing after all.
((bit)
(values #.sb!vm:simple-bit-vector-widetag 1))
;; OK, we have to wade into SUBTYPEPing after all.
@@
-94,7
+94,7
@@
;; FIXME: The data here are redundant with
;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
(pick-vector-type type
;; FIXME: The data here are redundant with
;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
(pick-vector-type type
- (base-char (values #.sb!vm:simple-string-widetag #.sb!vm:byte-bits))
+ (base-char (values #.sb!vm:simple-string-widetag #.sb!vm:n-byte-bits))
(bit (values #.sb!vm:simple-bit-vector-widetag 1))
((unsigned-byte 2)
(values #.sb!vm:simple-array-unsigned-byte-2-widetag 2))
(bit (values #.sb!vm:simple-bit-vector-widetag 1))
((unsigned-byte 2)
(values #.sb!vm:simple-array-unsigned-byte-2-widetag 2))
@@
-182,8
+182,8
@@
(error "can't specify both :INITIAL-ELEMENT and ~
:INITIAL-CONTENTS"))
(unless (= length (length initial-contents))
(error "can't specify both :INITIAL-ELEMENT and ~
:INITIAL-CONTENTS"))
(unless (= length (length initial-contents))
- (error "There are ~D elements in the :INITIAL-CONTENTS, but ~
- the vector length is ~D."
+ (error "There are ~W elements in the :INITIAL-CONTENTS, but ~
+ the vector length is ~W."
(length initial-contents)
length))
(replace array initial-contents))
(length initial-contents)
length))
(replace array initial-contents))
@@
-212,8
+212,9
@@
(unless (and (fixnump fill-pointer)
(>= fill-pointer 0)
(<= fill-pointer length))
(unless (and (fixnump fill-pointer)
(>= fill-pointer 0)
(<= fill-pointer length))
- (error "invalid fill-pointer ~D"
- fill-pointer))
+ ;; FIXME: should be TYPE-ERROR?
+ (error "invalid fill-pointer ~W"
+ fill-pointer))
fill-pointer))))
(setf (%array-fill-pointer-p array) t))
(t
fill-pointer))))
(setf (%array-fill-pointer-p array) t))
(t
@@
-274,12
+275,12
@@
(t
(unless (typep contents 'sequence)
(error "malformed :INITIAL-CONTENTS: ~S is not a ~
(t
(unless (typep contents 'sequence)
(error "malformed :INITIAL-CONTENTS: ~S is not a ~
- sequence, but ~D more layer~:P needed."
+ sequence, but ~W more layer~:P needed."
contents
(- (length dimensions) axis)))
(unless (= (length contents) (car dims))
(error "malformed :INITIAL-CONTENTS: Dimension of ~
contents
(- (length dimensions) axis)))
(unless (= (length contents) (car dims))
(error "malformed :INITIAL-CONTENTS: Dimension of ~
- axis ~D is ~D, but ~S is ~D long."
+ axis ~W is ~W, but ~S is ~W long."
axis (car dims) contents (length contents)))
(if (listp contents)
(dolist (content contents)
axis (car dims) contents (length contents)))
(if (listp contents)
(dolist (content contents)
@@
-346,7
+347,7
@@
(list subscripts))
(let ((rank (array-rank array)))
(unless (= rank (length subscripts))
(list subscripts))
(let ((rank (array-rank array)))
(unless (= rank (length subscripts))
- (error "wrong number of subscripts, ~D, for array of rank ~D"
+ (error "wrong number of subscripts, ~W, for array of rank ~W"
(length subscripts) rank))
(if (array-header-p array)
(do ((subs (nreverse subscripts) (cdr subs))
(length subscripts) rank))
(if (array-header-p array)
(do ((subs (nreverse subscripts) (cdr subs))
@@
-360,7
+361,7
@@
(declare (fixnum index dim))
(unless (< -1 index dim)
(if invalid-index-error-p
(declare (fixnum index dim))
(unless (< -1 index dim)
(if invalid-index-error-p
- (error "invalid index ~D~[~;~:; on axis ~:*~D~] in ~S"
+ (error "invalid index ~W~[~;~:; on axis ~:*~W~] in ~S"
index axis array)
(return-from %array-row-major-index nil)))
(incf result (* chunk-size index))
index axis array)
(return-from %array-row-major-index nil)))
(incf result (* chunk-size index))
@@
-368,7
+369,7
@@
(let ((index (first subscripts)))
(unless (< -1 index (length (the (simple-array * (*)) array)))
(if invalid-index-error-p
(let ((index (first subscripts)))
(unless (< -1 index (length (the (simple-array * (*)) array)))
(if invalid-index-error-p
- (error "invalid index ~D in ~S" index array)
+ (error "invalid index ~W in ~S" index array)
(return-from %array-row-major-index nil)))
index))))
(return-from %array-row-major-index nil)))
index))))
@@
-489,22
+490,22
@@
(defun array-element-type (array)
#!+sb-doc
"Return the type of the elements of the array"
(defun array-element-type (array)
#!+sb-doc
"Return the type of the elements of the array"
- (let ((type (get-type array)))
+ (let ((widetag (widetag-of array)))
(macrolet ((pick-element-type (&rest stuff)
(macrolet ((pick-element-type (&rest stuff)
- `(cond ,@(mapcar #'(lambda (stuff)
- (cons
- (let ((item (car stuff)))
- (cond ((eq item t)
- t)
- ((listp item)
- (cons 'or
- (mapcar #'(lambda (x)
- `(= type ,x))
- item)))
- (t
- `(= type ,item))))
- (cdr stuff)))
- stuff))))
+ `(cond ,@(mapcar (lambda (stuff)
+ (cons
+ (let ((item (car stuff)))
+ (cond ((eq item t)
+ t)
+ ((listp item)
+ (cons 'or
+ (mapcar (lambda (x)
+ `(= widetag ,x))
+ item)))
+ (t
+ `(= widetag ,item))))
+ (cdr stuff)))
+ stuff))))
;; FIXME: The data here are redundant with
;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
(pick-element-type
;; FIXME: The data here are redundant with
;; *SPECIALIZED-ARRAY-ELEMENT-TYPE-PROPERTIES*.
(pick-element-type
@@
-556,7
+557,7
@@
(error "Vector axis is not zero: ~S" axis-number))
(length (the (simple-array * (*)) array)))
((>= axis-number (%array-rank array))
(error "Vector axis is not zero: ~S" axis-number))
(length (the (simple-array * (*)) array)))
((>= axis-number (%array-rank array))
- (error "~D is too big; ~S only has ~D dimension~:P."
+ (error "Axis number ~W is too big; ~S only has ~D dimension~:P."
axis-number array (%array-rank array)))
(t
(%array-dimension array axis-number))))
axis-number array (%array-rank array)))
(t
(%array-dimension array axis-number))))
@@
-929,9
+930,9
@@
(defun zap-array-data-aux (old-data old-dims offset new-data new-dims)
(declare (fixnum offset))
(defun zap-array-data-aux (old-data old-dims offset new-data new-dims)
(declare (fixnum offset))
- (let ((limits (mapcar #'(lambda (x y)
- (declare (fixnum x y))
- (1- (the fixnum (min x y))))
+ (let ((limits (mapcar (lambda (x y)
+ (declare (fixnum x y))
+ (1- (the fixnum (min x y))))
old-dims new-dims)))
(macrolet ((bump-index-list (index limits)
`(do ((subscripts ,index (cdr subscripts))
old-dims new-dims)))
(macrolet ((bump-index-list (index limits)
`(do ((subscripts ,index (cdr subscripts))