Updated 2013-12-01 02:34:17 by AMG

A/AK Sometimes it's necessary to pass a data structure element to a procedure (or a command) that accepts a variable name and will write to this variable, and it's desirable to have the data structure updated. I don't use any complex, GC-enabled solutions (see Tcl references in Tcl for this kind of thing), but rather the simple trace-based code that you can see below.

This code supports two kinds of references with different lifespan: a temporary reference gets destroyed with any access to the parent data structure, and a persistent reference is destroyed with the whole data structure only (or when explicitly unset).

With help of the MkRefLowLevel proc, this package provides 4 example commands:

  • for getting persistent references to a dict or list item:
 dict& dictVariable key ?key? ...
 lindex& listVariable index ?index?

  • for getting temporary references to a dict or list item:
 dict* dictVariable key ?key? ...
 lindex* listVariable index ?index?

Usage:
 package require reftrace
 namespace import ::reftrace::*
 # ..... #
 set settings [dict create font fixed logfile /var/log/myfile.log]
 entry .e -textvariable [dict& settings logfile]
 # ..... #
 incr [dict* statistics usageCount]
 # ..... #
 myCommandRequiringVariableName [lindex* myListVariable 1 2]

I've recently discovered that this package may be very useful for interacting with Ffidl callouts: with a few lines of code (not listed here yet), I'm able to use the following syntax to pass an output (HANDLE*) parameter as a pointer-var Ffidl type:
 SQLAllocHandle 1 0 [SQLHANDLE* henv]

In this example, SQLHANDLE* creates a 'reference' to henv; but the variable passed to a callout actually contains bytearray, which is converted to integer $henv (and deallocated) when the $henv is read.

The GC-less approach, of course, creates a possibility for leaking unused references, but, as the reference gets deleted with the main data structure, there are many cases where it's safe to use even a persistent reference. E.g. it's always safe to create a reference to a snit instance's variable in the instance's constructor. Thus your snit megawidget, that provides a form for user to enter some values, may have an option -value holding the dict of all the form's fields, and each of the form's fields may use reference to this option as a -textvariable.

dict-oriented commands are constantly improved to compensate for the lack of references, so the usability of this package is slightly decreasing. However, dict append|lappend|incr don't have any list-oriented counterparts, and the ability to do [incr [lindex* ...] ] is still valuable; and I suspect that there will never be a builtin regsub that is able to perform substitution on the list element with putting the result back to the list.

