Add: types.lisp, singletonc lasses, debugging instr.lisp

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))))
+