------------------------------------------------------------------------------
--                                                                          --
--                         GNAT LIBRARY COMPONENTS                          --
--                                                                          --
--           ADA.CONTAINERS.RED_BLACK_TREES.GENERIC_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_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
      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 : Node_Access;
      Src : Node_Access;

      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;

         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;

      Tgt := Target.First;
      Src := Source.First;
      loop
         if Tgt = null then
            exit;
         end if;

         if Src = null 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 (Tgt, Src) then
               Compare := -1;
            elsif Is_Less (Src, 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 (Tgt);

         elsif Compare > 0 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
   begin
      if Left'Address = Right'Address then
         return Tree_Type'(others => <>);  -- Empty set
      end if;

      if Left.Length = 0 then
         return Tree_Type'(others => <>);  -- Empty set
      end if;

      if Right.Length = 0 then
         return Copy (Left);
      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;

         Tree : Tree_Type;

         L_Node : Node_Access;
         R_Node : Node_Access;

         Dst_Node : Node_Access;
         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 = null then
               exit;
            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;

               exit;
            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;

         BL := BL - 1;
         LL := LL - 1;

         BR := BR - 1;
         LR := LR - 1;

         return Tree;

      exception
         when others =>
            BL := BL - 1;
            LL := LL - 1;

            BR := BR - 1;
            LR := LR - 1;

            Delete_Tree (Tree.Root);
            raise;
      end;
   end Difference;

   ------------------
   -- Intersection --
   ------------------

   procedure Intersection
     (Target : in out Tree_Type;
      Source : Tree_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 : Node_Access;
      Src : Node_Access;

      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
         Clear (Target);
         return;
      end if;

      Tgt := Target.First;
      Src := Source.First;
      while Tgt /= null
        and then Src /= null
      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 (Tgt, Src) then
               Compare := -1;
            elsif Is_Less (Src, 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 : Node_Access := Tgt;
            begin
               Tgt := Tree_Operations.Next (Tgt);
               Tree_Operations.Delete_Node_Sans_Free (Target, X);
               Free (X);
            end;

         elsif Compare > 0 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
   begin
      if Left'Address = Right'Address then
         return Copy (Left);
      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;

         Tree : Tree_Type;

         L_Node : Node_Access;
         R_Node : Node_Access;

         Dst_Node : Node_Access;
         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 = null then
               exit;
            end if;

            if R_Node = null then
               exit;
            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;

         BL := BL - 1;
         LL := LL - 1;

         BR := BR - 1;
         LR := LR - 1;

         return Tree;

      exception
         when others =>
            BL := BL - 1;
            LL := LL - 1;

            BR := BR - 1;
            LR := LR - 1;

            Delete_Tree (Tree.Root);
            raise;
      end;
   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;

      --  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 : Node_Access;
         Set_Node    : Node_Access;

         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 = null then
               Result := Subset_Node = null;
               exit;
            end if;

            if Subset_Node = null then
               Result := True;
               exit;
            end if;

            if Is_Less (Subset_Node, Set_Node) then
               Result := False;
               exit;
            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;

         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 Is_Subset;

   -------------
   -- Overlap --
   -------------

   function Overlap (Left, Right : Tree_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 : Node_Access;
         R_Node : Node_Access;

         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 = null
              or else R_Node = null
            then
               Result := False;
               exit;
            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
               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 Overlap;

   --------------------------
   -- Symmetric_Difference --
   --------------------------

   procedure Symmetric_Difference
     (Target : in out Tree_Type;
      Source : Tree_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 : Node_Access;
      Src : Node_Access;

      New_Tgt_Node : Node_Access;
      pragma Warnings (Off, New_Tgt_Node);

      Compare : Integer;

   begin
      if Target'Address = Source'Address then
         Clear (Target);
         return;
      end if;

      Tgt := Target.First;
      Src := Source.First;
      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;

         --  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 (Tgt, Src) then
               Compare := -1;
            elsif Is_Less (Src, 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 (Tgt);

         elsif Compare > 0 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
   begin
      if Left'Address = Right'Address then
         return Tree_Type'(others => <>);  -- Empty set
      end if;

      if Right.Length = 0 then
         return Copy (Left);
      end if;

      if Left.Length = 0 then
         return Copy (Right);
      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;

         Tree : Tree_Type;

         L_Node : Node_Access;
         R_Node : Node_Access;

         Dst_Node : Node_Access;
         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 = 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;

               exit;
            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;

               exit;
            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;

         BL := BL - 1;
         LL := LL - 1;

         BR := BR - 1;
         LR := LR - 1;

         return Tree;

      exception
         when others =>
            BL := BL - 1;
            LL := LL - 1;

            BR := BR - 1;
            LR := LR - 1;

            Delete_Tree (Tree.Root);
            raise;
      end;
   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,  -- use node most recently inserted as hint
            Src_Node => 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;

         Iterate (Source);

         BS := BS - 1;
         LS := LS - 1;

      exception
         when others =>
            BS := BS - 1;
            LS := LS - 1;

            raise;
      end;
   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
         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;

         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,  -- use node most recently inserted as hint
               Src_Node => Node,
               Dst_Node => Hint);
         end Process;

      --  Start of processing for Union

      begin
         BL := BL + 1;
         LL := LL + 1;

         BR := BR + 1;
         LR := LR + 1;

         Iterate (Right);

         BL := BL - 1;
         LL := LL - 1;

         BR := BR - 1;
         LR := LR - 1;

         return Tree;

      exception
         when others =>
            BL := BL - 1;
            LL := LL - 1;

            BR := BR - 1;
            LR := LR - 1;

            Delete_Tree (Tree.Root);
            raise;
      end;
   end Union;

end Ada.Containers.Red_Black_Trees.Generic_Set_Operations;