Usage:defining an anonymous block
- : - block
- : label block
- break label
# the (extended) break command proc break {{label ""}} { if {$label != ""} { # check for existance if {![info exists ::break::$label]} { error "unknown label \"$label\"" } # set break flag set ::break::break 1 # set stopping label set ::break::$label 1 } # do break return -code break } # the label (:) command proc : {label args} { # if named, create namespace, create our label if {$label ne "-"} { namespace eval ::break set $label 0 } # execute set rc [catch { uplevel 1 $args } rs] # get state of our label and clean-up if {$label == "-"} { set flag 0 } else { set flag [set ::break::$label] unset ::break::$label } # break mechanism if {[info exists ::break::break]} { if {$flag} { # stop breaking here unset ::break::break } elseif {$rc == 0} { # continue breaking return -code break } } # return return event global errorInfo errorCode return -code $rc -errorinfo $errorInfo -errorcode $errorCode $rs }
The test
catch { console show } set level0 "break label test" : label1 \ while 1 { puts "inside while 1" : - \ foreach - - { # inside anonymous foreach : label2 \ while 2 { puts "inside while 2" puts $level0 puts "* breaking while 1" break label1 error "should not happen 2" } } error "should not happen 1" } puts "back to level 0"
The result
inside level 1 inside level 2 break label test * breaking level 1 back to level 0
With that you can still use 'break' or 'return -code break'. You can also break out of any named block. A fine extension would be to break out of a named script:In proc : replace:
# execute set rc [catch { uplevel 1 $args } rs]by
# execute set block [lindex $args 0] switch -exact -- $block { while - for - foreach { set rc [catch { uplevel 1 $args } rs] } default { set rc [catch { uplevel 1 foreach - - $args } rs] } }The dummy foreach will allow for break inside the script.
NEM offers this simpler alternative version:
# Use "2004" as our special exception code proc block {label args} { set rc [catch {uplevel 1 $args} ret] if {$rc == 2004 && $ret eq $label} { return } return -code $rc $ret } rename break __break proc break {args} { if {[llength $args] == 0} { return -code break } else { return -code 2004 [lindex $args 0] } }And this version of the test code:
set level0 "break label test" block label1 while 1 { puts "inside while 1" foreach - - { block label2 while 2 { puts "inside while 2" puts $level0 puts "* breaking level 1" break label1 error "should not happen 2" } } error "should not happen 1" } puts "back to level 0"
RS has this minimal code to offer - it allows to break out of a code block, to its end (hence no label needed), by just turning it into a run-once foreach loop:
interp alias {} breakable {} foreach . . breakable { # do something ... if $condition break # do something else ... }Should you happen to have a variable named ".", you'd have to use another one in the breakable definition.
RHS For what it's worth, the bytecode for break includes the bytecode position that it breaks to, so (from what I can see), it appears entirely possible to add an argument to the break command that allows it to break to a specific position. I did some playing with this when I was writing a bytecode analysis package (and de-bytecoder) and was able to have break commands that would break more than one level.