Hi Sheik,
sorry for the late response. I attach a sligtly different variant of your
filter program that should run. Look for "XXX" comments to see what I had to
change.
Cheers,
Uwe
#################################################################
#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]
puts "Filter $del $method"
#if delegate has method then dispatch it.
if {[$del procsearch $method] != ""} {
#
# XXX:
#
# eval [eval [$del $method $args]] does not work
#
return [eval $del $method $args]
}
return [next];
}
#
# XXX:
# you have forgotten this "next". Remember the filter is
# called on every call. Also on "[self] set delegate $d" in init.
# if you do not pass such calls through, the delegate must
# be set before the filter is appended.
#
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
#
# XXX:
# here, it said "a m 123", but you require some indiretion so that
# the filter knows that it should call m2 instead of m
#
# to make the example run, i just call m2 directly ...
#
puts "result = [a m2 123]"
#################################################################
On Sunday 08 July 2001 19:10, Sheik Yussuff wrote:
> > 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
----------------------------------------
Content-Type: text/html; charset="iso-8859-1"; name="Attachment: 1"
Content-Transfer-Encoding: quoted-printable
Content-Description:
----------------------------------------
--
Uwe Zdun
Institute for Computer Science, University of Essen
Phone: +49 201 81 00 332, Fax: +49 201 81 00 398
zdun_at_{xotcl,computer,acm}.org, uwe.zdun_at_uni-essen.de
