0.pre7.127:

[sbcl.git] / src / pcl / cpl.lisp

diff --git a/src/pcl/cpl.lisp b/src/pcl/cpl.lisp
index 162ba55..f834b1a 100644 (file)
--- a/src/pcl/cpl.lisp
+++ b/src/pcl/cpl.lisp
@@ -23,8 +23,8 @@
 
 (in-package "SB-PCL")
 \f
-;;; compute-class-precedence-list
-;;;
+;;;; COMPUTE-CLASS-PRECEDENCE-LIST and friends
+
 ;;; Knuth section 2.2.3 has some interesting notes on this.
 ;;;
 ;;; What appears here is basically the algorithm presented there.
@@ -78,11 +78,12 @@
   (compute-std-cpl root (class-direct-superclasses root)))
 
 (defstruct (class-precedence-description
-            (:conc-name nil)
-            (:print-object (lambda (obj str)
-                             (print-unreadable-object (obj str :type t)
-                               (format str "~D" (cpd-count obj)))))
-            (:constructor make-cpd ()))
+           (:conc-name nil)
+           (:print-object (lambda (obj str)
+                            (print-unreadable-object (obj str :type t)
+                              (format str "~D" (cpd-count obj)))))
+           (:constructor make-cpd ())
+           (:copier nil))
   (cpd-class  nil)
   (cpd-supers ())
   (cpd-after  ())
@@ -246,21 +247,21 @@
                 (format nil "named ~S" (class-name class))
                 class))))
     (mapcar
-      #'(lambda (reason)
-         (ecase (caddr reason)
-           (:super
-             (format
-               nil
-               "The class ~A appears in the supers of the class ~A."
-               (class-or-name (cadr reason))
-               (class-or-name (car reason))))
-           (:in-supers
-             (format
-               nil
-               "The class ~A follows the class ~A in the supers of the class ~A."
-               (class-or-name (cadr reason))
-               (class-or-name (car reason))
-               (class-or-name (cadddr reason))))))
+      (lambda (reason)
+       (ecase (caddr reason)
+         (:super
+          (format
+           nil
+           "The class ~A appears in the supers of the class ~A."
+           (class-or-name (cadr reason))
+           (class-or-name (car reason))))
+         (:in-supers
+          (format
+           nil
+           "The class ~A follows the class ~A in the supers of the class ~A."
+           (class-or-name (cadr reason))
+           (class-or-name (car reason))
+           (class-or-name (cadddr reason))))))
       reasons)))
 
 (defun find-cycle-reasons (all-cpds)