diff options
Diffstat (limited to 'gcc-4.4.3/gcc/ada/a-rbtgso.adb')
| -rw-r--r-- | gcc-4.4.3/gcc/ada/a-rbtgso.adb | 630 |
1 files changed, 0 insertions, 630 deletions
diff --git a/gcc-4.4.3/gcc/ada/a-rbtgso.adb b/gcc-4.4.3/gcc/ada/a-rbtgso.adb deleted file mode 100644 index 2b9b54024..000000000 --- a/gcc-4.4.3/gcc/ada/a-rbtgso.adb +++ /dev/null @@ -1,630 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT LIBRARY COMPONENTS -- --- -- --- ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_SET_OPERATIONS -- --- -- --- B o d y -- --- -- --- Copyright (C) 2004-2009, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- This unit was originally developed by Matthew J Heaney. -- ------------------------------------------------------------------------------- - -with System; use type System.Address; - -package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is - - ----------------------- - -- Local Subprograms -- - ----------------------- - - procedure Clear (Tree : in out Tree_Type); - - function Copy (Source : Tree_Type) return Tree_Type; - - ----------- - -- Clear -- - ----------- - - procedure Clear (Tree : in out Tree_Type) is - pragma Assert (Tree.Busy = 0); - pragma Assert (Tree.Lock = 0); - - Root : Node_Access := Tree.Root; - pragma Warnings (Off, Root); - - begin - Tree.Root := null; - Tree.First := null; - Tree.Last := null; - Tree.Length := 0; - - Delete_Tree (Root); - end Clear; - - ---------- - -- Copy -- - ---------- - - function Copy (Source : Tree_Type) return Tree_Type is - Target : Tree_Type; - - begin - if Source.Length = 0 then - return Target; - end if; - - Target.Root := Copy_Tree (Source.Root); - Target.First := Tree_Operations.Min (Target.Root); - Target.Last := Tree_Operations.Max (Target.Root); - Target.Length := Source.Length; - - return Target; - end Copy; - - ---------------- - -- Difference -- - ---------------- - - procedure Difference (Target : in out Tree_Type; Source : Tree_Type) is - Tgt : Node_Access := Target.First; - Src : Node_Access := Source.First; - - begin - if Target'Address = Source'Address then - if Target.Busy > 0 then - raise Program_Error with - "attempt to tamper with cursors (container is busy)"; - end if; - - Clear (Target); - return; - end if; - - if Source.Length = 0 then - return; - end if; - - if Target.Busy > 0 then - raise Program_Error with - "attempt to tamper with cursors (container is busy)"; - end if; - - loop - if Tgt = null then - return; - end if; - - if Src = null then - return; - end if; - - if Is_Less (Tgt, Src) then - Tgt := Tree_Operations.Next (Tgt); - - elsif Is_Less (Src, Tgt) then - Src := Tree_Operations.Next (Src); - - else - declare - X : Node_Access := Tgt; - begin - Tgt := Tree_Operations.Next (Tgt); - Tree_Operations.Delete_Node_Sans_Free (Target, X); - Free (X); - end; - - Src := Tree_Operations.Next (Src); - end if; - end loop; - end Difference; - - function Difference (Left, Right : Tree_Type) return Tree_Type is - Tree : Tree_Type; - - L_Node : Node_Access := Left.First; - R_Node : Node_Access := Right.First; - - Dst_Node : Node_Access; - pragma Warnings (Off, Dst_Node); - - begin - if Left'Address = Right'Address then - return Tree; -- Empty set - end if; - - if Left.Length = 0 then - return Tree; -- Empty set - end if; - - if Right.Length = 0 then - return Copy (Left); - end if; - - loop - if L_Node = null then - return Tree; - end if; - - if R_Node = null then - while L_Node /= null loop - Insert_With_Hint - (Dst_Tree => Tree, - Dst_Hint => null, - Src_Node => L_Node, - Dst_Node => Dst_Node); - - L_Node := Tree_Operations.Next (L_Node); - - end loop; - - return Tree; - end if; - - if Is_Less (L_Node, R_Node) then - Insert_With_Hint - (Dst_Tree => Tree, - Dst_Hint => null, - Src_Node => L_Node, - Dst_Node => Dst_Node); - - L_Node := Tree_Operations.Next (L_Node); - - elsif Is_Less (R_Node, L_Node) then - R_Node := Tree_Operations.Next (R_Node); - - else - L_Node := Tree_Operations.Next (L_Node); - R_Node := Tree_Operations.Next (R_Node); - end if; - end loop; - - exception - when others => - Delete_Tree (Tree.Root); - raise; - end Difference; - - ------------------ - -- Intersection -- - ------------------ - - procedure Intersection - (Target : in out Tree_Type; - Source : Tree_Type) - is - Tgt : Node_Access := Target.First; - Src : Node_Access := Source.First; - - begin - if Target'Address = Source'Address then - return; - end if; - - if Target.Busy > 0 then - raise Program_Error with - "attempt to tamper with cursors (container is busy)"; - end if; - - if Source.Length = 0 then - Clear (Target); - return; - end if; - - while Tgt /= null - and then Src /= null - loop - if Is_Less (Tgt, Src) then - declare - X : Node_Access := Tgt; - begin - Tgt := Tree_Operations.Next (Tgt); - Tree_Operations.Delete_Node_Sans_Free (Target, X); - Free (X); - end; - - elsif Is_Less (Src, Tgt) then - Src := Tree_Operations.Next (Src); - - else - Tgt := Tree_Operations.Next (Tgt); - Src := Tree_Operations.Next (Src); - end if; - end loop; - - while Tgt /= null loop - declare - X : Node_Access := Tgt; - begin - Tgt := Tree_Operations.Next (Tgt); - Tree_Operations.Delete_Node_Sans_Free (Target, X); - Free (X); - end; - end loop; - end Intersection; - - function Intersection (Left, Right : Tree_Type) return Tree_Type is - Tree : Tree_Type; - - L_Node : Node_Access := Left.First; - R_Node : Node_Access := Right.First; - - Dst_Node : Node_Access; - pragma Warnings (Off, Dst_Node); - - begin - if Left'Address = Right'Address then - return Copy (Left); - end if; - - loop - if L_Node = null then - return Tree; - end if; - - if R_Node = null then - return Tree; - end if; - - if Is_Less (L_Node, R_Node) then - L_Node := Tree_Operations.Next (L_Node); - - elsif Is_Less (R_Node, L_Node) then - R_Node := Tree_Operations.Next (R_Node); - - else - Insert_With_Hint - (Dst_Tree => Tree, - Dst_Hint => null, - Src_Node => L_Node, - Dst_Node => Dst_Node); - - L_Node := Tree_Operations.Next (L_Node); - R_Node := Tree_Operations.Next (R_Node); - end if; - end loop; - - exception - when others => - Delete_Tree (Tree.Root); - raise; - end Intersection; - - --------------- - -- Is_Subset -- - --------------- - - function Is_Subset - (Subset : Tree_Type; - Of_Set : Tree_Type) return Boolean - is - begin - if Subset'Address = Of_Set'Address then - return True; - end if; - - if Subset.Length > Of_Set.Length then - return False; - end if; - - declare - Subset_Node : Node_Access := Subset.First; - Set_Node : Node_Access := Of_Set.First; - - begin - loop - if Set_Node = null then - return Subset_Node = null; - end if; - - if Subset_Node = null then - return True; - end if; - - if Is_Less (Subset_Node, Set_Node) then - return False; - end if; - - if Is_Less (Set_Node, Subset_Node) then - Set_Node := Tree_Operations.Next (Set_Node); - else - Set_Node := Tree_Operations.Next (Set_Node); - Subset_Node := Tree_Operations.Next (Subset_Node); - end if; - end loop; - end; - end Is_Subset; - - ------------- - -- Overlap -- - ------------- - - function Overlap (Left, Right : Tree_Type) return Boolean is - L_Node : Node_Access := Left.First; - R_Node : Node_Access := Right.First; - - begin - if Left'Address = Right'Address then - return Left.Length /= 0; - end if; - - loop - if L_Node = null - or else R_Node = null - then - return False; - end if; - - if Is_Less (L_Node, R_Node) then - L_Node := Tree_Operations.Next (L_Node); - - elsif Is_Less (R_Node, L_Node) then - R_Node := Tree_Operations.Next (R_Node); - - else - return True; - end if; - end loop; - end Overlap; - - -------------------------- - -- Symmetric_Difference -- - -------------------------- - - procedure Symmetric_Difference - (Target : in out Tree_Type; - Source : Tree_Type) - is - Tgt : Node_Access := Target.First; - Src : Node_Access := Source.First; - - New_Tgt_Node : Node_Access; - pragma Warnings (Off, New_Tgt_Node); - - begin - if Target.Busy > 0 then - raise Program_Error with - "attempt to tamper with cursors (container is busy)"; - end if; - - if Target'Address = Source'Address then - Clear (Target); - return; - end if; - - loop - if Tgt = null then - while Src /= null loop - Insert_With_Hint - (Dst_Tree => Target, - Dst_Hint => null, - Src_Node => Src, - Dst_Node => New_Tgt_Node); - - Src := Tree_Operations.Next (Src); - end loop; - - return; - end if; - - if Src = null then - return; - end if; - - if Is_Less (Tgt, Src) then - Tgt := Tree_Operations.Next (Tgt); - - elsif Is_Less (Src, Tgt) then - Insert_With_Hint - (Dst_Tree => Target, - Dst_Hint => Tgt, - Src_Node => Src, - Dst_Node => New_Tgt_Node); - - Src := Tree_Operations.Next (Src); - - else - declare - X : Node_Access := Tgt; - begin - Tgt := Tree_Operations.Next (Tgt); - Tree_Operations.Delete_Node_Sans_Free (Target, X); - Free (X); - end; - - Src := Tree_Operations.Next (Src); - end if; - end loop; - end Symmetric_Difference; - - function Symmetric_Difference (Left, Right : Tree_Type) return Tree_Type is - Tree : Tree_Type; - - L_Node : Node_Access := Left.First; - R_Node : Node_Access := Right.First; - - Dst_Node : Node_Access; - pragma Warnings (Off, Dst_Node); - - begin - if Left'Address = Right'Address then - return Tree; -- Empty set - end if; - - if Right.Length = 0 then - return Copy (Left); - end if; - - if Left.Length = 0 then - return Copy (Right); - end if; - - loop - if L_Node = null then - while R_Node /= null loop - Insert_With_Hint - (Dst_Tree => Tree, - Dst_Hint => null, - Src_Node => R_Node, - Dst_Node => Dst_Node); - R_Node := Tree_Operations.Next (R_Node); - end loop; - - return Tree; - end if; - - if R_Node = null then - while L_Node /= null loop - Insert_With_Hint - (Dst_Tree => Tree, - Dst_Hint => null, - Src_Node => L_Node, - Dst_Node => Dst_Node); - - L_Node := Tree_Operations.Next (L_Node); - end loop; - - return Tree; - end if; - - if Is_Less (L_Node, R_Node) then - Insert_With_Hint - (Dst_Tree => Tree, - Dst_Hint => null, - Src_Node => L_Node, - Dst_Node => Dst_Node); - - L_Node := Tree_Operations.Next (L_Node); - - elsif Is_Less (R_Node, L_Node) then - Insert_With_Hint - (Dst_Tree => Tree, - Dst_Hint => null, - Src_Node => R_Node, - Dst_Node => Dst_Node); - - R_Node := Tree_Operations.Next (R_Node); - - else - L_Node := Tree_Operations.Next (L_Node); - R_Node := Tree_Operations.Next (R_Node); - end if; - end loop; - - exception - when others => - Delete_Tree (Tree.Root); - raise; - end Symmetric_Difference; - - ----------- - -- Union -- - ----------- - - procedure Union (Target : in out Tree_Type; Source : Tree_Type) - is - Hint : Node_Access; - - procedure Process (Node : Node_Access); - pragma Inline (Process); - - procedure Iterate is new Tree_Operations.Generic_Iteration (Process); - - ------------- - -- Process -- - ------------- - - procedure Process (Node : Node_Access) is - begin - Insert_With_Hint - (Dst_Tree => Target, - Dst_Hint => Hint, - Src_Node => Node, - Dst_Node => Hint); - end Process; - - -- Start of processing for Union - - begin - if Target'Address = Source'Address then - return; - end if; - - if Target.Busy > 0 then - raise Program_Error with - "attempt to tamper with cursors (container is busy)"; - end if; - - Iterate (Source); - end Union; - - function Union (Left, Right : Tree_Type) return Tree_Type is - begin - if Left'Address = Right'Address then - return Copy (Left); - end if; - - if Left.Length = 0 then - return Copy (Right); - end if; - - if Right.Length = 0 then - return Copy (Left); - end if; - - declare - Tree : Tree_Type := Copy (Left); - - Hint : Node_Access; - - procedure Process (Node : Node_Access); - pragma Inline (Process); - - procedure Iterate is - new Tree_Operations.Generic_Iteration (Process); - - ------------- - -- Process -- - ------------- - - procedure Process (Node : Node_Access) is - begin - Insert_With_Hint - (Dst_Tree => Tree, - Dst_Hint => Hint, - Src_Node => Node, - Dst_Node => Hint); - end Process; - - -- Start of processing for Union - - begin - Iterate (Right); - return Tree; - - exception - when others => - Delete_Tree (Tree.Root); - raise; - end; - - end Union; - -end Ada.Containers.Red_Black_Trees.Generic_Set_Operations; |