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

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 22186ad..76d880a 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -1815,6 +1815,10 @@
                            (let* ((interval (numeric-type->interval n))
                                   (low      (interval-low interval))
                                   (high     (interval-high interval)))
+                             (when (consp low)
+                               (setf low (car low)))
+                             (when (consp high)
+                               (setf high (car high)))
                              (specifier-type
                               `(integer ,(if low
                                              (round low)
@@ -3952,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),
@@ -3997,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