~ubuntu-branches/debian/stretch/adabrowse/stretch

« back to all changes in this revision

Viewing changes to gal-containers-hash_tables.ads

  • Committer: Bazaar Package Importer
  • Author(s): Ludovic Brenta
  • Date: 2004-02-14 13:22:40 UTC
  • Revision ID: james.westby@ubuntu.com-20040214132240-cqumhiq1677pkvzo
Tags: upstream-4.0.2
ImportĀ upstreamĀ versionĀ 4.0.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
-------------------------------------------------------------------------------
 
2
--
 
3
-- <STRONG>Copyright (c) 2001, 2002 by Thomas Wolf.</STRONG>
 
4
-- <BLOCKQUOTE>
 
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 unit is distributed in the hope that it will be
 
9
--    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,
 
15
--    USA.
 
16
-- </BLOCKQUOTE>
 
17
-- <BLOCKQUOTE>
 
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.
 
23
-- </BLOCKQUOTE>
 
24
--
 
25
-- <DL><DT><STRONG>
 
26
-- Author:</STRONG><DD>
 
27
--   Thomas Wolf  (TW)
 
28
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
 
29
--
 
30
-- <DL><DT><STRONG>
 
31
-- Purpose:</STRONG><DD>
 
32
--   Provides dynamic hash tables. Internal collision resolution, automatic
 
33
--   and explicit resizing. Collision chain index computation can be customized
 
34
--   though <CODE>Collision_Policies</CODE>. Resizing can be controlled through
 
35
--   load factors and <CODE>Growth_Policies</CODE>.
 
36
--   <BR><BR>
 
37
--   This hash table does not allow associating additional data with the
 
38
--   items stored. However, only a portion of type @Item@ might be the actual
 
39
--   key, while additional components might hold associated data. In this
 
40
--   case, both @Hash@ and <CODE>"="</CODE> must work only on the key part
 
41
--   of @Item@.
 
42
--   <BR><BR>
 
43
--   Note that this hash table does not allow in-place modification of the
 
44
--   items stored since this might result in violations of the internal
 
45
--   consistency of the hash table.
 
46
--   <BR><BR>
 
47
--   A slightly more powerful (but also slightly more complex to instantiate)
 
48
--   hash table package taking separate @Key@ and @Item@ types and allowing
 
49
--   in-place modifications of the items (but not the keys) is available in
 
50
--   package <A HREF="gal-adt-hash_tables.html">GAL.ADT.Hash_Tables</A>.
 
51
--   </DL>
 
52
--
 
53
-- <DL><DT><STRONG>
 
54
-- Tasking semantics:</STRONG><DD>
 
55
--   N/A. Not abortion-safe.</DL>
 
56
--
 
57
-- <DL><DT><STRONG>
 
58
-- Storage semantics:</STRONG><DD>
 
59
--   Dynamic storage allocation in a user-supplied storage pool.</DL>
 
60
--
 
61
-- <!--
 
62
-- Revision History
 
63
--
 
64
--   20-DEC-2001   TW  Initial version.
 
65
--   28-DEC-2001   TW  Added growth policies.
 
66
--   24-APR-2002   TW  Added the 'Choose_Size' generic formal function.
 
67
-- -->
 
68
-------------------------------------------------------------------------------
 
69
 
 
70
pragma License (Modified_GPL);
 
71
 
 
72
with GAL.Storage.Memory;
 
73
 
 
74
with GAL.ADT.Hash_Tables;
 
75
with GAL.Support.Hashing;
 
76
 
 
77
generic
 
78
   type Item (<>) is private;
 
79
 
 
80
   with package Memory is new GAL.Storage.Memory (<>);
 
81
 
 
82
   Initial_Size : in GAL.Support.Hashing.Size_Type := 23;
 
83
 
 
84
   with function Hash (Element : in Item)
 
85
          return GAL.Support.Hashing.Hash_Type is <>;
 
86
 
 
87
   with function "=" (Left, Right : in Item) return Boolean is <>;
 
88
 
 
89
   with function Choose_Size
 
90
        (Suggested : in GAL.Support.Hashing.Hash_Type)
 
91
        return GAL.Support.Hashing.Size_Type
 
