0.7.4.29:

[sbcl.git] / src / compiler / array-tran.lisp

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 2f3585a..5a81b1a 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -25,14 +25,6 @@
        element-type-specifier)))
 
 ;;; Array access functions return an object from the array, hence its
-;;; type will be asserted to be array element type.
-(defun extract-element-type (array)
-  (let ((type (continuation-type array)))
-    (if (array-type-p type)
-       (array-type-element-type type)
-       *universal-type*)))
-
-;;; Array access functions return an object from the array, hence its
 ;;; type is going to be the array upgraded element type.
 (defun extract-upgraded-element-type (array)
   (let ((type (continuation-type array)))
@@ -46,7 +38,7 @@
 (defun assert-new-value-type (new-value array)
   (let ((type (continuation-type array)))
     (when (array-type-p type)
-      (assert-continuation-type new-value (array-type-element-type type))))
+      (assert-continuation-type new-value (array-type-specialized-element-type type))))
   (continuation-type new-value))
 
 ;;; Return true if Arg is NIL, or is a constant-continuation whose
@@ -75,7 +67,7 @@
   ;; If the node continuation has a single use then assert its type.
   (let ((cont (node-cont node)))
     (when (= (length (find-uses cont)) 1)
-      (assert-continuation-type cont (extract-element-type array))))
+      (assert-continuation-type cont (extract-upgraded-element-type array))))
   (extract-upgraded-element-type array))
 
 (defoptimizer (%aset derive-type) ((array &rest stuff))
@@ -99,7 +91,7 @@
     (when (array-type-p atype)
       (values-specifier-type
        `(values (simple-array ,(type-specifier
-                               (array-type-element-type atype))
+                               (array-type-specialized-element-type atype))
                              (*))
                index index index)))))
 
@@ -520,12 +512,7 @@
                  `(if (<= ,n-svalue ,n-end ,n-len)
                       ;; success
                       (values ,n-array ,n-svalue ,n-end 0)
-                      ;; failure: Make a NOTINLINE call to
-                      ;; %WITH-ARRAY-DATA with our bad data
-                      ;; to cause the error to be signalled.
-                      (locally
-                        (declare (notinline %with-array-data))
-                        (%with-array-data ,n-array ,n-svalue ,n-evalue)))))
+                      (failed-%with-array-data ,n-array ,n-svalue ,n-evalue))))
             (,(if force-inline '%with-array-data-macro '%with-array-data)
              ,n-array ,n-svalue ,n-evalue))
        ,@forms)))
@@ -569,16 +556,12 @@
         (declare (type index ,cumulative-offset))))))
 
 (deftransform %with-array-data ((array start end)
-                               ;; Note: This transform is limited to
-                               ;; VECTOR only because I happened to
-                               ;; create it in order to get sequence
-                               ;; function operations to be more
-                               ;; efficient. It might very well be
-                               ;; reasonable to allow general ARRAY
-                               ;; here, I just haven't tried to
-                               ;; understand the performance issues
-                               ;; involved. -- WHN
-                               (vector index (or index null))
+                               ;; It might very well be reasonable to
+                               ;; allow general ARRAY here, I just
+                               ;; haven't tried to understand the
+                               ;; performance issues involved. --
+                               ;; WHN, and also CSR 2002-05-26
+                               ((or vector simple-array) index (or index null))
                                *
                                :important t
                                :node node