Static instance support.

[sod] / src / classes.lisp

diff --git a/src/classes.lisp b/src/classes.lisp
index 69df4d1..b21f3c0 100644 (file)
--- a/src/classes.lisp
+++ b/src/classes.lisp
@@ -497,4 +497,57 @@
            (sod-method-message method)
            (sod-method-class method))))
 
+;;;--------------------------------------------------------------------------
+;;; Instances.
+
+(export '(static-instance static-instance-name static-instance-extern-p
+         static-instance-const-p static-instance-class
+         static-instance-initializers))
+(defclass static-instance ()
+  ((name :initarg :name :type string :reader static-instance-name)
+   (location :initarg :location :initform (file-location nil)
+            :type file-location :reader file-location)
+   (externp :initarg :extern :initform nil :type t
+           :reader static-instance-extern-p)
+   (constp :initarg :const :initform t :type t
+          :reader static-instance-const-p)
+   (%class :initarg :class :type sod-class :reader static-instance-class)
+   (initializers :initarg :initializers :initform nil
+                :type list :accessor static-instance-initializers))
+  (:documentation
+   "A static instance is a class instance built at (C) compile time.
+
+   The slots are as follows.
+
+     * The `name' gives the C identifier naming the instance, as a string.
+
+     * The `externp' flag is non-nil if the instance is to be visible outside
+       of the translation unit.
+
+     * The `location' states where, in the user's source, the instance was
+       defined.  This gets used in error messages.
+
+     * The `class' specifies the class of the instance to construct.
+
+     * The `initializers' are a list of `sod-instance-initializer' objects
+       which override any existing slot initializers defined on the class."))
+
+(defmethod print-object ((instance static-instance) stream)
+  (with-slots (name (class %class) externp constp initializers) instance
+    (maybe-print-unreadable-object (instance stream :type t)
+      (format stream "~:[~;extern ~@_~]~:[~;const ~@_~]~A ~@_~A"
+             externp constp class name)
+      (when initializers
+       (princ ": " stream)
+       (pprint-indent :block 2 stream)
+       (let ((first t))
+         (dolist (init initializers)
+           (if first (setf first nil) (princ ", "))
+           (pprint-newline :linear stream)
+           (with-slots (slot (super %class) value) init
+             (format stream "~@<~A.~A = ~2I~@_~A~:>"
+                     (sod-class-nickname super)
+                     (sod-slot-name slot)
+                     value))))))))
+
 ;;;----- That's all, folks --------------------------------------------------