File : charles-deques-unbounded.adb


------------------------------------------------------------------------------

--                                                                          --

--                      CHARLES CONTAINER LIBRARY                           --

--                                                                          --

--              Copyright (C) 2001-2003 Matthew J Heaney                    --

--                                                                          --

-- The Charles Container Library ("Charles") is free software; you can      --

-- redistribute it and/or modify it under terms of the GNU General Public   --

-- License as published by the Free Software Foundation; either version 2,  --

-- or (at your option) any later version.  Charles is distributed in the    --

-- hope that it will be useful, but WITHOUT ANY WARRANTY; without even the  --

-- implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --

-- See the GNU General Public License for more details.  You should have    --

-- received a copy of the GNU General Public License distributed with       --

-- Charles;  see file COPYING.TXT.  If not, write to the Free Software      --

-- Foundation,  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.    --

--                                                                          --

-- As a special exception, if other files instantiate generics from this    --

-- unit, or you link this unit with other files to produce an executable,   --

-- this unit does not by itself cause the resulting executable to be        --

-- covered by the GNU General Public License.  This exception does not      --

-- however invalidate any other reasons why the executable file might be    --

-- covered by the GNU Public License.                                       --

--                                                                          --

-- Charles is maintained by Matthew J Heaney.                               --

--                                                                          --

-- http://home.earthlink.net/~matthewjheaney/index.html                     --

-- mailto:matthewjheaney@earthlink.net                                      --

--                                                                          --

------------------------------------------------------------------------------

with System;

