:generic-function generic-function
:method method)
(update-dfun generic-function))
+ (setf (gf-info-needs-update generic-function) t)
(map-dependents generic-function
(lambda (dep)
(update-dependent generic-function
:generic-function generic-function
:method method)
(update-dfun generic-function)
+ (setf (gf-info-needs-update generic-function) t)
(map-dependents generic-function
(lambda (dep)
(update-dependent generic-function
dep 'remove-method method)))))))
generic-function)
+
+
+;; Tell INFO about the generic function's methods' keys so that the
+;; compiler doesn't complain that the keys defined for some method are
+;; unrecognized.
+(sb-ext:without-package-locks
+ (defun sb-c::maybe-update-info-for-gf (name)
+ (let ((gf (if (fboundp name) (fdefinition name))))
+ (when (and gf (generic-function-p gf) (not (early-gf-p gf))
+ (not (eq :declared (info :function :where-from name)))
+ (gf-info-needs-update gf))
+ (let* ((methods (generic-function-methods gf))
+ (gf-lambda-list (generic-function-lambda-list gf))
+ (tfun (constantly t))
+ keysp)
+ (multiple-value-bind
+ (gf.required gf.optional gf.rest ignore gf.allowp)
+ (%split-arglist gf-lambda-list)
+ (declare (ignore ignore))
+ (setf (info :function :type name)
+ (specifier-type
+ `(function
+ (,@(mapcar tfun gf.required)
+ ,@(if gf.optional
+ `(&optional ,@(mapcar tfun gf.optional)))
+ ,@(if gf.rest
+ `(&rest t))
+ ,@(let ((all-keys
+ (mapcar
+ (lambda (x)
+ (list x t))
+ (remove-duplicates
+ (mapcan #'function-keywords methods)))))
+ (when all-keys
+ (setq keysp t)
+ `(&key ,@all-keys)))
+ ,@(if (and keysp gf.allowp)
+ `(&allow-other-keys)))
+ *))
+ (info :function :where-from name) :defined-method
+ (gf-info-needs-update gf) nil)))))
+ (values)))
\f
(defun compute-applicable-methods-function (generic-function arguments)
(values (compute-applicable-methods-using-types
(cond ((/= nkeys 1)
;; KLUDGE: someone has defined a method
;; specialized on the second argument: punt.
+ (setf po-cache nil)
(make-initial-dfun gf))
(po-cache
(multiple-value-bind (dfun cache info)
(make-caching-dfun gf po-cache)
(set-dfun gf dfun cache info)))
+ ;; the relevant PRINT-OBJECT methods get defined
+ ;; late, by delayed DEF!METHOD. We mustn't cache
+ ;; the effective method for our classes earlier
+ ;; than the relevant PRINT-OBJECT methods are
+ ;; defined...
+ ((boundp 'sb-impl::*delayed-def!method-args*)
+ (make-initial-dfun gf))
(t (multiple-value-bind (dfun cache info)
(make-final-dfun-internal
gf
(reinitialize-instance generic-function :name new-value)
new-value)
\f
+(defmethod function-keywords ((method standard-method))
+ (multiple-value-bind (nreq nopt keysp restp allow-other-keys-p
+ keywords keyword-parameters)
+ (analyze-lambda-list (if (consp method)
+ (early-method-lambda-list method)
+ (method-lambda-list method)))
+ (declare (ignore nreq nopt keysp restp keywords))
+ (values keywords allow-other-keys-p)))
+
(defmethod function-keyword-parameters ((method standard-method))
(multiple-value-bind (nreq nopt keysp restp allow-other-keys-p
keywords keyword-parameters)