[samoc]: `retry` is `try` more than once.

usage: `retry count_var count body ?handler...? ?finally script?`

e.g. try a few times to get a message through if the network is busy ...

======
retry count 3 {

    send_message "Hello"

} trap NetworkBusy {} {}
======

... or, retry with exponential backoff...

======
retry count 10 {

    send_message "Hello"

} trap NetworkBusy {msg info} {

    puts "$msg"
    after [expr {$count * $count * 100}]
}
======

It might occasionally be useful to retry for all errors:

======
retry count 3 {

    send_message "Hello"

} on error {} {}
======

Implementation:

======
proc retry {count_var count body args} {
    # Retry "body" up to "count" times for exceptions caught by "args".
    # "args" is a list of trap handlers: trap pattern variableList script...
    # The retry count is made visible through "count_var".

    assert string is wordchar $count_var
    assert string is integer $count
    assert {[lindex $args 0] in {trap on finally}}

    upvar $count_var i

    if {[lindex $args end-1] == "finally"} {
        set traps [lrange $args 0 end-2]
        set finally [lrange $args end-1 end]
    } else {
        set traps $args
        set finally {}
    }

    for {set i 1} {$i <= $count} {incr i} {

        # Try to execute "body". On success break from loop...
        uplevel [list try $body {*}$traps on ok {} break {*}$finally]

        # On the last attempt, suppress the trap handlers...
        if {$i + 1 == $count} {
            set traps {}
        }
    }
}
======

----
[AMG]: Some more explanation would be welcome. ''-- [samoc] sorry about the original unexplained version. Revised version is above.''

This code appears to retry an operation a specified number of times, swallowing configurable errors and other such abnormal returns all but the final time, though giving the user the ability to specify the handlers.  Your example shows waiting one second between retries.

Is this code intended to dodge a race condition?  Maybe find another way to design your system such that the race doesn't exist. ''-- [samoc]: This code is intended to deal with interfacing to real-world non-determinism (networks, people, actuators, sensors etc...)''

[RLE] (2014-05-25): [samoc]: Now you've posted, effectively, non-working code because you've left out your custom '[assert]' implementation.  However, if you are using Tcllib's [control%|%assert] then you need a "package require control" before defining the [proc].

[AMG]: This [[assert]] looks fairly straightforward.  From how it's being used, I assume this custom [[assert]] could be the following:

======
proc assert {test args} {
    if {[llength $args]} {
        set test \[[concat [list $test] $args]\]
    }
    if {![uplevel expr [list $test]]} {
        error "assert failure: $test"
    }
}
======

[samoc]: In fact, my version of [assert] looks like this:

======
proc assert {args} {
    # usage: assert command args...
    #    or: assert {expression}

    if {[llength $args] == 1} {
        if {[uplevel expr $args]} {
            return
        }
    } else {
      # Was just "[{*}$args]", thx to AMG for fix.
      if {[uplevel $args]} {
            return
        }
    }

    return -code error \
           -errorcode [list assert $args] \
           "Assertion Failed:\n    $args"
}

interp alias {} require {} assert
======

... but there is plenty of other information about [Assertions] elsewhere on the wiki.

[AMG]: Doing `{*}$args` means it can't be an arbitrary script but only a [command prefix].  Furthermore, the lack of [[[uplevel]]] means it can't see the caller's variables.  [[[info exists]]] is an example of where this matters.  The following code fails with your [[assert]] but works with mine:

======
set somevar someval
assert info exists somevar
======

[samoc]: Nice one. I missed that use-case. In my own code-base I used to have `[[uplevel $args]]` instead of `[[{*}$args]]` but I "simplified" it one step too far... I've reverted it now. Thankyou. The remaining difference between the two asserts seems to be: "trap" compatibility (`-errorcode`); and avoidance of the `expr` wrapper for non-expression asserts (not sure if it matters, the behaviour is the same).

----
[samoc]: The real version of `retry` that I use in my own code follows...

''The version above is edited to make it more like plain Tcl. I have a special prize for anyone who can guess what language my custom version of `proc` is inspired by :)''

======
proc retry {count_var count body args} {

    Retry "body" up to "count" times for exceptions caught by "args".
    "args" is a list of trap handlers: trap pattern variableList script...
    The retry count is made visible through "count_var".

} require {

    is wordchar $count_var
    is integer $count
    {[lfirst $args] in {trap on finally}}

} do {

    upvar $count_var i

    if {[lindex $args end-1] == "finally"} {
        set traps [lrange $args 0 end-2]
        set finally [lrange $args end-1 end]
    } else {
        set traps $args
        set finally {}
    }

    for {set i 1} {$i <= $count} {incr i} {

        # Try to execute "body". On success break from loop...
        uplevel [list try $body {*}$traps on ok {} break {*}$finally]

        # On the last attempt, suppress the trap handlers...
        if {$i + 1 == $count} {
            set traps {}
        }
    }
}
======

[RLE] (2014-05-26): First guess, it looks quite Lisp like, with a doc-string, a let clause to define variable bindings, although in your case it is assertions, and a body to execute.

[samoc]: mais non, ce n'est pas lisp!

[AMG]: Is it [Eiffel]?

[samoc]: Oui! Eiffel. Le chef-d'œuvre de mon professeur Bertrand Meyer - http://bertrandmeyer.com. I worked on the Eiffel compiler and runtime at https://www.eiffel.com in S.B. for a couple of years in the late 90s. I later implemented a full-blown Eiffel-syntax class and design-by-contract system in Tcl, but I don't own that code. These days I'm trying to come up with a more lightweight way to incorporate the good bits from Eiffel, Obj-C, python etc into my Tcl code.

Here is `proc`:

======
rename proc tcl_proc

tcl_proc proc {name arguments args} {

    if {[llength $args] == 1} {

       set body [lfirst $args]

    } else {

        lassign $args comment require precondition do body
        assert {$require == "require"}
        assert {$do == "do"}

        set precondition [lines [trim $precondition]]
        prepend body [join [lmap l $precondition {get "assert $l"}] \n]
    }

    uplevel [list tcl_proc $name $arguments $body]
}
======

Non-standard stuff in `proc` above includes: `::tcl::string::*` is imported into `::`; `get` (see [shorthand dict set]) and:

======
proc prepend {var_name string} {
    upvar $var_name v
    set v $string$v
}

proc lfirst {list} {
    lindex $list 0
}

proc lines {string} {
    lmap l [split [trimright $string \n] \n] {trimright $l \r}
}
======

[AMG]: At the risk of straying from topic, I want to point out that in Tcl 8.4 and beyond, it's preferred to use `[eq]` and `[ne]` to test for string equality.  The trouble with `[==]` and `[!=]` is in how they compare strings like "0" and "0.0".  They're numerically equal but textually unequal.  What's more, `[eq]` is faster due to bypassing the attempted conversion to number.

<<categories>> Control Structure