The ability to create New Control Structures, thereby extending the language, is one of the interesting features of Tcl.
RWT (with a lot of help from comp.lang.tcl) 2000-02-04:
uplevel command, which allows you to write a proc which executes code in the context of the caller, is the key.
For example, if we want to augment Tcl's standard for and while looping constructs with
do body while condition
we would simply write a do proc which executes the code in the caller's context. In its simplest form, it would look like this:
proc do {body condition} {
while 1 {
uplevel $body
if {![uplevel [list expr $condition]]} break
}
}We can make this a little more robust by specifying the exact number of levels to uplevel, which may prevent $body from being misinterpreted. We should also use list to construct the conditional command.
proc do {body condition} {
while 1 {
uplevel 1 $body
if {![uplevel 1 [list expr $condition]]} {break}
}
}Just to make things look prettier, we can add an extra argument to do that expects the word while. You could probably get fancy and make the while optional (like the else is optional for if ), but this should be good enough for our purposes.
proc do {body whileword condition} {
if {$whileword ne {while}} {
error "should be \"do body while condition\""
}
while 1 {
uplevel 1 $body
if {![uplevel 1 [list expr $condition]]} break
}
}This procedure does not handle errors well, though. For a good discussion of the issues involved, take a look at the exception handling chapter in John Ousterhout's book BOOK Tcl and the Tk Toolkit. But the primary issue is that we want to catch exceptional conditions when executing the $body, and correctly throw errors upwards. This error handling makes our new procedure really appear to be part of the language.
Recall that the error codes are
proc do {body whileword condition} {
global errorInfor errorCode
if {![string equal $whileword while]} {
error "should be \"do body while condition\""
}
while 1 {
set code [catch {uplevel 1 $body} message]
switch -- $code {
0 {}
1 {return -code error \
-errorinfo $::errorInfo \
-errorcode $::errorCode $message }
2 {return -code return $message}
3 return
4 {}
default {return -code $code $message}
}
if {![uplevel 1 [list expr $condition]]} break
}
}To make this really really really robust, you should consider adding the same error handling to the uplevel condition, but that is left as an exercise for the reader.
GPS 2003-10-08:
This is a conditional repeat:
proc repeat {cond time body} {
if !$cond return
uplevel #0 $body
after $time [info level 0]
} ;#GPS
repeat {[winfo exists .foo]} 1000 {puts [.foo get]} Another version of that which is easier to parse mentally is:
proc repeat {body _every_ time _until_ cond} {
if $cond return
uplevel #0 $body
after $time [info level 0]
} ;#GPS
repeat [list raise .rename .] every 1000 until {![winfo exists .rename]}GPS 2003-10-19: I was going through a Python tutorial and came upon this nice concise code:
if ok in ('y', 'ye', 'yes'): return 1I became curious about doing such a thing in Tcl, and I came up with this:
proc if.in.list {val list body} {
if {[lsearch $list $val] >= 0} {uplevel $body}
}Example usage:
% set v abc
abc
% if.in.list $v [list abc adef foo] {puts TRUE}
TRUEslebetman: I personally use plain if for this with the following two procs:
proc either {val args} {
if {[lsearch -exact $args $val] == -1} {return 0}
return 1
}
proc neither {val args} {
if {[lsearch -exact $args $val] == -1} {return 1}
return 0
}not really a control structure per se, just a sugar for if:
if {[either $answer y ye yes]} {puts TRUE}
if {[neither $ext .z .zip .gz .bz]} {error {Unsupported file type!}}I find this cleaner to read than regular lsearch. It's safe to not brace the above if since either and neither will never return something which requires substitution. Unless of course someone redefines them.
PYK 2014-05-29: That may be true, but with when the arguments to if are static values, i.e. braced, Tcl can bytecode the command, which greatly improves performance.
Larry Smith: I would suggest either be anyof and neither be noneof. either and neither are really only binary and use in a list expression is confusing.
RS: From Tcl 8.5, we can use the in operator of expr to code like this:
if {$v in {abc adef foo}} {puts TRUE}Googie: Here is a structure which I met in EPIC4 (IRC client) scripting language.
#"For Every Character"
proc fec {var string body} {
uplevel "
for {set fec 0} {\[string index [list $string] \$fec] != {}} {
incr fec} {
set [list $var] \[string index [list $string] \$fec]
$body
}
"
}PYK 2014-05-29: It would be more correct not to contaminate the next level up with $fec:
#"For Every Character"
proc fec {var string body} {
for {set fec 0} {[string index $string $fec] != {}} {incr fec} {
uplevel [list set $var [string index $string $fec]]
uplevel $body
}
}And then using split is likely more performant:
#"For Every Character"
proc fec {var string body} {
foreach char [split $string {}] {
uplevel [list set $var $char]
uplevel $body
}
}It uses uplevel to allow using other variables in body. Using example:
set validFlags abcde
set flagsToSet asdfghj
fec flag $flagsToSet {
if {[string first $flag $validFlags] == -1} {
puts "Invalid flag: $flag"
}
}RS (prior to comments of PYK above): Note however that the following is probably faster (and avoids quoting hell ;^):
foreach flag [split $flagsToSet {}] {...}NEM 2006-12-15: Writing new control structures is both difficult to get right, and also extremely useful when designing a program. Writing specialised, application-specific control structures can greatly improve the clarity of code and separation of concerns. For instance, if we are writing an NNTP newsreader application, a typical task would be to iterate over the new articles in some newsgroup and then perform some application-specific task on each one (e.g. displaying them, or storing them in a database). We could write this out directly using the facilities of the nntp package, explicitly looping over the articles and extracting each one. However, the problem with this is that we mix up the application code (displaying the articles) with the nntp code (retrieving the articles, iterating over them, fetching headers, dealing with network errors, etc). A clean way to separate this is to design a high-level specialised control structure for iterating over new articles in a newsgroup. Ideally, this would allow us to write our application code like the following:
foreachNewMsg {head body} [nntp::nntp $server $port] comp.lang.tcl {
puts [join $head \n]
puts "--------------------------------"
puts [join $body \n]
puts "================================"
}This new foreachNewMsg control structure deals with selecting the group, iterating over new messages, fetching the headers and body, and closing the connection when we are finished. It handles all network-related errors, and ensures that the connection is always closed. This means that our application code doesn't have to deal with any network-related errors, as they are handled for us. All we have to worry about is any errors in our application-specific code. Implementing this new control structure is moderately difficult, but the pattern is very similar for most such specific control constructs (e.g., something very similar is in the do procedure further up this page). In this version, we even handle things like break/continue in the loop:
proc foreachNewMsg {vars con group script} {
upvar 1 [lindex $vars 0] head [lindex $vars 1] body
lassign [$con group $group] num first last group
# Limit to 20 messages max
if {$last - $first > 20} {set first [expr {$last - 20}]}
for {set i $first} {$i <= $last} {incr i} {
if {![catch {$con head $i} head] &&
![catch {$con body $i} body]} {
switch -exact [catch {uplevel 1 $script} msg opts] {
0 {}
3 break
4 continue
default {
$con quit
return -options $opts $msg
}
}
}
}
$con quit
}Once you learn how to write this kind of custom control structure, it can really help to clean up your own code. See e.g. a higher-level channel API for a more complex example.
MJ: In the same vein as the example above, a structure that opens a file, executes a block on it and makes sure the file gets closed:
proc with-file {name var block} {
# name is the filename to open
# var will contain the file_handle and can be used in the block
# block will be executed in the current scope.
upvar $var file
set file [open $name]
set code [catch {uplevel 1 $block} res]
close $file
return -code $code $res
}iu2: Tcl and Lisp are similiar in this aspect, they both enable the core language's syntax extension. Here is a beautiful paragraph describing the Lisp way of programming, which, I think, applies also to Tcl (taken from Programming Bottom-Up , by Paul Graham, which has many other good essays, recommended):
"Experienced Lisp programmers divide up their programs differently. As well as top-down design, they follow a principle which could be called bottom-up design-- changing the language to suit the problem. In Lisp, you don't just write your program down toward the language, you also build the language up toward your program. As you're writing a program you may think "I wish Lisp had such-and-such an operator." So you go and write it. Afterward you realize that using the new operator would simplify the design of another part of the program, and so on. Language and program evolve together. Like the border between two warring states, the boundary between language and program is drawn and redrawn, until eventually it comes to rest along the mountains and rivers, the natural frontiers of your problem. In the end your program will look as if the language had been designed for it. And when language and program fit one another well, you end up with code which is clear, small, and efficient."
slebetman: It should be noted that while Lispers consider this sort of thing as changing the syntax, seasoned Tclers don't. The Tcl way sees these things as just another command. Indeed, Tcl's syntax doesn't do much: you can't define a function, you can't perform loops, you can't test conditions, you can't even assign a value to a variable using Tcl syntax! Tcl does all those things using commands (which may or may not be implementable using the proc command). In Tcl, when we talk about changing the syntax we usually mean something which modifies or adds to the endekalogue/dodekalogue.
rahulj: Is it simple that to design pause for loop. one loop is continuing execution and then user press some button(binded) and then resumes again on pressing someanother button. I am trying but no success.
NEM 2008-08-04: It's not impossible, but slightly tricky. In general, Tcl has no facility to interrupt an arbitrary computation and then restart it later on. However, if you structure the loop carefully, using the event loop then you can achieve something like this. What is the real problem you want to solve?
AMG: [uplevel] doesn't quite do everything that's needed for creating a new control structure in pure-Tcl. All it really does is override which set of variables its script argument has access to. If you could scan a script and know which variables it will access, you could reimplement [uplevel] using [upvar] and [eval].
My point is that [uplevel] only lets you get at a caller's variables. This can be very different than "running code in the caller". The chief example is [return], though also mind [break], [continue], [error], [throw], [tailcall], and possibly custom extension commands.
I have hit this issue many times, most recently when writing my version of forward-compatible dict. Many of the test failures my final version encountered were due to [return] and friends not propagating the correct number of levels.
A brief example will help. Here's wdb's contribution to the do..while page:
proc do {code while cond} {
uplevel 1 $code
uplevel 1 [list $while $cond $code]
}Here's a working example of its use:
proc good {i} {
do {
lappend result $i
incr i
} while {$i < 6}
return $result
}
good 0 ;# 0 1 2 3 4 5
good 1 ;# 1 2 3 4 5
good 2 ;# 2 3 4 5
good 3 ;# 3 4 5
good 4 ;# 4 5
good 5 ;# 5
good 6 ;# 6But this doesn't work:
proc bad {i} {
do {
if {$i & 2} {
return xxx
}
lappend result $i
incr i
} while {$i < 6}
return $result
}
bad 0 ;# want "xxx", get "0 1"
bad 1 ;# want "xxx", get "0 1"
bad 2 ;# want "xxx", get "can't read result: no such variable"
bad 3 ;# want "xxx", get "can't read result: no such variable"
bad 4 ;# want "4 5", get "4 5"
bad 5 ;# want "5" , get "5"
bad 6 ;# want "xxx", get "can't read result: no such variable"The problem is that the [return] command only causes [do] to return, not [bad].
So, what's the solution? [bad] works as expected if [do] is changed to this:
proc do {code while cond} {
tailcall try $code\n[list $while $cond $code]
}[tailcall try] are the magic words for making the caller actually do something, as opposed to merely playing games with variables. (You could say [eval] instead of [try], though with a performance penalty.)
But there's a price to be paid. Using [tailcall] terminates the current procedure and replaces it with its argument command line (which is a command prefix, not an arbitrary script, hence the need for [try] which serves as an adapter shim).
Obviously, this limits your ability to do stuff with the result of the script execution. You have to instead tell the caller to do all that. This isn't impossible, it's just tough. Appending [apply] to the script argument to [try] may be useful to do further work in a child stack frame with its own variables, but you have to see to it that it gets arguments reinitializing its local variables from whatever came before. Or you might set up a [coroutine], then use the [tailcall try] trick to tell your caller to do something and then pass the result to that coroutine for further processing.
That all seems like quite a lot of work to get around the fact that [uplevel] affects variables but not [return] and friends.
This is discussed elsewhere on the wiki: [L1 ], [L2 ].