Version 12 of ranged switch

Updated 2006-01-02 08:04:05

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 secondary 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)

}

---

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