# copyright (C) 1997-2006 Jean-Luc Fontaine (mailto:jfontain@free.fr)
# this program is free software: please read the COPYRIGHT file enclosed in this package or use the Help Copyright menu

# $Id: hashes.tcl,v 1.10 2006/02/26 15:31:46 jfontain Exp $


package provide hashes [lindex {$Revision: 1.10 $} 1]

namespace eval hash64 {      ;# uses a Tcl hash algorithm tuned for bytes instead of numeric characters (11 multiplier instead of 9)

    proc bytes {string} {                                                 ;# generate a 64 bits unsigned value from string parameter
        binary scan $string c* bytes
        set value 0
        foreach byte $bytes {
            set value [expr {($value * 11) + ($byte & 0xFF)}]                          ;# transform negative byte values to unsigned
        }
        return [format %lu $value]
    }

    proc words32 {list} {                                    ;# generate a 64 bits unsigned value from list of 32 bits wide integers
        set value 0
        foreach number $list {
            set value [expr {($value * 11) + ($number & 0xFFFFFFFF)}]                       ;# transform negative values to unsigned
        }
        return [format %lu $value]
    }

    proc string {string {repeatable 0}} {                             ;# generate unique and repeatable unsigned integer from string
        variable stringHash                                                                                                 ;# cache

        if {[info exists stringHash($string)]} {return $stringHash($string)}                                    ;# already generated
        foreach {name value} [array get stringHash] {set current($value) {}}                                ;# gather current hashes
        foreach character [concat [list {}] [split 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz {}]] {
            set value [bytes ${string}$character]              ;# possibly use extra trailing character until a unique hash is found
            if {![info exists current($value)]} {return [set stringHash($string) $value]}                    ;# found a unique value
            if {$repeatable} {
                # make sure that hash values are identical across program instances (which is not possible when strings with
                # identical hashes before trailer addition arrive in different order)
                foreach {name existing} [array get stringHash] {if {$value == $existing} break}
                error "\"$string\" and \"$name\" would have the same hash value"
            }
        }
        error "could not generate unique number from string \"$string\""                           ;# abort (practically impossible)
    }

    proc numbers32 {list {repeatable 0}} {            ;# generate unique and repeatable unsigned integer from list of 32 bit numbers
        variable numbersHash                                                                                                ;# cache

        if {[info exists numbersHash($list)]} {return $numbersHash($list)}                                      ;# already generated
        foreach {name value} [array get numbersHash] {set current($value) {}}                               ;# gather current hashes
        for {set number -1} {$number < 256} {incr number} {       ;# possibly use extra trailing number until a unique hash is found
            if {$number < 0} {set value [words32 $list]} else {set value [words32 [concat $list $number]]}
            if {![info exists current($value)]} {return [set numbersHash($list) $value]}                     ;# found a unique value
            if {$repeatable} {
                foreach {name existing} [array get numbersHash] {if {$value == $existing} break}
                error "\"$list\" and \"$name\" would have the same hash value"
            }
        }
        error "could not generate unique number from list \"$list\""                               ;# abort (practically impossible)
    }

}
