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.

If you have some exposure to Lisp or Common Lisp, but need a refresher on CLOS, chapter 16 and chapter 17 of the same text are superb primers.

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

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 :metaclass.

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 DEFCLASS.

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 STANDARD-OBJECT.

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.