returneval

returneval is a historical but interesting strategy to work around historical limitations of return -code prior to the implementation in version 8.5 of TIP 90 , "Enable return -code in Control Structure Procs".

Larry Smith: Just a note: this concept is a Tcl-ish implementation of TRAC's "active return" concept. In TRAC there are three types of evaluation, active, inactive, and "neutral". "Active" implies the result is rescanned and re-evaluated, "neutral" that it is scanned and evaluated just once, and "inactive" meaning it is neither scanned nor evaluated.

Typically, if a command calls return -code ..., and the value of -code is anything other than 0, Tcl causes the command itself to return with the same code:

proc myproc {} {
    return -code 1 {Something is wrong!}
}

catch myproc ;# -> 1

catch just returns as its value the return code of the script it recursively invoked:

catch {return something} ;# -> 2
catch {return -code ok something} ;# -> 2
catch {return -code error something} ;# -> 2

The return code of return is actually 2, which signals Tcl to cause myproc itself to return immediately with a code of 1. This is the most common use of return, and is well-understood. There are times, though, when a script would like evaluate another script and inspect the -code value of any return command. In this case, catch would indicate that the return code of return itself was 2. The problem is that the script then has no way to inspect the -code value of that command:

proc myproc {} {
    set code [catch {return -code 0 {Everything is good!}}] ;# -> 2
    if {$code} {
        #Is there any way to see that the value of -code is 0?
        #No!
    }
}

myproc

This has implications for a user-defined control structure like do, which only knows that a script invoked return, but not what the return code was. Therefore, the following procedures display different behaviour:

proc a {} {while 1 {return -code 1}}
package require control
proc b {} {control::do {return -code 1} while 1}

while, a built-in command, leverages the standard interpreter behaviour, and itself returns with a code of 1, which then causes a itself to return with a code of 1 (an error). control::do, on the other hand, catches the return code of return, which is 2, but has no way to inspect the -code value, and see that it is 1. Therefore control::do itself returns with a code of 0.

In some sense this difference is a deficiency in control::do, but there is in fact no way to implement it so that it handles this. The reference implementation of Tcl does not currently support it!

Built-in commands have the luxury of inspecing the -code value of return or the return codes of break and continue, and reacting to the return code. Commands like eval and uplevel don't do anything special based on the return code, and the interpreter just causes them to return with that value as their own return code. subst ignores -code values other than 1. control structure commands such as for, foreach, while, etc.) rely on return code of commands like break and continue.

If a user-defined control structure command could inspect the -code value of return (either directly or via break/continue), it could, like the built-in commands, provide more specialized functionality.

Below are defined some commands that provide a workaround for this. The idea is that returneval not only causes the calling procedure to return but also evaluates a user-supplied command "in place of" the procedure that returned. This lets one define a procedure c through

eproc c {} {control::do {returneval {error {}}} while 1}

that behaves just like a. In particular,

catch a
catch c

both return 1 whereas

catch b

returns 0.

returneval makes use of the nonstandard return code -1. The reason for choosing this can be found on the uplevel page.

proc returneval script {return -code -1 $script}

However, this will just behave as an error if it isn't intercepted at some point. Therefore any procedure which you might want to returneval from must be defined using eproc rather than proc.

proc eproc {name arglist body} {
    uplevel 1 [list proc "$name " $arglist $body]
    set full [uplevel 1 [list namespace which -command "$name "]]
    interp alias {} [string range $full 0 end-1] {} [
        namespace which -command eproc_call] $full
}

proc eproc_call args {
    set code [catch [list uplevel 1 $args] res]
    if {$code == -1} then {
        set code [catch [list uplevel 1 $res] res]
        return -code $code $res
    } elseif {$code == 1} then {
        return -code error -errorinfo $::errorInfo -errorcode $::errorCode $res
    } else {
        return -code $code $res
    }
}

[Also explain why the above works]

About the original definition of eproc,

