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.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index f729de4d3cbc1662c72090dd04397d02ab388c9b..af83764e3b1de5b8dc17effbb375a5e1f2ca99b0 100644 (file)
--- 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-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
   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-entry
 method-entry-slot-name
   method-entry

+method-keyword-argument-lists
+  effective-method t

 module-dependencies
   module
 (setf module-dependencies)
 module-dependencies
   module
 (setf module-dependencies)

diff --git a/doc/layout.tex b/doc/layout.tex
index 3c6fcf06332be8856dd3ed061978954ebaa360c3..ab63860572f8d2f28ed8ed20237eab6b62d8fd5c 100644 (file)
--- a/doc/layout.tex
+++ b/doc/layout.tex
@@ -229,6 +229,10 @@
 \begin{describe}{gf}{primary-method-class @<message> @> @<class>}
 \end{describe}
 
 \begin{describe}{gf}{primary-method-class @<message> @> @<class>}
 \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}
 \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 20380a7c4b7818bf044b79403a5532847a841cda..9f1a48f185027c98d689b68c3bb779f0a848b83d 100644 (file)
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -244,21 +244,28 @@ (define-on-demand-slot delegating-direct-method function-type (method)
 ;;;--------------------------------------------------------------------------
 ;;; Effective method classes.
 
 ;;;--------------------------------------------------------------------------
 ;;; 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
 (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
 
 (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 b82191206753d78dc737d59a6039a529a600eb79..048c9249d3471f0f67eb402e419fd1a0b30d85fe 100644 (file)
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -63,6 +63,15 @@ (defgeneric primary-method-class (message)
 
    This protocol is used by `simple-message' subclasses."))
 
 
    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
 (export 'compute-sod-effective-method)
 (defgeneric compute-sod-effective-method (message class)
   (:documentation