proc redefaultProc {procn argn value} {
set argl {}
foreach arg [info args $procn] {
if [info default $procn $arg default] {
if {$arg==$argn} {set default $value}
lappend argl [list $arg $default]
} else {
lappend argl $arg
}
}
proc $procn $argl [info body $procn]
}With this tool in hand, we can proceed to write static, a command that somehow resembles a C "declaration", but actively registers arguments as "static", i.e. installs a write trace so every time the variable is changed, the proc definition is rewritten (for performance, don't assign to it too often!): proc static args {
set caller [lindex [info level -1] 0]
foreach arg $args {
uplevel 1 [list trace var $arg w [list staticTrace $caller]]
}
}
# ... and the trace proc, which only serves to ignore 'el' and 'op':
proc staticTrace {caller name el op} {
upvar 1 $name var
redefaultProc $caller $name $var
}..and now testing the whole thing. Note that a static variable needs also to be written into the proc argument list with a default value to start with: proc x {y {z 0}} {
static z
puts [incr z]:$y
}
% x hello
1:hello
% x world
2:worldLooks like we made it - proc x has a "counter" z that remembers how often it was called before, but you can reset it explicitly (as the call to x pre-increments, use -1 to start next time with a 0 counter):% x reset -1 0:reset % x test 1:testStatic variables need not be numbers, for instance this example shows that it always remembers the previous call's argument (any string):
proc lookback {now {before {}}} {
static before
puts $before->$now
set before $now
}And intgen can now be rewritten like this: proc intgen {{seed 0}} {static seed; incr seed}Ulrich Schoebel 2002-10-09 - Another way to implement static variables without a need for traces is to use a reserved namespace (in this example ::StaticVariables) for their storage. This handles scalar and array variables. The variable names must not contain namespace qualifiers (why should they?).
proc static {args} {
set ns ::StaticVariables
append ns [string trimright [uplevel 1 namespace current] :]
append ns :: [namespace tail [lindex [info level -1] 0]]
foreach var $args {
if {![string equal [namespace tail $var] $var]} {
return -code error -errorinfo "Static variable $var has namespace qualifiers"
}
# if {![info exists ${ns}::$var]} {
namespace eval $ns [list variable $var] ;# (1)
# }
uplevel 1 upvar #0 ${ns}::$var $var
}
}This proc is completely sufficient as long as you don't rename the proc using static variables. If you need renaming, add the following: rename rename _rename
proc rename {old new} {
set ns ::StaticVariables
append ns [string trimright [uplevel 1 namespace current] :]
append nso $ns :: [string trimleft $old :]
if {[string length $new] == 0} {
foreach var [info vars ${nso}::*] {
catch {unset $var}
}
_rename $old ""
return ""
}
append nsn $ns :: [string trimleft $new :]
foreach var [info vars ${nso}::*] {
if {![catch {set $var} value]} {
namespace eval $nsn [list set [namespace tail $var] $value]
} elseif {[array exists $var]} {
namespace eval $nsn [list array set [namespace tail $var] [array get $var]]
}
catch {unset $var}
}
_rename $old $new
}USRS: A good alternative! But I think the existence check marked at (1) above is not needed; redeclaring an existing variable can't hurt.US: I agree. Haven't read the man page thoroughly enough. Commented check.RHS The following works also:
namespace eval ::localvars {}
proc static {varName args} {
if {![string equal [namespace tail $varName] $varName]} {
return -code error \
"static variables may not contain namespace qualifiers"
}
set procName [lindex [info level -1] 0]
namespace eval ::localvars [list variable [list $procName $varName]]
uplevel 1 [list upvar ::localvars::[list $procName $varName] $varName]
switch -exact -- [llength $args] {
0 { }
1 {
set ::localvars::[list $procName $varName] [lindex $args 0]
}
default {
return -code error \
"wrong # args: should be \"local varName ?value\""
}
}
trace add command $procName delete \
[list ::localvars::renameCallback $varName]
trace add command $procName rename \
[list ::localvars::renameCallback $varName]
}
proc ::localvars::renameCallback {var oldname newname op} {
switch -exact -- $op {
delete {
unset ::localvars::[list $oldname $var]
}
rename {
set old ::localvars::[list $oldname $var]
set new ::localvars::[list $newname $var]
set $new [set $old]
unset $old
}
default {
error "Unexpected op $op to localnames::renameCallback"
}
}
}The code and tests for the above can be found at http://robert.rkseeger.net/tcl
Zarutian: 10. may 2005: an other way would be putting a execute trace on the procedure which updates the defaults to the procedure.Zarutian: 6. june 2005: sorry I have been a little bit busy.
package require Tcl 8.4
proc proc_with_staticVars {name args staticVars body} {
set staticVarsWithValues [list]
foreach item $staticVars {
if {[llength $item] == 2} {
lappend staticVarsWithValues $item
} elseif {[llength $item] == 1} {
upvar $item tmp
lappend staticVarsWithValues [list $item $tmp]
}
}
set old_args $args
foreach item $staticVarsWithValues {
lappend args $item
}
lappend args [list old_args $args]
proc $name $args $body
trace add execution $name leave saveStaticVars
}
proc saveStaticVars args {
set op [lindex $args end]
set command_string [lindex $args 0]
set proc_name [lindex $command_string 0]
if {$op == "leave"} {
set vars [uplevel 1 [list info locals]]
set varsAndValues [list]
set old_args {}
foreach item $vars {
upvar $item tmp
if {$item == "old_args"} {
set old_args $tmp
} else {
lappend varsAndValues [list $item $tmp]
}
}
set args [list]
foreach item $old_args { lappend args $item }
foreach item $varsAndValues { lappend args $item }
proc $proc_name $args [info body $proc_name]
}
}Should work nowZarutian 2. june 2008: but it doesnt as saveStaticVars gets invoked after the command it is trace has returned and destoryed its callframe.RS 2005-05-11: Here's how I would reimplement the namespace-based solution these days - rename at your own risk (statics will be reset to initial values then):
namespace eval ::static {}
proc static {name {value ""}} {
set caller [lindex [info level -1] 0]
namespace eval ::static::$caller {}
set qname ::static::${caller}::$name
if {![info exists $qname]} {set $qname $value}
uplevel 1 [list upvar #0 $qname $name]
}
#-- Testing:
proc intgen {} {
static i 0
incr i
}
% intgen
1
% intgen
2
% intgen
3See Streams for many usage examples of static variables (and another intgen variation) - Closures - static data in command procedures
Inspired by the use of namespaces in jimulation by RS here is another version of the namespace-based solution (and another intgen variation) posted by kruzalex
proc static {name {value 0}} {
set caller [lindex [info level -1] 0]
set qname ::static::${caller}
if {![info exists ${qname}::$name]} {
foreach var [list [lrange [info level 0] 1 end]] {
if {[llength $var]==1} {lappend var $value}
namespace eval $qname [linsert $var 0 variable]
}
}
uplevel 1 [list upvar 0 ${qname}::$name $name]
}
#-- Testing:
proc intgen {} {
static i 0
incr i
}
% intgen
1
% intgen
2
% intgen
3AMG: See sproc for my implementation of static variables.
RLE gave a very nice example of pseudo-statics on Playing Scheme:
proc intgen {{i 0}} {
proc intgen "{i [incr i]}" [info body intgen]
return $i
}