From 5135d00a5e5184b2ba955a1f9e538ad603848466 Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Tue, 15 Dec 2015 19:15:23 +0000
Subject: [PATCH] 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.
---
 doc/SYMBOLS           |  4 ++++
 doc/layout.tex        |  3 +++
 src/method-impl.lisp  |  8 +++++---
 src/method-proto.lisp | 10 ++++++++++
 4 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index 58fdc74..06e2002 100644
--- 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-live-p                       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
+  effective-method
   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-live-p
+  simple-effective-method
 effective-method-message
   effective-method
 effective-slot-class
diff --git a/doc/layout.tex b/doc/layout.tex
index c52989c..3c6fcf0 100644
--- a/doc/layout.tex
+++ b/doc/layout.tex
@@ -288,6 +288,9 @@
     {effective-method-basic-argument-names @<method> @> @<list>}
 \end{describe}
 
+\begin{describe}{gf}
+    {effective-method-live-p @<method> @> @<generalized-boolean>}
+\end{describe}
 
 
 \begin{describe}{cls}
diff --git a/src/method-impl.lisp b/src/method-impl.lisp
index 1256376..20380a7 100644
--- a/src/method-impl.lisp
+++ b/src/method-impl.lisp
@@ -790,9 +790,11 @@
 				       *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))
 
diff --git a/src/method-proto.lisp b/src/method-proto.lisp
index f5d8be7..b821912 100644
--- a/src/method-proto.lisp
+++ b/src/method-proto.lisp
@@ -216,6 +216,16 @@
    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.
 
-- 
2.11.0

