From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Fri, 15 Nov 2002 14:47:05 +0000 (+0000)
Subject: 0.7.9.50:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7ffdb2f586bf545334b64e639e9e78c30c2063d6;p=sbcl.git

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
--- 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
--- 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
--- 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
--- 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"