doc/structures.tex: Better typesetting of structure expressions.

[sod] / src / class-make-impl.lisp

diff --git a/src/class-make-impl.lisp b/src/class-make-impl.lisp
index 878f813..906519b 100644 (file)
--- a/src/class-make-impl.lisp
+++ b/src/class-make-impl.lisp
@@ -7,7 +7,7 @@
 
 ;;;----- Licensing notice ---------------------------------------------------
 ;;;
-;;; This file is part of the Sensble Object Design, an object system for C.
+;;; This file is part of the Sensible Object Design, an object system for C.
 ;;;
 ;;; SOD is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -28,19 +28,23 @@
 ;;;--------------------------------------------------------------------------
 ;;; 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."
-  (do ((supers (sod-class-direct-superclasses class) (cdr supers))
-       (meta nil (let ((candidate (sod-class-metaclass (car supers))))
-                  (cond ((null meta) candidate)
-                        ((sod-subclass-p meta candidate) meta)
-                        ((sod-subclass-p candidate meta) candidate)
-                        (t (error "Unable to choose metaclass for `~A'"
-                                  class))))))
-      ((endp supers) meta)))
+  (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.
@@ -66,7 +70,8 @@
   ;; If no metaclass, guess one in a (Lisp) class-specific way.
   (default-slot-from-property (class 'metaclass slot-names)
       (pset :metaclass :id meta (find-sod-class meta))
-    (guess-metaclass class))
+    (and (sod-class-direct-superclasses class)
+        (guess-metaclass class)))
 
   ;; If no chain-link, then start a new chain here.
   (default-slot-from-property (class 'chain-link slot-names)