proc eproc {name arglist body} {
    interp alias {} $name {} eproc_call "$name "
    proc "$name " $arglist $body
}

DGP wrote: Very nice. This could possibly be a way to work around the limitations of the control package commands until a TIP 90 solution is in place.

Some nitpicking: it looks like eproc assumes it is called from the :: namespace. To make this robust, there should be an uplevel 1 ::namespace current to discover the namespace context of the caller, then be careful to create both the alias and the proc in that namespace.

Lars H: I suspect you're right about that. Would it work to simply uplevel the commands in eproc, i.e.,

proc eproc {name arglist body} {
    uplevel 1 [list interp alias {} $name {} ::eproc_call "$name "]
    uplevel 1 [list proc "$name " $arglist $body]
}

?

DGP: For proc, yes. For interp alias no. For no apparently good reason, procs get defined in the current namespace while aliases get defined in the namespace :: of the target interp.

Lars H 2002-12-02: OK, now I have fixed that namespace issue. As a side-effect, eproc now returns the full name of the alias it created.

2002-12-12: Another namespace fix, so that eproc and eproc_call don't have to be defined in the :: namespace. Another note: The handling of negative return codes is broken in some Tcl 8.4 versions, but that has been fixed in CVS when I write this. If you want to use the above commands, but you have a buggy version, then substitute some positive integer > 4 for the -1 return code in returneval and eproc_call.

Lars H 2005-04-11: Today I had a "brilliant" idea on how to make returneval safe for tail call optimization, and put the following here on the wiki:

proc eproc_call args {
    if {[info level] > 1 &&
        [lindex [info level 0] 0] eq [lindex [info level 1] 0]} {
        return -code -1 $args
    }
    set code -1
    while {$code == -1} {
        set code [catch [list uplevel 1 $args] args]
    }
    if {$code == 1} then {
        return -code error -errorinfo $::errorInfo -errorcode $::errorCode $args
    } else {
        return -code $code $args
    }
}

Update: I think the idea is sound: When eproc_call notices it has been called by itself, it can safely pass the call back to the calling eproc_call and let everything be handled there -- thus there will not be a stack buildup, which is what prevented tail calls in the first place. The problem is however that in practice, uplevel will hide the outer eproc_call from the inner, so the then branch of the first if above is never taken, and the stack starts piling higher (but out of sight from info level, which fooled me at first). Close, but no cigar.

Unless I get it sorted out somehow, the following should be ignored: Another modification for this is to allow several arguments of returneval:

proc returneval args {
    if {[llength $args] == 1} then {set args [lindex $args 0]}
    return -code -1 $args
}

With these, a tail-recursive factorial procedure fac can be coded as follows

eproc fac {n {prod 1}} {
    if {$n <= 1} then {
        return $prod
    } else {
        returneval fac [expr {$n-1}] [expr {$n*$prod}]
    }
}

PYK 2014-06-14: As Lars H mentioned, the tailcall-optimizing eproc_call above was "close, but not cigar". info frame, which became available in 8.5 a couple of years after Lars H had this idea, provides the additional info that's needed to allow eproc_call to detect that it is already "running" and take the optimizing branch. Here is an updated eproc_call that works in 8.5:

proc eproc_call args {
    set myname [dict get [info frame 0] proc]
    for {set i [info frame]; incr i -1} {$i > 0} {incr i -1} {
        set frameinfo [info frame $i]
        if {[dict exists $frameinfo proc] && [dict get $frameinfo proc] eq
            $myname}  {
            return -code -1 $args
        }
    }
    set code -1
    while {$code == -1} {
        set code [catch [list uplevel 1 $args] args]
    }
    if {$code == 1} then {
        return -code error -errorinfo $::errorInfo -errorcode $::errorCode $args
    } else {
        return -code $code $args
    }
}

testing:

% puts [fac 4]
24

Of course, since 8.6, a real tailcall is available as a built-in command.