+;;;--------------------------------------------------------------------------
+;;; Static instances.
+
+(defmethod shared-initialize :after
+ ((instance static-instance) slot-names &key pset)
+ "Initialize a static instance."
+ (default-slot-from-property (instance 'externp slot-names)
+ (pset :extern :boolean)
+ nil)
+ (default-slot-from-property (instance 'constp slot-names)
+ (pset :const :boolean)
+ t))
+
+(defmethod make-static-instance ((class sod-class) name initializers
+ pset location &key)
+
+ ;; Check that the initializers are all for distinct slots.
+ (find-duplicates (lambda (initializer previous)
+ (let ((slot (sod-initializer-slot initializer)))
+ (cerror*-with-location initializer
+ "Duplicate initializer for ~
+ instance slot `~A' in ~
+ static instance `~A'"
+ slot name)
+ (info-with-location previous
+ "Previous definition was here")))
+ initializers
+ :key #'sod-initializer-slot)
+
+ ;; Ensure that every slot will have an initializer, either defined directly
+ ;; on the instance or as part of some class definition.
+ (let ((have (make-hash-table)))
+
+ ;; First, populate the hash table with all of the slots for which we have
+ ;; initializers.
+ (flet ((seen-slot-initializer (init)
+ (setf (gethash (sod-initializer-slot init) have) t)))
+ (mapc #'seen-slot-initializer
+ initializers)
+ (dolist (super (sod-class-precedence-list class))
+ (mapc #'seen-slot-initializer
+ (sod-class-instance-initializers super))))
+
+ ;; Now go through all of the slots and check that they have initializers.
+ (dolist (super (sod-class-precedence-list class))
+ (dolist (slot (sod-class-slots super))
+ (unless (gethash slot have)
+ (cerror*-with-location location
+ "No initializer for instance slot `~A', ~
+ required by static instance `~A'"
+ slot name)
+ (info-with-location slot "Slot `~A' defined here" slot)))))
+
+ ;; Make the instance.
+ (make-instance 'static-instance
+ :class class
+ :name name
+ :initializers initializers
+ :location (file-location location)
+ :pset pset))
+