Code:
 # 2005, Anton Kovalenko
 # Do what you want with this code, but don't blame me.
 #
 # This package implements a simplistic approach to 
 # references. 
 # 
 # Each reference is a variable within ::reftrace::v, tied to some
 # other variable containing some data structure. MkRefLowLevel
 # takes (among other arguments) a command to extract an element
 # from the data structure and a command to put it back.
 #
 # There are two types of references: 'temporary' 
 # and 'persistent'.
 #
 # Typical usage for a temporary reference:
 # incr [lindex* myListVar 3 12]
 #
 # Typical usage for a persistent reference:
 # .entry configure -textvariable [lindex& myListVar 3 12]
 #
 # To prevent leaking references, it's preferable to use temporary
 # references when it's possible. And it's always possible if the
 # following is true:
 # - the reference is only required to be valid for an interval 
 # during which the main data structure will not be accessed in any way.
 #
 # It sounds very restrictively, however, there is a lot of cases
 # where this restriction is satisfied. Almost every single call 
 # to a command that accepts a variable name as an argument 
 # will work well with a temporary reference. The only way for 
 # the called command to mess things up is to access the main data 
 # structure, that's almost never needed when you have to pass
 # a reference.
 #
 # Note that the reference NEVER survives the main data structure,
 # so there will be many cases where it's not necessary to worry
 # about 'leaking' or 'hanging' refs.
 #
 # Exact specification of the references behavior:
 #
 # (for both t&p) - the data structure element gets extracted 
 # initially on call to MkRefLowLevel (lindex*, lindex&, etc)
 #
 # (for both t&p) - when the data structure is read, the new
 # element's value is put back on its place
 #
 # After putting the value back, any TEMPORARY reference 
 # is destroyed.
 #
 # (for both t&p) - when the data structure is unset, the 
 # reference is unset too.
 #
 # For persistent references:
 # if the data structure is written, the reference gets new value
 # automatically.
 #
 # For temporary references:
 # if the data structure is written, the reference is destroyed.
 
 package provide reftrace 1.0
 
 namespace eval ::reftrace { 
     variable seq 0 
     namespace export {[a-z]*}
 }
 namespace eval ::reftrace::v {}
 
 
 
 # Make a persistent reference to a [sub]list element
 proc ::reftrace::lindex& {listVarName args} {
     upvar 1 $listVarName lv
     MkRefLowLevel [list ::lindex $args] \
         [list ::lset $args] 0 lv
 }
 
 # Make a persistent reference to a [dict]'s element
 proc ::reftrace::dict& {dictVarName args} {
     upvar 1 $dictVarName dv
     MkRefLowLevel [list {::dict get} $args] \
         [list {::dict set} $args] 0 dv
 }
 
 # Make a temporary reference to a [sub]list element
 proc ::reftrace::lindex* {listVarName args} {
     upvar 1 $listVarName lv
     MkRefLowLevel [list ::lindex $args] \
         [list ::lset $args] 1 lv
 }
 
 # Make a temporary reference to a [dict]'s element
 proc ::reftrace::dict* {dictVarName args} {
     upvar 1 $dictVarName dv
     MkRefLowLevel [list {::dict get} $args] \
         [list {::dict set} $args] 1 dv
 }
 
 # Please put more examples here.
 
 
 
 
 # The low-level procedure creating references
 # - inConv is a 'command template' for extracting value 
 #   from the data structure;
 # - outConv is a 'command template' for putting a value 
 #   back to the data structure.
 # * Command template is a 2-elements list of lists:
 #   {lset myList} {2 4}
 #   Extra arguments are inserted between these two parts 
 #   of a command. It is a non-standard but (i think) a convenient
 #   solution for passing callbacks in Tcl.
 
 proc ::reftrace::MkRefLowLevel {inConv outConv isTemporal structureVarName} {
     # We will assign traces to the data structure
     upvar 1 $structureVarName structureVar
     # Initialize it (may be useful sometimes) [FIXME: explain]
     if {![info exists structureVar]} {
         set structureVar {}
     }
     set linkedName [MkName]
     upvar \#0 $linkedName linkedVar
     foreach {cvpre cvpost} $inConv {break}
     # Used to be {*} :-(
     set linkedVar [eval $cvpre [list $structureVar] $cvpost]
     trace add variable structureVar {write read unset} \
         [list ::reftrace::Tracker $linkedName $inConv $outConv $isTemporal]
     return $linkedName
 }
 
 proc ::reftrace::Tracker \
     {linkedName inConv outConv isTemporal name1 name2 op} {
     # The linked var is always unset when the data structure var is.
     # For temporary ('unaliased') references, the linked var is
     # also unset when the data structure is written.
     if {($op eq "unset")||($op eq "write" && $isTemporal)} {
         unset $linkedName
     } elseif {$op eq "write"} {
         # For non-temporal references, we update linked var when
         # the data structure is written.
         if {$name2 eq ""} {
             upvar 1 $name1 myvar
         } else {
             upvar 1 ${name1}($name2) myvar
         }
         foreach {cvpre cvpost} $inConv {break}
         set $linkedName [eval $cvpre [list $myvar] $cvpost]
     } elseif {$op eq "read"} {
         # Someone tries to read a data structure...
         if {$name2 eq ""} {
             upvar 1 $name1 myvar
         } else {
             upvar 1 ${name1}($name2) myvar
         }
         # Time to put the value back
         foreach {cvpre cvpost} $outConv {break}
         # If someone didn't unset linked var yet
         if {[info exists $linkedName]} {
             eval $cvpre myvar $cvpost [list [set $linkedName]]
         } else {
             # The link is destroyed, trace is not necessary
             trace remove variable myvar {write read unset} \
                 [list ::reftrace::Tracker \
                     $linkedName $inConv $outConv $isTemporal]
         }
         # Temporal link is removed when the structure is first read.
         if {$isTemporal} {
             unset $linkedName
             trace remove variable myvar {write read unset} \
                 [list ::reftrace::Tracker \
                     $linkedName $inConv $outConv $isTemporal]
         }
     }
 }
 
 # Reinventing a wheel: generate unique name variable name
 proc ::reftrace::MkName {} {
     return ::reftrace::v::[incr ::reftrace::seq] 
 }

See also: