src/method-{proto,impl}.lisp: Introduce `effective-method-live-p' protocol.

Previously, the `compute-method-entry-functions' method defined on
`simple-effective-method' would bail out early if there were no primary
methods.  This is unsatisfactory: subclasses of `simple-effective-
method' might want to introduce more complicated method combination
machinery.

Make this a proper part of the protocol: introduce `effective-method-
live-p', which gets to decide whether to make method-entry functions or
just leave the vtable pointers null.  Now `simple-effective-method' can
decide, in the same way, to suppress the method entries based on the
existence of primary methods, but subclasses can apply more (or less)
subtle policy.

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 58fdc748f130df4ec3d6b114e2e603c0b77e96e0..06e2002d54c8f93e267f96a6177b3bddb243e0a9 100644 (file)
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -479,6 +479,7 @@ method-proto.lisp
   effective-method-class                        generic
   effective-method-function-name                generic
   effective-method-keywords                     generic
   effective-method-class                        generic
   effective-method-function-name                generic
   effective-method-keywords                     generic

+  effective-method-live-p                       generic

   effective-method-message                      generic
   ensure-ilayout-var                            function
   inst-chain-head                               generic
   effective-method-message                      generic
   ensure-ilayout-var                            function
   inst-chain-head                               generic


@@ -842,6 +843,7 @@ compute-islots
   sod-class sod-class
 compute-method-entry-functions
   basic-effective-method
   sod-class sod-class
 compute-method-entry-functions
   basic-effective-method

+  effective-method

   simple-effective-method
 compute-sod-effective-method
   sod-message sod-class
   simple-effective-method
 compute-sod-effective-method
   sod-message sod-class


@@ -876,6 +878,8 @@ effective-method-function-name
   effective-method
 effective-method-keywords
   effective-method
   effective-method
 effective-method-keywords
   effective-method

+effective-method-live-p
+  simple-effective-method

 effective-method-message
   effective-method
 effective-slot-class
 effective-method-message
   effective-method
 effective-slot-class

diff --git a/doc/layout.tex b/doc/layout.tex
index c52989cd82901f8a50f388f4551a90c8b401fe2a..3c6fcf06332be8856dd3ed061978954ebaa360c3 100644 (file)
--- a/doc/layout.tex
+++ b/doc/layout.tex
@@ -288,6 +288,9 @@
     {effective-method-basic-argument-names @<method> @> @<list>}
 \end{describe}
 
     {effective-method-basic-argument-names @<method> @> @<list>}
 \end{describe}
 

+\begin{describe}{gf}
+    {effective-method-live-p @<method> @> @<generalized-boolean>}
+\end{describe}

 
 
 \begin{describe}{cls}
 
 
 \begin{describe}{cls}

diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index 1256376158091721c45106d0044ca1e0b16ef79c..20380a7c4b7818bf044b79403a5532847a841cda 100644 (file)
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -790,9 +790,11 @@ (defmethod compute-effective-method-body :around
                                       *null-pointer* 0)))
               (call-next-method)))))))
 
                                       *null-pointer* 0)))
               (call-next-method)))))))
 

-(defmethod compute-method-entry-functions
-    ((method simple-effective-method))
-  (if (effective-method-primary-methods method)
+(defmethod effective-method-live-p ((method simple-effective-method))
+  (effective-method-primary-methods method))
+
+(defmethod compute-method-entry-functions :around ((method effective-method))
+  (if (effective-method-live-p method)

       (call-next-method)
       nil))
 
       (call-next-method)
       nil))
 

diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index f5d8be7a228f737136ee21c809eba410d08eb0d3..b82191206753d78dc737d59a6039a529a600eb79 100644 (file)
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -216,6 +216,16 @@ (defgeneric effective-method-basic-argument-names (method)
    not included, and neither are more exotic arguments added as part of the
    method delegation protocol."))
 
    not included, and neither are more exotic arguments added as part of the
    method delegation protocol."))
 

+(export 'effective-method-live-p)
+(defgeneric effective-method-live-p (method)
+  (:documentation
+   "Returns true if the effective METHOD is live.
+
+   An effective method is `live' if it should actually have proper method entry
+   functions associated with it and stored in the class vtable.  The other
+   possibility is that the method is `dead', in which case the function
+   pointers in the vtable are left null."))
+

 ;;;--------------------------------------------------------------------------
 ;;; Code generation.
 
 ;;;--------------------------------------------------------------------------
 ;;; Code generation.