1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.HASH_TABLES.GENERIC_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_Keys is
32 --------------------------
33 -- Delete_Key_Sans_Free --
34 --------------------------
36 procedure Delete_Key_Sans_Free
37 (HT : in out Hash_Table_Type;
50 Indx := Index (HT, Key);
51 X := HT.Buckets (Indx);
57 if Equivalent_Keys (Key, X) then
59 raise Program_Error with
60 "attempt to tamper with cursors (container is busy)";
62 HT.Buckets (Indx) := Next (X);
63 HT.Length := HT.Length - 1;
75 if Equivalent_Keys (Key, X) then
77 raise Program_Error with
78 "attempt to tamper with cursors (container is busy)";
80 Set_Next (Node => Prev, Next => Next (X));
81 HT.Length := HT.Length - 1;
85 end Delete_Key_Sans_Free;
92 (HT : Hash_Table_Type;
93 Key : Key_Type) return Node_Access is
103 Indx := Index (HT, Key);
105 Node := HT.Buckets (Indx);
106 while Node /= null loop
107 if Equivalent_Keys (Key, Node) then
116 --------------------------------
117 -- Generic_Conditional_Insert --
118 --------------------------------
120 procedure Generic_Conditional_Insert
121 (HT : in out Hash_Table_Type;
123 Node : out Node_Access;
124 Inserted : out Boolean)
126 Indx : constant Hash_Type := Index (HT, Key);
127 B : Node_Access renames HT.Buckets (Indx);
132 raise Program_Error with
133 "attempt to tamper with cursors (container is busy)";
136 if HT.Length = Count_Type'Last then
137 raise Constraint_Error;
140 Node := New_Node (Next => null);
144 HT.Length := HT.Length + 1;
151 if Equivalent_Keys (Key, Node) then
158 exit when Node = null;
162 raise Program_Error with
163 "attempt to tamper with cursors (container is busy)";
166 if HT.Length = Count_Type'Last then
167 raise Constraint_Error;
170 Node := New_Node (Next => B);
174 HT.Length := HT.Length + 1;
175 end Generic_Conditional_Insert;
182 (HT : Hash_Table_Type;
183 Key : Key_Type) return Hash_Type is
185 return Hash (Key) mod HT.Buckets'Length;
188 -----------------------------
189 -- Generic_Replace_Element --
190 -----------------------------
192 procedure Generic_Replace_Element
193 (HT : in out Hash_Table_Type;
197 pragma Assert (HT.Length > 0);
198 pragma Assert (Node /= null);
200 Old_Hash : constant Hash_Type := Hash (Node);
201 Old_Indx : constant Hash_Type := Old_Hash mod HT.Buckets'Length;
203 New_Hash : constant Hash_Type := Hash (Key);
204 New_Indx : constant Hash_Type := New_Hash mod HT.Buckets'Length;
206 New_Bucket : Node_Access renames HT.Buckets (New_Indx);
210 if Equivalent_Keys (Key, Node) then
211 pragma Assert (New_Hash = Old_Hash);
214 raise Program_Error with
215 "attempt to tamper with elements (container is locked)";
218 -- We can change a node's key to Key (that's what Assign is for), 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 only.)
221 -- The exception is when Key is mapped to Node, in which case the
222 -- change is allowed.
225 pragma Assert (Hash (Node) = New_Hash);
226 pragma Assert (Equivalent_Keys (Key, Node));
230 -- Key is not equivalent to Node, so we now have to determine if it's
231 -- equivalent to some other node in the hash table. This is the case
232 -- irrespective of whether Key is in the same or a different bucket from
237 if Equivalent_Keys (Key, N) then
238 pragma Assert (N /= Node);
239 raise Program_Error with
240 "attempt to replace existing element";
246 -- We have determined that Key is not already in the hash table, so
247 -- the change is tentatively allowed. We now perform the standard
248 -- checks to determine whether the hash table is locked (because you
249 -- cannot change an element while it's in use by Query_Element or
250 -- Update_Element), or if the container is busy (because moving a
251 -- node to a different bucket would interfere with iteration).
253 if Old_Indx = New_Indx then
254 -- The node is already in the bucket implied by Key. In this case
255 -- we merely change its value without moving it.
258 raise Program_Error with
259 "attempt to tamper with elements (container is locked)";
263 pragma Assert (Hash (Node) = New_Hash);
264 pragma Assert (Equivalent_Keys (Key, Node));
268 -- The node is a bucket different from the bucket implied by Key
271 raise Program_Error with
272 "attempt to tamper with cursors (container is busy)";
275 -- Do the assignment first, before moving the node, so that if Assign
276 -- propagates an exception, then the hash table will not have been
277 -- modified (except for any possible side-effect Assign had on Node).
280 pragma Assert (Hash (Node) = New_Hash);
281 pragma Assert (Equivalent_Keys (Key, Node));
283 -- Now we can safely remove the node from its current bucket
285 N := HT.Buckets (Old_Indx);
286 pragma Assert (N /= null);
289 HT.Buckets (Old_Indx) := Next (Node);
292 pragma Assert (HT.Length > 1);
296 pragma Assert (M /= null);
299 Set_Next (Node => N, Next => Next (Node));
307 -- Now we link the node into its new bucket (corresponding to Key)
309 Set_Next (Node => Node, Next => New_Bucket);
311 end Generic_Replace_Element;
313 end Ada.Containers.Hash_Tables.Generic_Keys;