[PD-cvs] pd/src poe.tcl,1.1.2.2.2.2,1.1.2.2.2.3

[Mathieu Bouchard]

Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8652

Modified Files:
      Tag: desiredata
	poe.tcl 
Log Message:
faster dispatcher


Index: poe.tcl
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/poe.tcl,v
retrieving revision 1.1.2.2.2.2
retrieving revision 1.1.2.2.2.3
diff -C2 -d -r1.1.2.2.2.2 -r1.1.2.2.2.3
*** poe.tcl	6 Dec 2006 18:17:39 -0000	1.1.2.2.2.2
--- poe.tcl	6 Dec 2006 18:29:00 -0000	1.1.2.2.2.3
***************
*** 101,116 ****
  }
  
- # TODO: use {expand}
  set dispatch {
  	global _ __
! 	set methods {}; set ancestors {}; set class $_($self:_class); set self $self
! 	if {[info exists __($class:$selector)]} {
! 		set methods $__($class:$selector)
! 	} {
! 		#puts "self=$self class=$_($self:_class)"
! 		lookup_method $_($self:_class) $selector methods ancestors
  		set __($class:$selector) $methods
  	}
- 	set i 0
  	if {![llength $methods]} {
  		error "no such method '$selector' for object '$self'\nwith ancestors {[Class_ancestors $class]}"
--- 101,112 ----
  }
  
  set dispatch {
  	global _ __
! 	set i 0; set methods {}; set class $_($self:_class); set self $self
! 	if {[catch {set methods $__($class:$selector)}]} {
! 		set ancestors {}
! 		lookup_method $class $selector methods ancestors
  		set __($class:$selector) $methods
  	}
  	if {![llength $methods]} {
  		error "no such method '$selector' for object '$self'\nwith ancestors {[Class_ancestors $class]}"
***************
*** 118,127 ****
  }
  if {$tcl_version >= 8.5} {
! 	append dispatch {[lindex $methods $i] $self {expand}$args}
  } else {
! 	append dispatch {eval [concat [list [lindex $methods $i] $self] $args]}
  }
  proc setup_dispatcher {self} {
  	#puts "setup_dispatcher $self"
  	proc $self {selector args} [regsub -all {\$self} $::dispatch $self]
  	#puts [regsub -all {\$self} $::dispatch $self]
--- 114,124 ----
  }
  if {$tcl_version >= 8.5} {
! 	append dispatch {[lindex $methods 0] $self {expand}$args}
  } else {
! 	append dispatch {eval [concat [list [lindex $methods 0] $self] $args]}
  }
  proc setup_dispatcher {self} {
  	#puts "setup_dispatcher $self"
+ 	#puts [time {proc $self {selector args} [regsub -all {\$self} $::dispatch $self]}]
  	proc $self {selector args} [regsub -all {\$self} $::dispatch $self]
  	#puts [regsub -all {\$self} $::dispatch $self]