1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_SET_OPERATIONS --
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 package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
42 procedure Difference (Target : in out Tree_Type; Source : Tree_Type) is
43 Tgt : Node_Access := Target.First;
44 Src : Node_Access := Source.First;
48 -- NOTE: must be done by client:
49 -- if Target'Address = Source'Address then
55 if Tgt = Tree_Operations.Null_Node then
59 if Src = Tree_Operations.Null_Node then
63 if Is_Less (Tgt, Src) then
64 Tgt := Tree_Operations.Next (Tgt);
66 elsif Is_Less (Src, Tgt) then
67 Src := Tree_Operations.Next (Src);
71 X : Node_Access := Tgt;
73 Tgt := Tree_Operations.Next (Tgt);
74 Tree_Operations.Delete_Node_Sans_Free (Target, X);
78 Src := Tree_Operations.Next (Src);
83 function Difference (Left, Right : Tree_Type) return Tree_Type is
84 Tree : Tree_Type := (Length => 0, others => Tree_Operations.Null_Node);
86 L_Node : Node_Access := Left.First;
87 R_Node : Node_Access := Right.First;
89 Dst_Node : Node_Access;
92 -- NOTE: must by done by client:
93 -- if Left'Address = Right'Address then
98 if L_Node = Tree_Operations.Null_Node then
102 if R_Node = Tree_Operations.Null_Node then
103 while L_Node /= Tree_Operations.Null_Node loop
106 Dst_Hint => Tree_Operations.Null_Node,
108 Dst_Node => Dst_Node);
110 L_Node := Tree_Operations.Next (L_Node);
117 if Is_Less (L_Node, R_Node) then
120 Dst_Hint => Tree_Operations.Null_Node,
122 Dst_Node => Dst_Node);
124 L_Node := Tree_Operations.Next (L_Node);
126 elsif Is_Less (R_Node, L_Node) then
127 R_Node := Tree_Operations.Next (R_Node);
130 L_Node := Tree_Operations.Next (L_Node);
131 R_Node := Tree_Operations.Next (R_Node);
137 Delete_Tree (Tree.Root);
145 procedure Intersection
146 (Target : in out Tree_Type;
149 Tgt : Node_Access := Target.First;
150 Src : Node_Access := Source.First;
153 -- NOTE: must be done by caller: ???
154 -- if Target'Address = Source'Address then
158 while Tgt /= Tree_Operations.Null_Node
159 and then Src /= Tree_Operations.Null_Node
161 if Is_Less (Tgt, Src) then
163 X : Node_Access := Tgt;
165 Tgt := Tree_Operations.Next (Tgt);
166 Tree_Operations.Delete_Node_Sans_Free (Target, X);
170 elsif Is_Less (Src, Tgt) then
171 Src := Tree_Operations.Next (Src);
174 Tgt := Tree_Operations.Next (Tgt);
175 Src := Tree_Operations.Next (Src);
180 function Intersection (Left, Right : Tree_Type) return Tree_Type is
181 Tree : Tree_Type := (Length => 0, others => Tree_Operations.Null_Node);
183 L_Node : Node_Access := Left.First;
184 R_Node : Node_Access := Right.First;
186 Dst_Node : Node_Access;
189 -- NOTE: must be done by caller: ???
190 -- if Left'Address = Right'Address then
195 if L_Node = Tree_Operations.Null_Node then
199 if R_Node = Tree_Operations.Null_Node then
203 if Is_Less (L_Node, R_Node) then
204 L_Node := Tree_Operations.Next (L_Node);
206 elsif Is_Less (R_Node, L_Node) then
207 R_Node := Tree_Operations.Next (R_Node);
212 Dst_Hint => Tree_Operations.Null_Node,
214 Dst_Node => Dst_Node);
216 L_Node := Tree_Operations.Next (L_Node);
217 R_Node := Tree_Operations.Next (R_Node);
223 Delete_Tree (Tree.Root);
233 Of_Set : Tree_Type) return Boolean
236 -- NOTE: must by done by caller:
237 -- if Subset'Address = Of_Set'Address then
241 if Subset.Length > Of_Set.Length then
246 Subset_Node : Node_Access := Subset.First;
247 Set_Node : Node_Access := Of_Set.First;
251 if Set_Node = Tree_Operations.Null_Node then
252 return Subset_Node = Tree_Operations.Null_Node;
255 if Subset_Node = Tree_Operations.Null_Node then
259 if Is_Less (Subset_Node, Set_Node) then
263 if Is_Less (Set_Node, Subset_Node) then
264 Set_Node := Tree_Operations.Next (Set_Node);
266 Set_Node := Tree_Operations.Next (Set_Node);
267 Subset_Node := Tree_Operations.Next (Subset_Node);
277 function Overlap (Left, Right : Tree_Type) return Boolean is
278 L_Node : Node_Access := Left.First;
279 R_Node : Node_Access := Right.First;
282 -- NOTE: must be done by caller: ???
283 -- if Left'Address = Right'Address then
284 -- return Left.Tree.Length /= 0;
288 if L_Node = Tree_Operations.Null_Node
289 or else R_Node = Tree_Operations.Null_Node
294 if Is_Less (L_Node, R_Node) then
295 L_Node := Tree_Operations.Next (L_Node);
297 elsif Is_Less (R_Node, L_Node) then
298 R_Node := Tree_Operations.Next (R_Node);
306 --------------------------
307 -- Symmetric_Difference --
308 --------------------------
310 procedure Symmetric_Difference
311 (Target : in out Tree_Type;
314 Tgt : Node_Access := Target.First;
315 Src : Node_Access := Source.First;
317 New_Tgt_Node : Node_Access;
320 -- NOTE: must by done by client: ???
321 -- if Target'Address = Source'Address then
327 if Tgt = Tree_Operations.Null_Node then
328 while Src /= Tree_Operations.Null_Node loop
331 Dst_Hint => Tree_Operations.Null_Node,
333 Dst_Node => New_Tgt_Node);
335 Src := Tree_Operations.Next (Src);
341 if Src = Tree_Operations.Null_Node then
345 if Is_Less (Tgt, Src) then
346 Tgt := Tree_Operations.Next (Tgt);
348 elsif Is_Less (Src, Tgt) then
353 Dst_Node => New_Tgt_Node);
355 Src := Tree_Operations.Next (Src);
359 X : Node_Access := Tgt;
361 Tgt := Tree_Operations.Next (Tgt);
362 Tree_Operations.Delete_Node_Sans_Free (Target, X);
366 Src := Tree_Operations.Next (Src);
369 end Symmetric_Difference;
371 function Symmetric_Difference (Left, Right : Tree_Type) return Tree_Type is
372 Tree : Tree_Type := (Length => 0, others => Tree_Operations.Null_Node);
374 L_Node : Node_Access := Left.First;
375 R_Node : Node_Access := Right.First;
377 Dst_Node : Node_Access;
380 -- NOTE: must by done by caller ???
381 -- if Left'Address = Right'Address then
386 if L_Node = Tree_Operations.Null_Node then
387 while R_Node /= Tree_Operations.Null_Node loop
390 Dst_Hint => Tree_Operations.Null_Node,
392 Dst_Node => Dst_Node);
393 R_Node := Tree_Operations.Next (R_Node);
399 if R_Node = Tree_Operations.Null_Node then
400 while L_Node /= Tree_Operations.Null_Node loop
403 Dst_Hint => Tree_Operations.Null_Node,
405 Dst_Node => Dst_Node);
407 L_Node := Tree_Operations.Next (L_Node);
413 if Is_Less (L_Node, R_Node) then
416 Dst_Hint => Tree_Operations.Null_Node,
418 Dst_Node => Dst_Node);
420 L_Node := Tree_Operations.Next (L_Node);
422 elsif Is_Less (R_Node, L_Node) then
425 Dst_Hint => Tree_Operations.Null_Node,
427 Dst_Node => Dst_Node);
429 R_Node := Tree_Operations.Next (R_Node);
432 L_Node := Tree_Operations.Next (L_Node);
433 R_Node := Tree_Operations.Next (R_Node);
439 Delete_Tree (Tree.Root);
441 end Symmetric_Difference;
447 procedure Union (Target : in out Tree_Type; Source : Tree_Type)
451 procedure Process (Node : Node_Access);
452 pragma Inline (Process);
454 procedure Iterate is new Tree_Operations.Generic_Iteration (Process);
460 procedure Process (Node : Node_Access) is
469 -- Start of processing for Union
472 -- NOTE: must be done by caller: ???
473 -- if Target'Address = Source'Address then
480 function Union (Left, Right : Tree_Type) return Tree_Type is
484 -- NOTE: must be done by caller:
485 -- if Left'Address = Right'Address then
490 Root : constant Node_Access := Copy_Tree (Left.Root);
492 Tree := (Root => Root,
493 First => Tree_Operations.Min (Root),
494 Last => Tree_Operations.Max (Root),
495 Length => Left.Length);
501 procedure Process (Node : Node_Access);
502 pragma Inline (Process);
505 new Tree_Operations.Generic_Iteration (Process);
511 procedure Process (Node : Node_Access) is
520 -- Start of processing for Union
527 Delete_Tree (Tree.Root);
534 end Ada.Containers.Red_Black_Trees.Generic_Set_Operations;