From 5fb561a1daba0b6dbd76f7347d4b0fa4b02494a6 Mon Sep 17 00:00:00 2001 From: Richard M Kreuter Date: Wed, 16 Jul 2008 20:51:14 +0000 Subject: [PATCH] 1.0.18.21: More STYLE-WARNINGs * STYLE-WARN for argument list mismatches for all already-defined functions. --- src/compiler/ir1opt.lisp | 14 ++++++++++++-- src/compiler/ir1tran.lisp | 8 ++++++-- src/compiler/node.lisp | 3 +++ version.lisp-expr | 2 +- 4 files changed, 22 insertions(+), 5 deletions(-) diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index 548c1c9f8..b8b00544c 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)) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 3e38ef773..eddc909d8 100644 --- 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 49400c5ce..6420c6231 100644 --- 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 dc841e83d..d3d50337d 100644 --- 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" -- 2.11.4.GIT