sequences: change to use tuple-hashcode algorithm, make string-hashcode work like old sequence-hashcode.
parent
685fc2f86f
commit
7b76c26bc0
|
@ -1309,13 +1309,7 @@ HELP: sequence-hashcode
|
||||||
{ $values
|
{ $values
|
||||||
{ "n" integer } { "seq" sequence }
|
{ "n" integer } { "seq" sequence }
|
||||||
{ "x" integer } }
|
{ "x" integer } }
|
||||||
{ $description "Iterates over a sequence, computes a hashcode with " { $link hashcode* } " for each element, and combines them using " { $link sequence-hashcode-step } "." } ;
|
{ $description "Iterates over a sequence, computes a hashcode with " { $link hashcode* } " for each element, and combines them." } ;
|
||||||
|
|
||||||
HELP: sequence-hashcode-step
|
|
||||||
{ $values
|
|
||||||
{ "oldhash" integer } { "newpart" integer }
|
|
||||||
{ "newhash" integer } }
|
|
||||||
{ $description "An implementation word that computes a running hashcode of a sequence using some bit-twiddling. The resulting hashcode is always a fixnum." } ;
|
|
||||||
|
|
||||||
HELP: short
|
HELP: short
|
||||||
{ $values
|
{ $values
|
||||||
|
|
|
@ -600,18 +600,14 @@ ERROR: assert-sequence got expected ;
|
||||||
: assert-sequence= ( a b -- )
|
: assert-sequence= ( a b -- )
|
||||||
2dup sequence= [ 2drop ] [ assert-sequence ] if ;
|
2dup sequence= [ 2drop ] [ assert-sequence ] if ;
|
||||||
|
|
||||||
<PRIVATE
|
: sequence-hashcode ( depth seq -- hash )
|
||||||
|
[
|
||||||
: sequence-hashcode-step ( oldhash newpart -- newhash )
|
[ drop 1000003 HEX: 345678 ] dip length
|
||||||
>fixnum swap [
|
[ dup fixnum+fast 82520 fixnum+fast ] [ iota ] bi
|
||||||
[ -2 fixnum-shift-fast ] [ 5 fixnum-shift-fast ] bi
|
] 2keep [
|
||||||
fixnum+fast fixnum+fast
|
swapd nth-unsafe hashcode* rot fixnum-bitxor
|
||||||
] keep fixnum-bitxor ; inline
|
pick fixnum*fast [ [ fixnum+fast ] keep ] dip swap
|
||||||
|
] 2curry each drop nip 97531 fixnum+fast ; inline
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
: sequence-hashcode ( n seq -- x )
|
|
||||||
[ 0 ] 2dip [ hashcode* sequence-hashcode-step ] with each ; inline
|
|
||||||
|
|
||||||
M: reversed equal? over reversed? [ sequence= ] [ 2drop f ] if ;
|
M: reversed equal? over reversed? [ sequence= ] [ 2drop f ] if ;
|
||||||
|
|
||||||
|
|
|
@ -13,8 +13,14 @@ IN: strings
|
||||||
: reset-string-hashcode ( str -- )
|
: reset-string-hashcode ( str -- )
|
||||||
f swap set-string-hashcode ; inline
|
f swap set-string-hashcode ; inline
|
||||||
|
|
||||||
|
: string-hashcode-step ( oldhash newpart -- newhash )
|
||||||
|
>fixnum swap [
|
||||||
|
[ -2 fixnum-shift-fast ] [ 5 fixnum-shift-fast ] bi
|
||||||
|
fixnum+fast fixnum+fast
|
||||||
|
] keep fixnum-bitxor ; inline
|
||||||
|
|
||||||
: rehash-string ( str -- )
|
: rehash-string ( str -- )
|
||||||
1 over sequence-hashcode swap set-string-hashcode ; inline
|
[ 0 [ string-hashcode-step ] reduce ] keep set-string-hashcode ; inline
|
||||||
|
|
||||||
: (aux) ( n string -- byte-array m )
|
: (aux) ( n string -- byte-array m )
|
||||||
aux>> { byte-array } declare swap 1 fixnum-shift-fast ; inline
|
aux>> { byte-array } declare swap 1 fixnum-shift-fast ; inline
|
||||||
|
|
Loading…
Reference in New Issue