#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