X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fvector.lisp;h=2b4f2d21d6e718646e08aba3e5d99a22dd46f6a9;hb=7fe6593d72990d1dacc1d68aee2b909866c9d3c7;hp=549c5e36fa9fd3c19316789219552a2010a8120f;hpb=7474a620a5538091b9c1cba877156f5645d78aa6;p=sbcl.git

diff --git a/src/pcl/vector.lisp b/src/pcl/vector.lisp
index 549c5e3..2b4f2d2 100644
--- a/src/pcl/vector.lisp
+++ b/src/pcl/vector.lisp
@@ -985,12 +985,13 @@
          ;; The lambda-list used by BIND-ARGS
          (bind-list lambda-list)
          (setq-p (getf (cdr lmf-params) :setq-p))
+         (auxp (member '&aux bind-list))
          (call-next-method-p (getf (cdr lmf-params) :call-next-method-p)))
     ;; Try to use the normal function call machinery instead of BIND-ARGS
-    ;; bindings the arguments, unless:
+    ;; binding the arguments, unless:
     (unless (or ;; If all arguments are required, BIND-ARGS will be a no-op
                 ;; in any case.
-                (not restp)
+                (and (not restp) (not auxp))
                 ;; CALL-NEXT-METHOD wants to use BIND-ARGS, and needs a
                 ;; list of all non-required arguments.
                 call-next-method-p)
@@ -1013,7 +1014,9 @@
                          '.rest-arg.))
              (fmf-lambda-list (if rest-arg
                                   (append req-args (list '&rest rest-arg))
-                                  lambda-list)))
+                                  (if call-next-method-p
+                                      req-args
+                                      lambda-list))))
         `(list*
           :function
           (let* ((fmf (,(if (body-method-name body) 'named-lambda 'lambda)
@@ -1091,11 +1094,7 @@
                                    (method-function nm)
                                    nm)
                      :call-method-args (list nms)))))
-        (if restp
-            (let* ((rest (nthcdr nreq method-args))
-                   (args (ldiff method-args rest)))
-              (apply fmf pv-cell nmc (nconc args (list rest))))
-            (apply fmf pv-cell nmc method-args))))))
+        (apply fmf pv-cell nmc method-args)))))
 
 (defun get-pv-cell (method-args pv-table)
   (let ((pv-wrappers (pv-wrappers-from-all-args pv-table method-args)))