X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/29ad689c87013c6ce8cd33ffb2f1f6b86dc67f0c..ae0f15ee8427fa91cfd1945bfded847032cb8a25:/src/class-make-impl.lisp diff --git a/src/class-make-impl.lisp b/src/class-make-impl.lisp index aef6948..dba6965 100644 --- a/src/class-make-impl.lisp +++ b/src/class-make-impl.lisp @@ -28,24 +28,6 @@ ;;;-------------------------------------------------------------------------- ;;; Classes. -(defun maximum (items order what) - "Return a maximum item according to the non-strict partial ORDER." - (reduce (lambda (best this) - (cond ((funcall order best this) best) - ((funcall order this best) this) - (t (error "Unable to choose best ~A." what)))) - items)) - -(defmethod guess-metaclass ((class sod-class)) - "Default metaclass-guessing function for classes. - - Return the most specific metaclass of any of the CLASS's direct - superclasses." - (maximum (mapcar #'sod-class-metaclass - (sod-class-direct-superclasses class)) - #'sod-subclass-p - (format nil "metaclass for `~A'" class))) - (defmethod shared-initialize :after ((class sod-class) slot-names &key pset) "Specific behaviour for SOD class initialization. @@ -67,11 +49,11 @@ (pset :nick :id) (string-downcase (slot-value class 'name))) - ;; If no metaclass, guess one in a (Lisp) class-specific way. + ;; Set the metaclass if the appropriate property has been provided; + ;; otherwise leave it unbound for now, and we'll sort out the mess during + ;; finalization. (default-slot-from-property (class 'metaclass slot-names) - (pset :metaclass :id meta (find-sod-class meta)) - (and (sod-class-direct-superclasses class) - (guess-metaclass class))) + (pset :metaclass :id meta (find-sod-class meta))) ;; If no chain-link, then start a new chain here. (default-slot-from-property (class 'chain-link slot-names)