/pliant/language/type/set/dictionary.pli
1	# Copyright  Hubert Tonneau  hubert.tonneau@pliant.cx
2	#
3	# This program is free software; you can redistribute it and/or
4	# modify it under the terms of the GNU General Public License version 2
5	# as published by the Free Software Foundation.
6	#
7	# This program is distributed in the hope that it will be useful,
8	# but WITHOUT ANY WARRANTY; without even the implied warranty of
9	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
10	# GNU General Public License for more details.
11	#
12	# You should have received a copy of the GNU General Public License
13	# version 2 along with this program; if not, write to the Free Software
14	# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
15
16	scope "/pliant/language/" "/pliant/install/"
17	module "/pliant/install/ring2.pli"
18	submodule "common.pli"
19
20	doc
21	[Todo: use a better hashing function.]
22
23
24	function update_hash_key u adr size
25	arg_rw uInt u ; arg Address adr ; arg Int size
26	for (var Int offset) 0 size-uInt:size step uInt:size
27	u := u .xor. ((adr translate Byte offset) map uInt)
28	u := (u .*. 2^11) .or. (u \ 2^(32-11))
29	if size%uInt:size<>0
30	u := u .xor. ( ((adr translate uInt size\uInt:size) map uInt) .and. 2^(8*(size%uInt:size))-1 )
31
32	function hash i -> u
33	arg Int i ; arg uInt u
34	u := addressof:i map uInt
35
36	function hash i -> u
37	arg uInt i ; arg uInt u
38	u := i
39
40	function hash s -> u
41	arg Str s ; arg uInt u
42	u := 0
43	update_hash_key u s:characters s:len
44
45	export update_hash_key hash
46
47
48	function find_hash_function t -> f
49	arg Type t ; arg_RW Function f
50	var Pointer:Arrow c :> pliant_general_dictionary first "hash"
51	while c<>null
52	if entry_type:c=Function
53	f :> c map Function
54	if f:nb_args_with_result=2 and (f arg 0):type=t and (f arg 1):type=uInt
55	return
56	c :> pliant_general_dictionary next "hash" c
57	f :> null map Function
58
59
60
61
62
63	gvar Relation 'pliant dictionary types'
64	export 'pliant dictionary types'
65
66	function Dictionary key value -> t
67	arg Type key value ; arg_R Type t
68	has_no_side_effect
69
70	var Address adr := 'pliant dictionary types' query addressof:key addressof:value
71	if adr<>null
72	return (adr map Type)
73
74	var Pointer:Function f :> find_hash_function key
75	if addressof:f=null and (key:flags .and. type_flag_scalar)<>0
76	runtime_compile Key key
77	function hash k -> u
78	arg Key k ; arg uInt u
79	u := 0
80	update_hash_key u addressof:k Key:size
81	export hash
82	var Pointer:Function f :> find_hash_function key
83	if addressof:f=null
84	error error_id_compile "There is no hash function available for "+key:name
85	t :> Void ; return
86
87	runtime_compile  Key key Value value  Dictionary (cast "(Dictionary "+key:name+" "+value:name+")" Ident)  DictionaryNode (cast "(DictionaryNode "+key:name+" "+value:name+")" Ident)  hash_key (cast "hash "+key:name+" "+value:name Ident)  hash_function f  nodiv false  real addressof:value=(addressof value:real_data_type)
88
89	function hash_key k -> u
90	arg Universal k ; arg uInt u
91	u := hash_function (addressof:k map Key)
92
93	type DictionaryNode
94	field Pointer:DictionaryNode next_node
95	field Key key
96	field Value value
97
98	type Dictionary
99	field Address table
100	field Int hashsize
101	if nodiv
102	field uInt mask
103	field Int count
104
105	function build  d
106	arg_w Dictionary d
107	d table := null
108	d hashsize := 0
109	if nodiv
110	d mask := 0
111	d count := 0
112
113	function destroy d
114	arg_w Dictionary d
115	for (var Int i) 0 d:hashsize-1
116	var Pointer:DictionaryNode n :> (d:table translate Address i) map Pointer:DictionaryNode
117	while addressof:n<>null
118	var Pointer:DictionaryNode n2 :> n next_node
119	DictionaryNode destroy_instance addressof:n
120	memory_free addressof:n
121	n :> n2
122	memory_free d:table
123
124	method d walk i v
125	arg Dictionary d ; arg Int i ; arg_w Pointer:Value v
126	var Int j := i
127	while true
128	if j=d:hashsize
129	if real
130	v :> null map Value
131	else
132	(addressof Pointer:Value v) map Address := null
133	return
134	var Pointer:DictionaryNode n :> (d:table translate Address j) map Pointer:DictionaryNode
135	if addressof:n<>null
136	if real
137	v :> n value
138	else
139	(addressof Pointer:Value v) map Address := addressof Value n:value
140	return
141	j := j+1
142
143	method d next v1 -> v2
144	arg Dictionary d ; arg_r Value v1 ; arg_C Value v2
145	var Pointer:DictionaryNode n1 :> ((addressof:v1 translate Value 1) translate DictionaryNode -1) map DictionaryNode
146	var Pointer:DictionaryNode n2 :> n1 next_node
147	if addressof:n2<>null
148	if real
149	v2 :> n2 value
150	else
151	(addressof Pointer:Value v2) map Address := addressof Value n2:value
152	else
153	d walk (hash_key n1:key)%(cast d:hashsize uInt)+1 v2
154
155	method d first -> v
156	arg Dictionary d  ; arg_C Value v
157	d walk 0 v
158
159	method d walk k start v
160	arg Dictionary d ; arg Key k ; arg DictionaryNode start ; arg_w Pointer:Value v
161	var Pointer:DictionaryNode n :> start
162	while addressof:n<>null
163	if n:key=k
164	if real
165	v :> n value
166	else
167	(addressof Pointer:Value v) map Address := addressof Value n:value
168	return
169	n :> n next_node
170	if real
171	v :> null map Value
172	else
173	(addressof Pointer:Value v) map Address := null
174
175	method d first k -> v
176	arg Dictionary d ; arg Key k ; arg_C Value v
177	if d:hashsize<>0
178	if nodiv
179	var Int i
180	if d:mask<>0
181	i := hash_key:k .and. d:mask
182	else
183	i := hash_key:k%(cast d:hashsize uInt)
184	else
185	var Int i := hash_key:k%(cast d:hashsize uInt)
186	var Pointer:DictionaryNode n :> (d:table translate Address i) map Pointer:DictionaryNode
187	d walk k n v
188	else
189	if real
190	v :> null map Value
191	else
192	(addressof Pointer:Value v) map Address := null
193
194	method d first k default -> v
195	arg_rw Dictionary d ; arg Key k ; arg Value default ; arg_C Value v
196	v :> d first k
197	if not exists:v
198	v :> default
199
200	method d next k v1 -> v2
201	arg Dictionary d ; arg Key k ; arg_r Value v1 ; arg_C Value v2
202	var Pointer:DictionaryNode n :> ((addressof:v1 translate Value 1) translate DictionaryNode -1) map DictionaryNode
203	d walk k n:next_node v2
204
205	method d exists k -> c
206	arg Dictionary d ; arg Key k ; arg CBool c
207	c := exists (d first k)
208
209	method d '' k -> v
210	arg Dictionary d ; arg Key k ; arg_C Value v
211	(addressof Pointer:Value v) map Address := addressof Value (d first k)
212	if (addressof Value v)=null
213	error error_id_missing "there is no such key in the Dictionary"
214
215	method d resize size
216	arg_rw Dictionary d ; arg Int size
217	var Address newtable := memory_zallocate size*Address:size addressof:d
218	for (var Int i) 0 d:hashsize-1
219	var Pointer:DictionaryNode n :> (d:table translate Address i) map Pointer:DictionaryNode
220	while addressof:n<>null
221	var Pointer:DictionaryNode n2 :> n next_node
222	var Int newi := (hash_key n:key)%(cast size uInt)
223	n next_node :> (newtable translate Address newi) map Pointer:DictionaryNode
224	(newtable translate Address newi) map Pointer:DictionaryNode :> n
225	n :> n2
226	memory_free d:table
227	d table := newtable
228	d hashsize := size
229	if nodiv
230	d mask := 0
231	for (var Int i) 0 30
232	if 2^i=d:hashsize
233	d mask := d:hashsize-1
234	if 2^i>=d:hashsize
235	return
236
237	method d insert k v -> v2
238	arg_rw Dictionary d ; arg Key k ; arg Value v ; arg_C Value v2
239	if d:count>=d:hashsize
240	d resize (max 2*d:count 16)
241	var Pointer:DictionaryNode n :> (memory_allocate DictionaryNode:size addressof:d) map DictionaryNode
242	DictionaryNode build_instance addressof:n
243	Key copy_instance (addressof Key k) (addressof Key n:key)
244	Value copy_instance (addressof Value v) (addressof Value n:value)
245	var Int i := hash_key:k%(cast d:hashsize uInt)
246	n next_node :> (d:table translate Address i) map Pointer:DictionaryNode
247	(d:table translate Address i) map Pointer:DictionaryNode :> n
248	if real
249	v2 :> n value
250	else
251	(addressof Pointer:Value v2) map Address := addressof Value n:value
252	d count := d:count+1
253
254	method d '' k default -> v
255	arg_rw Dictionary d ; arg Key k ; arg Value default ; arg_C Value v
256	v :> d first k
257	if not exists:v
258	v :> d insert k default
259
260	function '-=' d v
261	arg_rw Dictionary d ; arg_r Value v
262	if d:hashsize=0
263	return
264	var Pointer:DictionaryNode n :> ((addressof:v translate Value 1) translate DictionaryNode -1) map DictionaryNode
265	var Int i := (hash_key n:key)%(cast d:hashsize uInt)
266	var (Pointer Pointer:DictionaryNode) ptr :>> (d:table translate Address i) map Pointer:DictionaryNode
267	while addressof:ptr<>addressof:n
268	ptr :>> ptr next_node
269	ptr :> n next_node
270	DictionaryNode destroy_instance addressof:n
271	memory_free addressof:n
272	d count := d:count-1
273
274	method d remove v -> v2
275	arg_rw Dictionary d ; arg_r Value v ; arg_C Value v2
276	if real
277	v2 :> d next v
278	else
279	(addressof Pointer:Value v2) map Address := addressof Value (d next v)
280	d -= v
281
282	method d key v -> k
283	arg Dictionary d ; arg_r Value v ; arg_R Key k
284	k :> (((addressof:v translate Value 1) translate DictionaryNode -1) map DictionaryNode) key
285
286	method d size -> n
287	arg Dictionary d ; arg Int n
288	n := d count
289
290	function copy src dest
291	arg Dictionary src ; arg_w Dictionary dest
292	Dictionary destroy_instance addressof:dest
293	Dictionary build_instance addressof:dest
294	dest resize src:size
295	for (var Int i) 0 src:hashsize-1
296	var Pointer:DictionaryNode n :> (src:table translate Address i) map Pointer:DictionaryNode
297	while addressof:n<>null
298	dest insert n:key n:value
299	n :> n next_node
300
301	method d check
302	arg Dictionary d
303	if pliant_debugging_level>=2
304	for (var Int i) 0 d:hashsize-1
305	var Pointer:DictionaryNode n :> (d:table translate Address i) map Pointer:DictionaryNode
306	while addressof:n<>null
307	check (hash_key n:key)%(cast d:hashsize uInt)=i
308	n :> n next_node
309
310	export Dictionary '' '. exists' '. first' '. next' '. key' '. insert' '. remove' '. resize' '-=' '. size' '. check'
311	'pliant dictionary types' define addressof:Key addressof:Value addressof:Dictionary
312	'pliant set types' define addressof:Dictionary addressof:Dictionary addressof:(new Str "Dictionary")
313	'pliant set types' define addressof:Dictionary null addressof:Key
314	'pliant set types' define null addressof:Dictionary addressof:Value
315
316	var Address adr := 'pliant dictionary types' query addressof:key addressof:value
317	check adr<>null
318	return (adr map Type)
319
320	export Dictionary
321