From 073f54bf68f2917e92e79d1e6564b1623930e8f5 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 30 Jul 2009 13:36:43 +0000 Subject: [PATCH] 1.0.30.20: less DEFGENERIC clobbers FTYPE STYLE-WARNINGS * Remove the declamation from DESCRIBE-OBJECT. * Make SBCL warn only if the new type is more general than the old type. * In NOTE-GF-SIGNATURE, use the existing GF lambda-list if the user didn't provide one to ENSURE-GENERIC-FUNCTION. This allows us to deduce sufficiently good types for condition slot readers from the lambda-list to elide the warning. --- src/code/describe.lisp | 1 - src/pcl/boot.lisp | 48 +++++++++++++++++++++++++++++++++++------------- version.lisp-expr | 2 +- 3 files changed, 36 insertions(+), 15 deletions(-) diff --git a/src/code/describe.lisp b/src/code/describe.lisp index 6b73804..7762f8e 100644 --- a/src/code/describe.lisp +++ b/src/code/describe.lisp @@ -167,7 +167,6 @@ (base-char "base-char") (t "character"))) -(declaim (ftype (function (t stream)) describe-object)) (defgeneric describe-object (x stream)) (defvar *in-describe* nil) diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index cc1dc82..90d8cfb 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -2209,19 +2209,41 @@ bootstrapping. (t (find-class method-class t ,env)))))))) (defun note-gf-signature (fun-name lambda-list-p lambda-list) - ;; FIXME: Ideally we would like to not clobber it, but because generic - ;; functions assert their FTYPEs callers believing the FTYPE are - ;; left with unsafe assumptions. Hence the clobbering. - (when (eq :declared (info :function :where-from fun-name)) - (style-warn "~@" - fun-name 'ftype)) - (setf (info :function :type fun-name) - (specifier-type - (if lambda-list-p - (ftype-declaration-from-lambda-list lambda-list fun-name) - 'function))) - (setf (info :function :where-from fun-name) :defined-method)) + (unless lambda-list-p + ;; Use the existing lambda-list, if any. It is reasonable to do eg. + ;; + ;; (if (fboundp name) + ;; (ensure-generic-function name) + ;; (ensure-generic-function name :lambda-list '(foo))) + ;; + ;; in which case we end up here with no lambda-list in the first leg. + (setf (values lambda-list lambda-list-p) + (handler-case + (values (generic-function-lambda-list (fdefinition fun-name)) + t) + ((or warning error) () + (values nil nil))))) + (let ((gf-type + (specifier-type + (if lambda-list-p + (ftype-declaration-from-lambda-list lambda-list fun-name) + 'function))) + (old-type nil)) + ;; FIXME: Ideally we would like to not clobber it, but because generic + ;; functions assert their FTYPEs callers believing the FTYPE are left with + ;; unsafe assumptions. Hence the clobbering. Be quiet when the new type + ;; is a subtype of the old one, though -- even though the type is not + ;; trusted anymore, the warning is still not quite as interesting. + (when (and (eq :declared (info :function :where-from fun-name)) + (not (csubtypep gf-type (setf old-type (info :function :type fun-name))))) + (style-warn "~@" + fun-name 'ftype + (type-specifier old-type) + (type-specifier gf-type))) + (setf (info :function :type fun-name) gf-type + (info :function :where-from fun-name) :defined-method) + fun-name)) (defun real-ensure-gf-using-class--generic-function (existing diff --git a/version.lisp-expr b/version.lisp-expr index 41de5f1..c140eb0 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.30.19" +"1.0.30.20" -- 1.7.10.4