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. I could have curried the connection id to postgres commands, but that felt too restricting.
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]
}I used a curry proc to create the dispatcher (I really don't create a curry and perhaps namespace code could accomplish a similiar thing, but I had a curry proc handy, so there):
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 {
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