Update of /cvsroot/sbcl/sbcl/src/pcl
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv8577/src/pcl
126.96.36.199: 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
* 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.
RCS file: /cvsroot/sbcl/sbcl/src/pcl/boot.lisp,v
retrieving revision 1.153
retrieving revision 1.154
diff -u -d -r1.153 -r1.154
--- boot.lisp 29 Jul 2009 14:48:51 -0000 1.153
+++ boot.lisp 30 Jul 2009 13:36:43 -0000 1.154
@@ -2209,19 +2209,41 @@
(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 "~@<Generic function ~S clobbers an earlier ~S proclamation ~
- for the same name.~:@>"
- fun-name 'ftype))
- (setf (info :function :type fun-name)
- (if lambda-list-p
- (ftype-declaration-from-lambda-list lambda-list fun-name)
- (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)
+ (values (generic-function-lambda-list (fdefinition fun-name))
+ ((or warning error) ()
+ (values nil nil)))))
+ (let ((gf-type
+ (if lambda-list-p
+ (ftype-declaration-from-lambda-list lambda-list fun-name)
+ (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 "~@<Generic function ~S clobbers an earlier ~S proclamation ~S ~
+ for the same name with ~S.~:@>"
+ 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)