proc-local alias

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 add variable __$name unset "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...

jmn 2008-03-12 I have an app which regularly has 100,000+ aliases. I did some tests under Tcl 8.5.2 where I created over 4million aliases - and it works fine up til the point where the process crashes with 'unable to allocate xx bytes'. This happens when the ram usage is around 2GB - so presumably that's just the per process memory limit on the windows machine I was using.

Performance for invocation of each alias doesn't seem to degrade even with millions of aliases present. My guess is that aliases can essentially be used as often as you like bearing in mind the memory costs. By my estimates it's somewhere around 450-500 Bytes per alias, and is similar in terms of memory costs to a very minimal proc.

In another experiment I looped 100 times, generating 1 million aliases each time, and then deleting them. The process had a steady 500+MB of ram in use - but it seems to indicate there should be no trouble with long running processes creating and destroying aliases as often as desired.

male 2006-02-08: perhabs the code below solves some issues:

 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;
         variable contexts;

         array unset aliases;
         array set aliases [list];

         array unset contexts;
         array set contexts [list];

         proc evalCB {alias args} {
                 variable aliases;
                 variable contexts;

                 # get the current context
                 #
                 set context        [lindex [info level -2] 0];

                 # check if an alias in this context is really defined
                 #
                 if {[info exists contexts($context.$alias)] == 0} {
                         error "no such defined proc-local alias \"$alias\" in the procedure \"$context\"";
                 }

                 # evaluate the alias inside the context
                 #
                 return [uplevel 2 $contexts($context.$alias) $args];
         }

         proc deleteCB {context alias} {
                 variable aliases;

                 # remove the definition context from the list of alias definition contexts
                 #
                 set aliases($alias)        [lreplace \
                         $aliases($alias) \
                         [set idx [lsearch -exact $aliases($alias) $context] $idx \
                 ];

                 if {[llength $aliases($alias)] == 0} {
                         unset aliases($alias);
                         unset contexts($context.$alias);

                         interp alias [list] $alias [list];
                 }

                 return;
         }

         proc alias {alias args} {
                 variable aliases;
                 variable contexts;

                 # 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)        $context;

                 set contexts($context.$alias) $args;

                 # set our deletion "flag"
                 #
                 upvar 1 [resolve cache::$alias] deleteFlag;

                 set deleteFlag "";

                 # define the "real" alias
                 #
                 eval [list interp alias [list] $alias [list]] [scope evalCB $alias];

                 # activate the alias deletion callback
                 #
                 trace add variable deleteFlag unset [scope deleteCB $context $alias];
         }

         namespace export -clear alias;
 }

 namespace import -force ::alias::*;

 # define an alias in test
 #
 proc test {} {
         alias up string toupper
         return [up hello],[up world]
 }

 # define an alias in test2
 # with the same name than in test
 #
 proc test2 {} {
         alias up string toupper
         return [test],[up more]
 }

 # define an alias in test3
 # with the same name than in test and test2,
 # but with a different "meaning"
 #
 proc test3 {} {
         alias up string totitle
         return [test2],[up less]
 }

Here the examples:

 % test;
 HELLO,WORLD
 % test2;
 HELLO,WORLD,MORE
 % test3;
 HELLO,WORLD,MORE,Less

Category Development