chiark / gitweb /
src/class-finalize-impl.lisp (clos-cpl, dylan-cpl): Improve formatting.
[sod] / src / class-finalize-impl.lisp
index ce3282f5eaa792f85688ec5c81bea04339ffc15e..7b324068b4f97232aaa1d459b633a8f4787b4e23 100644 (file)
@@ -72,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."
 
    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.
 
 (defun c3-tiebreaker (candidates cpls)
   "The C3 linearization tiebreaker function.
@@ -128,11 +125,10 @@ (defun clos-cpl (class)
               (remove-duplicates (cons class
                                        (mappend #'superclasses
                                                 direct-supers))))))
               (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)
 
 (export 'dylan-cpl)
 (defun dylan-cpl (class)
@@ -153,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."
 
    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)
 
 (export 'c3-cpl)
 (defun c3-cpl (class)