1 ! Copyright (C) 2005, 2011 John Benediktsson, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays kernel kernel.private slots.private math
4 assocs math.private sequences sequences.private vectors ;
8 { count array-capacity }
9 { deleted array-capacity }
14 : wrap ( i array -- n )
15 length>> 1 fixnum-fast fixnum-bitand ; inline
17 : hash@ ( key array -- i )
18 [ hashcode >fixnum dup fixnum+fast ] dip wrap ; inline
20 : probe ( array i probe# -- array i probe# )
21 2 fixnum+fast [ fixnum+fast over wrap ] keep ; inline
23 : no-key ( key array -- array n ? ) nip f f ; inline
25 : (key@) ( key array i probe# -- array n ? )
26 [ 3dup swap array-nth ] dip over ((empty)) eq?
27 [ drop 3drop no-key ] [
32 ] if ; inline recursive
34 : key@ ( key hash -- array n ? )
35 array>> dup length>> 0 eq?
36 [ no-key ] [ 2dup hash@ 0 (key@) ] if ; inline
38 : <hash-array> ( n -- array )
39 1 + next-power-of-2 4 * ((empty)) <array> ; inline
41 : init-hash ( hash -- )
42 0 >>count 0 >>deleted drop ; inline
44 : reset-hash ( n hash -- )
45 swap <hash-array> >>array init-hash ; inline
47 : hash-count+ ( hash -- )
48 [ 1 fixnum+fast ] change-count drop ; inline
50 : hash-deleted+ ( hash -- )
51 [ 1 fixnum+fast ] change-deleted drop ; inline
53 : hash-deleted- ( hash -- )
54 [ 1 fixnum-fast ] change-deleted drop ; inline
56 ! i = first-empty-or-found
58 ! empty? = if true, key was not found
61 ! - we want to store into i
64 ! - we want to store into j if j is not f
65 ! - otherwise we want to store into i
66 ! - ... and increment count
68 : (new-key@) ( key array i probe# j -- array i j empty? )
69 [ 2dup swap array-nth ] 2dip pick tombstone?
72 [ nip [ drop ] 3dip t ]
73 [ pick or [ probe ] dip (new-key@) ]
76 [ [ pick ] dip = ] 2dip rot
77 [ nip [ drop ] 3dip f ]
78 [ [ probe ] dip (new-key@) ]
80 ] if ; inline recursive
82 : new-key@ ( key hash -- array n )
83 [ array>> 2dup hash@ 0 f (new-key@) ] keep swap
84 [ over [ hash-deleted- ] [ hash-count+ ] if swap or ] [ 2drop ] if ; inline
86 : set-nth-pair ( value key seq n -- )
87 2 fixnum+fast [ set-slot ] 2keep
88 1 fixnum+fast set-slot ; inline
90 : (rehash) ( hash alist -- )
91 swap [ swapd set-at ] curry assoc-each ; inline
93 : hash-large? ( hash -- ? )
94 [ count>> 3 fixnum*fast 1 fixnum+fast ]
95 [ array>> length>> ] bi fixnum> ; inline
97 : grow-hash ( hash -- )
98 [ [ >alist ] [ assoc-size 1 + ] bi ] keep
102 : ?grow-hash ( hash -- )
103 dup hash-large? [ grow-hash ] [ drop ] if ; inline
107 : <hashtable> ( n -- hash )
108 hashtable new [ reset-hash ] keep ; inline
110 M: hashtable at* ( key hash -- value ? )
111 key@ [ 3 fixnum+fast slot t ] [ 2drop f f ] if ;
113 M: hashtable clear-assoc ( hash -- )
114 [ init-hash ] [ array>> [ drop ((empty)) ] map! drop ] bi ;
116 M: hashtable delete-at ( key hash -- )
117 [ nip ] [ key@ ] 2bi [
118 [ ((tombstone)) dup ] 2dip set-nth-pair
124 M: hashtable assoc-size ( hash -- n )
125 [ count>> ] [ deleted>> ] bi - ; inline
128 dup >alist [ dup clear-assoc ] dip (rehash) ;
130 M: hashtable set-at ( value key hash -- )
131 dup ?grow-hash dupd new-key@ set-nth-pair ;
133 : associate ( value key -- hash )
134 2 <hashtable> [ set-at ] keep ;
138 : push-unsafe ( elt seq -- )
140 [ underlying>> set-array-nth ]
141 [ [ 1 fixnum+fast { array-capacity } declare ] dip length<< ]
147 [ array>> [ length 2/ ] keep ] [ assoc-size <vector> ] bi [
150 [ 1 fixnum-shift-fast ] dip
151 [ array-nth ] [ [ 1 fixnum+fast ] dip array-nth ] 2bi
153 pick tombstone? [ 3drop ] [ [ 2array ] dip push-unsafe ] if
154 ] 2curry each-integer
158 (clone) [ clone ] change-array ; inline
161 over hashtable? [ assoc= ] [ 2drop f ] if ;
164 M: assoc new-assoc drop <hashtable> ; inline
166 M: f new-assoc drop <hashtable> ; inline
168 : >hashtable ( assoc -- hashtable )
169 H{ } assoc-clone-like ;
171 M: hashtable assoc-like
172 drop dup hashtable? [ >hashtable ] unless ; inline
174 : ?set-at ( value key assoc/f -- assoc )
175 [ [ set-at ] keep ] [ associate ] if* ;
177 ! borrowed from boost::hash_combine, but the
178 ! magic number is 2^29/phi instead of 2^32/phi
179 ! due to max fixnum value on 32-bit machines
180 : hash-combine ( obj oldhash -- newhash )
181 [ hashcode 0x13c6ef37 + ] dip
182 [ 6 shift ] [ -2 shift ] bi + + ;
184 INSTANCE: hashtable assoc