Richard Suchenwirth 2006-02-07 - For doing some OO sugar, I needed a way that interp aliases are cleaned up when the proc scope where they were defined is left. Here's my solution with a guard variable, to which an unset trace is tied:
proc alias {name = args} {
upvar 1 __$name __$name
eval [list interp alias {} $name {}] $args
set __$name ""
trace var __$name u "interp alias {} $name {} ;#"
}
proc test {} {
alias up = string toupper
return [up hello],[up world]
}
146 % test
HELLO,WORLD
277 % up this
invalid command name "up"NEM cautions though that the scope of aliases aren't really proc local, e.g.:
% proc test2 {} {
alias up = string toupper
return [test],[up more]
}
% test2
invalid command name "up"RS Right. I should better have said "short-lived". But in my use case, accidentally reusing a name is less of a concern - it will be unambiguous handles to objects, for the popular
$obj method arg arg...
style. My worry was that the alias table would run full, if 10,000s of such were created every hour...
male 2006-02-08: perhabs the following, more complex proc-local alias solution helps?
namespace eval ::alias {
namespace eval cache {
}
proc this {} [list return [namespace current]];
proc parent {} [list return [namespace parent [this]]];
proc scope {command args} {
return [concat [namespace code $command] $args];
}
proc resolve {varName {element ""}} {
set varName [namespace which -variable $varName];
if {[array exists $varName] == 1} {
set varName [format {%s(%s)} $varName $element];
}
return $varName;
}
variable aliases;
array unset aliases;
array set aliases [list];
proc deleteCB {context alias argv} {
variable aliases;
# remove the definition context from the list of alias definition contexts
#
set aliases($alias.$argv) [lreplace \
$aliases($alias.$argv) \
[set idx [lsearch -exact $aliases($alias.$argv) $context] $idx \
];
if {[llength $aliases($alias.$argv)] == 0} {
unset aliases($alias.$argv);
interp alias [list] $alias [list];
}
return;
}
proc alias {alias args} {
variable aliases;
# requesting the proc-local context
#
set context [lindex [info level -1] 0];
# save the context in the list of contexts to prevent an alias deletion
# before the last context defining the same alias collapses
#
lappend aliases($alias.$args) $context;
# set our deletion "flag"
#
upvar 1 [resolve cache::$alias] deleteFlag;
set deleteFlag "";
# define the "real" alias
#
eval [list interp alias [list] $alias [list]] $args;
# activate the alias deletion callback
#
trace add variable deleteFlag unset [scope deleteCB $context $alias $args];
return;
}
namespace export -clear alias;
}
namespace import -force ::alias::*;
proc test {} {
alias up string toupper
return [up hello],[up world]
}
proc test2 {} {
alias up string toupper
return [test],[up more]
}The result is like expected:
% test HELLO,WORLD % test2 HELLO,WORLD,MORE