92
        is GAL.Support.Hashing.Next_Prime;
 
93
   --  This function is called whenever the size of the hash table is to be
 
94
   --  defined. @Suggested@ is the suggested size of the new table; the
 
95
   --  function should then return a size that is >= @Suggested@. If it
 
96
   --  returns a smaller value anyway, the exception @Container_Error@ is
 
97
   --  raised.
 
98
package GAL.Containers.Hash_Tables is
 
99
 
 
100
   pragma Elaborate_Body;
 
101
 
 
102
   ----------------------------------------------------------------------------
 
103
   --  Exception renamings to facilitate usage of this package.
 
104
 
 
105
   Container_Empty  : exception renames GAL.Containers.Container_Empty;
 
106
   Container_Full   : exception renames GAL.Containers.Container_Full;
 
107
   Range_Error      : exception renames GAL.Containers.Range_Error;
 
108
   Not_Found        : exception renames GAL.Containers.Not_Found;
 
109
   Duplicate_Key    : exception renames GAL.Containers.Duplicate_Key;
 
110
 
 
111
   Hash_Table_Empty : exception renames Container_Empty;
 
112
   Hash_Table_Full  : exception renames Container_Full;
 
113
 
 
114
   Container_Error  : exception renames GAL.Containers.Container_Error;
 
115
 
 
116
   ----------------------------------------------------------------------------
 
117
 
 
118
   type Hash_Table is private;
 
119
   --  Hash tables are initially empty; no storage allocation occurs yet.
 
120
   --  Virgin hash tables do not resize themselves when full!
 
121
   --
 
122
   --  Some routines specify explicit (minimum) sizes for a hash table. Note
 
123
   --  that an implementation is free to choose a larger size if it so
 
124
   --  desires.
 
125
 
 
126
   Null_Hash_Table : constant Hash_Table;
 
127
 
 
128
   ----------------------------------------------------------------------------
 
129
 
 
130
   procedure Swap
 
131
     (Left, Right : in out Hash_Table);
 
132
   --  Swaps the two hash tables without making a temporary copy.
 
133
 
 
134
   ----------------------------------------------------------------------------
 
135
 
 
136
   procedure Insert
 
137
     (Table   : in out Hash_Table;
 
138
      Element : in     Item);
 
139
   --  Raises Container_Full if the hash table is full and automatic resizing
 
