;;;; specification.
(in-package "SB-PCL")
-
-(sb-int:file-comment
- "$Header$")
\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.
(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 ())
(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)