src/method-{impl,proto}.lisp: Add `sod-method-description'.

Now we can report on kinds of methods.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 17eb597b316b9decff8db46b42de9bbbf5ea975c..ab66f2565ac03f2a0449d05322f3fb4e2b1b375f 100644 (file)
--- 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 cbc7cd07b1d5733b284db494d8b2474648ba2526..80c264e1d9b39452fb50491bbfc2c3147f77ae78 100644 (file)
--- 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 9f1a48f185027c98d689b68c3bb779f0a848b83d..630570b546907edb507274148dba4d4b35fd5693 100644 (file)
--- 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 e85f62ad78e25daf26bb8619f686cfa7bf11010f..2d5f4715165088e2520139df923f427d212e74ad 100644 (file)
--- 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