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
 | 
			
		||||
     { "n" integer } { "seq" sequence }
 | 
			
		||||
     { "x" integer } }
 | 
			
		||||
{ $description "Iterates over a sequence, computes a hashcode with " { $link hashcode* } " for each element, and combines them using " { $link sequence-hashcode-step } "." } ;
 | 
			
		||||
 | 
			
		||||
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." } ;
 | 
			
		||||
{ $description "Iterates over a sequence, computes a hashcode with " { $link hashcode* } " for each element, and combines them." } ;
 | 
			
		||||
 | 
			
		||||
HELP: short
 | 
			
		||||
{ $values
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -600,18 +600,14 @@ ERROR: assert-sequence got expected ;
 | 
			
		|||
: assert-sequence= ( a b -- )
 | 
			
		||||
    2dup sequence= [ 2drop ] [ assert-sequence ] if ;
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
 | 
			
		||||
: sequence-hashcode-step ( oldhash newpart -- newhash )
 | 
			
		||||
    >fixnum swap [
 | 
			
		||||
        [ -2 fixnum-shift-fast ] [ 5 fixnum-shift-fast ] bi
 | 
			
		||||
        fixnum+fast fixnum+fast
 | 
			
		||||
    ] keep fixnum-bitxor ; inline
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: sequence-hashcode ( n seq -- x )
 | 
			
		||||
    [ 0 ] 2dip [ hashcode* sequence-hashcode-step ] with each ; inline
 | 
			
		||||
: sequence-hashcode ( depth seq -- hash )
 | 
			
		||||
    [
 | 
			
		||||
        [ drop 1000003 HEX: 345678 ] dip length
 | 
			
		||||
        [ dup fixnum+fast 82520 fixnum+fast ] [ iota ] bi
 | 
			
		||||
    ] 2keep [
 | 
			
		||||
        swapd nth-unsafe hashcode* rot fixnum-bitxor
 | 
			
		||||
        pick fixnum*fast [ [ fixnum+fast ] keep ] dip swap
 | 
			
		||||
    ] 2curry each drop nip 97531 fixnum+fast ; inline
 | 
			
		||||
 | 
			
		||||
M: reversed equal? over reversed? [ sequence= ] [ 2drop f ] if ;
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -13,8 +13,14 @@ IN: strings
 | 
			
		|||
: reset-string-hashcode ( str -- )
 | 
			
		||||
    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 -- )
 | 
			
		||||
    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>> { byte-array } declare swap 1 fixnum-shift-fast ; inline
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue