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

[Uwe Zdun]

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@{xotcl,computer,acm}.org, uwe.zdun at uni-essen.de