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 fbc4a06..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))
@@ -573,10 +579,7 @@
                           ,@(when offset-var `(,offset-var)))
         (if (not (array-header-p ,n-array))
             (let ((,n-array ,n-array))
-              ;; The #-CMU is because tonyms reported (sbcl-devel
-              ;; 2002-09-29) that this declaration confuses old CMU
-              ;; CL on x86 Debian 2.2. -- WHN 2002-10-02
-              #-cmu (declare (type (simple-array * (*)) ,n-array))
+              (declare (type (simple-array * (*)) ,n-array))
               ,(once-only ((n-len `(length ,n-array))
                            (n-end `(or ,n-evalue ,n-len)))
                  `(if (<= ,n-svalue ,n-end ,n-len)