0.7.9.29:

[sbcl.git] / src / code / array.lisp

diff --git a/src/code/array.lisp b/src/code/array.lisp
index ddfa44c..10f81e8 100644 (file)
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -49,6 +49,11 @@
 (defun %with-array-data (array start end)
   (%with-array-data-macro array start end :fail-inline? t))
 
+(defun %data-vector-and-index (array index)
+  (if (array-header-p array)
+      (%with-array-data array index nil)
+      (values array index)))
+
 ;;; It'd waste space to expand copies of error handling in every
 ;;; inline %WITH-ARRAY-DATA, so we have them call this function
 ;;; instead. This is just a wrapper which is known never to return.
@@ -328,6 +333,12 @@
                                                index))))
                         *specialized-array-element-types*))))
 
+;;; (Ordinary DATA-VECTOR-REF usage compiles into a vop, but
+;;; DATA-VECTOR-REF is also FOLDABLE, and this ordinary function
+;;; definition is needed for the compiler to use in constant folding.)
+(defun data-vector-ref (array index)
+  (hairy-data-vector-ref array index))
+
 (defun hairy-data-vector-set (array index new-value)
   (with-array-data ((vector array) (index index) (end))
     (declare (ignore end))
@@ -367,15 +378,26 @@
            (declare (fixnum index dim))
            (unless (< -1 index dim)
              (if invalid-index-error-p
-                 (error "invalid index ~W~[~;~:; on axis ~:*~W~] in ~S"
-                        index axis array)
+                 (error 'simple-type-error
+                        :format-control "invalid index ~W~[~;~:; on axis ~:*~W~] in ~S"
+                        :format-arguments (list index axis array)
+                        :datum index
+                        :expected-type `(integer 0 (,dim)))
                  (return-from %array-row-major-index nil)))
            (incf result (* chunk-size index))
            (setf chunk-size (* chunk-size dim))))
-       (let ((index (first subscripts)))
-         (unless (< -1 index (length (the (simple-array * (*)) array)))
+       (let ((index (first subscripts))
+             (length (length (the (simple-array * (*)) array))))
+         (unless (< -1 index length)
            (if invalid-index-error-p
-               (error "invalid index ~W in ~S" index array)
+               ;; FIXME: perhaps this should share a format-string
+               ;; with INVALID-ARRAY-INDEX-ERROR or
+               ;; INDEX-TOO-LARGE-ERROR?
+               (error 'simple-type-error
+                      :format-control "invalid index ~W in ~S"
+                      :format-arguments (list index array)
+                      :datum index
+                      :expected-type `(integer 0 (,length)))
                (return-from %array-row-major-index nil)))
          index))))