Version 7 of do...until in Tcl

Updated 2014-06-19 16:59:39 by pooryorick

From a news:comp.lang.tcl posting by Jeffrey Hobbs on Aug 15, 2000:

Brandon Hoppe wrote: I need a loop equivalent to the do-while loop. Is there one built in?

A do-until construct was one of the Tcl2K expert questions, with the undisputed winner being:

# Done by Reinhard Max
# at the Texas Tcl Shoot-Out 2000
# in Austin, Texas,
# with subsequent updates

proc do {script arg2 {arg3 {}}} {
    # Implements a "do <script> until <expression>" loop
    # The "until" keyword ist optional
    # It is as fast as builtin "while" command for loops with
    # more than just a few iterations.

    if {$arg3 eq {}} {
        # copy the expression to arg3 if only
        # two arguments are supplied
        set arg3 $arg2
    } else {
        if {$arg2 eq {until}} {
            return -code 1 {Error: do script ?until? expression}

    set ret [catch {uplevel $script} result copts] 
    switch $ret {
        0 -
        4 {}
        3 return
        default {
            return -options [dict replace $copts -level 2] $result
    set ret [catch {uplevel [list while !($arg3) $script]} result copts]
    return -options $copts $result

You can alter this from do-until to do-while by removing the !() from the uplevel'ed while .

I'll leave the analysis up to the reader, because this is an excellent example of control construct creation.

DGP: An update of this proc for Tcl 8.5 (TIP 90 ) would be a good idea. If no one else does it, I'll get to it eventually.

PYK 2014-06-19: updated as suggested by DGP.

RS: If you change the proc line to

proc do {script {arg2 {}} {arg3 {}}} {
    if {![string length $arg2$arg3]} {set arg2 0}

you win the added functionality of calling do $body which works like the not too unfrequent while 1 $body. Switching between while and until can of course also be built in...

if {$arg3 ne {}} {
    switch -- $arg2 {
    until   {set bool !}
    while   {set bool {}}
        default {return -code 1 {usage: do script ??until|while? expr?}}

# ...

set ret [catch {uplevel [list while ${bool}($arg3) $script]} result]

rmax: This "do while|until" loop is now a part of tcllib's control package.

PYK 2014-06-19

Here is another do ... until that uses tailcall, the primary advantage of which is that do gets out of the business of handling all the possible return and error conditions, making it more straight-forward to implement new control structures.

proc do {script until args} {
    if {[llength $args]} {
        if {$until ne {until}} {
            set errorcode [
                list {until missing} {
                    with 3 arguments, argument 2 should be {until}}]
            return -code error -errorcode $errorcode $errorcode
        set until $args 
    set script [string map [
        list @[email protected] [list $script] @[email protected] [list !($until)]] {
        while 1 {
            switch [catch @[email protected] ::errorCode ::errorInfo] {
                4 {}
                default {
                    return -options $::errorInfo $::errorCode
            while @[email protected] @[email protected]
    tailcall if 1 $script

To avoid polluting the caller's namespace $::errorInfo and $::errorCode are used to capture the necessary catch information. It's a little hacky, but so far it's the best strategy I've found.