- Contemporary messages sorted: [ by date ] [ by thread ] [ by subject ] [ by author ] [ by messages with attachments ]

From: Erick Gallesio <eg_at_kaolin.unice.fr>

Date: Sat, 19 Nov 1994 18:39:14 +0000

*> I have a class heirarchy resembling the following:
*

*>
*

*> (define-class <a> () ())
*

*> (define-class <b> () ())
*

*> (define-class <c> (<b>) ())
*

*> (define-class <d> (<c> <a>) ())
*

*>
*

*> (define-method m ((self <a>)) (display "I'm an <a>") (newline))
*

*> (define-method m ((self <b>)) (display "I'm a <b>") (newline))
*

*>
*

*> Now if I create a <c> and a <d> and pass them to m:
*

*>
*

*> (m (make <c>))
*

*> (m (make <d>))
*

*>
*

*> I see
*

*>
*

*> I'm a <b>
*

*> I'm an <a>
*

*>
*

*> It seems to me that d should be a <b>, because <c> comes before <a>
*

*> in the definition of <d>, and <b> should come before <a> because CLOS
*

*> is supposed to keep the <c> family tree together. Isn't this right?
*

It is not a bug. It's only that things are not identical that in CLOS.

I don't know what algorithm is more logical". In your exemple, I'm enclained

to think that the CLOS algorithm is better .However, in the exemple which is

exhibited in the Annex of the STk reference manual the STklos algorithm seems

to me better. In AMOP (p 80 if I remeber), there are 2 other class precedence

list which are shown with different results. I think that no solution is

ideal. The important thing is that the algorithm is known by advance (and that

it is deterministic:-> ).

Note however, that if you want to change the algorithm which buid the class

precedence list, you only have to redefine the compute-cpl function (whih is

defined in the file STklos/stklos.stk). The code in this function is

