annotate gcc/ada/libgnat/a-chtgop.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT LIBRARY COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
5 -- ADA.CONTAINERS.HASH_TABLES.GENERIC_OPERATIONS --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
9 -- Copyright (C) 2004-2018, Free Software Foundation, Inc. --
111
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNAT is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
kono
parents:
diff changeset
17 -- --
kono
parents:
diff changeset
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
kono
parents:
diff changeset
19 -- additional permissions described in the GCC Runtime Library Exception, --
kono
parents:
diff changeset
20 -- version 3.1, as published by the Free Software Foundation. --
kono
parents:
diff changeset
21 -- --
kono
parents:
diff changeset
22 -- You should have received a copy of the GNU General Public License and --
kono
parents:
diff changeset
23 -- a copy of the GCC Runtime Library Exception along with this program; --
kono
parents:
diff changeset
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
kono
parents:
diff changeset
25 -- <http://www.gnu.org/licenses/>. --
kono
parents:
diff changeset
26 -- --
kono
parents:
diff changeset
27 -- This unit was originally developed by Matthew J Heaney. --
kono
parents:
diff changeset
28 ------------------------------------------------------------------------------
kono
parents:
diff changeset
29
kono
parents:
diff changeset
30 with Ada.Containers.Prime_Numbers;
kono
parents:
diff changeset
31 with Ada.Unchecked_Deallocation;
kono
parents:
diff changeset
32
kono
parents:
diff changeset
33 with System; use type System.Address;
kono
parents:
diff changeset
34
kono
parents:
diff changeset
35 package body Ada.Containers.Hash_Tables.Generic_Operations is
kono
parents:
diff changeset
36
kono
parents:
diff changeset
37 pragma Warnings (Off, "variable ""Busy*"" is not referenced");
kono
parents:
diff changeset
38 pragma Warnings (Off, "variable ""Lock*"" is not referenced");
kono
parents:
diff changeset
39 -- See comment in Ada.Containers.Helpers
kono
parents:
diff changeset
40
kono
parents:
diff changeset
41 type Buckets_Allocation is access all Buckets_Type;
kono
parents:
diff changeset
42 -- Used for allocation and deallocation (see New_Buckets and Free_Buckets).
kono
parents:
diff changeset
43 -- This is necessary because Buckets_Access has an empty storage pool.
kono
parents:
diff changeset
44
kono
parents:
diff changeset
45 ------------
kono
parents:
diff changeset
46 -- Adjust --
kono
parents:
diff changeset
47 ------------
kono
parents:
diff changeset
48
kono
parents:
diff changeset
49 procedure Adjust (HT : in out Hash_Table_Type) is
kono
parents:
diff changeset
50 Src_Buckets : constant Buckets_Access := HT.Buckets;
kono
parents:
diff changeset
51 N : constant Count_Type := HT.Length;
kono
parents:
diff changeset
52 Src_Node : Node_Access;
kono
parents:
diff changeset
53 Dst_Prev : Node_Access;
kono
parents:
diff changeset
54
kono
parents:
diff changeset
55 begin
kono
parents:
diff changeset
56 -- If the counts are nonzero, execution is technically erroneous, but
kono
parents:
diff changeset
57 -- it seems friendly to allow things like concurrent "=" on shared
kono
parents:
diff changeset
58 -- constants.
kono
parents:
diff changeset
59
kono
parents:
diff changeset
60 Zero_Counts (HT.TC);
kono
parents:
diff changeset
61
kono
parents:
diff changeset
62 HT.Buckets := null;
kono
parents:
diff changeset
63 HT.Length := 0;
kono
parents:
diff changeset
64
kono
parents:
diff changeset
65 if N = 0 then
kono
parents:
diff changeset
66 return;
kono
parents:
diff changeset
67 end if;
kono
parents:
diff changeset
68
kono
parents:
diff changeset
69 -- Technically it isn't necessary to allocate the exact same length
kono
parents:
diff changeset
70 -- buckets array, because our only requirement is that following
kono
parents:
diff changeset
71 -- assignment the source and target containers compare equal (that is,
kono
parents:
diff changeset
72 -- operator "=" returns True). We can satisfy this requirement with any
kono
parents:
diff changeset
73 -- hash table length, but we decide here to match the length of the
kono
parents:
diff changeset
74 -- source table. This has the benefit that when iterating, elements of
kono
parents:
diff changeset
75 -- the target are delivered in the exact same order as for the source.
kono
parents:
diff changeset
76
kono
parents:
diff changeset
77 HT.Buckets := New_Buckets (Length => Src_Buckets'Length);
kono
parents:
diff changeset
78
kono
parents:
diff changeset
79 for Src_Index in Src_Buckets'Range loop
kono
parents:
diff changeset
80 Src_Node := Src_Buckets (Src_Index);
kono
parents:
diff changeset
81
kono
parents:
diff changeset
82 if Src_Node /= null then
kono
parents:
diff changeset
83 declare
kono
parents:
diff changeset
84 Dst_Node : constant Node_Access := Copy_Node (Src_Node);
kono
parents:
diff changeset
85
kono
parents:
diff changeset
86 -- See note above
kono
parents:
diff changeset
87
kono
parents:
diff changeset
88 pragma Assert (Checked_Index (HT, Dst_Node) = Src_Index);
kono
parents:
diff changeset
89
kono
parents:
diff changeset
90 begin
kono
parents:
diff changeset
91 HT.Buckets (Src_Index) := Dst_Node;
kono
parents:
diff changeset
92 HT.Length := HT.Length + 1;
kono
parents:
diff changeset
93
kono
parents:
diff changeset
94 Dst_Prev := Dst_Node;
kono
parents:
diff changeset
95 end;
kono
parents:
diff changeset
96
kono
parents:
diff changeset
97 Src_Node := Next (Src_Node);
kono
parents:
diff changeset
98 while Src_Node /= null loop
kono
parents:
diff changeset
99 declare
kono
parents:
diff changeset
100 Dst_Node : constant Node_Access := Copy_Node (Src_Node);
kono
parents:
diff changeset
101
kono
parents:
diff changeset
102 -- See note above
kono
parents:
diff changeset
103
kono
parents:
diff changeset
104 pragma Assert (Checked_Index (HT, Dst_Node) = Src_Index);
kono
parents:
diff changeset
105
kono
parents:
diff changeset
106 begin
kono
parents:
diff changeset
107 Set_Next (Node => Dst_Prev, Next => Dst_Node);
kono
parents:
diff changeset
108 HT.Length := HT.Length + 1;
kono
parents:
diff changeset
109
kono
parents:
diff changeset
110 Dst_Prev := Dst_Node;
kono
parents:
diff changeset
111 end;
kono
parents:
diff changeset
112
kono
parents:
diff changeset
113 Src_Node := Next (Src_Node);
kono
parents:
diff changeset
114 end loop;
kono
parents:
diff changeset
115 end if;
kono
parents:
diff changeset
116 end loop;
kono
parents:
diff changeset
117
kono
parents:
diff changeset
118 pragma Assert (HT.Length = N);
kono
parents:
diff changeset
119 end Adjust;
kono
parents:
diff changeset
120
kono
parents:
diff changeset
121 --------------
kono
parents:
diff changeset
122 -- Capacity --
kono
parents:
diff changeset
123 --------------
kono
parents:
diff changeset
124
kono
parents:
diff changeset
125 function Capacity (HT : Hash_Table_Type) return Count_Type is
kono
parents:
diff changeset
126 begin
kono
parents:
diff changeset
127 if HT.Buckets = null then
kono
parents:
diff changeset
128 return 0;
kono
parents:
diff changeset
129 end if;
kono
parents:
diff changeset
130
kono
parents:
diff changeset
131 return HT.Buckets'Length;
kono
parents:
diff changeset
132 end Capacity;
kono
parents:
diff changeset
133
kono
parents:
diff changeset
134 -------------------
kono
parents:
diff changeset
135 -- Checked_Index --
kono
parents:
diff changeset
136 -------------------
kono
parents:
diff changeset
137
kono
parents:
diff changeset
138 function Checked_Index
kono
parents:
diff changeset
139 (Hash_Table : aliased in out Hash_Table_Type;
kono
parents:
diff changeset
140 Buckets : Buckets_Type;
kono
parents:
diff changeset
141 Node : Node_Access) return Hash_Type
kono
parents:
diff changeset
142 is
kono
parents:
diff changeset
143 Lock : With_Lock (Hash_Table.TC'Unrestricted_Access);
kono
parents:
diff changeset
144 begin
kono
parents:
diff changeset
145 return Index (Buckets, Node);
kono
parents:
diff changeset
146 end Checked_Index;
kono
parents:
diff changeset
147
kono
parents:
diff changeset
148 function Checked_Index
kono
parents:
diff changeset
149 (Hash_Table : aliased in out Hash_Table_Type;
kono
parents:
diff changeset
150 Node : Node_Access) return Hash_Type
kono
parents:
diff changeset
151 is
kono
parents:
diff changeset
152 begin
kono
parents:
diff changeset
153 return Checked_Index (Hash_Table, Hash_Table.Buckets.all, Node);
kono
parents:
diff changeset
154 end Checked_Index;
kono
parents:
diff changeset
155
kono
parents:
diff changeset
156 -----------
kono
parents:
diff changeset
157 -- Clear --
kono
parents:
diff changeset
158 -----------
kono
parents:
diff changeset
159
kono
parents:
diff changeset
160 procedure Clear (HT : in out Hash_Table_Type) is
kono
parents:
diff changeset
161 Index : Hash_Type := 0;
kono
parents:
diff changeset
162 Node : Node_Access;
kono
parents:
diff changeset
163
kono
parents:
diff changeset
164 begin
kono
parents:
diff changeset
165 TC_Check (HT.TC);
kono
parents:
diff changeset
166
kono
parents:
diff changeset
167 while HT.Length > 0 loop
kono
parents:
diff changeset
168 while HT.Buckets (Index) = null loop
kono
parents:
diff changeset
169 Index := Index + 1;
kono
parents:
diff changeset
170 end loop;
kono
parents:
diff changeset
171
kono
parents:
diff changeset
172 declare
kono
parents:
diff changeset
173 Bucket : Node_Access renames HT.Buckets (Index);
kono
parents:
diff changeset
174 begin
kono
parents:
diff changeset
175 loop
kono
parents:
diff changeset
176 Node := Bucket;
kono
parents:
diff changeset
177 Bucket := Next (Bucket);
kono
parents:
diff changeset
178 HT.Length := HT.Length - 1;
kono
parents:
diff changeset
179 Free (Node);
kono
parents:
diff changeset
180 exit when Bucket = null;
kono
parents:
diff changeset
181 end loop;
kono
parents:
diff changeset
182 end;
kono
parents:
diff changeset
183 end loop;
kono
parents:
diff changeset
184 end Clear;
kono
parents:
diff changeset
185
kono
parents:
diff changeset
186 --------------------------
kono
parents:
diff changeset
187 -- Delete_Node_At_Index --
kono
parents:
diff changeset
188 --------------------------
kono
parents:
diff changeset
189
kono
parents:
diff changeset
190 procedure Delete_Node_At_Index
kono
parents:
diff changeset
191 (HT : in out Hash_Table_Type;
kono
parents:
diff changeset
192 Indx : Hash_Type;
kono
parents:
diff changeset
193 X : in out Node_Access)
kono
parents:
diff changeset
194 is
kono
parents:
diff changeset
195 Prev : Node_Access;
kono
parents:
diff changeset
196 Curr : Node_Access;
kono
parents:
diff changeset
197
kono
parents:
diff changeset
198 begin
kono
parents:
diff changeset
199 Prev := HT.Buckets (Indx);
kono
parents:
diff changeset
200
kono
parents:
diff changeset
201 if Prev = X then
kono
parents:
diff changeset
202 HT.Buckets (Indx) := Next (Prev);
kono
parents:
diff changeset
203 HT.Length := HT.Length - 1;
kono
parents:
diff changeset
204 Free (X);
kono
parents:
diff changeset
205 return;
kono
parents:
diff changeset
206 end if;
kono
parents:
diff changeset
207
kono
parents:
diff changeset
208 if Checks and then HT.Length = 1 then
kono
parents:
diff changeset
209 raise Program_Error with
kono
parents:
diff changeset
210 "attempt to delete node not in its proper hash bucket";
kono
parents:
diff changeset
211 end if;
kono
parents:
diff changeset
212
kono
parents:
diff changeset
213 loop
kono
parents:
diff changeset
214 Curr := Next (Prev);
kono
parents:
diff changeset
215
kono
parents:
diff changeset
216 if Checks and then Curr = null then
kono
parents:
diff changeset
217 raise Program_Error with
kono
parents:
diff changeset
218 "attempt to delete node not in its proper hash bucket";
kono
parents:
diff changeset
219 end if;
kono
parents:
diff changeset
220
kono
parents:
diff changeset
221 if Curr = X then
kono
parents:
diff changeset
222 Set_Next (Node => Prev, Next => Next (Curr));
kono
parents:
diff changeset
223 HT.Length := HT.Length - 1;
kono
parents:
diff changeset
224 Free (X);
kono
parents:
diff changeset
225 return;
kono
parents:
diff changeset
226 end if;
kono
parents:
diff changeset
227
kono
parents:
diff changeset
228 Prev := Curr;
kono
parents:
diff changeset
229 end loop;
kono
parents:
diff changeset
230 end Delete_Node_At_Index;
kono
parents:
diff changeset
231
kono
parents:
diff changeset
232 ---------------------------
kono
parents:
diff changeset
233 -- Delete_Node_Sans_Free --
kono
parents:
diff changeset
234 ---------------------------
kono
parents:
diff changeset
235
kono
parents:
diff changeset
236 procedure Delete_Node_Sans_Free
kono
parents:
diff changeset
237 (HT : in out Hash_Table_Type;
kono
parents:
diff changeset
238 X : Node_Access)
kono
parents:
diff changeset
239 is
kono
parents:
diff changeset
240 pragma Assert (X /= null);
kono
parents:
diff changeset
241
kono
parents:
diff changeset
242 Indx : Hash_Type;
kono
parents:
diff changeset
243 Prev : Node_Access;
kono
parents:
diff changeset
244 Curr : Node_Access;
kono
parents:
diff changeset
245
kono
parents:
diff changeset
246 begin
kono
parents:
diff changeset
247 if Checks and then HT.Length = 0 then
kono
parents:
diff changeset
248 raise Program_Error with
kono
parents:
diff changeset
249 "attempt to delete node from empty hashed container";
kono
parents:
diff changeset
250 end if;
kono
parents:
diff changeset
251
kono
parents:
diff changeset
252 Indx := Checked_Index (HT, X);
kono
parents:
diff changeset
253 Prev := HT.Buckets (Indx);
kono
parents:
diff changeset
254
kono
parents:
diff changeset
255 if Checks and then Prev = null then
kono
parents:
diff changeset
256 raise Program_Error with
kono
parents:
diff changeset
257 "attempt to delete node from empty hash bucket";
kono
parents:
diff changeset
258 end if;
kono
parents:
diff changeset
259
kono
parents:
diff changeset
260 if Prev = X then
kono
parents:
diff changeset
261 HT.Buckets (Indx) := Next (Prev);
kono
parents:
diff changeset
262 HT.Length := HT.Length - 1;
kono
parents:
diff changeset
263 return;
kono
parents:
diff changeset
264 end if;
kono
parents:
diff changeset
265
kono
parents:
diff changeset
266 if Checks and then HT.Length = 1 then
kono
parents:
diff changeset
267 raise Program_Error with
kono
parents:
diff changeset
268 "attempt to delete node not in its proper hash bucket";
kono
parents:
diff changeset
269 end if;
kono
parents:
diff changeset
270
kono
parents:
diff changeset
271 loop
kono
parents:
diff changeset
272 Curr := Next (Prev);
kono
parents:
diff changeset
273
kono
parents:
diff changeset
274 if Checks and then Curr = null then
kono
parents:
diff changeset
275 raise Program_Error with
kono
parents:
diff changeset
276 "attempt to delete node not in its proper hash bucket";
kono
parents:
diff changeset
277 end if;
kono
parents:
diff changeset
278
kono
parents:
diff changeset
279 if Curr = X then
kono
parents:
diff changeset
280 Set_Next (Node => Prev, Next => Next (Curr));
kono
parents:
diff changeset
281 HT.Length := HT.Length - 1;
kono
parents:
diff changeset
282 return;
kono
parents:
diff changeset
283 end if;
kono
parents:
diff changeset
284
kono
parents:
diff changeset
285 Prev := Curr;
kono
parents:
diff changeset
286 end loop;
kono
parents:
diff changeset
287 end Delete_Node_Sans_Free;
kono
parents:
diff changeset
288
kono
parents:
diff changeset
289 --------------
kono
parents:
diff changeset
290 -- Finalize --
kono
parents:
diff changeset
291 --------------
kono
parents:
diff changeset
292
kono
parents:
diff changeset
293 procedure Finalize (HT : in out Hash_Table_Type) is
kono
parents:
diff changeset
294 begin
kono
parents:
diff changeset
295 Clear (HT);
kono
parents:
diff changeset
296 Free_Buckets (HT.Buckets);
kono
parents:
diff changeset
297 end Finalize;
kono
parents:
diff changeset
298
kono
parents:
diff changeset
299 -----------
kono
parents:
diff changeset
300 -- First --
kono
parents:
diff changeset
301 -----------
kono
parents:
diff changeset
302
kono
parents:
diff changeset
303 function First
kono
parents:
diff changeset
304 (HT : Hash_Table_Type) return Node_Access
kono
parents:
diff changeset
305 is
kono
parents:
diff changeset
306 Dummy : Hash_Type;
kono
parents:
diff changeset
307 begin
kono
parents:
diff changeset
308 return First (HT, Dummy);
kono
parents:
diff changeset
309 end First;
kono
parents:
diff changeset
310
kono
parents:
diff changeset
311 function First
kono
parents:
diff changeset
312 (HT : Hash_Table_Type;
kono
parents:
diff changeset
313 Position : out Hash_Type) return Node_Access is
kono
parents:
diff changeset
314 begin
kono
parents:
diff changeset
315 if HT.Length = 0 then
kono
parents:
diff changeset
316 Position := Hash_Type'Last;
kono
parents:
diff changeset
317 return null;
kono
parents:
diff changeset
318 end if;
kono
parents:
diff changeset
319
kono
parents:
diff changeset
320 Position := HT.Buckets'First;
kono
parents:
diff changeset
321 loop
kono
parents:
diff changeset
322 if HT.Buckets (Position) /= null then
kono
parents:
diff changeset
323 return HT.Buckets (Position);
kono
parents:
diff changeset
324 end if;
kono
parents:
diff changeset
325
kono
parents:
diff changeset
326 Position := Position + 1;
kono
parents:
diff changeset
327 end loop;
kono
parents:
diff changeset
328 end First;
kono
parents:
diff changeset
329
kono
parents:
diff changeset
330 ------------------
kono
parents:
diff changeset
331 -- Free_Buckets --
kono
parents:
diff changeset
332 ------------------
kono
parents:
diff changeset
333
kono
parents:
diff changeset
334 procedure Free_Buckets (Buckets : in out Buckets_Access) is
kono
parents:
diff changeset
335 procedure Free is
kono
parents:
diff changeset
336 new Ada.Unchecked_Deallocation (Buckets_Type, Buckets_Allocation);
kono
parents:
diff changeset
337
kono
parents:
diff changeset
338 begin
kono
parents:
diff changeset
339 -- Buckets must have been created by New_Buckets. Here, we convert back
kono
parents:
diff changeset
340 -- to the Buckets_Allocation type, and do the free on that.
kono
parents:
diff changeset
341
kono
parents:
diff changeset
342 Free (Buckets_Allocation (Buckets));
kono
parents:
diff changeset
343 end Free_Buckets;
kono
parents:
diff changeset
344
kono
parents:
diff changeset
345 ---------------------
kono
parents:
diff changeset
346 -- Free_Hash_Table --
kono
parents:
diff changeset
347 ---------------------
kono
parents:
diff changeset
348
kono
parents:
diff changeset
349 procedure Free_Hash_Table (Buckets : in out Buckets_Access) is
kono
parents:
diff changeset
350 Node : Node_Access;
kono
parents:
diff changeset
351
kono
parents:
diff changeset
352 begin
kono
parents:
diff changeset
353 if Buckets = null then
kono
parents:
diff changeset
354 return;
kono
parents:
diff changeset
355 end if;
kono
parents:
diff changeset
356
kono
parents:
diff changeset
357 for J in Buckets'Range loop
kono
parents:
diff changeset
358 while Buckets (J) /= null loop
kono
parents:
diff changeset
359 Node := Buckets (J);
kono
parents:
diff changeset
360 Buckets (J) := Next (Node);
kono
parents:
diff changeset
361 Free (Node);
kono
parents:
diff changeset
362 end loop;
kono
parents:
diff changeset
363 end loop;
kono
parents:
diff changeset
364
kono
parents:
diff changeset
365 Free_Buckets (Buckets);
kono
parents:
diff changeset
366 end Free_Hash_Table;
kono
parents:
diff changeset
367
kono
parents:
diff changeset
368 -------------------
kono
parents:
diff changeset
369 -- Generic_Equal --
kono
parents:
diff changeset
370 -------------------
kono
parents:
diff changeset
371
kono
parents:
diff changeset
372 function Generic_Equal
kono
parents:
diff changeset
373 (L, R : Hash_Table_Type) return Boolean
kono
parents:
diff changeset
374 is
kono
parents:
diff changeset
375 begin
kono
parents:
diff changeset
376 if L.Length /= R.Length then
kono
parents:
diff changeset
377 return False;
kono
parents:
diff changeset
378 end if;
kono
parents:
diff changeset
379
kono
parents:
diff changeset
380 if L.Length = 0 then
kono
parents:
diff changeset
381 return True;
kono
parents:
diff changeset
382 end if;
kono
parents:
diff changeset
383
kono
parents:
diff changeset
384 declare
kono
parents:
diff changeset
385 -- Per AI05-0022, the container implementation is required to detect
kono
parents:
diff changeset
386 -- element tampering by a generic actual subprogram.
kono
parents:
diff changeset
387
kono
parents:
diff changeset
388 Lock_L : With_Lock (L.TC'Unrestricted_Access);
kono
parents:
diff changeset
389 Lock_R : With_Lock (R.TC'Unrestricted_Access);
kono
parents:
diff changeset
390
kono
parents:
diff changeset
391 L_Index : Hash_Type;
kono
parents:
diff changeset
392 L_Node : Node_Access;
kono
parents:
diff changeset
393
kono
parents:
diff changeset
394 N : Count_Type;
kono
parents:
diff changeset
395 begin
kono
parents:
diff changeset
396 -- Find the first node of hash table L
kono
parents:
diff changeset
397
kono
parents:
diff changeset
398 L_Index := 0;
kono
parents:
diff changeset
399 loop
kono
parents:
diff changeset
400 L_Node := L.Buckets (L_Index);
kono
parents:
diff changeset
401 exit when L_Node /= null;
kono
parents:
diff changeset
402 L_Index := L_Index + 1;
kono
parents:
diff changeset
403 end loop;
kono
parents:
diff changeset
404
kono
parents:
diff changeset
405 -- For each node of hash table L, search for an equivalent node in
kono
parents:
diff changeset
406 -- hash table R.
kono
parents:
diff changeset
407
kono
parents:
diff changeset
408 N := L.Length;
kono
parents:
diff changeset
409 loop
kono
parents:
diff changeset
410 if not Find (HT => R, Key => L_Node) then
kono
parents:
diff changeset
411 return False;
kono
parents:
diff changeset
412 end if;
kono
parents:
diff changeset
413
kono
parents:
diff changeset
414 N := N - 1;
kono
parents:
diff changeset
415
kono
parents:
diff changeset
416 L_Node := Next (L_Node);
kono
parents:
diff changeset
417
kono
parents:
diff changeset
418 if L_Node = null then
kono
parents:
diff changeset
419 -- We have exhausted the nodes in this bucket
kono
parents:
diff changeset
420
kono
parents:
diff changeset
421 if N = 0 then
kono
parents:
diff changeset
422 return True;
kono
parents:
diff changeset
423 end if;
kono
parents:
diff changeset
424
kono
parents:
diff changeset
425 -- Find the next bucket
kono
parents:
diff changeset
426
kono
parents:
diff changeset
427 loop
kono
parents:
diff changeset
428 L_Index := L_Index + 1;
kono
parents:
diff changeset
429 L_Node := L.Buckets (L_Index);
kono
parents:
diff changeset
430 exit when L_Node /= null;
kono
parents:
diff changeset
431 end loop;
kono
parents:
diff changeset
432 end if;
kono
parents:
diff changeset
433 end loop;
kono
parents:
diff changeset
434 end;
kono
parents:
diff changeset
435 end Generic_Equal;
kono
parents:
diff changeset
436
kono
parents:
diff changeset
437 -----------------------
kono
parents:
diff changeset
438 -- Generic_Iteration --
kono
parents:
diff changeset
439 -----------------------
kono
parents:
diff changeset
440
kono
parents:
diff changeset
441 procedure Generic_Iteration (HT : Hash_Table_Type) is
kono
parents:
diff changeset
442 procedure Wrapper (Node : Node_Access; Dummy_Pos : Hash_Type);
kono
parents:
diff changeset
443
kono
parents:
diff changeset
444 -------------
kono
parents:
diff changeset
445 -- Wrapper --
kono
parents:
diff changeset
446 -------------
kono
parents:
diff changeset
447
kono
parents:
diff changeset
448 procedure Wrapper (Node : Node_Access; Dummy_Pos : Hash_Type) is
kono
parents:
diff changeset
449 begin
kono
parents:
diff changeset
450 Process (Node);
kono
parents:
diff changeset
451 end Wrapper;
kono
parents:
diff changeset
452
kono
parents:
diff changeset
453 procedure Internal_With_Pos is
kono
parents:
diff changeset
454 new Generic_Iteration_With_Position (Wrapper);
kono
parents:
diff changeset
455
kono
parents:
diff changeset
456 -- Start of processing for Generic_Iteration
kono
parents:
diff changeset
457
kono
parents:
diff changeset
458 begin
kono
parents:
diff changeset
459 Internal_With_Pos (HT);
kono
parents:
diff changeset
460 end Generic_Iteration;
kono
parents:
diff changeset
461
kono
parents:
diff changeset
462 -------------------------------------
kono
parents:
diff changeset
463 -- Generic_Iteration_With_Position --
kono
parents:
diff changeset
464 -------------------------------------
kono
parents:
diff changeset
465
kono
parents:
diff changeset
466 procedure Generic_Iteration_With_Position
kono
parents:
diff changeset
467 (HT : Hash_Table_Type)
kono
parents:
diff changeset
468 is
kono
parents:
diff changeset
469 Node : Node_Access;
kono
parents:
diff changeset
470
kono
parents:
diff changeset
471 begin
kono
parents:
diff changeset
472 if HT.Length = 0 then
kono
parents:
diff changeset
473 return;
kono
parents:
diff changeset
474 end if;
kono
parents:
diff changeset
475
kono
parents:
diff changeset
476 for Indx in HT.Buckets'Range loop
kono
parents:
diff changeset
477 Node := HT.Buckets (Indx);
kono
parents:
diff changeset
478 while Node /= null loop
kono
parents:
diff changeset
479 Process (Node, Indx);
kono
parents:
diff changeset
480 Node := Next (Node);
kono
parents:
diff changeset
481 end loop;
kono
parents:
diff changeset
482 end loop;
kono
parents:
diff changeset
483 end Generic_Iteration_With_Position;
kono
parents:
diff changeset
484
kono
parents:
diff changeset
485 ------------------
kono
parents:
diff changeset
486 -- Generic_Read --
kono
parents:
diff changeset
487 ------------------
kono
parents:
diff changeset
488
kono
parents:
diff changeset
489 procedure Generic_Read
kono
parents:
diff changeset
490 (Stream : not null access Root_Stream_Type'Class;
kono
parents:
diff changeset
491 HT : out Hash_Table_Type)
kono
parents:
diff changeset
492 is
kono
parents:
diff changeset
493 N : Count_Type'Base;
kono
parents:
diff changeset
494 NN : Hash_Type;
kono
parents:
diff changeset
495
kono
parents:
diff changeset
496 begin
kono
parents:
diff changeset
497 Clear (HT);
kono
parents:
diff changeset
498
kono
parents:
diff changeset
499 Count_Type'Base'Read (Stream, N);
kono
parents:
diff changeset
500
kono
parents:
diff changeset
501 if Checks and then N < 0 then
kono
parents:
diff changeset
502 raise Program_Error with "stream appears to be corrupt";
kono
parents:
diff changeset
503 end if;
kono
parents:
diff changeset
504
kono
parents:
diff changeset
505 if N = 0 then
kono
parents:
diff changeset
506 return;
kono
parents:
diff changeset
507 end if;
kono
parents:
diff changeset
508
kono
parents:
diff changeset
509 -- The RM does not specify whether or how the capacity changes when a
kono
parents:
diff changeset
510 -- hash table is streamed in. Therefore we decide here to allocate a new
kono
parents:
diff changeset
511 -- buckets array only when it's necessary to preserve representation
kono
parents:
diff changeset
512 -- invariants.
kono
parents:
diff changeset
513
kono
parents:
diff changeset
514 if HT.Buckets = null
kono
parents:
diff changeset
515 or else HT.Buckets'Length < N
kono
parents:
diff changeset
516 then
kono
parents:
diff changeset
517 Free_Buckets (HT.Buckets);
kono
parents:
diff changeset
518 NN := Prime_Numbers.To_Prime (N);
kono
parents:
diff changeset
519 HT.Buckets := New_Buckets (Length => NN);
kono
parents:
diff changeset
520 end if;
kono
parents:
diff changeset
521
kono
parents:
diff changeset
522 for J in 1 .. N loop
kono
parents:
diff changeset
523 declare
kono
parents:
diff changeset
524 Node : constant Node_Access := New_Node (Stream);
kono
parents:
diff changeset
525 Indx : constant Hash_Type := Checked_Index (HT, Node);
kono
parents:
diff changeset
526 B : Node_Access renames HT.Buckets (Indx);
kono
parents:
diff changeset
527 begin
kono
parents:
diff changeset
528 Set_Next (Node => Node, Next => B);
kono
parents:
diff changeset
529 B := Node;
kono
parents:
diff changeset
530 end;
kono
parents:
diff changeset
531
kono
parents:
diff changeset
532 HT.Length := HT.Length + 1;
kono
parents:
diff changeset
533 end loop;
kono
parents:
diff changeset
534 end Generic_Read;
kono
parents:
diff changeset
535
kono
parents:
diff changeset
536 -------------------
kono
parents:
diff changeset
537 -- Generic_Write --
kono
parents:
diff changeset
538 -------------------
kono
parents:
diff changeset
539
kono
parents:
diff changeset
540 procedure Generic_Write
kono
parents:
diff changeset
541 (Stream : not null access Root_Stream_Type'Class;
kono
parents:
diff changeset
542 HT : Hash_Table_Type)
kono
parents:
diff changeset
543 is
kono
parents:
diff changeset
544 procedure Write (Node : Node_Access);
kono
parents:
diff changeset
545 pragma Inline (Write);
kono
parents:
diff changeset
546
kono
parents:
diff changeset
547 procedure Write is new Generic_Iteration (Write);
kono
parents:
diff changeset
548
kono
parents:
diff changeset
549 -----------
kono
parents:
diff changeset
550 -- Write --
kono
parents:
diff changeset
551 -----------
kono
parents:
diff changeset
552
kono
parents:
diff changeset
553 procedure Write (Node : Node_Access) is
kono
parents:
diff changeset
554 begin
kono
parents:
diff changeset
555 Write (Stream, Node);
kono
parents:
diff changeset
556 end Write;
kono
parents:
diff changeset
557
kono
parents:
diff changeset
558 begin
kono
parents:
diff changeset
559 -- See Generic_Read for an explanation of why we do not stream out the
kono
parents:
diff changeset
560 -- buckets array length too.
kono
parents:
diff changeset
561
kono
parents:
diff changeset
562 Count_Type'Base'Write (Stream, HT.Length);
kono
parents:
diff changeset
563 Write (HT);
kono
parents:
diff changeset
564 end Generic_Write;
kono
parents:
diff changeset
565
kono
parents:
diff changeset
566 -----------
kono
parents:
diff changeset
567 -- Index --
kono
parents:
diff changeset
568 -----------
kono
parents:
diff changeset
569
kono
parents:
diff changeset
570 function Index
kono
parents:
diff changeset
571 (Buckets : Buckets_Type;
kono
parents:
diff changeset
572 Node : Node_Access) return Hash_Type is
kono
parents:
diff changeset
573 begin
kono
parents:
diff changeset
574 return Hash_Node (Node) mod Buckets'Length;
kono
parents:
diff changeset
575 end Index;
kono
parents:
diff changeset
576
kono
parents:
diff changeset
577 function Index
kono
parents:
diff changeset
578 (Hash_Table : Hash_Table_Type;
kono
parents:
diff changeset
579 Node : Node_Access) return Hash_Type is
kono
parents:
diff changeset
580 begin
kono
parents:
diff changeset
581 return Index (Hash_Table.Buckets.all, Node);
kono
parents:
diff changeset
582 end Index;
kono
parents:
diff changeset
583
kono
parents:
diff changeset
584 ----------
kono
parents:
diff changeset
585 -- Move --
kono
parents:
diff changeset
586 ----------
kono
parents:
diff changeset
587
kono
parents:
diff changeset
588 procedure Move (Target, Source : in out Hash_Table_Type) is
kono
parents:
diff changeset
589 begin
kono
parents:
diff changeset
590 if Target'Address = Source'Address then
kono
parents:
diff changeset
591 return;
kono
parents:
diff changeset
592 end if;
kono
parents:
diff changeset
593
kono
parents:
diff changeset
594 TC_Check (Source.TC);
kono
parents:
diff changeset
595
kono
parents:
diff changeset
596 Clear (Target);
kono
parents:
diff changeset
597
kono
parents:
diff changeset
598 declare
kono
parents:
diff changeset
599 Buckets : constant Buckets_Access := Target.Buckets;
kono
parents:
diff changeset
600 begin
kono
parents:
diff changeset
601 Target.Buckets := Source.Buckets;
kono
parents:
diff changeset
602 Source.Buckets := Buckets;
kono
parents:
diff changeset
603 end;
kono
parents:
diff changeset
604
kono
parents:
diff changeset
605 Target.Length := Source.Length;
kono
parents:
diff changeset
606 Source.Length := 0;
kono
parents:
diff changeset
607 end Move;
kono
parents:
diff changeset
608
kono
parents:
diff changeset
609 -----------------
kono
parents:
diff changeset
610 -- New_Buckets --
kono
parents:
diff changeset
611 -----------------
kono
parents:
diff changeset
612
kono
parents:
diff changeset
613 function New_Buckets (Length : Hash_Type) return Buckets_Access is
kono
parents:
diff changeset
614 subtype Rng is Hash_Type range 0 .. Length - 1;
kono
parents:
diff changeset
615
kono
parents:
diff changeset
616 begin
kono
parents:
diff changeset
617 -- Allocate in Buckets_Allocation'Storage_Pool, then convert to
kono
parents:
diff changeset
618 -- Buckets_Access.
kono
parents:
diff changeset
619
kono
parents:
diff changeset
620 return Buckets_Access (Buckets_Allocation'(new Buckets_Type (Rng)));
kono
parents:
diff changeset
621 end New_Buckets;
kono
parents:
diff changeset
622
kono
parents:
diff changeset
623 ----------
kono
parents:
diff changeset
624 -- Next --
kono
parents:
diff changeset
625 ----------
kono
parents:
diff changeset
626
kono
parents:
diff changeset
627 function Next
kono
parents:
diff changeset
628 (HT : aliased in out Hash_Table_Type;
kono
parents:
diff changeset
629 Node : Node_Access;
kono
parents:
diff changeset
630 Position : in out Hash_Type) return Node_Access
kono
parents:
diff changeset
631 is
kono
parents:
diff changeset
632 Result : Node_Access;
kono
parents:
diff changeset
633 First : Hash_Type;
kono
parents:
diff changeset
634
kono
parents:
diff changeset
635 begin
kono
parents:
diff changeset
636 -- First, check if the node has other nodes chained to it
kono
parents:
diff changeset
637 Result := Next (Node);
kono
parents:
diff changeset
638
kono
parents:
diff changeset
639 if Result /= null then
kono
parents:
diff changeset
640 return Result;
kono
parents:
diff changeset
641 end if;
kono
parents:
diff changeset
642
kono
parents:
diff changeset
643 -- Check if we were supplied a position for Node, from which we
kono
parents:
diff changeset
644 -- can start iteration on the buckets.
kono
parents:
diff changeset
645
kono
parents:
diff changeset
646 if Position /= Hash_Type'Last then
kono
parents:
diff changeset
647 First := Position + 1;
kono
parents:
diff changeset
648 else
kono
parents:
diff changeset
649 First := Checked_Index (HT, Node) + 1;
kono
parents:
diff changeset
650 end if;
kono
parents:
diff changeset
651
kono
parents:
diff changeset
652 for Indx in First .. HT.Buckets'Last loop
kono
parents:
diff changeset
653 Result := HT.Buckets (Indx);
kono
parents:
diff changeset
654
kono
parents:
diff changeset
655 if Result /= null then
kono
parents:
diff changeset
656 Position := Indx;
kono
parents:
diff changeset
657 return Result;
kono
parents:
diff changeset
658 end if;
kono
parents:
diff changeset
659 end loop;
kono
parents:
diff changeset
660
kono
parents:
diff changeset
661 return null;
kono
parents:
diff changeset
662 end Next;
kono
parents:
diff changeset
663
kono
parents:
diff changeset
664 function Next
kono
parents:
diff changeset
665 (HT : aliased in out Hash_Table_Type;
kono
parents:
diff changeset
666 Node : Node_Access) return Node_Access
kono
parents:
diff changeset
667 is
kono
parents:
diff changeset
668 Pos : Hash_Type := Hash_Type'Last;
kono
parents:
diff changeset
669 begin
kono
parents:
diff changeset
670 return Next (HT, Node, Pos);
kono
parents:
diff changeset
671 end Next;
kono
parents:
diff changeset
672
kono
parents:
diff changeset
673 ----------------------
kono
parents:
diff changeset
674 -- Reserve_Capacity --
kono
parents:
diff changeset
675 ----------------------
kono
parents:
diff changeset
676
kono
parents:
diff changeset
677 procedure Reserve_Capacity
kono
parents:
diff changeset
678 (HT : in out Hash_Table_Type;
kono
parents:
diff changeset
679 N : Count_Type)
kono
parents:
diff changeset
680 is
kono
parents:
diff changeset
681 NN : Hash_Type;
kono
parents:
diff changeset
682
kono
parents:
diff changeset
683 begin
kono
parents:
diff changeset
684 if HT.Buckets = null then
kono
parents:
diff changeset
685 if N > 0 then
kono
parents:
diff changeset
686 NN := Prime_Numbers.To_Prime (N);
kono
parents:
diff changeset
687 HT.Buckets := New_Buckets (Length => NN);
kono
parents:
diff changeset
688 end if;
kono
parents:
diff changeset
689
kono
parents:
diff changeset
690 return;
kono
parents:
diff changeset
691 end if;
kono
parents:
diff changeset
692
kono
parents:
diff changeset
693 if HT.Length = 0 then
kono
parents:
diff changeset
694
kono
parents:
diff changeset
695 -- This is the easy case. There are no nodes, so no rehashing is
kono
parents:
diff changeset
696 -- necessary. All we need to do is allocate a new buckets array
kono
parents:
diff changeset
697 -- having a length implied by the specified capacity. (We say
kono
parents:
diff changeset
698 -- "implied by" because bucket arrays are always allocated with a
kono
parents:
diff changeset
699 -- length that corresponds to a prime number.)
kono
parents:
diff changeset
700
kono
parents:
diff changeset
701 if N = 0 then
kono
parents:
diff changeset
702 Free_Buckets (HT.Buckets);
kono
parents:
diff changeset
703 return;
kono
parents:
diff changeset
704 end if;
kono
parents:
diff changeset
705
kono
parents:
diff changeset
706 if N = HT.Buckets'Length then
kono
parents:
diff changeset
707 return;
kono
parents:
diff changeset
708 end if;
kono
parents:
diff changeset
709
kono
parents:
diff changeset
710 NN := Prime_Numbers.To_Prime (N);
kono
parents:
diff changeset
711
kono
parents:
diff changeset
712 if NN = HT.Buckets'Length then
kono
parents:
diff changeset
713 return;
kono
parents:
diff changeset
714 end if;
kono
parents:
diff changeset
715
kono
parents:
diff changeset
716 declare
kono
parents:
diff changeset
717 X : Buckets_Access := HT.Buckets;
kono
parents:
diff changeset
718 pragma Warnings (Off, X);
kono
parents:
diff changeset
719 begin
kono
parents:
diff changeset
720 HT.Buckets := New_Buckets (Length => NN);
kono
parents:
diff changeset
721 Free_Buckets (X);
kono
parents:
diff changeset
722 end;
kono
parents:
diff changeset
723
kono
parents:
diff changeset
724 return;
kono
parents:
diff changeset
725 end if;
kono
parents:
diff changeset
726
kono
parents:
diff changeset
727 if N = HT.Buckets'Length then
kono
parents:
diff changeset
728 return;
kono
parents:
diff changeset
729 end if;
kono
parents:
diff changeset
730
kono
parents:
diff changeset
731 if N < HT.Buckets'Length then
kono
parents:
diff changeset
732
kono
parents:
diff changeset
733 -- This is a request to contract the buckets array. The amount of
kono
parents:
diff changeset
734 -- contraction is bounded in order to preserve the invariant that the
kono
parents:
diff changeset
735 -- buckets array length is never smaller than the number of elements
kono
parents:
diff changeset
736 -- (the load factor is 1).
kono
parents:
diff changeset
737
kono
parents:
diff changeset
738 if HT.Length >= HT.Buckets'Length then
kono
parents:
diff changeset
739 return;
kono
parents:
diff changeset
740 end if;
kono
parents:
diff changeset
741
kono
parents:
diff changeset
742 NN := Prime_Numbers.To_Prime (HT.Length);
kono
parents:
diff changeset
743
kono
parents:
diff changeset
744 if NN >= HT.Buckets'Length then
kono
parents:
diff changeset
745 return;
kono
parents:
diff changeset
746 end if;
kono
parents:
diff changeset
747
kono
parents:
diff changeset
748 else
kono
parents:
diff changeset
749 NN := Prime_Numbers.To_Prime (Count_Type'Max (N, HT.Length));
kono
parents:
diff changeset
750
kono
parents:
diff changeset
751 if NN = HT.Buckets'Length then -- can't expand any more
kono
parents:
diff changeset
752 return;
kono
parents:
diff changeset
753 end if;
kono
parents:
diff changeset
754 end if;
kono
parents:
diff changeset
755
kono
parents:
diff changeset
756 TC_Check (HT.TC);
kono
parents:
diff changeset
757
kono
parents:
diff changeset
758 Rehash : declare
kono
parents:
diff changeset
759 Dst_Buckets : Buckets_Access := New_Buckets (Length => NN);
kono
parents:
diff changeset
760 Src_Buckets : Buckets_Access := HT.Buckets;
kono
parents:
diff changeset
761 pragma Warnings (Off, Src_Buckets);
kono
parents:
diff changeset
762
kono
parents:
diff changeset
763 L : Count_Type renames HT.Length;
kono
parents:
diff changeset
764 LL : constant Count_Type := L;
kono
parents:
diff changeset
765
kono
parents:
diff changeset
766 Src_Index : Hash_Type := Src_Buckets'First;
kono
parents:
diff changeset
767
kono
parents:
diff changeset
768 begin
kono
parents:
diff changeset
769 while L > 0 loop
kono
parents:
diff changeset
770 declare
kono
parents:
diff changeset
771 Src_Bucket : Node_Access renames Src_Buckets (Src_Index);
kono
parents:
diff changeset
772
kono
parents:
diff changeset
773 begin
kono
parents:
diff changeset
774 while Src_Bucket /= null loop
kono
parents:
diff changeset
775 declare
kono
parents:
diff changeset
776 Src_Node : constant Node_Access := Src_Bucket;
kono
parents:
diff changeset
777
kono
parents:
diff changeset
778 Dst_Index : constant Hash_Type :=
kono
parents:
diff changeset
779 Checked_Index (HT, Dst_Buckets.all, Src_Node);
kono
parents:
diff changeset
780
kono
parents:
diff changeset
781 Dst_Bucket : Node_Access renames Dst_Buckets (Dst_Index);
kono
parents:
diff changeset
782
kono
parents:
diff changeset
783 begin
kono
parents:
diff changeset
784 Src_Bucket := Next (Src_Node);
kono
parents:
diff changeset
785
kono
parents:
diff changeset
786 Set_Next (Src_Node, Dst_Bucket);
kono
parents:
diff changeset
787
kono
parents:
diff changeset
788 Dst_Bucket := Src_Node;
kono
parents:
diff changeset
789 end;
kono
parents:
diff changeset
790
kono
parents:
diff changeset
791 pragma Assert (L > 0);
kono
parents:
diff changeset
792 L := L - 1;
kono
parents:
diff changeset
793 end loop;
kono
parents:
diff changeset
794
kono
parents:
diff changeset
795 exception
kono
parents:
diff changeset
796 when others =>
kono
parents:
diff changeset
797
kono
parents:
diff changeset
798 -- If there's an error computing a hash value during a
kono
parents:
diff changeset
799 -- rehash, then AI-302 says the nodes "become lost." The
kono
parents:
diff changeset
800 -- issue is whether to actually deallocate these lost nodes,
kono
parents:
diff changeset
801 -- since they might be designated by extant cursors. Here
kono
parents:
diff changeset
802 -- we decide to deallocate the nodes, since it's better to
kono
parents:
diff changeset
803 -- solve real problems (storage consumption) rather than
kono
parents:
diff changeset
804 -- imaginary ones (the user might, or might not, dereference
kono
parents:
diff changeset
805 -- a cursor designating a node that has been deallocated),
kono
parents:
diff changeset
806 -- and because we have a way to vet a dangling cursor
kono
parents:
diff changeset
807 -- reference anyway, and hence can actually detect the
kono
parents:
diff changeset
808 -- problem.
kono
parents:
diff changeset
809
kono
parents:
diff changeset
810 for Dst_Index in Dst_Buckets'Range loop
kono
parents:
diff changeset
811 declare
kono
parents:
diff changeset
812 B : Node_Access renames Dst_Buckets (Dst_Index);
kono
parents:
diff changeset
813 X : Node_Access;
kono
parents:
diff changeset
814 begin
kono
parents:
diff changeset
815 while B /= null loop
kono
parents:
diff changeset
816 X := B;
kono
parents:
diff changeset
817 B := Next (X);
kono
parents:
diff changeset
818 Free (X);
kono
parents:
diff changeset
819 end loop;
kono
parents:
diff changeset
820 end;
kono
parents:
diff changeset
821 end loop;
kono
parents:
diff changeset
822
kono
parents:
diff changeset
823 Free_Buckets (Dst_Buckets);
kono
parents:
diff changeset
824 raise Program_Error with
kono
parents:
diff changeset
825 "hash function raised exception during rehash";
kono
parents:
diff changeset
826 end;
kono
parents:
diff changeset
827
kono
parents:
diff changeset
828 Src_Index := Src_Index + 1;
kono
parents:
diff changeset
829 end loop;
kono
parents:
diff changeset
830
kono
parents:
diff changeset
831 HT.Buckets := Dst_Buckets;
kono
parents:
diff changeset
832 HT.Length := LL;
kono
parents:
diff changeset
833
kono
parents:
diff changeset
834 Free_Buckets (Src_Buckets);
kono
parents:
diff changeset
835 end Rehash;
kono
parents:
diff changeset
836 end Reserve_Capacity;
kono
parents:
diff changeset
837
kono
parents:
diff changeset
838 end Ada.Containers.Hash_Tables.Generic_Operations;