0.7.12.12:

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

diff --git a/src/code/array.lisp b/src/code/array.lisp
index 10f81e8..68aa0c6 100644 (file)
--- a/src/code/array.lisp
+++ b/src/code/array.lisp
@@ -63,7 +63,15 @@
   (bug "called FAILED-%WITH-ARRAY-DATA with valid array parameters?"))
 \f
 ;;;; MAKE-ARRAY
-
+(defun upgraded-array-element-type (spec &optional environment)
+  #!+sb-doc
+  "Return the element type that will actually be used to implement an array
+   with the specifier :ELEMENT-TYPE Spec."
+  (declare (ignore environment))
+  (if (unknown-type-p (specifier-type spec))
+      (error "undefined type: ~S" spec)
+      (type-specifier (array-type-specialized-element-type
+                      (specifier-type `(array ,spec))))))
 (eval-when (:compile-toplevel :execute)
   (sb!xc:defmacro pick-vector-type (type &rest specs)
     `(cond ,@(mapcar (lambda (spec)
@@ -375,7 +383,7 @@
          (declare (list subs) (fixnum axis chunk-size result))
          (let ((index (car subs))
                (dim (%array-dimension array axis)))
-           (declare (fixnum index dim))
+           (declare (fixnum dim))
            (unless (< -1 index dim)
              (if invalid-index-error-p
                  (error 'simple-type-error
@@ -384,7 +392,7 @@
                         :datum index
                         :expected-type `(integer 0 (,dim)))
                  (return-from %array-row-major-index nil)))
-           (incf result (* chunk-size index))
+           (incf result (* chunk-size (the fixnum index)))
            (setf chunk-size (* chunk-size dim))))
        (let ((index (first subscripts))
              (length (length (the (simple-array * (*)) array))))
@@ -436,6 +444,13 @@
 ;;;  ZOO
 ;;; But that doesn't seem to be what happens in CMU CL.
 ;;;
+;;; KLUDGE: this is probably because ANSI, in its wisdom (CLHS
+;;; 5.1.2.5) requires implementations to support
+;;;   (SETF (APPLY #'AREF ...) ...)
+;;; [and also #'BIT and #'SBIT].  Yes, this is terrifying, and it's
+;;; also terrifying that this sequence of definitions causes it to
+;;; work.
+;;;
 ;;; Also, it would be nice to make DESCRIBE FOO tell whether a symbol
 ;;; has a setf expansion and/or a setf function defined.