diff options
Diffstat (limited to 'src/util.lisp')
-rw-r--r-- | src/util.lisp | 20 |
1 files changed, 20 insertions, 0 deletions
diff --git a/src/util.lisp b/src/util.lisp index 5899b36..e561778 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -82,3 +82,23 @@ CLASS-OPTIONS is a PLIST of class options." `(defclass ,name ,supers (,@slot-defs) ,@options)))) + +;;; SINGLETON CLASSES + +(defclass singleton (closer-mop:standard-class) + ((instance :reader singleton-instance + :initarg :instance + :documentation "The instance of a singleton class.")) + (:documentation "Metaclass for singleton classes.")) + + +(defmethod closer-mop:validate-superclass + ((sub singleton) (sup closer-mop:standard-class)) + t) + +(defmethod make-instance ((class singleton) &rest kwargs) + (declare (ignorable kwargs)) + (if (slot-boundp class 'instance) + (slot-value class 'instance) + (setf (slot-value class 'instance) (call-next-method)))) + |