'''`returneval`''' is a '''historical''' but interesting strategy to work
around historical limitations of `[return] -code` prior to the implementation
in version [Changes in Tcl/Tk 8.5%|%8.5] of [TIP]
[http://www.tcl.tk/cgi-bin/tct/tip/90.html%|%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 [Tcl Commands%|%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).  `[do%|%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
`[do%|%control::do]` itself returns with a code of `0`.

In some sense this difference is a deficiency in `[do%|%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, `proc`s 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
[Changes in Tcl/Tk 8.5%|%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 [Tcl 8.6%|%8.6], a real `[tailcall]` is available as a [Tcl Commands%|%built-in] command.

<<categories>> Control Structure