X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsrctran.lisp;h=76d880aa71056fae635e660118028020cca8a334;hb=997959cc458b00ff7faae526511533d24bdc0fde;hp=72c2695d5a007acdfff01bde5ea60e13e4bbe8c2;hpb=b67011dd39c355d2d75037e0280e4e2a564013a3;p=sbcl.git

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 72c2695..76d880a 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -3956,7 +3956,7 @@
                            :format-arguments
                            (list nargs 'cerror y x (max max1 max2))))))))))))))
 
-(defoptimizer (coerce derive-type) ((value type))
+(defoptimizer (coerce derive-type) ((value type) node)
   (cond
     ((constant-lvar-p type)
      ;; This branch is essentially (RESULT-TYPE-SPECIFIER-NTH-ARG 2),
@@ -4001,7 +4001,17 @@
              (type-union result-typeoid
                          (type-intersection (lvar-type value)
                                             (specifier-type 'rational))))))
-         (t result-typeoid))))
+         ((and (policy node (zerop safety))
+               (csubtypep result-typeoid (specifier-type '(array * (*)))))
+          ;; At zero safety the deftransform for COERCE can elide dimension
+          ;; checks for the things like (COERCE X '(SIMPLE-VECTOR 5)) -- so we
+          ;; need to simplify the type to drop the dimension information.
+          (let ((vtype (simplify-vector-type result-typeoid)))
+            (if vtype
+                (specifier-type vtype)
+                result-typeoid)))
+         (t
+          result-typeoid))))
     (t
      ;; OK, the result-type argument isn't constant.  However, there
      ;; are common uses where we can still do better than just