0.8.2.7:

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

diff --git a/src/pcl/defcombin.lisp b/src/pcl/defcombin.lisp
index e312ba9..7652ec8 100644 (file)
--- a/src/pcl/defcombin.lisp
+++ b/src/pcl/defcombin.lisp
@@ -161,8 +161,33 @@
                `(,operator ,@(mapcar (lambda (m) `(call-method ,m ()))
                                      primary)))))
       (cond ((null primary)
-            `(error "No ~S methods for the generic function ~S."
-                    ',type ',generic-function))
+            ;; As of sbcl-0.8.0.80 we don't seem to need to need
+            ;; to do anything messy like
+            ;;        `(APPLY (FUNCTION (IF AROUND
+            ;;                              'NO-PRIMARY-METHOD
+            ;;                              'NO-APPLICABLE-METHOD)
+            ;;                           ',GENERIC-FUNCTION
+            ;;                           .ARGS.)
+            ;; here because (for reasons I don't understand at the
+            ;; moment -- WHN) control will never reach here if there
+            ;; are no applicable methods, but instead end up
+            ;; in NO-APPLICABLE-METHODS first.
+            ;;
+            ;; FIXME: The way that we arrange for .ARGS. to be bound 
+            ;; here seems weird. We rely on EXPAND-EFFECTIVE-METHOD-FUNCTION
+            ;; recognizing any form whose operator is %NO-PRIMARY-METHOD
+            ;; as magical, and carefully surrounding it with a
+            ;; LAMBDA form which binds .ARGS. But...
+            ;;   1. That seems fragile, because the magicalness of
+            ;;      %NO-PRIMARY-METHOD forms is scattered around
+            ;;      the system. So it could easily be broken by
+            ;;      locally-plausible maintenance changes like,
+            ;;      e.g., using the APPLY expression above.
+            ;;   2. That seems buggy w.r.t. to MOPpish tricks in
+            ;;      user code, e.g.
+            ;;         (DEFMETHOD COMPUTE-EFFECTIVE-METHOD :AROUND (...)
+            ;;           `(PROGN ,(CALL-NEXT-METHOD) (INCF *MY-CTR*)))
+             `(%no-primary-method ',generic-function .args.))
            ((null around) main-method)
            (t
             `(call-method ,(car around)
@@ -233,9 +258,7 @@
        (type ll method-group-specifiers args-option gf-var body)
   (declare (ignore type))
   (multiple-value-bind (real-body declarations documentation)
-      ;; (Note that PARSE-BODY ignores its second arg ENVIRONMENT.)
-      (parse-body body nil)
-
+      (parse-body body)
     (let ((wrapped-body
            (wrap-method-group-specifier-bindings method-group-specifiers
                                                  declarations