breakeval

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 edit

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

Tests

 f 0  ;# breaks zero times (no break occurs)
 f 1  ;# breaks once; same as the normal 'break'
 f 2  ;# breaks twice; breaks to the 'while' loop
 f 3  ;# breaks three times; breaks to 'all done'
 f 4  ;# too-big numbers are ignored since the 'while' loop is not prefaced by '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

[Fabien] - 2016-05-25 00:47:33

I've made this function for my own needs, it could be useful for others. (sorry if there are some human language mistakes, I'm not native English speaker)

proc f_nestedLoopsCtrl {{code ""} {depth ""}} {
   if {![string is space "$code $depth"]} {
   ##loop init. Call takes two args.
        if {[info exists ::nestedLoopsCtrlValues]} {
           set A [lindex $::nestedLoopsCtrlValues 0]
           set B [lindex $::nestedLoopsCtrlValues 1]
           if {$A != 0 && $B != 0} {
              ##this should never happen 
              return -code 1 "[info level 0] : loop ctrl inconsistency\
              : state is \"$A $B\", should be \"0 0\".\nFormer loop\
              count out of range or loop ctrl point missing?"
           }
        }
        set C "$code"
        set D "$depth"
        if {"$C" == "3"} {set C break}
        if {"$C" == "4"} {set C continue}
        if {"$C" != "break" && "$C" != "continue"} {
           return -code 1 "[info level 0] : wrong arg \"code $C\""
        }
        if {![string is digit -strict "$D"]} {
           return -code 1 "[info level 0] : wrong arg \"depth $D\""
        }
        if {$D == 0} {
           return -code 1 "[info level 0] : wrong arg \"depth $D\"\
           : loop count out of range" 
        }
        if {$D == 1} {
           set ::nestedLoopsCtrlValues [list 0 0]
           return -code $C
        }
        incr D -1
        set ::nestedLoopsCtrlValues [list $C $D]
        return -code break
   } else {
   ##loop state ctrl point. Call takes no arg.
        if {![info exists ::nestedLoopsCtrlValues]} {
           set ::nestedLoopsCtrlValues [list 0 0]
        }
        set C [lindex $::nestedLoopsCtrlValues 0]
        set D [lindex $::nestedLoopsCtrlValues 1]
        if {$C == 0 && $D == 0} {return}
        incr D -1
        if {$D > 0} {
           set ::nestedLoopsCtrlValues [list $C $D]
           return -code break
        }
        set ::nestedLoopsCtrlValues [list 0 0]
        return -code $C
   }

 #####
 f_nestedLoopsCtrl:
 a function that emulates 'break n' and 'continue n'
 surprisingly missing in Tcl.
 usage example:

 foreach a {list1} {
    ...
    foreach b {list2} {
       ...
       if {some condition} {f_nestedLoopsCtrl continue 2}
       if {some condition} {f_nestedLoopsCtrl break 2}
       ...
    }
    f_nestedLoopsCtrl
    ...
 }

 #####

}

Some tests and comments below

tested with Tcl 8.6

proc nestedLoopsCtrlDemo {} {
while 1 {
   incr count3
   puts "C $count3"
   #if {$count3 == 3} {puts "next nested loop"; break} ;##OK - same as next line
   if {$count3 == 3} {
        puts "C $count3 loopCtrl break - next nested loop"
        f_nestedLoopsCtrl break 1 ;##OK
   }
   
   while 1 {
        incr count2
        set count1 0
        puts "B $count2"
        #if {$count2 == 2} {puts "B loopCtrl break"; f_nestedLoopsCtrl break 1} ;##OK

        while 1 {
           incr count1
           after 300
           puts "A $count1"
           if {$count1 == 5} {
                puts "A $count1 loopCtrl continue 3"; set count1 0
                f_nestedLoopsCtrl continue 3 ;##OK
                #f_nestedLoopsCtrl continue 4 ;##ERROR
           }
        }
        ##next line for demonstration purpose only
        puts "B ::nestedLoopsCtrlValues: $::nestedLoopsCtrlValues"
        f_nestedLoopsCtrl ;##ERROR if missing
   }
   ##next line for demonstration purpose only
   puts "C ::nestedLoopsCtrlValues: $::nestedLoopsCtrlValues" ;##there should be no code here
   #if {$count3 == 2} {puts "next nested loop"; break} ;##next nested loop ERROR
   f_nestedLoopsCtrl
}

while 1 {
   incr count3
   puts "F $count3"
   if {$count3 == 6} {puts "loops' end"; break}

   while 1 {
        incr count2
        set count1 0
        puts "E $count2"

        while 1 {
           incr count1
           after 300
           puts "D $count1"
           if {$count1 == 5} {
                puts "D $count1 loopCtrl"; set count1 0
                f_nestedLoopsCtrl continue 3
                ##next line triggers an UNDETECTED ERROR on next foreach x {a b c}... loop
                #f_nestedLoopsCtrl continue 4 ;##increase value to 5 or 6 for wider effect
                ##Beware that loop ctrl point can't catch such out of range errors, it only
                ##decreases depth by one, breaks, and applies code when value is 0.
                ##So don't rely totaly on f_nestedLoopsCtrl errors return capabilities.
           }
        }
        f_nestedLoopsCtrl
   }
   f_nestedLoopsCtrl
}

puts "::nestedLoopsCtrlValues: $::nestedLoopsCtrlValues\n"

##nevertheless, undetected error discussed above can be caught by such simple loop
##so if you're unsure...
#foreach A {a} {f_nestedLoopsCtrl break 1}

foreach x {a b c} {
   foreach y {d c f} {
      puts [list $x $y]
      if {$x eq $y} {f_nestedLoopsCtrl break 2}
   }
   f_nestedLoopsCtrl
}

}; nestedLoopsCtrlDemo; exit

Category Control Structure

Category Command