URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-btgbso.adb] - Blame information for rev 706

Details | Compare with Previous | View Log


------------------------------------------------------------------------------
--                                                                          --
--                         GNAT LIBRARY COMPONENTS                          --
--                                                                          --
--       ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_BOUNDED_SET_OPERATIONS      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (C) 2004-2011, 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_Bounded_Set_Operations is
 
   -----------------------
   -- Local Subprograms --
   -----------------------
 
   function Copy (Source : Set_Type) return Set_Type;
 
   ----------
   -- Copy --
   ----------
 
   function Copy (Source : Set_Type) return Set_Type is
   begin
      return Target : Set_Type (Source.Length) do
         Assign (Target => Target, Source => Source);
      end return;
   end Copy;
 
   ----------------
   -- Difference --
   ----------------
 
   procedure Set_Difference (Target : in out Set_Type; Source : Set_Type) is
      Tgt, Src : Count_Type;
 
      TN : Nodes_Type renames Target.Nodes;
      SN : Nodes_Type renames Source.Nodes;
 
   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;
 
         Tree_Operations.Clear_Tree (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;
 
      Tgt := Target.First;
      Src := Source.First;
      loop
         if Tgt = 0 then
            return;
         end if;
 
         if Src = 0 then
            return;
         end if;
 
         if Is_Less (TN (Tgt), SN (Src)) then
            Tgt := Tree_Operations.Next (Target, Tgt);
 
         elsif Is_Less (SN (Src), TN (Tgt)) then
            Src := Tree_Operations.Next (Source, Src);
 
         else
            declare
               X : constant Count_Type := Tgt;
            begin
               Tgt := Tree_Operations.Next (Target, Tgt);
 
               Tree_Operations.Delete_Node_Sans_Free (Target, X);
               Tree_Operations.Free (Target, X);
            end;
 
            Src := Tree_Operations.Next (Source, Src);
         end if;
      end loop;
   end Set_Difference;
 
   function Set_Difference (Left, Right : Set_Type) return Set_Type is
      L_Node : Count_Type;
      R_Node : Count_Type;
 
      Dst_Node : Count_Type;
      pragma Warnings (Off, Dst_Node);
 
   begin
      if Left'Address = Right'Address then
         return S : Set_Type (0);  -- Empty set
      end if;
 
      if Left.Length = 0 then
         return S : Set_Type (0);  -- Empty set
      end if;
 
      if Right.Length = 0 then
         return Copy (Left);
      end if;
 
      return Result : Set_Type (Left.Length) do
         L_Node := Left.First;
         R_Node := Right.First;
         loop
            if L_Node = 0 then
               return;
            end if;
 
            if R_Node = 0 then
               while L_Node /= 0 loop
                  Insert_With_Hint
                    (Dst_Set  => Result,
                     Dst_Hint => 0,
                     Src_Node => Left.Nodes (L_Node),
                     Dst_Node => Dst_Node);
 
                  L_Node := Tree_Operations.Next (Left, L_Node);
               end loop;
 
               return;
            end if;
 
            if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
               Insert_With_Hint
                 (Dst_Set  => Result,
                  Dst_Hint => 0,
                  Src_Node => Left.Nodes (L_Node),
                  Dst_Node => Dst_Node);
 
               L_Node := Tree_Operations.Next (Left, L_Node);
 
            elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
               R_Node := Tree_Operations.Next (Right, R_Node);
 
            else
               L_Node := Tree_Operations.Next (Left, L_Node);
               R_Node := Tree_Operations.Next (Right, R_Node);
            end if;
         end loop;
      end return;
   end Set_Difference;
 
   ------------------
   -- Intersection --
   ------------------
 
   procedure Set_Intersection
     (Target : in out Set_Type;
      Source : Set_Type)
   is
      Tgt : Count_Type;
      Src : Count_Type;
 
   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
         Tree_Operations.Clear_Tree (Target);
         return;
      end if;
 
      Tgt := Target.First;
      Src := Source.First;
      while Tgt /= 0
        and then Src /= 0
      loop
         if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then
            declare
               X : constant Count_Type := Tgt;
            begin
               Tgt := Tree_Operations.Next (Target, Tgt);
 
               Tree_Operations.Delete_Node_Sans_Free (Target, X);
               Tree_Operations.Free (Target, X);
            end;
 
         elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then
            Src := Tree_Operations.Next (Source, Src);
 
         else
            Tgt := Tree_Operations.Next (Target, Tgt);
            Src := Tree_Operations.Next (Source, Src);
         end if;
      end loop;
 
      while Tgt /= 0 loop
         declare
            X : constant Count_Type := Tgt;
         begin
            Tgt := Tree_Operations.Next (Target, Tgt);
 
            Tree_Operations.Delete_Node_Sans_Free (Target, X);
            Tree_Operations.Free (Target, X);
         end;
      end loop;
   end Set_Intersection;
 
   function Set_Intersection (Left, Right : Set_Type) return Set_Type is
      L_Node : Count_Type;
      R_Node : Count_Type;
 
      Dst_Node : Count_Type;
      pragma Warnings (Off, Dst_Node);
 
   begin
      if Left'Address = Right'Address then
         return Copy (Left);
      end if;
 
      return Result : Set_Type (Count_Type'Min (Left.Length, Right.Length)) do
         L_Node := Left.First;
         R_Node := Right.First;
         loop
            if L_Node = 0 then
               return;
            end if;
 
            if R_Node = 0 then
               return;
            end if;
 
            if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
               L_Node := Tree_Operations.Next (Left, L_Node);
 
            elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
               R_Node := Tree_Operations.Next (Right, R_Node);
 
            else
               Insert_With_Hint
                 (Dst_Set  => Result,
                  Dst_Hint => 0,
                  Src_Node => Left.Nodes (L_Node),
                  Dst_Node => Dst_Node);
 
               L_Node := Tree_Operations.Next (Left, L_Node);
               R_Node := Tree_Operations.Next (Right, R_Node);
            end if;
         end loop;
      end return;
   end Set_Intersection;
 
   ---------------
   -- Is_Subset --
   ---------------
 
   function Set_Subset
     (Subset : Set_Type;
      Of_Set : Set_Type) return Boolean
   is
      Subset_Node : Count_Type;
      Set_Node    : Count_Type;
 
   begin
      if Subset'Address = Of_Set'Address then
         return True;
      end if;
 
      if Subset.Length > Of_Set.Length then
         return False;
      end if;
 
      Subset_Node := Subset.First;
      Set_Node    := Of_Set.First;
      loop
         if Set_Node = 0 then
            return Subset_Node = 0;
         end if;
 
         if Subset_Node = 0 then
            return True;
         end if;
 
         if Is_Less (Subset.Nodes (Subset_Node), Of_Set.Nodes (Set_Node)) then
            return False;
         end if;
 
         if Is_Less (Of_Set.Nodes (Set_Node), Subset.Nodes (Subset_Node)) then
            Set_Node := Tree_Operations.Next (Of_Set, Set_Node);
         else
            Set_Node := Tree_Operations.Next (Of_Set, Set_Node);
            Subset_Node := Tree_Operations.Next (Subset, Subset_Node);
         end if;
      end loop;
   end Set_Subset;
 
   -------------
   -- Overlap --
   -------------
 
   function Set_Overlap (Left, Right : Set_Type) return Boolean is
      L_Node : Count_Type;
      R_Node : Count_Type;
 
   begin
      if Left'Address = Right'Address then
         return Left.Length /= 0;
      end if;
 
      L_Node := Left.First;
      R_Node := Right.First;
      loop
         if L_Node = 0
           or else R_Node = 0
         then
            return False;
         end if;
 
         if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
            L_Node := Tree_Operations.Next (Left, L_Node);
 
         elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
            R_Node := Tree_Operations.Next (Right, R_Node);
 
         else
            return True;
         end if;
      end loop;
   end Set_Overlap;
 
   --------------------------
   -- Symmetric_Difference --
   --------------------------
 
   procedure Set_Symmetric_Difference
     (Target : in out Set_Type;
      Source : Set_Type)
   is
      Tgt : Count_Type;
      Src : Count_Type;
 
      New_Tgt_Node : Count_Type;
      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
         Tree_Operations.Clear_Tree (Target);
         return;
      end if;
 
      Tgt := Target.First;
      Src := Source.First;
      loop
         if Tgt = 0 then
            while Src /= 0 loop
               Insert_With_Hint
                 (Dst_Set  => Target,
                  Dst_Hint => 0,
                  Src_Node => Source.Nodes (Src),
                  Dst_Node => New_Tgt_Node);
 
               Src := Tree_Operations.Next (Source, Src);
            end loop;
 
            return;
         end if;
 
         if Src = 0 then
            return;
         end if;
 
         if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then
            Tgt := Tree_Operations.Next (Target, Tgt);
 
         elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then
            Insert_With_Hint
              (Dst_Set  => Target,
               Dst_Hint => Tgt,
               Src_Node => Source.Nodes (Src),
               Dst_Node => New_Tgt_Node);
 
            Src := Tree_Operations.Next (Source, Src);
 
         else
            declare
               X : constant Count_Type := Tgt;
            begin
               Tgt := Tree_Operations.Next (Target, Tgt);
 
               Tree_Operations.Delete_Node_Sans_Free (Target, X);
               Tree_Operations.Free (Target, X);
            end;
 
            Src := Tree_Operations.Next (Source, Src);
         end if;
      end loop;
   end Set_Symmetric_Difference;
 
   function Set_Symmetric_Difference
     (Left, Right : Set_Type) return Set_Type
   is
      L_Node : Count_Type;
      R_Node : Count_Type;
 
      Dst_Node : Count_Type;
      pragma Warnings (Off, Dst_Node);
 
   begin
      if Left'Address = Right'Address then
         return S : Set_Type (0);  -- Empty set
      end if;
 
      if Right.Length = 0 then
         return Copy (Left);
      end if;
 
      if Left.Length = 0 then
         return Copy (Right);
      end if;
 
      return Result : Set_Type (Left.Length + Right.Length) do
         L_Node := Left.First;
         R_Node := Right.First;
         loop
            if L_Node = 0 then
               while R_Node /= 0 loop
                  Insert_With_Hint
                    (Dst_Set  => Result,
                     Dst_Hint => 0,
                     Src_Node => Right.Nodes (R_Node),
                     Dst_Node => Dst_Node);
 
                  R_Node := Tree_Operations.Next (Right, R_Node);
               end loop;
 
               return;
            end if;
 
            if R_Node = 0 then
               while L_Node /= 0 loop
                  Insert_With_Hint
                    (Dst_Set  => Result,
                     Dst_Hint => 0,
                     Src_Node => Left.Nodes (L_Node),
                     Dst_Node => Dst_Node);
 
                  L_Node := Tree_Operations.Next (Left, L_Node);
               end loop;
 
               return;
            end if;
 
            if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then
               Insert_With_Hint
                 (Dst_Set  => Result,
                  Dst_Hint => 0,
                  Src_Node => Left.Nodes (L_Node),
                  Dst_Node => Dst_Node);
 
               L_Node := Tree_Operations.Next (Left, L_Node);
 
            elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then
               Insert_With_Hint
                 (Dst_Set  => Result,
                  Dst_Hint => 0,
                  Src_Node => Right.Nodes (R_Node),
                  Dst_Node => Dst_Node);
 
               R_Node := Tree_Operations.Next (Right, R_Node);
 
            else
               L_Node := Tree_Operations.Next (Left, L_Node);
               R_Node := Tree_Operations.Next (Right, R_Node);
            end if;
         end loop;
      end return;
   end Set_Symmetric_Difference;
 
   -----------
   -- Union --
   -----------
 
   procedure Set_Union (Target : in out Set_Type; Source : Set_Type) is
      Hint : Count_Type := 0;
 
      procedure Process (Node : Count_Type);
      pragma Inline (Process);
 
      procedure Iterate is new Tree_Operations.Generic_Iteration (Process);
 
      -------------
      -- Process --
      -------------
 
      procedure Process (Node : Count_Type) is
      begin
         Insert_With_Hint
           (Dst_Set  => Target,
            Dst_Hint => Hint,
            Src_Node => Source.Nodes (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;
 
      --  Note that there's no way to decide a priori whether the target has
      --  enough capacity for the union with source. We cannot simply compare
      --  the sum of the existing lengths to the capacity of the target,
      --  because equivalent items from source are not included in the union.
 
      Iterate (Source);
   end Set_Union;
 
   function Set_Union (Left, Right : Set_Type) return Set_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;
 
      return Result : Set_Type (Left.Length + Right.Length) do
         Assign (Target => Result, Source => Left);
 
         Insert_Right : declare
            Hint : Count_Type := 0;
 
            procedure Process (Node : Count_Type);
            pragma Inline (Process);
 
            procedure Iterate is
              new Tree_Operations.Generic_Iteration (Process);
 
            -------------
            -- Process --
            -------------
 
            procedure Process (Node : Count_Type) is
            begin
               Insert_With_Hint
                 (Dst_Set  => Result,
                  Dst_Hint => Hint,
                  Src_Node => Right.Nodes (Node),
                  Dst_Node => Hint);
            end Process;
 
         --  Start of processing for Insert_Right
 
         begin
            Iterate (Right);
         end Insert_Right;
      end return;
   end Set_Union;
 
end Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations;

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-btgbso.adb] - Blame information for rev 706

Line No.	Rev	Author	Line
1	706	jeremybenn	`------------------------------------------------------------------------------`
2			`-- --`
3			`-- GNAT LIBRARY COMPONENTS --`
4			`-- --`
5			`-- ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_BOUNDED_SET_OPERATIONS --`
6			`-- --`
7			`-- B o d y --`
8			`-- --`
9			`-- Copyright (C) 2004-2011, Free Software Foundation, Inc. --`
10			`-- --`
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. --`
17			`-- --`
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. --`
21			`-- --`
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/>. --`
26			`-- --`
27			`-- This unit was originally developed by Matthew J Heaney. --`
28			`------------------------------------------------------------------------------`
29
30			`with System; use type System.Address;`
31
32			`package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations is`
33
34			`-----------------------`
35			`-- Local Subprograms --`
36			`-----------------------`
37
38			`function Copy (Source : Set_Type) return Set_Type;`
39
40			`----------`
41			`-- Copy --`
42			`----------`
43
44			`function Copy (Source : Set_Type) return Set_Type is`
45			`begin`
46			`return Target : Set_Type (Source.Length) do`
47			`Assign (Target => Target, Source => Source);`
48			`end return;`
49			`end Copy;`
50
51			`----------------`
52			`-- Difference --`
53			`----------------`
54
55			`procedure Set_Difference (Target : in out Set_Type; Source : Set_Type) is`
56			`Tgt, Src : Count_Type;`
57
58			`TN : Nodes_Type renames Target.Nodes;`
59			`SN : Nodes_Type renames Source.Nodes;`
60
61			`begin`
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)";`
66			`end if;`
67
68			`Tree_Operations.Clear_Tree (Target);`
69			`return;`
70			`end if;`
71
72			`if Source.Length = 0 then`
73			`return;`
74			`end if;`
75
76			`if Target.Busy > 0 then`
77			`raise Program_Error with`
78			`"attempt to tamper with cursors (container is busy)";`
79			`end if;`
80
81			`Tgt := Target.First;`
82			`Src := Source.First;`
83			`loop`
84			`if Tgt = 0 then`
85			`return;`
86			`end if;`
87
88			`if Src = 0 then`
89			`return;`
90			`end if;`
91
92			`if Is_Less (TN (Tgt), SN (Src)) then`
93			`Tgt := Tree_Operations.Next (Target, Tgt);`
94
95			`elsif Is_Less (SN (Src), TN (Tgt)) then`
96			`Src := Tree_Operations.Next (Source, Src);`
97
98			`else`
99			`declare`
100			`X : constant Count_Type := Tgt;`
101			`begin`
102			`Tgt := Tree_Operations.Next (Target, Tgt);`
103
104			`Tree_Operations.Delete_Node_Sans_Free (Target, X);`
105			`Tree_Operations.Free (Target, X);`
106			`end;`
107
108			`Src := Tree_Operations.Next (Source, Src);`
109			`end if;`
110			`end loop;`
111			`end Set_Difference;`
112
113			`function Set_Difference (Left, Right : Set_Type) return Set_Type is`
114			`L_Node : Count_Type;`
115			`R_Node : Count_Type;`
116
117			`Dst_Node : Count_Type;`
118			`pragma Warnings (Off, Dst_Node);`
119
120			`begin`
121			`if Left'Address = Right'Address then`
122			`return S : Set_Type (0); -- Empty set`
123			`end if;`
124
125			`if Left.Length = 0 then`
126			`return S : Set_Type (0); -- Empty set`
127			`end if;`
128
129			`if Right.Length = 0 then`
130			`return Copy (Left);`
131			`end if;`
132
133			`return Result : Set_Type (Left.Length) do`
134			`L_Node := Left.First;`
135			`R_Node := Right.First;`
136			`loop`
137			`if L_Node = 0 then`
138			`return;`
139			`end if;`
140
141			`if R_Node = 0 then`
142			`while L_Node /= 0 loop`
143			`Insert_With_Hint`
144			`(Dst_Set => Result,`
145			`Dst_Hint => 0,`
146			`Src_Node => Left.Nodes (L_Node),`
147			`Dst_Node => Dst_Node);`
148
149			`L_Node := Tree_Operations.Next (Left, L_Node);`
150			`end loop;`
151
152			`return;`
153			`end if;`
154
155			`if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then`
156			`Insert_With_Hint`
157			`(Dst_Set => Result,`
158			`Dst_Hint => 0,`
159			`Src_Node => Left.Nodes (L_Node),`
160			`Dst_Node => Dst_Node);`
161
162			`L_Node := Tree_Operations.Next (Left, L_Node);`
163
164			`elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then`
165			`R_Node := Tree_Operations.Next (Right, R_Node);`
166
167			`else`
168			`L_Node := Tree_Operations.Next (Left, L_Node);`
169			`R_Node := Tree_Operations.Next (Right, R_Node);`
170			`end if;`
171			`end loop;`
172			`end return;`
173			`end Set_Difference;`
174
175			`------------------`
176			`-- Intersection --`
177			`------------------`
178
179			`procedure Set_Intersection`
180			`(Target : in out Set_Type;`
181			`Source : Set_Type)`
182			`is`
183			`Tgt : Count_Type;`
184			`Src : Count_Type;`
185
186			`begin`
187			`if Target'Address = Source'Address then`
188			`return;`
189			`end if;`
190
191			`if Target.Busy > 0 then`
192			`raise Program_Error with`
193			`"attempt to tamper with cursors (container is busy)";`
194			`end if;`
195
196			`if Source.Length = 0 then`
197			`Tree_Operations.Clear_Tree (Target);`
198			`return;`
199			`end if;`
200
201			`Tgt := Target.First;`
202			`Src := Source.First;`
203			`while Tgt /= 0`
204			`and then Src /= 0`
205			`loop`
206			`if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then`
207			`declare`
208			`X : constant Count_Type := Tgt;`
209			`begin`
210			`Tgt := Tree_Operations.Next (Target, Tgt);`
211
212			`Tree_Operations.Delete_Node_Sans_Free (Target, X);`
213			`Tree_Operations.Free (Target, X);`
214			`end;`
215
216			`elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then`
217			`Src := Tree_Operations.Next (Source, Src);`
218
219			`else`
220			`Tgt := Tree_Operations.Next (Target, Tgt);`
221			`Src := Tree_Operations.Next (Source, Src);`
222			`end if;`
223			`end loop;`
224
225			`while Tgt /= 0 loop`
226			`declare`
227			`X : constant Count_Type := Tgt;`
228			`begin`
229			`Tgt := Tree_Operations.Next (Target, Tgt);`
230
231			`Tree_Operations.Delete_Node_Sans_Free (Target, X);`
232			`Tree_Operations.Free (Target, X);`
233			`end;`
234			`end loop;`
235			`end Set_Intersection;`
236
237			`function Set_Intersection (Left, Right : Set_Type) return Set_Type is`
238			`L_Node : Count_Type;`
239			`R_Node : Count_Type;`
240
241			`Dst_Node : Count_Type;`
242			`pragma Warnings (Off, Dst_Node);`
243
244			`begin`
245			`if Left'Address = Right'Address then`
246			`return Copy (Left);`
247			`end if;`
248
249			`return Result : Set_Type (Count_Type'Min (Left.Length, Right.Length)) do`
250			`L_Node := Left.First;`
251			`R_Node := Right.First;`
252			`loop`
253			`if L_Node = 0 then`
254			`return;`
255			`end if;`
256
257			`if R_Node = 0 then`
258			`return;`
259			`end if;`
260
261			`if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then`
262			`L_Node := Tree_Operations.Next (Left, L_Node);`
263
264			`elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then`
265			`R_Node := Tree_Operations.Next (Right, R_Node);`
266
267			`else`
268			`Insert_With_Hint`
269			`(Dst_Set => Result,`
270			`Dst_Hint => 0,`
271			`Src_Node => Left.Nodes (L_Node),`
272			`Dst_Node => Dst_Node);`
273
274			`L_Node := Tree_Operations.Next (Left, L_Node);`
275			`R_Node := Tree_Operations.Next (Right, R_Node);`
276			`end if;`
277			`end loop;`
278			`end return;`
279			`end Set_Intersection;`
280
281			`---------------`
282			`-- Is_Subset --`
283			`---------------`
284
285			`function Set_Subset`
286			`(Subset : Set_Type;`
287			`Of_Set : Set_Type) return Boolean`
288			`is`
289			`Subset_Node : Count_Type;`
290			`Set_Node : Count_Type;`
291
292			`begin`
293			`if Subset'Address = Of_Set'Address then`
294			`return True;`
295			`end if;`
296
297			`if Subset.Length > Of_Set.Length then`
298			`return False;`
299			`end if;`
300
301			`Subset_Node := Subset.First;`
302			`Set_Node := Of_Set.First;`
303			`loop`
304			`if Set_Node = 0 then`
305			`return Subset_Node = 0;`
306			`end if;`
307
308			`if Subset_Node = 0 then`
309			`return True;`
310			`end if;`
311
312			`if Is_Less (Subset.Nodes (Subset_Node), Of_Set.Nodes (Set_Node)) then`
313			`return False;`
314			`end if;`
315
316			`if Is_Less (Of_Set.Nodes (Set_Node), Subset.Nodes (Subset_Node)) then`
317			`Set_Node := Tree_Operations.Next (Of_Set, Set_Node);`
318			`else`
319			`Set_Node := Tree_Operations.Next (Of_Set, Set_Node);`
320			`Subset_Node := Tree_Operations.Next (Subset, Subset_Node);`
321			`end if;`
322			`end loop;`
323			`end Set_Subset;`
324
325			`-------------`
326			`-- Overlap --`
327			`-------------`
328
329			`function Set_Overlap (Left, Right : Set_Type) return Boolean is`
330			`L_Node : Count_Type;`
331			`R_Node : Count_Type;`
332
333			`begin`
334			`if Left'Address = Right'Address then`
335			`return Left.Length /= 0;`
336			`end if;`
337
338			`L_Node := Left.First;`
339			`R_Node := Right.First;`
340			`loop`
341			`if L_Node = 0`
342			`or else R_Node = 0`
343			`then`
344			`return False;`
345			`end if;`
346
347			`if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then`
348			`L_Node := Tree_Operations.Next (Left, L_Node);`
349
350			`elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then`
351			`R_Node := Tree_Operations.Next (Right, R_Node);`
352
353			`else`
354			`return True;`
355			`end if;`
356			`end loop;`
357			`end Set_Overlap;`
358
359			`--------------------------`
360			`-- Symmetric_Difference --`
361			`--------------------------`
362
363			`procedure Set_Symmetric_Difference`
364			`(Target : in out Set_Type;`
365			`Source : Set_Type)`
366			`is`
367			`Tgt : Count_Type;`
368			`Src : Count_Type;`
369
370			`New_Tgt_Node : Count_Type;`
371			`pragma Warnings (Off, New_Tgt_Node);`
372
373			`begin`
374			`if Target.Busy > 0 then`
375			`raise Program_Error with`
376			`"attempt to tamper with cursors (container is busy)";`
377			`end if;`
378
379			`if Target'Address = Source'Address then`
380			`Tree_Operations.Clear_Tree (Target);`
381			`return;`
382			`end if;`
383
384			`Tgt := Target.First;`
385			`Src := Source.First;`
386			`loop`
387			`if Tgt = 0 then`
388			`while Src /= 0 loop`
389			`Insert_With_Hint`
390			`(Dst_Set => Target,`
391			`Dst_Hint => 0,`
392			`Src_Node => Source.Nodes (Src),`
393			`Dst_Node => New_Tgt_Node);`
394
395			`Src := Tree_Operations.Next (Source, Src);`
396			`end loop;`
397
398			`return;`
399			`end if;`
400
401			`if Src = 0 then`
402			`return;`
403			`end if;`
404
405			`if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then`
406			`Tgt := Tree_Operations.Next (Target, Tgt);`
407
408			`elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then`
409			`Insert_With_Hint`
410			`(Dst_Set => Target,`
411			`Dst_Hint => Tgt,`
412			`Src_Node => Source.Nodes (Src),`
413			`Dst_Node => New_Tgt_Node);`
414
415			`Src := Tree_Operations.Next (Source, Src);`
416
417			`else`
418			`declare`
419			`X : constant Count_Type := Tgt;`
420			`begin`
421			`Tgt := Tree_Operations.Next (Target, Tgt);`
422
423			`Tree_Operations.Delete_Node_Sans_Free (Target, X);`
424			`Tree_Operations.Free (Target, X);`
425			`end;`
426
427			`Src := Tree_Operations.Next (Source, Src);`
428			`end if;`
429			`end loop;`
430			`end Set_Symmetric_Difference;`
431
432			`function Set_Symmetric_Difference`
433			`(Left, Right : Set_Type) return Set_Type`
434			`is`
435			`L_Node : Count_Type;`
436			`R_Node : Count_Type;`
437
438			`Dst_Node : Count_Type;`
439			`pragma Warnings (Off, Dst_Node);`
440
441			`begin`
442			`if Left'Address = Right'Address then`
443			`return S : Set_Type (0); -- Empty set`
444			`end if;`
445
446			`if Right.Length = 0 then`
447			`return Copy (Left);`
448			`end if;`
449
450			`if Left.Length = 0 then`
451			`return Copy (Right);`
452			`end if;`
453
454			`return Result : Set_Type (Left.Length + Right.Length) do`
455			`L_Node := Left.First;`
456			`R_Node := Right.First;`
457			`loop`
458			`if L_Node = 0 then`
459			`while R_Node /= 0 loop`
460			`Insert_With_Hint`
461			`(Dst_Set => Result,`
462			`Dst_Hint => 0,`
463			`Src_Node => Right.Nodes (R_Node),`
464			`Dst_Node => Dst_Node);`
465
466			`R_Node := Tree_Operations.Next (Right, R_Node);`
467			`end loop;`
468
469			`return;`
470			`end if;`
471
472			`if R_Node = 0 then`
473			`while L_Node /= 0 loop`
474			`Insert_With_Hint`
475			`(Dst_Set => Result,`
476			`Dst_Hint => 0,`
477			`Src_Node => Left.Nodes (L_Node),`
478			`Dst_Node => Dst_Node);`
479
480			`L_Node := Tree_Operations.Next (Left, L_Node);`
481			`end loop;`
482
483			`return;`
484			`end if;`
485
486			`if Is_Less (Left.Nodes (L_Node), Right.Nodes (R_Node)) then`
487			`Insert_With_Hint`
488			`(Dst_Set => Result,`
489			`Dst_Hint => 0,`
490			`Src_Node => Left.Nodes (L_Node),`
491			`Dst_Node => Dst_Node);`
492
493			`L_Node := Tree_Operations.Next (Left, L_Node);`
494
495			`elsif Is_Less (Right.Nodes (R_Node), Left.Nodes (L_Node)) then`
496			`Insert_With_Hint`
497			`(Dst_Set => Result,`
498			`Dst_Hint => 0,`
499			`Src_Node => Right.Nodes (R_Node),`
500			`Dst_Node => Dst_Node);`
501
502			`R_Node := Tree_Operations.Next (Right, R_Node);`
503
504			`else`
505			`L_Node := Tree_Operations.Next (Left, L_Node);`
506			`R_Node := Tree_Operations.Next (Right, R_Node);`
507			`end if;`
508			`end loop;`
509			`end return;`
510			`end Set_Symmetric_Difference;`
511
512			`-----------`
513			`-- Union --`
514			`-----------`
515
516			`procedure Set_Union (Target : in out Set_Type; Source : Set_Type) is`
517			`Hint : Count_Type := 0;`
518
519			`procedure Process (Node : Count_Type);`
520			`pragma Inline (Process);`
521
522			`procedure Iterate is new Tree_Operations.Generic_Iteration (Process);`
523
524			`-------------`
525			`-- Process --`
526			`-------------`
527
528			`procedure Process (Node : Count_Type) is`
529			`begin`
530			`Insert_With_Hint`
531			`(Dst_Set => Target,`
532			`Dst_Hint => Hint,`
533			`Src_Node => Source.Nodes (Node),`
534			`Dst_Node => Hint);`
535			`end Process;`
536
537			`-- Start of processing for Union`
538
539			`begin`
540			`if Target'Address = Source'Address then`
541			`return;`
542			`end if;`
543
544			`if Target.Busy > 0 then`
545			`raise Program_Error with`
546			`"attempt to tamper with cursors (container is busy)";`
547			`end if;`
548
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.`
553
554			`Iterate (Source);`
555			`end Set_Union;`
556
557			`function Set_Union (Left, Right : Set_Type) return Set_Type is`
558			`begin`
559			`if Left'Address = Right'Address then`
560			`return Copy (Left);`
561			`end if;`
562
563			`if Left.Length = 0 then`
564			`return Copy (Right);`
565			`end if;`
566
567			`if Right.Length = 0 then`
568			`return Copy (Left);`
569			`end if;`
570
571			`return Result : Set_Type (Left.Length + Right.Length) do`
572			`Assign (Target => Result, Source => Left);`
573
574			`Insert_Right : declare`
575			`Hint : Count_Type := 0;`
576
577			`procedure Process (Node : Count_Type);`
578			`pragma Inline (Process);`
579
580			`procedure Iterate is`
581			`new Tree_Operations.Generic_Iteration (Process);`
582
583			`-------------`
584			`-- Process --`
585			`-------------`
586
587			`procedure Process (Node : Count_Type) is`
588			`begin`
589			`Insert_With_Hint`
590			`(Dst_Set => Result,`
591			`Dst_Hint => Hint,`
592			`Src_Node => Right.Nodes (Node),`
593			`Dst_Node => Hint);`
594			`end Process;`
595
596			`-- Start of processing for Insert_Right`
597
598			`begin`
599			`Iterate (Right);`
600			`end Insert_Right;`
601			`end return;`
602			`end Set_Union;`
603
604			`end Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations;`