1.0.8.25: refactor CAN-OPTIMIZE-ACCESS usage and interface

[sbcl.git] / src / pcl / combin.lisp

diff --git a/src/pcl/combin.lisp b/src/pcl/combin.lisp
index ba3d35a..b6a0fc1 100644 (file)
--- a/src/pcl/combin.lisp
+++ b/src/pcl/combin.lisp
@@ -216,10 +216,9 @@
 
 (defun expand-effective-method-function (gf effective-method &optional env)
   (declare (ignore env))
-  (multiple-value-bind (nreq applyp metatypes nkeys arg-info)
+  (multiple-value-bind (nreq applyp)
       (get-generic-fun-info gf)
-    (declare (ignore nreq nkeys arg-info))
-    (let ((ll (make-fast-method-call-lambda-list metatypes applyp))
+    (let ((ll (make-fast-method-call-lambda-list nreq applyp))
           (check-applicable-keywords
            (when (and applyp (gf-requires-emf-keyword-checks gf))
              '((check-applicable-keywords))))
@@ -243,16 +242,12 @@
              (declare (ignorable #'%no-primary-method #'%invalid-qualifiers))
              ,effective-method)))
         (mc-args-p
-         (let* ((required
-                 ;; FIXME: Ick. Shared idiom, too, with stuff in cache.lisp
-                 (let (req)
-                   (dotimes (i (length metatypes) (nreverse req))
-                     (push (dfun-arg-symbol i) req))))
+         (let* ((required (make-dfun-required-args nreq))
                 (gf-args (if applyp
                              `(list* ,@required
                                      (sb-c::%listify-rest-args
                                       .dfun-more-context.
-                                      (the (and (unsigned-byte fixnum))
+                                      (the (and unsigned-byte fixnum)
                                         .dfun-more-count.)))
                              `(list ,@required))))
            `(lambda ,ll
@@ -314,7 +309,7 @@
     (call-method
      (let ((gensym (get-effective-method-gensym)))
        (values (make-emf-call
-                metatypes applyp gensym
+                (length metatypes) applyp gensym
                 (make-effective-method-fun-type
                  generic-function form method-alist-p wrappers-p))
                (list gensym))))
@@ -323,7 +318,7 @@
            (type (make-effective-method-list-fun-type
                   generic-function form method-alist-p wrappers-p)))
        (values `(dolist (emf ,gensym nil)
-                 ,(make-emf-call metatypes applyp 'emf type))
+                 ,(make-emf-call (length metatypes) applyp 'emf type))
                (list gensym))))
     (check-applicable-keywords
      (values `(check-applicable-keywords .keyargs-start.