1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_BOUNDED_SET_OPERATIONS --
9 -- Copyright (C) 2004-2011, 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 Tgt, Src : Count_Type;
58 TN : Nodes_Type renames Target.Nodes;
59 SN : Nodes_Type renames Source.Nodes;
62 if Target'Address = Source'Address then
63 if Target.Busy > 0 then
64 raise Program_Error with
65 "attempt to tamper with cursors (container is busy)";
68 Tree_Operations.Clear_Tree (Target);
72 if Source.Length = 0 then
76 if Target.Busy > 0 then
77 raise Program_Error with
78 "attempt to tamper with cursors (container is busy)";
92 if Is_Less (TN (Tgt), SN (Src)) then
93 Tgt := Tree_Operations.Next (Target, Tgt);
95 elsif Is_Less (SN (Src), TN (Tgt)) then
96 Src := Tree_Operations.Next (Source, Src);
100 X : constant Count_Type := Tgt;
102 Tgt := Tree_Operations.Next (Target, Tgt);
104 Tree_Operations.Delete_Node_Sans_Free (Target, X);
105 Tree_Operations.Free (Target, X);
108 Src := Tree_Operations.Next (Source, Src);
113 function Set_Difference (Left, Right : Set_Type) return Set_Type is
117 Dst_Node : Count_Type;
118 pragma Warnings (Off, Dst_Node);
121 if Left'Address = Right'Address then
122 return S : Set_Type (0); -- Empty set
125 if Left.Length = 0 then
126 return S : Set_Type (0); -- Empty set
129 if Right.Length = 0 then
133 return Result : Set_Type (Left.Length) do
134 L_Node := Left.First;
135 R_Node := Right.First;
142 while L_Node /= 0 loop
146 Src_Node => Left.Nodes (L_Node),
147 Dst_Node => Dst_Node);
149 L_Node := Tree_Operations.Next (Left, L_Node);
155 if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
159 Src_Node => Left.Nodes (L_Node),
160 Dst_Node => Dst_Node);
162 L_Node := Tree_Operations.Next (Left, L_Node);
164 elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
165 R_Node := Tree_Operations.Next (Right, R_Node);
168 L_Node := Tree_Operations.Next (Left, L_Node);
169 R_Node := Tree_Operations.Next (Right, R_Node);
179 procedure Set_Intersection
180 (Target : in out Set_Type;
187 if Target'Address = Source'Address then
191 if Target.Busy > 0 then
192 raise Program_Error with
193 "attempt to tamper with cursors (container is busy)";
196 if Source.Length = 0 then
197 Tree_Operations.Clear_Tree (Target);
206 if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then
208 X : constant Count_Type := Tgt;
210 Tgt := Tree_Operations.Next (Target, Tgt);
212 Tree_Operations.Delete_Node_Sans_Free (Target, X);
213 Tree_Operations.Free (Target, X);
216 elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then
217 Src := Tree_Operations.Next (Source, Src);
220 Tgt := Tree_Operations.Next (Target, Tgt);
221 Src := Tree_Operations.Next (Source, Src);
227 X : constant Count_Type := Tgt;
229 Tgt := Tree_Operations.Next (Target, Tgt);
231 Tree_Operations.Delete_Node_Sans_Free (Target, X);
232 Tree_Operations.Free (Target, X);
235 end Set_Intersection;
237 function Set_Intersection (Left, Right : Set_Type) return Set_Type is
241 Dst_Node : Count_Type;
242 pragma Warnings (Off, Dst_Node);
245 if Left'Address = Right'Address then
249 return Result : Set_Type (Count_Type'Min (Left.Length, Right.Length)) do
250 L_Node := Left.First;
251 R_Node := Right.First;
261 if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
262 L_Node := Tree_Operations.Next (Left, L_Node);
264 elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
265 R_Node := Tree_Operations.Next (Right, R_Node);
271 Src_Node => Left.Nodes (L_Node),
272 Dst_Node => Dst_Node);
274 L_Node := Tree_Operations.Next (Left, L_Node);
275 R_Node := Tree_Operations.Next (Right, R_Node);
279 end Set_Intersection;
287 Of_Set : Set_Type) return Boolean
289 Subset_Node : Count_Type;
290 Set_Node : Count_Type;
293 if Subset'Address = Of_Set'Address then
297 if Subset.Length > Of_Set.Length then
301 Subset_Node := Subset.First;
302 Set_Node := Of_Set.First;
305 return Subset_Node = 0;
308 if Subset_Node = 0 then
312 if Is_Less (Subset.Nodes (Subset_Node), Of_Set.Nodes (Set_Node)) then
316 if Is_Less (Of_Set.Nodes (Set_Node), Subset.Nodes (Subset_Node)) then
317 Set_Node := Tree_Operations.Next (Of_Set, Set_Node);
319 Set_Node := Tree_Operations.Next (Of_Set, Set_Node);
320 Subset_Node := Tree_Operations.Next (Subset, Subset_Node);
329 function Set_Overlap (Left, Right : Set_Type) return Boolean is
334 if Left'Address = Right'Address then
335 return Left.Length /= 0;
338 L_Node := Left.First;
339 R_Node := Right.First;
347 if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
348 L_Node := Tree_Operations.Next (Left, L_Node);
350 elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
351 R_Node := Tree_Operations.Next (Right, R_Node);
359 --------------------------
360 -- Symmetric_Difference --
361 --------------------------
363 procedure Set_Symmetric_Difference
364 (Target : in out Set_Type;
370 New_Tgt_Node : Count_Type;
371 pragma Warnings (Off, New_Tgt_Node);
374 if Target.Busy > 0 then
375 raise Program_Error with
376 "attempt to tamper with cursors (container is busy)";
379 if Target'Address = Source'Address then
380 Tree_Operations.Clear_Tree (Target);
392 Src_Node => Source.Nodes (Src),
393 Dst_Node => New_Tgt_Node);
395 Src := Tree_Operations.Next (Source, Src);
405 if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then
406 Tgt := Tree_Operations.Next (Target, Tgt);
408 elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then
412 Src_Node => Source.Nodes (Src),
413 Dst_Node => New_Tgt_Node);
415 Src := Tree_Operations.Next (Source, Src);
419 X : constant Count_Type := Tgt;
421 Tgt := Tree_Operations.Next (Target, Tgt);
423 Tree_Operations.Delete_Node_Sans_Free (Target, X);
424 Tree_Operations.Free (Target, X);
427 Src := Tree_Operations.Next (Source, Src);
430 end Set_Symmetric_Difference;
432 function Set_Symmetric_Difference
433 (Left, Right : Set_Type) return Set_Type
438 Dst_Node : Count_Type;
439 pragma Warnings (Off, Dst_Node);
442 if Left'Address = Right'Address then
443 return S : Set_Type (0); -- Empty set
446 if Right.Length = 0 then
450 if Left.Length = 0 then
454 return Result : Set_Type (Left.Length + Right.Length) do
455 L_Node := Left.First;
456 R_Node := Right.First;
459 while R_Node /= 0 loop
463 Src_Node => Right.Nodes (R_Node),
464 Dst_Node => Dst_Node);
466 R_Node := Tree_Operations.Next (Right, R_Node);
473 while L_Node /= 0 loop
477 Src_Node => Left.Nodes (L_Node),
478 Dst_Node => Dst_Node);
480 L_Node := Tree_Operations.Next (Left, L_Node);
486 if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
490 Src_Node => Left.Nodes (L_Node),
491 Dst_Node => Dst_Node);
493 L_Node := Tree_Operations.Next (Left, L_Node);
495 elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
499 Src_Node => Right.Nodes (R_Node),
500 Dst_Node => Dst_Node);
502 R_Node := Tree_Operations.Next (Right, R_Node);
505 L_Node := Tree_Operations.Next (Left, L_Node);
506 R_Node := Tree_Operations.Next (Right, R_Node);
510 end Set_Symmetric_Difference;
516 procedure Set_Union (Target : in out Set_Type; Source : Set_Type) is
517 Hint : Count_Type := 0;
519 procedure Process (Node : Count_Type);
520 pragma Inline (Process);
522 procedure Iterate is new Tree_Operations.Generic_Iteration (Process);
528 procedure Process (Node : Count_Type) is
533 Src_Node => Source.Nodes (Node),
537 -- Start of processing for Union
540 if Target'Address = Source'Address then
544 if Target.Busy > 0 then
545 raise Program_Error with
546 "attempt to tamper with cursors (container is busy)";
549 -- Note that there's no way to decide a priori whether the target has
550 -- enough capacity for the union with source. We cannot simply compare
551 -- the sum of the existing lengths to the capacity of the target,
552 -- because equivalent items from source are not included in the union.
557 function Set_Union (Left, Right : Set_Type) return Set_Type is
559 if Left'Address = Right'Address then
563 if Left.Length = 0 then
567 if Right.Length = 0 then
571 return Result : Set_Type (Left.Length + Right.Length) do
572 Assign (Target => Result, Source => Left);
574 Insert_Right : declare
575 Hint : Count_Type := 0;
577 procedure Process (Node : Count_Type);
578 pragma Inline (Process);
581 new Tree_Operations.Generic_Iteration (Process);
587 procedure Process (Node : Count_Type) is
592 Src_Node => Right.Nodes (Node),
596 -- Start of processing for Insert_Right
604 end Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations;