[Xotcl] "Simple Delegation" revisited (long post)

[Sheik Yussuff]

Just over 6 months ago,Catherine Letondal raised

the issue of implementing "simple delegation".

Professor G. Neumann replied with some code showing

how it can be done as well as suggesting that one may

use a filter to filter all methods or an instmixin

to target specific methods for delegation.

I am now learning Tcl and XOTcl (a week or so now)at the

same time and have decided to try the filter approach.

The Experiment:

1. Create a meta-class SimpleDelegation

2. add a filter sdFilter to this meta-class

3. add an instproc setDelegate

4. Create classes A and B using SimpleDelegate

5. Create class C using Class

6. A has as delegate(instvar) an object of class B;

B has as delegate an object of class C

7. A,B and C has a method "m" defined

The Problem: (Using Windows binary ver 0.85)

I extended Prof. Neumann's code to handle above

and it works.(see Code1 below)

My experiment(Code 2) works only for the following

cases(that I tested):

1. A,B and C has a method "m".

2. The instvar delegate removed from B

It does not work when I rename the method

"m" in class C to "m2".

In this case I expect an object of class B to

execute "m" but instead I get an object of class

A executing "m" instead.

I would be grateful for any pointers to resolve

this problem.

Also I want to try to implement delegation as

described by Prof. Lieberman(OOPSLA 1986 paper).

Will be grateful for any pointers on this also.

...............

Code1: Prof Neumann's code inelegantly extended

Class A -parameter delegate

A instproc handleDelegation {result} {

if {[[self] exists delegate]} {

set context [::info level -1]

#look for method in delegated object

if {[[[self] set delegate] procsearch [lindex $context 0]] != "" } {

::upvar $result y

set y [eval [[self] set delegate] $context]

return 1

}

}

return 0

}

A instproc m {x} {

if {[[self] handleDelegation r]} {

return $r

} else {

puts "[self] [self class] [self proc] $x";

return [next]

}

}

Class B -parameter delegate

B instproc handleDelegation {result} {

if {[[self] exists delegate]} {

set context [::info level -1]

#look for method in delegated object

if {[[[self] set delegate] procsearch [lindex $context 0]] != "" } {

::upvar $result y

set y [eval [[self] set delegate] $context]

return 1

}

}

return 0

}

B instproc m {x} {

if {[[self] handleDelegation r]} {

return $r

} else {

puts "[self] [self class] [self proc] $x";

return [next]

}

}

Class D

D instproc m2 {x} {

puts "[self] [self class] [self proc] $x"

next

return [expr {$x*2 + [[self] set v]}]

}

D d1

d1 set v 100

B b1 -delegate d1

A a1 -delegate b1

puts "result = [a1 m 123]"

...............................................

Code2: My Try using filters

#create SimpleDelegation as a meta-class

Class SimpleDelegation -superclass Class

SimpleDelegation instproc sdFilter args {

set method [self calledproc]

if {[[self] exists delegate]} {

set del [[self] set delegate]

#if delegate has method then dispatch it.

if {[$del procsearch $method] != ""} {

return [eval [$del $method $args]]

} 

return [next];

}

}

SimpleDelegation instproc init args {

[self] filterappend [self class]::sdFilter

next

[self] instproc setDelegate {d} {

[self] set delegate $d

}

}

SimpleDelegation A -parameter delegate

SimpleDelegation B -parameter delegate



A instproc m {x} {

puts "[self] [self class] [self proc] $x"

return [next]

}

B instproc m {x} {

puts "[self] [self class] [self proc] $x"

next

return [expr {$x*2 + [[self] set v]}]

}

Class C

#method "m" renamed to "m2" here.

C instproc m2 {x} {

puts "[self] [self class] [self proc] $x"

next

return [expr {$x*3 + [[self] set v]}]

}

A a

B b

a setDelegate b

b set v 100

C c

b setDelegate c

c set v 100

puts "result = [a m 123]"

..................................................

Regards,

Sheik Yussuff

email: sheik at carib-link.net

-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://alice.wu-wien.ac.at/pipermail/xotcl/attachments/20010708/a6c9bbc6/attachment.html