1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_BOUNDED_SET_OPERATIONS --
9 -- Copyright (C) 2004-2013, 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 System; use type System.Address;
32 package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations is
34 -----------------------
35 -- Local Subprograms --
36 -----------------------
38 function Copy (Source : Set_Type) return Set_Type;
44 function Copy (Source : Set_Type) return Set_Type is
46 return Target : Set_Type (Source.Length) do
47 Assign (Target => Target, Source => Source);
55 procedure Set_Difference (Target : in out Set_Type; Source : Set_Type) is
56 BT : Natural renames Target.Busy;
57 LT : Natural renames Target.Lock;
59 BS : Natural renames Source'Unrestricted_Access.Busy;
60 LS : Natural renames Source'Unrestricted_Access.Lock;
62 Tgt, Src : Count_Type;
64 TN : Nodes_Type renames Target.Nodes;
65 SN : Nodes_Type renames Source.Nodes;
70 if Target'Address = Source'Address then
71 if Target.Busy > 0 then
72 raise Program_Error with
73 "attempt to tamper with cursors (container is busy)";
76 Tree_Operations.Clear_Tree (Target);
80 if Source.Length = 0 then
84 if Target.Busy > 0 then
85 raise Program_Error with
86 "attempt to tamper with cursors (container is busy)";
100 -- Per AI05-0022, the container implementation is required to detect
101 -- element tampering by a generic actual subprogram.
110 if Is_Less (TN (Tgt), SN (Src)) then
112 elsif Is_Less (SN (Src), TN (Tgt)) then
135 Tgt := Tree_Operations.Next (Target, Tgt);
137 elsif Compare > 0 then
138 Src := Tree_Operations.Next (Source, Src);
142 X : constant Count_Type := Tgt;
144 Tgt := Tree_Operations.Next (Target, Tgt);
146 Tree_Operations.Delete_Node_Sans_Free (Target, X);
147 Tree_Operations.Free (Target, X);
150 Src := Tree_Operations.Next (Source, Src);
155 function Set_Difference (Left, Right : Set_Type) return Set_Type is
157 if Left'Address = Right'Address then
158 return S : Set_Type (0); -- Empty set
161 if Left.Length = 0 then
162 return S : Set_Type (0); -- Empty set
165 if Right.Length = 0 then
169 return Result : Set_Type (Left.Length) do
170 -- Per AI05-0022, the container implementation is required to detect
171 -- element tampering by a generic actual subprogram.
174 BL : Natural renames Left'Unrestricted_Access.Busy;
175 LL : Natural renames Left'Unrestricted_Access.Lock;
177 BR : Natural renames Right'Unrestricted_Access.Busy;
178 LR : Natural renames Right'Unrestricted_Access.Lock;
183 Dst_Node : Count_Type;
184 pragma Warnings (Off, Dst_Node);
193 L_Node := Left.First;
194 R_Node := Right.First;
201 while L_Node /= 0 loop
205 Src_Node => Left.Nodes (L_Node),
206 Dst_Node => Dst_Node);
208 L_Node := Tree_Operations.Next (Left, L_Node);
214 if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
218 Src_Node => Left.Nodes (L_Node),
219 Dst_Node => Dst_Node);
221 L_Node := Tree_Operations.Next (Left, L_Node);
223 elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
224 R_Node := Tree_Operations.Next (Right, R_Node);
227 L_Node := Tree_Operations.Next (Left, L_Node);
228 R_Node := Tree_Operations.Next (Right, R_Node);
254 procedure Set_Intersection
255 (Target : in out Set_Type;
258 BT : Natural renames Target.Busy;
259 LT : Natural renames Target.Lock;
261 BS : Natural renames Source'Unrestricted_Access.Busy;
262 LS : Natural renames Source'Unrestricted_Access.Lock;
270 if Target'Address = Source'Address then
274 if Target.Busy > 0 then
275 raise Program_Error with
276 "attempt to tamper with cursors (container is busy)";
279 if Source.Length = 0 then
280 Tree_Operations.Clear_Tree (Target);
289 -- Per AI05-0022, the container implementation is required to detect
290 -- element tampering by a generic actual subprogram.
299 if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then
301 elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then
325 X : constant Count_Type := Tgt;
327 Tgt := Tree_Operations.Next (Target, Tgt);
329 Tree_Operations.Delete_Node_Sans_Free (Target, X);
330 Tree_Operations.Free (Target, X);
333 elsif Compare > 0 then
334 Src := Tree_Operations.Next (Source, Src);
337 Tgt := Tree_Operations.Next (Target, Tgt);
338 Src := Tree_Operations.Next (Source, Src);
344 X : constant Count_Type := Tgt;
346 Tgt := Tree_Operations.Next (Target, Tgt);
348 Tree_Operations.Delete_Node_Sans_Free (Target, X);
349 Tree_Operations.Free (Target, X);
352 end Set_Intersection;
354 function Set_Intersection (Left, Right : Set_Type) return Set_Type is
356 if Left'Address = Right'Address then
360 return Result : Set_Type (Count_Type'Min (Left.Length, Right.Length)) do
362 -- Per AI05-0022, the container implementation is required to detect
363 -- element tampering by a generic actual subprogram.
366 BL : Natural renames Left'Unrestricted_Access.Busy;
367 LL : Natural renames Left'Unrestricted_Access.Lock;
369 BR : Natural renames Right'Unrestricted_Access.Busy;
370 LR : Natural renames Right'Unrestricted_Access.Lock;
375 Dst_Node : Count_Type;
376 pragma Warnings (Off, Dst_Node);
385 L_Node := Left.First;
386 R_Node := Right.First;
396 if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
397 L_Node := Tree_Operations.Next (Left, L_Node);
399 elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
400 R_Node := Tree_Operations.Next (Right, R_Node);
406 Src_Node => Left.Nodes (L_Node),
407 Dst_Node => Dst_Node);
409 L_Node := Tree_Operations.Next (Left, L_Node);
410 R_Node := Tree_Operations.Next (Right, R_Node);
430 end Set_Intersection;
438 Of_Set : Set_Type) return Boolean
441 if Subset'Address = Of_Set'Address then
445 if Subset.Length > Of_Set.Length then
449 -- Per AI05-0022, the container implementation is required to detect
450 -- element tampering by a generic actual subprogram.
453 BL : Natural renames Subset'Unrestricted_Access.Busy;
454 LL : Natural renames Subset'Unrestricted_Access.Lock;
456 BR : Natural renames Of_Set'Unrestricted_Access.Busy;
457 LR : Natural renames Of_Set'Unrestricted_Access.Lock;
459 Subset_Node : Count_Type;
460 Set_Node : Count_Type;
471 Subset_Node := Subset.First;
472 Set_Node := Of_Set.First;
475 Result := Subset_Node = 0;
479 if Subset_Node = 0 then
484 if Is_Less (Subset.Nodes (Subset_Node),
485 Of_Set.Nodes (Set_Node))
491 if Is_Less (Of_Set.Nodes (Set_Node),
492 Subset.Nodes (Subset_Node))
494 Set_Node := Tree_Operations.Next (Of_Set, Set_Node);
496 Set_Node := Tree_Operations.Next (Of_Set, Set_Node);
497 Subset_Node := Tree_Operations.Next (Subset, Subset_Node);
524 function Set_Overlap (Left, Right : Set_Type) return Boolean is
526 if Left'Address = Right'Address then
527 return Left.Length /= 0;
530 -- Per AI05-0022, the container implementation is required to detect
531 -- element tampering by a generic actual subprogram.
534 BL : Natural renames Left'Unrestricted_Access.Busy;
535 LL : Natural renames Left'Unrestricted_Access.Lock;
537 BR : Natural renames Right'Unrestricted_Access.Busy;
538 LR : Natural renames Right'Unrestricted_Access.Lock;
552 L_Node := Left.First;
553 R_Node := Right.First;
562 if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
563 L_Node := Tree_Operations.Next (Left, L_Node);
565 elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
566 R_Node := Tree_Operations.Next (Right, R_Node);
593 --------------------------
594 -- Symmetric_Difference --
595 --------------------------
597 procedure Set_Symmetric_Difference
598 (Target : in out Set_Type;
601 BT : Natural renames Target.Busy;
602 LT : Natural renames Target.Lock;
604 BS : Natural renames Source'Unrestricted_Access.Busy;
605 LS : Natural renames Source'Unrestricted_Access.Lock;
610 New_Tgt_Node : Count_Type;
611 pragma Warnings (Off, New_Tgt_Node);
616 if Target'Address = Source'Address then
617 Tree_Operations.Clear_Tree (Target);
629 Src_Node => Source.Nodes (Src),
630 Dst_Node => New_Tgt_Node);
632 Src := Tree_Operations.Next (Source, Src);
642 -- Per AI05-0022, the container implementation is required to detect
643 -- element tampering by a generic actual subprogram.
652 if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then
654 elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then
677 Tgt := Tree_Operations.Next (Target, Tgt);
679 elsif Compare > 0 then
683 Src_Node => Source.Nodes (Src),
684 Dst_Node => New_Tgt_Node);
686 Src := Tree_Operations.Next (Source, Src);
690 X : constant Count_Type := Tgt;
692 Tgt := Tree_Operations.Next (Target, Tgt);
694 Tree_Operations.Delete_Node_Sans_Free (Target, X);
695 Tree_Operations.Free (Target, X);
698 Src := Tree_Operations.Next (Source, Src);
701 end Set_Symmetric_Difference;
703 function Set_Symmetric_Difference
704 (Left, Right : Set_Type) return Set_Type
707 if Left'Address = Right'Address then
708 return S : Set_Type (0); -- Empty set
711 if Right.Length = 0 then
715 if Left.Length = 0 then
719 return Result : Set_Type (Left.Length + Right.Length) do
721 -- Per AI05-0022, the container implementation is required to detect
722 -- element tampering by a generic actual subprogram.
725 BL : Natural renames Left'Unrestricted_Access.Busy;
726 LL : Natural renames Left'Unrestricted_Access.Lock;
728 BR : Natural renames Right'Unrestricted_Access.Busy;
729 LR : Natural renames Right'Unrestricted_Access.Lock;
734 Dst_Node : Count_Type;
735 pragma Warnings (Off, Dst_Node);
744 L_Node := Left.First;
745 R_Node := Right.First;
748 while R_Node /= 0 loop
752 Src_Node => Right.Nodes (R_Node),
753 Dst_Node => Dst_Node);
755 R_Node := Tree_Operations.Next (Right, R_Node);
762 while L_Node /= 0 loop
766 Src_Node => Left.Nodes (L_Node),
767 Dst_Node => Dst_Node);
769 L_Node := Tree_Operations.Next (Left, L_Node);
775 if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
779 Src_Node => Left.Nodes (L_Node),
780 Dst_Node => Dst_Node);
782 L_Node := Tree_Operations.Next (Left, L_Node);
784 elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
788 Src_Node => Right.Nodes (R_Node),
789 Dst_Node => Dst_Node);
791 R_Node := Tree_Operations.Next (Right, R_Node);
794 L_Node := Tree_Operations.Next (Left, L_Node);
795 R_Node := Tree_Operations.Next (Right, R_Node);
815 end Set_Symmetric_Difference;
821 procedure Set_Union (Target : in out Set_Type; Source : Set_Type) is
822 Hint : Count_Type := 0;
824 procedure Process (Node : Count_Type);
825 pragma Inline (Process);
827 procedure Iterate is new Tree_Operations.Generic_Iteration (Process);
833 procedure Process (Node : Count_Type) is
838 Src_Node => Source.Nodes (Node),
842 -- Start of processing for Union
845 if Target'Address = Source'Address then
849 -- Per AI05-0022, the container implementation is required to detect
850 -- element tampering by a generic actual subprogram.
853 BS : Natural renames Source'Unrestricted_Access.Busy;
854 LS : Natural renames Source'Unrestricted_Access.Lock;
860 -- Note that there's no way to decide a priori whether the target has
861 -- enough capacity for the union with source. We cannot simply
862 -- compare the sum of the existing lengths to the capacity of the
863 -- target, because equivalent items from source are not included in
879 function Set_Union (Left, Right : Set_Type) return Set_Type is
881 if Left'Address = Right'Address then
885 if Left.Length = 0 then
889 if Right.Length = 0 then
893 return Result : Set_Type (Left.Length + Right.Length) do
895 BL : Natural renames Left'Unrestricted_Access.Busy;
896 LL : Natural renames Left'Unrestricted_Access.Lock;
898 BR : Natural renames Right'Unrestricted_Access.Busy;
899 LR : Natural renames Right'Unrestricted_Access.Lock;
908 Assign (Target => Result, Source => Left);
910 Insert_Right : declare
911 Hint : Count_Type := 0;
913 procedure Process (Node : Count_Type);
914 pragma Inline (Process);
917 new Tree_Operations.Generic_Iteration (Process);
923 procedure Process (Node : Count_Type) is
928 Src_Node => Right.Nodes (Node),
932 -- Start of processing for Insert_Right
956 end Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations;