X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/71ecc48e20c8651175b16f37ee66ca08a36cc1c6..a07d8d005f69c0f9f5da2e09c6ee39cb1e1801aa:/class-layout.lisp?ds=inline

diff --git a/class-layout.lisp b/class-layout.lisp
index a37852e..8770739 100644
--- a/class-layout.lisp
+++ b/class-layout.lisp
@@ -232,12 +232,11 @@ (defgeneric compute-sod-effective-method (message class)
 
 (defmethod compute-sod-effective-method
     ((message sod-message) (class sod-class))
-  (let ((direct-methods (mapcan (lambda (super)
-				  (let ((method
-					 (find message
-					       (sod-class-methods super)
-					       :key #'sod-method-message)))
-				    (and method (list method))))
+  (let ((direct-methods (mappend (lambda (super)
+				   (remove message
+					   (sod-class-methods super)
+					   :key #'sod-method-message
+					   :test-not #'eql))
 				(sod-class-precedence-list class))))
     (make-instance (message-effective-method-class message)
 		   :message message
@@ -549,10 +548,14 @@ (defun find-root-superclass (class)
   ;; is harmless.
   (let* ((supers (sod-class-direct-superclasses class))
 	 (roots (if supers
-		    (remove-if #'sod-class-direct-superclasses
-			       (mapcar (lambda (super)
-					 (sod-class-chain-head super))
-				       supers))
+		    (remove-duplicates
+		     (remove-if #'sod-class-direct-superclasses
+				(mappend (lambda (super)
+					   (mapcar (lambda (chain)
+						     (sod-class-chain-head
+						      (car chain)))
+						   (sod-class-chains super)))
+					 supers)))
 		    (list class))))
     (cond ((null roots) (error "Class ~A has no root class!" class))
 	  ((cdr roots) (error "Class ~A has multiple root classes ~