records

Tcl has no struct or record facility. We can approximate them with keyed lists or the like, but they just aren't as compact or usable as a simple record. Thus was born:

 proc record { op rec args } {
   upvar type-$rec type
   upvar len-$rec len

   switch -exact $op {
    define {
             set type $args
             set len [ llength $args ]
           }
    new    {
             set varname [ lindex $args 0 ]
             set args [ lreplace $args 0 0 ]
             upvar $varname instance
             set instance [ eval list $rec $args ]
           }
    get    {
             upvar $rec instance
             set rec [ lindex $instance 0 ]
             upvar type-$rec type
             set element [ lsearch -exact $type $args ]
             if { $element == -1 } {
               bail "no such element $args in $rec"
             } else {
               incr element
               return [ lindex $instance $element ]
             }
           }
    set    { upvar $rec instance
             set instname $rec
             set rec [ lindex $instance 0 ]
             upvar type-$rec type
             set field [ lindex $args 0 ]
             if { [ llength $args ] == 1 } {
               return [ uplevel record get $instname $field ]
             }
             set value [ lrange $args 1 end ]
             set element [ lsearch -exact $type $field ]
             if { $element == -1 } {
               bail "no such element $field in $rec"
             } else {
               incr element
               return [set instance [lreplace $instance $element $element $value]]
             }
           }
  }
 }

What's different here? Well, rather than dragging the field names around with each individual record we can define a prototype list. This prototype names the fields of the record, and is used to look up which field you want when you ask for it, or change it. Dicts, keyed lists, and array all incur this overhead. Records have only one definition, objects declared this way consist only of their record type and the actual data for each field.

For a (trivial) example:

 #source record.tcl - as needed

 record define person name height weight
 record new person larry "" "" ""
 record set larry name "Larry Smith"
 record set larry height 6'4\"
 puts "Larry: $larry"
 puts "larry.height=[record get larry height]"
 puts "larry.height=[record set larry height]"

The notation is not compact, but I left it this way to show how it works. Any of the normal currying methods like Custom curry can shorten it easily.


BAS - See also the record package in tcllib (struct), although I'd like to update that to use dicts internally some day


Extended version of the example above, added som new functions which could mirror some features from ::struct::record posted by kruzalex

 proc record { op {rec ""} {args ""}} {
   upvar records records
  
   switch -exact $op {
    define {
             upvar type-$rec type
             upvar len-$rec len
             set type [eval concat $args]
             lappend records $rec
             set len [ llength $args ]
           }
        "delete record" {
                 upvar record-$rec record 
                 if {[ lsearch -exact $record $rec ] != -1} {
                  upvar instname-$rec instname
                  unset record instname
                  set element [ lsearch -exact $records $rec ]
                  set records [lrange $records [expr $element+1] end]
             } else {
             return -code error "Could not delete record - record does not exist"    
         }
          }
          "delete instance" {
                 upvar instname-$rec instname
         if {[info exists instname]==0} {
             return -code error "Could not delete instance - parent record does not exist"    
         } else {    
                 if {[ lsearch -exact $instname $args ] != -1} {
                  set element [string first $args $instname]
                  set instname [lrange $instname [expr $element+1] end]
             } else {
             return -code error "Could not delete instance - instance does not exist"    
         }
         }
          }
    "show members" -
    "show types" {
            upvar type-$rec type
            set type
        }
    "show records" {
              set records 
         }
    "show instances" {
            upvar instname-$rec instname
            if {[ lsearch -exact $records $rec ] != -1} {
                set instname
                } else {     
            return -code error "Could not show instances for requested record - record does not exist"     
        }
        }
    "show values" {
             upvar $rec instance
             return [lrange $instance 1 end]
        }
    "exists record" {
            if {[ lsearch -exact $records $rec ] != -1} {
                return 1    
        } else {
            return 0    
        }        
        }        
        configure {
                upvar type-$rec type
                upvar len-$rec len
                if {[llength $args] == 0} {
                puts [set type]
                } else {
        append type " " $args
        set len [ llength $args ]
        }
       }           
    new {
            upvar record-$rec record
            upvar instname-$rec instname
        set record $rec
        if {[llength [lindex $args 0]] > 0} {        
        if {[info exists instname]==0} {
        set instname [lindex $args 0]
        } else {
        append instname " " [lindex $args 0]
        } 
        }
            set varname [ lindex $args 0 ]
            set args [ lreplace $args 0 0 ]
            upvar $varname instance
            set instance [ eval list $rec $args ]
            }
    get {
            upvar $rec instance
            upvar record-$rec record 
            set rec [ lindex $instance 0 ]
            upvar type-$rec type
            set element [ lsearch -exact $type $args ]
            if { $element == -1 } {
            bail "no such element $args in $rec"
            } else {
            incr element
            return [ lindex $instance $element ]
            }
            }
    set {upvar $rec instance
         upvar record-$rec record
         set rec [ lindex $instance 0 ]
         set record $rec
             upvar type-$rec type
             set field [ lindex $args 0 ]
             if { [ llength $args ] == 1 } {
             return [ uplevel record get $instname $field ]
             }
             set value [ lrange $args 1 end ]
             set element [ lsearch -exact $type $field ]
             if { $element == -1 } {
             bail "no such element $field in $rec"
             } else {
             incr element
             return [set instance [lreplace $instance $element $element $value]]
             }
             }
    }
  }

 record define person name height weight
 record define class first second third
 record configure person
 record configure person age

 # copy one record to another record
 record define level [record "show members" class]
 #
 puts "types level: [record "show types" level]"
 puts "types person: [record "show types" person]"
 puts "types class: [record "show types" class]"
 puts "records: [record "show records"]"

 record new person
 record new person larry {} {} {}
 record new person garry {} {} {}
 record new person perry {} {} {}
 puts "record show instances: [record "show instances" person]"
 record set larry name "Larry Smith"
 record set larry height 6'4\"
 puts "larry.height=[record get larry height]"
 puts "show values: [record "show values" larry]"
 puts "show values: [record "show values" garry]"
 puts [record "exists record" person] 
 record "delete record" person
 puts [record "exists record" person] 
 puts "record show instances: [record "show instances" person]"