pd/src poe.tcl,1.1.2.2,1.1.2.2.2.1 - Pd-cvs

6 Dec 2006


      Update of /cvsroot/pure-data/pd/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv19606
Modified Files:
      Tag: desiredata
    poe.tcl 
Log Message:
Tcl 8.5 specific speedup using {expand}
Index: poe.tcl
===================================================================
RCS file: /cvsroot/pure-data/pd/src/Attic/poe.tcl,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.2.2.1
diff -C2 -d -r1.1.2.2 -r1.1.2.2.2.1
*** poe.tcl	19 Nov 2006 05:59:13 -0000	1.1.2.2
--- poe.tcl	6 Dec 2006 08:46:06 -0000	1.1.2.2.2.1
***************
*** 87,90 ****
--- 87,91 ----
  }
+ # TODO: remove duplicates in lookup
  proc lookup_method {class selector methodsv ancestorsv} {
    global _
***************
*** 98,104 ****
rename unknown unknown2
! # TODO: remove duplicates in lookup
! # TODO: cache lookup for greater speed
! proc unknown {args} {
    global _ __
    set self [lindex $args 0]
--- 99,104 ----
rename unknown unknown2
! # TODO: use {expand}
! set unknown {
    global _ __
    set self [lindex $args 0]
***************
*** 118,133 ****
    set i 0
    if {![llength $methods]} {
! 		set ancestors [Class_ancestors $class]
! 		error "no such method '$selector' for object '$self'\nwith ancestors {$ancestors}"
    }
- 	eval [concat [list [lindex $methods $i] $self] [lrange $args 2 end]]
  }
! proc super {args} {
    upvar 2 methods methods self self i oi
! 	set i [expr 1+$oi]
    if {[llength $methods] < $i} {error "no more supermethods"}
- 	eval [concat [list [lindex $methods $i] $self] $args]
  }
class_new Thing {}
--- 118,142 ----
    set i 0
    if {![llength $methods]} {
! 		error "no such method '$selector' for object '$self'\nwith ancestors {[Class_ancestors $class]}"
    }
  }
+ if {$tcl_version >= 8.5} {
+ 	append unknown {[lindex $methods $i] $self {expand}[lrange $args 2 end]}
+ } else {
+ 	append unknown {eval [concat [list [lindex $methods $i] $self] [lrange $args 2 end]]}
+ }
+ proc unknown {args} $unknown
! set super {
    upvar 2 methods methods self self i oi
! 	set i [expr {1+$oi}]
    if {[llength $methods] < $i} {error "no more supermethods"}
  }
+ if {$tcl_version >= 8.5} {
+ 	append super {[lindex $methods $i] $self {expand}$args}
+ } else {
+ 	append super {eval [concat [list [lindex $methods $i] $self] $args]}
+ }
+ proc super {args} $super
class_new Thing {}