- (with-slots ((msgtype type)) message
- (unless (c-type-equal-p (c-type-subtype msgtype)
- (c-type-subtype type))
- (error "Method return type ~A doesn't match message ~A"
- (c-type-subtype msgtype) (c-type-subtype type)))
- (unless (argument-lists-compatible-p (c-function-arguments msgtype)
- (c-function-arguments type))
- (error "Method arguments ~A don't match message ~A" type msgtype))))
+ (with-slots ((msgtype %type)) message
+ (check-method-return-type-against-message type msgtype)
+ (check-method-argument-lists type msgtype)))
+
+;;;--------------------------------------------------------------------------
+;;; 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))