I’ll try to write this blog entry in english. I’m not very used to writing in english though, so please bear with me 
I will try to show how to use the Metaobject Protocol for CLOS (the Lisp OO system). When learning how to use MOP, I had quite a hard time finding examples on the web, and the seminal work about MOP (The Art of the Metaobject Protocol) doesn’t offer that much help either. Furthermore, MOP is not really standardized as it is, and most Lisp implementations offer subtly different implementations. The code I’ll present here has been tested with PCL-based Lisp implementations (SBCL and CMUCL, for example), and with Allegro CL. I guess it can easily be ported to other Lisp implementations, but haven’t got around to do it for now.
A good deal of the functionality of BKNR is based on the Metaobject Protocol, namely:
- the Indices package, which offers object-oriented indices on CLOS objects.
- the XML import/export package, which offers XML bindings for CLOS objects,
- the Datastore package, which offers persistent CLOS objects and support for logged transactions.
The Metaobject Protocol is a “meta”-layer above CLOS which allows both introspection and customization of the Object System.
MOP for introspection
MOP presents an object-oriented view to the object-system itself.
For example, the classes created using the DEFCLASS macro are
themselves objects. You can get such an object by using
FIND-CLASS:
CL-USER> (defclass foo () ())
#<STANDARD-CLASS FOO>
CL-USER> (find-class 'foo)
#<STANDARD-CLASS FOO>
CL-USER> (describe *)
#<STANDARD-CLASS FOO> is an instance of
#<STANDARD-CLASS STANDARD-CLASS>:
The following slots have :INSTANCE allocation:
PLIST NIL
FLAGS 0
DIRECT-METHODS (NIL)
NAME FOO
DIRECT-SUPERCLASSES (#<STANDARD-CLASS STANDARD-OBJECT>)
DIRECT-SUBCLASSES NIL
CLASS-PRECEDENCE-LIST NIL
WRAPPER NIL
DIRECT-SLOTS NIL
SLOTS NIL
PROTOTYPE NIL
; No value
CL-USER> (find-class 'standard-class)
#<STANDARD-CLASS STANDARD-CLASS>
The class FOO we created is represented by an object of class
STANDARD-CLASS. The object representing STANDARD-CLASS is itself of
class STANDARD-CLASS. Beware of the recursion trap if you try too
hard to think about it. The trick here is that the MOP is not
necessarily the actual implementation of the object system, but is
just a representation.
MOP can be used to inspect not only classes, but also other
parts of the object system. You can inspect slot objects, which
represent the slots of classes:
CL-USER> (defclass blorg () (a b (c :initarg :c :initform 1))) #<STANDARD-CLASS BLORG> CL-USER> (mop:finalize-inheritance (find-class 'blorg)) NIL CL-USER> (mop:class-slots (find-class 'blorg)) (#<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION A @ #x55b17b2> #<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION B @ #x55b17fa> #<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION C @ #x55b1842>)
We see the first trick to use in order to use the ACL MOP here.
The ACL MOP delays most operations until the first instance of a
class is actually created. We force the finalization of the class
BLORG here by calling the method FINALIZE-INHERITANCE by hand. We
can now inspect the slot objects:
CL-USER> (describe (first *))
#<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION A @ #x55b17b2> is an
instance of
#<STANDARD-CLASS ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION>:
The following slots have :INSTANCE allocation:
NAME A
TYPE T
DOCUMENTATION NIL
INITFORM NIL
INITFUNCTION NIL
INITARGS NIL
ALLOCATION :INSTANCE
; No value
CL-USER> (describe (car (last **)))
#<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION C @ #x561c342> is an
instance of
#<STANDARD-CLASS ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION>:
The following slots have :INSTANCE allocation:
NAME C
TYPE T
DOCUMENTATION NIL
INITFORM 1
INITFUNCTION #<Closure (:INTERNAL CONSTANTLY 0) @ #x5649a22>
INITARGS (:C)
ALLOCATION :INSTANCE
; No value
In the same way, we can also inspect generic function objects
and method objects (I won’t cover that here because I never used
it).
MOP for customization
The most interesting part of MOP however is the customization
part. You can use MOP to modify the way CLOS works. Now, most of
the time, the standard tools of CLOS are sufficient (think about
what you can do with method combinations, multiple inheritance, and
the like). But in special cases, you want to control slot access
for example, triggering special events when a slot is accessed
without overleading all slot accessors, and without creating
wrapper macros. Or you would like to add automatically generated
slots on class creation. You can do all this by creating your own
metaclasses. Metaclasses are classes instantiated to create class
objects. For example, STANDARD-CLASS is such a metaclass (and all
you metaclasses should inherit from STANDARD-CLASS if you want to
avoid weird effects). Starting from there, MOP has a myriad of
little generic method protocols which specify how classes are
instantiated, how slots are accessed, how methods are called, how
objects are initialized. By carefully overloading or modifying some
of these methods for your metaclasses, you can add new
functionality to you CLOS classes and objects.
I’ll present the functionality we added using MOP in our BKNR
framework. However, this will not be an exhaustive coverage of all
the functionality we implemented, but more a kind of overview. I
hope these examples will help you to get started with MOP. I had a
lot of difficulty grasping it at first. After all this introductory
smalltalk, I think it is time to get started with the real
thing.
Indices for CLOS objects
The Indices package was motivated by the fact that we had to
query the data that was stored in our first persistent store. For
example, we had a lot of classes that had unique identification
string (the username for the USER class, for example, or the image
name for IMAGEs, or the title for ARTICLEs). We factored this
functionality out by using a big class definition macro, which was
gladly wept under the rug when we rewrote the datastore. However,
we wanted to keep the practical aspects of the macro: we were able
to specify an index and the name of the functions to query it in a
few keywords inside the class declaration. To illustrate what I’m
saying, imagine that you are keeping track of gorillas in wildlife
park (these examples are straight from the Indices package
documentation). In traditional Common Lisp, you would write
something like this:
(defclass gorilla ()
((name :initarg :name
:reader gorilla-name
:type string)
(description :initarg :description
:reader gorilla-description)))
(defun all-gorillas () (copy-list *gorillas*))
(defun gorilla-with-name (name)
(find name *gorillas* :test #'string-equal
:key #'gorilla-name))
(defun gorillas-with-description (description)
(remove description *gorillas* :test-not #'eql :key
#'gorilla-description))
Writing all the query-functions by hand quickly gets tiresome
(especially if all the indices are similar). The original
DEFPERSISTENTCLASS (or whatever it used to be called) handled this
by extracting special keyword arguments from the slot definition
and adding custom :AROUND wrappers on the slot accessors and the
INITIALIZE-INSTANCE method. This did not catch slot acces using the
SLOT-VALUE function though, and handling inheritance was ugly and
prone to error to say the least. Before delving into the
implementation details of BKNR Indices, let me explain how slots
are handled by MOP.
Slot definitions
A class specification, which is written by the programmer using
the DEFCLASS macro, specificies how “DIRECT-SLOT-DEFINITION”
objects are created. These are the objects that hold the parameters
given in the slot definition. The direct slot definition class can
be specified by overloading the DIRECT-SLOT-DEFINITION-CLASS method
of the metaclass. The new direct slot definition class should
inherit from the STANDARD-DIRECT-DEFINITION class. When a new class
is created, the direct slot definition objects for each slot are
combined with the direct slot definition objects of the
superclasses of the new classes. and this list of direct slot
definition objects is used to create the effective slot definition.
The effective slot definition is the object that is used for the
“real” slots of the class. The information stored in the direct
slot definitions can be used to create this effective slot. Let’s
see how this applies for our indexed objects.
The indexes for a slot can be specified using a multitude of
keywords in the slot definition. For example, you can specify the
type of the index to be created, the name of various query
functions, as well as a list of initialisation arguments to be used
at index creation. All these parameters are stored in the direct
slot definition. Thus, we create a new metaclass for indexed
classes classed INDEX-DIRECT-SLOT-DEFINITION (this definition is a
bit lengthy, but I will post it in full for the sake of
completeness):
(defclass index-direct-slot-definition (standard-direct-slot-definition)
((index :initarg :index :initform nil
:reader index-direct-slot-definition-index
:documentation "Slot keyword for an already existing index")
(index-var :initarg :index-var :initform nil
:reader index-direct-slot-definition-index-var
:documentation "Symbol that will be bound to the index")
(index-type :initarg :index-type :initform nil
:reader index-direct-slot-definition-index-type
:documentation "Slot keyword to specify the class of a new slot index")
(index-initargs :initarg :index-initargs :initform nil
:reader index-direct-slot-definition-index-initargs
:documentation "Arguments that will be passed to
INDEX-CREATE when creating a new slot index")
(index-reader :initform nil
:initarg :index-reader
:accessor index-direct-slot-definition-index-reader
:documentation "Name of a function that will be created to query the slot index")
(index-values :initform nil
:initarg :index-values
:accessor index-direct-slot-definition-index-values
:documentation "Name of a function that will be
created to get the values stored in the index")
(index-mapvalues :initform nil
:initarg :index-mapvalues
:accessor index-direct-slot-definition-index-mapvalues
:documentation "Name of a function that will be
created to map over the values stored in the index")
(index-keys :initform nil
:initarg :index-keys
:accessor index-direct-slot-definition-index-keys
:documentation "Name of a function that will be created
to get the keys stored in the index")
(index-subclasses :initarg :index-subclasses :initform t
:accessor index-direct-slot-definition-index-subclasses
:documentation "Specify if the slot index will
also index subclasses of the class to which the slot belongs, default is T")
(class :initform nil
:accessor index-direct-slot-definition-class)))
When a new indexed class is created (to be precise, when a new
class with the metaclass INDEXED-CLASS is created), the direct slot
definitions objects for each slot are combined into an object of
class INDEX-EFFECTIVE-SLOT-DEFINITION. This object is a lot simpler
than the direct slot definition. It only holds a list of indexes
that apply to the slot (indexes that have to be updated when the
slot is changed).
(defclass index-effective-slot-definition (standard-effective-slot-definition)
((indices :initarg :indices :initform nil
:accessor index-effective-slot-definition-indices)))
For example, when we create a class USER with the slot NAME, a
direct slot definition is created for the slot NAME. This direct
slot definition object will be used to create the corresponding
index, which will be stored in the effective slot definition, which
will be used for slot accesses later on.
INDICES> (defclass user ()
((name :initarg :name
:reader user-name
:index-type string-unique-index))
(:metaclass indexed-class))
#<INDEXED-CLASS USER>
INDICES> (mop:class-slots *) (#<INDEX-EFFECTIVE-SLOT-DEFINITION DESTROYED-P @ #x6768912> #<INDEX-EFFECTIVE-SLOT-DEFINITION NAME @ #x676814a>)
INDICES> (mop:class-direct-slots **) (#<INDEX-DIRECT-SLOT-DEFINITION NAME @ #x6767ffa>)
INDICES> (describe (first *))
#<INDEX-DIRECT-SLOT-DEFINITION NAME @ #x6767ffa> is an instance of
#<STANDARD-CLASS INDEX-DIRECT-SLOT-DEFINITION>:
The following slots have :INSTANCE allocation:
NAME NAME
TYPE T
DOCUMENTATION NIL
INITFORM NIL
INITFUNCTION NIL
INITARGS (:NAME)
ALLOCATION :INSTANCE
READERS (USER-NAME)
WRITERS NIL
FIXED-INDEX NIL
INDEX NIL
INDEX-VAR NIL
INDEX-TYPE STRING-UNIQUE-INDEX
INDEX-INITARGS NIL
INDEX-READER NIL
INDEX-VALUES NIL
INDEX-MAPVALUES NIL
INDEX-KEYS NIL
INDEX-SUBCLASSES T
CLASS #<INDEXED-CLASS USER>
INDICES> (describe (second (mop:class-slots (find-class 'user))))
#<INDEX-EFFECTIVE-SLOT-DEFINITION NAME @ #x676814a> is an instance of
#<STANDARD-CLASS INDEX-EFFECTIVE-SLOT-DEFINITION>:
The following slots have :INSTANCE allocation:
NAME NAME
TYPE T
DOCUMENTATION NIL
INITFORM NIL
INITFUNCTION NIL
INITARGS (:NAME)
ALLOCATION :INSTANCE
INDICES (#<STRING-UNIQUE-INDEX SLOT: NAME SIZE: 0 @
#x6768182>)
We can then create a class KILLER-USER, and add an additional
index on the NAME slot. Both direct slot definitions (for USER and
KILLER-USER) will be combined to form a new effective slot
definition.
INDICES> (defclass killer-user (user)
((name :index-type string-unique-index
:index-reader killer-user-with-name))
(:metaclass indexed-class))
#<INDEXED-CLASS KILLER-USER>
INDICES> (describe (second (mop:class-slots (find-class 'killer-user))))
#<INDEX-EFFECTIVE-SLOT-DEFINITION NAME @ #x67be082> is an instance of
#<STANDARD-CLASS INDEX-EFFECTIVE-SLOT-DEFINITION>:
The following slots have :INSTANCE allocation:
NAME NAME
TYPE T
DOCUMENTATION NIL
INITFORM NIL
INITFUNCTION NIL
INITARGS (:NAME)
ALLOCATION :INSTANCE
INDICES (#<STRING-UNIQUE-INDEX SLOT: NAME SIZE: 0 @
#x6768182>
#<STRING-UNIQUE-INDEX SLOT: NAME SIZE: 0 @
#x67be0d2>)
INDICES> (mop:class-direct-slots (find-class 'killer-user))
(#<INDEX-DIRECT-SLOT-DEFINITION NAME @ #x67bdfda>)
INDICES> (describe (first *))
#<INDEX-DIRECT-SLOT-DEFINITION NAME @ #x67bdfda> is an instance of
#<STANDARD-CLASS INDEX-DIRECT-SLOT-DEFINITION>:
The following slots have :INSTANCE allocation:
NAME NAME
TYPE T
DOCUMENTATION NIL
INITFORM NIL
INITFUNCTION NIL
INITARGS NIL
ALLOCATION :INSTANCE
READERS NIL
WRITERS NIL
FIXED-INDEX NIL
INDEX NIL
INDEX-VAR NIL
INDEX-TYPE STRING-UNIQUE-INDEX
INDEX-INITARGS NIL
INDEX-READER KILLER-USER-WITH-NAME
INDEX-VALUES NIL
INDEX-MAPVALUES NIL
INDEX-KEYS NIL
INDEX-SUBCLASSES T
CLASS #<INDEXED-CLASS KILLER-USER>
As for direct slot definitions, changing the class of the
effective slot definition can be done by overloading the method
EFFECTIVE-SLOT-DEFINITION-CLASS. The method that combines all the
direct slots into a new effective slot definition object is called
COMPUTE-EFFECTIVE-SLOT-DEFINITION. In addition, if we want to add
new custom slots to a class (for example, you may have noticed the
new slot DESTROYED-P in the USER class), we can do this in the
method COMPUTE-SLOTS. However, we have to be careful with the
COMPUTE-SLOTS method. Its last step is to carry through the
allocation of the slots. This step is implementation specific, and
overloading the COMPUTE-SLOTS method has to be done with care so as
not to jump over this last step for new slots.
The indices MOP code
I will now walk through the actual code of INDEXED-CLASS (which
can be found in the bknr repository under
svn://bknr.net/trunk/bknr/src/indices/indexed-class.lisp). I will
not discuss the indices functionality though (I will blog about
this another day). First, we have to define our new metaclass,
called INDEXED-CLASS. It is customary to name new metaclasses
SOMETHING-CLASS.
(defclass indexed-class (standard-class)
((indices :initarg :indices :initform nil
:accessor indexed-class-indices)
(old-indices :initarg 
ld-indices :initform nil
:accessor indexed-class-old-indices)
(index-definitions :initarg :class-indices :initform nil
:accessor indexed-class-index-definitions)))
The INDICES slot here holds the indices which apply to the class
directly, and which have to be updated on class modification for
example. OLD-INDICES is only used when reinitializing the class to
hold some temporary values. I think this could be removed by using
some clever :AROUND method. INDEX-DEFINITIONS holds the definitions
of class indices, which apply to all slots of an object. The
definitions are used to reinitialize the indices when the class is
changed. The next step is to validate the new superclass with the
MOP by specifically overloading VALIDATE-SUPERCLASS (this is
necessary for PCL-based MOPs).
(defclass indexed-class (standard-class)
((indices :initarg :indices :initform nil
:accessor indexed-class-indices)
(old-indices :initarg ld-indices :initform nil
:accessor indexed-class-old-indices)
(index-definitions :initarg :class-indices :initform nil
:accessor indexed-class-index-definitions)))
(defmethod validate-superclass ((sub indexed-class) (super standard-class)) t)
The next step is to overload the DIRECT-SLOT-DEFINITION-CLASS
and EFFECTIVE-SLOT_DEFINITION-CLASS methods. We will create an
INDEX-DIRECT-SLOT-DEFINITION object only if the initargs INDEX or
INDEX-TYPE are present. However, to simplify our handling code, we
will always create INDEX-EFFECTIVE-SLOT-DEFINITIONS objects.
(defmethod direct-slot-definition-class ((class indexed-class) &key index index-type &allow-other-keys)
(if (or index index-type)
'index-direct-slot-definition
(call-next-method)))
(defmethod effective-slot-definition-class ((class indexed-class) &rest initargs) (declare (ignore initargs)) 'index-effective-slot-definition)
The direct slot definitions are used by
COMPUTE-EFFECTIVE-SLOT-DEFINITION to compute the effective indices
for a slot. Here it is (beware, this function is quite
complicated):
(defmethod compute-effective-slot-definition ((class indexed-class) name direct-slots)
(declare (ignore name))
(let* ((normal-slot (call-next-method))
(direct-slots (remove-if-not #'(lambda (slot)
(typep slot 'index-direct-slot-definition))
direct-slots))
(direct-slot (first direct-slots)))
(when (and direct-slot
(or (not (index-direct-slot-definition-class direct-slot))
(eql (index-direct-slot-definition-class direct-slot) class)))
(setf (index-direct-slot-definition-class direct-slot) class)
(with-slots (index index-type index-initargs index-subclasses index-keys
index-reader index-values index-mapvalues index-var) direct-slot
(when (or index index-type)
(let* ((name (slot-definition-name direct-slot))
(index-object (make-index-object :index index
:type index-type
:initargs index-initargs
:reader index-reader
:keys index-keys
:values index-values
:mapvalues index-mapvalues
:var index-var
:slots (list name))))
(when index-object
(push (make-index-holder :class class :slots (list name)
:name name :index index-object
:index-subclasses index-subclasses)
(indexed-class-indices class)))))))
normal-slot))
A few words of explanation… First, the function removes all
the direct slot definitions that don’t relate to indices. Then, it
will handle only the direct slot definition pertaining to the
current class (direct slot definitions for superclasses have
already been handled, and we just have to fetch the created indices
from the superclass). It then creates the new index by using
MAKE-INDEX-OBJECT and passing it all the initialization arguments
held in the direct slot definition. The direct slot definition is
only used as some kind of proxy between the slot definition written
by the programmer and the actual index object (which are documented
in INDICES.LISP in the same directory). Finally, an index-holder is
created and stored in the list of all the indices of the class. The
indices for superclasses are computed in another function called
COMPUTE-CLASS-INDICES.
I mentionned above that all MOP implementations are slightly
different in some kind of awkward ways. The following code is there
to avoid late binding in CMUCL and AllegroCL (this is necessary to
be able to compute the correct indices for a new class).
#+allegro (defmethod finalize-inheritance :after ((class indexed-class)) (compute-class-indices class (indexed-class-index-definitions class)) (reinitialize-class-indices class))
;;; avoid late instantiation
#+(or allegro cmu) (defmethod initialize-instance :after ((class indexed-class) &key &allow-other-keys) (compute-class-indices class (indexed-class-index-definitions class)) (reinitialize-class-indices class))
#+(or allegro cmu) (defmethod reinitialize-instance :after ((class indexed-class) &key &allow-other-keys) (compute-class-indices class (indexed-class-index-definitions class)) (reinitialize-class-indices class))
Finally, we add the new slot DESTROYED-P, which is true if the
obejct has been destroyed (but has not been garbage collected yet).
This slot is very important. When it is set, every slot access
throws an error.
(defmethod compute-slots ((class indexed-class))
(let* ((normal-slots (call-next-method)))
(let ((destroyed-p-slot #.`(make-instance 'index-effective-slot-definition
:name 'destroyed-p
:initform nil
:class class
#+cmu
,@'(:readers nil :writers nil)
:initfunction #'(lambda () nil))))
(cons destroyed-p-slot normal-slots))))
To be continued…
This is the end of this first posting of which will be a longer
serie than expected. The next posting will continue going through
the Indices code where we left it. We will then see how to handle
slot access, and how to reinitialize indexed objects and indexed
classes.