named let

So, I've been on a weird tear this weekend to implement some random bits of pieces of Scheme in Tcl for no particular reason whatsoever. I figured some might find some novelty in my implementation of (let), with the named three-argument form supported using tail recursion trampolines.

namespace eval ::lambda {
    variable symbol 0
}

proc ::lambda::gensym {} {
    variable symbol

    return "[namespace current]::symbol[incr symbol]"
}

proc ::lambda::let {args} {
    set varNames   [list]
    set varValues  [list]

    switch -- [llength $args] 2 {
        lassign $args bindings script

        set name {}
    } 3 {
        lassign $args bindings name script
    } default {
        error "Invalid command invocation"
    }

    foreach binding $bindings {
        lappend varNames  [lindex $binding 0]
        lappend varValues [uplevel 1 expr [lindex $binding 1]]
    }

    set ns     [::lambda::gensym]
    set result [list]

    namespace eval $ns {
        variable triggered 1
    }

    proc "${ns}::triggered" {args} {
        variable triggered

        if {[llength $args] > 0} {
            set triggered [lindex $args 0]
        }

        return $triggered
    }

    proc "${ns}::${name}" {args} {
        variable triggered 1
        uplevel 2 [list set varValues $args]
    }

    while {[namespace eval $ns triggered]} {
        namespace eval $ns {triggered 0}

        set result [apply [list $varNames $script $ns] {*}$varValues]

        if {[namespace eval $ns triggered]} {
            continue
        }
    }

    namespace forget $ns

    return $result
}

#
# Example usage
#
::lambda::let {{a 5}
     {b 6}} loop {
        puts "$a => $b"
        loop 7 8} ; # Loops forever

Category Command