From 9c29a20fc74f6a5710a83cdb17d3e8814de4605e Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Mon, 9 Jul 2018 12:19:19 +0100
Subject: [PATCH] src/class-layout-impl.lisp: Abstract out
 `sod-message-applicable-methods'.

We shall want this more later.
---
 doc/SYMBOLS                |  3 +++
 doc/layout.tex             |  4 ++++
 src/class-layout-impl.lisp | 16 ++++++++++------
 src/method-proto.lisp      |  8 ++++++++
 4 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 944a975..ff820f1 100644
--- 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
--- 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
--- 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
--- 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
-- 
2.11.0