1.0.18.21: More STYLE-WARNINGs

* STYLE-WARN for argument list mismatches for all already-defined
  functions.

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 548c1c9..b8b0054 100644 (file)
--- 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))

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 3e38ef7..eddc909 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -118,6 +118,9 @@
                              (not (fun-lexically-notinline-p name)))))
                (info :function :type name)
                (specifier-type 'function))
+     :defined-type (if (eq where :defined)
+                       (info :function :type name)
+                       *universal-type*)
      :where-from where)))
 
 ;;; Has the *FREE-FUNS* entry FREE-FUN become invalid?
@@ -1042,8 +1045,9 @@
            (type leaf var))
   (let* ((node (ir1-convert-combination start next result form var))
          (fun-lvar (basic-combination-fun node))
-         (type (leaf-type var)))
-    (when (validate-call-type node type t)
+         (type (leaf-type var))
+         (defined-type (leaf-defined-type var)))
+    (when (validate-call-type node type defined-type t)
       (setf (lvar-%derived-type fun-lvar)
             (make-single-value-type type))
       (setf (lvar-reoptimize fun-lvar) nil)))

diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index 49400c5..6420c62 100644 (file)
--- a/src/compiler/node.lisp
+++ b/src/compiler/node.lisp
@@ -617,6 +617,9 @@
                 :read-only t)
   ;; the type which values of this leaf must have
   (type *universal-type* :type ctype)
+  ;; the type which values of this leaf have last been defined to have
+  ;; (but maybe won't have in future, in case of redefinition)
+  (defined-type *universal-type* :type ctype)
   ;; where the TYPE information came from:
   ;;  :DECLARED, from a declaration.
   ;;  :ASSUMED, from uses of the object.

diff --git a/version.lisp-expr b/version.lisp-expr
index dc841e8..d3d5033 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.18.20"
+"1.0.18.21"