1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.INDEFINITE_HASHED_SETS --
9 -- Copyright (C) 2004 Free Software Foundation, Inc. --
11 -- This specification is derived from the Ada Reference Manual for use with --
12 -- GNAT. The copyright notice above, and the license provisions that follow --
13 -- apply solely to the contents of the part following the private keyword. --
15 -- GNAT is free software; you can redistribute it and/or modify it under --
16 -- terms of the GNU General Public License as published by the Free Soft- --
17 -- ware Foundation; either version 2, or (at your option) any later ver- --
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
20 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
21 -- for more details. You should have received a copy of the GNU General --
22 -- Public License distributed with GNAT; see file COPYING. If not, write --
23 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
24 -- MA 02111-1307, USA. --
26 -- As a special exception, if other files instantiate generics from this --
27 -- unit, or you link this unit with other files to produce an executable, --
28 -- this unit does not by itself cause the resulting executable to be --
29 -- covered by the GNU General Public License. This exception does not --
30 -- however invalidate any other reasons why the executable file might be --
31 -- covered by the GNU Public License. --
33 -- This unit has originally being developed by Matthew J Heaney. --
34 ------------------------------------------------------------------------------
36 with Ada.Unchecked_Deallocation;
38 with Ada.Containers.Hash_Tables.Generic_Operations;
39 pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Operations);
41 with Ada.Containers.Hash_Tables.Generic_Keys;
42 pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys);
44 with System; use type System.Address;
46 with Ada.Containers.Prime_Numbers;
48 with Ada.Finalization; use Ada.Finalization;
50 package body Ada.Containers.Indefinite_Hashed_Sets is
52 type Element_Access is access Element_Type;
56 Element : Element_Access;
61 (Node : Node_Access) return Hash_Type;
62 pragma Inline (Hash_Node);
65 (Node : Node_Access) return Hash_Type is
67 return Hash (Node.Element.all);
71 (Node : Node_Access) return Node_Access;
75 (Node : Node_Access) return Node_Access is
83 pragma Inline (Set_Next);
87 Next : Node_Access) is
92 function Equivalent_Keys
94 Node : Node_Access) return Boolean;
95 pragma Inline (Equivalent_Keys);
97 function Equivalent_Keys
99 Node : Node_Access) return Boolean is
101 return Equivalent_Keys (Key, Node.Element.all);
105 (Source : Node_Access) return Node_Access;
106 pragma Inline (Copy_Node);
109 (Source : Node_Access) return Node_Access is
111 Target : constant Node_Access :=
112 new Node_Type'(Element => Source.Element,
119 procedure Free_Element is
120 new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
122 procedure Free (X : in out Node_Access);
124 procedure Free (X : in out Node_Access) is
125 procedure Deallocate is
126 new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
129 Free_Element (X.Element);
135 new Hash_Tables.Generic_Operations
136 (HT_Types => HT_Types,
137 Hash_Table_Type => Set,
139 Hash_Node => Hash_Node,
141 Set_Next => Set_Next,
142 Copy_Node => Copy_Node,
145 package Element_Keys is
146 new Hash_Tables.Generic_Keys
147 (HT_Types => HT_Types,
151 Set_Next => Set_Next,
152 Key_Type => Element_Type,
154 Equivalent_Keys => Equivalent_Keys);
157 procedure Adjust (Container : in out Set) renames HT_Ops.Adjust;
159 procedure Finalize (Container : in out Set) renames HT_Ops.Finalize;
162 function Find_Equal_Key
164 L_Node : Node_Access) return Boolean;
166 function Find_Equal_Key
168 L_Node : Node_Access) return Boolean is
170 R_Index : constant Hash_Type :=
171 Element_Keys.Index (R_Set, L_Node.Element.all);
173 R_Node : Node_Access := R_Set.Buckets (R_Index);
179 if R_Node = null then
183 if L_Node.Element.all = R_Node.Element.all then
187 R_Node := Next (R_Node);
194 new HT_Ops.Generic_Equal (Find_Equal_Key);
196 function "=" (Left, Right : Set) return Boolean renames Is_Equal;
199 function Length (Container : Set) return Count_Type is
201 return Container.Length;
205 function Is_Empty (Container : Set) return Boolean is
207 return Container.Length = 0;
211 procedure Clear (Container : in out Set) renames HT_Ops.Clear;
214 function Element (Position : Cursor) return Element_Type is
216 return Position.Node.Element.all;
220 procedure Query_Element
221 (Position : in Cursor;
222 Process : not null access procedure (Element : in Element_Type)) is
224 Process (Position.Node.Element.all);
229 -- procedure Replace_Element (Container : in out Set;
230 -- Position : in Node_Access;
231 -- By : in Element_Type);
233 -- procedure Replace_Element (Container : in out Set;
234 -- Position : in Node_Access;
235 -- By : in Element_Type) is
237 -- Node : Node_Access := Position;
241 -- if Equivalent_Keys (Node.Element.all, By) then
244 -- X : Element_Access := Node.Element;
246 -- Node.Element := new Element_Type'(By);
248 -- -- NOTE: If there's an exception here, then just
249 -- -- let it propagate. We haven't modified the
250 -- -- state of the container, so there's nothing else
260 -- HT_Ops.Delete_Node_Sans_Free (Container, Node);
263 -- Free_Element (Node.Element);
266 -- Node.Element := null; -- don't attempt to dealloc X.E again
272 -- Node.Element := new Element_Type'(By);
280 -- function New_Node (Next : Node_Access) return Node_Access;
281 -- pragma Inline (New_Node);
283 -- function New_Node (Next : Node_Access) return Node_Access is
285 -- Node.Next := Next;
289 -- procedure Insert is
290 -- new Element_Keys.Generic_Conditional_Insert (New_Node);
292 -- Result : Node_Access;
293 -- Success : Boolean;
297 -- Key => Node.Element.all,
299 -- Success => Success);
301 -- if not Success then
303 -- raise Program_Error;
306 -- pragma Assert (Result = Node);
309 -- end Replace_Element;
312 -- procedure Replace_Element (Container : in out Set;
313 -- Position : in Cursor;
314 -- By : in Element_Type) is
317 -- if Position.Container = null then
318 -- raise Constraint_Error;
321 -- if Position.Container /= Set_Access'(Container'Unchecked_Access) then
322 -- raise Program_Error;
325 -- Replace_Element (Container, Position.Node, By);
327 -- end Replace_Element;
330 procedure Move (Target : in out Set;
331 Source : in out Set) renames HT_Ops.Move;
334 procedure Insert (Container : in out Set;
335 New_Item : in Element_Type;
336 Position : out Cursor;
337 Inserted : out Boolean) is
339 function New_Node (Next : Node_Access) return Node_Access;
340 pragma Inline (New_Node);
342 function New_Node (Next : Node_Access) return Node_Access is
343 Element : Element_Access := new Element_Type'(New_Item);
345 return new Node_Type'(Element, Next);
348 Free_Element (Element);
353 new Element_Keys.Generic_Conditional_Insert (New_Node);
357 HT_Ops.Ensure_Capacity (Container, Container.Length + 1);
358 Insert (Container, New_Item, Position.Node, Inserted);
359 Position.Container := Container'Unchecked_Access;
364 procedure Insert (Container : in out Set;
365 New_Item : in Element_Type) is
372 Insert (Container, New_Item, Position, Inserted);
375 raise Constraint_Error;
381 procedure Replace (Container : in out Set;
382 New_Item : in Element_Type) is
384 Node : constant Node_Access :=
385 Element_Keys.Find (Container, New_Item);
392 raise Constraint_Error;
397 Node.Element := new Element_Type'(New_Item);
404 procedure Include (Container : in out Set;
405 New_Item : in Element_Type) is
414 Insert (Container, New_Item, Position, Inserted);
418 X := Position.Node.Element;
420 Position.Node.Element := new Element_Type'(New_Item);
429 procedure Delete (Container : in out Set;
430 Item : in Element_Type) is
436 Element_Keys.Delete_Key_Sans_Free (Container, Item, X);
439 raise Constraint_Error;
447 procedure Exclude (Container : in out Set;
448 Item : in Element_Type) is
454 Element_Keys.Delete_Key_Sans_Free (Container, Item, X);
460 procedure Delete (Container : in out Set;
461 Position : in out Cursor) is
464 if Position = No_Element then
468 if Position.Container /= Set_Access'(Container'Unchecked_Access) then
472 HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
473 Free (Position.Node);
475 Position.Container := null;
481 procedure Union (Target : in out Set;
484 procedure Process (Src_Node : in Node_Access);
486 procedure Process (Src_Node : in Node_Access) is
488 Src : Element_Type renames Src_Node.Element.all;
490 function New_Node (Next : Node_Access) return Node_Access;
491 pragma Inline (New_Node);
493 function New_Node (Next : Node_Access) return Node_Access is
494 Tgt : Element_Access := new Element_Type'(Src);
496 return new Node_Type'(Tgt, Next);
504 new Element_Keys.Generic_Conditional_Insert (New_Node);
506 Tgt_Node : Node_Access;
511 Insert (Target, Src, Tgt_Node, Success);
516 new HT_Ops.Generic_Iteration (Process);
520 if Target'Address = Source'Address then
524 HT_Ops.Ensure_Capacity (Target, Target.Length + Source.Length);
532 function Union (Left, Right : Set) return Set is
534 Buckets : HT_Types.Buckets_Access;
539 if Left'Address = Right'Address then
543 if Right.Length = 0 then
547 if Left.Length = 0 then
552 Size : constant Hash_Type :=
553 Prime_Numbers.To_Prime (Left.Length + Right.Length);
555 Buckets := new Buckets_Type (0 .. Size - 1);
559 procedure Process (L_Node : Node_Access);
561 procedure Process (L_Node : Node_Access) is
562 I : constant Hash_Type :=
563 Hash (L_Node.Element.all) mod Buckets'Length;
565 Buckets (I) := new Node_Type'(L_Node.Element, Buckets (I));
569 new HT_Ops.Generic_Iteration (Process);
574 HT_Ops.Free_Hash_Table (Buckets);
578 Length := Left.Length;
581 procedure Process (Src_Node : Node_Access);
583 procedure Process (Src_Node : Node_Access) is
585 Src : Element_Type renames Src_Node.Element.all;
587 I : constant Hash_Type :=
588 Hash (Src) mod Buckets'Length;
590 Tgt_Node : Node_Access := Buckets (I);
594 while Tgt_Node /= null loop
596 if Equivalent_Keys (Src, Tgt_Node.Element.all) then
600 Tgt_Node := Next (Tgt_Node);
605 Tgt : Element_Access := new Element_Type'(Src);
607 Buckets (I) := new Node_Type'(Tgt, Buckets (I));
614 Length := Length + 1;
619 new HT_Ops.Generic_Iteration (Process);
624 HT_Ops.Free_Hash_Table (Buckets);
628 return (Controlled with Buckets, Length);
635 Key : Node_Access) return Boolean;
636 pragma Inline (Is_In);
640 Key : Node_Access) return Boolean is
642 return Element_Keys.Find (HT, Key.Element.all) /= null;
646 procedure Intersection (Target : in out Set;
649 Tgt_Node : Node_Access;
653 if Target'Address = Source'Address then
657 if Source.Length = 0 then
662 -- TODO: optimize this to use an explicit
663 -- loop instead of an active iterator
664 -- (similar to how a passive iterator is
667 -- Another possibility is to test which
668 -- set is smaller, and iterate over the
671 Tgt_Node := HT_Ops.First (Target);
673 while Tgt_Node /= null loop
675 if Is_In (Source, Tgt_Node) then
677 Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
682 X : Node_Access := Tgt_Node;
684 Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
685 HT_Ops.Delete_Node_Sans_Free (Target, X);
696 function Intersection (Left, Right : Set) return Set is
698 Buckets : HT_Types.Buckets_Access;
703 if Left'Address = Right'Address then
707 Length := Count_Type'Min (Left.Length, Right.Length);
714 Size : constant Hash_Type := Prime_Numbers.To_Prime (Length);
716 Buckets := new Buckets_Type (0 .. Size - 1);
722 procedure Process (L_Node : Node_Access);
724 procedure Process (L_Node : Node_Access) is
726 if Is_In (Right, L_Node) then
729 I : constant Hash_Type :=
730 Hash (L_Node.Element.all) mod Buckets'Length;
732 Buckets (I) := new Node_Type'(L_Node.Element, Buckets (I));
735 Length := Length + 1;
741 new HT_Ops.Generic_Iteration (Process);
746 HT_Ops.Free_Hash_Table (Buckets);
750 return (Controlled with Buckets, Length);
755 procedure Difference (Target : in out Set;
759 Tgt_Node : Node_Access;
763 if Target'Address = Source'Address then
768 if Source.Length = 0 then
772 -- TODO: As I noted above, this can be
773 -- written in terms of a loop instead as
774 -- active-iterator style, sort of like a
777 Tgt_Node := HT_Ops.First (Target);
779 while Tgt_Node /= null loop
781 if Is_In (Source, Tgt_Node) then
784 X : Node_Access := Tgt_Node;
786 Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
787 HT_Ops.Delete_Node_Sans_Free (Target, X);
793 Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
803 function Difference (Left, Right : Set) return Set is
805 Buckets : HT_Types.Buckets_Access;
810 if Left'Address = Right'Address then
814 if Left.Length = 0 then
818 if Right.Length = 0 then
823 Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length);
825 Buckets := new Buckets_Type (0 .. Size - 1);
831 procedure Process (L_Node : Node_Access);
833 procedure Process (L_Node : Node_Access) is
835 if not Is_In (Right, L_Node) then
838 I : constant Hash_Type :=
839 Hash (L_Node.Element.all) mod Buckets'Length;
841 Buckets (I) := new Node_Type'(L_Node.Element, Buckets (I));
844 Length := Length + 1;
850 new HT_Ops.Generic_Iteration (Process);
855 HT_Ops.Free_Hash_Table (Buckets);
859 return (Controlled with Buckets, Length);
865 procedure Symmetric_Difference (Target : in out Set;
869 if Target'Address = Source'Address then
874 HT_Ops.Ensure_Capacity (Target, Target.Length + Source.Length);
876 if Target.Length = 0 then
879 procedure Process (Src_Node : Node_Access);
881 procedure Process (Src_Node : Node_Access) is
882 E : Element_Type renames Src_Node.Element.all;
883 B : Buckets_Type renames Target.Buckets.all;
884 I : constant Hash_Type := Hash (E) mod B'Length;
885 N : Count_Type renames Target.Length;
888 X : Element_Access := new Element_Type'(E);
890 B (I) := new Node_Type'(X, B (I));
901 new HT_Ops.Generic_Iteration (Process);
909 procedure Process (Src_Node : Node_Access);
911 procedure Process (Src_Node : Node_Access) is
912 E : Element_Type renames Src_Node.Element.all;
913 B : Buckets_Type renames Target.Buckets.all;
914 I : constant Hash_Type := Hash (E) mod B'Length;
915 N : Count_Type renames Target.Length;
920 X : Element_Access := new Element_Type'(E);
922 B (I) := new Node_Type'(X, null);
931 elsif Equivalent_Keys (E, B (I).Element.all) then
934 X : Node_Access := B (I);
944 Prev : Node_Access := B (I);
945 Curr : Node_Access := Prev.Next;
947 while Curr /= null loop
948 if Equivalent_Keys (E, Curr.Element.all) then
949 Prev.Next := Curr.Next;
960 X : Element_Access := new Element_Type'(E);
962 B (I) := new Node_Type'(X, B (I));
976 new HT_Ops.Generic_Iteration (Process);
983 end Symmetric_Difference;
986 function Symmetric_Difference (Left, Right : Set) return Set is
988 Buckets : HT_Types.Buckets_Access;
993 if Left'Address = Right'Address then
997 if Right.Length = 0 then
1001 if Left.Length = 0 then
1006 Size : constant Hash_Type :=
1007 Prime_Numbers.To_Prime (Left.Length + Right.Length);
1009 Buckets := new Buckets_Type (0 .. Size - 1);
1015 procedure Process (L_Node : Node_Access);
1017 procedure Process (L_Node : Node_Access) is
1019 if not Is_In (Right, L_Node) then
1021 E : Element_Type renames L_Node.Element.all;
1022 I : constant Hash_Type := Hash (E) mod Buckets'Length;
1026 X : Element_Access := new Element_Type'(E);
1028 Buckets (I) := new Node_Type'(X, Buckets (I));
1035 Length := Length + 1;
1040 procedure Iterate is
1041 new HT_Ops.Generic_Iteration (Process);
1046 HT_Ops.Free_Hash_Table (Buckets);
1051 procedure Process (R_Node : Node_Access);
1053 procedure Process (R_Node : Node_Access) is
1055 if not Is_In (Left, R_Node) then
1057 E : Element_Type renames R_Node.Element.all;
1058 I : constant Hash_Type := Hash (E) mod Buckets'Length;
1062 X : Element_Access := new Element_Type'(E);
1064 Buckets (I) := new Node_Type'(X, Buckets (I));
1071 Length := Length + 1;
1077 procedure Iterate is
1078 new HT_Ops.Generic_Iteration (Process);
1083 HT_Ops.Free_Hash_Table (Buckets);
1087 return (Controlled with Buckets, Length);
1089 end Symmetric_Difference;
1092 function Is_Subset (Subset : Set;
1093 Of_Set : Set) return Boolean is
1095 Subset_Node : Node_Access;
1099 if Subset'Address = Of_Set'Address then
1103 if Subset.Length > Of_Set.Length then
1107 -- TODO: rewrite this to loop in the
1108 -- style of a passive iterator.
1110 Subset_Node := HT_Ops.First (Subset);
1112 while Subset_Node /= null loop
1113 if not Is_In (Of_Set, Subset_Node) then
1117 Subset_Node := HT_Ops.Next (Subset, Subset_Node);
1125 function Overlap (Left, Right : Set) return Boolean is
1127 Left_Node : Node_Access;
1131 if Right.Length = 0 then
1135 if Left'Address = Right'Address then
1139 Left_Node := HT_Ops.First (Left);
1141 while Left_Node /= null loop
1142 if Is_In (Right, Left_Node) then
1146 Left_Node := HT_Ops.Next (Left, Left_Node);
1154 function Find (Container : Set;
1155 Item : Element_Type) return Cursor is
1157 Node : constant Node_Access := Element_Keys.Find (Container, Item);
1165 return Cursor'(Container'Unchecked_Access, Node);
1170 function Contains (Container : Set;
1171 Item : Element_Type) return Boolean is
1173 return Find (Container, Item) /= No_Element;
1178 function First (Container : Set) return Cursor is
1179 Node : constant Node_Access := HT_Ops.First (Container);
1185 return Cursor'(Container'Unchecked_Access, Node);
1189 -- function First_Element (Container : Set) return Element_Type is
1190 -- Node : constant Node_Access := HT_Ops.First (Container);
1192 -- return Node.Element;
1193 -- end First_Element;
1196 function Next (Position : Cursor) return Cursor is
1198 if Position.Container = null
1199 or else Position.Node = null
1205 S : Set renames Position.Container.all;
1206 Node : constant Node_Access := HT_Ops.Next (S, Position.Node);
1212 return Cursor'(Position.Container, Node);
1217 procedure Next (Position : in out Cursor) is
1219 Position := Next (Position);
1223 function Has_Element (Position : Cursor) return Boolean is
1225 if Position.Container = null then
1229 if Position.Node = null then
1237 function Equivalent_Keys (Left, Right : Cursor)
1240 return Equivalent_Keys (Left.Node.Element.all, Right.Node.Element.all);
1241 end Equivalent_Keys;
1244 function Equivalent_Keys (Left : Cursor;
1245 Right : Element_Type)
1248 return Equivalent_Keys (Left.Node.Element.all, Right);
1249 end Equivalent_Keys;
1252 function Equivalent_Keys (Left : Element_Type;
1256 return Equivalent_Keys (Left, Right.Node.Element.all);
1257 end Equivalent_Keys;
1261 (Container : in Set;
1262 Process : not null access procedure (Position : in Cursor)) is
1264 procedure Process_Node (Node : in Node_Access);
1265 pragma Inline (Process_Node);
1267 procedure Process_Node (Node : in Node_Access) is
1269 Process (Cursor'(Container'Unchecked_Access, Node));
1272 procedure Iterate is
1273 new HT_Ops.Generic_Iteration (Process_Node);
1275 Iterate (Container);
1279 function Capacity (Container : Set) return Count_Type
1280 renames HT_Ops.Capacity;
1282 procedure Reserve_Capacity
1283 (Container : in out Set;
1284 Capacity : in Count_Type)
1285 renames HT_Ops.Ensure_Capacity;
1288 procedure Write_Node
1289 (Stream : access Root_Stream_Type'Class;
1290 Node : in Node_Access);
1291 pragma Inline (Write_Node);
1293 procedure Write_Node
1294 (Stream : access Root_Stream_Type'Class;
1295 Node : in Node_Access) is
1297 Element_Type'Output (Stream, Node.Element.all);
1300 procedure Write_Nodes is
1301 new HT_Ops.Generic_Write (Write_Node);
1304 (Stream : access Root_Stream_Type'Class;
1305 Container : in Set) renames Write_Nodes;
1308 function Read_Node (Stream : access Root_Stream_Type'Class)
1310 pragma Inline (Read_Node);
1312 function Read_Node (Stream : access Root_Stream_Type'Class)
1313 return Node_Access is
1315 X : Element_Access := new Element_Type'(Element_Type'Input (Stream));
1317 return new Node_Type'(X, null);
1324 procedure Read_Nodes is
1325 new HT_Ops.Generic_Read (Read_Node);
1328 (Stream : access Root_Stream_Type'Class;
1329 Container : out Set) renames Read_Nodes;
1332 package body Generic_Keys is
1334 function Equivalent_Keys (Left : Cursor;
1338 return Equivalent_Keys (Right, Left.Node.Element.all);
1339 end Equivalent_Keys;
1341 function Equivalent_Keys (Left : Key_Type;
1345 return Equivalent_Keys (Left, Right.Node.Element.all);
1346 end Equivalent_Keys;
1348 function Equivalent_Keys
1350 Node : Node_Access) return Boolean;
1351 pragma Inline (Equivalent_Keys);
1353 function Equivalent_Keys
1355 Node : Node_Access) return Boolean is
1357 return Equivalent_Keys (Key, Node.Element.all);
1358 end Equivalent_Keys;
1361 new Hash_Tables.Generic_Keys
1362 (HT_Types => HT_Types,
1366 Set_Next => Set_Next,
1367 Key_Type => Key_Type,
1369 Equivalent_Keys => Equivalent_Keys);
1372 function Find (Container : Set;
1376 Node : constant Node_Access :=
1377 Key_Keys.Find (Container, Key);
1385 return Cursor'(Container'Unchecked_Access, Node);
1390 function Contains (Container : Set;
1391 Key : Key_Type) return Boolean is
1393 return Find (Container, Key) /= No_Element;
1397 function Element (Container : Set;
1399 return Element_Type is
1401 Node : constant Node_Access := Key_Keys.Find (Container, Key);
1403 return Node.Element.all;
1407 function Key (Position : Cursor) return Key_Type is
1409 return Key (Position.Node.Element.all);
1414 -- procedure Replace (Container : in out Set;
1415 -- Key : in Key_Type;
1416 -- New_Item : in Element_Type) is
1418 -- Node : constant Node_Access :=
1419 -- Key_Keys.Find (Container, Key);
1423 -- if Node = null then
1424 -- raise Constraint_Error;
1427 -- Replace_Element (Container, Node, New_Item);
1432 procedure Delete (Container : in out Set;
1433 Key : in Key_Type) is
1439 Key_Keys.Delete_Key_Sans_Free (Container, Key, X);
1442 raise Constraint_Error;
1450 procedure Exclude (Container : in out Set;
1451 Key : in Key_Type) is
1457 Key_Keys.Delete_Key_Sans_Free (Container, Key, X);
1463 procedure Checked_Update_Element
1464 (Container : in out Set;
1465 Position : in Cursor;
1466 Process : not null access
1467 procedure (Element : in out Element_Type)) is
1471 if Position.Container = null then
1472 raise Constraint_Error;
1475 if Position.Container /= Set_Access'(Container'Unchecked_Access) then
1476 raise Program_Error;
1480 Old_Key : Key_Type renames Key (Position.Node.Element.all);
1482 Process (Position.Node.Element.all);
1484 if Equivalent_Keys (Old_Key, Position.Node.Element.all) then
1490 function New_Node (Next : Node_Access) return Node_Access;
1491 pragma Inline (New_Node);
1493 function New_Node (Next : Node_Access) return Node_Access is
1495 Position.Node.Next := Next;
1496 return Position.Node;
1500 new Key_Keys.Generic_Conditional_Insert (New_Node);
1502 Result : Node_Access;
1505 HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
1509 Key => Key (Position.Node.Element.all),
1511 Success => Success);
1515 X : Node_Access := Position.Node;
1520 raise Program_Error;
1523 pragma Assert (Result = Position.Node);
1526 end Checked_Update_Element;
1530 end Ada.Containers.Indefinite_Hashed_Sets;