[nongnu] externals/sly 5f15cf1 43/47: Use defgeneric lambda list in defmethod arglists

[ELPA Syncer]

branch: externals/sly
commit 5f15cf1c72ddbecc591bf660d2595e21247c2b53
Author: Luís Oliveira <loliveira@common-lisp.net>
Commit: João Távora <joaotavora@gmail.com>

    Use defgeneric lambda list in defmethod arglists
    
    Make (defmethod foo ...)'s arglist reflect only the generic function's
    lambda list, with which a new method must be congruent. This doesn't
    affect the arglist of (foo ...) which still aggregates the lambda
    lists of all methods when foo names a generic function.
    
    Fixes SLIME github issue https://github.com/slime/slime/issues/572
    reported by phoe.
    
    * contrib/slynk-arglists.lisp (arglist-dispatch): Rework
    
    Cherry-picked-from: SLIME commit fac8069fc13eb62742c31967b314bddb6da6b6c7
    Co-authored-by: João Távora <joaotavora@gmail.com>
---
 contrib/slynk-arglists.lisp | 17 +++++++++--------
 1 file changed, 9 insertions(+), 8 deletions(-)

diff --git a/contrib/slynk-arglists.lisp b/contrib/slynk-arglists.lisp
index 0f0e19c..bb78d68 100644
--- a/contrib/slynk-arglists.lisp
+++ b/contrib/slynk-arglists.lisp
@@ -1033,14 +1033,15 @@ If the arglist is not available, return 
:NOT-AVAILABLE."))
     (('defmethod (#'function-exists-p gf-name) . rest)
      (let ((gf (fdefinition gf-name)))
        (when (typep gf 'generic-function)
-         (with-available-arglist (arglist) (decode-arglist (arglist gf))
-           (let ((qualifiers (loop for x in rest
-                                   until (or (listp x) (empty-arg-p x))
-                                   collect x)))
-             (return-from arglist-dispatch
-               (make-arglist :provided-args (cons gf-name qualifiers)
-                             :required-args (list arglist)
-                             :rest "body" :body-p t)))))))
+         (let ((lambda-list (slynk-mop:generic-function-lambda-list gf)))
+           (with-available-arglist (arglist) (decode-arglist lambda-list)
+             (let ((qualifiers (loop for x in rest
+                                     until (or (listp x) (empty-arg-p x))
+                                     collect x)))
+               (return-from arglist-dispatch
+                 (make-arglist :provided-args (cons gf-name qualifiers)
+                               :required-args (list arglist)
+                               :rest "body" :body-p t))))))))
     (_)) ; Fall through
   (call-next-method))