;;;--------------------------------------------------------------------------
;;; Classes.
+(export 'guess-metaclass)
+(defgeneric guess-metaclass (class)
+ (:documentation
+ "Determine a suitable metaclass for the CLASS.
+
+ The default behaviour is to choose the most specific metaclass of any of
+ the direct superclasses of CLASS, or to signal an error if that failed."))
+
(export 'make-sod-class)
-(defun make-sod-class (name superclasses pset &optional location)
+(defun make-sod-class (name superclasses pset &key location)
"Construct and return a new SOD class with the given NAME and SUPERCLASSES.
This is the main constructor function for classes. The protocol works as
(with-default-error-location (location)
(let* ((pset (property-set pset))
(best-class (or (get-property pset :lisp-metaclass :symbol nil)
- (if superclasses
- (maximum (mapcar #'class-of superclasses)
- #'subtypep
- (format nil "Lisp metaclass for ~A"
- name))
- 'sod-class)))
+ (select-minimal-class-property
+ superclasses #'class-of #'subtypep 'sod-class
+ "Lisp metaclass"
+ :present (lambda (class)
+ (format nil "`~S'"
+ (class-name class)))
+ :allow-empty t)))
(class (make-instance best-class
:name name
:superclasses superclasses
;;; Slots and slot initializers.
(export 'make-sod-slot)
-(defgeneric make-sod-slot (class name type pset &optional location)
+(defgeneric make-sod-slot (class name type pset &key location)
(:documentation
"Construct, add, and attach a new slot with given NAME and TYPE, to CLASS.
(export 'make-sod-instance-initializer)
(defgeneric make-sod-instance-initializer
- (class nick name value pset &optional location)
+ (class nick name value pset &key location inhibit-initargs)
(:documentation
"Construct and attach an instance slot initializer, to CLASS.
construction process. The default method looks up the slot using
`find-instance-slot-by-name', calls `make-sod-initializer-using-slot' to
actually make the initializer object, and adds it to the appropriate list
- in CLASS."))
+ in CLASS.
+
+ Usually, if an `initarg' property is set on PSET, then a slot initarg is
+ created and attached to the slot; this can be prevented by setting
+ INHIBIT-INITARGS non-nil. This is needed when creating a slot and
+ initializer from the same property set, in order to prevent creation of a
+ duplicate initarg."))
(export 'make-sod-class-initializer)
(defgeneric make-sod-class-initializer
- (class nick name value pset &optional location)
+ (class nick name value pset &key location)
(:documentation
"Construct and attach a class slot initializer, to CLASS.
You are not expected to call this generic function directly; it's more
useful as a place to hang methods for custom initializer classes."))
+(export 'make-sod-user-initarg)
+(defgeneric make-sod-user-initarg
+ (class name type pset &key default location)
+ (:documentation
+ "Attach a user-defined initialization keyword argument to the CLASS.
+
+ The new argument has the given NAME and TYPE, and maybe a DEFAULT value.
+ Currently, initialization arguments are just dumb objects held in a
+ list."))
+
+(export 'make-sod-slot-initarg)
+(defgeneric make-sod-slot-initarg
+ (class name nick slot-name pset &key location)
+ (:documentation
+ "Attach an initialization keyword argument to a slot by name.
+
+ The default method uses `find-instance-slot-by-name' to find the slot, and
+ `make-slot-initarg-using-slot' to actually make and attach the initarg."))
+
+(export 'make-sod-slot-initarg-using-slot)
+(defgeneric make-sod-slot-initarg-using-slot
+ (class name slot pset &key location)
+ (:documentation
+ "Attach an initialization keyword argument to a SLOT.
+
+ The argument's type is taken from the slot type. Slot initargs can't have
+ defaults: the slot's most-specific initializer is used instead.
+
+ You are not expected to call this generic function directly; it's more
+ useful as a place to hang methods for custom classes."))
+
+(export 'sod-initarg-argument)
+(defgeneric sod-initarg-argument (initarg)
+ (:documentation "Returns an `argument' object for the initarg."))
+
+(export 'make-sod-class-initfrag)
+(defgeneric make-sod-class-initfrag (class frag pset &key location)
+ (:documentation
+ "Attach an initialization fragment FRAG to the CLASS.
+
+ Currently, initialization fragments are just dumb objects held in a
+ list."))
+
+(export 'make-sod-class-tearfrag)
+(defgeneric make-sod-class-tearfrag (class frag pset &key location)
+ (:documentation
+ "Attach a teardown fragment FRAG to the CLASS.
+
+ Currently, teardown fragments are just dumb objects held in a
+ list."))
+
;;;--------------------------------------------------------------------------
;;; Messages and methods.
(export 'make-sod-message)
-(defgeneric make-sod-message (class name type pset &optional location)
+(defgeneric make-sod-message (class name type pset &key location)
(:documentation
"Construct and attach a new message with given NAME and TYPE, to CLASS.
(export 'make-sod-method)
(defgeneric make-sod-method
- (class nick name type body pset &optional location)
+ (class nick name type body pset &key location)
(:documentation
"Construct and attach a new method to CLASS.