X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Farray-tran.lisp;h=579064e88e77db57fc7dfe63dc4e1a8982afff2a;hb=09d7974601df2aaaa820ca576026b9b4f03e6ab1;hp=b71f70d86f343582e40045e5ffee2d085ebc1e73;hpb=dea9bd5c1afe23d9e061c60db654b88187ba9a5e;p=sbcl.git

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index b71f70d..579064e 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -47,14 +47,18 @@
 (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-specialized-element-type type))))
+      (assert-continuation-type
+       new-value
+       (array-type-specialized-element-type type)
+       (lexenv-policy (node-lexenv (continuation-dest new-value))))))
   (continuation-type new-value))
 
 (defun assert-array-complex (array)
-  (assert-continuation-type array
-			    (make-array-type :complexp t
-					     :element-type *wild-type*)))
+  (assert-continuation-type
+   array
+   (make-array-type :complexp t
+                    :element-type *wild-type*)
+   (lexenv-policy (node-lexenv (continuation-dest array)))))
 
 ;;; Return true if ARG is NIL, or is a constant-continuation whose
 ;;; value is NIL, false otherwise.
@@ -71,7 +75,8 @@
 (defun assert-array-rank (array rank)
   (assert-continuation-type
    array
-   (specifier-type `(array * ,(make-list rank :initial-element '*)))))
+   (specifier-type `(array * ,(make-list rank :initial-element '*)))
+   (lexenv-policy (node-lexenv (continuation-dest array)))))
 
 (defoptimizer (array-in-bounds-p derive-type) ((array &rest indices))
   (assert-array-rank array (length indices))
@@ -82,7 +87,8 @@
   ;; 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-upgraded-element-type array))))
+      (assert-continuation-type cont (extract-upgraded-element-type array)
+                                (lexenv-policy (node-lexenv node)))))
   (extract-upgraded-element-type array))
 
 (defoptimizer (%aset derive-type) ((array &rest stuff))
@@ -298,9 +304,9 @@
 	     ;; elements before he reads elements (or to read manuals
 	     ;; before he writes code:-), we'll signal a STYLE-WARNING
 	     ;; in case he didn't realize this.
-	     (compiler-note "The default initial element ~S is not a ~S."
-			    (saetp-initial-element-default saetp)
-			    eltype))
+	     (compiler-style-warn "The default initial element ~S is not a ~S."
+				  (saetp-initial-element-default saetp)
+				  eltype))
 	   creation-form)
 	  (t
 	   `(let ((array ,creation-form))
@@ -579,7 +585,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)))