clos: implicit generic function definition doesn't have &key arguments

According to second paragraph of
http://www.lispworks.com/documentation/HyperSpec/Body/m_defmet.htm
generic function should mention key (if it is in method), but now key
arguments. Fixes #76.

Signed-off-by: Daniel Kochmański <dkochmanski@turtle-solutions.eu>

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.

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)