aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/ada/a-btgbso.adb
diff options
context:
space:
mode:
Diffstat (limited to 'gcc-4.9/gcc/ada/a-btgbso.adb')
-rw-r--r--gcc-4.9/gcc/ada/a-btgbso.adb956
1 files changed, 956 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/ada/a-btgbso.adb b/gcc-4.9/gcc/ada/a-btgbso.adb
new file mode 100644
index 000000000..2aef270f6
--- /dev/null
+++ b/gcc-4.9/gcc/ada/a-btgbso.adb
@@ -0,0 +1,956 @@
+------------------------------------------------------------------------------
+-- --
+-- GNAT LIBRARY COMPONENTS --
+-- --
+-- ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_BOUNDED_SET_OPERATIONS --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2004-2013, 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
+ BT : Natural renames Target.Busy;
+ LT : Natural renames Target.Lock;
+
+ BS : Natural renames Source'Unrestricted_Access.Busy;
+ LS : Natural renames Source'Unrestricted_Access.Lock;
+
+ Tgt, Src : Count_Type;
+
+ TN : Nodes_Type renames Target.Nodes;
+ SN : Nodes_Type renames Source.Nodes;
+
+ Compare : Integer;
+
+ 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
+ exit;
+ end if;
+
+ if Src = 0 then
+ exit;
+ end if;
+
+ -- Per AI05-0022, the container implementation is required to detect
+ -- element tampering by a generic actual subprogram.
+
+ begin
+ BT := BT + 1;
+ LT := LT + 1;
+
+ BS := BS + 1;
+ LS := LS + 1;
+
+ if Is_Less (TN (Tgt), SN (Src)) then
+ Compare := -1;
+ elsif Is_Less (SN (Src), TN (Tgt)) then
+ Compare := 1;
+ else
+ Compare := 0;
+ end if;
+
+ BT := BT - 1;
+ LT := LT - 1;
+
+ BS := BS - 1;
+ LS := LS - 1;
+ exception
+ when others =>
+ BT := BT - 1;
+ LT := LT - 1;
+
+ BS := BS - 1;
+ LS := LS - 1;
+
+ raise;
+ end;
+
+ if Compare < 0 then
+ Tgt := Tree_Operations.Next (Target, Tgt);
+
+ elsif Compare > 0 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
+ 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
+ -- Per AI05-0022, the container implementation is required to detect
+ -- element tampering by a generic actual subprogram.
+
+ declare
+ BL : Natural renames Left'Unrestricted_Access.Busy;
+ LL : Natural renames Left'Unrestricted_Access.Lock;
+
+ BR : Natural renames Right'Unrestricted_Access.Busy;
+ LR : Natural renames Right'Unrestricted_Access.Lock;
+
+ L_Node : Count_Type;
+ R_Node : Count_Type;
+
+ Dst_Node : Count_Type;
+ pragma Warnings (Off, Dst_Node);
+
+ begin
+ BL := BL + 1;
+ LL := LL + 1;
+
+ BR := BR + 1;
+ LR := LR + 1;
+
+ L_Node := Left.First;
+ R_Node := Right.First;
+ loop
+ if L_Node = 0 then
+ exit;
+ 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;
+
+ exit;
+ 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;
+
+ BL := BL - 1;
+ LL := LL - 1;
+
+ BR := BR - 1;
+ LR := LR - 1;
+ exception
+ when others =>
+ BL := BL - 1;
+ LL := LL - 1;
+
+ BR := BR - 1;
+ LR := LR - 1;
+
+ raise;
+ end;
+ end return;
+ end Set_Difference;
+
+ ------------------
+ -- Intersection --
+ ------------------
+
+ procedure Set_Intersection
+ (Target : in out Set_Type;
+ Source : Set_Type)
+ is
+ BT : Natural renames Target.Busy;
+ LT : Natural renames Target.Lock;
+
+ BS : Natural renames Source'Unrestricted_Access.Busy;
+ LS : Natural renames Source'Unrestricted_Access.Lock;
+
+ Tgt : Count_Type;
+ Src : Count_Type;
+
+ Compare : Integer;
+
+ 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
+ -- Per AI05-0022, the container implementation is required to detect
+ -- element tampering by a generic actual subprogram.
+
+ begin
+ BT := BT + 1;
+ LT := LT + 1;
+
+ BS := BS + 1;
+ LS := LS + 1;
+
+ if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then
+ Compare := -1;
+ elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then
+ Compare := 1;
+ else
+ Compare := 0;
+ end if;
+
+ BT := BT - 1;
+ LT := LT - 1;
+
+ BS := BS - 1;
+ LS := LS - 1;
+ exception
+ when others =>
+ BT := BT - 1;
+ LT := LT - 1;
+
+ BS := BS - 1;
+ LS := LS - 1;
+
+ raise;
+ end;
+
+ if Compare < 0 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 Compare > 0 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
+ begin
+ if Left'Address = Right'Address then
+ return Copy (Left);
+ end if;
+
+ return Result : Set_Type (Count_Type'Min (Left.Length, Right.Length)) do
+
+ -- Per AI05-0022, the container implementation is required to detect
+ -- element tampering by a generic actual subprogram.
+
+ declare
+ BL : Natural renames Left'Unrestricted_Access.Busy;
+ LL : Natural renames Left'Unrestricted_Access.Lock;
+
+ BR : Natural renames Right'Unrestricted_Access.Busy;
+ LR : Natural renames Right'Unrestricted_Access.Lock;
+
+ L_Node : Count_Type;
+ R_Node : Count_Type;
+
+ Dst_Node : Count_Type;
+ pragma Warnings (Off, Dst_Node);
+
+ begin
+ BL := BL + 1;
+ LL := LL + 1;
+
+ BR := BR + 1;
+ LR := LR + 1;
+
+ L_Node := Left.First;
+ R_Node := Right.First;
+ loop
+ if L_Node = 0 then
+ exit;
+ end if;
+
+ if R_Node = 0 then
+ exit;
+ 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;
+
+ BL := BL - 1;
+ LL := LL - 1;
+
+ BR := BR - 1;
+ LR := LR - 1;
+ exception
+ when others =>
+ BL := BL - 1;
+ LL := LL - 1;
+
+ BR := BR - 1;
+ LR := LR - 1;
+
+ raise;
+ end;
+ end return;
+ end Set_Intersection;
+
+ ---------------
+ -- Is_Subset --
+ ---------------
+
+ function Set_Subset
+ (Subset : Set_Type;
+ Of_Set : Set_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;
+
+ -- Per AI05-0022, the container implementation is required to detect
+ -- element tampering by a generic actual subprogram.
+
+ declare
+ BL : Natural renames Subset'Unrestricted_Access.Busy;
+ LL : Natural renames Subset'Unrestricted_Access.Lock;
+
+ BR : Natural renames Of_Set'Unrestricted_Access.Busy;
+ LR : Natural renames Of_Set'Unrestricted_Access.Lock;
+
+ Subset_Node : Count_Type;
+ Set_Node : Count_Type;
+
+ Result : Boolean;
+
+ begin
+ BL := BL + 1;
+ LL := LL + 1;
+
+ BR := BR + 1;
+ LR := LR + 1;
+
+ Subset_Node := Subset.First;
+ Set_Node := Of_Set.First;
+ loop
+ if Set_Node = 0 then
+ Result := Subset_Node = 0;
+ exit;
+ end if;
+
+ if Subset_Node = 0 then
+ Result := True;
+ exit;
+ end if;
+
+ if Is_Less (Subset.Nodes (Subset_Node),
+ Of_Set.Nodes (Set_Node))
+ then
+ Result := False;
+ exit;
+ 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;
+
+ BL := BL - 1;
+ LL := LL - 1;
+
+ BR := BR - 1;
+ LR := LR - 1;
+
+ return Result;
+ exception
+ when others =>
+ BL := BL - 1;
+ LL := LL - 1;
+
+ BR := BR - 1;
+ LR := LR - 1;
+
+ raise;
+ end;
+ end Set_Subset;
+
+ -------------
+ -- Overlap --
+ -------------
+
+ function Set_Overlap (Left, Right : Set_Type) return Boolean is
+ begin
+ if Left'Address = Right'Address then
+ return Left.Length /= 0;
+ end if;
+
+ -- Per AI05-0022, the container implementation is required to detect
+ -- element tampering by a generic actual subprogram.
+
+ declare
+ BL : Natural renames Left'Unrestricted_Access.Busy;
+ LL : Natural renames Left'Unrestricted_Access.Lock;
+
+ BR : Natural renames Right'Unrestricted_Access.Busy;
+ LR : Natural renames Right'Unrestricted_Access.Lock;
+
+ L_Node : Count_Type;
+ R_Node : Count_Type;
+
+ Result : Boolean;
+
+ begin
+ BL := BL + 1;
+ LL := LL + 1;
+
+ BR := BR + 1;
+ LR := LR + 1;
+
+ L_Node := Left.First;
+ R_Node := Right.First;
+ loop
+ if L_Node = 0
+ or else R_Node = 0
+ then
+ Result := False;
+ exit;
+ 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
+ Result := True;
+ exit;
+ end if;
+ end loop;
+
+ BL := BL - 1;
+ LL := LL - 1;
+
+ BR := BR - 1;
+ LR := LR - 1;
+
+ return Result;
+ exception
+ when others =>
+ BL := BL - 1;
+ LL := LL - 1;
+
+ BR := BR - 1;
+ LR := LR - 1;
+
+ raise;
+ end;
+ end Set_Overlap;
+
+ --------------------------
+ -- Symmetric_Difference --
+ --------------------------
+
+ procedure Set_Symmetric_Difference
+ (Target : in out Set_Type;
+ Source : Set_Type)
+ is
+ BT : Natural renames Target.Busy;
+ LT : Natural renames Target.Lock;
+
+ BS : Natural renames Source'Unrestricted_Access.Busy;
+ LS : Natural renames Source'Unrestricted_Access.Lock;
+
+ Tgt : Count_Type;
+ Src : Count_Type;
+
+ New_Tgt_Node : Count_Type;
+ pragma Warnings (Off, New_Tgt_Node);
+
+ Compare : Integer;
+
+ begin
+ 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;
+
+ -- Per AI05-0022, the container implementation is required to detect
+ -- element tampering by a generic actual subprogram.
+
+ begin
+ BT := BT + 1;
+ LT := LT + 1;
+
+ BS := BS + 1;
+ LS := LS + 1;
+
+ if Is_Less (Target.Nodes (Tgt), Source.Nodes (Src)) then
+ Compare := -1;
+ elsif Is_Less (Source.Nodes (Src), Target.Nodes (Tgt)) then
+ Compare := 1;
+ else
+ Compare := 0;
+ end if;
+
+ BT := BT - 1;
+ LT := LT - 1;
+
+ BS := BS - 1;
+ LS := LS - 1;
+ exception
+ when others =>
+ BT := BT - 1;
+ LT := LT - 1;
+
+ BS := BS - 1;
+ LS := LS - 1;
+
+ raise;
+ end;
+
+ if Compare < 0 then
+ Tgt := Tree_Operations.Next (Target, Tgt);
+
+ elsif Compare > 0 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
+ 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
+
+ -- Per AI05-0022, the container implementation is required to detect
+ -- element tampering by a generic actual subprogram.
+
+ declare
+ BL : Natural renames Left'Unrestricted_Access.Busy;
+ LL : Natural renames Left'Unrestricted_Access.Lock;
+
+ BR : Natural renames Right'Unrestricted_Access.Busy;
+ LR : Natural renames Right'Unrestricted_Access.Lock;
+
+ L_Node : Count_Type;
+ R_Node : Count_Type;
+
+ Dst_Node : Count_Type;
+ pragma Warnings (Off, Dst_Node);
+
+ begin
+ BL := BL + 1;
+ LL := LL + 1;
+
+ BR := BR + 1;
+ LR := LR + 1;
+
+ 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;
+
+ exit;
+ 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;
+
+ exit;
+ 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;
+
+ BL := BL - 1;
+ LL := LL - 1;
+
+ BR := BR - 1;
+ LR := LR - 1;
+ exception
+ when others =>
+ BL := BL - 1;
+ LL := LL - 1;
+
+ BR := BR - 1;
+ LR := LR - 1;
+
+ raise;
+ end;
+ 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;
+
+ -- Per AI05-0022, the container implementation is required to detect
+ -- element tampering by a generic actual subprogram.
+
+ declare
+ BS : Natural renames Source'Unrestricted_Access.Busy;
+ LS : Natural renames Source'Unrestricted_Access.Lock;
+
+ begin
+ BS := BS + 1;
+ LS := LS + 1;
+
+ -- 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);
+
+ BS := BS - 1;
+ LS := LS - 1;
+ exception
+ when others =>
+ BS := BS - 1;
+ LS := LS - 1;
+
+ raise;
+ end;
+ 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
+ declare
+ BL : Natural renames Left'Unrestricted_Access.Busy;
+ LL : Natural renames Left'Unrestricted_Access.Lock;
+
+ BR : Natural renames Right'Unrestricted_Access.Busy;
+ LR : Natural renames Right'Unrestricted_Access.Lock;
+
+ begin
+ BL := BL + 1;
+ LL := LL + 1;
+
+ BR := BR + 1;
+ LR := LR + 1;
+
+ 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;
+
+ BL := BL - 1;
+ LL := LL - 1;
+
+ BR := BR - 1;
+ LR := LR - 1;
+ exception
+ when others =>
+ BL := BL - 1;
+ LL := LL - 1;
+
+ BR := BR - 1;
+ LR := LR - 1;
+
+ raise;
+ end;
+ end return;
+ end Set_Union;
+
+end Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations;