Expected TCL: upvar vs namespace variable performance - namespaces

Is there an expected, by spec/implementation, difference between accessing namespace variables vs. upvar.
I have to use a call-back function. I cannot just pass an argument.Empirically, upvar wins. But is that expected, in all reasonable case?
Thanks.

Yes definitely. fully scoped reference is faster than upvar reference which is faster than variable reference.
To find-out, the command 'time' is your friend:
namespace eval toto {
proc cb_upvar {varname} {
upvar $varname var
incr var
}
proc cb_scoped {varname} {
incr $varname
}
proc cb_variable {varname} {
variable $varname
incr $varname
}
}
proc benchmark {cmd} {
set toto::totovar 1
time $cmd 100
puts -nonewline "[lindex $cmd 0] =>\t"
puts [time $cmd 20000000]
}
puts [info tclversion]
benchmark {toto::cb_scoped ::toto::totovar}
benchmark {toto::cb_variable totovar}
benchmark {toto::cb_upvar totovar}
Output:
toto::cb_scoped => 0.47478505 microseconds per iteration
toto::cb_variable => 0.7644891 microseconds per iteration
toto::cb_upvar => 0.6046395 microseconds per iteration
Rem: the huge number of iterations is required to get consistent result.

Related

What is faster to execute - expr or if

I am looking at the possibility of optimizing the execution of some of my existing code using ternary operators in single command containing if and else blocks.
Is the ternary operator approach faster than the traditional if / else e.g which is faster to execute of the following:
First:
expr {[info exists arr($var)]? [return $_timeouts($var)] : [puts "No key $var has been set"]}
Second:
if {[info exists arr($var)]} {
[return $_timeouts($var)]
} else {
puts "No key $var has been set"
}
Notice that the entire expr in the ternary operator approach (First) is contained in a single {} block and I am hoping this will be faster to execute than the Second approach.
Thanks
You can use the built-in time command to test your question.
I changed 'puts' to a different 'return' statement so that the speed of a variable that exists in the array could be directly compared to the speed of a variable that does not exist in the array.
variable arr
proc test1 { var } {
variable arr
expr {[info exists arr($var)] ? [return $arr($var)] : [return -1]}
}
proc test2 { var } {
variable arr
if { [info exists arr($var)] } {
return $arr($var)
} else {
return -1
}
}
proc init { } {
variable arr
# fill arr with stuff...
for {set i 0} {$i < 10000} {incr i} {
set arr($i) $i
}
}
init
puts [time {test1 9000} 10000]
puts [time {test1 15000} 10000]
puts [time {test2 9000} 10000]
puts [time {test2 15000} 10000]
The results on my machine:
bll-tecra:bll$ tclsh t.tcl
1.3121 microseconds per iteration
1.0267 microseconds per iteration
1.1399 microseconds per iteration
0.9029 microseconds per iteration
So using expr is a bit slower. In this case, the more readable code is definitely a win.
The speed difference is pretty small. If this small of a difference is affecting your program, I also recommend trying this code with a dictionary rather than a array and check the speed differences.

how do I update a variable via a tk window by name

