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@carib-link.net