1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.INDEFINITE_ORDERED_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 was originally developed by Matthew J Heaney. --
34 ------------------------------------------------------------------------------
36 with Ada.Containers.Red_Black_Trees.Generic_Operations;
37 pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Operations);
39 with Ada.Containers.Red_Black_Trees.Generic_Keys;
40 pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Keys);
42 with Ada.Containers.Red_Black_Trees.Generic_Set_Operations;
43 pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations);
45 with Ada.Unchecked_Deallocation;
47 with System; use type System.Address;
49 package body Ada.Containers.Indefinite_Ordered_Sets is
51 type Element_Access is access Element_Type;
55 type Node_Type is limited record
59 Color : Red_Black_Trees.Color_Type := Red;
60 Element : Element_Access;
63 -----------------------
64 -- Local Subprograms --
65 -----------------------
67 function Color (Node : Node_Access) return Color_Type;
68 pragma Inline (Color);
70 function Copy_Node (Source : Node_Access) return Node_Access;
71 pragma Inline (Copy_Node);
73 function Copy_Tree (Source_Root : Node_Access) return Node_Access;
75 procedure Delete_Tree (X : in out Node_Access);
77 procedure Free (X : in out Node_Access);
79 procedure Insert_With_Hint
80 (Dst_Tree : in out Tree_Type;
81 Dst_Hint : Node_Access;
82 Src_Node : Node_Access;
83 Dst_Node : out Node_Access);
85 function Is_Greater_Element_Node
87 Right : Node_Access) return Boolean;
88 pragma Inline (Is_Greater_Element_Node);
90 function Is_Less_Element_Node
92 Right : Node_Access) return Boolean;
93 pragma Inline (Is_Less_Element_Node);
95 function Is_Less_Node_Node (L, R : Node_Access) return Boolean;
96 pragma Inline (Is_Less_Node_Node);
98 function Left (Node : Node_Access) return Node_Access;
101 function Parent (Node : Node_Access) return Node_Access;
102 pragma Inline (Parent);
104 function Right (Node : Node_Access) return Node_Access;
105 pragma Inline (Right);
107 procedure Set_Color (Node : Node_Access; Color : Color_Type);
108 pragma Inline (Set_Color);
110 procedure Set_Left (Node : Node_Access; Left : Node_Access);
111 pragma Inline (Set_Left);
113 procedure Set_Parent (Node : Node_Access; Parent : Node_Access);
114 pragma Inline (Set_Parent);
116 procedure Set_Right (Node : Node_Access; Right : Node_Access);
117 pragma Inline (Set_Right);
119 --------------------------
120 -- Local Instantiations --
121 --------------------------
123 procedure Free_Element is
124 new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
126 package Tree_Operations is
127 new Red_Black_Trees.Generic_Operations
128 (Tree_Types => Tree_Types,
129 Null_Node => Node_Access'(null));
133 package Element_Keys is
134 new Red_Black_Trees.Generic_Keys
135 (Tree_Operations => Tree_Operations,
136 Key_Type => Element_Type,
137 Is_Less_Key_Node => Is_Less_Element_Node,
138 Is_Greater_Key_Node => Is_Greater_Element_Node);
141 new Generic_Set_Operations
142 (Tree_Operations => Tree_Operations,
143 Insert_With_Hint => Insert_With_Hint,
144 Copy_Tree => Copy_Tree,
145 Delete_Tree => Delete_Tree,
146 Is_Less => Is_Less_Node_Node,
153 function "<" (Left, Right : Cursor) return Boolean is
155 return Left.Node.Element.all < Right.Node.Element.all;
158 function "<" (Left : Cursor; Right : Element_Type) return Boolean is
160 return Left.Node.Element.all < Right;
163 function "<" (Left : Element_Type; Right : Cursor) return Boolean is
165 return Left < Right.Node.Element.all;
172 function "=" (Left, Right : Set) return Boolean is
174 function Is_Equal_Node_Node (L, R : Node_Access) return Boolean;
175 pragma Inline (Is_Equal_Node_Node);
178 new Tree_Operations.Generic_Equal (Is_Equal_Node_Node);
180 ------------------------
181 -- Is_Equal_Node_Node --
182 ------------------------
184 function Is_Equal_Node_Node (L, R : Node_Access) return Boolean is
186 return L.Element.all = R.Element.all;
187 end Is_Equal_Node_Node;
189 -- Start of processing for "="
192 if Left'Address = Right'Address then
196 return Is_Equal (Left.Tree, Right.Tree);
204 function ">" (Left, Right : Cursor) return Boolean is
206 -- L > R same as R < L
208 return Right.Node.Element.all < Left.Node.Element.all;
211 function ">" (Left : Cursor; Right : Element_Type) return Boolean is
213 return Right < Left.Node.Element.all;
216 function ">" (Left : Element_Type; Right : Cursor) return Boolean is
218 return Right.Node.Element.all < Left;
225 procedure Adjust (Container : in out Set) is
226 Tree : Tree_Type renames Container.Tree;
229 if Tree.Length = 0 then
230 pragma Assert (Tree.Root = null);
235 Tree.Root := Copy_Tree (Tree.Root);
238 Tree := (Length => 0, others => null);
242 Tree.First := Min (Tree.Root);
243 Tree.Last := Max (Tree.Root);
250 function Ceiling (Container : Set; Item : Element_Type) return Cursor is
251 Node : constant Node_Access :=
252 Element_Keys.Ceiling (Container.Tree, Item);
259 return Cursor'(Container'Unchecked_Access, Node);
266 procedure Clear (Container : in out Set) is
267 Tree : Tree_Type renames Container.Tree;
268 Root : Node_Access := Tree.Root;
270 Tree := (Length => 0, others => null);
278 function Color (Node : Node_Access) return Color_Type is
287 function Contains (Container : Set; Item : Element_Type) return Boolean is
289 return Find (Container, Item) /= No_Element;
296 function Copy_Node (Source : Node_Access) return Node_Access is
297 Element : Element_Access := new Element_Type'(Source.Element.all);
299 return new Node_Type'(Parent => null,
302 Color => Source.Color,
306 Free_Element (Element);
314 function Copy_Tree (Source_Root : Node_Access) return Node_Access is
315 Target_Root : Node_Access := Copy_Node (Source_Root);
319 if Source_Root.Right /= null then
320 Target_Root.Right := Copy_Tree (Source_Root.Right);
321 Target_Root.Right.Parent := Target_Root;
325 X := Source_Root.Left;
329 Y : Node_Access := Copy_Node (X);
335 if X.Right /= null then
336 Y.Right := Copy_Tree (X.Right);
349 Delete_Tree (Target_Root);
357 procedure Delete (Container : in out Set; Position : in out Cursor) is
359 if Position = No_Element then
363 if Position.Container /= Set_Access'(Container'Unchecked_Access) then
367 Delete_Node_Sans_Free (Container.Tree, Position.Node);
368 Free (Position.Node);
370 Position.Container := null;
373 procedure Delete (Container : in out Set; Item : Element_Type) is
375 Element_Keys.Find (Container.Tree, Item);
379 raise Constraint_Error;
382 Delete_Node_Sans_Free (Container.Tree, X);
390 procedure Delete_First (Container : in out Set) is
391 C : Cursor := First (Container);
393 Delete (Container, C);
400 procedure Delete_Last (Container : in out Set) is
401 C : Cursor := Last (Container);
403 Delete (Container, C);
410 procedure Delete_Tree (X : in out Node_Access) is
426 procedure Difference (Target : in out Set; Source : Set) is
428 if Target'Address = Source'Address then
433 Set_Ops.Difference (Target.Tree, Source.Tree);
436 function Difference (Left, Right : Set) return Set is
438 if Left'Address = Right'Address then
443 Tree : constant Tree_Type :=
444 Set_Ops.Difference (Left.Tree, Right.Tree);
446 return (Controlled with Tree);
454 function Element (Position : Cursor) return Element_Type is
456 return Position.Node.Element.all;
463 procedure Exclude (Container : in out Set; Item : Element_Type) is
465 Element_Keys.Find (Container.Tree, Item);
468 Delete_Node_Sans_Free (Container.Tree, X);
477 function Find (Container : Set; Item : Element_Type) return Cursor is
478 Node : constant Node_Access :=
479 Element_Keys.Find (Container.Tree, Item);
486 return Cursor'(Container'Unchecked_Access, Node);
493 function First (Container : Set) return Cursor is
495 if Container.Tree.First = null then
499 return Cursor'(Container'Unchecked_Access, Container.Tree.First);
506 function First_Element (Container : Set) return Element_Type is
508 return Container.Tree.First.Element.all;
515 function Floor (Container : Set; Item : Element_Type) return Cursor is
516 Node : constant Node_Access :=
517 Element_Keys.Floor (Container.Tree, Item);
524 return Cursor'(Container'Unchecked_Access, Node);
531 procedure Free (X : in out Node_Access) is
532 procedure Deallocate is
533 new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
536 Free_Element (X.Element);
545 package body Generic_Keys is
547 -----------------------
548 -- Local Subprograms --
549 -----------------------
551 function Is_Greater_Key_Node
553 Right : Node_Access) return Boolean;
554 pragma Inline (Is_Greater_Key_Node);
556 function Is_Less_Key_Node
558 Right : Node_Access) return Boolean;
559 pragma Inline (Is_Less_Key_Node);
561 --------------------------
562 -- Local Instantiations --
563 --------------------------
566 new Red_Black_Trees.Generic_Keys
567 (Tree_Operations => Tree_Operations,
568 Key_Type => Key_Type,
569 Is_Less_Key_Node => Is_Less_Key_Node,
570 Is_Greater_Key_Node => Is_Greater_Key_Node);
576 function "<" (Left : Key_Type; Right : Cursor) return Boolean is
578 return Left < Right.Node.Element.all;
581 function "<" (Left : Cursor; Right : Key_Type) return Boolean is
583 return Right > Left.Node.Element.all;
590 function ">" (Left : Key_Type; Right : Cursor) return Boolean is
592 return Left > Right.Node.Element.all;
595 function ">" (Left : Cursor; Right : Key_Type) return Boolean is
597 return Right < Left.Node.Element.all;
604 function Ceiling (Container : Set; Key : Key_Type) return Cursor is
605 Node : constant Node_Access :=
606 Key_Keys.Ceiling (Container.Tree, Key);
613 return Cursor'(Container'Unchecked_Access, Node);
616 ----------------------------
617 -- Checked_Update_Element --
618 ----------------------------
620 procedure Checked_Update_Element
621 (Container : in out Set;
623 Process : not null access
624 procedure (Element : in out Element_Type))
627 if Position.Container = null then
628 raise Constraint_Error;
631 if Position.Container /= Set_Access'(Container'Unchecked_Access) then
636 Old_Key : Key_Type renames Key (Position.Node.Element.all);
639 Process (Position.Node.Element.all);
641 if Old_Key < Position.Node.Element.all
642 or else Old_Key > Position.Node.Element.all
651 Result : Node_Access;
654 function New_Node return Node_Access;
655 pragma Inline (New_Node);
657 procedure Insert_Post is
658 new Key_Keys.Generic_Insert_Post (New_Node);
661 new Key_Keys.Generic_Conditional_Insert (Insert_Post);
667 function New_Node return Node_Access is
669 return Position.Node;
672 -- Start of processing for Checked_Update_Element
675 Delete_Node_Sans_Free (Container.Tree, Position.Node);
678 (Tree => Container.Tree,
679 Key => Key (Position.Node.Element.all),
685 X : Node_Access := Position.Node;
693 pragma Assert (Result = Position.Node);
695 end Checked_Update_Element;
701 function Contains (Container : Set; Key : Key_Type) return Boolean is
703 return Find (Container, Key) /= No_Element;
710 procedure Delete (Container : in out Set; Key : Key_Type) is
711 X : Node_Access := Key_Keys.Find (Container.Tree, Key);
715 raise Constraint_Error;
718 Delete_Node_Sans_Free (Container.Tree, X);
726 function Element (Container : Set; Key : Key_Type) return Element_Type is
727 C : constant Cursor := Find (Container, Key);
729 return C.Node.Element.all;
736 procedure Exclude (Container : in out Set; Key : Key_Type) is
737 X : Node_Access := Key_Keys.Find (Container.Tree, Key);
741 Delete_Node_Sans_Free (Container.Tree, X);
750 function Find (Container : Set; Key : Key_Type) return Cursor is
751 Node : constant Node_Access :=
752 Key_Keys.Find (Container.Tree, Key);
759 return Cursor'(Container'Unchecked_Access, Node);
766 function Floor (Container : Set; Key : Key_Type) return Cursor is
767 Node : constant Node_Access :=
768 Key_Keys.Floor (Container.Tree, Key);
775 return Cursor'(Container'Unchecked_Access, Node);
778 -------------------------
779 -- Is_Greater_Key_Node --
780 -------------------------
782 function Is_Greater_Key_Node
784 Right : Node_Access) return Boolean is
786 return Left > Right.Element.all;
787 end Is_Greater_Key_Node;
789 ----------------------
790 -- Is_Less_Key_Node --
791 ----------------------
793 function Is_Less_Key_Node
795 Right : Node_Access) return Boolean is
797 return Left < Right.Element.all;
798 end Is_Less_Key_Node;
804 function Key (Position : Cursor) return Key_Type is
806 return Key (Position.Node.Element.all);
815 function Has_Element (Position : Cursor) return Boolean is
817 return Position /= No_Element;
824 procedure Include (Container : in out Set; New_Item : Element_Type) is
831 Insert (Container, New_Item, Position, Inserted);
834 X := Position.Node.Element;
835 Position.Node.Element := new Element_Type'(New_Item);
845 (Container : in out Set;
846 New_Item : Element_Type;
847 Position : out Cursor;
848 Inserted : out Boolean)
850 function New_Node return Node_Access;
851 pragma Inline (New_Node);
853 procedure Insert_Post is
854 new Element_Keys.Generic_Insert_Post (New_Node);
856 procedure Insert_Sans_Hint is
857 new Element_Keys.Generic_Conditional_Insert (Insert_Post);
863 function New_Node return Node_Access is
864 Element : Element_Access := new Element_Type'(New_Item);
866 return new Node_Type'(Parent => null,
873 Free_Element (Element);
877 -- Start of processing for Insert
886 Position.Container := Container'Unchecked_Access;
889 procedure Insert (Container : in out Set; New_Item : Element_Type) is
893 Insert (Container, New_Item, Position, Inserted);
896 raise Constraint_Error;
900 ----------------------
901 -- Insert_With_Hint --
902 ----------------------
904 procedure Insert_With_Hint
905 (Dst_Tree : in out Tree_Type;
906 Dst_Hint : Node_Access;
907 Src_Node : Node_Access;
908 Dst_Node : out Node_Access)
912 function New_Node return Node_Access;
914 procedure Insert_Post is
915 new Element_Keys.Generic_Insert_Post (New_Node);
917 procedure Insert_Sans_Hint is
918 new Element_Keys.Generic_Conditional_Insert (Insert_Post);
920 procedure Insert_With_Hint is
921 new Element_Keys.Generic_Conditional_Insert_With_Hint
929 function New_Node return Node_Access is
930 Element : Element_Access :=
931 new Element_Type'(Src_Node.Element.all);
936 Node := new Node_Type;
939 Free_Element (Element);
943 Node.Element := Element;
947 -- Start of processing for Insert_With_Hint
953 Src_Node.Element.all,
956 end Insert_With_Hint;
962 procedure Intersection (Target : in out Set; Source : Set) is
964 if Target'Address = Source'Address then
968 Set_Ops.Intersection (Target.Tree, Source.Tree);
971 function Intersection (Left, Right : Set) return Set is
973 if Left'Address = Right'Address then
978 Tree : constant Tree_Type :=
979 Set_Ops.Intersection (Left.Tree, Right.Tree);
981 return (Controlled with Tree);
989 function Is_Empty (Container : Set) return Boolean is
991 return Length (Container) = 0;
994 -----------------------------
995 -- Is_Greater_Element_Node --
996 -----------------------------
998 function Is_Greater_Element_Node
999 (Left : Element_Type;
1000 Right : Node_Access) return Boolean is
1002 -- e > node same as node < e
1004 return Right.Element.all < Left;
1005 end Is_Greater_Element_Node;
1008 --------------------------
1009 -- Is_Less_Element_Node --
1010 --------------------------
1012 function Is_Less_Element_Node
1013 (Left : Element_Type;
1014 Right : Node_Access) return Boolean is
1016 return Left < Right.Element.all;
1017 end Is_Less_Element_Node;
1019 -----------------------
1020 -- Is_Less_Node_Node --
1021 -----------------------
1023 function Is_Less_Node_Node (L, R : Node_Access) return Boolean is
1025 return L.Element.all < R.Element.all;
1026 end Is_Less_Node_Node;
1032 function Is_Subset (Subset : Set; Of_Set : Set) return Boolean is
1034 if Subset'Address = Of_Set'Address then
1038 return Set_Ops.Is_Subset (Subset => Subset.Tree, Of_Set => Of_Set.Tree);
1047 Process : not null access procedure (Position : Cursor))
1049 procedure Process_Node (Node : Node_Access);
1050 pragma Inline (Process_Node);
1052 procedure Local_Iterate is
1053 new Tree_Operations.Generic_Iteration (Process_Node);
1059 procedure Process_Node (Node : Node_Access) is
1061 Process (Cursor'(Container'Unchecked_Access, Node));
1064 -- Start of processing for Iterate
1067 Local_Iterate (Container.Tree);
1074 function Last (Container : Set) return Cursor is
1076 if Container.Tree.Last = null then
1080 return Cursor'(Container'Unchecked_Access, Container.Tree.Last);
1087 function Last_Element (Container : Set) return Element_Type is
1089 return Container.Tree.Last.Element.all;
1096 function Left (Node : Node_Access) return Node_Access is
1105 function Length (Container : Set) return Count_Type is
1107 return Container.Tree.Length;
1114 procedure Move (Target : in out Set; Source : in out Set) is
1116 if Target'Address = Source'Address then
1120 Move (Target => Target.Tree, Source => Source.Tree);
1127 procedure Next (Position : in out Cursor) is
1129 Position := Next (Position);
1132 function Next (Position : Cursor) return Cursor is
1134 if Position = No_Element then
1139 Node : constant Node_Access :=
1140 Tree_Operations.Next (Position.Node);
1146 return Cursor'(Position.Container, Node);
1154 function Overlap (Left, Right : Set) return Boolean is
1156 if Left'Address = Right'Address then
1157 return Left.Tree.Length /= 0;
1160 return Set_Ops.Overlap (Left.Tree, Right.Tree);
1167 function Parent (Node : Node_Access) return Node_Access is
1176 procedure Previous (Position : in out Cursor) is
1178 Position := Previous (Position);
1181 function Previous (Position : Cursor) return Cursor is
1183 if Position = No_Element then
1188 Node : constant Node_Access :=
1189 Tree_Operations.Previous (Position.Node);
1195 return Cursor'(Position.Container, Node);
1203 procedure Query_Element
1205 Process : not null access procedure (Element : Element_Type))
1208 Process (Position.Node.Element.all);
1216 (Stream : access Ada.Streams.Root_Stream_Type'Class;
1217 Container : out Set)
1219 N : Count_Type'Base;
1221 function New_Node return Node_Access;
1224 new Tree_Operations.Generic_Read (New_Node);
1230 function New_Node return Node_Access is
1231 Node : Node_Access := new Node_Type;
1234 Node.Element := new Element_Type'(Element_Type'Input (Stream));
1243 -- Start of processing for Read
1247 Count_Type'Base'Read (Stream, N);
1248 pragma Assert (N >= 0);
1249 Read (Container.Tree, N);
1256 procedure Replace (Container : in out Set; New_Item : Element_Type) is
1257 Node : constant Node_Access :=
1258 Element_Keys.Find (Container.Tree, New_Item);
1264 raise Constraint_Error;
1268 Node.Element := new Element_Type'(New_Item);
1273 -- procedure Replace
1274 -- (Container : in out Set;
1276 -- New_Item : Element_Type)
1278 -- Node : Node_Access := Key_Keys.Find (Container.Tree, Key);
1281 -- if Node = null then
1282 -- raise Constraint_Error;
1285 -- Replace_Element (Container, Node, New_Item);
1288 ---------------------
1289 -- Replace_Element --
1290 ---------------------
1293 -- procedure Replace_Element
1294 -- (Container : in out Set;
1295 -- Position : Node_Access;
1296 -- By : Element_Type)
1299 -- Node : Node_Access := Position;
1302 -- if By < Node.Element.all
1303 -- or else Node.Element.all < By
1309 -- X : Element_Access := Node.Element;
1312 -- Node.Element := new Element_Type'(By);
1314 -- -- NOTE: If there's an exception here, then just
1315 -- -- let it propagate. We haven't modified the
1316 -- -- state of the container, so there's nothing else
1317 -- -- we need to do.
1319 -- Free_Element (X);
1325 -- Delete_Node_Sans_Free (Container.Tree, Node);
1328 -- Free_Element (Node.Element);
1331 -- Node.Element := null; -- don't attempt to dealloc X.E again
1337 -- Node.Element := new Element_Type'(By);
1345 -- function New_Node return Node_Access;
1346 -- pragma Inline (New_Node);
1348 -- function New_Node return Node_Access is
1353 -- procedure Insert_Post is
1354 -- new Element_Keys.Generic_Insert_Post (New_Node);
1356 -- procedure Insert is
1357 -- new Element_Keys.Generic_Conditional_Insert (Insert_Post);
1359 -- Result : Node_Access;
1360 -- Success : Boolean;
1364 -- (Tree => Container.Tree,
1365 -- Key => Node.Element.all,
1367 -- Success => Success);
1369 -- if not Success then
1371 -- raise Program_Error;
1374 -- pragma Assert (Result = Node);
1376 -- end Replace_Element;
1379 -- procedure Replace_Element
1380 -- (Container : in out Set;
1381 -- Position : Cursor;
1382 -- By : Element_Type)
1385 -- if Position.Container = null then
1386 -- raise Constraint_Error;
1389 -- if Position.Container /= Set_Access'(Container'Unchecked_Access) then
1390 -- raise Program_Error;
1393 -- Replace_Element (Container, Position.Node, By);
1394 -- end Replace_Element;
1396 ---------------------
1397 -- Reverse_Iterate --
1398 ---------------------
1400 procedure Reverse_Iterate
1402 Process : not null access procedure (Position : Cursor))
1404 procedure Process_Node (Node : Node_Access);
1405 pragma Inline (Process_Node);
1407 procedure Local_Reverse_Iterate is
1408 new Tree_Operations.Generic_Reverse_Iteration (Process_Node);
1414 procedure Process_Node (Node : Node_Access) is
1416 Process (Cursor'(Container'Unchecked_Access, Node));
1419 -- Start of processing for Reverse_Iterate
1422 Local_Reverse_Iterate (Container.Tree);
1423 end Reverse_Iterate;
1429 function Right (Node : Node_Access) return Node_Access is
1438 procedure Set_Color (Node : Node_Access; Color : Color_Type) is
1440 Node.Color := Color;
1447 procedure Set_Left (Node : Node_Access; Left : Node_Access) is
1456 procedure Set_Parent (Node : Node_Access; Parent : Node_Access) is
1458 Node.Parent := Parent;
1465 procedure Set_Right (Node : Node_Access; Right : Node_Access) is
1467 Node.Right := Right;
1470 --------------------------
1471 -- Symmetric_Difference --
1472 --------------------------
1474 procedure Symmetric_Difference (Target : in out Set; Source : Set) is
1476 if Target'Address = Source'Address then
1481 Set_Ops.Symmetric_Difference (Target.Tree, Source.Tree);
1482 end Symmetric_Difference;
1484 function Symmetric_Difference (Left, Right : Set) return Set is
1486 if Left'Address = Right'Address then
1491 Tree : constant Tree_Type :=
1492 Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
1494 return (Controlled with Tree);
1496 end Symmetric_Difference;
1502 procedure Union (Target : in out Set; Source : Set) is
1504 if Target'Address = Source'Address then
1508 Set_Ops.Union (Target.Tree, Source.Tree);
1511 function Union (Left, Right : Set) return Set is
1513 if Left'Address = Right'Address then
1518 Tree : constant Tree_Type :=
1519 Set_Ops.Union (Left.Tree, Right.Tree);
1521 return (Controlled with Tree);
1530 (Stream : access Ada.Streams.Root_Stream_Type'Class;
1533 procedure Process (Node : Node_Access);
1534 pragma Inline (Process);
1536 procedure Iterate is
1537 new Tree_Operations.Generic_Iteration (Process);
1543 procedure Process (Node : Node_Access) is
1545 Element_Type'Output (Stream, Node.Element.all);
1548 -- Start of processing for Write
1551 Count_Type'Base'Write (Stream, Container.Tree.Length);
1552 Iterate (Container.Tree);
1555 end Ada.Containers.Indefinite_Ordered_Sets;