# HG changeset patch # User Steve Losh # Date 1661483104 14400 # Node ID 1aa828894145a316a37eb4301c5b94b250e05828 # Parent 351848b6eab471da50ec51fe3cc18e7f24bd16de New entry, plus some other stuff diff -r 351848b6eab4 -r 1aa828894145 IDEAS --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/IDEAS Thu Aug 25 23:05:04 2022 -0400 @@ -0,0 +1,1 @@ +Macro post on define-sorting-predicate diff -r 351848b6eab4 -r 1aa828894145 LICENSE --- a/LICENSE Wed Apr 20 20:10:31 2022 -0400 +++ b/LICENSE Thu Aug 25 23:05:04 2022 -0400 @@ -1,4 +1,4 @@ -Copyright (c) 2020 Steve Losh +Copyright (c) 2022 Steve Losh Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff -r 351848b6eab4 -r 1aa828894145 README.markdown --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/README.markdown Thu Aug 25 23:05:04 2022 -0400 @@ -0,0 +1,23 @@ +Workflow +======== + +`watch.sh` in one window, `serve.sh` in another. + +`deploy.sh` when ready. + +Pieces +====== + +`make` is used to build particular files, don't use it manually. + +`generate` is the Lisp program to generate the bulk of the HTML from Markdown. + +`build.sh` will do one build, invoking `generate` and a few other things. + +`watch.sh` will watch with `peat` and rebuild on changes. + +`deploy.sh` will build and deploy to the server. + +`serve.sh` will start the simple Python webserver locally. + + diff -r 351848b6eab4 -r 1aa828894145 content/blog/2022/04/clos-dependent-maintenance.markdown --- 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/ - -
- -## 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 # to 1 at 3828527923. -; => Setting slot NAME of # to "sjl" at 3828527923. -; => *U* - -(id *u*) -; => Reading slot ID of # at 3828527937. -; => 1 - -(setf (name *u*) "Steve") -; => Setting slot NAME of # 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 - - - - -```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)) - '()))))) -``` diff -r 351848b6eab4 -r 1aa828894145 content/blog/2022/08/depending-in-common-lisp.markdown --- /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/ + +
+ +## 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 # to 1 at 3828527923. +; => Setting slot NAME of # to "sjl" at 3828527923. +; => *U* + +(slot-value *u* 'id) +; => Reading slot ID of # at 3828527937. +; => 1 + +(setf (slot-value *u* 'name) "Steve") +; => Setting slot NAME of # 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 # to 2 at 3870460545. +; => Setting slot NAME of # to "moneybags" at 3870460545. +; => Setting slot PLAN of # 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) +; => # +``` + +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 # to 1 at 3870468582. + +(slot-value *foo-object* 'x) +; => Reading slot X of # at 3870468645. + +(setf (slot-value *foo-object* 'x) 2) +; => Setting slot X of # to 2 at 3870468657. + +;; Bar has the quiet one --------------------------------------- +(defparameter *bar-object* (make-instance 'bar :x 1)) +; => #/X <- 1 + +(slot-value *bar-object* 'x) +; => <- #/X + +(setf (slot-value *bar-object* 'x) 2) +; => #/X <- 2 + +;; Baz inherits foo's function --------------------------------- +(defparameter *baz-object* (make-instance 'baz :x 1)) +; => Setting slot X of # to 1 at 3870468733. + +(slot-value *baz-object* 'x) +; => Reading slot X of # at 3870468755. + +(setf (slot-value *baz-object* 'x) 2) +; => Setting slot X of # 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 # 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)) +; => #/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 # 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. diff -r 351848b6eab4 -r 1aa828894145 content/blog/in-progress/lisp-pens-and-trees.markdown --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/content/blog/in-progress/lisp-pens-and-trees.markdown Thu Aug 25 23:05:04 2022 -0400 @@ -0,0 +1,50 @@ +(:title "Lisp, Pens, and Trees" + :snip "Growing something pretty." + :date "2022-07-27T00:00:00Z" + :draft t) + +I've been meaning to document a fun little project I did a few years ago, so +here we go. The actual project itself is a lot more complicated and has a lot +more code behind it, but I wanted to distill it down to the essence here. + +
+ +## Drawing Lines + +First we want to be able to draw some lines. + +## Turtle Graphics + +[Turtle graphics][] are a simple way to draw lines with instructions like: + +1. Start at the center, facing north. +2. Move forward. +3. Turn right 90°. +4. Move forward. +5. Turn right 90°. +6. Move forward. +7. Move forward again. + +The result would look something like: + +[![Example of a simple Turtle graphics script](/static/images/blog/2022/07/trivial-turtle.png)](/static/images/blog/2022/07/trivial-turtle.png) + +The name "turtle" came from the [original robots][], which looked +and moved like turtles. + +We can use a more compact notation for our turtle instructions: + +* `F` move forward one step (while drawing). +* `S` skip forward one step (without drawing). +* `+` rotate a set amount counterclockwise. +* `-` rotate a set amount clockwise. + +We'll add some other instructions later, but this is enough for now. Let's +implement a simple turtle. + +[Turtle graphics]: https://en.wikipedia.org/wiki/Turtle_graphics +[original robots]: https://blog.adafruit.com/2018/05/03/the-history-of-turtle-bots-part-1-hardware/ + +## L-Systems +## Mutation +## Plotting diff -r 351848b6eab4 -r 1aa828894145 serve.sh --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/serve.sh Thu Aug 25 23:05:04 2022 -0400 @@ -0,0 +1,6 @@ +#!/usr/bin/env bash + +set -euo pipefail + +cd build +python3 -m http.server diff -r 351848b6eab4 -r 1aa828894145 static/images/blog/2022/07/trivial-turtle.png Binary file static/images/blog/2022/07/trivial-turtle.png has changed diff -r 351848b6eab4 -r 1aa828894145 watch.sh --- a/watch.sh Wed Apr 20 20:10:31 2022 -0400 +++ b/watch.sh Thu Aug 25 23:05:04 2022 -0400 @@ -2,4 +2,4 @@ set -euo pipefail -hg files generate.lisp content static | grep -v static/images | peat ./build.sh +ffind | grep -v static/images | peat ./build.sh