Version 1 of A Hash Table in Tcl

Updated 2009-07-06 08:51:12 by LVwikignoming

George Peter Staplin Nov 28, 2008 - Hash tables are generally used to associate strings or values with other values. This is a simple implementation of such a thing in Tcl. Tcl's array and dict are similar, though implemented in C.

---

 #By George Peter Staplin
 #
 #This is a simple demonstration of a hash table for Tcl implemented in Tcl.
 #We use a linear list of sublists.
 #
 #In Tcl lists are like C arrays, so this is quite efficient.
 #
 #You can store a hash table in a hash table, so it's less restricted than [array].
 #This might be beneficial to those that aren't using [dict] or [objstructure].


 proc hash-create {} {
     set numbuckets 500
     return [lrepeat $numbuckets [list]]
 }


 proc hash str {
     set n 0

     foreach c [split $str ""] {
         #This hash algorithm is like Tcl's core hash.
         set n [expr {$n + ($n << 3) + [scan $c %c]}]
     }

     return $n
 }

 proc hash-set {bucketsvar key value} {
     upvar 1 $bucketsvar buckets

     set numbuckets [llength $buckets]
     set hash [hash $key]
     set offset [expr {$hash % $numbuckets}]
     set sublist [lindex $buckets $offset]
     set existing [lsearch -exact -index 0 $sublist $key]

     if {$existing < 0} {
         #This is a new key that hashed to this bucket.
         lappend sublist [list $key $value]
     } else {
         #This is a key that is the same as a previous key.
         #Replace the bucket's sublist item.
         set sublist [lreplace $sublist $existing $existing [list $key $value]]
     }

     lset buckets $offset $sublist
 }


 proc hash-get {buckets key valuevar} {
     upvar 1 $valuevar value

     set numbuckets [llength $buckets]
     set hash [hash $key]
     set offset [expr {$hash % $numbuckets}]
     set sublist [lindex $buckets $offset]

     set existing [lsearch -exact -index 0 $sublist $key]

     if {$existing < 0} {
         #not found
         return 0
     }

     set value [lindex $sublist $existing 1]

     #found
     return 1
 }

 proc main {} {
     set h [hash-create]

     set key1 "Hello World!"
     set key2 "Goodbye World!"

     puts keyset1:[time {
         hash-set h $key1 123
     }]
     puts keyset2:[time {
         hash-set h $key2 456
     }]

     if {[hash-get $h $key1 value]} {
         puts "Found $value associated with: $key1"
     }

     if {[hash-get $h $key2 value]} {
         puts "Found $value associated with $key2"
     }

     if {[hash-get $h "invalid key" value]} {
         puts "Invalid key returned a value?"
     }

     hash-set h $key1 789

     if {[hash-get $h $key1 value]} {
         puts "updated $key1 value is: $value"
     }
 }
 main

---