From 675b48242d0f5c6f2f2563003a1d2fd87e06522c Mon Sep 17 00:00:00 2001
Message-Id: <675b48242d0f5c6f2f2563003a1d2fd87e06522c.1715470367.git.mdw@distorted.org.uk>
From: Mark Wooding <mdw@chiark.greenend.org.uk>
Date: Sun, 26 Mar 2017 15:16:18 +0100
Subject: [PATCH] src/method-{impl,proto}.lisp: Add `sod-method-description'.
Organization: Straylight/Edgeware

From: Mark Wooding <mdw@distorted.org.uk>

Now we can report on kinds of methods.
---
 doc/SYMBOLS           |  3 +++
 doc/layout.tex        |  3 +++
 src/method-impl.lisp  |  5 +++++
 src/method-proto.lisp | 10 ++++++++++
 4 files changed, 21 insertions(+)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 17eb597..ab66f25 100644
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -540,6 +540,7 @@ method-proto.lisp
   simple-method-body                            generic
   sod-message-argument-tail                     generic
   sod-message-effective-method-class            generic
+  sod-method-description                        generic
   sod-method-function-name                      generic
   sod-method-function-type                      generic
   sod-method-next-method-type                   generic
@@ -1505,6 +1506,8 @@ sod-method-body
   sod-method
 sod-method-class
   sod-method
+sod-method-description
+  basic-direct-method
 sod-method-function-name
   basic-direct-method
 sod-method-function-type
diff --git a/doc/layout.tex b/doc/layout.tex
index cbc7cd0..80c264e 100644
--- a/doc/layout.tex
+++ b/doc/layout.tex
@@ -272,6 +272,9 @@
 \begin{describe}{gf}{sod-method-next-method-type @<method> @> @<c-type>}
 \end{describe}
 
+\begin{describe}{gf}{sod-method-description @<method> @> @<string>}
+\end{describe}
+
 \begin{describe}{gf}{sod-method-function-name @<method> @> @<string>}
 \end{describe}
 
diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index 9f1a48f..630570b 100644
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -152,6 +152,11 @@ (define-on-demand-slot basic-direct-method function-type (method)
 		 ("me" (* (class (sod-method-class method))))
 		 . method-args))))
 
+(defmethod sod-method-description ((method basic-direct-method))
+  (with-slots (role) method
+    (if role (string-downcase role)
+	"primary")))
+
 (defmethod sod-method-function-name ((method basic-direct-method))
   (with-slots ((class %class) role message) method
     (format nil "~A__~@[~(~A~)_~]method_~A__~A" class role
diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index e85f62a..2d5f471 100644
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -147,6 +147,16 @@ (defgeneric sod-message-argument-tail (message)
 
    No `me' argument is prepended; any `:ellipsis' is left as it is."))
 
+(export 'sod-method-description)
+(defgeneric sod-method-description (method)
+  (:documentation
+   "Return an adjectival phrase describing METHOD.
+
+    The result will be placed into an error message reading something like
+    ``Conflicting definition of DESCRIPTION direct method `bogus'''.  Two
+    direct methods which can coexist in the same class, defined on the same
+    message, should have differing descriptions."))
+
 (export 'sod-method-function-type)
 (defgeneric sod-method-function-type (method)
   (:documentation
-- 
[mdw]