1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- A D A . C O N T A I N E R S . --
6 -- H A S H _ T A B L E S . G E N E R I C _ K E Y S --
10 -- Copyright (C) 2004-2007, Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- This unit was originally developed by Matthew J Heaney. --
31 ------------------------------------------------------------------------------
33 package body Ada.Containers.Hash_Tables.Generic_Keys is
35 --------------------------
36 -- Delete_Key_Sans_Free --
37 --------------------------
39 procedure Delete_Key_Sans_Free
40 (HT : in out Hash_Table_Type;
53 Indx := Index (HT, Key);
54 X := HT.Buckets (Indx);
60 if Equivalent_Keys (Key, X) then
62 raise Program_Error with
63 "attempt to tamper with elements (container is busy)";
65 HT.Buckets (Indx) := Next (X);
66 HT.Length := HT.Length - 1;
78 if Equivalent_Keys (Key, X) then
80 raise Program_Error with
81 "attempt to tamper with elements (container is busy)";
83 Set_Next (Node => Prev, Next => Next (X));
84 HT.Length := HT.Length - 1;
88 end Delete_Key_Sans_Free;
95 (HT : Hash_Table_Type;
96 Key : Key_Type) return Node_Access is
102 if HT.Length = 0 then
106 Indx := Index (HT, Key);
108 Node := HT.Buckets (Indx);
109 while Node /= null loop
110 if Equivalent_Keys (Key, Node) then
119 --------------------------------
120 -- Generic_Conditional_Insert --
121 --------------------------------
123 procedure Generic_Conditional_Insert
124 (HT : in out Hash_Table_Type;
126 Node : out Node_Access;
127 Inserted : out Boolean)
129 Indx : constant Hash_Type := Index (HT, Key);
130 B : Node_Access renames HT.Buckets (Indx);
135 raise Program_Error with
136 "attempt to tamper with elements (container is busy)";
139 if HT.Length = Count_Type'Last then
140 raise Constraint_Error;
143 Node := New_Node (Next => null);
147 HT.Length := HT.Length + 1;
154 if Equivalent_Keys (Key, Node) then
161 exit when Node = null;
165 raise Program_Error with
166 "attempt to tamper with elements (container is busy)";
169 if HT.Length = Count_Type'Last then
170 raise Constraint_Error;
173 Node := New_Node (Next => B);
177 HT.Length := HT.Length + 1;
178 end Generic_Conditional_Insert;
185 (HT : Hash_Table_Type;
186 Key : Key_Type) return Hash_Type is
188 return Hash (Key) mod HT.Buckets'Length;
191 -----------------------------
192 -- Generic_Replace_Element --
193 -----------------------------
195 procedure Generic_Replace_Element
196 (HT : in out Hash_Table_Type;
200 pragma Assert (HT.Length > 0);
201 pragma Assert (Node /= null);
203 Old_Hash : constant Hash_Type := Hash (Node);
204 Old_Indx : constant Hash_Type := Old_Hash mod HT.Buckets'Length;
206 New_Hash : constant Hash_Type := Hash (Key);
207 New_Indx : constant Hash_Type := New_Hash mod HT.Buckets'Length;
209 New_Bucket : Node_Access renames HT.Buckets (New_Indx);
213 if Equivalent_Keys (Key, Node) then
214 pragma Assert (New_Hash = Old_Hash);
217 raise Program_Error with
218 "attempt to tamper with cursors (container is locked)";
221 -- We can change a node's key to Key (that's what Assign is for), but
222 -- only if Key is not already in the hash table. (In a unique-key
223 -- hash table as this one a key is mapped to exactly one node only.)
224 -- The exception is when Key is mapped to Node, in which case the
225 -- change is allowed.
228 pragma Assert (Hash (Node) = New_Hash);
229 pragma Assert (Equivalent_Keys (Key, Node));
233 -- Key is not equivalent to Node, so we now have to determine if it's
234 -- equivalent to some other node in the hash table. This is the case
235 -- irrespective of whether Key is in the same or a different bucket from
240 if Equivalent_Keys (Key, N) then
241 pragma Assert (N /= Node);
242 raise Program_Error with
243 "attempt to replace existing element";
249 -- We have determined that Key is not already in the hash table, so
250 -- the change is tenatively allowed. We now perform the standard
251 -- checks to determine whether the hash table is locked (because you
252 -- cannot change an element while it's in use by Query_Element or
253 -- Update_Element), or if the container is busy (because moving a
254 -- node to a different bucket would interfere with iteration).
256 if Old_Indx = New_Indx then
257 -- The node is already in the bucket implied by Key. In this case
258 -- we merely change its value without moving it.
261 raise Program_Error with
262 "attempt to tamper with cursors (container is locked)";
266 pragma Assert (Hash (Node) = New_Hash);
267 pragma Assert (Equivalent_Keys (Key, Node));
271 -- The node is a bucket different from the bucket implied by Key
274 raise Program_Error with
275 "attempt to tamper with elements (container is busy)";
278 -- Do the assignment first, before moving the node, so that if Assign
279 -- propagates an exception, then the hash table will not have been
280 -- modified (except for any possible side-effect Assign had on Node).
283 pragma Assert (Hash (Node) = New_Hash);
284 pragma Assert (Equivalent_Keys (Key, Node));
286 -- Now we can safely remove the node from its current bucket
288 N := HT.Buckets (Old_Indx);
289 pragma Assert (N /= null);
292 HT.Buckets (Old_Indx) := Next (Node);
295 pragma Assert (HT.Length > 1);
299 pragma Assert (M /= null);
302 Set_Next (Node => N, Next => Next (Node));
310 -- Now we link the node into its new bucket (corresponding to Key)
312 Set_Next (Node => Node, Next => New_Bucket);
314 end Generic_Replace_Element;
316 end Ada.Containers.Hash_Tables.Generic_Keys;