''Insert good description of closures here...''

-------
''Another attempt at [Emulating Closures in Tcl]''

[Todd Coram] -
While playing with [PostgresSQL], I got tired of passing around 
the ''connection id'' to each postgres tcl command (plus there was some
other contextual info I wanted to keep around with each connection).

Objectifying the postgres interface seemed over-kill and keeping state in
a single namespace prevented me from keeping more than one database connection open 
at a time. I could have used the classic objectifying technique of keeping
the instance info in array, but this felt clumsy.

Closures are neat because they give you a way to let functions carry a bit
of state with it. Tcl Namespaces give you most of what you need, but you
start to bleed into ''object land'' when you try to create more than one
exclusive set of variables.

So, thus was born this late night hacked attempt at emulating closures in Tcl:


 # Create a proc named 'name' that will create a closure over the supplied
 # 'variables' definition for the 'lambda_proc'. Any supplied variables in
 # 'arglist' can be used to initialize 'variables' during the closure
 # definition.
 #
 proc make-closure-proc {name arglist variables lambda_proc} {
    set invoke_context [uplevel namespace current]
    set name_context ${invoke_context}::$name

    # Create a namespace called $name_context to hold auto_cnt
    #
    namespace eval $name_context {
       if {![info exists auto_cnt]} { variable auto_cnt -1}
    }

    # Now, build a proc in invocation context that will create
    # closures. We do this by substituting all of the passed
    # parameters (name, arglist, variables, lambda_proc) and the
    # $name_context.
    #
    # The resulting proc will:
    # 1. Accept $arglist as initializers for the closures.
    # 2. Create a unique closure_name from the auto_cnt variable.
    # 3. Create a namespace for the closure.
    # 4. Evaluate the $variables (optionally evaluating them with
    #    $arglist).
    # 5. Create an alias called 'dispatch' for the lambda_proc.
    # 6. Return the alias.
    #
    namespace eval $invoke_context \
       [subst -nocommands -nobackslashes {
           proc $name {$arglist} { 
                set closure_name \
                ${name_context}::$name[incr ${name_context}::auto_cnt]
                eval [subst {
                    namespace eval [set closure_name] {
                        $variables
                    }
                }]
                namespace eval [set closure_name] {
                    # Curry a dispatcher for the lambda_proc.
                    #
                    curry [namespace current]::dispatch [$lambda_proc]
                } 
                return [set closure_name]::dispatch}
            }]
 }

 proc delete-closure {name} {
     namespace delete [namespace qualifiers $name]
 }

You will need a curry proc to create the dispatcher:

 proc curry {new args} {
    uplevel [list interp alias {} $new {}] $args
 }

And a lambda proc to pass to the make-closure-proc:
 proc lambda {arglst body} {
    set level [info level 0]
    set name [string map {\n _ \t _ \" _ " " _ \; _ $ _ : _ \{ _ \} _ \[ _ \] _} $level]
    set invoke_context [uplevel namespace current]
    proc ${invoke_context}::$name $arglst $body
    return ${invoke_context}::$name
 }

Here is a (contrived) example of how to create and use the closures:
 make-closure-proc make-logputs {_level _filename} {
    variable fd [open $_filename w]
    variable filename $_filename
    variable level $_level
 } {
    lambda {cmd {str ""}} {
        variable fd; variable filename; variable level
        switch -- $cmd {
            puts { 
                puts "Writing ($level to $filename) $str"
                puts $fd "([clock format [clock seconds]] - $level) $str"
            }
            close { 
               eval close $fd 
            }
        }
    }
 }

 set info [make-logputs INFO info.out]
 set warn [make-logputs WARN warn.out]

 $info puts "Some info: hello world"
 $info puts "blech"
 $warn puts "You have been warned!"

 $info close
 $warn close

 delete-closure $info
 delete-closure $warn

---------------------