From 43ce48fd4112471e4c7ef083297688fc45add4a8 Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Tue, 5 Jan 2016 22:43:47 +0000
Subject: [PATCH] src/method-{proto,impl}.lisp: New
 `method-keyword-argument-lists' protocol.

In case method classes want to introduce keyword arguments from
somewhere other than the obvious direct methods, there's now a separate
bit of protocol for determining the lists of keyword arguments which
need to be merged together.
---
 doc/SYMBOLS           |  3 +++
 doc/layout.tex        |  4 ++++
 src/method-impl.lisp  | 25 ++++++++++++++++---------
 src/method-proto.lisp |  9 +++++++++
 4 files changed, 32 insertions(+), 9 deletions(-)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index f729de4..af83764 100644
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -503,6 +503,7 @@ method-proto.lisp
   method-entry-function-name                    generic
   method-entry-function-type                    generic
   method-entry-slot-name                        generic
+  method-keyword-argument-lists                 generic
   primary-method-class                          generic
   simple-method-body                            generic
   sod-message-argument-tail                     generic
@@ -1212,6 +1213,8 @@ method-entry-function-type
   method-entry
 method-entry-slot-name
   method-entry
+method-keyword-argument-lists
+  effective-method t
 module-dependencies
   module
 (setf module-dependencies)
diff --git a/doc/layout.tex b/doc/layout.tex
index 3c6fcf0..ab63860 100644
--- a/doc/layout.tex
+++ b/doc/layout.tex
@@ -230,6 +230,10 @@
 \end{describe}
 
 \begin{describe}{gf}
+    {method-keyword-argument-lists @<method> @<direct-methods> @> @<list>}
+\end{describe}
+
+\begin{describe}{gf}
     {compute-sod-effective-method @<message> @<class> @> @<method>}
 \end{describe}
 
diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index 20380a7..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
diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index b821912..048c924 100644
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -63,6 +63,15 @@
 
    This protocol is used by `simple-message' subclasses."))
 
+(export 'method-keyword-argument-lists)
+(defgeneric method-keyword-argument-lists (method direct-methods)
+  (:documentation
+   "Returns a list of keyword argument lists to be merged.
+
+   This should return a list suitable for passing to `merge-keyword-lists',
+   i.e., each element should be a pair consisting of a list of `argument'
+   objects and a string describing the source of the argument list."))
+
 (export 'compute-sod-effective-method)
 (defgeneric compute-sod-effective-method (message class)
   (:documentation
-- 
2.11.0