diff --git a/src/clos/fixup.lsp b/src/clos/fixup.lsp index defa5f61d..ddece2c14 100644 --- a/src/clos/fixup.lsp +++ b/src/clos/fixup.lsp @@ -150,7 +150,8 @@ and cannot be added to ~A." method other-gf gf))) (error "Cannot add the method ~A to the generic function ~A because ~ their lambda lists ~A and ~A are not congruent." method gf old-lambda-list new-lambda-list))) - (reinitialize-instance gf :lambda-list new-lambda-list))) + (reinitialize-instance + gf :lambda-list (implicit-generic-lambda new-lambda-list)))) ;; ;; 3) Finally, it is inserted in the list of methods, and the method is ;; marked as belonging to a generic function. diff --git a/src/clos/method.lsp b/src/clos/method.lsp index 56c5c9a5d..9dd18eb3c 100644 --- a/src/clos/method.lsp +++ b/src/clos/method.lsp @@ -290,6 +290,17 @@ (values name (nreverse qualifiers) (first args) (rest args))) (push (pop args) qualifiers)))) +(defun implicit-generic-lambda (lambda-list) + "Implicit defgeneric declaration removes all &key arguments (preserving &key)" + (when lambda-list + (let (acc) + (do* ((ll lambda-list (cdr ll)) + (elt (car ll) (car ll))) + ((or (endp (rest ll)) + (eql elt '&key)) + (nreverse (cons elt acc))) + (push elt acc))))) + (defun extract-lambda-list (specialized-lambda-list) (values (parse-specialized-lambda-list specialized-lambda-list))) @@ -398,7 +409,8 @@ have disappeared." (push method (generic-function-methods gf)) (setf (method-generic-function method) gf) (unless (si::sl-boundp (generic-function-lambda-list gf)) - (setf (generic-function-lambda-list gf) (method-lambda-list method)) + (setf (generic-function-lambda-list gf) (implicit-generic-lambda + (method-lambda-list method))) (setf (generic-function-argument-precedence-order gf) (rest (si::process-lambda-list (method-lambda-list method) t)))) (compute-g-f-spec-list gf)