1.0.16.16: Use declared element type in AREF short-circuit transform

	The short-circuit transformation introduced in 1.0.2.17
	removed the system's understanding of the declared array element
	type (as opposed to the upgraded array element type).
	Reintroduce the cleverness, and hope that the use of type=
	doesn't remove all the slowdown.

	(Issue noted by vy on #lisp afternoon 2008-05-04 BST)

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 14eb3de..9762e0c 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -800,19 +800,23 @@
 ;; without bloating the code. If we already know the type of the array
 ;; with sufficient precision, skip directly to DATA-VECTOR-REF.
 (deftransform aref ((array index) (t t) * :node node)
-  (let ((type (lvar-type array)))
-    (cond ((and (array-type-p type)
-                (null (array-type-complexp type))
-                (not (eql (extract-upgraded-element-type array)
-                          *wild-type*))
-                (eql (length (array-type-dimensions type)) 1))
-           `(data-vector-ref array (%check-bound array
-                                                 (array-dimension array 0)
-                                                 index)))
-          ((policy node (zerop insert-array-bounds-checks))
-           `(hairy-data-vector-ref array index))
-          (t
-           `(hairy-data-vector-ref/check-bounds array index)))))
+  (let* ((type (lvar-type array))
+         (element-ctype (extract-upgraded-element-type array)))
+    (cond
+      ((and (array-type-p type)
+            (null (array-type-complexp type))
+            (not (eql element-ctype *wild-type*))
+            (eql (length (array-type-dimensions type)) 1))
+       (let* ((declared-element-ctype (extract-declared-element-type array))
+              (bare-form
+               `(data-vector-ref array
+                 (%check-bound array (array-dimension array 0) index))))
+         (if (type= declared-element-ctype element-ctype)
+             bare-form
+             `(the ,(type-specifier declared-element-ctype) ,bare-form))))
+      ((policy node (zerop insert-array-bounds-checks))
+       `(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)
   (if (policy node (zerop insert-array-bounds-checks))

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 88463e1..b5df3b9 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -528,11 +528,19 @@
     (funcall f y 1)
     (assert (equal y #*10))))
 
+;;; use of declared array types
 (handler-bind ((sb-ext:compiler-note #'error))
   (compile nil '(lambda (x)
-                 (declare (type (simple-array (simple-string 3) (5)) x))
+                 (declare (type (simple-array (simple-string 3) (5)) x)
+                          (optimize speed))
                  (aref (aref x 0) 0))))
 
+(handler-bind ((sb-ext:compiler-note #'error))
+  (compile nil '(lambda (x)
+                 (declare (type (simple-array (simple-array bit (10)) (10)) x)
+                          (optimize speed))
+                 (1+ (aref (aref x 0) 0)))))
+
 ;;; compiler failure
 (let ((f (compile nil '(lambda (x) (typep x '(not (member 0d0)))))))
   (assert (funcall f 1d0)))

diff --git a/version.lisp-expr b/version.lisp-expr
index 0424d81..5434840 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.16.15"
+"1.0.16.16"