X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/1622ed8e30b05ba9025520cde3e68d186c8c7e50..89ef4001b93c0219096c94125e7e9fdb745d2c97:/src/method-impl.lisp

diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index 1256376..9f1a48f 100644
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -244,21 +244,28 @@
 ;;;--------------------------------------------------------------------------
 ;;; Effective method classes.
 
+(defmethod method-keyword-argument-lists
+    ((method effective-method) direct-methods)
+  (with-slots (message) method
+     (and (keyword-message-p message)
+	  (mapcar (lambda (m)
+		    (let ((type (sod-method-type m)))
+		      (cons (c-function-keywords type)
+			    (format nil "method for ~A on ~A (at ~A)"
+				    message
+				    (sod-method-class m)
+				    (file-location m)))))
+		  direct-methods))))
+
 (defmethod shared-initialize :after
     ((method effective-method) slot-names &key direct-methods)
   (declare (ignore slot-names))
 
   ;; Set the keyword argument list.
   (with-slots (message keywords) method
-    (setf keywords (and (keyword-message-p message)
-			(merge-keyword-lists
-			 (mapcar (lambda (m)
-				   (let ((type (sod-method-type m)))
-				     (cons (c-function-keywords type)
-					   (format nil "method for ~A on ~A"
-						   message
-						   (sod-method-class m)))))
-				 direct-methods))))))
+    (setf keywords
+	  (merge-keyword-lists (method-keyword-argument-lists
+				method direct-methods)))))
 
 (export '(basic-effective-method
 	  effective-method-around-methods effective-method-before-methods
@@ -790,9 +797,11 @@
 				       *null-pointer* 0)))
 	       (call-next-method)))))))
 
-(defmethod compute-method-entry-functions
-    ((method simple-effective-method))
-  (if (effective-method-primary-methods method)
+(defmethod effective-method-live-p ((method simple-effective-method))
+  (effective-method-primary-methods method))
+
+(defmethod compute-method-entry-functions :around ((method effective-method))
+  (if (effective-method-live-p method)
       (call-next-method)
       nil))