34
38
39:- module(chr_hashtable_store,
40 [ new_ht/1,
41 lookup_ht/3,
42 lookup_ht1/4,
43 lookup_ht2/4,
44 insert_ht/3,
45 insert_ht1/4,
46 insert_ht/4,
47 delete_ht/3,
48 delete_ht1/4,
49 delete_first_ht/3,
50 value_ht/2,
51 stats_ht/1,
52 stats_ht/1
53 ]). 54
55:- use_module(pairlist). 56:- use_module(library(dialect/hprolog)). 57:- use_module(library(lists)). 58
59:- multifile user:goal_expansion/2. 60:- dynamic user:goal_expansion/2. 61
62initial_capacity(89).
63
64new_ht(HT) :-
65 initial_capacity(Capacity),
66 new_ht(Capacity,HT).
67
68new_ht(Capacity,HT) :-
69 functor(T1,t,Capacity),
70 HT = ht(Capacity,0,Table),
71 Table = T1.
72
73lookup_ht(HT,Key,Values) :-
74 term_hash(Key,Hash),
75 lookup_ht1(HT,Hash,Key,Values).
88
90
104
105lookup_ht1(HT,Hash,Key,Values) :-
106 HT = ht(Capacity,_,Table),
107 Index is (Hash mod Capacity) + 1,
108 arg(Index,Table,Bucket),
109 nonvar(Bucket),
110 ( Bucket = K-Vs ->
111 K == Key,
112 Values = Vs
113 ;
114 lookup(Bucket,Key,Values)
115 ).
116
117lookup_ht2(HT,Key,Values,Index) :-
118 term_hash(Key,Hash),
119 HT = ht(Capacity,_,Table),
120 Index is (Hash mod Capacity) + 1,
121 arg(Index,Table,Bucket),
122 nonvar(Bucket),
123 ( Bucket = K-Vs ->
124 K == Key,
125 Values = Vs
126 ;
127 lookup(Bucket,Key,Values)
128 ).
129
130lookup_pair_eq([P | KVs],Key,Pair) :-
131 P = K-_,
132 ( K == Key ->
133 P = Pair
134 ;
135 lookup_pair_eq(KVs,Key,Pair)
136 ).
137
138insert_ht(HT,Key,Value) :-
139 term_hash(Key,Hash),
140 HT = ht(Capacity0,Load,Table0),
141 LookupIndex is (Hash mod Capacity0) + 1,
142 arg(LookupIndex,Table0,LookupBucket),
143 ( var(LookupBucket) ->
144 LookupBucket = Key - [Value]
145 ; LookupBucket = K-Values ->
146 ( K == Key ->
147 setarg(2,LookupBucket,[Value|Values])
148 ;
149 setarg(LookupIndex,Table0,[Key-[Value],LookupBucket])
150 )
151 ;
152 ( lookup_pair_eq(LookupBucket,Key,Pair) ->
153 Pair = _-Values,
154 setarg(2,Pair,[Value|Values])
155 ;
156 setarg(LookupIndex,Table0,[Key-[Value]|LookupBucket])
157 )
158 ),
159 NLoad is Load + 1,
160 setarg(2,HT,NLoad),
161 ( Load == Capacity0 ->
162 expand_ht(HT,_Capacity)
163 ;
164 true
165 ).
166
167insert_ht1(HT,Key,Hash,Value) :-
168 HT = ht(Capacity0,Load,Table0),
169 LookupIndex is (Hash mod Capacity0) + 1,
170 arg(LookupIndex,Table0,LookupBucket),
171 ( var(LookupBucket) ->
172 LookupBucket = Key - [Value]
173 ; LookupBucket = K-Values ->
174 ( K == Key ->
175 setarg(2,LookupBucket,[Value|Values])
176 ;
177 setarg(LookupIndex,Table0,[Key-[Value],LookupBucket])
178 )
179 ;
180 ( lookup_pair_eq(LookupBucket,Key,Pair) ->
181 Pair = _-Values,
182 setarg(2,Pair,[Value|Values])
183 ;
184 setarg(LookupIndex,Table0,[Key-[Value]|LookupBucket])
185 )
186 ),
187 NLoad is Load + 1,
188 setarg(2,HT,NLoad),
189 ( Load == Capacity0 ->
190 expand_ht(HT,_Capacity)
191 ;
192 true
193 ).
194
196
197insert_ht(HT,Key,Value,Result) :-
198 HT = ht(Capacity,Load,Table),
199 term_hash(Key,Hash),
200 LookupIndex is (Hash mod Capacity) + 1,
201 arg(LookupIndex,Table,LookupBucket),
202 ( var(LookupBucket)
203 -> Result = [Value],
204 LookupBucket = Key - Result,
205 NewLoad is Load + 1
206 ; LookupBucket = K - V
207 -> ( K = Key
208 -> Result = [Value|V],
209 setarg(2,LookupBucket,Result),
210 NewLoad = Load
211 ; Result = [Value],
212 setarg(LookupIndex,Table,[Key - Result,LookupBucket]),
213 NewLoad is Load + 1
214 )
215 ; ( lookup_pair_eq(LookupBucket,Key,Pair)
216 -> Pair = _-Values,
217 Result = [Value|Values],
218 setarg(2,Pair,Result),
219 NewLoad = Load
220 ; Result = [Value],
221 setarg(LookupIndex,Table,[Key - Result|LookupBucket]),
222 NewLoad is Load + 1
223 )
224 ),
225 setarg(2,HT,NewLoad),
226 ( NewLoad > Capacity
227 -> expand_ht(HT,_)
228 ; true
229 ).
230
232delete_first_ht(HT,Key,Values) :-
233 HT = ht(Capacity,Load,Table),
234 term_hash(Key,Hash),
235 Index is (Hash mod Capacity) + 1,
236 arg(Index,Table,Bucket),
237 ( Bucket = _-[_|Values]
238 -> ( Values = []
239 -> setarg(Index,Table,_),
240 NewLoad is Load - 1
241 ; setarg(2,Bucket,Values),
242 NewLoad = Load
243 )
244 ; lookup_pair_eq(Bucket,Key,Pair)
245 -> Pair = _-[_|Values],
246 ( Values = []
247 -> pairlist_delete_eq(Bucket,Key,NewBucket),
248 ( NewBucket = []
249 -> setarg(Index,Table,_)
250 ; NewBucket = [OtherPair]
251 -> setarg(Index,Table,OtherPair)
252 ; setarg(Index,Table,NewBucket)
253 ),
254 NewLoad is Load - 1
255 ; setarg(2,Pair,Values),
256 NewLoad = Load
257 )
258 ),
259 setarg(2,HT,NewLoad).
260
261delete_ht(HT,Key,Value) :-
262 HT = ht(Capacity,Load,Table),
263 NLoad is Load - 1,
264 term_hash(Key,Hash),
265 Index is (Hash mod Capacity) + 1,
266 arg(Index,Table,Bucket),
267 ( Bucket = _K-Vs ->
270 ( 271 delete_first_fail(Vs,Value,NVs) ->
272 setarg(2,HT,NLoad),
273 ( NVs == [] ->
274 setarg(Index,Table,_)
275 ;
276 setarg(2,Bucket,NVs)
277 )
278 ;
279 true
280 )
281 ;
282 ( lookup_pair_eq(Bucket,Key,Pair),
283 Pair = _-Vs,
284 delete_first_fail(Vs,Value,NVs) ->
285 setarg(2,HT,NLoad),
286 ( NVs == [] ->
287 pairlist_delete_eq(Bucket,Key,NBucket),
288 ( NBucket = [Singleton] ->
289 setarg(Index,Table,Singleton)
290 ;
291 setarg(Index,Table,NBucket)
292 )
293 ;
294 setarg(2,Pair,NVs)
295 )
296 ;
297 true
298 )
299 ).
300
301delete_first_fail([X | Xs], Y, Zs) :-
302 ( X == Y ->
303 Zs = Xs
304 ;
305 Zs = [X | Zs1],
306 delete_first_fail(Xs, Y, Zs1)
307 ).
308
309delete_ht1(HT,Key,Value,Index) :-
310 HT = ht(_Capacity,Load,Table),
311 NLoad is Load - 1,
312 313 314 arg(Index,Table,Bucket),
315 ( Bucket = _K-Vs ->
318 ( 319 delete_first_fail(Vs,Value,NVs) ->
320 setarg(2,HT,NLoad),
321 ( NVs == [] ->
322 setarg(Index,Table,_)
323 ;
324 setarg(2,Bucket,NVs)
325 )
326 ;
327 true
328 )
329 ;
330 ( lookup_pair_eq(Bucket,Key,Pair),
331 Pair = _-Vs,
332 delete_first_fail(Vs,Value,NVs) ->
333 setarg(2,HT,NLoad),
334 ( NVs == [] ->
335 pairlist_delete_eq(Bucket,Key,NBucket),
336 ( NBucket = [Singleton] ->
337 setarg(Index,Table,Singleton)
338 ;
339 setarg(Index,Table,NBucket)
340 )
341 ;
342 setarg(2,Pair,NVs)
343 )
344 ;
345 true
346 )
347 ).
349value_ht(HT,Value) :-
350 HT = ht(Capacity,_,Table),
351 value_ht(1,Capacity,Table,Value).
352
353value_ht(I,N,Table,Value) :-
354 I =< N,
355 arg(I,Table,Bucket),
356 (
357 nonvar(Bucket),
358 ( Bucket = _-Vs ->
359 true
360 ;
361 member(_-Vs,Bucket)
362 ),
363 member(Value,Vs)
364 ;
365 J is I + 1,
366 value_ht(J,N,Table,Value)
367 ).
368
370
371expand_ht(HT,NewCapacity) :-
372 HT = ht(Capacity,_,Table),
373 NewCapacity is Capacity * 2 + 1,
374 functor(NewTable,t,NewCapacity),
375 setarg(1,HT,NewCapacity),
376 setarg(3,HT,NewTable),
377 expand_copy(Table,1,Capacity,NewTable,NewCapacity).
378
379expand_copy(Table,I,N,NewTable,NewCapacity) :-
380 ( I > N ->
381 true
382 ;
383 arg(I,Table,Bucket),
384 ( var(Bucket) ->
385 true
386 ; Bucket = Key - Value ->
387 expand_insert(NewTable,NewCapacity,Key,Value)
388 ;
389 expand_inserts(Bucket,NewTable,NewCapacity)
390 ),
391 J is I + 1,
392 expand_copy(Table,J,N,NewTable,NewCapacity)
393 ).
394
395expand_inserts([],_,_).
396expand_inserts([K-V|R],Table,Capacity) :-
397 expand_insert(Table,Capacity,K,V),
398 expand_inserts(R,Table,Capacity).
399
400expand_insert(Table,Capacity,K,V) :-
401 term_hash(K,Hash),
402 Index is (Hash mod Capacity) + 1,
403 arg(Index,Table,Bucket),
404 ( var(Bucket) ->
405 Bucket = K - V
406 ; Bucket = _-_ ->
407 setarg(Index,Table,[K-V,Bucket])
408 ;
409 setarg(Index,Table,[K-V|Bucket])
410 ).
412stats_ht(HT) :-
413 HT = ht(Capacity,Load,Table),
414 format('HT load = ~w / ~w\n',[Load,Capacity]),
415 ( between(1,Capacity,Index),
416 arg(Index,Table,Entry),
417 ( var(Entry) -> Size = 0
418 ; Entry = _-_ -> Size = 1
419 ; length(Entry,Size)
420 ),
421 format('~w : ~w\n',[Index,Size]),
422 fail
423 ;
424 true
425 )