X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/sod/blobdiff_plain/ab7e7521a95d737ed6d1bf94964fc44d46ab077c..5d55bdaafab11f2479024bcd1cf5d76e0cf73f98:/src/class-finalize-impl.lisp

diff --git a/src/class-finalize-impl.lisp b/src/class-finalize-impl.lisp
index f67c118..7b32406 100644
--- a/src/class-finalize-impl.lisp
+++ b/src/class-finalize-impl.lisp
@@ -56,13 +56,8 @@ (defun merge-class-lists (lists pick)
 
    This is a convenience wrapper around the main `merge-lists' function.
    Given that class linearizations (almost?) always specify a custom
-   tiebreaker function, this isn't a keyword argument.  Also, this wrapper
-   provides a standard presentation function so that any errors are presented
-   properly."
-  (merge-lists lists
-	       :pick pick
-	       :present (lambda (class)
-			  (format nil "`~A'" (sod-class-name class)))))
+   tiebreaker function, this isn't a keyword argument."
+  (merge-lists lists :pick pick))
 
 ;;; Tiebreaker functions.
 
@@ -77,14 +72,11 @@ (defun clos-tiebreaker (candidates so-far)
    direct subclass then that subclass's direct superclasses list must order
    them relative to each other."
 
-  (let (winner)
-    (dolist (class so-far)
-      (dolist (candidate candidates)
-	(when (member candidate (sod-class-direct-superclasses class))
-	  (setf winner candidate))))
-    (unless winner
-      (error "SOD INTERNAL ERROR: Failed to break tie in CLOS"))
-    winner))
+  (dolist (class so-far)
+    (dolist (candidate candidates)
+      (when (member candidate (sod-class-direct-superclasses class))
+	(return-from clos-tiebreaker candidate))))
+  (error "SOD INTERNAL ERROR: Failed to break tie in CLOS"))
 
 (defun c3-tiebreaker (candidates cpls)
   "The C3 linearization tiebreaker function.
@@ -133,11 +125,10 @@ (defun clos-cpl (class)
 	       (remove-duplicates (cons class
 					(mappend #'superclasses
 						 direct-supers))))))
-    (merge-class-lists
-     (mapcar (lambda (class)
-	       (cons class (sod-class-direct-superclasses class)))
-	     (superclasses class))
-     #'clos-tiebreaker)))
+    (merge-class-lists (mapcar (lambda (c)
+				 (cons c (sod-class-direct-superclasses c)))
+			       (superclasses class))
+		       #'clos-tiebreaker)))
 
 (export 'dylan-cpl)
 (defun dylan-cpl (class)
@@ -158,11 +149,10 @@ (defun dylan-cpl (class)
    assuming that the superclass CPLs are already monotonic.  If they aren't,
    you're going to lose anyway."
 
-  (let ((direct-supers (sod-class-direct-superclasses class)))
-    (merge-class-lists
-     (cons (cons class direct-supers)
-	   (mapcar #'sod-class-precedence-list direct-supers))
-     #'clos-tiebreaker)))
+  (let* ((direct-supers (sod-class-direct-superclasses class))
+	 (cpls (mapcar #'sod-class-precedence-list direct-supers)))
+    (merge-class-lists (cons (cons class direct-supers) cpls)
+		       #'clos-tiebreaker)))
 
 (export 'c3-cpl)
 (defun c3-cpl (class)