1/*
2
3This code implements hash-arrays.
4It requires the hash key to be a ground term.
5
6It relies on dynamic array code.
7
8*/
9:- source.
10:- yap_flag(unknown,error).
11:- style_check(all).
12
13:- module(b_hash, [   b_hash_new/1,
14		      b_hash_new/2,
15		      b_hash_new/4,
16		      b_hash_lookup/3,
17		      b_hash_update/3,
18		      b_hash_update/4,
19		      b_hash_insert_new/4,
20		      b_hash_insert/4
21		    ]).
22
23:- use_module(library(terms), [ term_hash/4 ]).
24
25
26:- meta_predicate(b_hash_new(-,+,3,2)).
27
28array_default_size(2048).
29
30b_hash_new(hash(Keys, Vals, Size, N, _, _)) :-
31	array_default_size(Size),
32	array(Keys, Size),
33	array(Vals, Size),
34	create_mutable(0, N).
35
36b_hash_new(hash(Keys, Vals, Size, N, _, _), Size) :-
37	array(Keys, Size),
38	array(Vals, Size),
39	create_mutable(0, N).
40
41b_hash_new(hash(Keys,Vals, Size, N, HashF, CmpF), Size, HashF, CmpF) :-
42	array(Keys, Size),
43	array(Vals, Size),
44	create_mutable(0, N).
45
46b_hash_lookup(Key, Val, hash(Keys, Vals, Size, _, F, CmpF)):-
47	hash_f(Key, Size, Index, F),
48	fetch_key(Keys, Index, Size, Key, CmpF, ActualIndex),
49	array_element(Vals, ActualIndex, Mutable),
50	get_mutable(Val, Mutable).
51
52fetch_key(Keys, Index, Size, Key, CmpF, ActualIndex) :-
53	array_element(Keys, Index, El),
54	nonvar(El),
55	(
56	    cmp_f(CmpF, El, Key)
57	->
58	    Index = ActualIndex
59	;
60	    I1 is (Index+1) mod Size,
61	    fetch_key(Keys, I1, Size, Key, CmpF, ActualIndex)
62	).
63
64b_hash_update(Hash, Key, NewVal):-
65	Hash = hash(Keys, Vals, Size, _, F, CmpF),
66	hash_f(Key,Size,Index,F),
67	fetch_key(Keys, Index, Size, Key, CmpF, ActualIndex),
68	array_element(Vals, ActualIndex, Mutable),
69	update_mutable(NewVal, Mutable).
70
71b_hash_update(Hash, Key, OldVal, NewVal):-
72	Hash = hash(Keys, Vals, Size, _, F, CmpF),
73	hash_f(Key,Size,Index,F),
74	fetch_key(Keys, Index, Size, Key, CmpF, ActualIndex),
75	array_element(Vals, ActualIndex, Mutable),
76	get_mutable(OldVal, Mutable),
77	update_mutable(NewVal, Mutable).
78
79b_hash_insert(Hash, Key, NewVal, NewHash):-
80	Hash = hash(Keys, Vals, Size, N, F, CmpF),
81	hash_f(Key,Size,Index,F),
82	find_or_insert(Keys, Index, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash).
83
84find_or_insert(Keys, Index, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash) :-
85	array_element(Keys, Index, El),
86	(
87	    var(El)
88	->
89	    add_element(Keys, Index, Size, N, Vals, Key, NewVal, Hash, NewHash)
90	;
91	    cmp_f(CmpF, El, Key)
92	->
93	     % do rb_update
94	    array_element(Vals, Index, Mutable),
95	    update_mutable(NewVal, Mutable)
96        ;
97	    I1 is (Index+1) mod Size,
98	    find_or_insert(Keys, I1, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash)
99	).
100
101b_hash_insert_new(Hash, Key, NewVal, NewHash):-
102	Hash = hash(Keys, Vals, Size, N, F, CmpF),
103	hash_f(Key,Size,Index,F),
104	find_or_insert_new(Keys, Index, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash).
105
106find_or_insert_new(Keys, Index, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash) :-
107	array_element(Keys, Index, El),
108	(
109	    var(El)
110	->
111	    add_element(Keys, Index, Size, N, Vals, Key, NewVal, Hash, NewHash)
112	;
113	    cmp_f(CmpF, El, Key)
114	->
115	    fail
116        ;
117	    I1 is (Index+1) mod Size,
118	    find_or_insert_new(Keys, I1, Size, N, CmpF, Vals, Key, NewVal, Hash, NewHash)
119	).
120
121add_element(Keys, Index, Size, N, Vals, Key, NewVal, Hash, NewHash) :-
122	get_mutable(NEls, N),
123	NN is NEls+1,
124	update_mutable(NN, N),
125	(
126	    NN > Size/3
127	->
128	    expand_array(Hash, NewHash)
129	;
130	    Hash = NewHash
131	),
132	array_element(Keys, Index, Key),
133	update_mutable(NN, N),
134	array_element(Vals, Index, Mutable),
135	create_mutable(NewVal, Mutable).
136
137expand_array(Hash, hash(NewKeys, NewVals, NewSize, X, F, CmpF)) :-
138	Hash = hash(Keys, Vals, Size, X, F, CmpF),
139	new_size(Size, NewSize),
140	array(NewKeys, NewSize),
141	array(NewVals, NewSize),
142	copy_hash_table(Size, Keys, Vals, F, NewSize, NewKeys, NewVals).
143
144new_size(Size, NewSize) :-
145	Size > 1048576, !,
146	NewSize is Size+1048576.
147new_size(Size, NewSize) :-
148	NewSize is Size*2.
149
150copy_hash_table(0, _, _, _, _, _, _) :- !.
151copy_hash_table(I1, Keys, Vals, F, Size, NewKeys, NewVals) :-
152	I is I1-1,
153	array_element(Keys, I, Key),
154	nonvar(Key), !,
155	array_element(Vals, I, Val),
156	insert_el(Key, Val, Size, F, NewKeys, NewVals),
157	copy_hash_table(I, Keys, Vals, F, Size, NewKeys, NewVals).
158copy_hash_table(I1, Keys, Vals, F, Size, NewKeys, NewVals) :-
159	I is I1-1,
160	copy_hash_table(I, Keys, Vals, F, Size, NewKeys, NewVals).
161
162insert_el(Key, Val, Size, F, NewKeys, NewVals) :-
163	hash_f(Key,Size,Index, F),
164	find_free(Index, Size, NewKeys, TrueIndex),
165	array_element(NewKeys, TrueIndex, Key),
166	array_element(NewVals, TrueIndex, Val).
167
168find_free(Index, Size, Keys, NewIndex) :-
169	array_element(Keys, Index, El),
170	(
171	    var(El)
172	->
173	    NewIndex = Index
174	;
175	    I1 is (Index+1) mod Size,
176	    find_free(I1, Size, Keys, NewIndex)
177	).
178
179hash_f(Key, Size, Index, F) :-
180	var(F), !,
181	term_hash(Key,-1,Size,Index).
182hash_f(Key, Size, Index, F) :-
183	call(F, Key, Size, Index).
184
185cmp_f(F, A, B) :-
186	var(F), !,
187	A == B.
188cmp_f(F, A, B) :-
189	call(F, A, B).
190
191