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-2006, 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
64 HT.Buckets (Indx) := Next (X);
65 HT.Length := HT.Length - 1;
77 if Equivalent_Keys (Key, X) then
81 Set_Next (Node => Prev, Next => Next (X));
82 HT.Length := HT.Length - 1;
86 end Delete_Key_Sans_Free;
93 (HT : Hash_Table_Type;
94 Key : Key_Type) return Node_Access is
100 if HT.Length = 0 then
104 Indx := Index (HT, Key);
106 Node := HT.Buckets (Indx);
107 while Node /= null loop
108 if Equivalent_Keys (Key, Node) then
117 --------------------------------
118 -- Generic_Conditional_Insert --
119 --------------------------------
121 procedure Generic_Conditional_Insert
122 (HT : in out Hash_Table_Type;
124 Node : out Node_Access;
125 Inserted : out Boolean)
127 Indx : constant Hash_Type := Index (HT, Key);
128 B : Node_Access renames HT.Buckets (Indx);
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;
165 if HT.Length = Count_Type'Last then
166 raise Constraint_Error;
169 Node := New_Node (Next => B);
173 HT.Length := HT.Length + 1;
174 end Generic_Conditional_Insert;
181 (HT : Hash_Table_Type;
182 Key : Key_Type) return Hash_Type is
184 return Hash (Key) mod HT.Buckets'Length;
187 ---------------------
188 -- Replace_Element --
189 ---------------------
191 procedure Generic_Replace_Element
192 (HT : in out Hash_Table_Type;
197 pragma Assert (HT.Length > 0);
199 if Equivalent_Keys (Key, Node) then
200 pragma Assert (Hash (Key) = Hash (Node));
203 raise Program_Error with
204 "attempt to tamper with cursors (container is locked)";
213 K : constant Hash_Type := Index (HT, Key);
214 B : Node_Access renames HT.Buckets (K);
215 N : Node_Access := B;
220 if Equivalent_Keys (Key, N) then
221 raise Program_Error with
222 "attempt to replace existing element";
232 raise Program_Error with
233 "attempt to tamper with cursors (container is locked)";
241 raise Program_Error with
242 "attempt to tamper with elements (container is busy)";
248 pragma Assert (N /= null);
251 HT.Buckets (J) := Next (Node);
254 pragma Assert (HT.Length > 1);
258 pragma Assert (M /= null);
261 Set_Next (Node => N, Next => Next (Node));
269 Set_Next (Node => Node, Next => B);
272 end Generic_Replace_Element;
274 end Ada.Containers.Hash_Tables.Generic_Keys;