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]