------------------------------------------------------------------------------
--                                                                          --
--                        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 Ada.Unchecked_Deallocation;

with System;  use type System.Address;

with Charles.Algorithms.Generic_Lexicographical_Compare;
with Charles.Algorithms.Generic_Quicksort_Array;
--with Charles.Algorithms.Generic_Reverse_Random_Access;
--with Charles.Algorithms.Generic_Remove;

package body Charles.Vectors.Unbounded is

   type Int is range System.Min_Int .. System.Max_Int;


   procedure Free is
      new Ada.Unchecked_Deallocation (Element_Array,
                                      Element_Array_Access);


--     function To_Integer (Index : Index_Type'Base) return Integer'Base is
--        pragma Inline (To_Integer);

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

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

--        Offset : constant Integer'Base := I - F;

--        Result : constant Integer'Base := 1 + Offset;

--     begin
--        return Result;
--     end;


--     function To_Index (I : Integer'Base) return Index_Type'Base is
--        pragma Inline (To_Index);

--        Offset : constant Integer'Base := I - 1;

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

--        J : constant Integer'Base := F + Offset;

--        Result : constant Index_Type'Base := Index_Type'Val (J);

--     begin
--        return Result;
--     end;


   procedure Adjust (Container : in out Container_Type) is
   begin

      if Container.Elements = null then
         return;
      end if;

      if Container.Elements'Length = 0
        or else Container.Last = Last_Subtype'First
      then
         Container.Elements := null;
         return;
      end if;

      declare
         Source : Element_Array renames
            Container.Elements (Index_Type'First .. Container.Last);
      begin
         Container.Elements := new Element_Array'(Source);
      exception
         when others =>
            Container.Elements := null;
            Container.Last := Last_Subtype'First;
            raise;
      end;

   end Adjust;


   procedure Finalize (Container : in out Container_Type) is
   begin

      Container.Last := Last_Subtype'First;

      begin
         Free (Container.Elements);
      exception
         when others =>
            Container.Elements := null;
            raise;
      end;

   end Finalize;


   function "=" (Left, Right : Container_Type) return Boolean is
   begin

      if Left'Address = Right'Address then
         return True;
      end if;

      if Left.Last /= Right.Last then
         return False;
      end if;

      for I in Index_Type'First .. Left.Last loop

         if Left.Elements (I) /= Right.Elements (I) then
            return False;
         end if;

      end loop;

      return True;

   end "=";


   function Generic_Less (Left, Right : Container_Type) return Boolean is

      function Is_Less (LI, RI : Index_Type'Base) return Boolean is
         pragma Inline (Is_Less);
      begin
         return Left.Elements (LI) < Right.Elements (RI);
      end;

      function Lexicographical_Compare is
         new Charles.Algorithms.Generic_Lexicographical_Compare
              (Iterator_Type => Index_Type'Base,
               Succ          => Index_Type'Succ);

   begin -- Generic_Less

      if Left'Address = Right'Address then
         return False;
      end if;

      return Lexicographical_Compare
               (Left_First  => Index_Type'First,
                Left_Back   => Index_Type'Succ (Left.Last),
                Right_First => Index_Type'First,
                Right_Back  => Index_Type'Succ (Right.Last));

   end Generic_Less;


   function To_Access
     (Container : Container_Type) return Element_Array_Access is
   begin
      return Container.Elements;
   end;


   function Length (Container : Container_Type) return Natural is

      First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);

      Last_As_Int : constant Int := Index_Type'Pos (Container.Last);

      Result : constant Int'Base := Last_As_Int - First_As_Int + 1;

   begin
      return Natural (Result);
   end;


   procedure Set_Length
     (Container : in out Container_Type;
      Length    : in     Natural) is

      First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);

      N : constant Int := Integer'Pos (Length);

      Last_As_Int : constant Int'Base := First_As_Int + N - 1;

      Last : constant Last_Subtype := Index_Type'Val (Last_As_Int);

   begin

      Resize (Container, Size => Length);

      Container.Last := Last;

   end Set_Length;



   procedure Set_Length
     (Container : in out Container_Type;
      Length    : in     Natural;
      New_Item  : in     Element_Type) is

      First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);

      N : constant Int := Integer'Pos (Length);

      Last_As_Int : constant Int'Base := First_As_Int + N - 1;

      Last : constant Last_Subtype := Index_Type'Val (Last_As_Int);

   begin

      Resize (Container, Size => Length);

      declare
         Target : Element_Array renames
           Container.Elements (Index_Type'Succ (Container.Last) .. Last);
      begin
         Target := (others => New_Item);
      end;

      Container.Last := Last;

   end Set_Length;



   function Is_Empty (Container : Container_Type) return Boolean is
   begin
      return Container.Last = Last_Subtype'First;
   end;


   procedure Clear (Container : in out Container_Type) is
   begin
      Container.Last := Last_Subtype'First;
   end;


   procedure Swap (Left, Right : in out Container_Type) is

      L_EA : constant Element_Array_Access := Left.Elements;
      L_Last : constant Last_Subtype := Left.Last;

   begin

      Left.Elements := Right.Elements;
      Left.Last := Right.Last;

      Right.Elements := L_EA;
      Right.Last := L_Last;

   end Swap;


   function Empty_Vector return Container_Type is
   begin
      return (Controlled with null, Last_Subtype'First);
   end;


   function To_Vector
     (Length : Natural) return Container_Type is
   begin

      if Length = 0 then
         return Empty_Vector;
      end if;

      declare
         First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);

         Last_As_Int : constant Int'Base :=
           First_As_Int + Int (Length) - 1;

         Last : constant Index_Type := Index_Type'Val (Last_As_Int);

         Elements : constant Element_Array_Access :=
           new Element_Array (Index_Type'First .. Last);
      begin
         return (Controlled with Elements, Last);
      end;

   end To_Vector;


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

   begin

      if Length = 0 then
         return Empty_Vector;
      end if;

      declare
         First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);

         Last_As_Int : constant Int'Base :=
           First_As_Int + Int (Length) - 1;

         Last : constant Index_Type := Index_Type'Val (Last_As_Int);

         subtype Array_Subtype is
           Element_Array (Index_Type'First .. Last);

         Elements : constant Element_Array_Access :=
           new Array_Subtype'(others => Item);
      begin
         return (Controlled with Elements, Last);
      end;

   end To_Vector;



   function To_Vector
     (Source : Container_Type;
      First  : Index_Type'Base;
      Back   : Index_Type'Base) return Container_Type is

   begin

      if Back <= First then
         return Empty_Vector;
      end if;

      declare
         subtype Src_Index is Index_Type'Base range
           Index_Type'First .. Source.Last;

         F : constant Src_Index := First;
         L : constant Src_Index := Index_Type'Pred (Back);

         Src : Element_Array renames Source.Elements (F .. L);

         First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);
         Last_As_Int  : constant Int := First_As_Int + Src'Length - 1;

         Last : constant Index_Type := Index_Type'Val (Last_As_Int);

         subtype Array_Subtype is Element_Array (Index_Type'First .. Last);

         Elements : constant Element_Array_Access := new Array_Subtype'(Src);
      begin
         return (Controlled with Elements, Last);
      end;

   end To_Vector;



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

      First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);

      N : constant Int := Int (Length);

      Last_As_Int : constant Int'Base := First_As_Int + N - 1;
      Last : constant Last_Subtype := Index_Type'Val (Last_As_Int);

   begin

      if Target.Elements /= null
        and then Target.Elements'Last >= Last
      then
         Target.Last := Last;
         return;
      end if;

      declare
         EA : constant Element_Array_Access :=
            new Element_Array (Index_Type'First .. Last);

         X : Element_Array_Access := Target.Elements;
      begin
         Target.Elements := EA;
         Target.Last := Last;

         Free (X);
      end;

   end Assign;


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

      First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);

      N : constant Int := Int (Length);

      Last_As_Int : constant Int'Base := First_As_Int + N - 1;
      Last : constant Last_Subtype := Index_Type'Val (Last_As_Int);

      subtype Range_Subtype is Index_Type'Base range
         Index_Type'First .. Last;

   begin

      if Target.Elements /= null
        and then Target.Elements'Last >= Last
      then
         Target.Elements (Range_Subtype) := (others => New_Item);
         Target.Last := Last;

         return;
      end if;

      declare
         EA : constant Element_Array_Access :=
            new Element_Array'(Range_Subtype => New_Item);

         X : Element_Array_Access := Target.Elements;
      begin
         Target.Elements := EA;
         Target.Last := Last;

         Free (X);
      end;

   end Assign;


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

   begin

      if Target'Address = Source'Address then
         return;
      end if;

      if Source.Last = Last_Subtype'First then
         Target.Last := Last_Subtype'First;  --alloc null array too?
         return;
      end if;

      if Target.Elements = null then
         declare
            Src : Element_Array renames
              Source.Elements (Index_Type'First .. Source.Last);

            Tgt : constant Element_Array_Access :=
              new Element_Array'(Src);
         begin
            Target.Elements := Tgt;
            Target.Last := Source.Last;
         end;

         return;
      end if;

      if Source.Last <= Target.Elements'Last then
         declare
            subtype Range_Subtype is Index_Type'Base range
               Index_Type'First .. Source.Last;

            Src : Element_Array renames
               Source.Elements (Range_Subtype);

            Tgt : Element_Array renames
               Target.Elements (Range_Subtype);
         begin
            Tgt := Src;
         end;

         Target.Last := Source.Last;

         return;
      end if;

      declare
         subtype Range_Subtype is Index_Type'Base range
            Index_Type'First .. Source.Last;

         Src : Element_Array renames
            Source.Elements (Range_Subtype);

         Tgt : constant Element_Array_Access :=
            new Element_Array'(Src);

         X : Element_Array_Access := Target.Elements;
      begin
         Target.Elements := Tgt;
         Target.Last := Source.Last;

         Free (X);
      end;

   end Assign;


   procedure Assign
     (Target : in out Container_Type;
      Source : in     Container_Type;
      First  : in     Index_Type'Base;
      Back   : in     Index_Type'Base) is

   begin

      if Back <= First then
         Clear (Target);
         return;
      end if;

      declare

         subtype Src_Index_Subtype is Index_Type'Base range
           Index_Type'First .. Source.Last;

         F : constant Src_Index_Subtype := First;

         L1 : constant Index_Type'Base := Index_Type'Pred (Back);
         L2 : constant Index_Type'Base := Source.Last;

         L : constant Index_Type'Base := Index_Type'Min (L1, L2);

         Src : Element_Array renames Source.Elements (F .. L);

         First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);

         Last_As_Int  : constant Int'Base := First_As_Int + Src'Length - 1;
         Last : constant Index_Type'Base := Index_Type'Val (Last_As_Int);

         subtype Tgt_Range is Index_Type'Base range
           Index_Type'First .. Last;

      begin

         if Target'Address = Source'Address then

            declare
               Tgt : Element_Array renames
                 Target.Elements (Tgt_Range);
            begin
               Tgt := Src;
               Target.Last := Last;
            end;

            return;

         end if;

         if Target.Elements = null then

            declare
               subtype Tgt_Array is Element_Array (Tgt_Range);
               Tgt : constant Element_Array_Access := new Tgt_Array'(Src);
            begin
               Target.Elements := Tgt;
               Target.Last := Last;
            end;

            return;

         end if;

         if Src'Length <= Target.Elements'Length then

            declare
               Tgt : Element_Array renames
                 Target.Elements (Tgt_Range);
            begin
               Tgt := Src;
            end;

            Target.Last := Last;

            return;

         end if;

         declare
            subtype Tgt_Array is Element_Array (Tgt_Range);
            Tgt : constant Element_Array_Access := new Tgt_Array'(Src);

            X : Element_Array_Access := Target.Elements;
         begin
            Target.Elements := Tgt;
            Target.Last := Source.Last;

            Free (X);
         end;

      end;

   end Assign;


   procedure Append
     (Container : in out Container_Type;
      New_Item  : in     Element_Type) is
   begin
      Insert (Container, Before => Back (Container), New_Item => New_Item);
   end;


   procedure Delete_Last (Container : in out Container_Type) is
   begin
      if Container.Last >= Index_Type'First then
         Container.Last := Index_Type'Pred (Container.Last);
      end if;
   end Delete_Last;


--     procedure Delete_Last
--       (Container : in out Container_Type;
--        Item      : in     Element_Type) is

--        Old_Last : constant Index_Type := Container.Last;
--        New_Last : constant Last_Subtype := Index_Type'Pred (Old_Last);
--     begin
--        Container.Elements (Old_Last) := Item;
--        Container.Last := New_Last;
--     end;


--     procedure Delete_Last_N
--       (Container : in out Container_Type;
--        Count     : in     Natural) is
--     begin
--        Container.Last := To_Index (To_Integer (Container.Last) - Count);
--     end;


--     procedure Delete_Last_N
--       (Container : in out Container_Type;
--        Count     : in     Natural;
--        Item      : in     Element_Type) is

--        Old_Last : constant Last_Subtype := Container.Last;
--        Old_Length : constant Natural := To_Integer (Old_Last);

--        New_Length : constant Natural := Old_Length - Count;
--        New_Last : constant Last_Subtype := To_Index (New_Length);

--        J : constant Positive := Old_Length - Count + 1;
--        K : constant Index_Type'Base := To_Index (J);
--     begin
--        Container.Elements (K .. Old_Last) := (others => Item);
--        Container.Last := New_Last;
--     end;


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

      Old_Last : constant Last_Subtype := Container.Last;

      Old_Last_As_Int : constant Int := Index_Type'Pos (Old_Last);

      N : constant Int := Integer'Pos (Count);

      New_Last_As_Int : constant Int'Base := Old_Last_As_Int + N;

      New_Last : constant Last_Subtype := Index_Type'Val (New_Last_As_Int);

      New_First : Index_Type;

      Dst_Last : Index_Type;
      Dst      : Element_Array_Access;

   begin

      if Count = 0 then
         return;
      end if;

      declare
         subtype Before_Subtype is Index_Type'Base range
           Index_Type'First .. Index_Type'Succ (Container.Last);

         Old_First : constant Before_Subtype := Before;

         Old_First_As_Int : constant Int := Index_Type'Pos (Old_First);

         New_First_As_Int : constant Int'Base := Old_First_As_Int + N;
      begin
         New_First := Index_Type'Val (New_First_As_Int);
      end;

      if Container.Elements = null then

         --  NOTE: this appears to be incorrect -- shouldn't it be old_last = it'first?
         --  pragma Assert (New_First = Index_Type'First);

         declare
            subtype Elements_Subtype is
              Element_Array (Index_Type'First .. New_Last);
         begin
            Container.Elements := new Elements_Subtype'(others => New_Item);
         end;

         Container.Last := New_Last;

         return;

      end if;

      if New_Last <= Container.Elements'Last then

         declare
            E : Element_Array renames Container.Elements.all;
         begin
            E (New_First .. New_Last) := E (Before .. Container.Last);
            E (Before .. Index_Type'Pred (New_First)) := (others => New_Item);
         end;

         Container.Last := New_Last;

         return;

      end if;

      declare

         First : constant Int := Index_Type'Pos (Index_Type'First);

         New_Size : constant Int'Base := New_Last_As_Int - First + 1;

         Last : constant Int := Index_Type'Pos (Index_Type'Last);

         Max_Size : constant Int'Base := Last - First + 1;

         Size, Dst_Last_As_Int : Int'Base;

      begin

         if New_Size >= Max_Size / 2 then

            Dst_Last := Index_Type'Last;

         else

            Size := Container.Elements'Length;

            if Size = 0 then
               Size := 1;
            end if;

            while Size < New_Size loop
               Size := 2 * Size;
            end loop;

            Dst_Last_As_Int := First + Size - 1;
            Dst_Last := Index_Type'Val (Dst_Last_As_Int);

         end if;

      end;

      Dst := new Element_Array (Index_Type'First .. Dst_Last);

      declare
         Src : Element_Array renames Container.Elements.all;
      begin
         Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
           Src (Index_Type'First .. Index_Type'Pred (Before));

         Dst (Before .. Index_Type'Pred (New_First)) :=
           (others => New_Item);

         Dst (New_First .. New_Last) :=
           Src (Before .. Container.Last);
      exception
         when others =>
            Free (Dst);
            raise;
      end;

      declare
         X : Element_Array_Access := Container.Elements;
      begin
         Container.Elements := Dst;
         Container.Last := New_Last;

         Free (X);
      end;

   end Insert_N;


   procedure Insert_N
     (Container : in out Container_Type;
      Before    : in     Index_Type'Base;
      Count     : in     Natural) is

      Old_Last : constant Last_Subtype := Container.Last;

      Old_Last_As_Int : constant Int := Index_Type'Pos (Old_Last);

      N : constant Int := Integer'Pos (Count);

      New_Last_As_Int : constant Int'Base := Old_Last_As_Int + N;

      New_Last : constant Last_Subtype := Index_Type'Val (New_Last_As_Int);

      New_First : Index_Type;

      Dst_Last : Index_Type;
      Dst      : Element_Array_Access;

   begin

      if Count = 0 then
         return;
      end if;

      declare
         subtype Before_Subtype is Index_Type'Base range
           Index_Type'First .. Index_Type'Succ (Container.Last);

         Old_First : constant Before_Subtype := Before;

         Old_First_As_Int : constant Int := Index_Type'Pos (Old_First);

         New_First_As_Int : constant Int'Base := Old_First_As_Int + N;
      begin
         New_First := Index_Type'Val (New_First_As_Int);
      end;

      if Container.Elements = null then

         pragma Assert (New_First = Index_Type'First);

         declare
            subtype Elements_Subtype is
              Element_Array (Index_Type'First .. New_Last);
         begin
            Container.Elements := new Elements_Subtype;
         end;

         Container.Last := New_Last;

         return;

      end if;

      if New_Last <= Container.Elements'Last then

         declare
            E : Element_Array renames Container.Elements.all;
         begin
            E (New_First .. New_Last) := E (Before .. Container.Last);
         end;

         Container.Last := New_Last;

         return;

      end if;

      declare

         First : constant Int := Index_Type'Pos (Index_Type'First);

         New_Size : constant Int'Base := New_Last_As_Int - First + 1;

         Last : constant Int := Index_Type'Pos (Index_Type'Last);

         Max_Size : constant Int'Base := Last - First + 1;

         Size, Dst_Last_As_Int : Int'Base;

      begin

         if New_Size >= Max_Size / 2 then

            Dst_Last := Index_Type'Last;

         else

            Size := Container.Elements'Length;

            if Size = 0 then
               Size := 1;
            end if;

            while Size < New_Size loop
               Size := 2 * Size;
            end loop;

            Dst_Last_As_Int := First + Size - 1;
            Dst_Last := Index_Type'Val (Dst_Last_As_Int);

         end if;

      end;

      Dst := new Element_Array (Index_Type'First .. Dst_Last);

      declare
         Src : Element_Array renames Container.Elements.all;
      begin
         Dst (Index_Type'First .. Index_Type'Pred (Before)) :=
           Src (Index_Type'First .. Index_Type'Pred (Before));

         Dst (New_First .. New_Last) :=
           Src (Before .. Container.Last);
      exception
         when others =>
            Free (Dst);
            raise;
      end;

      declare
         X : Element_Array_Access := Container.Elements;
      begin
         Container.Elements := Dst;
         Container.Last := New_Last;

         Free (X);
      end;

   end Insert_N;



   procedure Insert
     (Container : in out Container_Type;
      Before    : in     Index_Type'Base) is
   begin
      Insert_N (Container, Before, Count => 1);
   end;


   procedure Insert
     (Container : in out Container_Type;
      Before    : in     Index_Type'Base;
      New_Item  : in     Element_Type) is
   begin
      Insert_N (Container, Before, Count => 1, New_Item => New_Item);
   end;


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

   begin

      --We could treat specifying an index outside of the
      --active range as an error (and propagate CE), but for
      --now let's weaken the precondition and just treat
      --deleting from an empty vector (say) as a no-op.

      if Index < Index_Type'First then
         return;
      end if;

      if Index > Container.Last then
         return;
      end if;


      declare
         Old_Last : constant Index_Type := Container.Last;
         New_Last : constant Last_Subtype := Index_Type'Pred (Old_Last);

         EA : Element_Array renames Container.Elements.all;

         subtype Index_Subtype is Index_Type'Base range
           Index_Type'First .. Old_Last;
      begin
         EA (Index_Subtype'(Index) .. New_Last) :=
           EA (Index_Type'Succ (Index) .. Old_Last);

         Container.Last := New_Last;
      end;

   end Delete;


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

   begin

      if Back <= First then
         return;
      end if;

      declare
         I : constant Int := Index_Type'Pos (First);
         J : constant Int := Index_Type'Pos (Back);
         N : constant Int'Base := J - I;
      begin
         Delete_N (Container, Index => First, Count => Positive (N));
      end;

   end Delete;


   procedure Delete_N
     (Container : in out Container_Type;
      Index     : in     Index_Type'Base;
      Count     : in     Natural) is

      subtype First_Subtype is Index_Type'Base range
        Index_Type'First .. Container.Last;

      First : First_Subtype;
      First_As_Int : Int;

      Last  : Last_Subtype;

   begin

      if Count = 0 then
         return;
      end if;

      First := Index; --can raise CE
      First_As_Int := Index_Type'Pos (First);

      declare
         N : constant Int := Integer'Pos (Count);

         Last1_As_Int : constant Int'Base := First_As_Int + N - 1;
         Last2_As_Int : constant Int'Base := Index_Type'Pos (Container.Last);

         Last_As_Int : constant Int'Base := Int'Min (Last1_As_Int, Last2_As_Int);
      begin
         Last := Index_Type'Val (Last_As_Int);
      end;

      if Last = Container.Last then
         Container.Last := Index_Type'Pred (First);
         return;
      end if;

      declare
         Src_First : constant Index_Type := Index_Type'Succ (Last);
         Src_First_As_Int : constant Int := Index_Type'Pos (Src_First);

         Src_Last_As_Int : constant Int := Index_Type'Pos (Container.Last);

         N : constant Int'Base := Src_Last_As_Int - Src_First_As_Int + 1;

         Tgt_Last_As_Int : constant Int'Base := First_As_Int + N - 1;
         Tgt_Last : constant Index_Type := Index_Type'Val (Tgt_Last_As_Int);

         Src : Element_Array renames
           Container.Elements (Src_First .. Container.Last);

         Tgt : Element_Array renames
           Container.Elements (First .. Tgt_Last);
      begin
         Tgt := Src;
         Container.Last := Tgt_Last;
      end;

   end Delete_N;


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

--     begin

--        if Back <= First then
--           return;
--        end if;

--        declare
--           subtype First_Subtype is Index_Type'Base range
--              Index_Type'First .. Container.Last;

--           subtype Back_Subtype is Index_Type'Base range
--              Index_Type'First .. Index_Type'Succ (Container.Last);
--        begin
--           Do_Delete
--             (Container,
--              First_Subtype'(First),
--              Back_Subtype'(Back),
--              Item);
--        end;

--     end Delete;


--     procedure Delete_N
--       (Container : in out Container_Type;
--        First     : in     Index_Type'Base;
--        Count     : in     Natural;
--        Item      : in     Element_Type) is

--     begin

--        if Count = 0 then
--           return;
--        end if;

--        declare
--           subtype First_Subtype is Index_Type'Base range
--              Index_Type'First .. Container.Last;

--           F : constant Positive := To_Integer (First_Subtype'(First));

--           BX : constant Positive := F + Count;
--           BY : constant Positive := To_Integer (Container.Last) + 1;
--           B  : constant Positive := Integer'Min (BX, BY);
--        begin
--           Do_Delete (Container, First, To_Index (B), Item);
--        end;

--     end Delete_N;


   function Size (Container : Container_Type) return Natural is
   begin

      if Container.Elements = null then
         return 0;
      end if;

      return Container.Elements'Length;

   end Size;


   procedure Resize
     (Container : in out Container_Type;
      Size      : in     Natural) is

   begin

--        if Size = 0 then
--           return;
--        end if;

      if Container.Elements = null then

         pragma Assert (Container.Last = Last_Subtype'First);

         declare
            First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);
            N : constant Int := Integer'Pos (Size);
            Last_As_Int : constant Int'Base := First_As_Int + N - 1;
            Last : constant Last_Subtype := Index_Type'Val (Last_As_Int);

            Elements : constant Element_Array_Access :=
              new Element_Array (Index_Type'First .. Last);
         begin
            Container.Elements := Elements;
         end;

         return;

      end if;

      if Container.Elements'Length >= Size then
         return;
      end if;

      declare

         First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);
         N : constant Int := Integer'Pos (Size);
         Last_As_Int : constant Int'Base := First_As_Int + N - 1;
         Last : constant Last_Subtype := Index_Type'Val (Last_As_Int);

         Elements : Element_Array_Access :=
           new Element_Array (Index_Type'First .. Last);

      begin

         declare
            Target : Element_Array renames
              Elements (Index_Type'First .. Container.Last);

            Source : Element_Array renames
              Container.Elements (Index_Type'First .. Container.Last);
         begin
            Target := Source;
         exception
            when others =>
               Free (Elements);
               raise;
         end;

         declare
            X : Element_Array_Access := Container.Elements;
         begin
            Container.Elements := Elements;
            Free (X);
         end;

      end;

   end Resize;


--     procedure Resize
--       (Container : in out Container_Type;
--        Size      : in     Natural;
--        New_Item  : in     Element_Type) is

--     begin

--  --        if Size = 0 then
--  --           return;
--  --        end if;

--        if Container.Elements = null then

--           pragma Assert (Container.Last = Last_Subtype'First);

--           declare
--              First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);
--              N : constant Int := Integer'Pos (Size);
--              Last_As_Int : constant Int'Base := First_As_Int + N - 1;
--              Last : constant Last_Subtype := Index_Type'Val (Last_As_Int);

--              subtype Array_Subtype is Element_Array (Index_Type'First .. Last);

--              Elements : constant Element_Array_Access :=
--                new Array_Subtype'(others => New_Item);
--           begin
--              Container.Elements := Elements;
--           end;

--           return;

--        end if;

--        if Container.Elements'Length >= Size then
--           return;
--        end if;

--        declare

--           First_As_Int : constant Int := Index_Type'Pos (Index_Type'First);
--           N : constant Int := Integer'Pos (Size);
--           Last_As_Int : constant Int'Base := First_As_Int + N - 1;
--           Last : constant Last_Subtype := Index_Type'Val (Last_As_Int);

--           Elements : Element_Array_Access :=
--             new Element_Array (Index_Type'First .. Last);

--        begin

--           declare
--              Target : Element_Array renames
--                Elements (Index_Type'First .. Container.Last);

--              Source : Element_Array renames
--                Container.Elements (Index_Type'First .. Container.Last);
--           begin
--              Target := Source;
--           exception
--              when others =>
--                 Free (Elements);
--                 raise;
--           end;

--           declare
--              Target : Element_Array renames
--                Elements (Index_Type'Succ (Container.Last) .. Last);
--           begin
--              Target := (others => New_Item);
--           exception
--              when others =>
--                 Free (Elements);
--                 raise;
--           end;

--           declare
--              X : Element_Array_Access := Container.Elements;
--           begin
--              Container.Elements := Elements;
--              Free (X);
--           end;

--        end;

--     end Resize;


--  --     procedure Generic_Reverse_Container
--  --       (Container : in Container_Type;
--  --        First     : in Index_Type'Base;
--  --        Back      : in Index_Type'Base) is

--  --        procedure Do_Swap is new Generic_Swap (Swap);

--  --        procedure Swap (L, R : Index_Type'Base) is
--  --           pragma Inline (Swap);
--  --        begin
--  --           Do_Swap (Container, L, R);
--  --        end;

--  --        procedure Reverse_Container is
--  --          new Algorithms.Generic_Reverse_Random_Access
--  --            (Index_Type'Base,
--  --             Index_Type'Succ,
--  --             Index_Type'Pred,
--  --             Swap);

--  --        subtype First_Subtype is Index_Type'Base range
--  --          Index_Type'First .. Unbounded.Last (Container);

--  --        subtype Back_Subtype is Index_Type'Base range
--  --          Index_Type'First .. Unbounded.Back (Container);

--  --     begin

--  --        if Back <= First then
--  --           return;
--  --        end if;

--  --        Reverse_Container (First_Subtype'(First), Back_Subtype'(Back));

--  --     end Generic_Reverse_Container;


--  --     procedure Reverse_Container
--  --       (Container : in Container_Type;
--  --        First     : in Index_Type'Base;
--  --        Back      : in Index_Type'Base) is

--  --        procedure Swap (L, R : Index_Type'Base) is
--  --           pragma Inline (Swap);
--  --        begin
--  --           Swap (Container, L, R);
--  --        end;

--  --        procedure Reverse_Container is
--  --          new Algorithms.Generic_Reverse_Random_Access
--  --            (Index_Type'Base,
--  --             Index_Type'Succ,
--  --             Index_Type'Pred,
--  --             Swap);

--  --        subtype First_Subtype is Index_Type'Base range
--  --          Index_Type'First .. Unbounded.Last (Container);

--  --        subtype Back_Subtype is Index_Type'Base range
--  --          Index_Type'First .. Unbounded.Back (Container);

--  --     begin

--  --        if Back <= First then
--  --           return;
--  --        end if;

--  --        Reverse_Container (First_Subtype'(First), Back_Subtype'(Back));

--  --     end Reverse_Container;


--  --     procedure Reverse_Container
--  --       (Container : in Container_Type) is
--  --     begin
--  --        Reverse_Container (Container, First (Container), Back (Container));
--  --     end;


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

--        function Predicate (I : Index_Type) return Boolean is
--           pragma Inline (Predicate);
--        begin
--           return Predicate (Container.Elements (I));
--        end;

--        procedure Assign
--          (Target : Index_Type;
--           Source : Index_Type) is
--           pragma Inline (Assign);
--        begin
--           Container.Elements (Target) := Container.Elements (Source);
--        end;

--        function Remove is
--          new Algorithms.Generic_Remove
--            (Index_Type'Base,
--             Index_Type'Succ,
--             Predicate,
--             Assign);

--        F : constant Index_Type'Base := Remove (First, Back);
--     begin
--        Delete (Container, F, Back);
--     end;


--     procedure Delete_Equal
--       (Container : in out Container_Type;
--        First     : in     Index_Type'Base;
--        Back      : in     Index_Type'Base;
--        Item      : in     Element_Type) is

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

--        procedure Delete_Equal is
--          new Generic_Delete_Predicate (Predicate);
--     begin
--        Delete_Equal (Container, First, Back);
--     end;


--     procedure Delete_Equal
--       (Container : in out Container_Type;
--        Item      : in     Element_Type) is
--     begin
--        Delete_Equal (Container, First (Container), Back (Container), Item);
--     end;



   function First
     (Container : Container_Type) return Index_Type is
      pragma Warnings (Off, Container);
   begin
      return Index_Type'First;
   end;


   function First_Element
     (Container : Container_Type) return Element_Type is
   begin
      return Element (Container, Index => First (Container));
   end;


   function Last
     (Container : Container_Type) return Index_Type'Base is
   begin
      return Container.Last;
   end;


   function Last_Element
     (Container : Container_Type) return Element_Type is
   begin
      return Element (Container, Index => Last (Container));
   end;


   function Back
     (Container : Container_Type) return Index_Type'Base is
   begin
      return Index_Type'Succ (Container.Last);
   end;


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

      subtype Index_Subtype is Index_Type'Base range
         Index_Type'First .. Container.Last;
   begin
      return Container.Elements (Index_Subtype'(Index));
   end;


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

      subtype Index_Subtype is Index_Type'Base range
         Index_Type'First .. Container.Last;
   begin
      return Container.Elements (Index_Subtype'(Index))'Access;
   end;


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

      subtype Index_Subtype is Index_Type'Base range
         Index_Type'First .. Container.Last;
   begin
      Container.Elements (Index_Subtype'(Index)) := By;
   end;


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

--        subtype T is Index_Type'Base range
--           Index_Type'First .. Container.Last;
--     begin
--        Process (Container.Elements (T'(Index)));
--     end;


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

--        subtype T is Index_Type'Base range
--           Index_Type'First .. Container.Last;
--     begin
--        Process (Container.Elements (T'(Index)));
--     end;


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

--        subtype T is Index_Type'Base range
--           Index_Type'First .. Container.Last;
--     begin
--        Process (Container.Elements (T'(Index))'Access);
--     end;


--     procedure Generic_Iteration
--       (Container : in Container_Type;
--        First     : in Index_Type'Base;
--        Back      : in Index_Type'Base) is

--        subtype T is Index_Type'Base range
--           Index_Type'First .. Container.Last;
--     begin
--        if Back <= First then
--           return;
--        end if;

--        for I in T'(First) .. T'(Index_Type'Pred (Back)) loop
--           Process (Container, I);
--        end loop;
--     end;


--     procedure Generic_Reverse_Iteration
--       (Container : in Container_Type;
--        First     : in Index_Type'Base;
--        Back      : in Index_Type'Base) is

--        subtype T is Index_Type'Base range
--           Index_Type'First .. Container.Last;
--     begin
--        if Back <= First then
--           return;
--        end if;

--        for I in reverse T'(First) .. T'(Index_Type'Pred (Back)) loop
--           Process (Container, I);
--        end loop;
--     end;


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

--        subtype T is Index_Type'Base range
--           Index_Type'First .. Container.Last;
--     begin
--        if Back <= First then
--           return;
--        end if;

--        for I in T'(First) .. T'(Index_Type'Pred (Back)) loop
--           Process (Container.Elements (I));
--        end loop;
--     end;


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

--        subtype T is Index_Type'Base range
--           Index_Type'First .. Container.Last;
--     begin
--        if Back <= First then
--           return;
--        end if;

--        for I in T'(First) .. T'(Index_Type'Pred (Back)) loop
--           Process (Container.Elements (I));
--        end loop;
--     end;



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

--        subtype T is Index_Type'Base range
--           Index_Type'First .. Container.Last;
--     begin
--        if Back <= First then
--           return;
--        end if;

--        for I in T'(First) .. T'(Index_Type'Pred (Back)) loop
--           Process (Container.Elements (I)'Access);
--        end loop;
--     end;


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

--        subtype T is Index_Type'Base range
--           Index_Type'First .. Container.Last;
--     begin
--        if Back <= First then
--           return;
--        end if;

--        for I in reverse T'(First) .. T'(Index_Type'Pred (Back)) loop
--           Process (Container.Elements (I));
--        end loop;
--     end;


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

--        subtype T is Index_Type'Base range
--           Index_Type'First .. Container.Last;
--     begin
--        if Back <= First then
--           return;
--        end if;

--        for I in reverse T'(First) .. T'(Index_Type'Pred (Back)) loop
--           Process (Container.Elements (I));
--        end loop;
--     end;



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

--        subtype T is Index_Type'Base range
--           Index_Type'First .. Container.Last;
--     begin
--        if Back <= First then
--           return;
--        end if;

--        for I in reverse T'(First) .. T'(Index_Type'Pred (Back)) loop
--           Process (Container.Elements (I)'Access);
--        end loop;
--     end;



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

      subtype T is Index_Type'Base range
        Index_Type'First .. Index_Type'Base'Last;

   begin

      for I in T'(Index) .. Container.Last loop
         if Predicate (Container.Elements (I)) then
            return I;
         end if;
      end loop;

      return Back (Container);

   end Generic_Find;


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

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

      function Find_Item is
         new Generic_Find (Predicate);
   begin
      return Find_Item (Container, Index);
   end;


   function Is_In
     (Item      : Element_Type;
      Container : Container_Type) return Boolean is
   begin
      return Find (Container, Item) /= Back (Container);
   end;


   function Generic_Reverse_Find
     (Container : Container_Type;
      Index     : Index_Type'Base := Index_Type'Last) return Index_Type'Base is

      Last : Index_Type'Base;

   begin

      if Index > Container.Last then
         Last := Container.Last;
      else
         Last := Index;
      end if;

      for I in reverse Index_Type'First .. Last loop
         if Predicate (Container.Elements (I)) then
            return I;
         end if;
      end loop;

      return Back (Container);

   end Generic_Reverse_Find;


   function Reverse_Find
     (Container : Container_Type;
      Item      : Element_Type;
      Index     : Index_Type'Base := Index_Type'Last) return Index_Type'Base is

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

      function Reverse_Find_Item is
         new Generic_Reverse_Find (Predicate);
   begin
      return Reverse_Find_Item (Container, Index);
   end;


   procedure Generic_Constant_Iteration (Container : in Container_Type) is
   begin
      for I in Index_Type'First .. Container.Last loop
         Process (Container.Elements (I));
      end loop;
   end;


   procedure Generic_Iteration (Container : in Container_Type) is
   begin
      for I in Index_Type'First .. Container.Last loop
         Process (Container.Elements (I));
      end loop;
   end;


   procedure Generic_Constant_Reverse_Iteration (Container : in Container_Type) is
   begin
      for I in reverse Index_Type'First .. Container.Last loop
         Process (Container.Elements (I));
      end loop;
   end;


   procedure Generic_Reverse_Iteration (Container : in Container_Type) is
   begin
      for I in reverse Index_Type'First .. Container.Last loop
         Process (Container.Elements (I));
      end loop;
   end;



   procedure Generic_Sort (Container : in Container_Type) is

      procedure Sort is
         new Algorithms.Generic_Quicksort_Array
           (Index_Type   => Index_Type,
            Element_Type => Element_Type,
            Array_Type   => Element_Array,
            "<"          => "<");
   begin

      if Container.Last >= Index_Type'First then
         Sort (Container.Elements (Index_Type'First .. Container.Last));
      end if;

   end Generic_Sort;


end Charles.Vectors.Unbounded;