package body Charles.Deques.Unbounded is

   use Ada.Finalization;
   use type System.Address;
   use Rep_Types;


   procedure Initialize (Container : in out Container_Type) is
   begin
      Initialize (Container.Map);
   end;

   procedure Adjust (Container : in out Container_Type) is
   begin
      Adjust (Container.Map);
   end;

   procedure Finalize (Container : in out Container_Type) is
   begin
      Finalize (Container.Map);
   end;


   function "=" (Left, Right : Container_Type) return Boolean is
   begin
      if Left'Address = Right'Address then
         return True;
      end if;

      return Is_Equal (Left.Map, Right.Map);
   end;


   function Length (Container : Container_Type) return Natural is
   begin
      return Container.Map.Length;
   end;


   function Is_Empty (Container : Container_Type) return Boolean is
   begin
      return Length (Container) = 0;
   end;


   procedure Clear (Container : in out Container_Type) is
   begin
      Clear (Container.Map);
   end;


   procedure Swap (Left, Right : in out Container_Type) is
   begin
      Swap (Left.Map, Right.Map);
   end;


   function To_Container
     (Length : Natural) return Container_Type is

      Map : Map_Type;

      Node_Count : constant Natural :=
         (Length + Elements_Per_Node - 1) / Elements_Per_Node;

   begin

      Map.Length := Length;

      if Node_Count /= 0 then

         Map.Nodes := new Node_Access_Array (1 .. Node_Count);

         for I in Map.Nodes'Range loop
            Map.Nodes (I) := new Node_Type;
         end loop;

         Map.First := Map.Nodes'First;

         Map.Last := Map.Nodes'Last;

         Map.Bias := 0;

      end if;

      return Container_Type'(Controlled with Map);

   end To_Container;


   function To_Container
     (Length : Natural;
      Item   : Element_Type) return Container_Type is

      Map : Map_Type;

      Node_Count : constant Natural :=
         (Length + Elements_Per_Node - 1) / Elements_Per_Node;

   begin

      Map.Length := Length;

      if Node_Count /= 0 then

         Map.Nodes := new Node_Access_Array (1 .. Node_Count);

         for I in Map.Nodes'Range loop

            Map.Nodes (I) :=
               new Node_Type'(Elements => (others => Item));

         end loop;

         Map.First := Map.Nodes'First;

         Map.Last := Map.Nodes'Last;

         Map.Bias := 0;

      end if;

      return Container_Type'(Controlled with Map);

   end To_Container;


   procedure Assign
     (Target : in out Container_Type;
      Length : in     Natural) is
   begin
      Assign (Target.Map, Length);
   end;


   procedure Assign
     (Target : in out Container_Type;
      Length : in     Natural;
      Item   : in     Element_Type) is

      procedure Process (Element : in out Element_Type) is
      begin
         Element := Item;
      end;

      procedure Iterate is
         new Generic_Modify_Elements;
   begin
      Assign (Target.Map, Length);
      Iterate (Target, First (Target), Back (Target));
   end;


   procedure Assign
     (Target : in out Container_Type;
      Source : in     Container_Type) is

      Index : Natural := 0;

      procedure Process (Element : Element_Type) is
      begin
         Replace_Element (Target.Map, Index, Element);
         Index := Index + 1;
      end;

      procedure Iterate is
         new Generic_Select_Elements;
   begin
      Assign (Target, Length (Source));
      Iterate (Source, First (Source), Back (Source));
   end;



   procedure Prepend
     (Container : in out Container_Type) is

      Node          : Node_Access;
      Element_Index : Integer'Base;
   begin
      Prepend (Container.Map, Node, Element_Index);
   end;


   procedure Prepend
     (Container : in out Container_Type;
      New_Item  : in     Element_Type) is

      Node          : Node_Access;
      Element_Index : Integer'Base;
   begin
      Prepend (Container.Map, Node, Element_Index);
      Node.Elements (Element_Index) := New_Item;
   end;


   procedure Delete_First (Container : in out Container_Type) is
   begin
      Delete_First (Container.Map);
   end;


   procedure Append
     (Container : in out Container_Type) is

      Element_Index : Integer'Base;
   begin
      Append (Container.Map, Element_Index);
   end;


   procedure Append
     (Container : in out Container_Type;
      New_Item  : in     Element_Type) is

      Map : Map_Type renames Container.Map;

      I : Integer'Base;
   begin
      Append (Map, I);
      Map.Nodes (Map.Last).Elements (I) := New_Item;
   end;



   procedure Delete_Last (Container : in out Container_Type) is
   begin
      Delete_Last (Container.Map);
   end;


   procedure Insert
     (Container : in out Container_Type;
      Before    : in     Index_Type'Base;
      New_Item  : in     Element_Type) is

      Before_Index : constant Integer'Base :=
         Index_Type'Pos (Before) - Index_Type'Pos (Index_Type'First);
   begin
      Insert (Container.Map, Before_Index, New_Item);
   end;




   procedure Insert_Range
     (Container : in out Container_Type;
      Before    : in     Index_Type'Base;
      Length    : in     Natural) is

      Before_Index : constant Integer'Base :=
         Index_Type'Pos (Before) - Index_Type'Pos (Index_Type'First);
   begin
      Insert_Range
        (Container.Map,
         Before_Index,
         Length);
   end;



   procedure Delete
     (Container : in out Container_Type;
      Index     : in     Index_Type) is

      Iterator_Index : constant Integer'Base :=
         Index_Type'Pos (Index) - Index_Type'Pos (Index_Type'First);
   begin
      Delete (Container.Map, Iterator_Index);
   end;


   procedure Delete
     (Container : in out Container_Type;
      First     : in     Index_Type;
      Back      : in     Index_Type'Base) is

      F : constant Integer'Base :=
         Index_Type'Pos (First) -
         Index_Type'Pos (Index_Type'First);

      L : constant Integer'Base :=
         Index_Type'Pos (Index_Type'Pred (Back)) -
         Index_Type'Pos (Index_Type'First);
   begin
      Delete (Container.Map, First => F, Last => L);
   end;


   function Element
     (Container : Container_Type;
      Index     : Index_Type) return Element_Type is

      I : constant Integer'Base :=
         Index_Type'Pos (Index) - Index_Type'Pos (Index_Type'First);
   begin
      return Element (Container.Map, I);
   end;


   function Generic_Element
     (Container : Container_Type;
      Index     : Index_Type) return Element_Access is

      I : constant Integer'Base :=
         Index_Type'Pos (Index) - Index_Type'Pos (Index_Type'First);

      Node_Index    : Positive;
      Element_Index : Positive;
   begin
      Element (Container.Map, I, Node_Index, Element_Index);

      declare
         Node : Node_Type renames Container.Map.Nodes (Node_Index).all;
      begin
         return Node.Elements (Element_Index)'Access;
      end;
   end;


   procedure Replace_Element
     (Container : Container_Type;
      Index     : Index_Type;
      By        : Element_Type) is

      I : constant Integer'Base :=
         Index_Type'Pos (Index) - Index_Type'Pos (Index_Type'First);
   begin
      Replace_Element (Container.Map, I, By);
   end;


--   procedure Assign

--     (Target : in out Element_Type;

--      Source : in     Container_Type;

--      Index  : in     Index_Type) is


   procedure Copy
     (Container : in     Container_Type;
      Index     : in     Index_Type;
      Item      :    out Element_Type) is

      I : constant Integer'Base :=
         Index_Type'Pos (Index) - Index_Type'Pos (Index_Type'First);

      Node_Index    : Positive;
      Element_Index : Positive;
   begin
      Element (Container.Map, I, Node_Index, Element_Index);

      declare
         Node : Node_Type renames Container.Map.Nodes (Node_Index).all;
      begin
         Item := Node.Elements (Element_Index);
      end;
   end;


   procedure Swap
     (Container : in     Container_Type;
      Index     : in     Index_Type;
      Item      : in out Element_Type) is

      I : constant Integer'Base :=
         Index_Type'Pos (Index) - Index_Type'Pos (Index_Type'First);

      Node_Index    : Positive;
      Element_Index : Positive;
   begin
      Element (Container.Map, I, Node_Index, Element_Index);

      declare
         Node : Node_Type renames Container.Map.Nodes (Node_Index).all;
         E    : Element_Type renames Node.Elements (Element_Index);
         E_Copy : constant Element_Type := E;
      begin
         E := Item;
         Item := E_Copy;
      end;
   end;


   procedure Generic_Swap
     (Container : in     Container_Type;
      Index     : in     Index_Type;
      Item      : in out Element_Type) is

      I : constant Integer'Base :=
         Index_Type'Pos (Index) - Index_Type'Pos (Index_Type'First);

      Node_Index    : Positive;
      Element_Index : Positive;
   begin
      Element (Container.Map, I, Node_Index, Element_Index);

      declare
         Node : Node_Type renames Container.Map.Nodes (Node_Index).all;
      begin
         Swap (Node.Elements (Element_Index), Item);
      end;
   end;


   procedure Swap_Element
     (Container   : in Container_Type;
      Left, Right : in Index_Type) is

      LI : constant Integer'Base :=
         Index_Type'Pos (Left) - Index_Type'Pos (Index_Type'First);

      RI : constant Integer'Base :=
         Index_Type'Pos (Right) - Index_Type'Pos (Index_Type'First);

      L_NI, R_NI : Positive;
      L_EI, R_EI : Positive;

      Map : Map_Type renames Container.Map;

   begin

      Element (Map, LI, L_NI, L_EI);
      Element (Map, RI, R_NI, R_EI);

      declare
         LN : Node_Type renames Map.Nodes (L_NI).all;
         LE : Element_Type renames LN.Elements (L_EI);

         RN : Node_Type renames Map.Nodes (R_NI).all;
         RE : Element_Type renames RN.Elements (R_EI);

         LE_Copy : constant Element_Type := LE;
      begin
         LE := RE;
         RE := LE_Copy;
      end;

   end Swap_Element;


   procedure Generic_Swap_Element
     (Container   : in Container_Type;
      Left, Right : in Index_Type) is

      LI : constant Integer'Base :=
         Index_Type'Pos (Left) - Index_Type'Pos (Index_Type'First);

      RI : constant Integer'Base :=
         Index_Type'Pos (Right) - Index_Type'Pos (Index_Type'First);

      L_NI, R_NI : Positive;
      L_EI, R_EI : Positive;

      Map : Map_Type renames Container.Map;

   begin

      Element (Map, LI, L_NI, L_EI);
      Element (Map, RI, R_NI, R_EI);

      declare
         LN : Node_Type renames Map.Nodes (L_NI).all;
         LE : Element_Type renames LN.Elements (L_EI);

         RN : Node_Type renames Map.Nodes (R_NI).all;
         RE : Element_Type renames RN.Elements (R_EI);
      begin
         Swap (LE, RE);
      end;

   end Generic_Swap_Element;


   procedure Generic_Select_Element
     (Container : Container_Type;
      Index     : Index_Type) is

      I : constant Integer'Base :=
         Index_Type'Pos (Index) - Index_Type'Pos (Index_Type'First);

      Node_Index    : Positive;
      Element_Index : Positive;
   begin
      Element (Container.Map, I, Node_Index, Element_Index);

      declare
         Node : Node_Type renames Container.Map.Nodes (Node_Index).all;
      begin
         Process (Node.Elements (Element_Index));
      end;
   end;


   procedure Generic_Modify_Element
     (Container : Container_Type;
      Index     : Index_Type) is

      I : constant Integer'Base :=
         Index_Type'Pos (Index) - Index_Type'Pos (Index_Type'First);

      Node_Index    : Positive;
      Element_Index : Positive;
   begin
      Element (Container.Map, I, Node_Index, Element_Index);

      declare
         Node : Node_Type renames Container.Map.Nodes (Node_Index).all;
      begin
         Process (Node.Elements (Element_Index));
      end;
   end;


   procedure Generic_Access_Element
     (Container : Container_Type;
      Index     : Index_Type) is

      I : constant Integer'Base :=
         Index_Type'Pos (Index) - Index_Type'Pos (Index_Type'First);

      Node_Index    : Positive;
      Element_Index : Positive;
   begin
      Element (Container.Map, I, Node_Index, Element_Index);

      declare
         Node : Node_Type renames Container.Map.Nodes (Node_Index).all;
      begin
         Process (Node.Elements (Element_Index)'Access);
      end;
   end;


   procedure Generic_Iteration
     (Container : Container_Type;
      First     : Index_Type;
      Back      : Index_Type'Base) is
   begin
      for I in First .. Index_Type'Pred (Back) loop
         Process (Container, I);
      end loop;
   end;


   procedure Generic_Reverse_Iteration
     (Container : Container_Type;
      First     : Index_Type;
      Back      : Index_Type'Base) is
   begin
      for I in reverse First .. Index_Type'Pred (Back) loop
         Process (Container, I);
      end loop;
   end;


   procedure Generic_Select_Elements
     (Container : Container_Type;
      First     : Index_Type;
      Back      : Index_Type'Base) is

      F : constant Integer'Base :=
         Index_Type'Pos (First) - Index_Type'Pos (Index_Type'First);

      L : constant Integer'Base :=
         Index_Type'Pos (Index_Type'Pred (Back)) -
         Index_Type'Pos (Index_Type'First);

      procedure Process
        (Node          : access Node_Type;
         First_Element : Positive;
         Last_Element  : Positive) is
      begin
         for I in First_Element .. Last_Element loop
            Process (Node.Elements (I));
         end loop;
      end;

      procedure Iterate is
         new Rep_Types.Generic_Iteration (Process);
   begin
      Iterate (Container.Map, F, L);
   end;



   procedure Generic_Modify_Elements
     (Container : Container_Type;
      First     : Index_Type;
      Back      : Index_Type'Base) is

      F : constant Integer'Base :=
         Index_Type'Pos (First) - Index_Type'Pos (Index_Type'First);

      L : constant Integer'Base :=
         Index_Type'Pos (Index_Type'Pred (Back)) -
         Index_Type'Pos (Index_Type'First);

      procedure Process
        (Node          : access Node_Type;
         First_Element : Positive;
         Last_Element  : Positive) is
      begin
         for I in First_Element .. Last_Element loop
            Process (Node.Elements (I));
         end loop;
      end;

      procedure Iterate is
         new Rep_Types.Generic_Iteration (Process);
   begin
      Iterate (Container.Map, F, L);
   end;


   procedure Generic_Access_Elements
     (Container : Container_Type;
      First     : Index_Type;
      Back      : Index_Type'Base) is

      F : constant Integer'Base :=
         Index_Type'Pos (First) - Index_Type'Pos (Index_Type'First);

      L : constant Integer'Base :=
         Index_Type'Pos (Index_Type'Pred (Back)) -
         Index_Type'Pos (Index_Type'First);

      procedure Process
        (Node          : access Node_Type;
         First_Element : Positive;
         Last_Element  : Positive) is
      begin
         for I in First_Element .. Last_Element loop
            Process (Node.Elements (I)'Access);
         end loop;
      end;

      procedure Iterate is
         new Rep_Types.Generic_Iteration (Process);
   begin
      Iterate (Container.Map, F, L);
   end;



   procedure Generic_Reverse_Select_Elements
     (Container : Container_Type;
      First     : Index_Type;
      Back      : Index_Type'Base) is

      F : constant Integer'Base :=
         Index_Type'Pos (First) - Index_Type'Pos (Index_Type'First);

      L : constant Integer'Base :=
         Index_Type'Pos (Index_Type'Pred (Back)) -
         Index_Type'Pos (Index_Type'First);

      procedure Process
        (Node          : access Node_Type;
         First_Element : Positive;
         Last_Element  : Positive) is
      begin
         for I in reverse First_Element .. Last_Element loop
            Process (Node.Elements (I));
         end loop;
      end;

      procedure Iterate is
         new Rep_Types.Generic_Reverse_Iteration (Process);
   begin
      Iterate (Container.Map, F, L);
   end;



   procedure Generic_Reverse_Modify_Elements
     (Container : Container_Type;
      First     : Index_Type;
      Back      : Index_Type'Base) is

      F : constant Integer'Base :=
         Index_Type'Pos (First) - Index_Type'Pos (Index_Type'First);

      L : constant Integer'Base :=
         Index_Type'Pos (Index_Type'Pred (Back)) -
         Index_Type'Pos (Index_Type'First);

      procedure Process
        (Node          : access Node_Type;
         First_Element : Positive;
         Last_Element  : Positive) is
      begin
         for I in reverse First_Element .. Last_Element loop
            Process (Node.Elements (I));
         end loop;
      end;

      procedure Iterate is
         new Rep_Types.Generic_Reverse_Iteration (Process);
   begin
      Iterate (Container.Map, F, L);
   end;


   procedure Generic_Reverse_Access_Elements
     (Container : Container_Type;
      First     : Index_Type;
      Back      : Index_Type'Base) is

      F : constant Integer'Base :=
         Index_Type'Pos (First) - Index_Type'Pos (Index_Type'First);

      L : constant Integer'Base :=
         Index_Type'Pos (Index_Type'Pred (Back)) -
         Index_Type'Pos (Index_Type'First);

      procedure Process
        (Node          : access Node_Type;
         First_Element : Positive;
         Last_Element  : Positive) is
      begin
         for I in reverse First_Element .. Last_Element loop
            Process (Node.Elements (I)'Access);
         end loop;
      end;

      procedure Iterate is
         new Rep_Types.Generic_Reverse_Iteration (Process);
   begin
      Iterate (Container.Map, F, L);
   end;



   function Front (Container : Container_Type)
      return Index_Type'Base is
   begin
      return Index_Type'Pred (Index_Type'First);
   end;


   function First (Container : Container_Type)
      return Index_Type is
   begin
      return Index_Type'First;
   end;


   function Last (Container : Container_Type)
      return Index_Type'Base is

      First : constant Integer'Base :=
         Index_Type'Pos (Index_Type'First);

      Offset : constant Integer'Base := Container.Map.Length - 1;

      Result : constant Index_Type'Base :=
         Index_Type'Val (First + Offset);
   begin
      return Result;
   end;


   function Back (Container : Container_Type)
      return Index_Type'Base is

      First : constant Integer'Base :=
         Index_Type'Pos (Index_Type'First);

      Offset : constant Integer'Base := Container.Map.Length;

      Result : constant Index_Type'Base :=
         Index_Type'Val (First + Offset);
   begin
      return Result;
   end;


   function Generic_Find
     (Container : Container_Type;
      First     : Index_Type;
      Back      : Index_Type'Base) return Index_Type'Base is

      F : constant Integer'Base :=
         Index_Type'Pos (First) - Index_Type'Pos (Index_Type'First);

      L : constant Integer'Base :=
         Index_Type'Pos (Index_Type'Pred (Back)) -
         Index_Type'Pos (Index_Type'First);

      function Find is
         new Rep_Types.Generic_Find (Predicate);

      Offset : constant Integer'Base :=
         Find (Container.Map, F, L);

      Result : constant Index_Type'Base :=
         Index_Type'Val (Index_Type'Pos (Index_Type'First) + Offset);
   begin
      return Result;
   end;


   function Find
     (Container : Container_Type;
      First     : Index_Type;
      Back      : Index_Type'Base;
      Item      : Element_Type) return Index_Type'Base is

      function Predicate (Element : Element_Type) return Boolean is
      begin
         return Item = Element;
      end;

      function Find is
         new Generic_Find (Predicate);
   begin
      return Find (Container, First => First, Back => Back);
   end;


   function Find
     (Container : Container_Type;
      Item      : Element_Type) return Index_Type'Base is
   begin
      return Find (Container,
                   First => First (Container),
                   Back => Back (Container),
                   Item => Item);
   end;


   function Generic_Reverse_Find
     (Container : Container_Type;
      First     : Index_Type;
      Back      : Index_Type'Base) return Index_Type'Base is

      F : constant Integer'Base :=
         Index_Type'Pos (First) - Index_Type'Pos (Index_Type'First);

      L : constant Integer'Base :=
         Index_Type'Pos (Index_Type'Pred (Back)) -
         Index_Type'Pos (Index_Type'First);

      function Find is
         new Rep_Types.Generic_Reverse_Find (Predicate);

      Offset : constant Integer'Base :=
         Find (Container.Map, F, L);

      Result : constant Index_Type'Base :=
         Index_Type'Val (Index_Type'Pos (Index_Type'First) + Offset);
   begin
      return Result;
   end;


   function Reverse_Find
     (Container : Container_Type;
      First     : Index_Type;
      Back      : Index_Type'Base;
      Item      : Element_Type) return Index_Type'Base is

      function Predicate (Element : Element_Type) return Boolean is
      begin
         return Item = Element;
      end;

      function Reverse_Find is
         new Generic_Reverse_Find (Predicate);
   begin
      return Reverse_Find (Container, First => First, Back => Back);
   end;


   function Reverse_Find
     (Container : Container_Type;
      Item      : Element_Type) return Index_Type'Base is
   begin
      return Reverse_Find (Container,
                           First => First (Container),
                           Back => Back (Container),
                           Item => Item);
   end;


end Charles.Deques.Unbounded;