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-2006, Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- This unit was originally developed by Matthew J Heaney. --
31 ------------------------------------------------------------------------------
33 with System; use type System.Address;
35 package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
37 -----------------------
38 -- Local Subprograms --
39 -----------------------
41 procedure Clear (Tree : in out Tree_Type);
43 function Copy (Source : Tree_Type) return Tree_Type;
49 procedure Clear (Tree : in out Tree_Type) is
50 pragma Assert (Tree.Busy = 0);
51 pragma Assert (Tree.Lock = 0);
53 Root : Node_Access := Tree.Root;
68 function Copy (Source : Tree_Type) return Tree_Type is
72 if Source.Length = 0 then
76 Target.Root := Copy_Tree (Source.Root);
77 Target.First := Tree_Operations.Min (Target.Root);
78 Target.Last := Tree_Operations.Max (Target.Root);
79 Target.Length := Source.Length;
88 procedure Difference (Target : in out Tree_Type; Source : Tree_Type) is
89 Tgt : Node_Access := Target.First;
90 Src : Node_Access := Source.First;
93 if Target'Address = Source'Address then
94 if Target.Busy > 0 then
95 raise Program_Error with
96 "attempt to tamper with cursors (container is busy)";
103 if Source.Length = 0 then
107 if Target.Busy > 0 then
108 raise Program_Error with
109 "attempt to tamper with cursors (container is busy)";
121 if Is_Less (Tgt, Src) then
122 Tgt := Tree_Operations.Next (Tgt);
124 elsif Is_Less (Src, Tgt) then
125 Src := Tree_Operations.Next (Src);
129 X : Node_Access := Tgt;
131 Tgt := Tree_Operations.Next (Tgt);
132 Tree_Operations.Delete_Node_Sans_Free (Target, X);
136 Src := Tree_Operations.Next (Src);
141 function Difference (Left, Right : Tree_Type) return Tree_Type is
144 L_Node : Node_Access := Left.First;
145 R_Node : Node_Access := Right.First;
147 Dst_Node : Node_Access;
150 if Left'Address = Right'Address then
151 return Tree; -- Empty set
154 if Left.Length = 0 then
155 return Tree; -- Empty set
158 if Right.Length = 0 then
163 if L_Node = null then
167 if R_Node = null then
168 while L_Node /= null loop
173 Dst_Node => Dst_Node);
175 L_Node := Tree_Operations.Next (L_Node);
182 if Is_Less (L_Node, R_Node) then
187 Dst_Node => Dst_Node);
189 L_Node := Tree_Operations.Next (L_Node);
191 elsif Is_Less (R_Node, L_Node) then
192 R_Node := Tree_Operations.Next (R_Node);
195 L_Node := Tree_Operations.Next (L_Node);
196 R_Node := Tree_Operations.Next (R_Node);
202 Delete_Tree (Tree.Root);
210 procedure Intersection
211 (Target : in out Tree_Type;
214 Tgt : Node_Access := Target.First;
215 Src : Node_Access := Source.First;
218 if Target'Address = Source'Address then
222 if Target.Busy > 0 then
223 raise Program_Error with
224 "attempt to tamper with cursors (container is busy)";
227 if Source.Length = 0 then
235 if Is_Less (Tgt, Src) then
237 X : Node_Access := Tgt;
239 Tgt := Tree_Operations.Next (Tgt);
240 Tree_Operations.Delete_Node_Sans_Free (Target, X);
244 elsif Is_Less (Src, Tgt) then
245 Src := Tree_Operations.Next (Src);
248 Tgt := Tree_Operations.Next (Tgt);
249 Src := Tree_Operations.Next (Src);
253 while Tgt /= null loop
255 X : Node_Access := Tgt;
257 Tgt := Tree_Operations.Next (Tgt);
258 Tree_Operations.Delete_Node_Sans_Free (Target, X);
264 function Intersection (Left, Right : Tree_Type) return Tree_Type is
267 L_Node : Node_Access := Left.First;
268 R_Node : Node_Access := Right.First;
270 Dst_Node : Node_Access;
273 if Left'Address = Right'Address then
278 if L_Node = null then
282 if R_Node = null then
286 if Is_Less (L_Node, R_Node) then
287 L_Node := Tree_Operations.Next (L_Node);
289 elsif Is_Less (R_Node, L_Node) then
290 R_Node := Tree_Operations.Next (R_Node);
297 Dst_Node => Dst_Node);
299 L_Node := Tree_Operations.Next (L_Node);
300 R_Node := Tree_Operations.Next (R_Node);
306 Delete_Tree (Tree.Root);
316 Of_Set : Tree_Type) return Boolean
319 if Subset'Address = Of_Set'Address then
323 if Subset.Length > Of_Set.Length then
328 Subset_Node : Node_Access := Subset.First;
329 Set_Node : Node_Access := Of_Set.First;
333 if Set_Node = null then
334 return Subset_Node = null;
337 if Subset_Node = null then
341 if Is_Less (Subset_Node, Set_Node) then
345 if Is_Less (Set_Node, Subset_Node) then
346 Set_Node := Tree_Operations.Next (Set_Node);
348 Set_Node := Tree_Operations.Next (Set_Node);
349 Subset_Node := Tree_Operations.Next (Subset_Node);
359 function Overlap (Left, Right : Tree_Type) return Boolean is
360 L_Node : Node_Access := Left.First;
361 R_Node : Node_Access := Right.First;
364 if Left'Address = Right'Address then
365 return Left.Length /= 0;
370 or else R_Node = null
375 if Is_Less (L_Node, R_Node) then
376 L_Node := Tree_Operations.Next (L_Node);
378 elsif Is_Less (R_Node, L_Node) then
379 R_Node := Tree_Operations.Next (R_Node);
387 --------------------------
388 -- Symmetric_Difference --
389 --------------------------
391 procedure Symmetric_Difference
392 (Target : in out Tree_Type;
395 Tgt : Node_Access := Target.First;
396 Src : Node_Access := Source.First;
398 New_Tgt_Node : Node_Access;
401 if Target.Busy > 0 then
402 raise Program_Error with
403 "attempt to tamper with cursors (container is busy)";
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
569 raise Program_Error with
570 "attempt to tamper with cursors (container is busy)";
576 function Union (Left, Right : Tree_Type) return Tree_Type is
578 if Left'Address = Right'Address then
582 if Left.Length = 0 then
586 if Right.Length = 0 then
591 Tree : Tree_Type := Copy (Left);
595 procedure Process (Node : Node_Access);
596 pragma Inline (Process);
599 new Tree_Operations.Generic_Iteration (Process);
605 procedure Process (Node : Node_Access) is
614 -- Start of processing for Union
622 Delete_Tree (Tree.Root);
628 end Ada.Containers.Red_Black_Trees.Generic_Set_Operations;