Updated 2011-12-28 13:03:34 by dkf

ulis: The gotos are gone but we still need to gracefully break out of an erroneous sequence. So we have 'break'. The pitfall with 'break' is that we can only break out of the current block. Here is a mechanism for breaking out of named blocks.

The gotos are gone (except for GOTO in Tcl) but the labels come back. In a structured manner, indeed.

Usage:

defining an anonymous block
: - block

defining a named block
: label block

breaking out of this named block
break label

remark: all blocks must be linked, so define anonymous blocks if needed between named blocks.
# 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.