939 lines
81 KiB
HTML
939 lines
81 KiB
HTML
|
<!DOCTYPE html>
|
||
|
|
<html lang='en'><head><meta charset='utf-8' /><meta name='pinterest' content='nopin' /><link href='../../../../static/css/style.css' rel='stylesheet' type='text/css' /><link href='../../../../static/css/print.css' rel='stylesheet' type='text/css' media='print' /><title>Depending in Common Lisp / Steve Losh</title></head><body><header><a id='logo' href='https://stevelosh.com/'>Steve Losh</a><nav><a href='../../../index.html'>Blog</a> - <a href='https://stevelosh.com/projects/'>Projects</a> - <a href='https://stevelosh.com/photography/'>Photography</a> - <a href='https://stevelosh.com/links/'>Links</a> - <a href='https://stevelosh.com/rss.xml'>Feed</a></nav></header><hr class='main-separator' /><main id='page-blog-entry'><article><h1><a href='index.html'>Depending in Common Lisp</a></h1><p class='date'>Posted on August 26th, 2022.</p><p>A while ago I was working on a Common Lisp library that makes use of the
|
||
|
|
<a href="http://metamodular.com/CLOS-MOP/">Metaobject Protocol</a>. I ran into a few edge
|
||
|
|
cases around dependencies between classes and it took a while for me to figure
|
||
|
|
out how to solve them, so I wanted to write down what I learned in case anyone
|
||
|
|
else might find it useful. This post is an expanded version of <a href="https://www.reddit.com/r/Common_Lisp/comments/kljyg1/need_advice_on_how_to_handle_metaclass_option/">a Reddit
|
||
|
|
thread</a> I posted.</p>
|
||
|
|
|
||
|
|
<ol class="table-of-contents"><li><a href="index.html#s1-setting-the-stage">Setting the Stage</a><ol><li><a href="index.html#s2-adding-more-flexibility">Adding More Flexibility</a></li><li><a href="index.html#s3-toy-example-disclaimer">Toy Example Disclaimer</a></li></ol></li><li><a href="index.html#s4-the-problem">The Problem</a></li><li><a href="index.html#s5-the-dependent-maintenance-protocol">The Dependent Maintenance Protocol</a><ol><li><a href="index.html#s6-dependency-wrappers">Dependency Wrappers</a></li><li><a href="index.html#s7-defining-the-metaclass">Defining the Metaclass</a></li><li><a href="index.html#s8-computing-slots">Computing Slots</a></li><li><a href="index.html#s9-initialization">Initialization</a></li><li><a href="index.html#s10-reinitialization">Reinitialization</a></li><li><a href="index.html#s11-dependent-updates">Dependent Updates</a></li></ol></li><li><a href="index.html#s12-the-result">The Result</a></li><li><a href="index.html#s13-is-it-worth-it">Is It Worth It?</a></li></ol>
|
||
|
|
|
||
|
|
<h2 id="s1-setting-the-stage"><a href="index.html#s1-setting-the-stage">Setting the Stage</a></h2>
|
||
|
|
|
||
|
|
<p>Before we can see the problem, we need a simple example. We'll use the
|
||
|
|
<code>monitored-class</code> metaclass from <a href="https://en.wikipedia.org/wiki/The_Art_of_the_Metaobject_Protocol">The Art of the Metaobject Protocol</a>
|
||
|
|
(pages 96-97). Using this class as a metaclass will log all slot reads and
|
||
|
|
writes, which could be useful for auditing access to certain objects.</p>
|
||
|
|
|
||
|
|
<p>Before we get started we'll need <a href="https://github.com/pcostanza/closer-mop">Closer to MOP</a> as an
|
||
|
|
implementation compatibility layer:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code">ql:quickload <span class="keyword">:closer-mop</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>First we define the metaclass:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> monitored-class <span class="paren2">(<span class="code">standard-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"></span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>Next we'll explicitly say that it's okay for a monitored class to have
|
||
|
|
superclasses that are standard classes:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> c2mop:validate-superclass
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">class monitored-class</span>)</span> <span class="paren3">(<span class="code">superclass standard-class</span>)</span></span>)</span>
|
||
|
|
t</span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>And now we can define the actual monitoring functionality. We'll use <code>:before</code>
|
||
|
|
methods on <code>slot-value-using-class</code> and its <code>setf</code> version to log the reads and
|
||
|
|
writes of all slots:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> c2mop:slot-value-using-class <span class="keyword">:before</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">class monitored-class</span>)</span> instance slot</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">format t <span class="string">"Reading slot ~A of ~A at ~A.~%"</span>
|
||
|
|
<span class="paren3">(<span class="code">c2mop:slot-definition-name slot</span>)</span> instance <span class="paren3">(<span class="code">get-universal-time</span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> <span class="paren2">(<span class="code">setf c2mop:slot-value-using-class</span>)</span> <span class="keyword">:before</span>
|
||
|
|
<span class="paren2">(<span class="code">new-value <span class="paren3">(<span class="code">class monitored-class</span>)</span> instance slot</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">format t <span class="string">"Setting slot ~A of ~A to ~S at ~A.~%"</span>
|
||
|
|
<span class="paren3">(<span class="code">c2mop:slot-definition-name slot</span>)</span> instance new-value <span class="paren3">(<span class="code">get-universal-time</span>)</span></span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>With that complete, we can define a new monitored class:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> user <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">id <span class="keyword">:initarg</span> <span class="keyword">:id</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">name <span class="keyword">:initarg</span> <span class="keyword">:name</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>And now we can see it in action:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defparameter</span></i> <span class="special">*u*</span> <span class="paren2">(<span class="code">make-instance 'user <span class="keyword">:id</span> 1 <span class="keyword">:name</span> <span class="string">"sjl"</span></span>)</span></span>)</span>
|
||
|
|
<span class="comment">; => Setting slot ID of #<USER {10074DFD33}> to 1 at 3828527923.
|
||
|
|
</span><span class="comment">; => Setting slot NAME of #<USER {10074DFD33}> to "sjl" at 3828527923.
|
||
|
|
</span><span class="comment">; => *U*
|
||
|
|
</span>
|
||
|
|
<span class="paren1">(<span class="code">slot-value <span class="special">*u*</span> 'id</span>)</span>
|
||
|
|
<span class="comment">; => Reading slot ID of #<USER {10074DFD33}> at 3828527937.
|
||
|
|
</span><span class="comment">; => 1
|
||
|
|
</span>
|
||
|
|
<span class="paren1">(<span class="code">setf <span class="paren2">(<span class="code">slot-value <span class="special">*u*</span> 'name</span>)</span> <span class="string">"Steve"</span></span>)</span>
|
||
|
|
<span class="comment">; => Setting slot NAME of #<USER {10074DFD33}> to "Steve" at 3828527946.
|
||
|
|
</span><span class="comment">; => "Steve"</span></span></code></pre>
|
||
|
|
|
||
|
|
<h3 id="s2-adding-more-flexibility"><a href="index.html#s2-adding-more-flexibility">Adding More Flexibility</a></h3>
|
||
|
|
|
||
|
|
<p>Now that we have a toy example working, let's make it a little more flexible.
|
||
|
|
Instead of always generating a string and writing it to standard out, we'll
|
||
|
|
allow users to provide a <code>:monitoring-function</code> as a class option that will
|
||
|
|
receive the data and can do whatever it wants. For example:</p>
|
||
|
|
|
||
|
|
<ul>
|
||
|
|
<li>Logging to syslog instead of standard out.</li>
|
||
|
|
<li>Inserting a row into a Postgres database as an audit log.</li>
|
||
|
|
<li>Tracking read/write counts in a hash table to find slots that are written more
|
||
|
|
often than they're read and vice versa.</li>
|
||
|
|
</ul>
|
||
|
|
|
||
|
|
<p>A monitoring function will receive 2 arguments (the instance and slot name),
|
||
|
|
plus an optional third argument when a slot is written (the new value). We can
|
||
|
|
make a default monitoring function that works the same way as before:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> log-slot-access <span class="paren2">(<span class="code">instance slot-name &optional <span class="paren3">(<span class="code">new-value nil new-value?</span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><i><span class="symbol">if</span></i> new-value?
|
||
|
|
<span class="paren3">(<span class="code">format t <span class="string">"Setting slot ~A of ~A to ~S at ~A.~%"</span>
|
||
|
|
slot-name instance new-value <span class="paren4">(<span class="code">get-universal-time</span>)</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">format t <span class="string">"Reading slot ~A of ~A at ~A.~%"</span>
|
||
|
|
slot-name instance <span class="paren4">(<span class="code">get-universal-time</span>)</span></span>)</span></span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>Note the use of the extended <code>&optional</code> form with the
|
||
|
|
<a href="http://www.lispworks.com/documentation/HyperSpec/Body/03_dab.htm"><code>supplied-p-parameter</code></a> used to check whether a value was given,
|
||
|
|
which ensures this works correctly even when setting a slot to <code>nil</code>.</p>
|
||
|
|
|
||
|
|
<p>Also note how we called it <code>new-value?</code> and not <code>new-value-p</code> as you'll
|
||
|
|
sometimes see people do. The <code>-p</code> in <code>new-value-p</code> stands for "predicate", and
|
||
|
|
a <a href="http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#predicate">predicate</a> is a <em>function</em> that returns a (generalized) boolean,
|
||
|
|
<em>not</em> a boolean itself. Using a name that ends in <code>-p</code> for a boolean value
|
||
|
|
(rather than for a predicate) is a <code>-p</code>et <code>-p</code>eeve of mine. Unfortunately it
|
||
|
|
happens in a couple of places (even in Common Lisp itself), so it's something to
|
||
|
|
watch out for.</p>
|
||
|
|
|
||
|
|
<p>Now we can update our <code>monitored-class</code> to add a slot to store the monitoring
|
||
|
|
function for each class, and update the <code>slot-value-using-class</code> methods to use
|
||
|
|
that instead of writing the string themselves:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> monitored-class <span class="paren2">(<span class="code">standard-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">monitoring-function <span class="keyword">:initarg</span> <span class="keyword">:monitoring-function</span>
|
||
|
|
<span class="keyword">:accessor</span> monitoring-function</span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> c2mop:slot-value-using-class <span class="keyword">:before</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">class monitored-class</span>)</span> instance slot</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">funcall <span class="paren3">(<span class="code">monitoring-function class</span>)</span>
|
||
|
|
instance
|
||
|
|
<span class="paren3">(<span class="code">c2mop:slot-definition-name slot</span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> <span class="paren2">(<span class="code">setf c2mop:slot-value-using-class</span>)</span> <span class="keyword">:before</span>
|
||
|
|
<span class="paren2">(<span class="code">new-value <span class="paren3">(<span class="code">class monitored-class</span>)</span> instance slot</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">funcall <span class="paren3">(<span class="code">monitoring-function class</span>)</span>
|
||
|
|
instance
|
||
|
|
<span class="paren3">(<span class="code">c2mop:slot-definition-name slot</span>)</span>
|
||
|
|
new-value</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>When a user creates a new <code>monitored-class</code>, we need to set the
|
||
|
|
<code>monitoring-function</code> slot appropriately. We might initially consider doing
|
||
|
|
this by having an <code>initform</code> for the <code>monitoring-function</code> slot in the
|
||
|
|
metaclass, like this:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> monitored-class <span class="paren2">(<span class="code">standard-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">monitoring-function <span class="keyword">:initarg</span> <span class="keyword">:monitoring-function</span>
|
||
|
|
<span class="keyword">:accessor</span> monitoring-function
|
||
|
|
<span class="keyword">:initform</span> #'log-slot-access</span>)</span></span>)</span></span>)</span> <span class="comment">; default function</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>But this won't work for a number of reasons we'll see shortly. Instead we'll
|
||
|
|
need to handle the initialization ourselves. We'll do it in <code>shared-initialize</code>
|
||
|
|
so it will happen both when a class is first created and when it's reinitialized
|
||
|
|
(e.g. after it's redefined):</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> parse-monitoring-function-class-option <span class="paren2">(<span class="code">arguments</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">case <span class="paren3">(<span class="code">length arguments</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">1 <span class="paren4">(<span class="code">eval <span class="paren5">(<span class="code">first arguments</span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">0 #'log-slot-access</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">t <span class="paren4">(<span class="code">error <span class="string">"Malformed monitoring-function option."</span></span>)</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> shared-initialize <span class="keyword">:around</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">class monitored-class</span>)</span> slot-names
|
||
|
|
&rest initargs
|
||
|
|
&key monitoring-function &allow-other-keys</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">apply #'call-next-method class slot-names
|
||
|
|
<span class="keyword">:monitoring-function</span> <span class="paren3">(<span class="code">parse-monitoring-function-class-option
|
||
|
|
monitoring-function</span>)</span>
|
||
|
|
initargs</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>If the user provided a <code>(:monitoring-function …)</code> class option we evaluate and
|
||
|
|
use it, otherwise we default to our simple logging function.</p>
|
||
|
|
|
||
|
|
<p>There are a couple of things to note here.</p>
|
||
|
|
|
||
|
|
<p>First, when <code>defclass</code> gets a class option like <code>(:monitoring-function foo)</code>,
|
||
|
|
what it <em>actually</em> passes to the <code>(re)initialize-instance</code> methods is the list
|
||
|
|
<code>(foo)</code>. This allows for class options with more than one argument. In our
|
||
|
|
case we only ever want a single argument, so we ensure the <code>length</code> of the
|
||
|
|
argument is <code>0</code> or <code>1</code> and handle the cases individually.</p>
|
||
|
|
|
||
|
|
<p>Second, <code>defclass</code> does not evaluate the class option's arguments. If we say
|
||
|
|
<code>(:monitoring-function (lambda (i s &optional v) (print (list i s v))))</code> what we
|
||
|
|
get as the initarg will be <code>((lambda (i s &optional v) (print (list i s v))))</code>.
|
||
|
|
That's a list of a list of three elements, <em>not</em> a list of an actual function
|
||
|
|
object. If we want the arguments to be evaluated, we have to do it ourselves.
|
||
|
|
Unfortunately as far as I can tell there's no way to evaluate these arguments
|
||
|
|
from <code>defclass</code> in their lexical environment — we have to fall back to <code>eval</code>
|
||
|
|
and the null lexical environment. That means that something like this will not
|
||
|
|
work:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">flet</span></i> <span class="paren2">(<span class="code"><span class="paren3">(<span class="code">monitor <span class="paren4">(<span class="code">instance slot-name &optional new-value</span>)</span>
|
||
|
|
…</span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><i><span class="symbol">defclass</span></i> foo <span class="paren3">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">…slots…</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code"><span class="keyword">:monitoring-function</span> #'monitor</span>)</span></span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>I haven't managed to find a way to make this work with <code>defclass</code>. If anyone
|
||
|
|
knows of a solution, please let me know.</p>
|
||
|
|
|
||
|
|
<p>Third, you might notice that we're <code>apply</code>ing with the full <code>initargs</code> list,
|
||
|
|
which includes the original (unparsed) <code>monitoring-function</code>. But that keyword
|
||
|
|
argument will be shadowed by the <code>:monitoring-function</code> we add at the beginning,
|
||
|
|
so there's no need to bother removing it from <code>initargs</code> before we apply (though
|
||
|
|
it wouldn't hurt to do so). This is another Common Lisp idiom you'll see here
|
||
|
|
and there when someone wants to override a single keyword argument but preserve
|
||
|
|
all the rest.</p>
|
||
|
|
|
||
|
|
<p>Now we can talk about all the reasons why <code>:initform #'log-slot-access</code> doesn't
|
||
|
|
magically solve all our problems.</p>
|
||
|
|
|
||
|
|
<p>First, the <code>:initform</code> <em>would</em> work properly when you first define a class, but
|
||
|
|
we still need all the code in <code>shared-initialize</code> to do the <code>eval</code>ing of the
|
||
|
|
forms the user provides when they <em>don't</em> use it.</p>
|
||
|
|
|
||
|
|
<p>Further, suppose a user runs:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> foo <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">some-slot <span class="keyword">:initarg</span> <span class="keyword">:some-slot</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:monitoring-function</span> monitor-foo</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>Then later they <em>remove</em> the <code>:monitoring-function</code> from the <code>defclass</code> and
|
||
|
|
reevaluate it:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> foo <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">some-slot <span class="keyword">:initarg</span> <span class="keyword">:some-slot</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>What the user (probably) expects here is for the class to have the default
|
||
|
|
monitoring function. This is what will happen if they start a fresh Lisp image
|
||
|
|
and load the current code into it. But if we had just used <code>:initform</code>, the
|
||
|
|
class would already have a value for the <code>monitoring-function</code> slot (the old
|
||
|
|
function) and since there's no <em>new</em> value being specified, the <code>:initform</code>
|
||
|
|
would never be used and nothing would get updated, so the class would continue
|
||
|
|
to use the old monitoring function. The user would have to clean things up
|
||
|
|
manually by killing the class with <code>(setf (find-class 'foo) nil)</code> and
|
||
|
|
reevaluating the <code>defclass</code>, or fixing the slot value up manually, or some other
|
||
|
|
ugly alternative.</p>
|
||
|
|
|
||
|
|
<p>With all that out of the way, we can now use a custom <code>monitoring-function</code> to
|
||
|
|
do whatever we want:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defparameter</span></i> <span class="special">*user-slot-reads*</span> <span class="paren2">(<span class="code">make-hash-table</span>)</span></span>)</span>
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defparameter</span></i> <span class="special">*user-slot-writes*</span> <span class="paren2">(<span class="code">make-hash-table</span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> track-user-slot-access
|
||
|
|
<span class="paren2">(<span class="code">instance slot-name &optional <span class="paren3">(<span class="code">new-value nil new-value?</span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">declare <span class="paren3">(<span class="code">ignore instance new-value</span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">incf <span class="paren3">(<span class="code">gethash slot-name
|
||
|
|
<span class="paren4">(<span class="code"><i><span class="symbol">if</span></i> new-value? <span class="special">*user-slot-writes*</span> <span class="special">*user-slot-reads*</span></span>)</span>
|
||
|
|
0</span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> user <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">id <span class="keyword">:initarg</span> <span class="keyword">:id</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">name <span class="keyword">:initarg</span> <span class="keyword">:name</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:monitoring-function</span> #'track-user-slot-access</span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="comment">;; Two writes
|
||
|
|
</span><span class="paren1">(<span class="code"><i><span class="symbol">defparameter</span></i> <span class="special">*u*</span> <span class="paren2">(<span class="code">make-instance 'user <span class="keyword">:id</span> 1 <span class="keyword">:name</span> <span class="string">"sjl"</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="comment">;; A read
|
||
|
|
</span><span class="paren1">(<span class="code">slot-value <span class="special">*u*</span> 'id</span>)</span>
|
||
|
|
|
||
|
|
<span class="comment">;; Two more writes
|
||
|
|
</span><span class="paren1">(<span class="code">setf <span class="paren2">(<span class="code">slot-value <span class="special">*u*</span> 'name</span>)</span> <span class="string">"steve"</span></span>)</span>
|
||
|
|
<span class="paren1">(<span class="code">setf <span class="paren2">(<span class="code">slot-value <span class="special">*u*</span> 'name</span>)</span> <span class="string">"sjl"</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="comment">;; Results
|
||
|
|
</span><span class="paren1">(<span class="code">alexandria:hash-table-alist <span class="special">*user-slot-reads*</span></span>)</span>
|
||
|
|
<span class="comment">; => ((ID . 1))
|
||
|
|
</span>
|
||
|
|
<span class="paren1">(<span class="code">alexandria:hash-table-alist <span class="special">*user-slot-writes*</span></span>)</span>
|
||
|
|
<span class="comment">; => ((NAME . 3) (ID . 1))</span></span></code></pre>
|
||
|
|
|
||
|
|
<h3 id="s3-toy-example-disclaimer"><a href="index.html#s3-toy-example-disclaimer">Toy Example Disclaimer</a></h3>
|
||
|
|
|
||
|
|
<p>The <code>monitored-class</code> example we've used so far is pretty small, and there are
|
||
|
|
a number of other ways we could accomplish the same thing, some of which might
|
||
|
|
not involve metaclasses at all. This might make my example seem overly
|
||
|
|
complicated.</p>
|
||
|
|
|
||
|
|
<p>I wanted to keep the example small so I can focus on the actual problem I ran
|
||
|
|
into without getting bogged down in too many irrelevant details about a specific
|
||
|
|
implementation. If you're bothered by how we're using metaclasses here when
|
||
|
|
there are other ways to implement this toy example, feel free to implement
|
||
|
|
a more extensive <code>monitored-class</code> variant as an exercise:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> user <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">id …</span>)</span>
|
||
|
|
<span class="comment">;; Never monitor this slot:
|
||
|
|
</span> <span class="paren3">(<span class="code">session-id … <span class="keyword">:monitored</span> nil</span>)</span>
|
||
|
|
<span class="comment">;; We only care when this slot *changes*:
|
||
|
|
</span> <span class="paren3">(<span class="code">role … <span class="keyword">:monitored/reads</span> nil</span>)</span>
|
||
|
|
<span class="comment">;; Names are PII, redact their values before logging:
|
||
|
|
</span> <span class="paren3">(<span class="code">name … <span class="keyword">:monitored/redact-value</span> t</span>)</span>
|
||
|
|
<span class="comment">;; Redact the user portion of the email address, logging only the domain:
|
||
|
|
</span> <span class="paren3">(<span class="code">email … <span class="keyword">:monitored/redact-value</span> #'scrub-email</span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:monitoring-function</span> #'log-to-syslog</span>)</span>
|
||
|
|
<span class="comment">;; Allow us to turn monitoring on/off globally:
|
||
|
|
</span> <span class="paren2">(<span class="code"><span class="keyword">:monitor-when</span> #'monitoring-enabled-p</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<h2 id="s4-the-problem"><a href="index.html#s4-the-problem">The Problem</a></h2>
|
||
|
|
|
||
|
|
<p>Let's return to a toy example that will help demonstrate the problem I ran into.
|
||
|
|
Suppose we have a <code>user</code> class and want to monitor that class to log a warning
|
||
|
|
if someone ever changes the <code>id</code> of an instance:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> monitor-user <span class="paren2">(<span class="code">instance slot &optional <span class="paren3">(<span class="code">new-value nil new-value?</span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">when <span class="paren3">(<span class="code">and <span class="paren4">(<span class="code">eql slot 'id</span>)</span> new-value?</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">when <span class="paren4">(<span class="code">slot-boundp instance 'id</span>)</span> <span class="comment">; ignore initial setting of the value
|
||
|
|
</span> <span class="paren4">(<span class="code">format t <span class="string">"WARNING: User ~A is getting a new ID ~A, this is concerning."</span>
|
||
|
|
<span class="paren5">(<span class="code">slot-value instance 'id</span>)</span>
|
||
|
|
new-value</span>)</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> user <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">id <span class="keyword">:initarg</span> <span class="keyword">:id</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">name <span class="keyword">:initarg</span> <span class="keyword">:name</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:monitoring-function</span> #'monitor-user</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>This works as expected:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defparameter</span></i> <span class="special">*u*</span> <span class="paren2">(<span class="code">make-instance 'user <span class="keyword">:id</span> 1 <span class="keyword">:name</span> <span class="string">"sjl"</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code">slot-value <span class="special">*u*</span> 'id</span>)</span>
|
||
|
|
<span class="comment">; => 1
|
||
|
|
</span>
|
||
|
|
<span class="paren1">(<span class="code">setf <span class="paren2">(<span class="code">slot-value <span class="special">*u*</span> 'id</span>)</span> 999</span>)</span>
|
||
|
|
<span class="comment">; WARNING: User 1 is getting a new ID 999, this is concerning.
|
||
|
|
</span><span class="comment">; => 999
|
||
|
|
</span>
|
||
|
|
<span class="paren1">(<span class="code">slot-value <span class="special">*u*</span> 'id</span>)</span>
|
||
|
|
<span class="comment">; => 999</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>So far, so good. But what happens if we add a subclass of user?</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> paid-user <span class="paren2">(<span class="code">user</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">plan <span class="keyword">:initarg</span> <span class="keyword">:plan</span> <span class="keyword">:type</span> <span class="paren4">(<span class="code">member <span class="keyword">:bronze</span> <span class="keyword">:silver</span> <span class="keyword">:gold</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defparameter</span></i> <span class="special">*p*</span>
|
||
|
|
<span class="paren2">(<span class="code">make-instance 'paid-user <span class="keyword">:id</span> 2 <span class="keyword">:name</span> <span class="string">"moneybags"</span> <span class="keyword">:plan</span> <span class="keyword">:gold</span></span>)</span></span>)</span>
|
||
|
|
<span class="comment">; => Setting slot ID of #<PAID-USER {100DE55F43}> to 2 at 3870460545.
|
||
|
|
</span><span class="comment">; => Setting slot NAME of #<PAID-USER {100DE55F43}> to "moneybags" at 3870460545.
|
||
|
|
</span><span class="comment">; => Setting slot PLAN of #<PAID-USER {100DE55F43}> to :GOLD at 3870460545.</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>We can already see the problem: we didn't explicitly specify
|
||
|
|
<code>(:monitoring-function #'monitor-user)</code> in the <code>defclass</code> options, so this class
|
||
|
|
used the default monitoring function instead of inheriting the monitoring
|
||
|
|
function from its superclass. This may be what you want in some cases, but for
|
||
|
|
this case I'd prefer subclasses to inherit their superclass' monitoring function
|
||
|
|
if they don't explicitly specify one themselves.</p>
|
||
|
|
|
||
|
|
<p>When I saw this, my first instinct was to update
|
||
|
|
<code>parse-monitoring-function-class-option</code> to take the class as an extra option
|
||
|
|
and use that to look up a superclass monitoring function (if any) to use as the
|
||
|
|
default instead, which would look something like this:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> monitored-class-p <span class="paren2">(<span class="code">class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">typep class 'monitored-class</span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> first-monitored-superclass <span class="paren2">(<span class="code">class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><i><span class="symbol">let</span></i> <span class="paren3">(<span class="code"><span class="paren4">(<span class="code">superclasses <span class="paren5">(<span class="code">rest <span class="paren6">(<span class="code">c2mop:class-precedence-list class</span>)</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">first <span class="paren4">(<span class="code">remove-if-not #'monitored-class-p superclasses</span>)</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> parse-monitoring-function-class-option <span class="paren2">(<span class="code">class arguments</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">case <span class="paren3">(<span class="code">length arguments</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">1 <span class="paren4">(<span class="code">eval <span class="paren5">(<span class="code">first arguments</span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">0 <span class="paren4">(<span class="code"><i><span class="symbol">let</span></i> <span class="paren5">(<span class="code"><span class="paren6">(<span class="code">super <span class="paren1">(<span class="code">first-monitored-superclass class</span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="comment">;; Inherit the monitoring function from its most specific monitored
|
||
|
|
</span> <span class="comment">;; superclass, or use the default if there isn't one.
|
||
|
|
</span> <span class="paren5">(<span class="code"><i><span class="symbol">if</span></i> super
|
||
|
|
<span class="paren6">(<span class="code">monitoring-function super</span>)</span>
|
||
|
|
#'log-slot-access</span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">t <span class="paren4">(<span class="code">error <span class="string">"Malformed monitoring-function option."</span></span>)</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> shared-initialize <span class="keyword">:around</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">class monitored-class</span>)</span> slot-names
|
||
|
|
&rest initargs
|
||
|
|
&key monitoring-function &allow-other-keys</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">apply #'call-next-method class slot-names
|
||
|
|
<span class="keyword">:monitoring-function</span> <span class="paren3">(<span class="code">parse-monitoring-function-class-option
|
||
|
|
class monitoring-function</span>)</span>
|
||
|
|
initargs</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>Unfortunately, if you try to actually run that code you'll discover a few
|
||
|
|
unpleasant things. First, the class precedence list isn't available the first
|
||
|
|
time the class is being initialized. So we can't use it in <code>shared-initialize</code>
|
||
|
|
like this.</p>
|
||
|
|
|
||
|
|
<p>Second, I misled you earlier. There's a line <a href="http://metamodular.com/CLOS-MOP/initialization-of-class-metaobjects2.html">deep in the bowels of the
|
||
|
|
Metaobject protocol</a> that says:</p>
|
||
|
|
|
||
|
|
<blockquote>
|
||
|
|
<p>Portable programs must not define methods on <code>shared-initialize</code>.</p>
|
||
|
|
</blockquote>
|
||
|
|
|
||
|
|
<p>So we can't use <code>shared-initialize</code> as a shortcut <em>at all</em>, and will need to
|
||
|
|
define separate methods for <code>initialize-instance</code> and <code>reinitialize-instance</code>
|
||
|
|
after all.</p>
|
||
|
|
|
||
|
|
<p>But even worse, if we think ahead a little bit (which I, of course, did not do
|
||
|
|
when I was figuring all this out), we can see this entire strategy is doomed to
|
||
|
|
failure from the start. Consider the following series of actions by a user at
|
||
|
|
a REPL:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="comment">;; Create user class, monitor with default function.
|
||
|
|
</span><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> user <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">id <span class="keyword">:initarg</span> <span class="keyword">:id</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">name <span class="keyword">:initarg</span> <span class="keyword">:name</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="comment">;; Create paid user class, inherits monitoring function from user.
|
||
|
|
</span><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> paid-user <span class="paren2">(<span class="code">user</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">plan <span class="keyword">:initarg</span> <span class="keyword">:plan</span> <span class="keyword">:type</span> <span class="paren4">(<span class="code">member <span class="keyword">:bronze</span> <span class="keyword">:silver</span> <span class="keyword">:gold</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="comment">;; Redefine user class, because actually we want to log
|
||
|
|
</span><span class="comment">;; monitored slots to Postgres.
|
||
|
|
</span><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> user <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">id <span class="keyword">:initarg</span> <span class="keyword">:id</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">name <span class="keyword">:initarg</span> <span class="keyword">:name</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:monitoring-function</span> #'log-slots-to-postgres</span>)</span></span>)</span> <span class="comment">; NEW</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>Clearly what should happen here is that the <code>paid-user</code> class should now inherit
|
||
|
|
the <em>new</em> monitoring function. But the strategy of trying to set the monitoring
|
||
|
|
function <em>once</em> when a class is initialized or reinitialized falls apart when
|
||
|
|
you want to support redefinition of superclasses and have their subclasses
|
||
|
|
inherit changes.</p>
|
||
|
|
|
||
|
|
<p>At this point, things are not looking good. We need a new plan.</p>
|
||
|
|
|
||
|
|
<h2 id="s5-the-dependent-maintenance-protocol"><a href="index.html#s5-the-dependent-maintenance-protocol">The Dependent Maintenance Protocol</a></h2>
|
||
|
|
|
||
|
|
<p>Fortunately, as often happens in Common Lisp, the creators of CLOS and the
|
||
|
|
Metaobject Protocol had a wonderful amount of foresight and provided a way out
|
||
|
|
of this problem in the form of the <a href="http://metamodular.com/CLOS-MOP/dependent-maintenance-protocol.html">CLOS Dependent Maintenance Protocol</a>.
|
||
|
|
From that page:</p>
|
||
|
|
|
||
|
|
<blockquote>
|
||
|
|
<p>It is convenient for portable metaobjects to be able to memoize information
|
||
|
|
about other metaobjects[…]. Because class […] metaobjects can be
|
||
|
|
reinitialized[…], a means must be provided to update this memoized
|
||
|
|
information.</p>
|
||
|
|
</blockquote>
|
||
|
|
|
||
|
|
<p>This is exactly what we need! We want to memoize the monitoring function each
|
||
|
|
monitored class will use, and we need to keep that up to date when any of the
|
||
|
|
classes in the inheritance hierarchy are updated.</p>
|
||
|
|
|
||
|
|
<p>The full details are laid out in the protocol documentation, but let's step
|
||
|
|
through an example here to see it in action.</p>
|
||
|
|
|
||
|
|
<h3 id="s6-dependency-wrappers"><a href="index.html#s6-dependency-wrappers">Dependency Wrappers</a></h3>
|
||
|
|
|
||
|
|
<p>The protocol states:</p>
|
||
|
|
|
||
|
|
<blockquote>
|
||
|
|
<p>To prevent conflicts between two portable programs, or between portable
|
||
|
|
programs and the implementation, portable code must not register metaobjects
|
||
|
|
themselves as dependents. Instead, portable programs which need to record
|
||
|
|
a metaobject as a dependent, should encapsulate that metaobject in some other
|
||
|
|
kind of object, and record that object as the dependent.</p>
|
||
|
|
</blockquote>
|
||
|
|
|
||
|
|
<p>With this in mind, we'll need to make a small wrapper we can use to store
|
||
|
|
dependents:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> dependency <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">dependent <span class="keyword">:accessor</span> dependent <span class="keyword">:initarg</span> <span class="keyword">:dep</span></span>)</span></span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>And then we'll make some utility functions to add and remove dependencies
|
||
|
|
to/from classes, which we'll use shortly:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> dependency= <span class="paren2">(<span class="code">d class</span>)</span>
|
||
|
|
<span class="string">"Return whether `d` is a dependency on `class`."</span>
|
||
|
|
<span class="comment">;; We need to filter out any other dependents other code might have added.
|
||
|
|
</span> <span class="paren2">(<span class="code">and <span class="paren3">(<span class="code">typep d 'dependency</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">eql <span class="paren4">(<span class="code">dependent d</span>)</span> class</span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> ensure-dependency <span class="paren2">(<span class="code">superclass class</span>)</span>
|
||
|
|
<span class="string">"Ensure that `class` is a dependent of `superclass`."</span>
|
||
|
|
<span class="paren2">(<span class="code">c2mop:map-dependents superclass
|
||
|
|
<span class="paren3">(<span class="code"><i><span class="symbol">lambda</span></i> <span class="paren4">(<span class="code">d</span>)</span>
|
||
|
|
<span class="paren4">(<span class="code">when <span class="paren5">(<span class="code">dependency= d class</span>)</span>
|
||
|
|
<span class="paren5">(<span class="code"><i><span class="symbol">return-from</span></i> ensure-dependency</span>)</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">c2mop:add-dependent superclass <span class="paren3">(<span class="code">make-instance 'dependency <span class="keyword">:dep</span> class</span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> ensure-no-dependency <span class="paren2">(<span class="code">superclass class</span>)</span>
|
||
|
|
<span class="string">"Ensure that `class` is NOT a dependent of `superclass`."</span>
|
||
|
|
<span class="paren2">(<span class="code">c2mop:map-dependents superclass
|
||
|
|
<span class="paren3">(<span class="code"><i><span class="symbol">lambda</span></i> <span class="paren4">(<span class="code">d</span>)</span>
|
||
|
|
<span class="paren4">(<span class="code">when <span class="paren5">(<span class="code">dependency= d class</span>)</span>
|
||
|
|
<span class="paren5">(<span class="code">c2mop:remove-dependent superclass d</span>)</span>
|
||
|
|
<span class="paren5">(<span class="code"><i><span class="symbol">return-from</span></i> ensure-no-dependency</span>)</span></span>)</span></span>)</span></span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>When we define a subclass on a monitored class, e.g. when we ran <code>(defclass
|
||
|
|
paid-user (user) …)</code> before, we'll need to <code>(ensure-dependency user paid-user)</code>
|
||
|
|
to tell CLOS that <code>paid-user</code> is dependent on <code>user</code>, and needs to be updated if
|
||
|
|
<code>user</code> is changed. We also want to make sure to only add the dependency if it
|
||
|
|
doesn't already exist, to avoid useless work.</p>
|
||
|
|
|
||
|
|
<p>But things can get a little trickier than this, because if <code>paid-user</code> is then
|
||
|
|
redefined to <em>not</em> be a subclass of <code>user</code> any more (unlikely, but possible) we
|
||
|
|
want to <em>remove</em> that dependency. So we'll need both utility functions for
|
||
|
|
managing the dependencies.</p>
|
||
|
|
|
||
|
|
<h3 id="s7-defining-the-metaclass"><a href="index.html#s7-defining-the-metaclass">Defining the Metaclass</a></h3>
|
||
|
|
|
||
|
|
<p>We'll need to update our metaclass to not only store the monitoring function,
|
||
|
|
but also store what the user <em>specified</em> as the monitoring function, in case we
|
||
|
|
need to recompute it later. We'll also tell Lisp it's okay for a monitored
|
||
|
|
class to be a subclass of a standard class, add our <code>slot-value-using-class</code>
|
||
|
|
methods from before, and define a helper type predicate while we're here:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> monitored-class <span class="paren2">(<span class="code">standard-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">given-monitoring-function
|
||
|
|
<span class="keyword">:initarg</span> <span class="keyword">:given-monitoring-function</span>
|
||
|
|
<span class="keyword">:accessor</span> given-monitoring-function</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">computed-monitoring-function
|
||
|
|
<span class="keyword">:initarg</span> <span class="keyword">:computed-monitoring-function</span>
|
||
|
|
<span class="keyword">:accessor</span> computed-monitoring-function</span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> c2mop:validate-superclass
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">class monitored-class</span>)</span> <span class="paren3">(<span class="code">superclass standard-class</span>)</span></span>)</span>
|
||
|
|
t</span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> c2mop:slot-value-using-class <span class="keyword">:before</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">class monitored-class</span>)</span> instance slot</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">funcall <span class="paren3">(<span class="code">computed-monitoring-function class</span>)</span>
|
||
|
|
instance
|
||
|
|
<span class="paren3">(<span class="code">c2mop:slot-definition-name slot</span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> <span class="paren2">(<span class="code">setf c2mop:slot-value-using-class</span>)</span> <span class="keyword">:before</span>
|
||
|
|
<span class="paren2">(<span class="code">new-value <span class="paren3">(<span class="code">class monitored-class</span>)</span> instance slot</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">funcall <span class="paren3">(<span class="code">computed-monitoring-function class</span>)</span>
|
||
|
|
instance
|
||
|
|
<span class="paren3">(<span class="code">c2mop:slot-definition-name slot</span>)</span>
|
||
|
|
new-value</span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> monitored-class-p <span class="paren2">(<span class="code">object</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">typep object 'monitored-class</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<h3 id="s8-computing-slots"><a href="index.html#s8-computing-slots">Computing Slots</a></h3>
|
||
|
|
|
||
|
|
<p>We're going to need a function for computing the value of the slot. It will
|
||
|
|
serve the same role <code>parse-monitoring-function-class-option</code> was serving before.</p>
|
||
|
|
|
||
|
|
<p>If we only have one class option like <code>:monitoring-function</code> we could hardcode
|
||
|
|
it into a function like this:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> recompute-monitoring-function <span class="paren2">(<span class="code">&key class superclasses value value?</span>)</span>
|
||
|
|
<span class="string">"Set the metaclass' monitoring-function slots to the appropriate value.
|
||
|
|
|
||
|
|
If the user provides an explicit value it will be used, otherwise the value
|
||
|
|
will be inherited from any superclass' value, otherwise the default will be
|
||
|
|
used.
|
||
|
|
|
||
|
|
In any case, the computed value is stored in the `computed-…` slot, and the
|
||
|
|
original user-given value (if any) is stored in the `given-…` slot so we can
|
||
|
|
use it later if any superclasses change and we need to recompute this.
|
||
|
|
|
||
|
|
"</span>
|
||
|
|
<span class="comment">;; Only consider monitored superclasses.
|
||
|
|
</span> <span class="paren2">(<span class="code">setf superclasses <span class="paren3">(<span class="code">remove-if-not #'monitored-class-p superclasses</span>)</span></span>)</span>
|
||
|
|
<span class="comment">;; We need to store whether the user gave an explicit value for later.
|
||
|
|
</span> <span class="paren2">(<span class="code"><i><span class="symbol">if</span></i> value?
|
||
|
|
<span class="paren3">(<span class="code">setf <span class="paren4">(<span class="code">slot-value class 'given-monitoring-function</span>)</span> value</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">slot-makunbound class 'given-monitoring-function</span>)</span></span>)</span>
|
||
|
|
<span class="comment">;; Set the computed value.
|
||
|
|
</span> <span class="paren2">(<span class="code">setf <span class="paren3">(<span class="code">slot-value class 'computed-monitoring-function</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code"><i><span class="symbol">cond</span></i>
|
||
|
|
<span class="comment">;; If the user gave a value, use it (after checking it's well-formed).
|
||
|
|
</span> <span class="paren4">(<span class="code">value? <span class="paren5">(<span class="code"><i><span class="symbol">progn</span></i> <span class="paren6">(<span class="code">assert <span class="paren1">(<span class="code">= 1 <span class="paren2">(<span class="code">length value</span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren6">(<span class="code">eval <span class="paren1">(<span class="code">first value</span>)</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="comment">;; Otherwise, if there are any monitored superclasses, use the most
|
||
|
|
</span> <span class="comment">;; specific one's monitoring function.
|
||
|
|
</span> <span class="paren4">(<span class="code">superclasses <span class="paren5">(<span class="code">slot-value <span class="paren6">(<span class="code">first superclasses</span>)</span>
|
||
|
|
'computed-monitoring-function</span>)</span></span>)</span>
|
||
|
|
<span class="comment">;; Otherwise use the default.
|
||
|
|
</span> <span class="paren4">(<span class="code">t #'log-slot-access</span>)</span></span>)</span></span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>First we clean up the superclass list to only consider relevant superclasses.</p>
|
||
|
|
|
||
|
|
<p>Then we store the value the user gave, if any, in the
|
||
|
|
<code>given-monitoring-function</code> slot of the class. If they <em>didn't</em> specify a value
|
||
|
|
(e.g. if they <em>removed</em> it and reevaluated the <code>defclass</code>), we make sure to
|
||
|
|
account for that by <code>slot-makunbound</code>ing the slot to clear out any possible old
|
||
|
|
value.</p>
|
||
|
|
|
||
|
|
<p>Then we compute what the real value should be. If they gave us a value, we
|
||
|
|
<code>eval</code> it as we talked about earlier and use that. Otherwise we use whatever we
|
||
|
|
computed for a superclass, if available, otherwise the default.</p>
|
||
|
|
|
||
|
|
<p>This is all we need if we've only got one option to deal with, as in our toy
|
||
|
|
example. In my <em>actual</em> project I have a bunch of these options, and so added
|
||
|
|
a slightly-tedious layer of abstraction to avoid the very-tedious copy/paste
|
||
|
|
approach:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> recompute-slot
|
||
|
|
<span class="paren2">(<span class="code">&key class superclasses computed-slot given-slot value value? <i><span class="symbol">default</span></i></span>)</span>
|
||
|
|
<span class="string">"Set the metaclass' slots to the appropriate value.
|
||
|
|
|
||
|
|
For metaclass slots if the user provides an explicit value it will be used,
|
||
|
|
otherwise the value will be inherited from any superclass' value, otherwise
|
||
|
|
the default will be used.
|
||
|
|
|
||
|
|
In any case, the computed value is stored in the `computed-…` slot, and the
|
||
|
|
original user-given value (if any) is stored in the `given-…` slot so we can
|
||
|
|
use it later if any superclasses change and we need to recompute this.
|
||
|
|
|
||
|
|
"</span>
|
||
|
|
<span class="comment">;; Only consider monitored superclasses.
|
||
|
|
</span> <span class="paren2">(<span class="code">setf superclasses <span class="paren3">(<span class="code">remove-if-not #'monitored-class-p superclasses</span>)</span></span>)</span>
|
||
|
|
<span class="comment">;; We need to store whether the user gave an explicit value for later.
|
||
|
|
</span> <span class="paren2">(<span class="code"><i><span class="symbol">if</span></i> value?
|
||
|
|
<span class="paren3">(<span class="code">setf <span class="paren4">(<span class="code">slot-value class given-slot</span>)</span> value</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">slot-makunbound class given-slot</span>)</span></span>)</span>
|
||
|
|
<span class="comment">;; Set the actual value to the given value, or the superclass value,
|
||
|
|
</span> <span class="comment">;; or the default.
|
||
|
|
</span> <span class="paren2">(<span class="code">setf <span class="paren3">(<span class="code">slot-value class computed-slot</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code"><i><span class="symbol">cond</span></i>
|
||
|
|
<span class="paren4">(<span class="code">value? <span class="paren5">(<span class="code"><i><span class="symbol">progn</span></i> <span class="paren6">(<span class="code">assert <span class="paren1">(<span class="code">= 1 <span class="paren2">(<span class="code">length value</span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren6">(<span class="code">eval <span class="paren1">(<span class="code">first value</span>)</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren4">(<span class="code">superclasses <span class="paren5">(<span class="code">slot-value <span class="paren6">(<span class="code">first superclasses</span>)</span> computed-slot</span>)</span></span>)</span>
|
||
|
|
<span class="paren4">(<span class="code">t <i><span class="symbol">default</span></i></span>)</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> recompute-slots <span class="paren2">(<span class="code">class &key
|
||
|
|
direct-superclasses
|
||
|
|
<span class="paren3">(<span class="code">monitoring-function nil monitoring-function?</span>)</span>
|
||
|
|
&allow-other-keys</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">recompute-slot <span class="keyword">:class</span> class
|
||
|
|
<span class="keyword">:superclasses</span> direct-superclasses
|
||
|
|
<span class="keyword">:computed-slot</span> 'computed-monitoring-function
|
||
|
|
<span class="keyword">:given-slot</span> 'given-monitoring-function
|
||
|
|
<span class="keyword">:value</span> monitoring-function
|
||
|
|
<span class="keyword">:value?</span> monitoring-function?
|
||
|
|
<span class="keyword">:default</span> #'log-slot-access</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>Supporting more options is just a matter of adding more calls inside of
|
||
|
|
<code>recompute-slots</code>. It's not the most exciting code I've ever written, but it
|
||
|
|
works.</p>
|
||
|
|
|
||
|
|
<h3 id="s9-initialization"><a href="index.html#s9-initialization">Initialization</a></h3>
|
||
|
|
|
||
|
|
<p>Now we can finally define the <code>initialize-instance</code> and <code>reinitialize-instance</code>
|
||
|
|
methods on our class. We'll start with <code>initialize-instance</code> (and a helper
|
||
|
|
function):</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> strip-initargs <span class="paren2">(<span class="code">initargs</span>)</span>
|
||
|
|
<span class="string">"Remove any monitored-class initargs from `initargs`.
|
||
|
|
|
||
|
|
We need to do this because we handle these ourselves before
|
||
|
|
`call-next-method`, in `recompute-slots`, and if we leave them in
|
||
|
|
the initarg list then `call-next-method` will explode.
|
||
|
|
|
||
|
|
"</span>
|
||
|
|
<span class="paren2">(<span class="code"><i><span class="symbol">loop</span></i> <span class="keyword">:for</span> <span class="paren3">(<span class="code">initarg value</span>)</span> <span class="keyword">:on</span> initargs <span class="keyword">:by</span> #'cddr
|
||
|
|
<span class="keyword">:unless</span> <span class="paren3">(<span class="code">member initarg '<span class="paren4">(<span class="code"><span class="keyword">:monitoring-function</span></span>)</span></span>)</span>
|
||
|
|
<span class="keyword">:append</span> <span class="paren3">(<span class="code">list initarg value</span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> initialize-instance <span class="keyword">:around</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">class monitored-class</span>)</span> &rest initargs &key &allow-other-keys</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">apply #'recompute-slots class initargs</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">apply #'call-next-method class <span class="paren3">(<span class="code">strip-initargs initargs</span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">dolist <span class="paren3">(<span class="code">superclass <span class="paren4">(<span class="code">c2mop:class-direct-superclasses class</span>)</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">ensure-dependency superclass class</span>)</span></span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>We recompute our special slots, then delegate to <code>call-next-method</code> to handle
|
||
|
|
everything else, after stripping out our initargs because we've already handled
|
||
|
|
them.</p>
|
||
|
|
|
||
|
|
<p>The only other thing we have to do is plug into the dependent maintenance
|
||
|
|
protocol, to ensure that this new class is a dependent of all its superclasses.</p>
|
||
|
|
|
||
|
|
<p>You might think I'm being wasteful here and we should only add dependencies on
|
||
|
|
superclasses that are instances of our particular metaclass. For example, if we
|
||
|
|
have:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> some-other-mixin <span class="paren2">(<span class="code"></span>)</span> <span class="paren2">(<span class="code"></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> user <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">…slots…</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> paid-user <span class="paren2">(<span class="code">user some-other-mixin</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">…slots…</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>Then <code>paid-user</code> will be a dependent of both <code>user</code> <em>and</em> <code>some-other-mixin</code>.
|
||
|
|
This seems unnecessary, because changes in non-monitored superclasses won't have
|
||
|
|
any effect on our monitoring function computation.</p>
|
||
|
|
|
||
|
|
<p>Unfortunately, things are not so simple. If we only add dependencies on
|
||
|
|
monitored superclasses, this will fall apart in the face of <a href="http://metamodular.com/CLOS-MOP/class-finalization-protocol.html">forward-referenced
|
||
|
|
superclasses</a>. In case you weren't aware, Common Lisp allows you to define
|
||
|
|
a subclass before its superclass, as long as all the classes are in place before
|
||
|
|
you try to actually make an instance of the subclass:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="comment">;; Define a subclass.
|
||
|
|
</span><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> bar <span class="paren2">(<span class="code">foo</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">b <span class="keyword">:accessor</span> b <span class="keyword">:initarg</span> <span class="keyword">:b</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="comment">;; Trying to make an instance now will signal an error.
|
||
|
|
</span><span class="paren1">(<span class="code">make-instance 'bar <span class="keyword">:a</span> 1 <span class="keyword">:b</span> 2</span>)</span>
|
||
|
|
<span class="comment">; => While computing the class precedence list of the class named COMMON-LISP-USER::BAR.
|
||
|
|
</span><span class="comment">; => The class named COMMON-LISP-USER::FOO is a forward referenced class.
|
||
|
|
</span><span class="comment">; => The class named COMMON-LISP-USER::FOO is a direct superclass of the class named COMMON-LISP-USER::BAR.
|
||
|
|
</span>
|
||
|
|
<span class="comment">;; Go ahead and define the superclass.
|
||
|
|
</span><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> foo <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">a <span class="keyword">:accessor</span> a <span class="keyword">:initarg</span> <span class="keyword">:a</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="comment">;; Now we can make an instance of the subclass.
|
||
|
|
</span><span class="paren1">(<span class="code">make-instance 'bar <span class="keyword">:a</span> 1 <span class="keyword">:b</span> 2</span>)</span>
|
||
|
|
<span class="comment">; => #<BAR {101144FFC3}></span></span></code></pre>
|
||
|
|
|
||
|
|
<p>This complicates our lives when we're trying to manage dependents, because we
|
||
|
|
can't possibly know whether a forward-referenced superclass will eventually be
|
||
|
|
defined as a monitored class or not. So we'll just take the safe route and add
|
||
|
|
a dependent to <em>all</em> superclasses. This will result in a little extra work, but
|
||
|
|
it only happens when a class is being defined or redefined which will happen
|
||
|
|
relatively infrequently.</p>
|
||
|
|
|
||
|
|
<h3 id="s10-reinitialization"><a href="index.html#s10-reinitialization">Reinitialization</a></h3>
|
||
|
|
|
||
|
|
<p>We'll also need to define a method on <code>reinitialize-instance</code>:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> reinitialize-instance <span class="keyword">:around</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">class monitored-class</span>)</span> &rest initargs
|
||
|
|
&key <span class="paren3">(<span class="code">direct-superclasses nil direct-superclasses?</span>)</span>
|
||
|
|
&allow-other-keys</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">apply #'recompute-slots class
|
||
|
|
<span class="keyword">:direct-superclasses</span> <span class="paren3">(<span class="code"><i><span class="symbol">if</span></i> direct-superclasses?
|
||
|
|
direct-superclasses
|
||
|
|
<span class="paren4">(<span class="code">c2mop:class-direct-superclasses class</span>)</span></span>)</span>
|
||
|
|
initargs</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><i><span class="symbol">let</span></i> <span class="paren3">(<span class="code"><span class="paren4">(<span class="code">before <span class="paren5">(<span class="code">c2mop:class-direct-superclasses class</span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">apply #'call-next-method class <span class="paren4">(<span class="code">strip-initargs initargs</span>)</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code"><i><span class="symbol">let*</span></i> <span class="paren4">(<span class="code"><span class="paren5">(<span class="code">after <span class="paren6">(<span class="code">c2mop:class-direct-superclasses class</span>)</span></span>)</span>
|
||
|
|
<span class="paren5">(<span class="code">removed <span class="paren6">(<span class="code">set-difference before after</span>)</span></span>)</span>
|
||
|
|
<span class="paren5">(<span class="code">added <span class="paren6">(<span class="code">set-difference after before</span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren4">(<span class="code">dolist <span class="paren5">(<span class="code">superclass removed</span>)</span>
|
||
|
|
<span class="paren5">(<span class="code">ensure-no-dependency superclass class</span>)</span></span>)</span>
|
||
|
|
<span class="paren4">(<span class="code">dolist <span class="paren5">(<span class="code">superclass added</span>)</span>
|
||
|
|
<span class="paren5">(<span class="code">ensure-dependency superclass class</span>)</span></span>)</span></span>)</span></span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>The overall structure of this method is the same as <code>initialize-instance</code>:</p>
|
||
|
|
|
||
|
|
<ol>
|
||
|
|
<li>Recompute values of our special metaclass slot(s).</li>
|
||
|
|
<li><code>call-next-method</code> to finish the rest of the (re)initialization.</li>
|
||
|
|
<li>Ensure our dependencies are correct.</li>
|
||
|
|
</ol>
|
||
|
|
|
||
|
|
<p>But there are a couple of fiddly bits to note.</p>
|
||
|
|
|
||
|
|
<p>We may or may not get a new set of direct superclasses, depending on how the
|
||
|
|
reinitialization happened. We <em>always</em> need that list when we call
|
||
|
|
<code>recompute-slots</code> though, so we'll grab it ourselves if we don't get it.</p>
|
||
|
|
|
||
|
|
<p>We also save the list of direct superclasses before and after we defer to
|
||
|
|
<code>call-next-method</code> to complete the reinitialization, and then compare the list
|
||
|
|
before and after to figure out which dependencies we need to add or remove.</p>
|
||
|
|
|
||
|
|
<p>With all that out of the way, we're almost done.</p>
|
||
|
|
|
||
|
|
<h3 id="s11-dependent-updates"><a href="index.html#s11-dependent-updates">Dependent Updates</a></h3>
|
||
|
|
|
||
|
|
<p>Now we can finally tell CLOS to update dependents when a monitored class
|
||
|
|
changes:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> given-to-initarg <span class="paren2">(<span class="code">class initarg given-slot</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">when <span class="paren3">(<span class="code">slot-boundp class given-slot</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">list initarg <span class="paren4">(<span class="code">slot-value class given-slot</span>)</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defmethod</span></i> c2mop:update-dependent
|
||
|
|
<span class="paren2">(<span class="code">updated-class <span class="paren3">(<span class="code">dep dependency</span>)</span> &rest initargs</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">declare <span class="paren3">(<span class="code">ignore initargs</span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">when <span class="paren3">(<span class="code">monitored-class-p updated-class</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code"><i><span class="symbol">let</span></i> <span class="paren4">(<span class="code"><span class="paren5">(<span class="code">dependent-class <span class="paren6">(<span class="code">dependent dep</span>)</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren4">(<span class="code">apply #'reinitialize-instance dependent-class
|
||
|
|
<span class="paren5">(<span class="code">append
|
||
|
|
<span class="paren6">(<span class="code">given-to-initarg dependent-class
|
||
|
|
<span class="keyword">:given-monitoring-function</span>
|
||
|
|
'given-monitoring-function</span>)</span></span>)</span></span>)</span></span>)</span></span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p><code>update-dependent</code> is the key method here. When a superclass with one of these
|
||
|
|
dependencies is updated, this method will be called. When that happens, we know
|
||
|
|
we might need to update the subclasses.</p>
|
||
|
|
|
||
|
|
<p>First we check to make sure the class being updated really <em>is</em> a monitored
|
||
|
|
class (and not something that was forward-referenced but didn't turn out to be
|
||
|
|
monitored).</p>
|
||
|
|
|
||
|
|
<p>Assuming we really are updating a monitored class, we call
|
||
|
|
<code>reinitialize-instance</code> on the dependent class. We set up the initargs to this
|
||
|
|
call as if the user had reran the <em>dependent's</em> <code>defclass</code> form (because we're
|
||
|
|
reinitializing the <em>dependent</em>, after the superclass has changed), to ensure
|
||
|
|
that the recalculation happens properly. An example might make this clearer:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> user <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">…slots…</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:monitoring-function</span> #'log-slot</span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> paid-user <span class="paren2">(<span class="code">user</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">…slots…</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> audited-user <span class="paren2">(<span class="code">user</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code">…slots…</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:monitoring-function</span> #'audit-slot-to-postgres</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>If we now redefine <code>user</code>, both of its dependencies will be reinitialized.</p>
|
||
|
|
|
||
|
|
<p>For <code>paid-user</code> we call <code>(reinitialize-instance paid-user)</code> with no initargs,
|
||
|
|
because there's no <code>(:monitoring-function …)</code> in the <code>defclass</code> form and thus
|
||
|
|
its <code>given-monitoring-function</code> slot is unbound.</p>
|
||
|
|
|
||
|
|
<p>For <code>audited-user</code> we call <code>(reinitialize-instance audited-user
|
||
|
|
:monitoring-function '(#'audit-slot-to-postgres))</code>, because the <code>audited-user</code>
|
||
|
|
class <em>does</em> have a monitoring function that <code>recompute-slots</code> will need.</p>
|
||
|
|
|
||
|
|
<h2 id="s12-the-result"><a href="index.html#s12-the-result">The Result</a></h2>
|
||
|
|
|
||
|
|
<p>With all that in place, our metaclass is ready for interactive use! First we'll
|
||
|
|
review the default logging function and create two more:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> log-slot-access <span class="paren2">(<span class="code">instance slot-name &optional <span class="paren3">(<span class="code">new-value nil new-value?</span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><i><span class="symbol">if</span></i> new-value?
|
||
|
|
<span class="paren3">(<span class="code">format t <span class="string">"Setting slot ~A of ~A to ~S at ~A.~%"</span>
|
||
|
|
slot-name instance new-value <span class="paren4">(<span class="code">get-universal-time</span>)</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">format t <span class="string">"Reading slot ~A of ~A at ~A.~%"</span>
|
||
|
|
slot-name instance <span class="paren4">(<span class="code">get-universal-time</span>)</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> loud-slot-access <span class="paren2">(<span class="code">instance slot-name &optional <span class="paren3">(<span class="code">new-value nil new-value?</span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><i><span class="symbol">if</span></i> new-value?
|
||
|
|
<span class="paren3">(<span class="code">format t <span class="string">"SETTING SLOT ~A OF ~A TO ~S AT ~A.~%"</span>
|
||
|
|
slot-name instance new-value <span class="paren4">(<span class="code">get-universal-time</span>)</span></span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">format t <span class="string">"READING SLOT ~A OF ~A AT ~A.~%"</span>
|
||
|
|
slot-name instance <span class="paren4">(<span class="code">get-universal-time</span>)</span></span>)</span></span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defun</span></i> quiet-slot-access <span class="paren2">(<span class="code">instance slot-name &optional <span class="paren3">(<span class="code">new-value nil new-value?</span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><i><span class="symbol">if</span></i> new-value?
|
||
|
|
<span class="paren3">(<span class="code">format t <span class="string">"~A/~A <- ~S~%"</span> instance slot-name new-value</span>)</span>
|
||
|
|
<span class="paren3">(<span class="code">format t <span class="string">"<- ~A/~A~%"</span> instance slot-name</span>)</span></span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>Now we can create a few classes:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> foo <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">x <span class="keyword">:initarg</span> <span class="keyword">:x</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> bar <span class="paren2">(<span class="code">foo</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:monitoring-function</span> #'quiet-slot-access</span>)</span></span>)</span>
|
||
|
|
|
||
|
|
<span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> baz <span class="paren2">(<span class="code">foo</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<ul>
|
||
|
|
<li><code>foo</code> is the superclass, with the default monitoring function.</li>
|
||
|
|
<li><code>bar</code> subclasses <code>foo</code> but changes the monitoring function.</li>
|
||
|
|
<li><code>baz</code> subclasses foo and inherits its monitoring function.</li>
|
||
|
|
</ul>
|
||
|
|
|
||
|
|
<p>And everything should work properly:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="comment">;; Foo has the default monitoring function ---------------------
|
||
|
|
</span><span class="paren1">(<span class="code"><i><span class="symbol">defparameter</span></i> <span class="special">*foo-object*</span> <span class="paren2">(<span class="code">make-instance 'foo <span class="keyword">:x</span> 1</span>)</span></span>)</span>
|
||
|
|
<span class="comment">; => Setting slot X of #<FOO {101190A513}> to 1 at 3870468582.
|
||
|
|
</span>
|
||
|
|
<span class="paren1">(<span class="code">slot-value <span class="special">*foo-object*</span> 'x</span>)</span>
|
||
|
|
<span class="comment">; => Reading slot X of #<FOO {101190A513}> at 3870468645.
|
||
|
|
</span>
|
||
|
|
<span class="paren1">(<span class="code">setf <span class="paren2">(<span class="code">slot-value <span class="special">*foo-object*</span> 'x</span>)</span> 2</span>)</span>
|
||
|
|
<span class="comment">; => Setting slot X of #<FOO {101190A513}> to 2 at 3870468657.
|
||
|
|
</span>
|
||
|
|
<span class="comment">;; Bar has the quiet one ---------------------------------------
|
||
|
|
</span><span class="paren1">(<span class="code"><i><span class="symbol">defparameter</span></i> <span class="special">*bar-object*</span> <span class="paren2">(<span class="code">make-instance 'bar <span class="keyword">:x</span> 1</span>)</span></span>)</span>
|
||
|
|
<span class="comment">; => #<BAR {101190EE03}>/X <- 1
|
||
|
|
</span>
|
||
|
|
<span class="paren1">(<span class="code">slot-value <span class="special">*bar-object*</span> 'x</span>)</span>
|
||
|
|
<span class="comment">; => <- #<BAR {101190EE03}>/X
|
||
|
|
</span>
|
||
|
|
<span class="paren1">(<span class="code">setf <span class="paren2">(<span class="code">slot-value <span class="special">*bar-object*</span> 'x</span>)</span> 2</span>)</span>
|
||
|
|
<span class="comment">; => #<BAR {101190EE03}>/X <- 2
|
||
|
|
</span>
|
||
|
|
<span class="comment">;; Baz inherits foo's function ---------------------------------
|
||
|
|
</span><span class="paren1">(<span class="code"><i><span class="symbol">defparameter</span></i> <span class="special">*baz-object*</span> <span class="paren2">(<span class="code">make-instance 'baz <span class="keyword">:x</span> 1</span>)</span></span>)</span>
|
||
|
|
<span class="comment">; => Setting slot X of #<BAZ {10119142F3}> to 1 at 3870468733.
|
||
|
|
</span>
|
||
|
|
<span class="paren1">(<span class="code">slot-value <span class="special">*baz-object*</span> 'x</span>)</span>
|
||
|
|
<span class="comment">; => Reading slot X of #<BAZ {10119142F3}> at 3870468755.
|
||
|
|
</span>
|
||
|
|
<span class="paren1">(<span class="code">setf <span class="paren2">(<span class="code">slot-value <span class="special">*baz-object*</span> 'x</span>)</span> 2</span>)</span>
|
||
|
|
<span class="comment">; => Setting slot X of #<BAZ {10119142F3}> to 2 at 3870468756.</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>And now for the <em>real</em> test. We'll redefine <em>only <code>foo</code></em> to change its function:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defclass</span></i> foo <span class="paren2">(<span class="code"></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="paren3">(<span class="code">x <span class="keyword">:initarg</span> <span class="keyword">:x</span></span>)</span></span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:metaclass</span> monitored-class</span>)</span>
|
||
|
|
<span class="paren2">(<span class="code"><span class="keyword">:monitoring-function</span> #'loud-slot-access</span>)</span></span>)</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>Now <code>foo</code> slot access will be yelled at us:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defparameter</span></i> <span class="special">*foo-object*</span> <span class="paren2">(<span class="code">make-instance 'foo <span class="keyword">:x</span> 1</span>)</span></span>)</span>
|
||
|
|
<span class="comment">; => SETTING SLOT X OF #<FOO {1011998B03}> TO 1 AT 3870469055.</span></span></code></pre>
|
||
|
|
|
||
|
|
<p><code>bar</code> hasn't changed, because it has its own explicit function defined:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defparameter</span></i> <span class="special">*bar-object*</span> <span class="paren2">(<span class="code">make-instance 'bar <span class="keyword">:x</span> 1</span>)</span></span>)</span>
|
||
|
|
<span class="comment">; => #<BAR {101199A913}>/X <- 1</span></span></code></pre>
|
||
|
|
|
||
|
|
<p>But, crucially, <code>baz</code> was automatically updated to use the new function it
|
||
|
|
inherits from <code>foo</code>:</p>
|
||
|
|
|
||
|
|
<pre><code><span class="code"><span class="paren1">(<span class="code"><i><span class="symbol">defparameter</span></i> <span class="special">*baz-object*</span> <span class="paren2">(<span class="code">make-instance 'baz <span class="keyword">:x</span> 1</span>)</span></span>)</span>
|
||
|
|
<span class="comment">; => SETTING SLOT X OF #<BAZ {101199C293}> TO 1 AT 3870469072.</span></span></code></pre>
|
||
|
|
|
||
|
|
<h2 id="s13-is-it-worth-it"><a href="index.html#s13-is-it-worth-it">Is It Worth It?</a></h2>
|
||
|
|
|
||
|
|
<p>That was a lot of work. Why did we bother doing it?</p>
|
||
|
|
|
||
|
|
<p>One of the strengths of Common Lisp programming is interactive development.
|
||
|
|
Lispers are used to redefining anything and everything at will and trusting that
|
||
|
|
their environments can keep up. Interactivity is baked into the bones of the
|
||
|
|
language — if we want a metaclass to really feel at home, we need to take the
|
||
|
|
extra steps to make sure it works well in the face of redefinition.</p>
|
||
|
|
|
||
|
|
<p>The designers of Common Lisp and the Metaobject Protocol had a lot of foresight
|
||
|
|
and provided the tools needed to extend the language without destroying its
|
||
|
|
interactivity. Unfortunately this is a hard problem, and the tools are not
|
||
|
|
simple to use. It's almost always <em>possible</em> to do things right, but is often
|
||
|
|
not <em>easy</em>.</p>
|
||
|
|
|
||
|
|
<p>Was it worth doing? For this toy example: probably not. For the project I was
|
||
|
|
working on when I had to figure this all out: I think it was. For your next
|
||
|
|
project: you'll need to decide that for yourself. But I, at least, am thankful
|
||
|
|
that the designers of Common Lisp and CLOS made it <em>possible</em> to do things
|
||
|
|
right, even if it's not always easy.</p>
|
||
|
|
</article></main><hr class='main-separator' /><footer><nav><a href='https://github.com/sjl/'>GitHub</a> ・ <a href='https://twitter.com/stevelosh/'>Twitter</a> ・ <a href='https://instagram.com/thirtytwobirds/'>Instagram</a> ・ <a href='https://hg.stevelosh.com/.plan/'>.plan</a></nav></footer></body></html>
|