Consider the following situation:
namespace eval ::mydialog {}
proc ::mydialog::show {w varName args} {
upvar 1 $varName theVar
# now I can access theVar
# (1)
# code defining/creating my window
# here some widgets for user interaction are created,
# some of which will call ::mydialog::_someCallback
wm protocol $w WM_DELETE_WINDOW [list ::mydialog::close $w]
}
proc ::mydialog::_someCallback {} {
# how do I access theVar here?
# (2)
}
proc ::mydialog::close { w } {
# here some changes are supposed to be written back into varName in the calling scope,
# how do I do that?!
# (3)
destroy $w
}
Im trying to figure out how to (a) get a variable from the calling scope (b) have it available in all three procs and (c) writing any changes back into said variable.
(a) I would normally solve using 'upvar 1 $varName theVar'
(b) I would normally solve with a namespace variable
(c) As long as we only have one proc that would happen automaticly with (a) due to the fact that we would be working on a local alias of that variable
The problem is that upvar only works (at least as intended) in (1).
I could use upvar in (1) and save/copy into a namespace variable, that would solve (a) and (b), but not (c).
I would be gratefull if someone could point me in the right direction here.
Also, as I'm relativly new to Tcl/Tk my concept might not be ideal, suggestions toward a better design are welcome too.
I suggest you use a namespace variable that keeps the name of the variable, and upvar using the global scope.
namespace eval ::mydialog {
variable varName
}
proc ::mydialog::show {w _varName args} {
variable varName $_varName
upvar #0 $varName theVar
}
proc ::mydialog::_someCallback {} {
variable varName
upvar #0 $varName theVar
puts $theVar
}
proc ::mydialog::close { w } {
variable varName
upvar #0 $varName theVar
set theVar newval
}
set globalvar oldval
# => oldval
::mydialog::show {} globalvar
::mydialog::_someCallback
# => oldval
::mydialog::close {}
# => newval
puts $globalvar
# => newval
Note that the syntax highlighting fails: #0 $varName theVar isn't really a comment.
This works with namespace variables too: if you have a variable called nsvar in the ::foobar namespace you can use it like this:
set ::foobar::nsvar oldval
::mydialog::show {} ::foobar::nsvar
::mydialog::_someCallback
::mydialog::close {}
puts $::foobar::nsvar
with the same effects.
You can't, however, use variables local to some procedure this way.
One way to make this really simple is to use Snit widgets instead of collections of Tcl procedures.
Documentation: namespace, proc, puts, set, upvar, variable
Snit documentation: man page, faq (the faq serves as a kind of introduction as well)

How do you list all the namespaces in an instance of TCL?

How do you list all the namespaces loaded in an instance of tclsh?
Chenz
Try running this proc from the TCLer's Wiki
proc listns {{parentns ::}} {
set result [list]
foreach ns [namespace children $parentns] {
eval lappend result [listns $ns]
lappend result $ns
}
return $result
}
When I run it, I get the following output:
% listns
::platform ::activestate::teapot::link ::activestate::teapot ::activestate ::tcl
::clock ::tcl::info ::tcl::dict ::tcl::tm ::tcl::mathop ::tcl::unsupported ::tcl
::mathfunc ::tcl::chan ::tcl::string ::tcl
%
So, to get ALL namespaces, you simply need to do this:
set all_namespaces [concat [listns] "::"]

Expanded TCL interpreter in TCL

