1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.HASH_TABLES.GENERIC_BOUNDED_KEYS --
9 -- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- This unit was originally developed by Matthew J Heaney. --
28 ------------------------------------------------------------------------------
30 package body Ada.Containers.Hash_Tables.Generic_Bounded_Keys is
32 --------------------------
33 -- Delete_Key_Sans_Free --
34 --------------------------
36 procedure Delete_Key_Sans_Free
37 (HT : in out Hash_Table_Type'Class;
50 Indx := Index (HT, Key);
51 X := HT.Buckets (Indx);
57 if Equivalent_Keys (Key, HT.Nodes (X)) then
59 raise Program_Error with
60 "attempt to tamper with cursors (container is busy)";
62 HT.Buckets (Indx) := Next (HT.Nodes (X));
63 HT.Length := HT.Length - 1;
69 X := Next (HT.Nodes (Prev));
75 if Equivalent_Keys (Key, HT.Nodes (X)) then
77 raise Program_Error with
78 "attempt to tamper with cursors (container is busy)";
80 Set_Next (HT.Nodes (Prev), Next => Next (HT.Nodes (X)));
81 HT.Length := HT.Length - 1;
85 end Delete_Key_Sans_Free;
92 (HT : Hash_Table_Type'Class;
93 Key : Key_Type) return Count_Type
103 Indx := Index (HT, Key);
105 Node := HT.Buckets (Indx);
107 if Equivalent_Keys (Key, HT.Nodes (Node)) then
110 Node := Next (HT.Nodes (Node));
116 --------------------------------
117 -- Generic_Conditional_Insert --
118 --------------------------------
120 procedure Generic_Conditional_Insert
121 (HT : in out Hash_Table_Type'Class;
123 Node : out Count_Type;
124 Inserted : out Boolean)
126 Indx : constant Hash_Type := Index (HT, Key);
127 B : Count_Type renames HT.Buckets (Indx);
132 raise Program_Error with
133 "attempt to tamper with cursors (container is busy)";
136 if HT.Length = HT.Capacity then
137 raise Capacity_Error with "no more capacity for insertion";
141 Set_Next (HT.Nodes (Node), Next => 0);
146 HT.Length := HT.Length + 1;
153 if Equivalent_Keys (Key, HT.Nodes (Node)) then
158 Node := Next (HT.Nodes (Node));
164 raise Program_Error with
165 "attempt to tamper with cursors (container is busy)";
168 if HT.Length = HT.Capacity then
169 raise Capacity_Error with "no more capacity for insertion";
173 Set_Next (HT.Nodes (Node), Next => B);
178 HT.Length := HT.Length + 1;
179 end Generic_Conditional_Insert;
186 (HT : Hash_Table_Type'Class;
187 Key : Key_Type) return Hash_Type is
189 return HT.Buckets'First + Hash (Key) mod HT.Buckets'Length;
192 -----------------------------
193 -- Generic_Replace_Element --
194 -----------------------------
196 procedure Generic_Replace_Element
197 (HT : in out Hash_Table_Type'Class;
201 pragma Assert (HT.Length > 0);
202 pragma Assert (Node /= 0);
204 BB : Buckets_Type renames HT.Buckets;
205 NN : Nodes_Type renames HT.Nodes;
207 Old_Hash : constant Hash_Type := Hash (NN (Node));
208 Old_Indx : constant Hash_Type := BB'First + Old_Hash mod BB'Length;
210 New_Hash : constant Hash_Type := Hash (Key);
211 New_Indx : constant Hash_Type := BB'First + New_Hash mod BB'Length;
213 New_Bucket : Count_Type renames BB (New_Indx);
217 -- Replace_Element is allowed to change a node's key to Key
218 -- (generic formal operation Assign provides the mechanism), but
219 -- only if Key is not already in the hash table. (In a unique-key
220 -- hash table as this one, a key is mapped to exactly one node.)
222 if Equivalent_Keys (Key, NN (Node)) then
223 pragma Assert (New_Hash = Old_Hash);
226 raise Program_Error with
227 "attempt to tamper with elements (container is locked)";
230 -- The new Key value is mapped to this same Node, so Node
231 -- stays in the same bucket.
233 Assign (NN (Node), Key);
234 pragma Assert (Hash (NN (Node)) = New_Hash);
235 pragma Assert (Equivalent_Keys (Key, NN (Node)));
239 -- Key is not equivalent to Node, so we now have to determine if it's
240 -- equivalent to some other node in the hash table. This is the case
241 -- irrespective of whether Key is in the same or a different bucket from
246 if Equivalent_Keys (Key, NN (N)) then
247 pragma Assert (N /= Node);
248 raise Program_Error with
249 "attempt to replace existing element";
255 -- We have determined that Key is not already in the hash table, so
256 -- the change is tentatively allowed. We now perform the standard
257 -- checks to determine whether the hash table is locked (because you
258 -- cannot change an element while it's in use by Query_Element or
259 -- Update_Element), or if the container is busy (because moving a
260 -- node to a different bucket would interfere with iteration).
262 if Old_Indx = New_Indx then
263 -- The node is already in the bucket implied by Key. In this case
264 -- we merely change its value without moving it.
267 raise Program_Error with
268 "attempt to tamper with elements (container is locked)";
271 Assign (NN (Node), Key);
272 pragma Assert (Hash (NN (Node)) = New_Hash);
273 pragma Assert (Equivalent_Keys (Key, NN (Node)));
277 -- The node is a bucket different from the bucket implied by Key
280 raise Program_Error with
281 "attempt to tamper with cursors (container is busy)";
284 -- Do the assignment first, before moving the node, so that if Assign
285 -- propagates an exception, then the hash table will not have been
286 -- modified (except for any possible side-effect Assign had on Node).
288 Assign (NN (Node), Key);
289 pragma Assert (Hash (NN (Node)) = New_Hash);
290 pragma Assert (Equivalent_Keys (Key, NN (Node)));
292 -- Now we can safely remove the node from its current bucket
294 N := BB (Old_Indx); -- get value of first node in old bucket
295 pragma Assert (N /= 0);
297 if N = Node then -- node is first node in its bucket
298 BB (Old_Indx) := Next (NN (Node));
301 pragma Assert (HT.Length > 1);
305 pragma Assert (M /= 0);
308 Set_Next (NN (N), Next => Next (NN (Node)));
316 -- Now we link the node into its new bucket (corresponding to Key)
318 Set_Next (NN (Node), Next => New_Bucket);
320 end Generic_Replace_Element;
322 end Ada.Containers.Hash_Tables.Generic_Bounded_Keys;