Version 15 of ranged switch

Updated 2006-01-18 03:47:32

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
 no

Due 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)
 }

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>}
 }

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>}
 }

---

Arts and crafts of Tcl-Tk programming | Category Control Structure