Richard Suchenwirth 2005-12-19 - As an example for custom control structures in Tcl, here is a range-aware lookalike to switch. A range (numeric or strings) can be given as from..to, and the associated scriptlet gets executed if the tested value lies inside that range. Like in switch, fall-through collapsing of several cases is indicated by "-", and "default" as final condition fires if none else did. Different from switch, numbers are compared by numeric value, no matter whether given as decimal, octal or hex.
proc rswitch {value body} {
set go 0
foreach {cond script} $body {
if {[regexp {(.+)\.\.(.+)} $cond -> from to]} {
if {$value >= $from && $value <= $to} {incr go}
} else {
if {$value == $cond} {incr go}
}
if {$go && $script ne "-"} { #(2)
uplevel 1 $script
break
}
}
if {$cond eq "default" && !$go} {uplevel 1 $script} ;#(1)
}Testing:
% foreach i {0 1 2 3 4 5 6 7 8} {puts $i;rswitch $i {1 {puts yes} 2..5 {puts maybe} 6..8 {puts no}}}
0
1
yes
2
maybe
3
maybe
4
maybe
5
maybe
6
no
7
no
8
noDue to polymorphic comparison (numeric or string), this also works:^)
% foreach i {A K c z 0 7} {
puts $i;rswitch $i {A..Z {puts upper} a..z {puts lower} 0..9 {puts digit}}
}
A
upper
K
upper
c
lower
z
lower
0
digit
7
digit
% rswitch 0x2A {42 {puts magic} default {puts df}}
magic* Ok, that's useful stuff.. but what about multi-digit numbers? -- Sy / jrandomhacker.info e.g., using:
rswitch 100 {A..Z {echo upper} a..z {echo lower} 0..999 {echo digit}}RS Yup, my bug. ".." in regular expressions match any char, so the original version
if {[regexp (.+)..(.+) $cond -> from to]} {was over-eager - in 0..99, it matched "0." as from, and "9" as to. Fixed above, so multi-digit numbers work (and added a line for default treatment at #(1)). Another enhancement at #(2) is fall-through treatment (a - b - c ...} just like in switch. Thanks for testing!
JAK Try this version to allow the "alternate" switch syntax:
proc rswitch {value args} {
set go 0
if {[llength $args] == 1 } {
set body [concat $args]
} else {
set body [list $args]
}
foreach {cond script} [join $body] {
if {[regexp {(.+)\.\.(.+)} $cond -> from to]} {
if {$value >= $from && $value <= $to} {incr go}
} else {
if {$value == $cond} {incr go}
}
if {$go && $script ne "-"} { #(2)
uplevel 1 $script
break
}
}
if {$cond eq "default" && !$go} {uplevel 1 $script} ;#(1)
}
Sy adds:
Ok, so with the first rswitch I can do great things like:
rswitch $variable {
3..19 {# <perform action here>}
20..30 {# <perform action here>}
}However, I cannot do this and have both items fire off:
rswitch $variable {
3..19 {# <perform action here>}
15..19 {# <perform action here>}
}PWQ 17 Mar 06, My feeling is that having a regexp et al inside a control structure is not efficient. This is due to untcl like use of n...n, should be not push for a tcl like syntax of {min max}.
Also one note about comments within the code that uses a ranged switch:
rswitch $variable {
# This is not a good place for a comment
3..19 {# <perform action here>;# In here is a good place for a comment}
15..19 {# <perform action here>}
}RS: (1) Multiple evaluation: normal switch doesn't do that either
switch a {a - b {puts hello} a - c {puts world} default {puts nix}}
helloBut you might try just commenting out the break above... (2) Comments in Tcl are tricky sometimes. You are safe only if the # is at the first position where a command is expected, and no unbalanced braces till end-of-line... Original switch has the same feature:
proc try x {
switch -- $x {
# This is not a comment
a {puts hello}
b {puts world}
}
}
% try #
invalid command name "This"
% try is
invalid command name "not"
% try a
invalid command name "comment"As you can see, "#", "is", "a" are taken as cases, and the following word is the associated body.
proc try x {
switch -- $x {
# {#This is a comment}
a {puts hello}
b {puts world}
}
}
% try #TR - A general approach would also include arbitrary expressions as 'patterns'. You can easily do things like
set myVar 2.5
switch 1 \
[expr {$myVar<3 && $myVar>0}] {set res "smaller then 3, but positive"} \
[expr {$myVar <= 0}] {set res "smaller or equal zero"} \
[expr {$myVar==3}] {set res "equal 3"} \
[expr {$myVar > 3}] {set res "greater than 3"}
puts "$myVar is $res"Putting this into a nice little proc could look like this:
proc exprSwitch {switches} {
#
# a switch command using 'expr'-essions instead of patterns:
#
# switches -> an even list consisting of:
# 1. expressions to test
# 2. bodies to execute, if expression is true
#
# Returns: the result of the evaluation of the body
#
set l [llength $switches]
if {$l % 2 != 0} {return -code error "exprSwitch: extra switch without body"}
set count 0
foreach {expr body} $switches {
incr count 2
if {$expr eq "default" && $count == $l} {
return [uplevel 1 $body]
}
if {[uplevel 1 [list expr $expr]]} {return [uplevel 1 $body]}
}
}and the above example would become:
set myVar 2.5
exprSwitch {
{$myVar<3 && $myVar>0} {set res "smaller then 3, but positive"}
{$myVar <= 0} {set res "smaller or equal zero"}
{$myVar==3} {set res "equal 3"}
{$myVar > 3} {set res "greater than 3"}
}
puts "$myVar is $res"This is quite handy if you have ranges of real numbers or more complicated expressions that need to be distinguished.
Lars H: Isn't that just if with less syntactic sugar? An alternative implementation is
proc exprSwitch2 {switches} {
set cmd ""
foreach {expr body} $switches {lappend cmd elseif $expr then $body}
uplevel 1 [lreplace $cmd 0 0 ::if]
}Arts and crafts of Tcl-Tk programming | Category Control Structure