Checked Implicit Upvar

NEM 2008-05-13: Recent conversations on the tcl-core mailing list, relating to Cloverfield and L have pointed out an interest in having a version of upvar that is simpler to use, clearer to read, and that captures errors early. (This wasn't the only focus of the conversation, but a side-issue). This is quite possible today, using a slight variation on the code at implicit upvar. The main construct in the package provided here is a checked proc that does implicit upvar on any parameters named in the form "&foo". When called, these procs also check whether the supplied variable name actually exists in the caller's scope, and if not, raise an intelligible error message. The package also provides a checked version of upvar itself, and a new construct called uplink which is used mainly in the implementation of the checked proc -- it is essentially a version of upvar whose arguments are more convenient when generating code. After this, it is trivial to define wrappers around various core built-ins, such as incr, lappend etc so that they raise errors if the variable supplied does not exist, rather than auto-creating it. This package could therefore be useful when quick detection and diagnosis of errors is more important than the full flexibility and convenience provided by various built-ins. The implementation is not the most efficient possible, as I opted for a clear implementation over a fast one (you could speed it up by inlining more of the code, but it's messier). It could also be back-ported to 8.4 with only a few changes.

# check.tcl --
#
#       Provides "checked" versions of some Tcl constructs which catch errors
#       earlier.
#
package require Tcl     8.5
package provide checked 0.1

namespace eval checked {
    namespace export proc upvar uplink

    # proc name params body --
    #
    #       Works like the built-in proc command, except that it allows implicit
    #       upvar. Any parameter named like &foo will be treated as a variable
    #       reference and an implicit [upvar] inserted so that the local
    #       variable 'foo' will be linked to the variable whose name was passed
    #       in that argument. In addition, this upvar checks at call-time
    #       whether the argument passed refers to an existing variable or not,
    #       and throws an error if not. For instance, a version of [incr] that
    #       complains when the variable doesn't exist (as in Tcl 8.4) can be
    #       written simply as:
    #
    #           checked proc myincr {&var {amount 1}} { incr var $amount }
    #
    ::proc proc {name params body} {
        set vars [list]
        foreach p $params {
            set p [lindex $p 0]
            if {[string match &* $p]} {
                ::lappend vars $p [string range $p 1 end]
            }
        }
        set body [list checked uplink 1 $vars $body]
        uplevel 1 [list ::proc $name $params $body]
    }
    
    # uplink level vars body --
    #
    #       This command is mostly a convenience proc for use in the [checked
    #       proc] implementation. The $vars argument should be a dictionary of
    #       parameter -> local var names. When called, it will examine the
    #       arguments passed to each specified parameter and then link a
    #       variable of that name from the caller's scope to the local var name
    #       specified. For instance:
    #
    #           proc myincr {varName {amount 1}} {
    #               checked uplink 1 {varName var} {
    #                   incr var $amount
    #               }
    #           }
    #
    ::proc uplink {level vars body} {
        set cmd [list checked upvar $level]
        if {[string is integer -strict $level]} { ::incr level }
        foreach {param local} $vars {
            ::upvar 1 $param p
            if {![uplevel $level [list info exists $p]]} {
                return -code error "no such variable \"$p\""
            } else {
                ::lappend cmd $p $local
            }
        }
        uplevel 1 $cmd
        uplevel 1 $body
    }

    # upvar level ?otherVar localVar ...? --
    #
    #
    #       A replacement for the built-in [upvar] command, except that it
    #       complains immediately if any of the otherVars do not exist already
    #       at the given level. Also the $level argument is mandatory, and you
    #       can specify no variable links (as a convenience).
    #
    ::proc upvar {level args} {
        set cmd [list ::upvar $level]
        if {[string is integer -strict $level]} { ::incr level }
        foreach {varName local} $args {
            if {![uplevel $level [list info exists $varName]]} {
                return -code error "no such variable \"$p\""
            } else {
                ::lappend cmd $varName $local
            }
        }
        uplevel 1 $cmd
    }

    # Redefined various standard commands to be checked
    foreach cmd {incr lappend append} {
        # Add more as needed
        namespace export $cmd
        checked proc $cmd {&var args} "::$cmd var {*}\$args"
    }

    namespace ensemble create

}