--- a/content/blog/2022/04/clos-dependent-maintenance.markdown Wed Apr 20 20:10:31 2022 -0400
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,496 +0,0 @@
-(:title "Using the CLOS Dependent Maintenance Protocol"
- :snip "Handling all the edge cases."
- :date "2022-04-26T16:10:00Z"
- :draft t)
-
-TODO: fix times!!!!!!!!!!!!!!!!!1
-
-Recently I've been working on a Common Lisp library that makes use of the
-[Metaobject Protocol](http://metamodular.com/CLOS-MOP/). I ran into a few edge
-cases 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 Reddit thread][reddit] I posted on the topic
-a while ago.
-
-[reddit]: https://www.reddit.com/r/Common_Lisp/comments/kljyg1/need_advice_on_how_to_handle_metaclass_option/
-
-<div id="toc"></div>
-
-## Setting the Stage
-
-Before we can see the problem, we need a simple example. We'll use the
-`monitored-class` metaclass from [The Art of the Metaobject Protocol][amop]
-(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.
-[amop]: https://en.wikipedia.org/wiki/The_Art_of_the_Metaobject_Protocol
-
-Before we get started, we'll need [Closer to MOP][closer-mop] as an
-implementation compatibility layer:
-
-[closer-mop]: https://github.com/pcostanza/closer-mop
-
-```lisp
-(ql:quickload :closer-mop)
-```
-
-First we define the metaclass:
-
-```lisp
-(defclass monitored-class (standard-class)
- ())
-```
-
-Next we'll explicitly say that it's okay for a monitored class to have
-superclasses that are standard classes:
-
-```lisp
-(defmethod c2mop:validate-superclass
- ((class monitored-class) (superclass standard-class))
- t)
-```
-
-And now we can define the actual monitoring functionality. We'll use `:before`
-methods on `slot-value-using-class` and its `setf` version to log the reads and
-writes of all slots:
-
-```lisp
-(defmethod c2mop:slot-value-using-class :before
- ((class monitored-class) instance slot)
- (format t "Reading slot ~A of ~A at ~A.~%"
- (c2mop:slot-definition-name slot) instance (get-universal-time)))
-
-(defmethod (setf c2mop:slot-value-using-class) :before
- (new-value (class monitored-class) instance slot)
- (format t "Setting slot ~A of ~A to ~S at ~A.~%"
- (c2mop:slot-definition-name slot) instance new-value (get-universal-time)))
-```
-
-With that complete, we can define a new monitored class:
-
-```lisp
-(defclass user ()
- ((id :initarg :id :accessor id)
- (name :initarg :name :accessor name))
- (:metaclass monitored-class))
-```
-
-And now we can see it in action:
-
-```lisp
-(defparameter *u* (make-instance 'user :id 1 :name "sjl"))
-; => Setting slot ID of #<USER {10074DFD33}> to 1 at 3828527923.
-; => Setting slot NAME of #<USER {10074DFD33}> to "sjl" at 3828527923.
-; => *U*
-
-(id *u*)
-; => Reading slot ID of #<USER {10074DFD33}> at 3828527937.
-; => 1
-
-(setf (name *u*) "Steve")
-; => Setting slot NAME of #<USER {10074DFD33}> to "Steve" at 3828527946.
-; => "Steve"
-```
-
-## Adding More Flexibility
-
-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 `:monitoring-function` as a class option that will
-receive the data and can do whatever it wants, for example:
-
-* Logging to syslog instead of standard out.
-* Inserting a row into a Postgres database as an audit log.
-* Tracking read/write counts in a hash table to find slots that are written more
- often than they're read and vice versa.
-
-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:
-
-```lisp
-(defun log-slot-access (instance slot-name &optional (new-value nil new-value?))
- (if new-value?
- (format t "Setting slot ~A of ~A to ~S at ~A.~%"
- slot-name instance new-value (get-universal-time))
- (format t "Reading slot ~A of ~A at ~A.~%"
- slot-name instance (get-universal-time))))
-```
-
-Note the use of the extended `&optional` form with the
-[`supplied-p-parameter`][supplied] used to check whether a value was given,
-which ensures this works correctly even when setting a slot to `nil`.
-
-[supplied]: http://www.lispworks.com/documentation/HyperSpec/Body/03_dab.htm
-
-Also note how we called it `new-value?` and not `new-value-p` as you'll
-sometimes see people do. The `-p` in `new-value-p` stands for "predicate", and
-a [predicate][predicate] is a *function* that returns a (generalized) boolean,
-*not* a boolean itself. Using a name that ends in `-p` for a boolean value
-(rather than for a predicate) is a pet peeve of mine. Unfortunately it happens
-in a couple of places (even in Common Lisp itself), so it's something to watch
-out for.
-
-[predicate]: http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#predicate
-
-Now we can update our `monitored-class` to add a slot to store the monitoring
-function for each class, and update the `slot-value-using-class` methods to use
-that instead of writing the string themselves:
-
-```lisp
-(defclass monitored-class (standard-class)
- ((monitoring-function :initarg :monitoring-function
- :accessor monitoring-function)))
-
-(defmethod c2mop:slot-value-using-class :before
- ((class monitored-class) instance slot)
- (funcall (monitoring-function class)
- instance
- (c2mop:slot-definition-name slot)))
-
-(defmethod (setf c2mop:slot-value-using-class) :before
- (new-value (class monitored-class) instance slot)
- (funcall (monitoring-function class)
- instance
- (c2mop:slot-definition-name slot)
- new-value))
-```
-
-
-When a user creates a new `monitored-class`, we need to set the
-`monitoring-function` slot appropriately. We might initially consider doing
-this by having an `initform` for the `monitoring-function` slot in the
-metaclass, like this:
-
-```lisp
-(defclass monitored-class (standard-class)
- ((monitoring-function :initarg :monitoring-function
- :accessor monitoring-function
- :initform #'log-slot-access))) ; default function
-```
-
-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 `shared-initialize`
-so it will happen both when a class is first created and when it's reinitialized
-(e.g. after it's redefined):
-
-```lisp
-(defun parse-monitoring-function-class-option (arguments)
- (case (length arguments)
- (1 (eval (first arguments)))
- (0 #'log-slot-access)
- (t (error "Malformed class option ~S."
- (list* :monitoring-function arguments)))))
-
-(defmethod shared-initialize :around
- ((class monitored-class) slot-names
- &rest initargs
- &key monitoring-function &allow-other-keys)
- (apply #'call-next-method class slot-names
- :monitoring-function (parse-monitoring-function-class-option
- monitoring-function)
- initargs))
-```
-
-If the user provided a `(:monitoring-function …)` class option we evaluate and
-use it, otherwise we default to our simple logging function.
-
-There are a couple of things to note here.
-
-First, when `defclass` gets a class option like `(:monitoring-function foo)`,
-what it *actually* passes to the `(re)initialize-instance` methods is the list
-`(foo)`. This allows for class options with more than one argument. In our
-case we only ever want a single argument, so we ensure the `length` of the
-argument is `0` or `1` and handle the cases individually.
-
-Second, `defclass` does not evaluate the class option's arguments. If we say
-`(:monitoring-function (lambda (i s &optional v) (print (list i s v))))` what we
-get as the initarg will be `((lambda (i s &optional v) (print (list i s v))))`.
-That's a list of a list of three elements, *not* 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 `defclass` in their lexical environment — we have to fall back to `eval`
-and the null lexical environment. That means that something like this will not
-work:
-
-```lisp
-(flet ((monitor (instance slot-name &optional new-value)
- …))
- (defclass foo ()
- (…slots…)
- (:monitoring-function #'monitor)))
-```
-
-I haven't managed to find a way to make this work with `defclass`. If anyone
-knows of a solution, please let me know.
-
-Third, you might notice that we're `apply`ing with the full `initargs` list,
-which includes the original (unparsed) `monitoring-function`. But that keyword
-argument will be shadowed by the `:monitoring-function` we add at the beginning,
-so there's no need to bother removing it from `initargs` 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.
-
-Now we can now talk about all the reasons why `:initform #'log-slot-access`
-doesn't just magically solve all our problems.
-
-First, the `:initform` *would* work properly when you first define a class, but
-we still need all the code in `shared-initialize` to do the `eval`ing of the
-forms the user provides when they *don't* use it.
-
-Further, suppose a user runs:
-
-```lisp
-(defclass foo ()
- ((some-slot :initarg :some-slot :accessor some-slot))
- (:metaclass monitored-class)
- (:monitoring-function monitor-foo))
-```
-
-Then later they *remove* the `:monitoring-function` from the `defclass` and
-reevaluate it:
-
-```lisp
-(defclass foo ()
- ((some-slot :initarg :some-slot :accessor some-slot))
- (:metaclass monitored-class))
-```
-
-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 `:initform`, the
-class would already have a value for the `monitoring-function` slot (the old
-function) and since there's no *new* value being specified, the `:initform`
-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 `(setf (find-class 'foo) nil)` and
-reevaluating the `defclass`, or fixing the slot value up manually, or some other
-ugly alternative.
-
-With all that out of the way, we can now use a custom `monitoring-function` to
-do whatever we want:
-
-```lisp
-(defparameter *user-slot-reads* (make-hash-table))
-(defparameter *user-slot-writes* (make-hash-table))
-
-(defun track-user-slot-access
- (instance slot-name &optional (new-value nil new-value?))
- (declare (ignore instance new-value))
- (incf (gethash slot-name
- (if new-value? *user-slot-writes* *user-slot-reads*)
- 0)))
-
-(defclass user ()
- ((id :initarg :id :accessor id)
- (name :initarg :name :accessor name))
- (:metaclass monitored-class)
- (:monitoring-function #'track-user-slot-access))
-
-;; Two writes
-(defparameter *u* (make-instance 'user :id 1 :name "sjl"))
-
-;; A read
-(id *u*)
-
-;; Two more writes
-(setf (name *u*) "steve")
-(setf (name *u*) "sjl")
-
-;; Results
-(alexandria:hash-table-alist *user-slot-reads*)
-; => ((ID . 1))
-
-(alexandria:hash-table-alist *user-slot-writes*)
-; => ((NAME . 3) (ID . 1))
-```
-
-## Toy Example Disclaimer™
-
-The `monitored-class` 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.
-
-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 `monitored-class` variant as an exercise:
-
-```lisp
-(defclass user ()
- ((id …)
- ;; Never monitor this slot:
- (session-id … :monitored nil)
- ;; We only care when this slot *changes*:
- (role … :monitored/reads nil)
- ;; Names are PII, redact their values before logging:
- (name … :monitored/redact-value t)
- ;; Redact the user portion of the email address, logging only the domain:
- (email … :monitored/redact-value #'scrub-email))
- (:metaclass monitored-class)
- (:monitoring-function #'log-to-syslog)
- ;; Allow us to turn monitoring on/off globally:
- (:monitor-when #'monitoring-enabled-p))
-```
-
-## The Problem
-
-```lisp
-(defclass paid-user (user)
- ((plan :initarg :plan
- :accessor plan
- :type (member :bronze :silver :gold)))
- (:metaclass monitored-class))
-
-(make-instance 'paid-user :id 2 :name "moneybags" :plan :gold)
-; =>
-; ??????????
-```
-
-
-```lisp
-(defclass user ()
- (…slots…)
- (:metaclass monitored-class)
- (:monitoring-function yell))
-
-; inherits YELL as the monitoring-function from the superclass
-(defclass paid-user (user)
- (…slots…)
- (:metaclass monitored-class))
-
-; actually let's log user slot accesses to Postgres for more safety
-(defclass user ()
- (…slots…)
- (:metaclass monitored-class)
- (:monitoring-function log-to-postgres))
-```
-
-## The Dependent Maintenance Protocol
-
-<http://metamodular.com/CLOS-MOP/dependent-maintenance-protocol.html>
-
-
-```lisp
-(ql:quickload :closer-mop)
-
-(defclass dep ()
- ((val :accessor val :initarg :val)))
-
-(defclass mc (standard-class)
- ((x :accessor x)
- ;; We need to not only store the value, but also store what the user
- ;; originally gave, so we can recompute later if one of our superclasses
- ;; changes.
- ;;
- ;; This slot will be unbound if the user didn't give an (:x foo) option, or
- ;; bound to (foo) if they did.
- (given-x :initarg :x :accessor given-x)))
-
-(defun mcp (object)
- (typep object 'mc))
-
-(defmethod c2mop:validate-superclass ((a mc) (b standard-class)) t)
-
-(defun dep= (d class)
- (and (typep d 'dep) ; need to filter out any other deps other code might have added
- (eql (val d) class)))
-
-(defun ensure-dep (superclass class)
- (c2mop:map-dependents superclass
- (lambda (d)
- (when (dep= d class)
- (return-from ensure-dep))))
- (c2mop:add-dependent superclass (make-instance 'dep :val class)))
-
-(defun ensure-no-dep (superclass class)
- (c2mop:map-dependents superclass
- (lambda (d)
- (when (dep= d class)
- (c2mop:remove-dependent superclass d)
- (return-from ensure-no-dep)))))
-
-(defun recompute (&key class superclasses slot given-slot value value? default)
- (format *debug-io* "~%Recomputing ~A of ~A." slot class)
- (setf superclasses (remove-if-not #'mcp superclasses))
- ;; We need to store whether the user gave an explicit value for later.
- (if value?
- (setf (slot-value class given-slot) value)
- (slot-makunbound class given-slot))
- ;; Set the actual value to the given value, or the superclass value, or the default.
- ;;
- ;; I THINK we only need to look at direct superclasses, not the entire class
- ;; precedence list, because while it's possible for an MC to inherit from
- ;; a standard-class, the reverse is not possible. So the only way for an MC
- ;; to get into the precedence list is to be there directly or come through
- ;; another MC that IS direct (and which would come first in the full list
- ;; anyway).
- (setf (slot-value class slot)
- (cond
- (value? (first value))
- (superclasses (slot-value (first superclasses) slot))
- (t default))))
-
-
-(defmethod initialize-instance :around ((class mc) &key
- (x nil x?)
- direct-superclasses &allow-other-keys)
- (recompute :class class
- :superclasses direct-superclasses
- :slot 'x
- :given-slot 'given-x
- :value x
- :value? x?
- :default :some-default)
- (call-next-method)
- ;; You might think we could get away with only having dependencies on
- ;; superclasses that happen to be our specific metaclass, instead of on ALL
- ;; direct superclasses. Sadly this fails for forward-referenced classes, so
- ;; we need to add dependencies on all of them and filter out the non-MC
- ;; classes later.
- (dolist (superclass (c2mop:class-direct-superclasses class))
- (ensure-dep superclass class)))
-
-(defmethod reinitialize-instance :around ((class mc) &key
- (x nil x?)
- (direct-superclasses nil direct-superclasses?)
- &allow-other-keys)
- ;; We have to recompute X /before/ we call-next-method because the
- ;; update-dependent calls happen as part of that next method. If we wait
- ;; until after call-next-method to patch up X, then the dependent will still
- ;; see the old version when it's updated and won't get the new value until
- ;; a second round of initialization.
- (recompute :class class
- :superclasses (if direct-superclasses?
- direct-superclasses
- (c2mop:class-direct-superclasses class))
- :slot 'x
- :given-slot 'given-x
- :value x
- :value? x?
- :default :some-default)
- (let ((before (c2mop:class-direct-superclasses class)))
- (call-next-method)
- (let* ((after (c2mop:class-direct-superclasses class))
- (removed (set-difference before after))
- (added (set-difference after before)))
- (dolist (superclass removed)
- (ensure-no-dep superclass class))
- (dolist (superclass added)
- (ensure-dep superclass class)))))
-
-(defmethod c2mop:update-dependent (obj (dep dep) &rest initargs)
- (declare (ignore initargs))
- (when (typep obj 'mc) ; We can ignore changes in non-MC superclasses here.
- (let ((class (val dep)))
- (format *debug-io* "~%Updating ~A because ~A changed." class obj)
- ;; Need to call reinitialize-instance here (instead of just recomputing the
- ;; slots) because otherwise transitive dependencies won't get updated
- ;; properly.
- (apply #'reinitialize-instance class
- (if (slot-boundp class 'given-x)
- (list :x (slot-value class 'given-x))
- '())))))
-```
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/content/blog/2022/08/depending-in-common-lisp.markdown Thu Aug 25 23:05:04 2022 -0400
@@ -0,0 +1,1024 @@
+(:title "Depending in Common Lisp"
+ :snip "Using the CLOS Dependent Maintenance Protocol"
+ :date "2022-08-26T15:10:00Z"
+ :draft nil)
+
+A while ago I was working on a Common Lisp library that makes use of the
+[Metaobject Protocol](http://metamodular.com/CLOS-MOP/). 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 Reddit
+thread][reddit] I posted.
+
+[reddit]: https://www.reddit.com/r/Common_Lisp/comments/kljyg1/need_advice_on_how_to_handle_metaclass_option/
+
+<div id="toc"></div>
+
+## Setting the Stage
+
+Before we can see the problem, we need a simple example. We'll use the
+`monitored-class` metaclass from [The Art of the Metaobject Protocol][amop]
+(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.
+
+[amop]: https://en.wikipedia.org/wiki/The_Art_of_the_Metaobject_Protocol
+
+Before we get started we'll need [Closer to MOP][closer-mop] as an
+implementation compatibility layer:
+
+[closer-mop]: https://github.com/pcostanza/closer-mop
+
+```lisp
+(ql:quickload :closer-mop)
+```
+
+First we define the metaclass:
+
+```lisp
+(defclass monitored-class (standard-class)
+ ())
+```
+
+Next we'll explicitly say that it's okay for a monitored class to have
+superclasses that are standard classes:
+
+```lisp
+(defmethod c2mop:validate-superclass
+ ((class monitored-class) (superclass standard-class))
+ t)
+```
+
+And now we can define the actual monitoring functionality. We'll use `:before`
+methods on `slot-value-using-class` and its `setf` version to log the reads and
+writes of all slots:
+
+```lisp
+(defmethod c2mop:slot-value-using-class :before
+ ((class monitored-class) instance slot)
+ (format t "Reading slot ~A of ~A at ~A.~%"
+ (c2mop:slot-definition-name slot) instance (get-universal-time)))
+
+(defmethod (setf c2mop:slot-value-using-class) :before
+ (new-value (class monitored-class) instance slot)
+ (format t "Setting slot ~A of ~A to ~S at ~A.~%"
+ (c2mop:slot-definition-name slot) instance new-value (get-universal-time)))
+```
+
+With that complete, we can define a new monitored class:
+
+```lisp
+(defclass user ()
+ ((id :initarg :id)
+ (name :initarg :name))
+ (:metaclass monitored-class))
+```
+
+And now we can see it in action:
+
+```lisp
+(defparameter *u* (make-instance 'user :id 1 :name "sjl"))
+; => Setting slot ID of #<USER {10074DFD33}> to 1 at 3828527923.
+; => Setting slot NAME of #<USER {10074DFD33}> to "sjl" at 3828527923.
+; => *U*
+
+(slot-value *u* 'id)
+; => Reading slot ID of #<USER {10074DFD33}> at 3828527937.
+; => 1
+
+(setf (slot-value *u* 'name) "Steve")
+; => Setting slot NAME of #<USER {10074DFD33}> to "Steve" at 3828527946.
+; => "Steve"
+```
+
+### Adding More Flexibility
+
+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 `:monitoring-function` as a class option that will
+receive the data and can do whatever it wants. For example:
+
+* Logging to syslog instead of standard out.
+* Inserting a row into a Postgres database as an audit log.
+* Tracking read/write counts in a hash table to find slots that are written more
+ often than they're read and vice versa.
+
+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:
+
+```lisp
+(defun log-slot-access (instance slot-name &optional (new-value nil new-value?))
+ (if new-value?
+ (format t "Setting slot ~A of ~A to ~S at ~A.~%"
+ slot-name instance new-value (get-universal-time))
+ (format t "Reading slot ~A of ~A at ~A.~%"
+ slot-name instance (get-universal-time))))
+```
+
+Note the use of the extended `&optional` form with the
+[`supplied-p-parameter`][supplied] used to check whether a value was given,
+which ensures this works correctly even when setting a slot to `nil`.
+
+[supplied]: http://www.lispworks.com/documentation/HyperSpec/Body/03_dab.htm
+
+Also note how we called it `new-value?` and not `new-value-p` as you'll
+sometimes see people do. The `-p` in `new-value-p` stands for "predicate", and
+a [predicate][predicate] is a *function* that returns a (generalized) boolean,
+*not* a boolean itself. Using a name that ends in `-p` for a boolean value
+(rather than for a predicate) is a `-p`et `-p`eeve of mine. Unfortunately it
+happens in a couple of places (even in Common Lisp itself), so it's something to
+watch out for.
+
+[predicate]: http://www.lispworks.com/documentation/HyperSpec/Body/26_glo_p.htm#predicate
+
+Now we can update our `monitored-class` to add a slot to store the monitoring
+function for each class, and update the `slot-value-using-class` methods to use
+that instead of writing the string themselves:
+
+```lisp
+(defclass monitored-class (standard-class)
+ ((monitoring-function :initarg :monitoring-function
+ :accessor monitoring-function)))
+
+(defmethod c2mop:slot-value-using-class :before
+ ((class monitored-class) instance slot)
+ (funcall (monitoring-function class)
+ instance
+ (c2mop:slot-definition-name slot)))
+
+(defmethod (setf c2mop:slot-value-using-class) :before
+ (new-value (class monitored-class) instance slot)
+ (funcall (monitoring-function class)
+ instance
+ (c2mop:slot-definition-name slot)
+ new-value))
+```
+
+
+When a user creates a new `monitored-class`, we need to set the
+`monitoring-function` slot appropriately. We might initially consider doing
+this by having an `initform` for the `monitoring-function` slot in the
+metaclass, like this:
+
+```lisp
+(defclass monitored-class (standard-class)
+ ((monitoring-function :initarg :monitoring-function
+ :accessor monitoring-function
+ :initform #'log-slot-access))) ; default function
+```
+
+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 `shared-initialize`
+so it will happen both when a class is first created and when it's reinitialized
+(e.g. after it's redefined):
+
+```lisp
+(defun parse-monitoring-function-class-option (arguments)
+ (case (length arguments)
+ (1 (eval (first arguments)))
+ (0 #'log-slot-access)
+ (t (error "Malformed monitoring-function option."))))
+
+(defmethod shared-initialize :around
+ ((class monitored-class) slot-names
+ &rest initargs
+ &key monitoring-function &allow-other-keys)
+ (apply #'call-next-method class slot-names
+ :monitoring-function (parse-monitoring-function-class-option
+ monitoring-function)
+ initargs))
+```
+
+If the user provided a `(:monitoring-function …)` class option we evaluate and
+use it, otherwise we default to our simple logging function.
+
+There are a couple of things to note here.
+
+First, when `defclass` gets a class option like `(:monitoring-function foo)`,
+what it *actually* passes to the `(re)initialize-instance` methods is the list
+`(foo)`. This allows for class options with more than one argument. In our
+case we only ever want a single argument, so we ensure the `length` of the
+argument is `0` or `1` and handle the cases individually.
+
+Second, `defclass` does not evaluate the class option's arguments. If we say
+`(:monitoring-function (lambda (i s &optional v) (print (list i s v))))` what we
+get as the initarg will be `((lambda (i s &optional v) (print (list i s v))))`.
+That's a list of a list of three elements, *not* 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 `defclass` in their lexical environment — we have to fall back to `eval`
+and the null lexical environment. That means that something like this will not
+work:
+
+```lisp
+(flet ((monitor (instance slot-name &optional new-value)
+ …))
+ (defclass foo ()
+ (…slots…)
+ (:monitoring-function #'monitor)))
+```
+
+I haven't managed to find a way to make this work with `defclass`. If anyone
+knows of a solution, please let me know.
+
+Third, you might notice that we're `apply`ing with the full `initargs` list,
+which includes the original (unparsed) `monitoring-function`. But that keyword
+argument will be shadowed by the `:monitoring-function` we add at the beginning,
+so there's no need to bother removing it from `initargs` 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.
+
+Now we can talk about all the reasons why `:initform #'log-slot-access` doesn't
+magically solve all our problems.
+
+First, the `:initform` *would* work properly when you first define a class, but
+we still need all the code in `shared-initialize` to do the `eval`ing of the
+forms the user provides when they *don't* use it.
+
+Further, suppose a user runs:
+
+```lisp
+(defclass foo ()
+ ((some-slot :initarg :some-slot))
+ (:metaclass monitored-class)
+ (:monitoring-function monitor-foo))
+```
+
+Then later they *remove* the `:monitoring-function` from the `defclass` and
+reevaluate it:
+
+```lisp
+(defclass foo ()
+ ((some-slot :initarg :some-slot))
+ (:metaclass monitored-class))
+```
+
+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 `:initform`, the
+class would already have a value for the `monitoring-function` slot (the old
+function) and since there's no *new* value being specified, the `:initform`
+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 `(setf (find-class 'foo) nil)` and
+reevaluating the `defclass`, or fixing the slot value up manually, or some other
+ugly alternative.
+
+With all that out of the way, we can now use a custom `monitoring-function` to
+do whatever we want:
+
+```lisp
+(defparameter *user-slot-reads* (make-hash-table))
+(defparameter *user-slot-writes* (make-hash-table))
+
+(defun track-user-slot-access
+ (instance slot-name &optional (new-value nil new-value?))
+ (declare (ignore instance new-value))
+ (incf (gethash slot-name
+ (if new-value? *user-slot-writes* *user-slot-reads*)
+ 0)))
+
+(defclass user ()
+ ((id :initarg :id)
+ (name :initarg :name))
+ (:metaclass monitored-class)
+ (:monitoring-function #'track-user-slot-access))
+
+;; Two writes
+(defparameter *u* (make-instance 'user :id 1 :name "sjl"))
+
+;; A read
+(slot-value *u* 'id)
+
+;; Two more writes
+(setf (slot-value *u* 'name) "steve")
+(setf (slot-value *u* 'name) "sjl")
+
+;; Results
+(alexandria:hash-table-alist *user-slot-reads*)
+; => ((ID . 1))
+
+(alexandria:hash-table-alist *user-slot-writes*)
+; => ((NAME . 3) (ID . 1))
+```
+
+### Toy Example Disclaimer
+
+The `monitored-class` 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.
+
+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 `monitored-class` variant as an exercise:
+
+```lisp
+(defclass user ()
+ ((id …)
+ ;; Never monitor this slot:
+ (session-id … :monitored nil)
+ ;; We only care when this slot *changes*:
+ (role … :monitored/reads nil)
+ ;; Names are PII, redact their values before logging:
+ (name … :monitored/redact-value t)
+ ;; Redact the user portion of the email address, logging only the domain:
+ (email … :monitored/redact-value #'scrub-email))
+ (:metaclass monitored-class)
+ (:monitoring-function #'log-to-syslog)
+ ;; Allow us to turn monitoring on/off globally:
+ (:monitor-when #'monitoring-enabled-p))
+```
+
+## The Problem
+
+Let's return to a toy example that will help demonstrate the problem I ran into.
+Suppose we have a `user` class and want to monitor that class to log a warning
+if someone ever changes the `id` of an instance:
+
+```lisp
+(defun monitor-user (instance slot &optional (new-value nil new-value?))
+ (when (and (eql slot 'id) new-value?)
+ (when (slot-boundp instance 'id) ; ignore initial setting of the value
+ (format t "WARNING: User ~A is getting a new ID ~A, this is concerning."
+ (slot-value instance 'id)
+ new-value))))
+
+(defclass user ()
+ ((id :initarg :id)
+ (name :initarg :name))
+ (:metaclass monitored-class)
+ (:monitoring-function #'monitor-user))
+```
+
+This works as expected:
+
+```lisp
+(defparameter *u* (make-instance 'user :id 1 :name "sjl"))
+
+(slot-value *u* 'id)
+; => 1
+
+(setf (slot-value *u* 'id) 999)
+; WARNING: User 1 is getting a new ID 999, this is concerning.
+; => 999
+
+(slot-value *u* 'id)
+; => 999
+```
+
+So far, so good. But what happens if we add a subclass of user?
+
+```lisp
+(defclass paid-user (user)
+ ((plan :initarg :plan :type (member :bronze :silver :gold)))
+ (:metaclass monitored-class))
+
+(defparameter *p*
+ (make-instance 'paid-user :id 2 :name "moneybags" :plan :gold))
+; => Setting slot ID of #<PAID-USER {100DE55F43}> to 2 at 3870460545.
+; => Setting slot NAME of #<PAID-USER {100DE55F43}> to "moneybags" at 3870460545.
+; => Setting slot PLAN of #<PAID-USER {100DE55F43}> to :GOLD at 3870460545.
+```
+
+We can already see the problem: we didn't explicitly specify
+`(:monitoring-function #'monitor-user)` in the `defclass` 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.
+
+When I saw this, my first instinct was to update
+`parse-monitoring-function-class-option` 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:
+
+```lisp
+(defun monitored-class-p (class)
+ (typep class 'monitored-class))
+
+(defun first-monitored-superclass (class)
+ (let ((superclasses (rest (c2mop:class-precedence-list class))))
+ (first (remove-if-not #'monitored-class-p superclasses))))
+
+(defun parse-monitoring-function-class-option (class arguments)
+ (case (length arguments)
+ (1 (eval (first arguments)))
+ (0 (let ((super (first-monitored-superclass class)))
+ ;; Inherit the monitoring function from its most specific monitored
+ ;; superclass, or use the default if there isn't one.
+ (if super
+ (monitoring-function super)
+ #'log-slot-access)))
+ (t (error "Malformed monitoring-function option."))))
+
+(defmethod shared-initialize :around
+ ((class monitored-class) slot-names
+ &rest initargs
+ &key monitoring-function &allow-other-keys)
+ (apply #'call-next-method class slot-names
+ :monitoring-function (parse-monitoring-function-class-option
+ class monitoring-function)
+ initargs))
+```
+
+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 `shared-initialize`
+like this.
+
+Second, I misled you earlier. There's a line [deep in the bowels of the
+Metaobject protocol][no-shared-init] that says:
+
+> Portable programs must not define methods on `shared-initialize`.
+
+So we can't use `shared-initialize` as a shortcut *at all*, and will need to
+define separate methods for `initialize-instance` and `reinitialize-instance`
+after all.
+
+[no-shared-init]: http://metamodular.com/CLOS-MOP/initialization-of-class-metaobjects2.html
+
+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:
+
+```lisp
+;; Create user class, monitor with default function.
+(defclass user ()
+ ((id :initarg :id)
+ (name :initarg :name))
+ (:metaclass monitored-class))
+
+;; Create paid user class, inherits monitoring function from user.
+(defclass paid-user (user)
+ ((plan :initarg :plan :type (member :bronze :silver :gold)))
+ (:metaclass monitored-class))
+
+;; Redefine user class, because actually we want to log
+;; monitored slots to Postgres.
+(defclass user ()
+ ((id :initarg :id)
+ (name :initarg :name))
+ (:metaclass monitored-class)
+ (:monitoring-function #'log-slots-to-postgres)) ; NEW
+```
+
+Clearly what should happen here is that the `paid-user` class should now inherit
+the *new* monitoring function. But the strategy of trying to set the monitoring
+function *once* when a class is initialized or reinitialized falls apart when
+you want to support redefinition of superclasses and have their subclasses
+inherit changes.
+
+At this point, things are not looking good. We need a new plan.
+
+## The Dependent Maintenance Protocol
+
+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 [CLOS Dependent Maintenance Protocol][].
+From that page:
+
+[CLOS Dependent Maintenance Protocol]: http://metamodular.com/CLOS-MOP/dependent-maintenance-protocol.html
+
+> 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.
+
+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.
+
+The full details are laid out in the protocol documentation, but let's step
+through an example here to see it in action.
+
+### Dependency Wrappers
+
+The protocol states:
+
+> 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.
+
+With this in mind, we'll need to make a small wrapper we can use to store
+dependents:
+
+```lisp
+(defclass dependency ()
+ ((dependent :accessor dependent :initarg :dep)))
+```
+
+And then we'll make some utility functions to add and remove dependencies
+to/from classes, which we'll use shortly:
+
+```lisp
+(defun dependency= (d class)
+ "Return whether `d` is a dependency on `class`."
+ ;; We need to filter out any other dependents other code might have added.
+ (and (typep d 'dependency)
+ (eql (dependent d) class)))
+
+(defun ensure-dependency (superclass class)
+ "Ensure that `class` is a dependent of `superclass`."
+ (c2mop:map-dependents superclass
+ (lambda (d)
+ (when (dependency= d class)
+ (return-from ensure-dependency))))
+ (c2mop:add-dependent superclass (make-instance 'dependency :dep class)))
+
+(defun ensure-no-dependency (superclass class)
+ "Ensure that `class` is NOT a dependent of `superclass`."
+ (c2mop:map-dependents superclass
+ (lambda (d)
+ (when (dependency= d class)
+ (c2mop:remove-dependent superclass d)
+ (return-from ensure-no-dependency)))))
+```
+
+When we define a subclass on a monitored class, e.g. when we ran `(defclass
+paid-user (user) …)` before, we'll need to `(ensure-dependency user paid-user)`
+to tell CLOS that `paid-user` is dependent on `user`, and needs to be updated if
+`user` is changed. We also want to make sure to only add the dependency if it
+doesn't already exist, to avoid useless work.
+
+But things can get a little trickier than this, because if `paid-user` is then
+redefined to *not* be a subclass of `user` any more (unlikely, but possible) we
+want to *remove* that dependency. So we'll need both utility functions for
+managing the dependencies.
+
+### Defining the Metaclass
+
+We'll need to update our metaclass to not only store the monitoring function,
+but also store what the user *specified* 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 `slot-value-using-class`
+methods from before, and define a helper type predicate while we're here:
+
+```lisp
+(defclass monitored-class (standard-class)
+ ((given-monitoring-function
+ :initarg :given-monitoring-function
+ :accessor given-monitoring-function)
+ (computed-monitoring-function
+ :initarg :computed-monitoring-function
+ :accessor computed-monitoring-function)))
+
+(defmethod c2mop:validate-superclass
+ ((class monitored-class) (superclass standard-class))
+ t)
+
+(defmethod c2mop:slot-value-using-class :before
+ ((class monitored-class) instance slot)
+ (funcall (computed-monitoring-function class)
+ instance
+ (c2mop:slot-definition-name slot)))
+
+(defmethod (setf c2mop:slot-value-using-class) :before
+ (new-value (class monitored-class) instance slot)
+ (funcall (computed-monitoring-function class)
+ instance
+ (c2mop:slot-definition-name slot)
+ new-value))
+
+(defun monitored-class-p (object)
+ (typep object 'monitored-class))
+```
+
+### Computing Slots
+
+We're going to need a function for computing the value of the slot. It will
+serve the same role `parse-monitoring-function-class-option` was serving before.
+
+If we only have one class option like `:monitoring-function` we could hardcode
+it into a function like this:
+
+```lisp
+(defun recompute-monitoring-function (&key class superclasses value value?)
+ "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.
+
+ "
+ ;; Only consider monitored superclasses.
+ (setf superclasses (remove-if-not #'monitored-class-p superclasses))
+ ;; We need to store whether the user gave an explicit value for later.
+ (if value?
+ (setf (slot-value class 'given-monitoring-function) value)
+ (slot-makunbound class 'given-monitoring-function))
+ ;; Set the computed value.
+ (setf (slot-value class 'computed-monitoring-function)
+ (cond
+ ;; If the user gave a value, use it (after checking it's well-formed).
+ (value? (progn (assert (= 1 (length value)))
+ (eval (first value))))
+ ;; Otherwise, if there are any monitored superclasses, use the most
+ ;; specific one's monitoring function.
+ (superclasses (slot-value (first superclasses)
+ 'computed-monitoring-function))
+ ;; Otherwise use the default.
+ (t #'log-slot-access))))
+```
+
+First we clean up the superclass list to only consider relevant superclasses.
+
+Then we store the value the user gave, if any, in the
+`given-monitoring-function` slot of the class. If they *didn't* specify a value
+(e.g. if they *removed* it and reevaluated the `defclass`), we make sure to
+account for that by `slot-makunbound`ing the slot to clear out any possible old
+value.
+
+Then we compute what the real value should be. If they gave us a value, we
+`eval` it as we talked about earlier and use that. Otherwise we use whatever we
+computed for a superclass, if available, otherwise the default.
+
+This is all we need if we've only got one option to deal with, as in our toy
+example. In my *actual* 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:
+
+```lisp
+(defun recompute-slot
+ (&key class superclasses computed-slot given-slot value value? default)
+ "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.
+
+ "
+ ;; Only consider monitored superclasses.
+ (setf superclasses (remove-if-not #'monitored-class-p superclasses))
+ ;; We need to store whether the user gave an explicit value for later.
+ (if value?
+ (setf (slot-value class given-slot) value)
+ (slot-makunbound class given-slot))
+ ;; Set the actual value to the given value, or the superclass value,
+ ;; or the default.
+ (setf (slot-value class computed-slot)
+ (cond
+ (value? (progn (assert (= 1 (length value)))
+ (eval (first value))))
+ (superclasses (slot-value (first superclasses) computed-slot))
+ (t default))))
+
+(defun recompute-slots (class &key
+ direct-superclasses
+ (monitoring-function nil monitoring-function?)
+ &allow-other-keys)
+ (recompute-slot :class class
+ :superclasses direct-superclasses
+ :computed-slot 'computed-monitoring-function
+ :given-slot 'given-monitoring-function
+ :value monitoring-function
+ :value? monitoring-function?
+ :default #'log-slot-access))
+```
+
+Supporting more options is just a matter of adding more calls inside of
+`recompute-slots`. It's not the most exciting code I've ever written, but it
+works.
+
+### Initialization
+
+Now we can finally define the `initialize-instance` and `reinitialize-instance`
+methods on our class. We'll start with `initialize-instance` (and a helper
+function):
+
+```lisp
+(defun strip-initargs (initargs)
+ "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.
+
+ "
+ (loop :for (initarg value) :on initargs :by #'cddr
+ :unless (member initarg '(:monitoring-function))
+ :append (list initarg value)))
+
+(defmethod initialize-instance :around
+ ((class monitored-class) &rest initargs &key &allow-other-keys)
+ (apply #'recompute-slots class initargs)
+ (apply #'call-next-method class (strip-initargs initargs))
+ (dolist (superclass (c2mop:class-direct-superclasses class))
+ (ensure-dependency superclass class)))
+```
+
+We recompute our special slots, then delegate to `call-next-method` to handle
+everything else, after stripping out our initargs because we've already handled
+them.
+
+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.
+
+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:
+
+```lisp
+(defclass some-other-mixin () ())
+
+(defclass user ()
+ (…slots…)
+ (:metaclass monitored-class))
+
+(defclass paid-user (user some-other-mixin)
+ (…slots…)
+ (:metaclass monitored-class))
+```
+
+Then `paid-user` will be a dependent of both `user` *and* `some-other-mixin`.
+This seems unnecessary, because changes in non-monitored superclasses won't have
+any effect on our monitoring function computation.
+
+Unfortunately, things are not so simple. If we only add dependencies on
+monitored superclasses, this will fall apart in the face of [forward-referenced
+superclasses][]. 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:
+
+[forward-referenced superclasses]: http://metamodular.com/CLOS-MOP/class-finalization-protocol.html
+
+```lisp
+;; Define a subclass.
+(defclass bar (foo)
+ ((b :accessor b :initarg :b)))
+
+;; Trying to make an instance now will signal an error.
+(make-instance 'bar :a 1 :b 2)
+; => While computing the class precedence list of the class named COMMON-LISP-USER::BAR.
+; => The class named COMMON-LISP-USER::FOO is a forward referenced class.
+; => The class named COMMON-LISP-USER::FOO is a direct superclass of the class named COMMON-LISP-USER::BAR.
+
+;; Go ahead and define the superclass.
+(defclass foo ()
+ ((a :accessor a :initarg :a)))
+
+;; Now we can make an instance of the subclass.
+(make-instance 'bar :a 1 :b 2)
+; => #<BAR {101144FFC3}>
+```
+
+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 *all* 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.
+
+### Reinitialization
+
+We'll also need to define a method on `reinitialize-instance`:
+
+```lisp
+(defmethod reinitialize-instance :around
+ ((class monitored-class) &rest initargs
+ &key (direct-superclasses nil direct-superclasses?)
+ &allow-other-keys)
+ (apply #'recompute-slots class
+ :direct-superclasses (if direct-superclasses?
+ direct-superclasses
+ (c2mop:class-direct-superclasses class))
+ initargs)
+ (let ((before (c2mop:class-direct-superclasses class)))
+ (apply #'call-next-method class (strip-initargs initargs))
+ (let* ((after (c2mop:class-direct-superclasses class))
+ (removed (set-difference before after))
+ (added (set-difference after before)))
+ (dolist (superclass removed)
+ (ensure-no-dependency superclass class))
+ (dolist (superclass added)
+ (ensure-dependency superclass class)))))
+```
+
+The overall structure of this method is the same as `initialize-instance`:
+
+1. Recompute values of our special metaclass slot(s).
+2. `call-next-method` to finish the rest of the (re)initialization.
+3. Ensure our dependencies are correct.
+
+But there are a couple of fiddly bits to note.
+
+We may or may not get a new set of direct superclasses, depending on how the
+reinitialization happened. We *always* need that list when we call
+`recompute-slots` though, so we'll grab it ourselves if we don't get it.
+
+We also save the list of direct superclasses before and after we defer to
+`call-next-method` to complete the reinitialization, and then compare the list
+before and after to figure out which dependencies we need to add or remove.
+
+With all that out of the way, we're almost done.
+
+### Dependent Updates
+
+Now we can finally tell CLOS to update dependents when a monitored class
+changes:
+
+```lisp
+(defun given-to-initarg (class initarg given-slot)
+ (when (slot-boundp class given-slot)
+ (list initarg (slot-value class given-slot))))
+
+(defmethod c2mop:update-dependent
+ (updated-class (dep dependency) &rest initargs)
+ (declare (ignore initargs))
+ (when (monitored-class-p updated-class)
+ (let ((dependent-class (dependent dep)))
+ (apply #'reinitialize-instance dependent-class
+ (append
+ (given-to-initarg dependent-class
+ :given-monitoring-function
+ 'given-monitoring-function))))))
+```
+
+`update-dependent` 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.
+
+First we check to make sure the class being updated really *is* a monitored
+class (and not something that was forward-referenced but didn't turn out to be
+monitored).
+
+Assuming we really are updating a monitored class, we call
+`reinitialize-instance` on the dependent class. We set up the initargs to this
+call as if the user had reran the *dependent's* `defclass` form (because we're
+reinitializing the *dependent*, after the superclass has changed), to ensure
+that the recalculation happens properly. An example might make this clearer:
+
+```lisp
+(defclass user ()
+ (…slots…)
+ (:metaclass monitored-class)
+ (:monitoring-function #'log-slot))
+
+(defclass paid-user (user)
+ (…slots…)
+ (:metaclass monitored-class))
+
+(defclass audited-user (user)
+ (…slots…)
+ (:metaclass monitored-class)
+ (:monitoring-function #'audit-slot-to-postgres))
+```
+
+If we now redefine `user`, both of its dependencies will be reinitialized.
+
+For `paid-user` we call `(reinitialize-instance paid-user)` with no initargs,
+because there's no `(:monitoring-function …)` in the `defclass` form and thus
+its `given-monitoring-function` slot is unbound.
+
+For `audited-user` we call `(reinitialize-instance audited-user
+:monitoring-function '(#'audit-slot-to-postgres))`, because the `audited-user`
+class *does* have a monitoring function that `recompute-slots` will need.
+
+## The Result
+
+With all that in place, our metaclass is ready for interactive use! First we'll
+review the default logging function and create two more:
+
+
+```lisp
+(defun log-slot-access (instance slot-name &optional (new-value nil new-value?))
+ (if new-value?
+ (format t "Setting slot ~A of ~A to ~S at ~A.~%"
+ slot-name instance new-value (get-universal-time))
+ (format t "Reading slot ~A of ~A at ~A.~%"
+ slot-name instance (get-universal-time))))
+
+(defun loud-slot-access (instance slot-name &optional (new-value nil new-value?))
+ (if new-value?
+ (format t "SETTING SLOT ~A OF ~A TO ~S AT ~A.~%"
+ slot-name instance new-value (get-universal-time))
+ (format t "READING SLOT ~A OF ~A AT ~A.~%"
+ slot-name instance (get-universal-time))))
+
+(defun quiet-slot-access (instance slot-name &optional (new-value nil new-value?))
+ (if new-value?
+ (format t "~A/~A <- ~S~%" instance slot-name new-value)
+ (format t "<- ~A/~A~%" instance slot-name)))
+```
+
+Now we can create a few classes:
+
+```lisp
+(defclass foo ()
+ ((x :initarg :x))
+ (:metaclass monitored-class))
+
+(defclass bar (foo)
+ ()
+ (:metaclass monitored-class)
+ (:monitoring-function #'quiet-slot-access))
+
+(defclass baz (foo)
+ ()
+ (:metaclass monitored-class))
+```
+
+* `foo` is the superclass, with the default monitoring function.
+* `bar` subclasses `foo` but changes the monitoring function.
+* `baz` subclasses foo and inherits its monitoring function.
+
+And everything should work properly:
+
+```lisp
+;; Foo has the default monitoring function ---------------------
+(defparameter *foo-object* (make-instance 'foo :x 1))
+; => Setting slot X of #<FOO {101190A513}> to 1 at 3870468582.
+
+(slot-value *foo-object* 'x)
+; => Reading slot X of #<FOO {101190A513}> at 3870468645.
+
+(setf (slot-value *foo-object* 'x) 2)
+; => Setting slot X of #<FOO {101190A513}> to 2 at 3870468657.
+
+;; Bar has the quiet one ---------------------------------------
+(defparameter *bar-object* (make-instance 'bar :x 1))
+; => #<BAR {101190EE03}>/X <- 1
+
+(slot-value *bar-object* 'x)
+; => <- #<BAR {101190EE03}>/X
+
+(setf (slot-value *bar-object* 'x) 2)
+; => #<BAR {101190EE03}>/X <- 2
+
+;; Baz inherits foo's function ---------------------------------
+(defparameter *baz-object* (make-instance 'baz :x 1))
+; => Setting slot X of #<BAZ {10119142F3}> to 1 at 3870468733.
+
+(slot-value *baz-object* 'x)
+; => Reading slot X of #<BAZ {10119142F3}> at 3870468755.
+
+(setf (slot-value *baz-object* 'x) 2)
+; => Setting slot X of #<BAZ {10119142F3}> to 2 at 3870468756.
+```
+
+And now for the *real* test. We'll redefine *only `foo`* to change its function:
+
+```lisp
+(defclass foo ()
+ ((x :initarg :x))
+ (:metaclass monitored-class)
+ (:monitoring-function #'loud-slot-access))
+```
+
+Now `foo` slot access will be yelled at us:
+
+```lisp
+(defparameter *foo-object* (make-instance 'foo :x 1))
+; => SETTING SLOT X OF #<FOO {1011998B03}> TO 1 AT 3870469055.
+```
+
+`bar` hasn't changed, because it has its own explicit function defined:
+
+```lisp
+(defparameter *bar-object* (make-instance 'bar :x 1))
+; => #<BAR {101199A913}>/X <- 1
+```
+
+But, crucially, `baz` was automatically updated to use the new function it
+inherits from `foo`:
+
+```lisp
+(defparameter *baz-object* (make-instance 'baz :x 1))
+; => SETTING SLOT X OF #<BAZ {101199C293}> TO 1 AT 3870469072.
+```
+
+## Is It Worth It?
+
+That was a lot of work. Why did we bother doing it?
+
+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.
+
+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 *possible* to do things right, but is often
+not *easy*.
+
+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 *possible* to do things
+right, even if it's not always easy.