# LEG20081206 -*- tcl -*-
#
# lexically/statically-scoped variables
#
if 0 {
    This is yet another approach to lexical scoped variables in Tcl.

    It introduces a special, yet Tcl conform syntax: static variable
    names are enclosed within parentheses, e.g.:

    set (x) 5; puts $(x) => 5

    We add an implementation of 'let' which evaluates a script in a
    new environment, as well as a definition function 'def' which is
    a proc with all args interpreted as lexically scoped variables.

    let {x 1  y 2} {expr {$(x)+$(y)}} => 3

    def sumsquares {x y} {
        let {
            x2 {[expr {$(x)**2}]}
            y2 {[expr {$(y)**2}]}
        } {
            expr {$(x2)+$(y2)}
        }
    }

    This all is accomplished by mainting static variables in the
    globally scoped array with name {}.  We maintain state/call frames
    with another global array named static.  This means you can mess
    arround with the static variables in a normal proc by declaring
    global {}.

    In the following, a binding is a list of {var value} pairs.

    As an addon a simple implementation of a cond construct is
    implemented. it is used in one of the following ways:

    cond cond1 body1 cond2 body2 .. condn bodyn
    cond cond1 body1 ...            else  bodyn

    'else' is a helper script which evaluates to true

}
if 1 {
    if {[info exists {}]} {array unset {}}
    if {[info exists static]} {array unset static}
}
global {}
global static
set static() 0

proc push bindings {
    # save environment, set new bindings
    global {} static; set i [incr static()]
    foreach {name value} $bindings {
        if {[info exists ($name)]} {set static($name,$i) $($name)}
        set ($name) [subst $value]
    }
}
proc pop bindings {
    # restore environment, discard previous bindings
    global {} static; set i $static()
    foreach {name value} $bindings {
        if {[info exists static($name,$i)]} {
            set ($name) $static($name,$i)
            unset static($name,$i); # optional
        } else {unset ($name)}
    }
    incr static() -1
}
proc let {bindings body} {
    # eval the body after adding the bindings to the environment
    push $bindings
    global {}; set r [eval $body]
    pop $bindings; return $r
}
proc def {name args body} {
    foreach v $args {append script "lappend bindings $v \$$v" \n}
    append script "let \$bindings {$body}"
    proc $name $args $script
}

proc else {} {return 1}

proc cond args {
    global {}
    foreach {predicate body} $args {
        if {[uplevel $predicate]} {break}
        unset body
    }
    uplevel subst $body
}