1
-------------------------------------------------------------------------------
3
-- <STRONG>Copyright © 2001, 2002 by Thomas Wolf.</STRONG>
5
-- This piece of software is free software; you can redistribute it and/or
6
-- modify it under the terms of the GNU General Public License as published
7
-- by the Free Software Foundation; either version 2, or (at your option)
8
-- any later version. This software is distributed in the hope that it will
9
-- be useful, but <EM>without any warranty</EM>; without even the implied
10
-- warranty of <EM>merchantability or fitness for a particular purpose.</EM>
11
-- See the GNU General Public License for more details. You should have
12
-- received a copy of the GNU General Public License with this distribution,
13
-- see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
14
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
18
-- As a special exception from the GPL, if other files instantiate generics
19
-- from this unit, or you link this unit with other files to produce an
20
-- executable, this unit does not by itself cause the resulting executable
21
-- to be covered by the GPL. This exception does not however invalidate any
22
-- other reasons why the executable file might be covered by the GPL.
26
-- Thomas Wolf (TW) <E_MAIL>
30
-- Provides dynamic hash tables. Internal collision resolution, automatic
31
-- and explicit resizing. Collision chain index computation can be
32
-- customized though @Collision_Policies@.
40
-- 20-DEC-2001 TW Initial version.
41
-- 28-DEC-2001 TW Added growth policies.
42
-- 24-APR-2002 TW Added the 'Choose_Size' generic formal function.
44
-------------------------------------------------------------------------------
46
pragma License (Modified_GPL);
48
with Ada.Finalization;
51
with GAL.Storage.Memory;
52
with GAL.Support.Hashing;
55
type Key_Type (<>) is private;
56
type Item (<>) is private;
58
with package Memory is new GAL.Storage.Memory (<>);
60
Initial_Size : in GAL.Support.Hashing.Size_Type := 23;
63
(Element : in Key_Type)
64
return GAL.Support.Hashing.Hash_Type is <>;
66
with function "=" (Left, Right : in Key_Type) return Boolean is <>;
68
with function Choose_Size
69
(Suggested : in GAL.Support.Hashing.Hash_Type)
70
return GAL.Support.Hashing.Hash_Type
71
is GAL.Support.Hashing.Next_Prime;
72
-- This function is called whenever the size of the hash table is to be
73
-- defined. 'Suggested' is the suggested size of the new table; the
74
-- function should then return a size that is >= Suggested. If it
75
-- returns a smaller value anyway, the exception 'Container_Error' is
78
package GAL.ADT.Hash_Tables is
80
pragma Elaborate_Body;
82
----------------------------------------------------------------------------
83
-- Exception renamings to facilitate usage of this package.
85
Container_Empty : exception renames GAL.ADT.Container_Empty;
86
Container_Full : exception renames GAL.ADT.Container_Full;
87
Range_Error : exception renames GAL.ADT.Range_Error;
88
Not_Found : exception renames GAL.ADT.Not_Found;
89
Duplicate_Key : exception renames GAL.ADT.Duplicate_Key;
91
Hash_Table_Empty : exception renames Container_Empty;
92
Hash_Table_Full : exception renames Container_Full;
94
Container_Error : exception renames GAL.ADT.Container_Error;
96
----------------------------------------------------------------------------
98
type Hash_Table is private;
99
-- Hash tables are initially empty; no storage allocation occurs yet.
100
-- Virgin hash tables do not resize themselves when full!
102
-- Some routines specify explicit (minimum) sizes for a hash table. Note
103
-- that an implementation is free to choose a larger size if it so
106
Null_Hash_Table : constant Hash_Table;
108
type Item_Ptr is access all Item;
109
for Item_Ptr'Storage_Size use 0;
111
----------------------------------------------------------------------------
114
(Left, Right : in out Hash_Table);
115
-- Exchanges the two tables without making a temporary copy.
117
----------------------------------------------------------------------------
120
(Table : in out Hash_Table;
123
-- Raises @Container_Full@ if the hash table is full and automatic resizing
124
-- is off (the table's resize load factor is 0.0), and @Duplicate_Key@ if
125
-- if an item with an equal key already is in the table.
128
(Table : in out Hash_Table;
130
Element : access Item);
132
----------------------------------------------------------------------------
135
(Table : in out Hash_Table;
138
-- If the key already exists in the hash table, replaces the associated
139
-- item. Otherwise inserts the element and its key.
142
(Table : in out Hash_Table;
144
Element : access Item);
146
----------------------------------------------------------------------------
149
(Table : in out Hash_Table;
151
-- Raises @Container_Empty@ if the table is empty, and @Not_Found@ if the
152
-- key is not in the table.
155
(Table : in out Hash_Table;
159
----------------------------------------------------------------------------
162
(Table : in Hash_Table;
165
-- Raises @Container_Empty@ if the table is empty, and @Not_Found@ if the
166
-- key is not in the table.
169
(Table : in Hash_Table;
172
-- Returns @False@ if the table is empty or the key is not in the table,
175
----------------------------------------------------------------------------
177
function Nof_Elements
178
(Table : in Hash_Table)
179
return GAL.Support.Hashing.Hash_Type;
182
(Table : in Hash_Table)
186
(Table : in Hash_Table)
187
return GAL.Support.Hashing.Load_Factor;
190
(Table : in Hash_Table)
191
return GAL.Support.Hashing.Hash_Type;
193
----------------------------------------------------------------------------
196
(Table : in out Hash_Table;
197
New_Size : in GAL.Support.Hashing.Size_Type);
198
-- Raises @Container_Error@ without modifying @Table@ if @New_Size@ is so
199
-- small that the table couldn't hold all the elements it currently
202
-- An alternative would be not to change the table at all, without raising
203
-- an exception. However, I think an attempt to shrink a hash table
204
-- through @Resize@ below the current number of elements in the table
205
-- should be seen as an application error.
207
----------------------------------------------------------------------------
210
(Table : in out Hash_Table);
213
(Table : in out Hash_Table;
214
New_Size : in GAL.Support.Hashing.Size_Type);
217
(Table : in out Hash_Table;
218
New_Size : in GAL.Support.Hashing.Size_Type;
219
Resize_At : in GAL.Support.Hashing.Load_Factor);
221
----------------------------------------------------------------------------
224
(Result : in out Hash_Table;
225
Source : in Hash_Table);
226
-- Raises @Duplicate_Key@ without modifying @Result@ if @Source@ contains
227
-- a key already in @Result@.
230
(Result : in out Hash_Table;
231
Source : in Hash_Table;
232
Overwrite : in Boolean);
233
-- Same as above, but different duplicate key handling: if @Overwrite@ is
234
-- true, items already in @Result@ are overwritten by the items from
235
-- @Source@; otherwise, the items in @Result@ remain unchanged.
237
----------------------------------------------------------------------------
238
-- Collision chain management. Every hash table has a collision policy;
239
-- the default is to do double hashing.
241
procedure Set_Collision_Policy
242
(Table : in out Hash_Table;
243
Policy : in GAL.Support.Hashing.Collision_Policy'Class);
244
-- If @Table@ is not empty, this causes re-hashing!
246
procedure Remove_Collision_Policy
247
(Table : in out Hash_Table);
248
-- If @Table@ is not empty, and the current policy is not already the
249
-- default one, this causes re-hashing!
251
procedure Set_Default_Collision_Policy
252
(Table : in out Hash_Table)
253
renames Remove_Collision_Policy;
255
function Get_Collision_Policy
256
(Table : in Hash_Table)
257
return GAL.Support.Hashing.Collision_Policy'Class;
258
-- Raises @Constraint_Error@ if the @Table@ does not have a collision
259
-- policy, which implies that it has been assigned the @Null_Hash_Table@,
260
-- and no insertions have yet taken place.
262
----------------------------------------------------------------------------
263
-- Growth management. See GAL.Containers.Vectors for more comments. By
264
-- default, a hash table has no growth policy and therefore doesn't
265
-- grow automatically but raises Container_Full in case (2) below.
267
-- The increase operation is called to get the new size:
269
-- 1. In 'Insert', if the resize load factor > 0.0 and the table's load
270
-- would be greater after inserting.
272
-- 2. In 'Insert', if no empty slot can be found.
274
----------------------------------------------------------------------------
277
(Table : in out Hash_Table;
278
Resize_At : in GAL.Support.Hashing.Load_Factor);
279
-- If @Resize_At@ = 0.0, the table resizes only if it is full and a growth
282
procedure Set_Growth_Policy
283
(Table : in out Hash_Table;
284
Policy : in GAL.Support.Hashing.Growth_Policy'Class);
285
-- Removes the current growth policy of @Table@ (if any), and installs a
286
-- copy of @Policy@ as the table's new growth policy.
288
procedure Remove_Growth_Policy
289
(Table : in out Hash_Table);
290
-- Removes the current growth policy of @Table@ (if any).
292
procedure Set_Default_Growth_Policy
293
(Table : in out Hash_Table)
294
renames Remove_Growth_Policy;
296
function Has_Growth_Policy
297
(Table : in Hash_Table)
299
-- Returns @True@ if a growth policy is defined for @Table@.
301
function Get_Growth_Policy
302
(Table : in Hash_Table)
303
return GAL.Support.Hashing.Growth_Policy'Class;
304
-- Raises @Constraint_Error@ if no growth policy has been set on @Table@.
306
----------------------------------------------------------------------------
309
type Visitor is abstract tagged private;
315
Quit : in out Boolean);
321
Quit : in out Boolean);
324
(Table : in Hash_Table;
325
V : in out Visitor'Class;
326
Reference : in Boolean := False);
329
with procedure Execute
332
Quit : in out Boolean);
334
(Table : in Hash_Table);
337
with procedure Execute
340
Quit : in out Boolean);
341
procedure Traverse_By_Reference_G
342
(Table : in Hash_Table);
344
----------------------------------------------------------------------------
348
(Left, Right : in Hash_Table)
350
-- Returns true if the two hash tables contain the same number of elements
351
-- with the same keys, False otherwise.
354
with function "=" (Left, Right : in Item) return Boolean is <>;
356
(Left, Right : in Hash_Table)
358
-- Ditto, but also requires the values associated with the keys to be
361
----------------------------------------------------------------------------
362
-- Unsafe pointer operations. All these operations return Item_Ptrs, which
363
-- point directly into the list. Of course, such pointers are unsafe
364
-- because they are not invalidated when the element pointed to is deleted.
365
-- Item_Ptrs can thus become dangling, and any dereference of an Item_Ptr
366
-- after the element pointed to has vanished is a bounded error.
367
-- Nevertheless, Item_Ptrs are sometimes a convenient and efficient way
368
-- to get at and work with the stored elements, especially if the element
369
-- type is a large record.
374
(Table : in Hash_Table;
377
-- Returns @null@ if no such element exists in the hash table.
383
function "=" (Left, Right : in Item) return Boolean
385
-- Make sure we don't use (the default) equality of items; we only want
386
-- to use equality on keys!
388
type Collision_Policy_Ptr is
389
access all GAL.Support.Hashing.Collision_Policy'Class;
390
for Collision_Policy_Ptr'Storage_Pool use Memory.Pool;
392
type Growth_Policy_Ptr is
393
access all GAL.Support.Hashing.Growth_Policy'Class;
394
for Growth_Policy_Ptr'Storage_Pool use Memory.Pool;
396
type Key_Ptr is access Key_Type;
397
for Key_Ptr'Storage_Pool use Memory.Pool;
399
type Data_Ptr is access all Item;
400
for Data_Ptr'Storage_Pool use Memory.Pool;
402
type Hash_State is (Empty, Deleted, Used);
406
Key : Key_Ptr := null;
407
Value : Data_Ptr := null;
408
State : Hash_State := Empty;
411
type Mem is array (GAL.Support.Hashing.Hash_Type range <>) of Hash_Entry;
412
type Ptr is access Mem;
413
for Ptr'Storage_Pool use Memory.Pool;
415
type Hash_Table is new Ada.Finalization.Controlled with
417
Count : GAL.Support.Hashing.Hash_Type := 0;
419
Collisions : Collision_Policy_Ptr := null;
420
Growth : Growth_Policy_Ptr := null;
421
Resize_At : GAL.Support.Hashing.Load_Factor := 0.0;
422
Initial_Size : GAL.Support.Hashing.Size_Type :=
423
GAL.ADT.Hash_Tables.Initial_Size;
426
procedure Adjust (Table : in out Hash_Table);
427
procedure Finalize (Table : in out Hash_Table);
432
(Stream : access Ada.Streams.Root_Stream_Type'Class;
433
Table : in Hash_Table);
436
(Stream : access Ada.Streams.Root_Stream_Type'Class;
437
Table : out Hash_Table);
439
for Hash_Table'Write use Write;
440
for Hash_Table'Read use Read;
442
Null_Hash_Table : constant Hash_Table :=
443
(Ada.Finalization.Controlled with
451
pragma Inline (Insert, Replace);
453
type Visitor is abstract tagged null record;
455
end GAL.ADT.Hash_Tables;
added
removed
gal-adt-hash_tables.ads
