\nI’ll try to write this blog entry in english. I’m not very used to writing in english though, so please bear with me \ud83d\ude42\n<\/p>\n
\nI will try to show how to use the Metaobject Protocol for CLOS<\/a> (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<\/a>) doesn’t offer that much help either. Furthermore, MOP is not really standardized<\/a> 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<\/a> and CMUCL<\/a>, for example), and with Allegro CL<\/a>. I guess it can easily be ported to other Lisp implementations, but haven’t got around to do it for now.\n<\/p>\n \nA good deal of the functionality of BKNR<\/a> is based on the Metaobject Protocol, namely:\n<\/p>\n \nThe Metaobject Protocol is a “meta”-layer above CLOS which allows both introspection and customization of the Object System.\n<\/p>\n <\/p>\n MOP for introspection The class FOO we created is represented by an object of class MOP can be used to inspect not only classes, but also other We see the first trick to use in order to use the ACL MOP here. In the same way, we can also inspect generic function objects MOP for customization<\/strong><\/p>\n The most interesting part of MOP however is the customization I’ll present the functionality we added using MOP in our BKNR Indices for CLOS objects<\/strong><\/p>\n The Indices package was motivated by the fact that we had to Writing all the query-functions by hand quickly gets tiresome Slot definitions<\/strong><\/p>\n A class specification, which is written by the programmer using The indexes for a slot can be specified using a multitude of When a new indexed class is created (to be precise, when a new For example, when we create a class USER with the slot NAME, a We can then create a class KILLER-USER, and add an additional As for direct slot definitions, changing the class of the The indices MOP code<\/strong><\/p>\n I will now walk through the actual code of INDEXED-CLASS (which The INDICES slot here holds the indices which apply to the class The next step is to overload the DIRECT-SLOT-DEFINITION-CLASS The direct slot definitions are used by A few words of explanation… First, the function removes all I mentionned above that all MOP implementations are slightly Finally, we add the new slot DESTROYED-P, which is true if the To be continued…<\/strong><\/p>\n This is the end of this first posting of which will be a longer 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 \ud83d\ude42 I will try to show how to use the Metaobject Protocol for CLOS (the Lisp OO … Continue reading \n
<\/strong>
\nMOP presents an object-oriented view to the object-system itself.
\nFor example, the classes created using the DEFCLASS macro are
\nthemselves objects. You can get such an object by using
\nFIND-CLASS:<\/p>\n\nCL-USER> (defclass foo () ())\n#<STANDARD-CLASS FOO>\nCL-USER> (find-class 'foo)\n#<STANDARD-CLASS FOO>\nCL-USER> (describe *)\n#<STANDARD-CLASS FOO> is an instance of\n #<STANDARD-CLASS STANDARD-CLASS>:\n The following slots have :INSTANCE allocation:\n PLIST NIL\n FLAGS 0\n DIRECT-METHODS (NIL)\n NAME FOO\n DIRECT-SUPERCLASSES (#<STANDARD-CLASS STANDARD-OBJECT>)\n DIRECT-SUBCLASSES NIL\n CLASS-PRECEDENCE-LIST NIL\n WRAPPER NIL\n DIRECT-SLOTS NIL\n SLOTS NIL\n PROTOTYPE NIL\n; No value\nCL-USER> (find-class 'standard-class)\n#<STANDARD-CLASS STANDARD-CLASS>\n<\/pre>\n
\nSTANDARD-CLASS. The object representing STANDARD-CLASS is itself of
\nclass STANDARD-CLASS. Beware of the recursion trap if you try too
\nhard to think about it. The trick here is that the MOP is not
\nnecessarily the actual implementation of the object system, but is
\njust a representation.<\/p>\n
\nparts of the object system. You can inspect slot objects, which
\nrepresent the slots of classes:<\/p>\n\nCL-USER> (defclass blorg () (a b (c :initarg :c :initform 1)))\n#<STANDARD-CLASS BLORG>\nCL-USER> (mop:finalize-inheritance (find-class 'blorg))\nNIL\nCL-USER> (mop:class-slots (find-class 'blorg))\n(#<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION A @ #x55b17b2>\n #<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION B @ #x55b17fa>\n #<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION C @ #x55b1842>)\n<\/pre>\n
\nThe ACL MOP delays most operations until the first instance of a
\nclass is actually created. We force the finalization of the class
\nBLORG here by calling the method FINALIZE-INHERITANCE by hand. We
\ncan now inspect the slot objects:<\/p>\n\nCL-USER> (describe (first *))\n#<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION A @ #x55b17b2> is an\n instance of\n #<STANDARD-CLASS ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION>:\n The following slots have :INSTANCE allocation:\n NAME A\n TYPE T\n DOCUMENTATION NIL\n INITFORM NIL\n INITFUNCTION NIL\n INITARGS NIL\n ALLOCATION :INSTANCE\n; No value\nCL-USER> (describe (car (last **)))\n#<ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION C @ #x561c342> is an\n instance of\n #<STANDARD-CLASS ACLMOP:STANDARD-EFFECTIVE-SLOT-DEFINITION>:\n The following slots have :INSTANCE allocation:\n NAME C\n TYPE T\n DOCUMENTATION NIL\n INITFORM 1\n INITFUNCTION #<Closure (:INTERNAL CONSTANTLY 0) @ #x5649a22>\n INITARGS (:C)\n ALLOCATION :INSTANCE\n; No value\n<\/pre>\n
\nand method objects (I won’t cover that here because I never used
\nit).<\/p>\n
\npart. You can use MOP to modify the way CLOS works. Now, most of
\nthe time, the standard tools of CLOS are sufficient (think about
\nwhat you can do with method combinations, multiple inheritance, and
\nthe like). But in special cases, you want to control slot access
\nfor example, triggering special events when a slot is accessed
\nwithout overleading all slot accessors, and without creating
\nwrapper macros. Or you would like to add automatically generated
\nslots on class creation. You can do all this by creating your own
\nmetaclasses. Metaclasses are classes instantiated to create class
\nobjects. For example, STANDARD-CLASS is such a metaclass (and all
\nyou metaclasses should inherit from STANDARD-CLASS if you want to
\navoid weird effects). Starting from there, MOP has a myriad of
\nlittle generic method protocols which specify how classes are
\ninstantiated, how slots are accessed, how methods are called, how
\nobjects are initialized. By carefully overloading or modifying some
\nof these methods for your metaclasses, you can add new
\nfunctionality to you CLOS classes and objects.<\/p>\n
\nframework. However, this will not be an exhaustive coverage of all
\nthe functionality we implemented, but more a kind of overview. I
\nhope these examples will help you to get started with MOP. I had a
\nlot of difficulty grasping it at first. After all this introductory
\nsmalltalk, I think it is time to get started with the real
\nthing.<\/p>\n
\nquery the data that was stored in our first persistent store. For
\nexample, we had a lot of classes that had unique identification
\nstring (the username for the USER class, for example, or the image
\nname for IMAGEs, or the title for ARTICLEs). We factored this
\nfunctionality out by using a big class definition macro, which was
\ngladly wept under the rug when we rewrote the datastore. However,
\nwe wanted to keep the practical aspects of the macro: we were able
\nto specify an index and the name of the functions to query it in a
\nfew keywords inside the class declaration. To illustrate what I’m
\nsaying, imagine that you are keeping track of gorillas in wildlife
\npark (these examples are straight from the Indices package
\ndocumentation). In traditional Common Lisp, you would write
\nsomething like this:<\/p>\n\n(defclass gorilla ()\n ((name :initarg :name\n :reader gorilla-name\n :type string)\n (description :initarg :description\n :reader gorilla-description)))\n<\/pre>\n
\n(defun all-gorillas ()\n (copy-list *gorillas*))\n<\/pre>\n
\n(defun gorilla-with-name (name)\n (find name *gorillas* :test #'string-equal\n :key #'gorilla-name))\n<\/pre>\n
\n(defun gorillas-with-description (description)\n (remove description *gorillas* :test-not #'eql :key\n #'gorilla-description))\n<\/pre>\n
\n(especially if all the indices are similar). The original
\nDEFPERSISTENTCLASS (or whatever it used to be called) handled this
\nby extracting special keyword arguments from the slot definition
\nand adding custom :AROUND wrappers on the slot accessors and the
\nINITIALIZE-INSTANCE method. This did not catch slot acces using the
\nSLOT-VALUE function though, and handling inheritance was ugly and
\nprone to error to say the least. Before delving into the
\nimplementation details of BKNR Indices, let me explain how slots
\nare handled by MOP.<\/p>\n
\nthe DEFCLASS macro, specificies how “DIRECT-SLOT-DEFINITION”
\nobjects are created. These are the objects that hold the parameters
\ngiven in the slot definition. The direct slot definition class can
\nbe specified by overloading the DIRECT-SLOT-DEFINITION-CLASS method
\nof the metaclass. The new direct slot definition class should
\ninherit from the STANDARD-DIRECT-DEFINITION class. When a new class
\nis created, the direct slot definition objects for each slot are
\ncombined with the direct slot definition objects of the
\nsuperclasses of the new classes. and this list of direct slot
\ndefinition objects is used to create the effective slot definition.
\nThe effective slot definition is the object that is used for the
\n“real” slots of the class. The information stored in the direct
\nslot definitions can be used to create this effective slot. Let’s
\nsee how this applies for our indexed objects.<\/p>\n
\nkeywords in the slot definition. For example, you can specify the
\ntype of the index to be created, the name of various query
\nfunctions, as well as a list of initialisation arguments to be used
\nat index creation. All these parameters are stored in the direct
\nslot definition. Thus, we create a new metaclass for indexed
\nclasses classed INDEX-DIRECT-SLOT-DEFINITION (this definition is a
\nbit lengthy, but I will post it in full for the sake of
\ncompleteness):<\/p>\n\n(defclass index-direct-slot-definition (standard-direct-slot-definition)\n ((index :initarg :index :initform nil\n :reader index-direct-slot-definition-index\n :documentation \"Slot keyword for an already existing index\")\n<\/pre>\n
\n (index-var :initarg :index-var :initform nil\n :reader index-direct-slot-definition-index-var\n :documentation \"Symbol that will be bound to the index\")\n \n (index-type :initarg :index-type :initform nil\n :reader index-direct-slot-definition-index-type\n :documentation \"Slot keyword to specify the class of a new slot index\")\n (index-initargs :initarg :index-initargs :initform nil\n :reader index-direct-slot-definition-index-initargs\n :documentation \"Arguments that will be passed to\nINDEX-CREATE when creating a new slot index\")\n<\/pre>\n
\n (index-reader :initform nil\n :initarg :index-reader\n :accessor index-direct-slot-definition-index-reader\n :documentation \"Name of a function that will be created to query the slot index\")\n (index-values :initform nil\n :initarg :index-values\n :accessor index-direct-slot-definition-index-values\n :documentation \"Name of a function that will be\ncreated to get the values stored in the index\")\n (index-mapvalues :initform nil\n :initarg :index-mapvalues\n :accessor index-direct-slot-definition-index-mapvalues\n :documentation \"Name of a function that will be\ncreated to map over the values stored in the index\")\n (index-keys :initform nil\n :initarg :index-keys\n :accessor index-direct-slot-definition-index-keys\n :documentation \"Name of a function that will be created\nto get the keys stored in the index\")\n<\/pre>\n
\n (index-subclasses :initarg :index-subclasses :initform t\n :accessor index-direct-slot-definition-index-subclasses\n :documentation \"Specify if the slot index will\nalso index subclasses of the class to which the slot belongs, default is T\")\n \n (class :initform nil\n :accessor index-direct-slot-definition-class)))\n<\/pre>\n
\nclass with the metaclass INDEXED-CLASS is created), the direct slot
\ndefinitions objects for each slot are combined into an object of
\nclass INDEX-EFFECTIVE-SLOT-DEFINITION. This object is a lot simpler
\nthan the direct slot definition. It only holds a list of indexes
\nthat apply to the slot (indexes that have to be updated when the
\nslot is changed).<\/p>\n\n(defclass index-effective-slot-definition (standard-effective-slot-definition)\n ((indices :initarg :indices :initform nil\n :accessor index-effective-slot-definition-indices)))\n<\/pre>\n
\ndirect slot definition is created for the slot NAME. This direct
\nslot definition object will be used to create the corresponding
\nindex, which will be stored in the effective slot definition, which
\nwill be used for slot accesses later on.<\/p>\n\nINDICES> (defclass user ()\n ((name :initarg :name\n :reader user-name\n :index-type string-unique-index))\n (:metaclass indexed-class))\n#<INDEXED-CLASS USER>\n<\/pre>\n
\nINDICES> (mop:class-slots *)\n(#<INDEX-EFFECTIVE-SLOT-DEFINITION DESTROYED-P @ #x6768912>\n #<INDEX-EFFECTIVE-SLOT-DEFINITION NAME @ #x676814a>)\n<\/pre>\n
\nINDICES> (mop:class-direct-slots **)\n(#<INDEX-DIRECT-SLOT-DEFINITION NAME @ #x6767ffa>)\n<\/pre>\n
\nINDICES> (describe (first *))\n#<INDEX-DIRECT-SLOT-DEFINITION NAME @ #x6767ffa> is an instance of\n #<STANDARD-CLASS INDEX-DIRECT-SLOT-DEFINITION>:\n The following slots have :INSTANCE allocation:\n NAME NAME\n TYPE T\n DOCUMENTATION NIL\n INITFORM NIL\n INITFUNCTION NIL\n INITARGS (:NAME)\n ALLOCATION :INSTANCE\n READERS (USER-NAME)\n WRITERS NIL\n FIXED-INDEX NIL\n INDEX NIL\n INDEX-VAR NIL\n INDEX-TYPE STRING-UNIQUE-INDEX\n INDEX-INITARGS NIL\n INDEX-READER NIL\n INDEX-VALUES NIL\n INDEX-MAPVALUES NIL\n INDEX-KEYS NIL\n INDEX-SUBCLASSES T\n CLASS #<INDEXED-CLASS USER>\n<\/pre>\n
\nINDICES> (describe (second (mop:class-slots (find-class 'user))))\n#<INDEX-EFFECTIVE-SLOT-DEFINITION NAME @ #x676814a> is an instance of\n #<STANDARD-CLASS INDEX-EFFECTIVE-SLOT-DEFINITION>:\n The following slots have :INSTANCE allocation:\n NAME NAME\n TYPE T\n DOCUMENTATION NIL\n INITFORM NIL\n INITFUNCTION NIL\n INITARGS (:NAME)\n ALLOCATION :INSTANCE\n INDICES (#<STRING-UNIQUE-INDEX SLOT: NAME SIZE: 0 @\n #x6768182>)\n<\/pre>\n
\nindex on the NAME slot. Both direct slot definitions (for USER and
\nKILLER-USER) will be combined to form a new effective slot
\ndefinition.<\/p>\n\nINDICES> (defclass killer-user (user)\n ((name :index-type string-unique-index\n :index-reader killer-user-with-name))\n (:metaclass indexed-class))\n#<INDEXED-CLASS KILLER-USER>\n<\/pre>\n
\nINDICES> (describe (second (mop:class-slots (find-class 'killer-user))))\n#<INDEX-EFFECTIVE-SLOT-DEFINITION NAME @ #x67be082> is an instance of\n #<STANDARD-CLASS INDEX-EFFECTIVE-SLOT-DEFINITION>:\n The following slots have :INSTANCE allocation:\n NAME NAME\n TYPE T\n DOCUMENTATION NIL\n INITFORM NIL\n INITFUNCTION NIL\n INITARGS (:NAME)\n ALLOCATION :INSTANCE\n INDICES (#<STRING-UNIQUE-INDEX SLOT: NAME SIZE: 0 @\n #x6768182>\n #<STRING-UNIQUE-INDEX SLOT: NAME SIZE: 0 @\n #x67be0d2>)\n<\/pre>\n
\nINDICES> (mop:class-direct-slots (find-class 'killer-user))\n(#<INDEX-DIRECT-SLOT-DEFINITION NAME @ #x67bdfda>)\nINDICES> (describe (first *))\n#<INDEX-DIRECT-SLOT-DEFINITION NAME @ #x67bdfda> is an instance of\n #<STANDARD-CLASS INDEX-DIRECT-SLOT-DEFINITION>:\n The following slots have :INSTANCE allocation:\n NAME NAME\n TYPE T\n DOCUMENTATION NIL\n INITFORM NIL\n INITFUNCTION NIL\n INITARGS NIL\n ALLOCATION :INSTANCE\n READERS NIL\n WRITERS NIL\n FIXED-INDEX NIL\n INDEX NIL\n INDEX-VAR NIL\n INDEX-TYPE STRING-UNIQUE-INDEX\n INDEX-INITARGS NIL\n INDEX-READER KILLER-USER-WITH-NAME\n INDEX-VALUES NIL\n INDEX-MAPVALUES NIL\n INDEX-KEYS NIL\n INDEX-SUBCLASSES T\n CLASS #<INDEXED-CLASS KILLER-USER>\n<\/pre>\n
\neffective slot definition can be done by overloading the method
\nEFFECTIVE-SLOT-DEFINITION-CLASS. The method that combines all the
\ndirect slots into a new effective slot definition object is called
\nCOMPUTE-EFFECTIVE-SLOT-DEFINITION. In addition, if we want to add
\nnew custom slots to a class (for example, you may have noticed the
\nnew slot DESTROYED-P in the USER class), we can do this in the
\nmethod COMPUTE-SLOTS. However, we have to be careful with the
\nCOMPUTE-SLOTS method. Its last step is to carry through the
\nallocation of the slots. This step is implementation specific, and
\noverloading the COMPUTE-SLOTS method has to be done with care so as
\nnot to jump over this last step for new slots.<\/p>\n
\ncan be found in the bknr repository under
\nsvn:\/\/bknr.net\/trunk\/bknr\/src\/indices\/indexed-class.lisp). I will
\nnot discuss the indices functionality though (I will blog about
\nthis another day). First, we have to define our new metaclass,
\ncalled INDEXED-CLASS. It is customary to name new metaclasses
\nSOMETHING-CLASS.<\/p>\n\n(defclass indexed-class (standard-class)\n ((indices :initarg :indices :initform nil\n :accessor indexed-class-indices)\n (old-indices :initarg :old-indices :initform nil\n :accessor indexed-class-old-indices)\n (index-definitions :initarg :class-indices :initform nil\n :accessor indexed-class-index-definitions)))\n<\/pre>\n
\ndirectly, and which have to be updated on class modification for
\nexample. OLD-INDICES is only used when reinitializing the class to
\nhold some temporary values. I think this could be removed by using
\nsome clever :AROUND method. INDEX-DEFINITIONS holds the definitions
\nof class indices, which apply to all slots of an object. The
\ndefinitions are used to reinitialize the indices when the class is
\nchanged. The next step is to validate the new superclass with the
\nMOP by specifically overloading VALIDATE-SUPERCLASS (this is
\nnecessary for PCL-based MOPs).<\/p>\n\n(defclass indexed-class (standard-class)\n ((indices :initarg :indices :initform nil\n :accessor indexed-class-indices)\n (old-indices :initarg :old-indices :initform nil\n :accessor indexed-class-old-indices)\n (index-definitions :initarg :class-indices :initform nil\n :accessor indexed-class-index-definitions)))\n<\/pre>\n
\n(defmethod validate-superclass ((sub indexed-class) (super standard-class))\n t)\n<\/pre>\n
\nand EFFECTIVE-SLOT_DEFINITION-CLASS methods. We will create an
\nINDEX-DIRECT-SLOT-DEFINITION object only if the initargs INDEX or
\nINDEX-TYPE are present. However, to simplify our handling code, we
\nwill always create INDEX-EFFECTIVE-SLOT-DEFINITIONS objects.<\/p>\n\n(defmethod direct-slot-definition-class ((class indexed-class) &key index index-type &allow-other-keys)\n (if (or index index-type)\n 'index-direct-slot-definition\n (call-next-method)))\n<\/pre>\n
\n(defmethod effective-slot-definition-class ((class indexed-class) &rest initargs)\n (declare (ignore initargs))\n 'index-effective-slot-definition)\n<\/pre>\n
\nCOMPUTE-EFFECTIVE-SLOT-DEFINITION to compute the effective indices
\nfor a slot. Here it is (beware, this function is quite
\ncomplicated):<\/p>\n\n(defmethod compute-effective-slot-definition ((class indexed-class) name direct-slots)\n (declare (ignore name))\n (let* ((normal-slot (call-next-method))\n (direct-slots (remove-if-not #'(lambda (slot)\n (typep slot 'index-direct-slot-definition))\n direct-slots))\n (direct-slot (first direct-slots)))\n (when (and direct-slot\n (or (not (index-direct-slot-definition-class direct-slot))\n (eql (index-direct-slot-definition-class direct-slot) class)))\n (setf (index-direct-slot-definition-class direct-slot) class)\n (with-slots (index index-type index-initargs index-subclasses index-keys\n index-reader index-values index-mapvalues index-var) direct-slot\n (when (or index index-type)\n (let* ((name (slot-definition-name direct-slot))\n (index-object (make-index-object :index index\n :type index-type\n :initargs index-initargs\n :reader index-reader\n :keys index-keys\n :values index-values\n :mapvalues index-mapvalues\n :var index-var\n :slots (list name))))\n (when index-object\n (push (make-index-holder :class class :slots (list name)\n :name name :index index-object\n :index-subclasses index-subclasses)\n (indexed-class-indices class)))))))\n normal-slot))\n<\/pre>\n
\nthe direct slot definitions that don’t relate to indices. Then, it
\nwill handle only the direct slot definition pertaining to the
\ncurrent class (direct slot definitions for superclasses have
\nalready been handled, and we just have to fetch the created indices
\nfrom the superclass). It then creates the new index by using
\nMAKE-INDEX-OBJECT and passing it all the initialization arguments
\nheld in the direct slot definition. The direct slot definition is
\nonly used as some kind of proxy between the slot definition written
\nby the programmer and the actual index object (which are documented
\nin INDICES.LISP in the same directory). Finally, an index-holder is
\ncreated and stored in the list of all the indices of the class. The
\nindices for superclasses are computed in another function called
\nCOMPUTE-CLASS-INDICES.<\/p>\n
\ndifferent in some kind of awkward ways. The following code is there
\nto avoid late binding in CMUCL and AllegroCL (this is necessary to
\nbe able to compute the correct indices for a new class).<\/p>\n\n#+allegro\n(defmethod finalize-inheritance :after ((class indexed-class))\n (compute-class-indices class (indexed-class-index-definitions class))\n (reinitialize-class-indices class))\n<\/pre>\n
\n;;; avoid late instantiation\n<\/pre>\n
\n#+(or allegro cmu)\n(defmethod initialize-instance :after ((class indexed-class) &key &allow-other-keys)\n (compute-class-indices class (indexed-class-index-definitions class))\n (reinitialize-class-indices class))\n<\/pre>\n
\n#+(or allegro cmu)\n(defmethod reinitialize-instance :after ((class indexed-class) &key &allow-other-keys)\n (compute-class-indices class (indexed-class-index-definitions class))\n (reinitialize-class-indices class))\n<\/pre>\n
\nobejct has been destroyed (but has not been garbage collected yet).
\nThis slot is very important. When it is set, every slot access
\nthrows an error.<\/p>\n\n(defmethod compute-slots ((class indexed-class))\n (let* ((normal-slots (call-next-method)))\n (let ((destroyed-p-slot #.`(make-instance 'index-effective-slot-definition\n :name 'destroyed-p\n :initform nil\n :class class\n #+cmu\n ,@'(:readers nil :writers nil)\n :initfunction #'(lambda () nil))))\n (cons destroyed-p-slot normal-slots))))\n<\/pre>\n
\nserie than expected. The next posting will continue going through
\nthe Indices code where we left it. We will then see how to handle
\nslot access, and how to reinitialize indexed objects and indexed
\nclasses.<\/p>\n","protected":false},"excerpt":{"rendered":"