0.7.9.50:

	Implement NO-PRIMARY-METHOD, following WHN/Gerd Moellman
	... and use it when we can't use NO-APPLICABLE-METHOD

diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index b2ed047..9198f09 100644 (file)
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -635,3 +635,13 @@
         generic-function
         method
         args))
+
+;;; An extension to the ANSI standard: in the presence of e.g. a
+;;; :BEFORE method, it would seem that going through
+;;; NO-APPLICABLE-METHOD is prohibited, as in fact there is an
+;;; applicable method.  -- CSR, 2002-11-15
+(defmethod no-primary-method (generic-function &rest args)
+  (error "~@<There is no primary method for the generic function ~2I~_~S~
+         ~I~_when called with arguments ~2I~_~S.~:>"
+        generic-function
+        args))

diff --git a/src/pcl/combin.lisp b/src/pcl/combin.lisp
index 47b7844..bb04d62 100644 (file)
--- a/src/pcl/combin.lisp
+++ b/src/pcl/combin.lisp
@@ -177,10 +177,18 @@
          ;; When there are no primary methods and a next-method call occurs
          ;; effective-method is (error "No mumble..") and the defined
          ;; args are not used giving a compiler warning.
-         (error-p (eq (first effective-method) 'error)))
-      `(lambda ,ll
-       (declare (ignore ,@(if error-p ll '(.pv-cell. .next-method-call.))))
-       ,effective-method))))
+         (error-p (eq (first effective-method) '%no-primary-method)))
+      (cond
+       (error-p
+        `(lambda (.pv-cell. .next-method-call. &rest .args.)
+          (declare (ignore .pv-cell. .next-method-call.))
+          (flet ((%no-primary-method (gf args)
+                   (apply #'no-primary-method gf args)))
+            ,effective-method)))
+       (t
+        `(lambda ,ll
+          (declare (ignore ,@(if error-p ll '(.pv-cell. .next-method-call.))))
+          ,effective-method))))))
 
 (defun expand-emf-call-method (gf form metatypes applyp env)
   (declare (ignore gf metatypes applyp env))
@@ -341,8 +349,7 @@
          primary (reverse primary)
          around  (reverse around))
     (cond ((null primary)
-          `(error "There is no primary method for the generic function ~S."
-                  ',generic-function))
+          `(%no-primary-method ',generic-function .args.))
          ((and (null before) (null after) (null around))
           ;; By returning a single call-method `form' here we enable
           ;; an important implementation-specific optimization.

diff --git a/src/pcl/generic-functions.lisp b/src/pcl/generic-functions.lisp
index 0a2a808..f91adbf 100644 (file)
--- a/src/pcl/generic-functions.lisp
+++ b/src/pcl/generic-functions.lisp
@@ -495,6 +495,8 @@
 
 (defgeneric no-next-method (generic-function method &rest args))
 
+(defgeneric no-primary-method (generic-function &rest args))
+
 (defgeneric reader-method-class (class direct-slot &rest initargs))
 
 (defgeneric reinitialize-instance (gf &rest args &key &allow-other-keys))

diff --git a/version.lisp-expr b/version.lisp-expr
index ea74d17..f8a9047 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.9.49"
+"0.7.9.50"