X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fcheckgen.lisp;h=b461851c8978b1cd9145b995f85b4a3498985222;hb=c40c56eedec692acb930ec0e358a933ab33a3560;hp=46b32e11cc9140e1729c6309e1f3fe792f99283d;hpb=18cc020d7e2477249c280c61750599213fb58ba9;p=sbcl.git

diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp
index 46b32e1..b461851 100644
--- a/src/compiler/checkgen.lisp
+++ b/src/compiler/checkgen.lisp
@@ -449,35 +449,41 @@
   (let* ((lvar (node-lvar cast))
          (dest (and lvar (lvar-dest lvar)))
          (value (cast-value cast))
-         (atype (cast-asserted-type cast)))
+         (atype (cast-asserted-type cast))
+         (condition 'type-warning)
+         (not-ok-uses '()))
     (do-uses (use value)
       (let ((dtype (node-derived-type use)))
-        (unless (values-types-equal-or-intersect dtype atype)
-          (let* ((*compiler-error-context* use)
-                 (atype-spec (type-specifier atype))
-                 (what (when (and (combination-p dest)
-                                  (eq (combination-kind dest) :local))
-                         (let ((lambda (combination-lambda dest))
-                               (pos (position-or-lose
-                                     lvar (combination-args dest))))
-                           (format nil "~:[A possible~;The~] binding of ~S"
-                                   (and (lvar-has-single-use-p lvar)
-                                        (eq (functional-kind lambda) :let))
-                                   (leaf-source-name (elt (lambda-vars lambda)
-                                                          pos)))))))
-            (cond ((and (ref-p use) (constant-p (ref-leaf use)))
-                   (warn 'type-warning
-                         :format-control
-                         "~:[This~;~:*~A~] is not a ~<~%~9T~:;~S:~>~%  ~S"
-                         :format-arguments
-                         (list what atype-spec
-                               (constant-value (ref-leaf use)))))
-                  (t
-                   (warn 'type-warning
-                         :format-control
-                         "~:[Result~;~:*~A~] is a ~S, ~<~%~9T~:;not a ~S.~>"
-                         :format-arguments
-                         (list what (type-specifier dtype) atype-spec)))))))))
+        (if (values-types-equal-or-intersect dtype atype)
+            (setf condition 'type-style-warning)
+            (push use not-ok-uses))))
+    (dolist (use (nreverse not-ok-uses))
+      (let* ((*compiler-error-context* use)
+             (dtype      (node-derived-type use))
+             (atype-spec (type-specifier atype))
+             (what (when (and (combination-p dest)
+                              (eq (combination-kind dest) :local))
+                     (let ((lambda (combination-lambda dest))
+                           (pos (position-or-lose
+                                 lvar (combination-args dest))))
+                       (format nil "~:[A possible~;The~] binding of ~S"
+                               (and (lvar-has-single-use-p lvar)
+                                    (eq (functional-kind lambda) :let))
+                               (leaf-source-name (elt (lambda-vars lambda)
+                                                      pos)))))))
+        (cond ((and (ref-p use) (constant-p (ref-leaf use)))
+               (warn condition
+                     :format-control
+                     "~:[This~;~:*~A~] is not a ~<~%~9T~:;~S:~>~%  ~S"
+                     :format-arguments
+                     (list what atype-spec
+                           (constant-value (ref-leaf use)))))
+              (t
+               (warn condition
+                     :format-control
+                     "~:[Result~;~:*~A~] is a ~S, ~<~%~9T~:;not a ~S.~>"
+                     :format-arguments
+                     (list what (type-specifier dtype) atype-spec)))))))
   (values))
 
 ;;; Loop over all blocks in COMPONENT that have TYPE-CHECK set,