1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.INDEFINITE_HASHED_SETS --
9 -- Copyright (C) 2004-2014, 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 with Ada
.Unchecked_Deallocation
;
32 with Ada
.Containers
.Hash_Tables
.Generic_Operations
;
33 pragma Elaborate_All
(Ada
.Containers
.Hash_Tables
.Generic_Operations
);
35 with Ada
.Containers
.Hash_Tables
.Generic_Keys
;
36 pragma Elaborate_All
(Ada
.Containers
.Hash_Tables
.Generic_Keys
);
38 with Ada
.Containers
.Prime_Numbers
;
40 with System
; use type System
.Address
;
42 package body Ada
.Containers
.Indefinite_Hashed_Sets
is
44 -----------------------
45 -- Local Subprograms --
46 -----------------------
48 procedure Assign
(Node
: Node_Access
; Item
: Element_Type
);
49 pragma Inline
(Assign
);
51 function Copy_Node
(Source
: Node_Access
) return Node_Access
;
52 pragma Inline
(Copy_Node
);
54 function Equivalent_Keys
56 Node
: Node_Access
) return Boolean;
57 pragma Inline
(Equivalent_Keys
);
59 function Find_Equal_Key
60 (R_HT
: Hash_Table_Type
;
61 L_Node
: Node_Access
) return Boolean;
63 function Find_Equivalent_Key
64 (R_HT
: Hash_Table_Type
;
65 L_Node
: Node_Access
) return Boolean;
67 procedure Free
(X
: in out Node_Access
);
69 function Hash_Node
(Node
: Node_Access
) return Hash_Type
;
70 pragma Inline
(Hash_Node
);
73 (HT
: in out Hash_Table_Type
;
74 New_Item
: Element_Type
;
75 Node
: out Node_Access
;
76 Inserted
: out Boolean);
79 (HT
: aliased in out Hash_Table_Type
;
80 Key
: Node_Access
) return Boolean;
81 pragma Inline
(Is_In
);
83 function Next
(Node
: Node_Access
) return Node_Access
;
86 function Read_Node
(Stream
: not null access Root_Stream_Type
'Class)
88 pragma Inline
(Read_Node
);
90 procedure Set_Next
(Node
: Node_Access
; Next
: Node_Access
);
91 pragma Inline
(Set_Next
);
93 function Vet
(Position
: Cursor
) return Boolean;
96 (Stream
: not null access Root_Stream_Type
'Class;
98 pragma Inline
(Write_Node
);
100 --------------------------
101 -- Local Instantiations --
102 --------------------------
104 procedure Free_Element
is
105 new Ada
.Unchecked_Deallocation
(Element_Type
, Element_Access
);
107 package HT_Ops
is new Hash_Tables
.Generic_Operations
108 (HT_Types
=> HT_Types
,
109 Hash_Node
=> Hash_Node
,
111 Set_Next
=> Set_Next
,
112 Copy_Node
=> Copy_Node
,
115 package Element_Keys
is new Hash_Tables
.Generic_Keys
116 (HT_Types
=> HT_Types
,
118 Set_Next
=> Set_Next
,
119 Key_Type
=> Element_Type
,
121 Equivalent_Keys
=> Equivalent_Keys
);
124 new HT_Ops
.Generic_Equal
(Find_Equal_Key
);
126 function Is_Equivalent
is
127 new HT_Ops
.Generic_Equal
(Find_Equivalent_Key
);
129 procedure Read_Nodes
is
130 new HT_Ops
.Generic_Read
(Read_Node
);
132 procedure Replace_Element
is
133 new Element_Keys
.Generic_Replace_Element
(Hash_Node
, Assign
);
135 procedure Write_Nodes
is
136 new HT_Ops
.Generic_Write
(Write_Node
);
142 function "=" (Left
, Right
: Set
) return Boolean is
144 return Is_Equal
(Left
.HT
, Right
.HT
);
151 procedure Adjust
(Container
: in out Set
) is
153 HT_Ops
.Adjust
(Container
.HT
);
156 procedure Adjust
(Control
: in out Reference_Control_Type
) is
158 if Control
.Container
/= null then
160 HT
: Hash_Table_Type
renames Control
.Container
.all.HT
;
161 B
: Natural renames HT
.Busy
;
162 L
: Natural renames HT
.Lock
;
174 procedure Assign
(Node
: Node_Access
; Item
: Element_Type
) is
175 X
: Element_Access
:= Node
.Element
;
177 -- The element allocator may need an accessibility check in the case the
178 -- actual type is class-wide or has access discriminants (RM 4.8(10.1)
181 pragma Unsuppress
(Accessibility_Check
);
184 Node
.Element
:= new Element_Type
'(Item);
188 procedure Assign (Target : in out Set; Source : Set) is
190 if Target'Address = Source'Address then
194 Target.Union (Source);
202 function Capacity (Container : Set) return Count_Type is
204 return HT_Ops.Capacity (Container.HT);
211 procedure Clear (Container : in out Set) is
213 HT_Ops.Clear (Container.HT);
216 ------------------------
217 -- Constant_Reference --
218 ------------------------
220 function Constant_Reference
221 (Container : aliased Set;
222 Position : Cursor) return Constant_Reference_Type
225 if Position.Container = null then
226 raise Constraint_Error with "Position cursor has no element";
229 if Position.Container /= Container'Unrestricted_Access then
230 raise Program_Error with
231 "Position cursor designates wrong container";
234 if Position.Node.Element = null then
235 raise Program_Error with "Node has no element";
238 pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
241 HT : Hash_Table_Type renames Position.Container.all.HT;
242 B : Natural renames HT.Busy;
243 L : Natural renames HT.Lock;
245 return R : constant Constant_Reference_Type :=
246 (Element => Position.Node.Element.all'Access,
247 Control => (Controlled with Container'Unrestricted_Access))
253 end Constant_Reference;
259 function Contains (Container : Set; Item : Element_Type) return Boolean is
261 return Find (Container, Item) /= No_Element;
270 Capacity : Count_Type := 0) return Set
278 elsif Capacity >= Source.Length then
283 with "Requested capacity is less than Source length";
286 return Target : Set do
287 Target.Reserve_Capacity (C);
288 Target.Assign (Source);
296 function Copy_Node (Source : Node_Access) return Node_Access is
297 E : Element_Access := new Element_Type'(Source
.Element
.all);
299 return new Node_Type
'(Element => E, Next => null);
311 (Container : in out Set;
317 Element_Keys.Delete_Key_Sans_Free (Container.HT, Item, X);
320 raise Constraint_Error with "attempt to delete element not in set";
327 (Container : in out Set;
328 Position : in out Cursor)
331 if Position.Node = null then
332 raise Constraint_Error with "Position cursor equals No_Element";
335 if Position.Node.Element = null then
336 raise Program_Error with "Position cursor is bad";
339 if Position.Container /= Container'Unrestricted_Access then
340 raise Program_Error with "Position cursor designates wrong set";
343 if Container.HT.Busy > 0 then
344 raise Program_Error with
345 "attempt to tamper with cursors (set is busy)";
348 pragma Assert (Vet (Position), "Position cursor is bad");
350 HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
352 Free (Position.Node);
353 Position.Container := null;
361 (Target : in out Set;
364 Src_HT : Hash_Table_Type renames Source'Unrestricted_Access.HT;
365 Tgt_Node : Node_Access;
368 if Target'Address = Source'Address then
373 if Src_HT.Length = 0 then
377 if Target.HT.Busy > 0 then
378 raise Program_Error with
379 "attempt to tamper with cursors (set is busy)";
382 if Src_HT.Length < Target.HT.Length then
384 Src_Node : Node_Access;
387 Src_Node := HT_Ops.First (Src_HT);
388 while Src_Node /= null loop
389 Tgt_Node := Element_Keys.Find (Target.HT, Src_Node.Element.all);
391 if Tgt_Node /= null then
392 HT_Ops.Delete_Node_Sans_Free (Target.HT, Tgt_Node);
396 Src_Node := HT_Ops.Next (Src_HT, Src_Node);
401 Tgt_Node := HT_Ops.First (Target.HT);
402 while Tgt_Node /= null loop
403 if Is_In (Src_HT, Tgt_Node) then
405 X : Node_Access := Tgt_Node;
407 Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
408 HT_Ops.Delete_Node_Sans_Free (Target.HT, X);
413 Tgt_Node := HT_Ops.Next (Target.HT, Tgt_Node);
419 function Difference (Left, Right : Set) return Set is
420 Left_HT : Hash_Table_Type renames Left'Unrestricted_Access.HT;
421 Right_HT : Hash_Table_Type renames Right'Unrestricted_Access.HT;
422 Buckets : HT_Types.Buckets_Access;
426 if Left'Address = Right'Address then
430 if Left.Length = 0 then
434 if Right.Length = 0 then
439 Size : constant Hash_Type := Prime_Numbers.To_Prime (Left.Length);
441 Buckets := HT_Ops.New_Buckets (Length => Size);
446 Iterate_Left : declare
447 procedure Process (L_Node : Node_Access);
450 new HT_Ops.Generic_Iteration (Process);
456 procedure Process (L_Node : Node_Access) is
458 if not Is_In (Right_HT, L_Node) then
460 -- Per AI05-0022, the container implementation is required
461 -- to detect element tampering by a generic actual
462 -- subprogram, hence the use of Checked_Index instead of a
463 -- simple invocation of generic formal Hash.
465 Indx : constant Hash_Type :=
466 HT_Ops.Checked_Index (Left_HT, Buckets.all, L_Node);
468 Bucket : Node_Access renames Buckets (Indx);
469 Src : Element_Type renames L_Node.Element.all;
470 Tgt : Element_Access := new Element_Type'(Src
);
473 Bucket
:= new Node_Type
'(Tgt, Bucket);
481 Length := Length + 1;
485 -- Start of processing for Iterate_Left
492 HT_Ops.Free_Hash_Table (Buckets);
496 return (Controlled with HT => (Buckets, Length, 0, 0));
503 function Element (Position : Cursor) return Element_Type is
505 if Position.Node = null then
506 raise Constraint_Error with "Position cursor of equals No_Element";
509 if Position.Node.Element = null then -- handle dangling reference
510 raise Program_Error with "Position cursor is bad";
513 pragma Assert (Vet (Position), "bad cursor in function Element");
515 return Position.Node.Element.all;
518 ---------------------
519 -- Equivalent_Sets --
520 ---------------------
522 function Equivalent_Sets (Left, Right : Set) return Boolean is
524 return Is_Equivalent (Left.HT, Right.HT);
527 -------------------------
528 -- Equivalent_Elements --
529 -------------------------
531 function Equivalent_Elements (Left, Right : Cursor) return Boolean is
533 if Left.Node = null then
534 raise Constraint_Error with
535 "Left cursor of Equivalent_Elements equals No_Element";
538 if Right.Node = null then
539 raise Constraint_Error with
540 "Right cursor of Equivalent_Elements equals No_Element";
543 if Left.Node.Element = null then
544 raise Program_Error with
545 "Left cursor of Equivalent_Elements is bad";
548 if Right.Node.Element = null then
549 raise Program_Error with
550 "Right cursor of Equivalent_Elements is bad";
553 pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Elements");
554 pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Elements");
556 -- AI05-0022 requires that a container implementation detect element
557 -- tampering by a generic actual subprogram. However, the following case
558 -- falls outside the scope of that AI. Randy Brukardt explained on the
559 -- ARG list on 2013/02/07 that:
562 -- But for an operation like "<" [the ordered set analog of
563 -- Equivalent_Elements], there is no need to "dereference" a cursor
564 -- after the call to the generic formal parameter function, so nothing
565 -- bad could happen if tampering is undetected. And the operation can
566 -- safely return a result without a problem even if an element is
567 -- deleted from the container.
570 return Equivalent_Elements
571 (Left.Node.Element.all,
572 Right.Node.Element.all);
573 end Equivalent_Elements;
575 function Equivalent_Elements
577 Right : Element_Type) return Boolean
580 if Left.Node = null then
581 raise Constraint_Error with
582 "Left cursor of Equivalent_Elements equals No_Element";
585 if Left.Node.Element = null then
586 raise Program_Error with
587 "Left cursor of Equivalent_Elements is bad";
590 pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Elements");
592 return Equivalent_Elements (Left.Node.Element.all, Right);
593 end Equivalent_Elements;
595 function Equivalent_Elements
596 (Left : Element_Type;
597 Right : Cursor) return Boolean
600 if Right.Node = null then
601 raise Constraint_Error with
602 "Right cursor of Equivalent_Elements equals No_Element";
605 if Right.Node.Element = null then
606 raise Program_Error with
607 "Right cursor of Equivalent_Elements is bad";
610 pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Elements");
612 return Equivalent_Elements (Left, Right.Node.Element.all);
613 end Equivalent_Elements;
615 ---------------------
616 -- Equivalent_Keys --
617 ---------------------
619 function Equivalent_Keys
621 Node : Node_Access) return Boolean
624 return Equivalent_Elements (Key, Node.Element.all);
632 (Container : in out Set;
637 Element_Keys.Delete_Key_Sans_Free (Container.HT, Item, X);
645 procedure Finalize (Container : in out Set) is
647 HT_Ops.Finalize (Container.HT);
650 procedure Finalize (Object : in out Iterator) is
652 if Object.Container /= null then
654 B : Natural renames Object.Container.all.HT.Busy;
661 procedure Finalize (Control : in out Reference_Control_Type) is
663 if Control.Container /= null then
665 HT : Hash_Table_Type renames Control.Container.all.HT;
666 B : Natural renames HT.Busy;
667 L : Natural renames HT.Lock;
673 Control.Container := null;
683 Item : Element_Type) return Cursor
685 HT : Hash_Table_Type renames Container'Unrestricted_Access.HT;
686 Node : constant Node_Access := Element_Keys.Find (HT, Item);
688 return (if Node = null then No_Element
689 else Cursor'(Container
'Unrestricted_Access, Node
));
696 function Find_Equal_Key
697 (R_HT
: Hash_Table_Type
;
698 L_Node
: Node_Access
) return Boolean
700 R_Index
: constant Hash_Type
:=
701 Element_Keys
.Index
(R_HT
, L_Node
.Element
.all);
703 R_Node
: Node_Access
:= R_HT
.Buckets
(R_Index
);
707 if R_Node
= null then
711 if L_Node
.Element
.all = R_Node
.Element
.all then
715 R_Node
:= Next
(R_Node
);
719 -------------------------
720 -- Find_Equivalent_Key --
721 -------------------------
723 function Find_Equivalent_Key
724 (R_HT
: Hash_Table_Type
;
725 L_Node
: Node_Access
) return Boolean
727 R_Index
: constant Hash_Type
:=
728 Element_Keys
.Index
(R_HT
, L_Node
.Element
.all);
730 R_Node
: Node_Access
:= R_HT
.Buckets
(R_Index
);
734 if R_Node
= null then
738 if Equivalent_Elements
(L_Node
.Element
.all, R_Node
.Element
.all) then
742 R_Node
:= Next
(R_Node
);
744 end Find_Equivalent_Key
;
750 function First
(Container
: Set
) return Cursor
is
751 Node
: constant Node_Access
:= HT_Ops
.First
(Container
.HT
);
753 return (if Node
= null then No_Element
754 else Cursor
'(Container'Unrestricted_Access, Node));
757 function First (Object : Iterator) return Cursor is
759 return Object.Container.First;
766 procedure Free (X : in out Node_Access) is
767 procedure Deallocate is
768 new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
775 X.Next := X; -- detect mischief (in Vet)
778 Free_Element (X.Element);
794 function Has_Element (Position : Cursor) return Boolean is
796 pragma Assert (Vet (Position), "bad cursor in Has_Element");
797 return Position.Node /= null;
804 function Hash_Node (Node : Node_Access) return Hash_Type is
806 return Hash (Node.Element.all);
814 (Container : in out Set;
815 New_Item : Element_Type)
823 Insert (Container, New_Item, Position, Inserted);
826 if Container.HT.Lock > 0 then
827 raise Program_Error with
828 "attempt to tamper with elements (set is locked)";
831 X := Position.Node.Element;
834 -- The element allocator may need an accessibility check in the
835 -- case the actual type is class-wide or has access discriminants
836 -- (see RM 4.8(10.1) and AI12-0035).
838 pragma Unsuppress (Accessibility_Check);
841 Position.Node.Element := new Element_Type'(New_Item
);
853 (Container
: in out Set
;
854 New_Item
: Element_Type
;
855 Position
: out Cursor
;
856 Inserted
: out Boolean)
859 Insert
(Container
.HT
, New_Item
, Position
.Node
, Inserted
);
860 Position
.Container
:= Container
'Unchecked_Access;
864 (Container
: in out Set
;
865 New_Item
: Element_Type
)
868 pragma Unreferenced
(Position
);
873 Insert
(Container
, New_Item
, Position
, Inserted
);
876 raise Constraint_Error
with
877 "attempt to insert element already in set";
882 (HT
: in out Hash_Table_Type
;
883 New_Item
: Element_Type
;
884 Node
: out Node_Access
;
885 Inserted
: out Boolean)
887 function New_Node
(Next
: Node_Access
) return Node_Access
;
888 pragma Inline
(New_Node
);
890 procedure Local_Insert
is
891 new Element_Keys
.Generic_Conditional_Insert
(New_Node
);
897 function New_Node
(Next
: Node_Access
) return Node_Access
is
899 -- The element allocator may need an accessibility check in the case
900 -- the actual type is class-wide or has access discriminants (see
901 -- RM 4.8(10.1) and AI12-0035).
903 pragma Unsuppress
(Accessibility_Check
);
905 Element
: Element_Access
:= new Element_Type
'(New_Item);
908 return new Node_Type'(Element
, Next
);
912 Free_Element
(Element
);
916 -- Start of processing for Insert
919 if HT_Ops
.Capacity
(HT
) = 0 then
920 HT_Ops
.Reserve_Capacity
(HT
, 1);
923 Local_Insert
(HT
, New_Item
, Node
, Inserted
);
925 if Inserted
and then HT
.Length
> HT_Ops
.Capacity
(HT
) then
926 HT_Ops
.Reserve_Capacity
(HT
, HT
.Length
);
934 procedure Intersection
935 (Target
: in out Set
;
938 Src_HT
: Hash_Table_Type
renames Source
'Unrestricted_Access.HT
;
939 Tgt_Node
: Node_Access
;
942 if Target
'Address = Source
'Address then
946 if Source
.Length
= 0 then
951 if Target
.HT
.Busy
> 0 then
952 raise Program_Error
with
953 "attempt to tamper with cursors (set is busy)";
956 Tgt_Node
:= HT_Ops
.First
(Target
.HT
);
957 while Tgt_Node
/= null loop
958 if Is_In
(Src_HT
, Tgt_Node
) then
959 Tgt_Node
:= HT_Ops
.Next
(Target
.HT
, Tgt_Node
);
963 X
: Node_Access
:= Tgt_Node
;
965 Tgt_Node
:= HT_Ops
.Next
(Target
.HT
, Tgt_Node
);
966 HT_Ops
.Delete_Node_Sans_Free
(Target
.HT
, X
);
973 function Intersection
(Left
, Right
: Set
) return Set
is
974 Left_HT
: Hash_Table_Type
renames Left
'Unrestricted_Access.HT
;
975 Right_HT
: Hash_Table_Type
renames Right
'Unrestricted_Access.HT
;
976 Buckets
: HT_Types
.Buckets_Access
;
980 if Left
'Address = Right
'Address then
984 Length
:= Count_Type
'Min (Left
.Length
, Right
.Length
);
991 Size
: constant Hash_Type
:= Prime_Numbers
.To_Prime
(Length
);
993 Buckets
:= HT_Ops
.New_Buckets
(Length
=> Size
);
998 Iterate_Left
: declare
999 procedure Process
(L_Node
: Node_Access
);
1001 procedure Iterate
is
1002 new HT_Ops
.Generic_Iteration
(Process
);
1008 procedure Process
(L_Node
: Node_Access
) is
1010 if Is_In
(Right_HT
, L_Node
) then
1012 -- Per AI05-0022, the container implementation is required
1013 -- to detect element tampering by a generic actual
1014 -- subprogram, hence the use of Checked_Index instead of a
1015 -- simple invocation of generic formal Hash.
1017 Indx
: constant Hash_Type
:=
1018 HT_Ops
.Checked_Index
(Left_HT
, Buckets
.all, L_Node
);
1020 Bucket
: Node_Access
renames Buckets
(Indx
);
1022 Src
: Element_Type
renames L_Node
.Element
.all;
1023 Tgt
: Element_Access
:= new Element_Type
'(Src);
1026 Bucket := new Node_Type'(Tgt
, Bucket
);
1034 Length
:= Length
+ 1;
1038 -- Start of processing for Iterate_Left
1045 HT_Ops
.Free_Hash_Table
(Buckets
);
1049 return (Controlled
with HT
=> (Buckets
, Length
, 0, 0));
1056 function Is_Empty
(Container
: Set
) return Boolean is
1058 return Container
.HT
.Length
= 0;
1066 (HT
: aliased in out Hash_Table_Type
;
1067 Key
: Node_Access
) return Boolean
1070 return Element_Keys
.Find
(HT
, Key
.Element
.all) /= null;
1079 Of_Set
: Set
) return Boolean
1081 Subset_HT
: Hash_Table_Type
renames Subset
'Unrestricted_Access.HT
;
1082 Of_Set_HT
: Hash_Table_Type
renames Of_Set
'Unrestricted_Access.HT
;
1083 Subset_Node
: Node_Access
;
1086 if Subset
'Address = Of_Set
'Address then
1090 if Subset
.Length
> Of_Set
.Length
then
1094 Subset_Node
:= HT_Ops
.First
(Subset_HT
);
1095 while Subset_Node
/= null loop
1096 if not Is_In
(Of_Set_HT
, Subset_Node
) then
1100 Subset_Node
:= HT_Ops
.Next
(Subset_HT
, Subset_Node
);
1112 Process
: not null access procedure (Position
: Cursor
))
1114 procedure Process_Node
(Node
: Node_Access
);
1115 pragma Inline
(Process_Node
);
1117 procedure Iterate
is
1118 new HT_Ops
.Generic_Iteration
(Process_Node
);
1124 procedure Process_Node
(Node
: Node_Access
) is
1126 Process
(Cursor
'(Container'Unrestricted_Access, Node));
1129 B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
1131 -- Start of processing for Iterate
1137 Iterate (Container.HT);
1147 function Iterate (Container : Set)
1148 return Set_Iterator_Interfaces.Forward_Iterator'Class
1150 B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
1152 return It : constant Iterator :=
1153 Iterator'(Limited_Controlled
with
1154 Container
=> Container
'Unrestricted_Access)
1164 function Length
(Container
: Set
) return Count_Type
is
1166 return Container
.HT
.Length
;
1173 procedure Move
(Target
: in out Set
; Source
: in out Set
) is
1175 HT_Ops
.Move
(Target
=> Target
.HT
, Source
=> Source
.HT
);
1182 function Next
(Node
: Node_Access
) return Node_Access
is
1187 function Next
(Position
: Cursor
) return Cursor
is
1189 if Position
.Node
= null then
1193 if Position
.Node
.Element
= null then
1194 raise Program_Error
with "bad cursor in Next";
1197 pragma Assert
(Vet
(Position
), "bad cursor in Next");
1200 HT
: Hash_Table_Type
renames Position
.Container
.HT
;
1201 Node
: constant Node_Access
:= HT_Ops
.Next
(HT
, Position
.Node
);
1203 return (if Node
= null then No_Element
1204 else Cursor
'(Position.Container, Node));
1208 procedure Next (Position : in out Cursor) is
1210 Position := Next (Position);
1215 Position : Cursor) return Cursor
1218 if Position.Container = null then
1222 if Position.Container /= Object.Container then
1223 raise Program_Error with
1224 "Position cursor of Next designates wrong set";
1227 return Next (Position);
1234 function Overlap (Left, Right : Set) return Boolean is
1235 Left_HT : Hash_Table_Type renames Left'Unrestricted_Access.HT;
1236 Right_HT : Hash_Table_Type renames Right'Unrestricted_Access.HT;
1237 Left_Node : Node_Access;
1240 if Right.Length = 0 then
1244 if Left'Address = Right'Address then
1248 Left_Node := HT_Ops.First (Left_HT);
1249 while Left_Node /= null loop
1250 if Is_In (Right_HT, Left_Node) then
1254 Left_Node := HT_Ops.Next (Left_HT, Left_Node);
1264 procedure Query_Element
1266 Process : not null access procedure (Element : Element_Type))
1269 if Position.Node = null then
1270 raise Constraint_Error with
1271 "Position cursor of Query_Element equals No_Element";
1274 if Position.Node.Element = null then
1275 raise Program_Error with "bad cursor in Query_Element";
1278 pragma Assert (Vet (Position), "bad cursor in Query_Element");
1281 HT : Hash_Table_Type renames
1282 Position.Container'Unrestricted_Access.all.HT;
1284 B : Natural renames HT.Busy;
1285 L : Natural renames HT.Lock;
1292 Process (Position.Node.Element.all);
1310 (Stream : not null access Root_Stream_Type'Class;
1311 Container : out Set)
1314 Read_Nodes (Stream, Container.HT);
1318 (Stream : not null access Root_Stream_Type'Class;
1322 raise Program_Error with "attempt to stream set cursor";
1326 (Stream : not null access Root_Stream_Type'Class;
1327 Item : out Constant_Reference_Type)
1330 raise Program_Error with "attempt to stream reference";
1338 (Stream : not null access Root_Stream_Type'Class) return Node_Access
1340 X : Element_Access := new Element_Type'(Element_Type
'Input (Stream
));
1342 return new Node_Type
'(X, null);
1354 (Container : in out Set;
1355 New_Item : Element_Type)
1357 Node : constant Node_Access :=
1358 Element_Keys.Find (Container.HT, New_Item);
1361 pragma Warnings (Off, X);
1365 raise Constraint_Error with
1366 "attempt to replace element not in set";
1369 if Container.HT.Lock > 0 then
1370 raise Program_Error with
1371 "attempt to tamper with elements (set is locked)";
1377 -- The element allocator may need an accessibility check in the case
1378 -- the actual type is class-wide or has access discriminants (see
1379 -- RM 4.8(10.1) and AI12-0035).
1381 pragma Unsuppress (Accessibility_Check);
1384 Node.Element := new Element_Type'(New_Item
);
1390 ---------------------
1391 -- Replace_Element --
1392 ---------------------
1394 procedure Replace_Element
1395 (Container
: in out Set
;
1397 New_Item
: Element_Type
)
1400 if Position
.Node
= null then
1401 raise Constraint_Error
with "Position cursor equals No_Element";
1404 if Position
.Node
.Element
= null then
1405 raise Program_Error
with "bad cursor in Replace_Element";
1408 if Position
.Container
/= Container
'Unrestricted_Access then
1409 raise Program_Error
with
1410 "Position cursor designates wrong set";
1413 pragma Assert
(Vet
(Position
), "bad cursor in Replace_Element");
1415 Replace_Element
(Container
.HT
, Position
.Node
, New_Item
);
1416 end Replace_Element
;
1418 ----------------------
1419 -- Reserve_Capacity --
1420 ----------------------
1422 procedure Reserve_Capacity
1423 (Container
: in out Set
;
1424 Capacity
: Count_Type
)
1427 HT_Ops
.Reserve_Capacity
(Container
.HT
, Capacity
);
1428 end Reserve_Capacity
;
1434 procedure Set_Next
(Node
: Node_Access
; Next
: Node_Access
) is
1439 --------------------------
1440 -- Symmetric_Difference --
1441 --------------------------
1443 procedure Symmetric_Difference
1444 (Target
: in out Set
;
1447 Tgt_HT
: Hash_Table_Type
renames Target
.HT
;
1448 Src_HT
: Hash_Table_Type
renames Source
.HT
'Unrestricted_Access.all;
1450 -- Per AI05-0022, the container implementation is required to detect
1451 -- element tampering by a generic actual subprogram.
1453 TB
: Natural renames Tgt_HT
.Busy
;
1454 TL
: Natural renames Tgt_HT
.Lock
;
1456 SB
: Natural renames Src_HT
.Busy
;
1457 SL
: Natural renames Src_HT
.Lock
;
1460 if Target
'Address = Source
'Address then
1466 raise Program_Error
with
1467 "attempt to tamper with cursors (set is busy)";
1471 N
: constant Count_Type
:= Target
.Length
+ Source
.Length
;
1473 if N
> HT_Ops
.Capacity
(Tgt_HT
) then
1474 HT_Ops
.Reserve_Capacity
(Tgt_HT
, N
);
1478 if Target
.Length
= 0 then
1479 Iterate_Source_When_Empty_Target
: declare
1480 procedure Process
(Src_Node
: Node_Access
);
1482 procedure Iterate
is new HT_Ops
.Generic_Iteration
(Process
);
1488 procedure Process
(Src_Node
: Node_Access
) is
1489 E
: Element_Type
renames Src_Node
.Element
.all;
1490 B
: Buckets_Type
renames Tgt_HT
.Buckets
.all;
1491 J
: constant Hash_Type
:= Hash
(E
) mod B
'Length;
1492 N
: Count_Type
renames Tgt_HT
.Length
;
1496 X
: Element_Access
:= new Element_Type
'(E);
1498 B (J) := new Node_Type'(X
, B
(J
));
1508 -- Start of processing for Iterate_Source_When_Empty_Target
1534 end Iterate_Source_When_Empty_Target
;
1537 Iterate_Source
: declare
1538 procedure Process
(Src_Node
: Node_Access
);
1540 procedure Iterate
is
1541 new HT_Ops
.Generic_Iteration
(Process
);
1547 procedure Process
(Src_Node
: Node_Access
) is
1548 E
: Element_Type
renames Src_Node
.Element
.all;
1549 B
: Buckets_Type
renames Tgt_HT
.Buckets
.all;
1550 J
: constant Hash_Type
:= Hash
(E
) mod B
'Length;
1551 N
: Count_Type
renames Tgt_HT
.Length
;
1554 if B
(J
) = null then
1556 X
: Element_Access
:= new Element_Type
'(E);
1558 B (J) := new Node_Type'(X
, null);
1567 elsif Equivalent_Elements
(E
, B
(J
).Element
.all) then
1569 X
: Node_Access
:= B
(J
);
1571 B
(J
) := B
(J
).Next
;
1578 Prev
: Node_Access
:= B
(J
);
1579 Curr
: Node_Access
:= Prev
.Next
;
1582 while Curr
/= null loop
1583 if Equivalent_Elements
(E
, Curr
.Element
.all) then
1584 Prev
.Next
:= Curr
.Next
;
1595 X
: Element_Access
:= new Element_Type
'(E);
1597 B (J) := new Node_Type'(X
, B
(J
));
1609 -- Start of processing for Iterate_Source
1637 end Symmetric_Difference
;
1639 function Symmetric_Difference
(Left
, Right
: Set
) return Set
is
1640 Left_HT
: Hash_Table_Type
renames Left
'Unrestricted_Access.HT
;
1641 Right_HT
: Hash_Table_Type
renames Right
'Unrestricted_Access.HT
;
1642 Buckets
: HT_Types
.Buckets_Access
;
1643 Length
: Count_Type
;
1646 if Left
'Address = Right
'Address then
1650 if Right
.Length
= 0 then
1654 if Left
.Length
= 0 then
1659 Size
: constant Hash_Type
:=
1660 Prime_Numbers
.To_Prime
(Left
.Length
+ Right
.Length
);
1662 Buckets
:= HT_Ops
.New_Buckets
(Length
=> Size
);
1667 Iterate_Left
: declare
1668 procedure Process
(L_Node
: Node_Access
);
1670 procedure Iterate
is
1671 new HT_Ops
.Generic_Iteration
(Process
);
1677 procedure Process
(L_Node
: Node_Access
) is
1679 if not Is_In
(Right_HT
, L_Node
) then
1681 E
: Element_Type
renames L_Node
.Element
.all;
1683 -- Per AI05-0022, the container implementation is required
1684 -- to detect element tampering by a generic actual
1685 -- subprogram, hence the use of Checked_Index instead of a
1686 -- simple invocation of generic formal Hash.
1688 J
: constant Hash_Type
:=
1689 HT_Ops
.Checked_Index
(Left_HT
, Buckets
.all, L_Node
);
1693 X
: Element_Access
:= new Element_Type
'(E);
1695 Buckets (J) := new Node_Type'(X
, Buckets
(J
));
1702 Length
:= Length
+ 1;
1707 -- Start of processing for Iterate_Left
1713 HT_Ops
.Free_Hash_Table
(Buckets
);
1717 Iterate_Right
: declare
1718 procedure Process
(R_Node
: Node_Access
);
1720 procedure Iterate
is
1721 new HT_Ops
.Generic_Iteration
(Process
);
1727 procedure Process
(R_Node
: Node_Access
) is
1729 if not Is_In
(Left_HT
, R_Node
) then
1731 E
: Element_Type
renames R_Node
.Element
.all;
1733 -- Per AI05-0022, the container implementation is required
1734 -- to detect element tampering by a generic actual
1735 -- subprogram, hence the use of Checked_Index instead of a
1736 -- simple invocation of generic formal Hash.
1738 J
: constant Hash_Type
:=
1739 HT_Ops
.Checked_Index
(Right_HT
, Buckets
.all, R_Node
);
1743 X
: Element_Access
:= new Element_Type
'(E);
1745 Buckets (J) := new Node_Type'(X
, Buckets
(J
));
1752 Length
:= Length
+ 1;
1757 -- Start of processing for Iterate_Right
1764 HT_Ops
.Free_Hash_Table
(Buckets
);
1768 return (Controlled
with HT
=> (Buckets
, Length
, 0, 0));
1769 end Symmetric_Difference
;
1775 function To_Set
(New_Item
: Element_Type
) return Set
is
1776 HT
: Hash_Table_Type
;
1779 pragma Unreferenced
(Node
, Inserted
);
1781 Insert
(HT
, New_Item
, Node
, Inserted
);
1782 return Set
'(Controlled with HT);
1790 (Target : in out Set;
1793 procedure Process (Src_Node : Node_Access);
1795 procedure Iterate is
1796 new HT_Ops.Generic_Iteration (Process);
1802 procedure Process (Src_Node : Node_Access) is
1803 Src : Element_Type renames Src_Node.Element.all;
1805 function New_Node (Next : Node_Access) return Node_Access;
1806 pragma Inline (New_Node);
1809 new Element_Keys.Generic_Conditional_Insert (New_Node);
1815 function New_Node (Next : Node_Access) return Node_Access is
1816 Tgt : Element_Access := new Element_Type'(Src
);
1818 return new Node_Type
'(Tgt, Next);
1825 Tgt_Node : Node_Access;
1827 pragma Unreferenced (Tgt_Node, Success);
1829 -- Start of processing for Process
1832 Insert (Target.HT, Src, Tgt_Node, Success);
1835 -- Start of processing for Union
1838 if Target'Address = Source'Address then
1842 if Target.HT.Busy > 0 then
1843 raise Program_Error with
1844 "attempt to tamper with cursors (set is busy)";
1848 N : constant Count_Type := Target.Length + Source.Length;
1850 if N > HT_Ops.Capacity (Target.HT) then
1851 HT_Ops.Reserve_Capacity (Target.HT, N);
1855 Iterate (Source.HT);
1858 function Union (Left, Right : Set) return Set is
1859 Left_HT : Hash_Table_Type renames Left.HT'Unrestricted_Access.all;
1860 Right_HT : Hash_Table_Type renames Right.HT'Unrestricted_Access.all;
1861 Buckets : HT_Types.Buckets_Access;
1862 Length : Count_Type;
1865 if Left'Address = Right'Address then
1869 if Right.Length = 0 then
1873 if Left.Length = 0 then
1878 Size : constant Hash_Type :=
1879 Prime_Numbers.To_Prime (Left.Length + Right.Length);
1881 Buckets := HT_Ops.New_Buckets (Length => Size);
1884 Iterate_Left : declare
1885 procedure Process (L_Node : Node_Access);
1887 procedure Iterate is
1888 new HT_Ops.Generic_Iteration (Process);
1894 procedure Process (L_Node : Node_Access) is
1895 Src : Element_Type renames L_Node.Element.all;
1896 J : constant Hash_Type := Hash (Src) mod Buckets'Length;
1897 Bucket : Node_Access renames Buckets (J);
1898 Tgt : Element_Access := new Element_Type'(Src
);
1900 Bucket
:= new Node_Type
'(Tgt, Bucket);
1907 -- Per AI05-0022, the container implementation is required to detect
1908 -- element tampering by a generic actual subprogram, hence the use of
1909 -- Checked_Index instead of a simple invocation of generic formal
1912 B : Integer renames Left_HT.Busy;
1913 L : Integer renames Left_HT.Lock;
1915 -- Start of processing for Iterate_Left
1931 HT_Ops.Free_Hash_Table (Buckets);
1935 Length := Left.Length;
1937 Iterate_Right : declare
1938 procedure Process (Src_Node : Node_Access);
1940 procedure Iterate is
1941 new HT_Ops.Generic_Iteration (Process);
1947 procedure Process (Src_Node : Node_Access) is
1948 Src : Element_Type renames Src_Node.Element.all;
1949 Idx : constant Hash_Type := Hash (Src) mod Buckets'Length;
1951 Tgt_Node : Node_Access := Buckets (Idx);
1954 while Tgt_Node /= null loop
1955 if Equivalent_Elements (Src, Tgt_Node.Element.all) then
1958 Tgt_Node := Next (Tgt_Node);
1962 Tgt : Element_Access := new Element_Type'(Src
);
1964 Buckets
(Idx
) := new Node_Type
'(Tgt, Buckets (Idx));
1971 Length := Length + 1;
1974 -- Per AI05-0022, the container implementation is required to detect
1975 -- element tampering by a generic actual subprogram, hence the use of
1976 -- Checked_Index instead of a simple invocation of generic formal
1979 LB : Integer renames Left_HT.Busy;
1980 LL : Integer renames Left_HT.Lock;
1982 RB : Integer renames Right_HT.Busy;
1983 RL : Integer renames Right_HT.Lock;
1985 -- Start of processing for Iterate_Right
2010 HT_Ops.Free_Hash_Table (Buckets);
2014 return (Controlled with HT => (Buckets, Length, 0, 0));
2021 function Vet (Position : Cursor) return Boolean is
2023 if Position.Node = null then
2024 return Position.Container = null;
2027 if Position.Container = null then
2031 if Position.Node.Next = Position.Node then
2035 if Position.Node.Element = null then
2040 HT : Hash_Table_Type renames Position.Container.HT;
2044 if HT.Length = 0 then
2048 if HT.Buckets = null
2049 or else HT.Buckets'Length = 0
2054 X := HT.Buckets (Element_Keys.Checked_Index
2056 Position.Node.Element.all));
2058 for J in 1 .. HT.Length loop
2059 if X = Position.Node then
2067 if X = X.Next then -- to prevent unnecessary looping
2083 (Stream : not null access Root_Stream_Type'Class;
2087 Write_Nodes (Stream, Container.HT);
2091 (Stream : not null access Root_Stream_Type'Class;
2095 raise Program_Error with "attempt to stream set cursor";
2099 (Stream : not null access Root_Stream_Type'Class;
2100 Item : Constant_Reference_Type)
2103 raise Program_Error with "attempt to stream reference";
2110 procedure Write_Node
2111 (Stream : not null access Root_Stream_Type'Class;
2115 Element_Type'Output (Stream, Node.Element.all);
2118 package body Generic_Keys is
2120 -----------------------
2121 -- Local Subprograms --
2122 -----------------------
2124 function Equivalent_Key_Node
2126 Node : Node_Access) return Boolean;
2127 pragma Inline (Equivalent_Key_Node);
2129 --------------------------
2130 -- Local Instantiations --
2131 --------------------------
2134 new Hash_Tables.Generic_Keys
2135 (HT_Types => HT_Types,
2137 Set_Next => Set_Next,
2138 Key_Type => Key_Type,
2140 Equivalent_Keys => Equivalent_Key_Node);
2146 procedure Adjust (Control : in out Reference_Control_Type) is
2148 if Control.Container /= null then
2150 HT : Hash_Table_Type renames Control.Container.HT;
2151 B : Natural renames HT.Busy;
2152 L : Natural renames HT.Lock;
2160 ------------------------
2161 -- Constant_Reference --
2162 ------------------------
2164 function Constant_Reference
2165 (Container : aliased Set;
2166 Key : Key_Type) return Constant_Reference_Type
2168 HT : Hash_Table_Type renames Container'Unrestricted_Access.HT;
2169 Node : constant Node_Access := Key_Keys.Find (HT, Key);
2173 raise Constraint_Error with "Key not in set";
2176 if Node.Element = null then
2177 raise Program_Error with "Node has no element";
2181 B : Natural renames HT.Busy;
2182 L : Natural renames HT.Lock;
2184 return R : constant Constant_Reference_Type :=
2185 (Element => Node.Element.all'Access,
2186 Control => (Controlled with Container'Unrestricted_Access))
2192 end Constant_Reference;
2200 Key : Key_Type) return Boolean
2203 return Find (Container, Key) /= No_Element;
2211 (Container : in out Set;
2217 Key_Keys.Delete_Key_Sans_Free (Container.HT, Key, X);
2220 raise Constraint_Error with "key not in set";
2232 Key : Key_Type) return Element_Type
2234 HT : Hash_Table_Type renames Container'Unrestricted_Access.HT;
2235 Node : constant Node_Access := Key_Keys.Find (HT, Key);
2239 raise Constraint_Error with "key not in set";
2242 return Node.Element.all;
2245 -------------------------
2246 -- Equivalent_Key_Node --
2247 -------------------------
2249 function Equivalent_Key_Node
2251 Node : Node_Access) return Boolean is
2253 return Equivalent_Keys (Key, Generic_Keys.Key (Node.Element.all));
2254 end Equivalent_Key_Node;
2261 (Container : in out Set;
2266 Key_Keys.Delete_Key_Sans_Free (Container.HT, Key, X);
2274 procedure Finalize (Control : in out Reference_Control_Type) is
2276 if Control.Container /= null then
2278 HT : Hash_Table_Type renames Control.Container.HT;
2279 B : Natural renames HT.Busy;
2280 L : Natural renames HT.Lock;
2286 if Hash (Key (Control.Old_Pos)) /= Control.Old_Hash then
2287 HT_Ops.Delete_Node_At_Index
2288 (Control.Container.HT, Control.Index, Control.Old_Pos.Node);
2289 raise Program_Error;
2292 Control.Container := null;
2302 Key : Key_Type) return Cursor
2304 HT : Hash_Table_Type renames Container'Unrestricted_Access.HT;
2305 Node : constant Node_Access := Key_Keys.Find (HT, Key);
2307 return (if Node = null then No_Element
2308 else Cursor'(Container
'Unrestricted_Access, Node
));
2315 function Key
(Position
: Cursor
) return Key_Type
is
2317 if Position
.Node
= null then
2318 raise Constraint_Error
with
2319 "Position cursor equals No_Element";
2322 if Position
.Node
.Element
= null then
2323 raise Program_Error
with "Position cursor is bad";
2326 pragma Assert
(Vet
(Position
), "bad cursor in function Key");
2328 return Key
(Position
.Node
.Element
.all);
2336 (Stream
: not null access Root_Stream_Type
'Class;
2337 Item
: out Reference_Type
)
2340 raise Program_Error
with "attempt to stream reference";
2343 ------------------------------
2344 -- Reference_Preserving_Key --
2345 ------------------------------
2347 function Reference_Preserving_Key
2348 (Container
: aliased in out Set
;
2349 Position
: Cursor
) return Reference_Type
2352 if Position
.Container
= null then
2353 raise Constraint_Error
with "Position cursor has no element";
2356 if Position
.Container
/= Container
'Unrestricted_Access then
2357 raise Program_Error
with
2358 "Position cursor designates wrong container";
2361 if Position
.Node
.Element
= null then
2362 raise Program_Error
with "Node has no element";
2367 "bad cursor in function Reference_Preserving_Key");
2370 HT
: Hash_Table_Type
renames Container
.HT
;
2371 B
: Natural renames HT
.Busy
;
2372 L
: Natural renames HT
.Lock
;
2374 return R
: constant Reference_Type
:=
2375 (Element
=> Position
.Node
.Element
.all'Access,
2378 Container
=> Container
'Access,
2379 Index
=> HT_Ops
.Index
(HT
, Position
.Node
),
2380 Old_Pos
=> Position
,
2381 Old_Hash
=> Hash
(Key
(Position
))))
2387 end Reference_Preserving_Key
;
2389 function Reference_Preserving_Key
2390 (Container
: aliased in out Set
;
2391 Key
: Key_Type
) return Reference_Type
2393 Node
: constant Node_Access
:= Key_Keys
.Find
(Container
.HT
, Key
);
2397 raise Constraint_Error
with "Key not in set";
2400 if Node
.Element
= null then
2401 raise Program_Error
with "Node has no element";
2405 HT
: Hash_Table_Type
renames Container
.HT
;
2406 B
: Natural renames HT
.Busy
;
2407 L
: Natural renames HT
.Lock
;
2408 P
: constant Cursor
:= Find
(Container
, Key
);
2410 return R
: constant Reference_Type
:=
2411 (Element
=> Node
.Element
.all'Access,
2414 Container
=> Container
'Access,
2415 Index
=> HT_Ops
.Index
(HT
, P
.Node
),
2417 Old_Hash
=> Hash
(Key
)))
2423 end Reference_Preserving_Key
;
2430 (Container
: in out Set
;
2432 New_Item
: Element_Type
)
2434 Node
: constant Node_Access
:= Key_Keys
.Find
(Container
.HT
, Key
);
2438 raise Constraint_Error
with
2439 "attempt to replace key not in set";
2442 Replace_Element
(Container
.HT
, Node
, New_Item
);
2445 -----------------------------------
2446 -- Update_Element_Preserving_Key --
2447 -----------------------------------
2449 procedure Update_Element_Preserving_Key
2450 (Container
: in out Set
;
2452 Process
: not null access
2453 procedure (Element
: in out Element_Type
))
2455 HT
: Hash_Table_Type
renames Container
.HT
;
2459 if Position
.Node
= null then
2460 raise Constraint_Error
with
2461 "Position cursor equals No_Element";
2464 if Position
.Node
.Element
= null
2465 or else Position
.Node
.Next
= Position
.Node
2467 raise Program_Error
with "Position cursor is bad";
2470 if Position
.Container
/= Container
'Unrestricted_Access then
2471 raise Program_Error
with
2472 "Position cursor designates wrong set";
2475 if HT
.Buckets
= null
2476 or else HT
.Buckets
'Length = 0
2477 or else HT
.Length
= 0
2479 raise Program_Error
with "Position cursor is bad (set is empty)";
2484 "bad cursor in Update_Element_Preserving_Key");
2486 -- Per AI05-0022, the container implementation is required to detect
2487 -- element tampering by a generic actual subprogram.
2490 E
: Element_Type
renames Position
.Node
.Element
.all;
2491 K
: constant Key_Type
:= Key
(E
);
2493 B
: Natural renames HT
.Busy
;
2494 L
: Natural renames HT
.Lock
;
2503 Indx
:= HT_Ops
.Index
(HT
, Position
.Node
);
2505 Eq
:= Equivalent_Keys
(K
, Key
(E
));
2523 if HT
.Buckets
(Indx
) = Position
.Node
then
2524 HT
.Buckets
(Indx
) := Position
.Node
.Next
;
2528 Prev
: Node_Access
:= HT
.Buckets
(Indx
);
2531 while Prev
.Next
/= Position
.Node
loop
2535 raise Program_Error
with
2536 "Position cursor is bad (node not found)";
2540 Prev
.Next
:= Position
.Node
.Next
;
2544 HT
.Length
:= HT
.Length
- 1;
2547 X
: Node_Access
:= Position
.Node
;
2553 raise Program_Error
with "key was modified";
2554 end Update_Element_Preserving_Key
;
2561 (Stream
: not null access Root_Stream_Type
'Class;
2562 Item
: Reference_Type
)
2565 raise Program_Error
with "attempt to stream reference";
2570 end Ada
.Containers
.Indefinite_Hashed_Sets
;