env))))
(defun add-method-declarations (name qualifiers lambda-list body env)
+ (declare (ignore env))
(multiple-value-bind (parameters unspecialized-lambda-list specializers)
(parse-specialized-lambda-list lambda-list)
(declare (ignore parameters))
(multiple-value-bind (real-body declarations documentation)
- (parse-body body env)
+ (parse-body body)
(values `(lambda ,unspecialized-lambda-list
,@(when documentation `(,documentation))
;; (Old PCL code used a somewhat different style of
is not a lambda form."
method-lambda))
(multiple-value-bind (real-body declarations documentation)
- (parse-body (cddr method-lambda) env)
+ (parse-body (cddr method-lambda))
(let* ((name-decl (get-declaration '%method-name declarations))
(sll-decl (get-declaration '%method-lambda-list declarations))
(method-name (when (consp name-decl) (car name-decl)))
(multiple-value-bind (walked-lambda-body
walked-declarations
walked-documentation)
- (parse-body (cddr walked-lambda) env)
+ (parse-body (cddr walked-lambda))
(declare (ignore walked-documentation))
(when (or next-method-p-p call-next-method-p)
(setq plist (list* :needs-next-methods-p t plist)))
(fboundp gf-spec))
(let* ((gf (fdefinition gf-spec))
(method (and (generic-function-p gf)
+ (generic-function-methods gf)
(find-method gf
qualifiers
(parse-specializers specializers)
*))))
(defun defgeneric-declaration (spec lambda-list)
- (when (consp spec)
- (setq spec (get-setf-fun-name (cadr spec))))
`(ftype ,(ftype-declaration-from-lambda-list lambda-list spec) ,spec))
\f
;;;; early generic function support
&allow-other-keys)
(declare (ignore keys))
(cond ((and existing (early-gf-p existing))
+ (when lambda-list-p
+ (set-arg-info existing :lambda-list lambda-list))
existing)
((assoc spec *!generic-function-fixups* :test #'equal)
(if existing
(method-lambda-list method)))
(k (member '&key ll)))
(if k
- (append (ldiff ll (cdr k)) '(&allow-other-keys))
+ (ldiff ll (cdr k))
ll))))
(arg-info-lambda-list arg-info))))