[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

*To*: Moon@STONY-BROOK.SCRC.Symbolics.COM*Subject*: Re: Class Precedence List*From*: Danny Bobrow <Bobrow.pa@Xerox.COM>*Date*: 6 Jan 87 01:56 PST*Cc*: common-lisp-object-system@SAIL.STANFORD.EDU*In-reply-to*: David A. Moon <Moon@STONY-BROOK.SCRC.Symbolics.COM>'s message of Tue, 6 Jan 87 00:53 EST*Sender*: Bobrow.pa@Xerox.COM

The following is my message (slightly edited to emphasize the difference from an earlier (buggy) message), and the code Gregor and I produced for class precedence list. Date: 1 Dec 86 18:50 PST Sender: Bobrow.pa Subject: Re: Class precedence list To: Moon@STONY-BROOK.SCRC.Symbolics.COM Message-ID: <861201-185029-2210@Xerox> To restate the rules I think are appropriate, they are (slightly edited from my message of 20 October): The class precedence list is a left to right, depth first linearization of the transitive closure of inheritance from the local super classes of a class. It satisfies three constraints: C-1) A class appears only once on the list. C-2) The order of classes in a local supers list is preserved C-3) A class always precedes all classes in its local supers list It can be thought of as constructed as follows: 1) Walk the inheritance tree in left to right depth first order, recording all super classes in the order visited. 2) Remove duplicates, preserving the last occurrence of any class. This can be combined with step 1 without extra consing. This ensures that C-1 is satisfied. In most cases C-2 and C-3 will also be satisfied. This is true for all the examples in the Concepts document. 3) Traverse the resulting list from left to right. If for any class c1, there is a class to its right that c1 should follow, move c1 to the right of the rightmost such class. This rightmost class must be computed by recursive application of rules C-2 and C-3. (*** This recursive dependency is the difference between my earlier set of rules that Moon found buggy, and this set) In computing this recursive dependency, a dependency loop may be discovered, indicating an error. This algorithm gives a well defined order in which all internal superclasses of class-1 will precede all internal superclasses of class-2 if there is no intersection. (*** This does provide a topological sort of the type specified by RPG, with a preferred total order based on the tree walk) Examples: No intersection (DEFCLASS1 C1 ()) (DEFCLASS1 C2 ()) (DEFCLASS1 D1 (C1)) (DEFCLASS1 D2 (C2)) (DEFCLASS1 E1 (D1 D2)) After Steps 1 and 2 (E1 D1 C1 D2 C2) Simple Intersection: (DEFCLASS1 C1 (OBJECT)) (DEFCLASS1 C2 (OBJECT)) (DEFCLASS1 D1 (C1)) (DEFCLASS1 D2 (C2)) (DEFCLASS1 E1 (D1 D2)) After Steps 1 and 2 (E1 D1 C1 D2 C2 OBJECT) Moving Required: (DEFCLASS1 C1 ()) (DEFCLASS1 C2 ()) (DEFCLASS1 C3 ()) (DEFCLASS1 D1 (C1 C2)) (DEFCLASS1 D2 (C1 C3)) (DEFCLASS1 E1 (D1 D2)) After Steps 1 and 2 (E1 D1 C2 D2 C1 C3) In step 3, C2 must be moved after C1. resulting in (E1 D1 D2 C1 C2 C3) Simple Error: (DEFCLASS1 C2 ()) (DEFCLASS1 C3 ()) (DEFCLASS1 D4 (C3 C2)) (DEFCLASS1 D5 (C2)) (DEFCLASS1 D6 (C3 C2 D5 D4)) After steps 1 and 2: (D6 D5 D4 C3 C2) Now D5 needs to after C2 from D6 definition. Computing the recursive closure of the constraints on D5, we see that C2 must be after D4 from D4, and D4 must be after D5 from D6!!! Error. Complex Constraint (DEFCLASS1 E1 (C1)) (DEFCLASS1 E2 (C2)) (DEFCLASS1 E3 (C3)) (DEFCLASS1 E4 (E3 E2 E1)) (DEFCLASS1 E5 (C1 C2)) (DEFCLASS1 E6 (C2 C3)) (DEFCLASS1 E7 (E5 E6 E4)) After Steps 1 and 2 (E7 E5 E6 E4 E3 C3 E2 C2 E1 C1) In Step 3 C3 has to be after C2 from E6, and hence after C1 from E5, giving (E7 E5 E6 E4 E3 E2 C2 E1 C1 C3) Now C2 is next in the list and it moves past C1 from E5, giving (E7 E5 E6 E4 E3 E2 E1 C1 C2 C3). Date: Tue, 2 Dec 86 16:11 PST From: Gregor.pa Subject: code for compute-class-precedence-list To: Common-Lisp-Object-System@Sail.Stanford.edu Message-ID: <861202161119.4.GREGOR@AVALON.isl.parc.xerox.com> Line-fold: no Here is the code and some examples for the latest version of compute-class-precedence-list as described by Danny yesterday. At the end are some examples. (DEFMACRO DEFCLASS1 (NAME SUPERCLASSES) `(progn (setf (get ',name 'supers) ',superclasses))) (defun compute-class-precedence-list (root) (let ((cpl ()) (must-precede-alist ())) ;; We start by computing two values. ;; CPL ;; The depth-first left-to-right up to joins walk of the supers tree. ;; MUST-PRECEDE-ALIST ;; An alist of the must-precede relations. The car of each element of the ;;; must-precede-alist is a class, the cdr is all the classes which must ;; precede that class in the CPL. ;; ;; Note that the actual walk is breadth-first, right-to-left. ;; (labels ((walk-supers (class &optional precedence) (let ((elem (assoc class must-precede-alist))) (if elem (setf (cdr elem) (union (cdr elem) precedence)) (push (cons class precedence) must-precede-alist))) (let* ((rsupers (reverse (cons class (get class 'supers)))) (precedence (cdr rsupers))) (do ((sup rsupers (cdr sup)) (pre precedence (cdr pre))) ((null pre)) (walk-supers (car sup) pre))) (unless (member class cpl) (push class cpl))) (must-move-p (element list &aux move) (dolist (must-precede (cdr (assoc element must-precede-alist))) (when (setq move (member must-precede (cdr list))) (return move)))) (find-farthest-move (element move) (let ((closure (compute-must-precedes-closure element))) (dolist (must-precede closure) (setq move (or (member must-precede move) move))) move)) (compute-must-precedes-closure (class) (let ((closure ())) (labels ((walk (element path) (when (member element path) (class-ordering-error root element path must-precede-alist)) (dolist (precede (cdr (assoc element must-precede-alist))) (pushnew precede closure) (walk precede (cons element path))))) (walk class nil) closure)))) (walk-supers root) ;Do the walk ;; For each class in the cpl, make sure that there are no classes after it which ;; should be before it. We do this by cdring down the list, making sure that for ;; each element of the list, none of its must-precedes come after it in the list. ;; If we find one, we use the transitive closure of the must-precedes (using ;; find-farthest-move) to see where the class must really be moved. We use a ;; hand-coded loop so that we can splice things in and out of the CPL as we go. (let ((tail cpl) (element nil) (move nil)) (loop (when (null tail) (return)) (setq element (car tail) move (must-move-p element tail)) (cond (move (setq move (find-farthest-move element move)) (setf (cdr move) (cons element (cdr move))) (setf (car tail) (cadr tail));OK to use Interlisp delete trick since it (setf (cdr tail) (cddr tail));will never be the last element of the list. ) (t (setq tail (cdr tail))))) (copy-list cpl))))) (defun class-ordering-error (root element path must-precede-alist) (declare (ignore root)) (setq path (cons element (reverse (member element (reverse path))))) (let ((explanations ())) (do ((tail path (cdr tail))) ((null (cdr tail))) (let ((after (cadr tail)) (before (car tail))) (if (member after (get before 'supers)) (push (format nil "~% ~A must precede ~A -- ~A is in the local supers of ~A." before after after before) explanations) (dolist (common-precede (intersection (cdr (assoc after must-precede-alist)) (cdr (assoc before must-precede-alist)))) (when (member after (member before (get common-precede 'supers))) (push (format nil "~% ~A must precede ~A -- ~A has local supers ~S." before after common-precede (get common-precede 'supers)) explanations)))))) (error "While computing the class-precedence-list for the class ~A:~%~ There is a circular constraint through the classes:~{ ~A~}.~%~ This arises because:~{~A~}" root path (reverse explanations)))) ;;;; Examples (defclass1 o ()) (defclass1 b1 (o)) (defclass1 b2 (o)) (defclass1 b3 (o)) (defclass1 b4 (o)) (defclass1 ex1-1 (b1 b3 b4)) (defclass1 ex1-2 (b2 b3)) (defclass1 example-1 (ex1-1 ex1-2)) (equal (compute-class-precedence-list 'example-1) '(EXAMPLE-1 EX1-1 B1 EX1-2 B2 B3 B4 O)) (defclass1 o ()) (defclass1 b1 (o)) (defclass1 b2 (o)) (defclass1 b3 (o)) (defclass1 ex2-1 (b1)) (defclass1 ex2-2 (b2)) (defclass1 ex2-3 (b3)) (defclass1 example-2 (ex2-1 ex2-2 ex2-3)) (equal (compute-class-precedence-list 'example-2) '(EXAMPLE-2 EX2-1 b1 EX2-2 b2 EX2-3 b3 O)) (DEFCLASS1 C1 ()) (DEFCLASS1 C2 ()) (DEFCLASS1 C3 ()) (DEFCLASS1 C4 (C1 C2)) (DEFCLASS1 C5 (C3 C2)) (DEFCLASS1 C6 (C4 C5)) (equal (compute-class-precedence-list 'c6) '(C6 C4 C1 C5 C3 C2)) (DEFCLASS1 E1 (c1)) (DEFCLASS1 E2 (c2)) (DEFCLASS1 E3 (c3)) (DEFCLASS1 E4 (E3 E2 E1)) (DEFCLASS1 E5 (c1 c2)) (DEFCLASS1 E6 (c2 c3)) (DEFCLASS1 E7 (E5 E6 E4)) (equal (compute-class-precedence-list 'e7) '(e7 e5 e6 e4 e3 e2 e1 c1 c2 c3)) (defclass1 d0 ()) (defclass1 d1 ()) (defclass1 d2 ()) (defclass1 d3 ()) (defclass1 e (d0 d1)) (defclass1 f (d1 d2 d3)) (defclass1 g (d1 d2)) (defclass1 h (d0)) (defclass1 foo (e f g h)) (equal (compute-class-precedence-list 'foo) '(foo e f g h d0 d1 d2 d3)) (DEFCLASS1 D1 ()) (DEFCLASS1 D2 ()) (DEFCLASS1 D3 ()) (DEFCLASS1 D4 (D3 D2)) (DEFCLASS1 D5 (D2)) (DEFCLASS1 D6 (D3 D2 D5 D4)) (COMPUTE-CLASS-PRECEDENCE-LIST 'D6) ;should error (defclass1 g1 ()) (defclass1 g2 ()) (defclass1 g3 ()) (defclass1 g4 ()) (defclass1 g5 (g1 g2)) (defclass1 g6 (g2 g3)) (defclass1 g7 (g3 g4)) (defclass1 g8 (g4 g5 g6 g7)) (compute-class-precedence-list 'g8) ;should error

- Prev by Date:
**Re: :allocation slot-option issues** - Next by Date:
**Re: Method Combination Proposal** - Previous by thread:
**Class Precedence List** - Next by thread:
**Class Precedence List** - Index(es):