X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/b7a3889e4b7911ee2427b6cdc89a6acfe97e06f4..284f1fa2ace3e276052ff1bd7d66442500e693da:/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 @@ (cl:in-package #:sod) ;;;-------------------------------------------------------------------------- ;;; 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 @@ (default-slot-from-property (class 'nickname slot-names) (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)