I have implemented many TCL extensions for a specific tool in the domain of formal methods (extensions are implemented in C but I do not want solution to rely on this fact). Thus, the users of my tool can use TCL for prototyping algorithms. Many of them are just linear list of commands (they are powerfull), e.g.:
my_read_file f
my_do_something a b c
my_do_something_else a b c
Now, I am interested in timing. It is possible to change the script to get:
puts [time [my_read_file f] 1]
puts [time [my_do_something a b c] 1]
puts [time [my_do_something_else a b c] 1]
Instead of this I want to define procedure xsource that executes a TCL script and get/write timing for all my commands. Some kind of a profiler. I wrote a naive implementation where the main idea is as follows:
set f [open [lindex $argv 0] r]
set inputLine ""
while {[gets $f line] >= 0} {
set d [expr [string length $line] - 1]
if { $d >= 0 } {
if { [string index $line 0] != "#" } {
if {[string index $line $d] == "\\"} {
set inputLine "$inputLine [string trimright [string range $line 0 [expr $d - 1]]]"
} else {
set inputLine "$inputLine $line"
set inputLine [string trimleft $inputLine]
puts $inputLine
puts [time {eval $inputLine} 1]
}
set inputLine ""
}
}
}
It works for linear list of commands and even allows comments and commands over multiple lines. But it fails if the user uses if statements, loops, and definition of procedures. Can you propose a better approach? It must be pure TCL script with as few extensions as possible.
One way of doing what you're asking for is to use execution traces. Here's a script that can do just that:
package require Tcl 8.5
# The machinery for tracking command execution times; prints the time taken
# upon termination of the command. More info is available too (e.g., did the
# command have an exception) but isn't printed here.
variable timerStack {}
proc timerEnter {cmd op} {
variable timerStack
lappend timerStack [clock microseconds]
}
proc timerLeave {cmd code result op} {
variable timerStack
set now [clock microseconds]
set then [lindex $timerStack end]
set timerStack [lrange $timerStack 0 end-1]
# Remove this length check to print everything out; could be a lot!
# Alternatively, modify the comparison to print more stack frames.
if {[llength $timerStack] < 1} {
puts "[expr {$now-$then}]: $cmd"
}
}
# Add the magic!
trace add execution source enterstep timerEnter
trace add execution source leavestep timerLeave
# And invoke the magic, magically
source [set argv [lassign $argv argv0];set argv0]
# Alternatively, if you don't want argument rewriting, just do:
# source yourScript.tcl
Then you'd call it like this (assuming you've put it in a file called timer.tcl):
tclsh8.5 timer.tcl yourScript.tcl
Be aware that this script has a considerable amount of overhead, as it inhibits many optimization strategies that are normally used. That won't matter too much for uses where you're doing the real meat in your own C code, but when it's lots of loops in Tcl then you'll notice a lot.
You can wrap your commands which you want to measure. And name wrappers exactly as the original ones (renaming original procs before). After that, when instrumented command is executed it actually executes the wrapper, which executes the original procedure and measure the time of execution. The example below (Tcl 8.5).
proc instrument {procs} {
set skip_procs {proc rename instrument puts time subst uplevel return}
foreach p $procs {
if {$p ni $skip_procs} {
uplevel [subst -nocommands {
rename $p __$p
proc $p {args} {
puts "$p: [time {set r [__$p {*}\$args]}]"
return \$r
}
}]
}
}
}
proc my_proc {a} {
set r 1
for {set i 1} {$i <= $a} {incr i} {
set r [expr {$r * $i}]
}
return $r
}
proc my_another_proc {a b} {
set r 0
for {set i $a} {$i <= $b} {incr i} {
incr r $i
}
return $r
}
instrument [info commands my_*]
puts "100 = [my_proc 100]"
puts "200 = [my_proc 100]"
puts "100 - 200 = [my_another_proc 100 200]"
You might want to look at the command "info complete". It can tell you if what you have accumulated so far looks complete from the point of view of most common Tcl syntax markers. It will deal with command input that might be spread across multiple physical lines.

Tcl Anonymous Functions

A Purely theoretical question on Tcl.
Following this question I was thinking on what would be the best way to implement anonymous functions in Tcl.
The end result should be allowing a developer to pass a full proc as an argument to anohter proc:
do_something $data {proc {} {input} {
puts $input;
}};
which would be similar to javascript's
do_something(data, function (input) {
alert(input);
});
now, naturally this will not work OOTB. I was thinking on something of this sort:
proc do_something {data anon_function} {
anon_run $anon_function $data
}
proc anon_run {proc args} {
set rand proc_[clock clicks];
set script [lreplace $proc 1 1 $rand];
uplevel 1 $script;
uplevel 1 [concat $rand $args];
uplevel 1 rename $rand {}; //delete the created proc
}
This works. But I was hoping to get suggestions for a better pattern then this, as it's not very elegant and not really using cool Tcl features. Mostly I'd like to get rid of manually calling anon_run.
In Tcl 8.5, you can use the apply command.
proc do_something {data anon_function} {
apply $anon_function $data
}
do_something $data {{input} {
puts $input
}}
Of course, if you're structuring your callbacks as command prefixes (recommended!) then you can do this:
proc lambda {arguments body} {
# We'll do this properly and include the optional namespace
set ns [uplevel 1 namespace current]
return [list ::apply [list $arguments $body $ns]]
}
proc do_something {data command} {
{*}$command $data
}
do_something $data [lambda {input} {
puts $input
}]
If you're using 8.4 or before, you need the code from the Tcler's Wiki as a substitute, but be aware that those solutions are only semantically equivalent (at best); they're not performance-equivalent.