X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Farray-tran.lisp;h=2194cfaf649b11f078097f3a06a5a35532de8f8d;hb=c3d4cd43d7cd8e0495dbb9c11fd9c121ea069a45;hp=06685d9acca8304f0f69378b9ce80e7ea7ef01f6;hpb=e1ba5a0d68ff8d4c8e688cd6a951aea1d56b1b61;p=sbcl.git

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 06685d9..2194cfa 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -126,23 +126,24 @@
   (let ((simple (and (unsupplied-or-nil adjustable)
 		     (unsupplied-or-nil displaced-to)
 		     (unsupplied-or-nil fill-pointer))))
-    (specifier-type
-     `(,(if simple 'simple-array 'array)
-       ,(cond ((not element-type) t)
-	      ((constant-continuation-p element-type)
-	       (continuation-value element-type))
-	      (t
-	       '*))
-       ,(cond ((not simple)
-	       '*)
-	      ((constant-continuation-p dims)
-	       (let ((val (continuation-value dims)))
-		 (if (listp val) val (list val))))
-	      ((csubtypep (continuation-type dims)
-			  (specifier-type 'integer))
-	       '(*))
-	      (t
-	       '*))))))
+    (or (careful-specifier-type
+         `(,(if simple 'simple-array 'array)
+            ,(cond ((not element-type) t)
+                   ((constant-continuation-p element-type)
+                    (continuation-value element-type))
+                   (t
+                    '*))
+            ,(cond ((not simple)
+                    '*)
+                   ((constant-continuation-p dims)
+                    (let ((val (continuation-value dims)))
+                      (if (listp val) val (list val))))
+                   ((csubtypep (continuation-type dims)
+                               (specifier-type 'integer))
+                    '(*))
+                   (t
+                    '*))))
+        (specifier-type 'array))))
 
 ;;; Complex array operations should assert that their array argument
 ;;; is complex.  In SBCL, vectors with fill-pointers are complex.
@@ -267,7 +268,7 @@
 			 "ELEMENT-TYPE is not constant."))
 		       (t
 			(continuation-value element-type))))
-	 (eltype-type (specifier-type eltype))
+	 (eltype-type (ir1-transform-specifier-type eltype))
 	 (saetp (find-if (lambda (saetp)
 			   (csubtypep eltype-type (saetp-ctype saetp)))
 			 *specialized-array-element-type-properties*))
@@ -279,7 +280,7 @@
 
     (unless saetp
       (give-up-ir1-transform "ELEMENT-TYPE not found in *SAETP*: ~S" eltype))
-    
+
     (cond ((or (null initial-element)
 	       (and (constant-continuation-p initial-element)
 		    (eql (continuation-value initial-element)
@@ -307,7 +308,7 @@
 		 (%data-vector-and-index array 0)
 	       (fill vector initial-element))
 	     array)))))
-			 
+
 ;;; The integer type restriction on the length ensures that it will be
 ;;; a vector. The lack of :ADJUSTABLE, :FILL-POINTER, and
 ;;; :DISPLACED-TO keywords ensures that it will be simple; the lack of
@@ -325,7 +326,7 @@
 		  (continuation-value length)
 		  '*))
 	 (result-type-spec `(simple-array ,eltype (,len)))
-	 (eltype-type (specifier-type eltype))
+	 (eltype-type (ir1-transform-specifier-type eltype))
 	 (saetp (find-if (lambda (saetp)
 			   (csubtypep eltype-type (saetp-ctype saetp)))
 			 *specialized-array-element-type-properties*)))
@@ -578,7 +579,9 @@
 		  `(if (<= ,n-svalue ,n-end ,n-len)
 		       ;; success
 		       (values ,n-array ,n-svalue ,n-end 0)
-		       (failed-%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)))