Version 2 of breakeval

Updated 2006-07-10 04:05:35

The following originally lived on the return page, but was moved there to simplify referring to it.

It is sometimes a nuisance that break is restricted to breaking out of the innermost loop, since it is sometimes necessary break out of multiple loops that are nested. One could imagine variants of break that break out of the two innermost loops, or the three innermost loops, but there is a more general (and powerful) solution to the problem: a break-like command that breaks out of the innermost loop and then evaluates a script (which could contain another break or the like). The break-like command is easy to implement using [return -code]:

 proc breakeval {script} {return -code 10 $script}

but the problem is to make the loop commands pay attention to this. The core loop commands do not. It is possible to define variants of for, foreach, etc. which catch a return code of 10 (or whatever one uses), but it is simpler to define a command "wrapper" that only handles this return code and lets the core command do everything else.

 proc breakeval-aware {args} {
    set code [catch [list uplevel 1 $args] res]
    if {$code==10} then {
       set code [catch [list uplevel 1 $res] res]
    }
    return -code $code -errorinfo $::errorInfo -errorcode $::errorCode $res
 }

With these commands, the effect of

 for {set i 0} {$i<4} {incr i} {
    breakeval-aware for {set j 0} {$j<4} {incr j} {
       puts stdout "$i,$j"
       if {$i*$j>1} then {
          # This breaks out of both loops
          breakeval {break}
       }
    }
    puts stdout "Completed i=$i"
 }

will be to print

 0,0
 0,1
 0,2
 0,3
 Completed i=0
 1,0
 1,1
 1,2

on stdout. If one instead says

 for {set i 0} {$i<4} {incr i} {
    breakeval-aware for {set j 0} {$j<4} {incr j} {
       puts stdout "$i,$j"
       if {$i*$j>1} then {
          # This breaks out of the inner loop
          # and continues the outer
          breakeval {continue}
       }
    }
    puts stdout "Completed i=$i"
 }

then the result will be

 0,0
 0,1
 0,2
 0,3
 Completed i=0
 1,0
 1,1
 1,2
 2,0
 2,1
 3,0
 3,1

This kind of thing is great for testing conditions like "for all a in A there exists some b in B such that for all c in C the condition P(a,b,c) holds". The procedure for that particular combination of quantifiers is

 proc test_P {A B C} {
    foreach a $A {
       breakeval-aware foreach b $B {
          breakeval-aware foreach c $C {
             if {![P $a $b $c]} {breakeval {continue}}
          }
          breakeval {continue}
       }
       return 0
    }
    return 1
 }

The only problem in this game (writing scripts that use return codes other than the standard 0-4) is that strange things are likely to happen if a single return code is used to mean two different things (presumbaly by two different control structures). Perhaps there should be some kind of informal registration? In that case, return seems to be a good place to collect nonstandard return codes. /Lars H


See also forall for another take at this task, with nested procs and only regular return codes.


Duoas (9 July 2006) adds his simple version, which simply allows you to specify the number of levels to break or continue. Simply preface the loop command with the new 'do command:

 proc f n {
   set y 4
   while {[incr y -1]} {
     do foreach x {a b c d e f} {
       do for {set cntr 0} {$cntr < 5} {incr cntr} {
         if {$cntr > 2} {break $n}
         puts "$x $cntr"
         }
       }
     puts $y
     }
   puts {all done}
   }

 f 0  ;# lists the full gauntlet
 f 1  ;# same as the normal 'break'
 f 2  ;# breaks to the 'while' loop
 f 3  ;# breaks to 'all done'
 f 4  ;# too-big numbers are ignored since the 'while' loop is not prefaced with 'do'

Here's the module:

 # do.tcl

 namespace eval ::do:: {
   variable breaklevel 0
   package provide do 1.0
   }

 rename break tcl.break
 proc break {{level 1}} {
   if {$level <= 0} return
   set ::do::breaklevel [incr level -1]
   return -code break
   }

 rename continue tcl.continue
 proc continue {{level 1}} {
   if {$level <= 0} return
   set ::do::breaklevel [expr {-$level +1}]
   return -code continue
   }

 proc do args {
   set result [uplevel 1 [list eval $args]]
   if {$::do::breaklevel == 0} {return $result}
   if {$::do::breaklevel > 0} {
     incr ::do::breaklevel -1
     return -code break
     }
   incr ::do::breaklevel
   return -code continue
   }

 # end do.tcl

[ Category Control Structure | Category Command ]