0.7.10.10:

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

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index b71f70d..579064e 100644 (file)
--- 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)))