Version 4 of breakeval

Updated 2015-01-24 15:53:31 by dkf

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