While playing with Tcl and Postgres, 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 too heavy and keeping state in a single namespace prevented me from keeping more than one database connection open at a time.
Closures are neat because they give you a way to let functions carry a bit of state with it.
Somebody explain closures here..'
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
} {
fp::slambda {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