X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1opt.lisp;h=b8b00544c4cddf5b1c632beafdbe0a706ac3234e;hb=70c6facc145eaf5ca368528b04df63f730746b1f;hp=548c1c9f8b84e810c39a58251dd10c08851715bb;hpb=6d3b9d5de8a28cd92e280f3451b60ce412260c19;p=sbcl.git

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 548c1c9..b8b0054 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -892,12 +892,22 @@
 ;;; syntax check, arg/result type processing, but still call
 ;;; RECOGNIZE-KNOWN-CALL, since the call might be to a known lambda,
 ;;; and that checking is done by local call analysis.
-(defun validate-call-type (call type ir1-converting-not-optimizing-p)
+(defun validate-call-type (call type defined-type ir1-converting-not-optimizing-p)
   (declare (type combination call) (type ctype type))
   (cond ((not (fun-type-p type))
          (aver (multiple-value-bind (val win)
                    (csubtypep type (specifier-type 'function))
                  (or val (not win))))
+         ;; In the commonish case where the function has been defined
+         ;; in another file, we only get FUNCTION for the type; but we
+         ;; can check whether the current call is valid for the
+         ;; existing definition, even if only to STYLE-WARN about it.
+         (when defined-type
+           (valid-fun-use call defined-type
+                          :argument-test #'always-subtypep
+                          :result-test nil
+                          :lossage-fun #'compiler-style-warn
+                          :unwinnage-fun #'compiler-notify))
          (recognize-known-call call ir1-converting-not-optimizing-p))
         ((valid-fun-use call type
                         :argument-test #'always-subtypep
@@ -947,7 +957,7 @@
            (derive-node-type call (tail-set-type (lambda-tail-set fun))))))
       (:full
        (multiple-value-bind (leaf info)
-           (validate-call-type call (lvar-type fun-lvar) nil)
+           (validate-call-type call (lvar-type fun-lvar) nil nil)
          (cond ((functional-p leaf)
                 (convert-call-if-possible
                  (lvar-uses (basic-combination-fun call))