;;;--------------------------------------------------------------------------
;;; 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)
"Construct and return a new SOD class with the given NAME and SUPERCLASSES.
(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