1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.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
.Hashed_Sets
is
54 Element
: Element_Type
;
59 (Node
: Node_Access
) return Hash_Type
;
60 pragma Inline
(Hash_Node
);
63 (Node
: Node_Access
) return Hash_Type
is
65 return Hash
(Node
.Element
);
69 (Node
: Node_Access
) return Node_Access
;
73 (Node
: Node_Access
) return Node_Access
is
81 pragma Inline
(Set_Next
);
85 Next
: Node_Access
) is
90 function Equivalent_Keys
92 Node
: Node_Access
) return Boolean;
93 pragma Inline
(Equivalent_Keys
);
95 function Equivalent_Keys
97 Node
: Node_Access
) return Boolean is
99 return Equivalent_Keys
(Key
, Node
.Element
);
103 (Source
: Node_Access
) return Node_Access
;
104 pragma Inline
(Copy_Node
);
107 (Source
: Node_Access
) return Node_Access
is
109 Target
: constant Node_Access
:=
110 new Node_Type
'(Element => Source.Element,
118 new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
121 new Hash_Tables.Generic_Operations
122 (HT_Types => HT_Types,
123 Hash_Table_Type => Set,
125 Hash_Node => Hash_Node,
127 Set_Next => Set_Next,
128 Copy_Node => Copy_Node,
131 package Element_Keys is
132 new Hash_Tables.Generic_Keys
133 (HT_Types => HT_Types,
137 Set_Next => Set_Next,
138 Key_Type => Element_Type,
140 Equivalent_Keys => Equivalent_Keys);
143 procedure Adjust (Container : in out Set) renames HT_Ops.Adjust;
145 procedure Finalize (Container : in out Set) renames HT_Ops.Finalize;
148 function Find_Equal_Key
150 L_Node : Node_Access) return Boolean;
152 function Find_Equal_Key
154 L_Node : Node_Access) return Boolean is
156 R_Index : constant Hash_Type :=
157 Element_Keys.Index (R_Set, L_Node.Element);
159 R_Node : Node_Access := R_Set.Buckets (R_Index);
165 if R_Node = null then
169 if L_Node.Element = R_Node.Element then
170 -- pragma Assert (Is_Equal_Key (L_Node.Element, R_Node.Element));
174 R_Node := Next (R_Node);
181 new HT_Ops.Generic_Equal (Find_Equal_Key);
183 function "=" (Left, Right : Set) return Boolean renames Is_Equal;
186 function Length (Container : Set) return Count_Type is
188 return Container.Length;
192 function Is_Empty (Container : Set) return Boolean is
194 return Container.Length = 0;
198 procedure Clear (Container : in out Set) renames HT_Ops.Clear;
201 function Element (Position : Cursor) return Element_Type is
203 return Position.Node.Element;
207 procedure Query_Element
208 (Position : in Cursor;
209 Process : not null access procedure (Element : in Element_Type)) is
211 Process (Position.Node.Element);
216 -- procedure Replace_Element (Container : in out Set;
217 -- Position : in Node_Access;
218 -- By : in Element_Type) is
220 -- Node : Node_Access := Position;
224 -- if Equivalent_Keys (Node.Element, By) then
227 -- Node.Element := By;
230 -- HT_Ops.Delete_Node_Sans_Free (Container, Node);
239 -- HT_Ops.Delete_Node_Sans_Free (Container, Node);
242 -- Node.Element := By;
250 -- function New_Node (Next : Node_Access) return Node_Access;
251 -- pragma Inline (New_Node);
253 -- function New_Node (Next : Node_Access) return Node_Access is
255 -- Node.Next := Next;
259 -- procedure Insert is
260 -- new Element_Keys.Generic_Conditional_Insert (New_Node);
262 -- Result : Node_Access;
263 -- Success : Boolean;
267 -- Key => Node.Element,
269 -- Success => Success);
271 -- if not Success then
273 -- raise Program_Error;
276 -- pragma Assert (Result = Node);
279 -- end Replace_Element;
282 -- procedure Replace_Element (Container : in out Set;
283 -- Position : in Cursor;
284 -- By : in Element_Type) is
287 -- if Position.Container = null then
288 -- raise Constraint_Error;
291 -- if Position.Container /= Set_Access'(Container
'Unchecked_Access) then
292 -- raise Program_Error;
295 -- Replace_Element (Container, Position.Node, By);
297 -- end Replace_Element;
300 procedure Move
(Target
: in out Set
;
301 Source
: in out Set
) renames HT_Ops
.Move
;
304 procedure Insert
(Container
: in out Set
;
305 New_Item
: in Element_Type
;
306 Position
: out Cursor
;
307 Inserted
: out Boolean) is
309 function New_Node
(Next
: Node_Access
) return Node_Access
;
310 pragma Inline
(New_Node
);
312 function New_Node
(Next
: Node_Access
) return Node_Access
is
313 Node
: constant Node_Access
:= new Node_Type
'(New_Item, Next);
319 new Element_Keys.Generic_Conditional_Insert (New_Node);
323 HT_Ops.Ensure_Capacity (Container, Container.Length + 1);
324 Insert (Container, New_Item, Position.Node, Inserted);
325 Position.Container := Container'Unchecked_Access;
330 procedure Insert (Container : in out Set;
331 New_Item : in Element_Type) is
338 Insert (Container, New_Item, Position, Inserted);
341 raise Constraint_Error;
347 procedure Replace (Container : in out Set;
348 New_Item : in Element_Type) is
350 X : Node_Access := Element_Keys.Find (Container, New_Item);
355 raise Constraint_Error;
358 X.Element := New_Item;
363 procedure Include (Container : in out Set;
364 New_Item : in Element_Type) is
371 Insert (Container, New_Item, Position, Inserted);
374 Position.Node.Element := New_Item;
380 procedure Delete (Container : in out Set;
381 Item : in Element_Type) is
387 Element_Keys.Delete_Key_Sans_Free (Container, Item, X);
390 raise Constraint_Error;
398 procedure Exclude (Container : in out Set;
399 Item : in Element_Type) is
405 Element_Keys.Delete_Key_Sans_Free (Container, Item, X);
411 procedure Delete (Container : in out Set;
412 Position : in out Cursor) is
415 if Position = No_Element then
419 if Position.Container /= Set_Access'(Container
'Unchecked_Access) then
423 HT_Ops
.Delete_Node_Sans_Free
(Container
, Position
.Node
);
424 Free
(Position
.Node
);
426 Position
.Container
:= null;
432 procedure Union
(Target
: in out Set
;
435 procedure Process
(Src_Node
: in Node_Access
);
437 procedure Process
(Src_Node
: in Node_Access
) is
439 function New_Node
(Next
: Node_Access
) return Node_Access
;
440 pragma Inline
(New_Node
);
442 function New_Node
(Next
: Node_Access
) return Node_Access
is
443 Node
: constant Node_Access
:=
444 new Node_Type
'(Src_Node.Element, Next);
450 new Element_Keys.Generic_Conditional_Insert (New_Node);
452 Tgt_Node : Node_Access;
457 Insert (Target, Src_Node.Element, Tgt_Node, Success);
462 new HT_Ops.Generic_Iteration (Process);
466 if Target'Address = Source'Address then
470 HT_Ops.Ensure_Capacity (Target, Target.Length + Source.Length);
478 function Union (Left, Right : Set) return Set is
480 Buckets : HT_Types.Buckets_Access;
485 if Left'Address = Right'Address then
489 if Right.Length = 0 then
493 if Left.Length = 0 then
498 Size : constant Hash_Type :=
499 Prime_Numbers.To_Prime (Left.Length + Right.Length);
501 Buckets := new Buckets_Type (0 .. Size - 1);
505 procedure Process (L_Node : Node_Access);
507 procedure Process (L_Node : Node_Access) is
508 I : constant Hash_Type :=
509 Hash (L_Node.Element) mod Buckets'Length;
511 Buckets (I) := new Node_Type'(L_Node
.Element
, Buckets
(I
));
515 new HT_Ops
.Generic_Iteration
(Process
);
520 HT_Ops
.Free_Hash_Table
(Buckets
);
524 Length
:= Left
.Length
;
527 procedure Process
(Src_Node
: Node_Access
);
529 procedure Process
(Src_Node
: Node_Access
) is
531 I
: constant Hash_Type
:=
532 Hash
(Src_Node
.Element
) mod Buckets
'Length;
534 Tgt_Node
: Node_Access
:= Buckets
(I
);
538 while Tgt_Node
/= null loop
540 if Equivalent_Keys
(Src_Node
.Element
, Tgt_Node
.Element
) then
544 Tgt_Node
:= Next
(Tgt_Node
);
548 Buckets
(I
) := new Node_Type
'(Src_Node.Element, Buckets (I));
549 Length := Length + 1;
554 new HT_Ops.Generic_Iteration (Process);
559 HT_Ops.Free_Hash_Table (Buckets);
563 return (Controlled with Buckets, Length);
570 Key : Node_Access) return Boolean;
571 pragma Inline (Is_In);
575 Key : Node_Access) return Boolean is
577 return Element_Keys.Find (HT, Key.Element) /= null;
581 procedure Intersection (Target : in out Set;
584 Tgt_Node : Node_Access;
588 if Target'Address = Source'Address then
592 if Source.Length = 0 then
597 -- TODO: optimize this to use an explicit
598 -- loop instead of an active iterator
599 -- (similar to how a passive iterator is
602 -- Another possibility is to test which
603 -- set is smaller, and iterate over the
606 Tgt_Node := HT_Ops.First (Target);
608 while Tgt_Node /= null loop
610 if Is_In (Source, Tgt_Node) then
612 Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
617 X : Node_Access := Tgt_Node;
619 Tgt_Node := HT_Ops.Next (Target, Tgt_Node);
620 HT_Ops.Delete_Node_Sans_Free (Target, X);
631 function Intersection (Left, Right : Set) return Set is
633 Buckets : HT_Types.Buckets_Access;
638 if Left'Address = Right'Address then
642 Length := Count_Type'Min (Left.Length, Right.Length);
649 Size : constant Hash_Type := Prime_Numbers.To_Prime (Length);
651 Buckets := new Buckets_Type (0 .. Size - 1);
657 procedure Process (L_Node : Node_Access);
659 procedure Process (L_Node : Node_Access) is
661 if Is_In (Right, L_Node) then
664 I : constant Hash_Type :=
665 Hash (L_Node.Element) mod Buckets'Length;
667 Buckets (I) := new Node_Type'(L_Node
.Element
, Buckets
(I
));
670 Length
:= Length
+ 1;
676 new HT_Ops
.Generic_Iteration
(Process
);
681 HT_Ops
.Free_Hash_Table
(Buckets
);
685 return (Controlled
with Buckets
, Length
);
690 procedure Difference
(Target
: in out Set
;
694 Tgt_Node
: Node_Access
;
698 if Target
'Address = Source
'Address then
703 if Source
.Length
= 0 then
707 -- TODO: As I noted above, this can be
708 -- written in terms of a loop instead as
709 -- active-iterator style, sort of like a
712 Tgt_Node
:= HT_Ops
.First
(Target
);
714 while Tgt_Node
/= null loop
716 if Is_In
(Source
, Tgt_Node
) then
719 X
: Node_Access
:= Tgt_Node
;
721 Tgt_Node
:= HT_Ops
.Next
(Target
, Tgt_Node
);
722 HT_Ops
.Delete_Node_Sans_Free
(Target
, X
);
728 Tgt_Node
:= HT_Ops
.Next
(Target
, Tgt_Node
);
738 function Difference
(Left
, Right
: Set
) return Set
is
740 Buckets
: HT_Types
.Buckets_Access
;
745 if Left
'Address = Right
'Address then
749 if Left
.Length
= 0 then
753 if Right
.Length
= 0 then
758 Size
: constant Hash_Type
:= Prime_Numbers
.To_Prime
(Left
.Length
);
760 Buckets
:= new Buckets_Type
(0 .. Size
- 1);
766 procedure Process
(L_Node
: Node_Access
);
768 procedure Process
(L_Node
: Node_Access
) is
770 if not Is_In
(Right
, L_Node
) then
773 I
: constant Hash_Type
:=
774 Hash
(L_Node
.Element
) mod Buckets
'Length;
776 Buckets
(I
) := new Node_Type
'(L_Node.Element, Buckets (I));
779 Length := Length + 1;
785 new HT_Ops.Generic_Iteration (Process);
790 HT_Ops.Free_Hash_Table (Buckets);
794 return (Controlled with Buckets, Length);
800 procedure Symmetric_Difference (Target : in out Set;
804 if Target'Address = Source'Address then
809 HT_Ops.Ensure_Capacity (Target, Target.Length + Source.Length);
811 if Target.Length = 0 then
814 procedure Process (Src_Node : Node_Access);
816 procedure Process (Src_Node : Node_Access) is
817 E : Element_Type renames Src_Node.Element;
818 B : Buckets_Type renames Target.Buckets.all;
819 I : constant Hash_Type := Hash (E) mod B'Length;
820 N : Count_Type renames Target.Length;
822 B (I) := new Node_Type'(E
, B
(I
));
827 new HT_Ops
.Generic_Iteration
(Process
);
835 procedure Process
(Src_Node
: Node_Access
);
837 procedure Process
(Src_Node
: Node_Access
) is
838 E
: Element_Type
renames Src_Node
.Element
;
839 B
: Buckets_Type
renames Target
.Buckets
.all;
840 I
: constant Hash_Type
:= Hash
(E
) mod B
'Length;
841 N
: Count_Type
renames Target
.Length
;
845 B
(I
) := new Node_Type
'(E, null);
848 elsif Equivalent_Keys (E, B (I).Element) then
851 X : Node_Access := B (I);
861 Prev : Node_Access := B (I);
862 Curr : Node_Access := Prev.Next;
864 while Curr /= null loop
865 if Equivalent_Keys (E, Curr.Element) then
866 Prev.Next := Curr.Next;
876 B (I) := new Node_Type'(E
, B
(I
));
884 new HT_Ops
.Generic_Iteration
(Process
);
891 end Symmetric_Difference
;
894 function Symmetric_Difference
(Left
, Right
: Set
) return Set
is
896 Buckets
: HT_Types
.Buckets_Access
;
901 if Left
'Address = Right
'Address then
905 if Right
.Length
= 0 then
909 if Left
.Length
= 0 then
914 Size
: constant Hash_Type
:=
915 Prime_Numbers
.To_Prime
(Left
.Length
+ Right
.Length
);
917 Buckets
:= new Buckets_Type
(0 .. Size
- 1);
923 procedure Process
(L_Node
: Node_Access
);
925 procedure Process
(L_Node
: Node_Access
) is
927 if not Is_In
(Right
, L_Node
) then
929 E
: Element_Type
renames L_Node
.Element
;
930 I
: constant Hash_Type
:= Hash
(E
) mod Buckets
'Length;
932 Buckets
(I
) := new Node_Type
'(E, Buckets (I));
933 Length := Length + 1;
939 new HT_Ops.Generic_Iteration (Process);
944 HT_Ops.Free_Hash_Table (Buckets);
949 procedure Process (R_Node : Node_Access);
951 procedure Process (R_Node : Node_Access) is
953 if not Is_In (Left, R_Node) then
955 E : Element_Type renames R_Node.Element;
956 I : constant Hash_Type := Hash (E) mod Buckets'Length;
958 Buckets (I) := new Node_Type'(E
, Buckets
(I
));
959 Length
:= Length
+ 1;
965 new HT_Ops
.Generic_Iteration
(Process
);
970 HT_Ops
.Free_Hash_Table
(Buckets
);
974 return (Controlled
with Buckets
, Length
);
976 end Symmetric_Difference
;
979 function Is_Subset
(Subset
: Set
;
980 Of_Set
: Set
) return Boolean is
982 Subset_Node
: Node_Access
;
986 if Subset
'Address = Of_Set
'Address then
990 if Subset
.Length
> Of_Set
.Length
then
994 -- TODO: rewrite this to loop in the
995 -- style of a passive iterator.
997 Subset_Node
:= HT_Ops
.First
(Subset
);
999 while Subset_Node
/= null loop
1000 if not Is_In
(Of_Set
, Subset_Node
) then
1004 Subset_Node
:= HT_Ops
.Next
(Subset
, Subset_Node
);
1012 function Overlap
(Left
, Right
: Set
) return Boolean is
1014 Left_Node
: Node_Access
;
1018 if Right
.Length
= 0 then
1022 if Left
'Address = Right
'Address then
1026 Left_Node
:= HT_Ops
.First
(Left
);
1028 while Left_Node
/= null loop
1029 if Is_In
(Right
, Left_Node
) then
1033 Left_Node
:= HT_Ops
.Next
(Left
, Left_Node
);
1041 function Find
(Container
: Set
;
1042 Item
: Element_Type
) return Cursor
is
1044 Node
: constant Node_Access
:= Element_Keys
.Find
(Container
, Item
);
1052 return Cursor
'(Container'Unchecked_Access, Node);
1057 function Contains (Container : Set;
1058 Item : Element_Type) return Boolean is
1060 return Find (Container, Item) /= No_Element;
1065 function First (Container : Set) return Cursor is
1066 Node : constant Node_Access := HT_Ops.First (Container);
1072 return Cursor'(Container
'Unchecked_Access, Node
);
1076 -- function First_Element (Container : Set) return Element_Type is
1077 -- Node : constant Node_Access := HT_Ops.First (Container);
1079 -- return Node.Element;
1080 -- end First_Element;
1083 function Next
(Position
: Cursor
) return Cursor
is
1085 if Position
.Container
= null
1086 or else Position
.Node
= null
1092 S
: Set
renames Position
.Container
.all;
1093 Node
: constant Node_Access
:= HT_Ops
.Next
(S
, Position
.Node
);
1099 return Cursor
'(Position.Container, Node);
1104 procedure Next (Position : in out Cursor) is
1106 Position := Next (Position);
1110 function Has_Element (Position : Cursor) return Boolean is
1112 if Position.Container = null then
1116 if Position.Node = null then
1124 function Equivalent_Keys (Left, Right : Cursor)
1127 return Equivalent_Keys (Left.Node.Element, Right.Node.Element);
1128 end Equivalent_Keys;
1131 function Equivalent_Keys (Left : Cursor;
1132 Right : Element_Type)
1135 return Equivalent_Keys (Left.Node.Element, Right);
1136 end Equivalent_Keys;
1139 function Equivalent_Keys (Left : Element_Type;
1143 return Equivalent_Keys (Left, Right.Node.Element);
1144 end Equivalent_Keys;
1148 (Container : in Set;
1149 Process : not null access procedure (Position : in Cursor)) is
1151 procedure Process_Node (Node : in Node_Access);
1152 pragma Inline (Process_Node);
1154 procedure Process_Node (Node : in Node_Access) is
1156 Process (Cursor'(Container
'Unchecked_Access, Node
));
1159 procedure Iterate
is
1160 new HT_Ops
.Generic_Iteration
(Process_Node
);
1162 Iterate
(Container
);
1166 function Capacity
(Container
: Set
) return Count_Type
1167 renames HT_Ops
.Capacity
;
1169 procedure Reserve_Capacity
1170 (Container
: in out Set
;
1171 Capacity
: in Count_Type
)
1172 renames HT_Ops
.Ensure_Capacity
;
1175 procedure Write_Node
1176 (Stream
: access Root_Stream_Type
'Class;
1177 Node
: in Node_Access
);
1178 pragma Inline
(Write_Node
);
1180 procedure Write_Node
1181 (Stream
: access Root_Stream_Type
'Class;
1182 Node
: in Node_Access
) is
1184 Element_Type
'Write (Stream
, Node
.Element
);
1187 procedure Write_Nodes
is
1188 new HT_Ops
.Generic_Write
(Write_Node
);
1191 (Stream
: access Root_Stream_Type
'Class;
1192 Container
: in Set
) renames Write_Nodes
;
1195 function Read_Node
(Stream
: access Root_Stream_Type
'Class)
1197 pragma Inline
(Read_Node
);
1199 function Read_Node
(Stream
: access Root_Stream_Type
'Class)
1200 return Node_Access
is
1202 Node
: Node_Access
:= new Node_Type
;
1204 Element_Type
'Read (Stream
, Node
.Element
);
1212 procedure Read_Nodes
is
1213 new HT_Ops
.Generic_Read
(Read_Node
);
1216 (Stream
: access Root_Stream_Type
'Class;
1217 Container
: out Set
) renames Read_Nodes
;
1220 package body Generic_Keys
is
1222 function Equivalent_Keys
(Left
: Cursor
;
1226 return Equivalent_Keys
(Right
, Left
.Node
.Element
);
1227 end Equivalent_Keys
;
1229 function Equivalent_Keys
(Left
: Key_Type
;
1233 return Equivalent_Keys
(Left
, Right
.Node
.Element
);
1234 end Equivalent_Keys
;
1236 function Equivalent_Keys
1238 Node
: Node_Access
) return Boolean;
1239 pragma Inline
(Equivalent_Keys
);
1241 function Equivalent_Keys
1243 Node
: Node_Access
) return Boolean is
1245 return Equivalent_Keys
(Key
, Node
.Element
);
1246 end Equivalent_Keys
;
1249 new Hash_Tables
.Generic_Keys
1250 (HT_Types
=> HT_Types
,
1254 Set_Next
=> Set_Next
,
1255 Key_Type
=> Key_Type
,
1257 Equivalent_Keys
=> Equivalent_Keys
);
1260 function Find
(Container
: Set
;
1264 Node
: constant Node_Access
:=
1265 Key_Keys
.Find
(Container
, Key
);
1273 return Cursor
'(Container'Unchecked_Access, Node);
1278 function Contains (Container : Set;
1279 Key : Key_Type) return Boolean is
1281 return Find (Container, Key) /= No_Element;
1285 function Element (Container : Set;
1287 return Element_Type is
1289 Node : constant Node_Access := Key_Keys.Find (Container, Key);
1291 return Node.Element;
1295 function Key (Position : Cursor) return Key_Type is
1297 return Key (Position.Node.Element);
1302 -- procedure Replace (Container : in out Set;
1303 -- Key : in Key_Type;
1304 -- New_Item : in Element_Type) is
1306 -- Node : constant Node_Access :=
1307 -- Key_Keys.Find (Container, Key);
1311 -- if Node = null then
1312 -- raise Constraint_Error;
1315 -- Replace_Element (Container, Node, New_Item);
1320 procedure Delete (Container : in out Set;
1321 Key : in Key_Type) is
1327 Key_Keys.Delete_Key_Sans_Free (Container, Key, X);
1330 raise Constraint_Error;
1338 procedure Exclude (Container : in out Set;
1339 Key : in Key_Type) is
1345 Key_Keys.Delete_Key_Sans_Free (Container, Key, X);
1351 procedure Checked_Update_Element
1352 (Container : in out Set;
1353 Position : in Cursor;
1354 Process : not null access
1355 procedure (Element : in out Element_Type)) is
1359 if Position.Container = null then
1360 raise Constraint_Error;
1363 if Position.Container /= Set_Access'(Container
'Unchecked_Access) then
1364 raise Program_Error
;
1368 Old_Key
: Key_Type
renames Key
(Position
.Node
.Element
);
1370 Process
(Position
.Node
.Element
);
1372 if Equivalent_Keys
(Old_Key
, Position
.Node
.Element
) then
1378 function New_Node
(Next
: Node_Access
) return Node_Access
;
1379 pragma Inline
(New_Node
);
1381 function New_Node
(Next
: Node_Access
) return Node_Access
is
1383 Position
.Node
.Next
:= Next
;
1384 return Position
.Node
;
1388 new Key_Keys
.Generic_Conditional_Insert
(New_Node
);
1390 Result
: Node_Access
;
1393 HT_Ops
.Delete_Node_Sans_Free
(Container
, Position
.Node
);
1397 Key
=> Key
(Position
.Node
.Element
),
1399 Success
=> Success
);
1403 X
: Node_Access
:= Position
.Node
;
1408 raise Program_Error
;
1411 pragma Assert
(Result
= Position
.Node
);
1414 end Checked_Update_Element
;
1418 end Ada
.Containers
.Hashed_Sets
;