140
   --  is off (the table's resize load factor is 0.0), and Duplicate_Key if
 
141
   --  if an item with an equal key already is in the table.
 
142
 
 
143
   procedure Insert
 
144
     (Table   : in out Hash_Table;
 
145
      Element : access Item);
 
146
 
 
147
   ----------------------------------------------------------------------------
 
148
 
 
149
   procedure Replace
 
150
     (Table   : in out Hash_Table;
 
151
      Element : in     Item);
 
152
   --  If the key already exists in the hash table, replaces the associated
 
153
   --  item. Otherwise inserts the element and its key.
 
154
 
 
155
   procedure Replace
 
156
     (Table   : in out Hash_Table;
 
157
      Element : access Item);
 
158
 
 
159
   ----------------------------------------------------------------------------
 
160
 
 
161
   procedure Delete
 
162
     (Table   : in out Hash_Table;
 
163
      Element : in     Item);
 
164
   --  Raises Container_Empty if the table is empty, and Not_Found is the key
 
165
   --  is not in the table.
 
166
 
 
167
   procedure Delete
 
168
     (Table   : in out Hash_Table;
 
169
      Element : access Item);
 
170
 
 
171
   ----------------------------------------------------------------------------
 
172
 
 
173
   function Contains
 
174
     (Table   : in Hash_Table;
 
175
      Element : in Item)
 
176
     return Boolean;
 
177
   --  Returns False if the table is empty or the key is not in the table,
 
178
   --  True if it is.
 
179
 
 
180
   function Contains
 
181
     (Table   : in     Hash_Table;
 
182
      Element : access Item)
 
183
     return Boolean;
 
184
 
 
185
   ----------------------------------------------------------------------------
 
186
 
 
187
   function Nof_Elements
 
188
     (Table : in Hash_Table)
 
189
     return GAL.Support.Hashing.Hash_Type;
 
190
 
 
191
   function Is_Empty
 
192
     (Table : in Hash_Table)
 
193
     return Boolean;
 
194
 
 
195
   function Load
 
196
     (Table : in Hash_Table)
 
197
     return GAL.Support.Hashing.Load_Factor;
 
198
 
 
199
   function Size
 
200
     (Table : in Hash_Table)
 
201
     return GAL.Support.Hashing.Hash_Type;
 
202
 
 
203
   ----------------------------------------------------------------------------
 
204
 
 
205
   procedure Resize
 
206
     (Table    : in out Hash_Table;
 
207
      New_Size : in     GAL.Support.Hashing.Size_Type);
 
208
   --  Resizes the table to at least 'New_Size' slots.
 
209
   --
 
210
   --  Raises Container_Error without modifying 'Table' if New_Size is so
 
211
   --  small that the table couldn't hold all the elements it currently
 
212
   --  contains.
 
213
   --
 
214
   --  An alternative would be not to change the table at all, without raising
 
215
   --  an exception. However, I think an attempt to shrink a hash table through
 
216
   --  'Resize' below the current number of elements in the table should be
 
217
   --  seen as an application error.
 
218
   --
 
219
   --  Raises Range_Error if the new size of the table would be larger than
 
220
   --  the number of elements in Hash_Type. (Note that the new size of the
 
221
   --  table may be *larger* than 'New_Size'!)
 
222
 
 
223
   ----------------------------------------------------------------------------
 
224
 
 
225
   procedure Reset
 
226
     (Table : in out Hash_Table);
 
227
 
 
228
   procedure Reset
 
229
     (Table    : in out Hash_Table;
 
230
      New_Size : in     GAL.Support.Hashing.Size_Type);
 
231
 
 
232
   procedure Reset
 
233
     (Table     : in out Hash_Table;
 
234
      New_Size  : in     GAL.Support.Hashing.Size_Type;
 
235
      Resize_At : in     GAL.Support.Hashing.Load_Factor);
 
236
 
 
237
   ----------------------------------------------------------------------------
 
238
 
 
239
   procedure Merge
 
240
     (Result : in out Hash_Table;
 
241
      Source : in     Hash_Table);
 
242
   --  Raises Duplicate_Key without modifying 'Result' if 'Source' contains
 
243
   --  a key already in 'Result'.
 
244
 
 
245
   procedure Merge
 
246
     (Result    : in out Hash_Table;
 
247
      Source    : in     Hash_Table;
 
248
      Overwrite : in     Boolean);
 
249
   --  Same as above, but different duplicate key handling: if Overwrite is
 
250
   --  true, items already in 'Result' are overwritten by the items from
 
251
   --  'Source'; otherwise, the items in 'Result' remain unchanged.
 
252
 
 
253
   ----------------------------------------------------------------------------
 
254
   --  Collision chain management. Every hash table has a collision policy;
 
255
   --  the default is to do exponential hashing, which seems to be least
 
256
   --  Susceptible to clustering (primary or secondary) and better than
 
257
   --  double hashing.
 
258
   --
 
259
   --  (Note however that better is relative anyway. Depending on the
 
260
   --  circumstances, linear probing may in fact be the most appropriate
 
261
   --  choice, as it exhibits a good access locality and thus may be a win on
 
262
   --  modern processor architctures with multi-level caching.)
 
263
 
 
264
   procedure Set_Collision_Policy
 
265
     (Table  : in out Hash_Table;
 
266
      Policy : in     GAL.Support.Hashing.Collision_Policy'Class);
 
267
   --  If 'Table' is not empty, this causes re-hashing!
 
268
 
 
269
   procedure Remove_Collision_Policy
 
270
     (Table : in out Hash_Table);
 
271
   --  If 'Table' is not empty, and the current policy is not already the
 
272
   --  default one, this causes re-hashing!
 
273
 
 
274
   procedure Set_Default_Collision_Policy
 
275
     (Table : in out Hash_Table)
 
276
     renames Remove_Collision_Policy;
 
277
 
 
278
   function Get_Collision_Policy
 
279
     (Table : in Hash_Table)
 
280
     return GAL.Support.Hashing.Collision_Policy'Class;
 
281
 
 
282
   ----------------------------------------------------------------------------
 
283
   --  Growth management. See GAL.Containers.Vectors for more comments. By
 
284
   --  default, a hash table has no growth policy and therefore doesn't
 
285
   --  grow automatically but raises Container_Full in case (2) below.
 
286
   --
 
287
   --  The increase operation is called to get the new size:
 
288
   --
 
289
   --    1. In 'Insert', if the resize load factor > 0.0 and the table's load
 
290
   --       would be greater after inserting.
 
291
   --
 
292
   --    2. In 'Insert', if no empty slot can be found.
 
293
 
 
294
   ----------------------------------------------------------------------------
 
295
 
 
296
   procedure Set_Resize
 
297
     (Table     : in out Hash_Table;
 
298
      Resize_At : in     GAL.Support.Hashing.Load_Factor);
 
299
   --  If Resize_At = 0.0, the table resizes only if it is full and a growth
 
300
   --  policy is set.
 
301
 
 
302
   procedure Set_Growth_Policy
 
303
     (Table  : in out Hash_Table;
 
304
      Policy : in     GAL.Support.Hashing.Growth_Policy'Class);
 
305
 
 
306
   procedure Remove_Growth_Policy
 
307
     (Table : in out Hash_Table);
 
308
 
 
309
   procedure Set_Default_Growth_Policy
 
310
     (Table : in out Hash_Table)
 
311
     renames Remove_Growth_Policy;
 
312
 
 
313
   function  Has_Growth_Policy
 
314
     (Table : in Hash_Table)
 
315
     return Boolean;
 
316
 
 
317
   function Get_Growth_Policy
 
318
     (Table : in Hash_Table)
 
319
     return GAL.Support.Hashing.Growth_Policy'Class;
 
320
 
 
321
   ----------------------------------------------------------------------------
 
322
   --  Traversals:
 
323
 
 
324
   type Visitor is abstract tagged private;
 
325
 
 
326
   procedure Execute
 
327
     (V     : in out Visitor;
 
328
      Value : in     Item;
 
329
      Quit  : in out Boolean)
 
330
     is abstract;
 
331
   --  'Quit' is False upon entry; traversal continues until either all items
 
332
   --  in the hash table have been processed or 'Quit' is set to True.
 
333
 
 
334
   procedure Traverse
 
335
     (Table     : in     Hash_Table;
 
336
      V         : in out Visitor'Class);
 
337
   --  Calls 'Execute (V)' for all items currently in the hash table, until
 
338
   --  either all items have been processed or 'Execute' sets 'Quit' to True.
 
339
 
 
340
   generic
 
341
      with procedure Execute
 
342
           (Value : in     Item;
 
343
            Quit  : in out Boolean);
 
344
   procedure Traverse_G
 
345
     (Table : in Hash_Table);
 
346
 
 
347
   ----------------------------------------------------------------------------
 
348
   --  Comparisons
 
349
 
 
350
   function "="
 
351
     (Left, Right : in Hash_Table)
 
352
     return Boolean;
 
353
   --  Returns true if the two hash tables contain the same number of elements
 
354
   --  with the same keys, False otherwise.
 
355
 
 
356
private
 
357
   package Impl is
 
358
      new GAL.ADT.Hash_Tables (Item, GAL.Support.Null_Type, Memory,
 
359
                               Initial_Size, Hash, "=", Choose_Size);
 
360
 
 
361
   type Visitor is abstract
 
362
     new Impl.Visitor with null record;
 
363
 
 
364
   procedure Action
 
365
     (V     : in out Visitor;
 
366
      Key   : in     Item;
 
367
      Value : in out GAL.Support.Null_Type;
 
368
      Quit  : in out Boolean);
 
369
   --  Dispatching call-through to 'Execute'.
 
370
 
 
371
   type Hash_Table is
 
372
      record
 
373
         Rep : Impl.Hash_Table;
 
374
      end record;
 
375
 
 
376
   Null_Hash_Table : constant Hash_Table := (Rep => Impl.Null_Hash_Table);
 
377
 
 
378
end GAL.Containers.Hash_Tables;
 
379
 
 
380
 
 
381
 
 
382
 
 
383
 
 
384
 
 
385