X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fpcl%2Fcombin.lisp;h=8128f53478e3b64bd0a6125c465300b0b694542a;hb=d0f65b07a30adc989e36a82ddc0ed54d135d638e;hp=a60d6cf97cb8b4b71694b2d8d2b7d6cb08c56260;hpb=90c4b36715e7173e12fe4af1079a347b2e6fd14b;p=sbcl.git

diff --git a/src/pcl/combin.lisp b/src/pcl/combin.lisp
index a60d6cf..8128f53 100644
--- a/src/pcl/combin.lisp
+++ b/src/pcl/combin.lisp
@@ -229,18 +229,19 @@
              ;; Otherwise the METHOD-COMBINATION slot is not bound.
              (let ((combin (generic-function-method-combination gf)))
                (and (long-method-combination-p combin)
-                    (long-method-combination-args-lambda-list combin))))))
+                    (long-method-combination-args-lambda-list combin)))))
+          (name `(emf ,(generic-function-name gf))))
       (cond
         (error-p
-         `(lambda (.pv. .next-method-call. &rest .args.)
-           (declare (ignore .pv. .next-method-call.))
-           (declare (ignorable .args.))
-           (flet ((%no-primary-method (gf args)
-                    (call-no-primary-method gf args))
-                  (%invalid-qualifiers (gf combin method)
-                    (invalid-qualifiers gf combin method)))
-             (declare (ignorable #'%no-primary-method #'%invalid-qualifiers))
-             ,effective-method)))
+         `(named-lambda ,name (.pv. .next-method-call. &rest .args.)
+            (declare (ignore .pv. .next-method-call.))
+            (declare (ignorable .args.))
+            (flet ((%no-primary-method (gf args)
+                     (call-no-primary-method gf args))
+                   (%invalid-qualifiers (gf combin method)
+                     (invalid-qualifiers gf combin method)))
+              (declare (ignorable #'%no-primary-method #'%invalid-qualifiers))
+              ,effective-method)))
         (mc-args-p
          (let* ((required (make-dfun-required-args nreq))
                 (gf-args (if applyp
@@ -250,17 +251,17 @@
                                       (the (and unsigned-byte fixnum)
                                         .dfun-more-count.)))
                              `(list ,@required))))
-           `(lambda ,ll
-             (declare (ignore .pv. .next-method-call.))
-             (let ((.gf-args. ,gf-args))
-               (declare (ignorable .gf-args.))
-               ,@check-applicable-keywords
-               ,effective-method))))
+           `(named-lambda ,name ,ll
+              (declare (ignore .pv. .next-method-call.))
+              (let ((.gf-args. ,gf-args))
+                (declare (ignorable .gf-args.))
+                ,@check-applicable-keywords
+                ,effective-method))))
         (t
-         `(lambda ,ll
-           (declare (ignore ,@(if error-p ll '(.pv. .next-method-call.))))
-           ,@check-applicable-keywords
-           ,effective-method))))))
+         `(named-lambda ,name ,ll
+            (declare (ignore ,@(if error-p ll '(.pv. .next-method-call.))))
+            ,@check-applicable-keywords
+            ,effective-method))))))
 
 (defun expand-emf-call-method (gf form metatypes applyp env)
   (declare (ignore gf metatypes applyp env))
@@ -406,16 +407,10 @@
 (defun gf-requires-emf-keyword-checks (generic-function)
   (member '&key (gf-lambda-list generic-function)))
 
-(defvar *in-precompute-effective-methods-p* nil)
-
 (defun standard-compute-effective-method
     (generic-function combin applicable-methods)
   (collect ((before) (primary) (after) (around))
-    (flet ((invalid (gf combin m)
-             (if *in-precompute-effective-methods-p*
-                 (return-from standard-compute-effective-method
-                   `(%invalid-qualifiers ',gf ',combin ',m))
-                 (invalid-qualifiers gf combin m))))
+    (flet ((invalid (gf combin m) (invalid-qualifiers gf combin m)))
       (dolist (m applicable-methods)
         (let ((qualifiers (if (listp m)
                               (early-method-qualifiers m)