(define (compute-cpl class)

(define (filter-cpl class)

(let ((res '()))

(for-each (lambda (item)

(unless (or (eq? item <object>)

(eq? item <top>)

(member item res))

(set! res (cons item res))))

class)

res))

(let* ((supers (slot-ref class 'direct-supers))

(big-list (apply append (cons class supers)

(map compute-cpl supers))))

(reverse (list* <top> <object> (filter-cpl big-list)))))

which is relatively simple. I have preferred to rewrite (and change) the class

precedence list algorrithm since

- the CLOS algorithm has somtimes a "weird" behaviour (imho)

- the only implementation I know in Scheme of the CLOS algorithm is

the one we can find in Tiny Clos (and that I have never tried to

understand, but which seems not simple).

- in case of doubt, you can always use the class-precedence-list

function to see the inheritance precedence list

The Tiny Clos algorithm is given below if you want to adapt it to

STklos.

;

; A simple topological sort.

;

; It's in this file so that both TinyClos and Objects can use it.

;

; This is a fairly modified version of code I originally got from Anurag

; Mendhekar <anurag_at_moose.cs.indiana.edu>.

;

;

(define compute-std-cpl

(lambda (c get-direct-supers)

(top-sort ((build-transitive-closure get-direct-supers) c)

((build-constraints get-direct-supers) c)

(std-tie-breaker get-direct-supers))))

(define top-sort

(lambda (elements constraints tie-breaker)

(let loop ((elements elements)

(constraints constraints)

(result '()))

(if (null? elements)

result

(let ((can-go-in-now

(filter-in

(lambda (x)

(every (lambda (constraint)

(or (not (eq? (cadr constraint) x))

(memq (car constraint) result)))

constraints))

elements)))

(if (null? can-go-in-now)

(error 'top-sort "Invalid constraints")

(let ((choice (if (null? (cdr can-go-in-now))

(car can-go-in-now)

(tie-breaker result

can-go-in-now))))

(loop

(filter-in (lambda (x) (not (eq? x choice)))

elements)

;(filter-in (lambda (x) (not (eq? (cadr x) choice)))

; constraints)

constraints

(append result (list choice))))))))))

(define std-tie-breaker

(lambda (get-supers)

(lambda (partial-cpl min-elts)

(let loop ((pcpl (reverse partial-cpl)))

(let ((current-elt (car pcpl)))

(let ((ds-of-ce (get-supers current-elt)))

(let ((common (filter-in (lambda (x)

(memq x ds-of-ce))

min-elts)))

(if (null? common)

(if (null? (cdr pcpl))

(error 'std-tie-breaker "Nothing valid")

(loop (cdr pcpl)))

(car common)))))))))

(define build-transitive-closure

(lambda (get-follow-ons)

(lambda (x)

(let track ((result '())

(pending (list x)))

(if (null? pending)

result

(let ((next (car pending)))

(if (memq next result)

(track result (cdr pending))

(track (cons next result)

(append (get-follow-ons next)

(cdr pending))))))))))

(define build-constraints

(lambda (get-follow-ons)

(lambda (x)

(let loop ((elements ((build-transitive-closure get-follow-ons) x))

(this-one '())

(result '()))

(if (or (null? this-one) (null? (cdr this-one)))

(if (null? elements)

result

(loop (cdr elements)

(cons (car elements)

(get-follow-ons (car elements)))

result))

(loop elements

(cdr this-one)

(cons (list (car this-one) (cadr this-one))

result)))))))

-- Erick

Received on Sat Nov 19 1994 - 18:39:15 CET

Date: Sat, 19 Nov 1994 18:39:14 +0000

It is not a bug. It's only that things are not identical that in CLOS.

I don't know what algorithm is more logical". In your exemple, I'm enclained

to think that the CLOS algorithm is better .However, in the exemple which is

exhibited in the Annex of the STk reference manual the STklos algorithm seems

to me better. In AMOP (p 80 if I remeber), there are 2 other class precedence

list which are shown with different results. I think that no solution is

ideal. The important thing is that the algorithm is known by advance (and that

it is deterministic:-> ).

Note however, that if you want to change the algorithm which buid the class

precedence list, you only have to redefine the compute-cpl function (whih is

defined in the file STklos/stklos.stk). The code in this function is

(define (compute-cpl class)

(define (filter-cpl class)

(let ((res '()))

(for-each (lambda (item)

(unless (or (eq? item <object>)

(eq? item <top>)

(member item res))

(set! res (cons item res))))

class)

res))

(let* ((supers (slot-ref class 'direct-supers))

(big-list (apply append (cons class supers)

(map compute-cpl supers))))

(reverse (list* <top> <object> (filter-cpl big-list)))))

which is relatively simple. I have preferred to rewrite (and change) the class

precedence list algorrithm since

- the CLOS algorithm has somtimes a "weird" behaviour (imho)

- the only implementation I know in Scheme of the CLOS algorithm is

the one we can find in Tiny Clos (and that I have never tried to

understand, but which seems not simple).

- in case of doubt, you can always use the class-precedence-list

function to see the inheritance precedence list

The Tiny Clos algorithm is given below if you want to adapt it to

STklos.

;

; A simple topological sort.

;

; It's in this file so that both TinyClos and Objects can use it.

;

; This is a fairly modified version of code I originally got from Anurag

; Mendhekar <anurag_at_moose.cs.indiana.edu>.

;

;

(define compute-std-cpl

(lambda (c get-direct-supers)

(top-sort ((build-transitive-closure get-direct-supers) c)

((build-constraints get-direct-supers) c)

(std-tie-breaker get-direct-supers))))

(define top-sort

(lambda (elements constraints tie-breaker)

(let loop ((elements elements)

(constraints constraints)

(result '()))

(if (null? elements)

result

(let ((can-go-in-now

(filter-in

(lambda (x)

(every (lambda (constraint)

(or (not (eq? (cadr constraint) x))

(memq (car constraint) result)))

constraints))

elements)))

(if (null? can-go-in-now)

(error 'top-sort "Invalid constraints")

(let ((choice (if (null? (cdr can-go-in-now))

(car can-go-in-now)

(tie-breaker result

can-go-in-now))))

(loop

(filter-in (lambda (x) (not (eq? x choice)))

elements)

;(filter-in (lambda (x) (not (eq? (cadr x) choice)))

; constraints)

constraints

(append result (list choice))))))))))

(define std-tie-breaker

(lambda (get-supers)

(lambda (partial-cpl min-elts)

(let loop ((pcpl (reverse partial-cpl)))

(let ((current-elt (car pcpl)))

(let ((ds-of-ce (get-supers current-elt)))

(let ((common (filter-in (lambda (x)

(memq x ds-of-ce))

min-elts)))

(if (null? common)

(if (null? (cdr pcpl))

(error 'std-tie-breaker "Nothing valid")

(loop (cdr pcpl)))

(car common)))))))))

(define build-transitive-closure

(lambda (get-follow-ons)

(lambda (x)

(let track ((result '())

(pending (list x)))

(if (null? pending)

result

(let ((next (car pending)))

(if (memq next result)

(track result (cdr pending))

(track (cons next result)

(append (get-follow-ons next)

(cdr pending))))))))))

(define build-constraints

(lambda (get-follow-ons)

(lambda (x)

(let loop ((elements ((build-transitive-closure get-follow-ons) x))

(this-one '())

(result '()))

(if (or (null? this-one) (null? (cdr this-one)))

(if (null? elements)

result

(loop (cdr elements)

(cons (car elements)

(get-follow-ons (car elements)))

result))

(loop elements

(cdr this-one)

(cons (list (car this-one) (cadr this-one))

result)))))))

-- Erick

Received on Sat Nov 19 1994 - 18:39:15 CET

*
This archive was generated by hypermail 2.3.0
: Mon Jul 21 2014 - 19:38:59 CEST
*