1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- A D A . C O N T A I N E R S . R E D _ B L A C K _ T R E E S . --
6 -- G E N E R I C _ S E T _ O P E R A T I O N S --
10 -- Copyright (C) 2004-2005, Free Software Foundation, Inc. --
12 -- This specification is derived from the Ada Reference Manual for use with --
13 -- GNAT. The copyright notice above, and the license provisions that follow --
14 -- apply solely to the contents of the part following the private keyword. --
16 -- GNAT is free software; you can redistribute it and/or modify it under --
17 -- terms of the GNU General Public License as published by the Free Soft- --
18 -- ware Foundation; either version 2, or (at your option) any later ver- --
19 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
20 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
21 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
22 -- for more details. You should have received a copy of the GNU General --
23 -- Public License distributed with GNAT; see file COPYING. If not, write --
24 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
25 -- Boston, MA 02110-1301, USA. --
27 -- As a special exception, if other files instantiate generics from this --
28 -- unit, or you link this unit with other files to produce an executable, --
29 -- this unit does not by itself cause the resulting executable to be --
30 -- covered by the GNU General Public License. This exception does not --
31 -- however invalidate any other reasons why the executable file might be --
32 -- covered by the GNU Public License. --
34 -- This unit was originally developed by Matthew J Heaney. --
35 ------------------------------------------------------------------------------
37 with System; use type System.Address;
39 package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
41 -----------------------
42 -- Local Subprograms --
43 -----------------------
45 procedure Clear (Tree : in out Tree_Type);
47 function Copy (Source : Tree_Type) return Tree_Type;
53 procedure Clear (Tree : in out Tree_Type) is
54 pragma Assert (Tree.Busy = 0);
55 pragma Assert (Tree.Lock = 0);
57 Root : Node_Access := Tree.Root;
72 function Copy (Source : Tree_Type) return Tree_Type is
76 if Source.Length = 0 then
80 Target.Root := Copy_Tree (Source.Root);
81 Target.First := Tree_Operations.Min (Target.Root);
82 Target.Last := Tree_Operations.Max (Target.Root);
83 Target.Length := Source.Length;
92 procedure Difference (Target : in out Tree_Type; Source : Tree_Type) is
93 Tgt : Node_Access := Target.First;
94 Src : Node_Access := Source.First;
97 if Target'Address = Source'Address then
98 if Target.Busy > 0 then
106 if Source.Length = 0 then
110 if Target.Busy > 0 then
123 if Is_Less (Tgt, Src) then
124 Tgt := Tree_Operations.Next (Tgt);
126 elsif Is_Less (Src, Tgt) then
127 Src := Tree_Operations.Next (Src);
131 X : Node_Access := Tgt;
133 Tgt := Tree_Operations.Next (Tgt);
134 Tree_Operations.Delete_Node_Sans_Free (Target, X);
138 Src := Tree_Operations.Next (Src);
143 function Difference (Left, Right : Tree_Type) return Tree_Type is
146 L_Node : Node_Access := Left.First;
147 R_Node : Node_Access := Right.First;
149 Dst_Node : Node_Access;
152 if Left'Address = Right'Address then
153 return Tree; -- Empty set
156 if Left.Length = 0 then
157 return Tree; -- Empty set
160 if Right.Length = 0 then
165 if L_Node = null then
169 if R_Node = null then
170 while L_Node /= null loop
175 Dst_Node => Dst_Node);
177 L_Node := Tree_Operations.Next (L_Node);
184 if Is_Less (L_Node, R_Node) then
189 Dst_Node => Dst_Node);
191 L_Node := Tree_Operations.Next (L_Node);
193 elsif Is_Less (R_Node, L_Node) then
194 R_Node := Tree_Operations.Next (R_Node);
197 L_Node := Tree_Operations.Next (L_Node);
198 R_Node := Tree_Operations.Next (R_Node);
204 Delete_Tree (Tree.Root);
212 procedure Intersection
213 (Target : in out Tree_Type;
216 Tgt : Node_Access := Target.First;
217 Src : Node_Access := Source.First;
220 if Target'Address = Source'Address then
224 if Target.Busy > 0 then
228 if Source.Length = 0 then
236 if Is_Less (Tgt, Src) then
238 X : Node_Access := Tgt;
240 Tgt := Tree_Operations.Next (Tgt);
241 Tree_Operations.Delete_Node_Sans_Free (Target, X);
245 elsif Is_Less (Src, Tgt) then
246 Src := Tree_Operations.Next (Src);
249 Tgt := Tree_Operations.Next (Tgt);
250 Src := Tree_Operations.Next (Src);
254 while Tgt /= null loop
256 X : Node_Access := Tgt;
258 Tgt := Tree_Operations.Next (Tgt);
259 Tree_Operations.Delete_Node_Sans_Free (Target, X);
265 function Intersection (Left, Right : Tree_Type) return Tree_Type is
268 L_Node : Node_Access := Left.First;
269 R_Node : Node_Access := Right.First;
271 Dst_Node : Node_Access;
274 if Left'Address = Right'Address then
279 if L_Node = null then
283 if R_Node = null then
287 if Is_Less (L_Node, R_Node) then
288 L_Node := Tree_Operations.Next (L_Node);
290 elsif Is_Less (R_Node, L_Node) then
291 R_Node := Tree_Operations.Next (R_Node);
298 Dst_Node => Dst_Node);
300 L_Node := Tree_Operations.Next (L_Node);
301 R_Node := Tree_Operations.Next (R_Node);
307 Delete_Tree (Tree.Root);
317 Of_Set : Tree_Type) return Boolean
320 if Subset'Address = Of_Set'Address then
324 if Subset.Length > Of_Set.Length then
329 Subset_Node : Node_Access := Subset.First;
330 Set_Node : Node_Access := Of_Set.First;
334 if Set_Node = null then
335 return Subset_Node = null;
338 if Subset_Node = null then
342 if Is_Less (Subset_Node, Set_Node) then
346 if Is_Less (Set_Node, Subset_Node) then
347 Set_Node := Tree_Operations.Next (Set_Node);
349 Set_Node := Tree_Operations.Next (Set_Node);
350 Subset_Node := Tree_Operations.Next (Subset_Node);
360 function Overlap (Left, Right : Tree_Type) return Boolean is
361 L_Node : Node_Access := Left.First;
362 R_Node : Node_Access := Right.First;
365 if Left'Address = Right'Address then
366 return Left.Length /= 0;
371 or else R_Node = null
376 if Is_Less (L_Node, R_Node) then
377 L_Node := Tree_Operations.Next (L_Node);
379 elsif Is_Less (R_Node, L_Node) then
380 R_Node := Tree_Operations.Next (R_Node);
388 --------------------------
389 -- Symmetric_Difference --
390 --------------------------
392 procedure Symmetric_Difference
393 (Target : in out Tree_Type;
396 Tgt : Node_Access := Target.First;
397 Src : Node_Access := Source.First;
399 New_Tgt_Node : Node_Access;
402 if Target.Busy > 0 then
406 if Target'Address = Source'Address then
413 while Src /= null loop
418 Dst_Node => New_Tgt_Node);
420 Src := Tree_Operations.Next (Src);
430 if Is_Less (Tgt, Src) then
431 Tgt := Tree_Operations.Next (Tgt);
433 elsif Is_Less (Src, Tgt) then
438 Dst_Node => New_Tgt_Node);
440 Src := Tree_Operations.Next (Src);
444 X : Node_Access := Tgt;
446 Tgt := Tree_Operations.Next (Tgt);
447 Tree_Operations.Delete_Node_Sans_Free (Target, X);
451 Src := Tree_Operations.Next (Src);
454 end Symmetric_Difference;
456 function Symmetric_Difference (Left, Right : Tree_Type) return Tree_Type is
459 L_Node : Node_Access := Left.First;
460 R_Node : Node_Access := Right.First;
462 Dst_Node : Node_Access;
465 if Left'Address = Right'Address then
466 return Tree; -- Empty set
469 if Right.Length = 0 then
473 if Left.Length = 0 then
478 if L_Node = null then
479 while R_Node /= null loop
484 Dst_Node => Dst_Node);
485 R_Node := Tree_Operations.Next (R_Node);
491 if R_Node = null then
492 while L_Node /= null loop
497 Dst_Node => Dst_Node);
499 L_Node := Tree_Operations.Next (L_Node);
505 if Is_Less (L_Node, R_Node) then
510 Dst_Node => Dst_Node);
512 L_Node := Tree_Operations.Next (L_Node);
514 elsif Is_Less (R_Node, L_Node) then
519 Dst_Node => Dst_Node);
521 R_Node := Tree_Operations.Next (R_Node);
524 L_Node := Tree_Operations.Next (L_Node);
525 R_Node := Tree_Operations.Next (R_Node);
531 Delete_Tree (Tree.Root);
533 end Symmetric_Difference;
539 procedure Union (Target : in out Tree_Type; Source : Tree_Type)
543 procedure Process (Node : Node_Access);
544 pragma Inline (Process);
546 procedure Iterate is new Tree_Operations.Generic_Iteration (Process);
552 procedure Process (Node : Node_Access) is
561 -- Start of processing for Union
564 if Target'Address = Source'Address then
568 if Target.Busy > 0 then
575 function Union (Left, Right : Tree_Type) return Tree_Type is
577 if Left'Address = Right'Address then
581 if Left.Length = 0 then
585 if Right.Length = 0 then
590 Tree : Tree_Type := Copy (Left);
594 procedure Process (Node : Node_Access);
595 pragma Inline (Process);
598 new Tree_Operations.Generic_Iteration (Process);
604 procedure Process (Node : Node_Access) is
613 -- Start of processing for Union
621 Delete_Tree (Tree.Root);
627 end Ada.Containers.Red_Black_Trees.Generic_Set_Operations;