src/class-layout-impl.lisp: Abstract out `sod-message-applicable-methods'.

We shall want this more later.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 944a975..ff820f1 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -544,6 +544,7 @@ method-proto.lisp
   method-keyword-argument-lists                 generic
   primary-method-class                          generic
   simple-method-body                            generic
+  sod-message-applicable-methods                generic
   sod-message-argument-tail                     generic
   sod-message-effective-method-class            generic
   sod-method-description                        generic
@@ -1514,6 +1515,8 @@ sod-initializer-slot
   sod-initializer
 sod-initializer-value
   sod-initializer
+sod-message-applicable-methods
+  sod-message sod-class
 sod-message-argument-tail
   basic-message
 sod-message-class

diff --git a/doc/layout.tex b/doc/layout.tex
index b106aa4..952cec0 100644 (file)
--- a/doc/layout.tex
+++ b/doc/layout.tex
@@ -230,6 +230,10 @@
 \end{describe*}
 
 \begin{describe}{gf}
+    {sod-message-applicable-methods @<message> @<class> @> list}
+\end{describe}
+
+\begin{describe}{gf}
     {sod-message-effective-method-class @<message> @> @<class>}
 \end{describe}
 

diff --git a/src/class-layout-impl.lisp b/src/class-layout-impl.lisp
index 119996e..7ff4667 100644 (file)
--- a/src/class-layout-impl.lisp
+++ b/src/class-layout-impl.lisp
@@ -127,14 +127,18 @@
            (sod-class-nickname (method-entry-chain-head entry))
            (method-entry-role entry))))
 
+(defmethod sod-message-applicable-methods
+    ((message sod-message) (class sod-class))
+  (mappend (lambda (super)
+            (remove message
+                    (sod-class-methods super)
+                    :key #'sod-method-message
+                    :test-not #'eql))
+          (sod-class-precedence-list class)))
+
 (defmethod compute-sod-effective-method
     ((message sod-message) (class sod-class))
-  (let ((direct-methods (mappend (lambda (super)
-                                  (remove message
-                                          (sod-class-methods super)
-                                          :key #'sod-method-message
-                                          :test-not #'eql))
-                                (sod-class-precedence-list class))))
+  (let ((direct-methods (sod-message-applicable-methods message class)))
     (make-instance (sod-message-effective-method-class message)
                   :message message
                   :class class

diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index f7f1f47..4a624c5 100644 (file)
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -49,6 +49,14 @@
    will be a list of applicable methods sorted in most-to-least specific
    order."))
 
+(export 'sod-message-applicable-methods)
+(defgeneric sod-message-applicable-methods (message class)
+  (:documentation
+   "Return a list of applicable methods for a MESSAGE.
+
+   The list contains all methods applicable for MESSAGE when sent to an
+   instance of CLASS, most specific first."))
+
 (export 'sod-message-effective-method-class)
 (defgeneric sod-message-effective-method-class (message)
   (:documentation