Singleton Classes with MOP
A Applied Introduction to the Metaobject Protocol
The Metaobject Protocol (MOP) for the Common Lisp Object System (CLOS) is one of the least bothered with but most interesting aspects of Common Lisp. As an introductory excursion (for both myself and the reader) into the workings of MOP and CLOS, this post presents an implementation of Singletons by means of a custom metaclass.
For The Unprepared Reader
If you have neither knowledge of CLOS nor Common Lisp, there is no better introduction than Practical Common Lisp.
The Effect To Be Produced
A singleton is a class having at most a single instance, hence the name. Operationally, instantiating a singleton class twice will yield the exact same object. Here is what this means in code:
;; instances are identical (eq (make-instance 'unique-thing) (make-instance 'unique-thing)) ; T
Note the use of
EQ in the above. The instances are not merely equivalent, but identical, occupying precisely the same location in memory.
In case you're curious, singletons do have legitimate uses. If, for example, your class models some state that takes control of external resources that can only reasonabley be controlled by one thing at a time, then a singleton may be appropriate. An example might be a class that controls a robot arm or something like that - it may not make sense to have two controllers for the same arm at the same time.
Metaclasses are one of the core concepts at work in the MOP. Just as objects are instances of classes, classes are instances of metaclasses. In Common Lisp, the default metaclass is standard-class, but the programmer can create and use custom metaclasses.
Being able to define classes as instances of custom metaclasses gives the programmer some interesting powers. You can, for example, supply a class with alternate default suerpclasses. Or, and this is of interest for the forthcoming implementation of singletons, you can ensure that a class has a particular class-level slot.
Using A Custom Metaclass
Provided that a metaclass called
singleton has been defined, a new class that uses
singleton as its metaclass can be subsequently defined like so:
;; using a metaclass (defclass unique-thing () ((name :accessor unique-thing-name :initform "" :initarg :name)) (:documentation "A unique thing") (:metaclass singleton)) ; specify the metaclass here.
The only difference between the above definition and a normal
DEFCLASS form is the use of the class option
Defining A Metaclass
Metaclasses are actually ordinary classes and, as such, can be defined with
DEFCLASS. To implement a singleton, the class needs a slot to hold the singular instance of the object-level classes that use
singleton as their metaclass.
;; define the singleton class (defclass singleton (standard-class) ((instance :initform nil :documentation "The instance for this class")))
Only one thing stands out in the above
DEFCLASS form: the inclusion of
STANDARD-CLASS among the direct superclasses list. If this step had been left out, the
singleton class would be a subclass of
STANDARD-OBJECT instead, which is the default superclass supplied by
It is worth thinking through why you must specify
STANDARD-CLASS as a superclass: it is because the instances of
singleton are themselves classes, not objects. Hence you extend from
STANDARD-CLASS instead of
In order to let Lisp know that a new metaclass is available, the programmer must manually validate its superclass relationships. Validation is performed by specializing the generic function
CLOSER-MOP:VALIDATE-SUPERCLASS for the new metaclass.
;; specialize valdiate-superclass (defmethod closer-mop:validate-superclass ((subclass singleton) (superclass standard-class)) t)
(Oh, if you have not already done so, load closer-mop in quicklisp.)
Enforcing The Rules for Singletons
Finally, to ensure the correct behavior of singleton classes, the
make-instance generic function is specialized:
;; specialise make-instance for instances of singleton (defmethod make-instance :around ((class singleton) &key) (if (slot-value class 'instance) (slot-value class 'instance) (setf (slot-value class 'instance) (call-next-method))))
It works like this: if there is already an instance, return it, otherwise use
call-next-method to proceed with the standard
make-instance process, save new instance to the
'instance slot, and return it.
Now it is possible to define classes with metaclass
singleton, and such classes will be able to instantiate at most a single object.
I hope you enjoyed that first taste of the CLOS MOP.