File : charles-vectors-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 Ada.Unchecked_Deallocation;

with System;  use type System.Address;
with Charles.Algorithms.Generic_Lexicographical_Compare;

package body Charles.Vectors.Unbounded is


   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
         declare
            subtype Array_Subtype is
               Element_Array (Index_Type'First .. Last_Subtype'First);
         begin
            Container.Elements := new Array_Subtype;
         end;
         
         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;

      if Left.Last > Right.Last 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;
   
   
--   package Element_Array_Access_Conversions is

--      new System.Address_To_Access_Conversions (Container_Type);

   
   function To_Access 
     (Container : Container_Type) return Element_Array_Access is

   begin

--      if Container.Elements = null then      


--         declare

--            use Element_Array_Access_Conversions;         


--            CP : constant Object_Pointer := To_Pointer (Container'Address);

--            

--            C : Container_Type renames CP.all;

--            

--            subtype Array_Subtype is

--               Element_Array (Index_Type'First .. Last_Subtype'First);

--         begin

--            C.Elements := new Array_Subtype;

--         end;


--      end if;

         
      return Container.Elements;      

   end To_Access;


   function Length (Container : Container_Type) return Natural is
   begin
      return To_Integer (Container.Last);
   end;
   
   
   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 Clear 
     (Container : in out Container_Type;
      Item      : in     Element_Type) is
      
      subtype Range_Subtype is Index_Type'Base range
         Index_Type'First .. Container.Last;
   begin
      if Container.Elements /= null then
         Container.Elements (Range_Subtype) := (others => Item);         
      end if;
      
      Container.Last := Last_Subtype'First;
   end Clear;

   
   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 To_Container (Length : Natural) return Container_Type is
   
      Last : constant Last_Subtype := To_Index (Length);
      
      subtype Range_Subtype is Index_Type'Base range
         Index_Type'First .. Last;

      EA : constant Element_Array_Access :=
         new Element_Array (Range_Subtype);
   begin
      return (Ada.Finalization.Controlled with EA, Last);
   end;


   function To_Container 
     (Length : Natural;
      Item   : Element_Type) return Container_Type is
      
      Last : constant Last_Subtype := To_Index (Length);
      
      subtype Range_Subtype is Index_Type'Base range
         Index_Type'First .. Last;
         
      subtype Array_Subtype is
         Element_Array (Range_Subtype);
         
      EA : constant Element_Array_Access :=
         new Array_Subtype'(others => Item);
   begin
      return (Ada.Finalization.Controlled with EA, Last);
   end;


   procedure Assign
     (Target : in out Container_Type;
      Length : in     Natural) is
      
      Last : constant Last_Subtype := To_Index (Length);
         
   begin
   
      if Target.Elements /= null
        and then Target.Elements'Length >= Length
      then
         Target.Last := Last;
         return;
      end if;

      declare
         EA : constant Element_Array_Access := 
            new Element_Array (Index_Type'First .. Last);
      begin
         begin
            Free (Target.Elements);
         exception
            when others =>
               Target.Elements := null;
               Target.Last := Last_Subtype'First;
               raise;
         end;
    
         Target.Elements := EA;
         Target.Last := Last;
      end;

   end Assign;


   procedure Assign
     (Target : in out Container_Type;
      Length : in     Natural;
      Item   : in     Element_Type) is
      
      Last : constant Last_Subtype := To_Index (Length);
      
      subtype Range_Subtype is Index_Type'Base range
         Index_Type'First .. Last;

   begin
   
      if Target.Elements /= null
        and then Target.Elements'Length >= Length
      then
         --must do the array assignment first, to protect against errors

         Target.Elements (Range_Subtype) := (others => Item);
         Target.Last := Last;

         return;
      end if;
      
      declare
         EA : constant Element_Array_Access := 
            new Element_Array'(Range_Subtype => Item);
      begin
         begin
            Free (Target.Elements);
         exception
            when others =>
               Target.Elements := null;
               Target.Last := Last_Subtype'First;
               raise;
         end;
    
         Target.Elements := EA;
         Target.Last := Last;
      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.Elements = null then
         if Target.Elements = null then
            declare
               subtype Array_Subtype is
                  Element_Array (Index_Type'First .. Last_Subtype'First);
            begin
               Target.Elements := new Array_Subtype;
            end;
         end if;
         
         Target.Last := Last_Subtype'First;

         return;
      end if;
      
      if Target.Elements /= null
         and then To_Integer (Source.Last) <= Target.Elements'Length
      then
         --must perform the assignment first

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

            Tgt : Element_Array renames 
               Target.Elements (Range_Subtype);

            Src : Element_Array renames
               Source.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;

         X : Element_Array renames 
            Source.Elements (Range_Subtype);

         EA : constant Element_Array_Access :=
            new Element_Array'(X);
      begin
         begin
            Free (Target.Elements);
         exception
            when others =>
               Target.Elements := null;
               Target.Last := Last_Subtype'First;
               raise;
         end;
         
         Target.Elements := EA;
         Target.Last := Source.Last;
      end;
   end Assign;




   procedure Append 
     (Container : in out Container_Type) is
     
      New_Last : constant Index_Type := Index_Type'Succ (Container.Last);
      New_Length : constant Positive := To_Integer (New_Last);
      
      Size : Positive;
      
   begin
      
      if Container.Elements = null then
         pragma Assert (New_Last = Index_Type'First);
         
         declare            
            subtype Array_Subtype is
               Element_Array (Index_Type'First .. New_Last);
         begin
            Container.Elements := new Array_Subtype;
            Container.Last := New_Last;
         end;
         
         return;
      end if;
      
      if Container.Elements'Length >= New_Length then
         Container.Last := New_Last;
         return;
      end if;
      
      Size := 2 * Integer'Max (Container.Elements'Length, 1); --?


      declare
         Length : constant Positive := To_Integer (Index_Type'Last);
      begin
         if Size > Length then
            Size := Length;
         end if;
      end;
      
      declare
         subtype Array_Subtype is
            Element_Array (Index_Type'First .. To_Index (Size));
            
         EA : Element_Array_Access := new Array_Subtype;
      begin
         declare
            subtype Range_Subtype is Index_Type range
               Index_Type'First .. Container.Last;
               
            Source : Element_Array renames
               Container.Elements (Range_Subtype);
         begin
            EA (Range_Subtype) := Source;
         exception
            when others =>
               Free (EA);
               raise;
         end;
         
         begin
            Free (Container.Elements);
         exception
            when others =>
               Container.Elements := null;
               Container.Last := Last_Subtype'First;
               Free (EA);
               raise;
         end;
            
         Container.Elements := EA;
         Container.Last := New_Last;
      end;               

   end Append;


   function Append 
     (Container : access Container_Type) return Index_Type is
   begin
      Append (Container.all);
      return Last (Container.all);
   end;


   function Generic_Append 
     (Container : access Container_Type) return Element_Access is
     
      Index : constant Index_Type := Append (Container);
   begin
      return Container.Elements (Index)'Access;
   end;


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

      New_Last : constant Index_Type := Index_Type'Succ (Container.Last);
      New_Length : constant Positive := To_Integer (New_Last);
      
      Size : Positive;

   begin
      
      if Container.Elements = null then
         pragma Assert (New_Last = Index_Type'First);
         
         declare            
            subtype Array_Subtype is
               Element_Array (Index_Type'First .. Index_Type'First);
         begin
            Container.Elements := 
               new Array_Subtype'(others => New_Item);
               
            Container.Last := New_Last;
         end;
         
         return;
      end if;
      
      if Container.Elements'Length >= New_Length then
         --must do assignment first

         Container.Elements (New_Last) := New_Item;
         Container.Last := New_Last;

         return;
      end if;
      
      Size := 2 * Integer'Max (Container.Elements'Length, 1);

      declare
         Length : constant Positive := To_Integer (Index_Type'Last);
      begin
         if Size > Length then
            Size := Length;
         end if;
      end;
      
      declare
         subtype Array_Subtype is
            Element_Array (Index_Type'First .. To_Index (Size));
            
         EA : Element_Array_Access := new Array_Subtype;
      begin
         declare
            subtype Range_Subtype is Index_Type range
               Index_Type'First .. Container.Last;
               
            Source : Element_Array renames
               Container.Elements (Range_Subtype);
         begin
            EA (Range_Subtype) := Source;
            EA (New_Last) := New_Item;
         exception
            when others =>
               Free (EA);
               raise;
         end;
         
         begin
            Free (Container.Elements);
         exception
            when others =>
               Container.Elements := null;
               Container.Last := Last_Subtype'First;
               Free (EA);
               raise;
         end;
            
         Container.Elements := EA;
         Container.Last := New_Last;
      end;               

   end Append;

      
   procedure Append_N
     (Container : in out Container_Type;
      Count     : in     Natural) is

      Old_Length : constant Natural := To_Integer (Container.Last);
      
      New_Length : constant Natural := Old_Length + Count;
      New_Last : constant Last_Subtype := To_Index (New_Length);
      
      Size : Positive;
      
   begin
      
      if Container.Elements = null then
         pragma Assert (Container.Last = Last_Subtype'First);
         
         declare            
            subtype Array_Subtype is
               Element_Array (Index_Type'First .. New_Last);
         begin
            Container.Elements := new Array_Subtype;
            Container.Last := New_Last;
         end;
         
         return;
      end if;
      
      if Container.Elements'Length >= New_Length then
         Container.Last := New_Last;
         return;
      end if;
      
      Size := 2 * Integer'Max (Container.Elements'Length, 1); --?


      declare
         Length : constant Positive := To_Integer (Index_Type'Last);
      begin
         if Size > Length then
            Size := Length;
         end if;
      end;
      
      declare
         subtype Array_Subtype is
            Element_Array (Index_Type'First .. To_Index (Size));
            
         EA : Element_Array_Access := new Array_Subtype;
      begin
         declare
            subtype Range_Subtype is Index_Type range
               Index_Type'First .. Container.Last;
               
            Source : Element_Array renames
               Container.Elements (Range_Subtype);
         begin
            EA (Range_Subtype) := Source;
         exception
            when others =>
               Free (EA);
               raise;
         end;
         
         begin
            Free (Container.Elements);
         exception
            when others =>
               Container.Elements := null;
               Container.Last := Last_Subtype'First;
               Free (EA);
               raise;
         end;
            
         Container.Elements := EA;
         Container.Last := New_Last;
      end;               

   end Append_N;
      

   
   procedure Append_N
     (Container : in out Container_Type;
      Count     : in     Natural;
      New_Item  : in     Element_Type) is

      Old_Length : constant Natural := To_Integer (Container.Last);
      
      New_Length : constant Natural := Old_Length + Count;
      New_Last : constant Last_Subtype := To_Index (New_Length);
      
      Size : Positive;
      
   begin
      
      if Container.Elements = null then
         pragma Assert (Container.Last = Last_Subtype'First);
         
         declare            
            subtype Array_Subtype is
               Element_Array (Index_Type'First .. New_Last);
         begin
            Container.Elements := new Array_Subtype'(others => New_Item);
            Container.Last := New_Last;
         end;
         
         return;
      end if;
      
      if Container.Elements'Length >= New_Length then
         declare
            subtype Range_Subtype is Index_Type range 
               Index_Type'Succ (Container.Last) .. New_Last;
               
            Target : Element_Array renames
               Container.Elements (Range_Subtype);
         begin
            Target := (others => New_Item);
         end;
            
         Container.Last := New_Last;

         return;
      end if;
      
      Size := 2 * Integer'Max (Container.Elements'Length, 1); --?


      declare
         Length : constant Positive := To_Integer (Index_Type'Last);
      begin
         if Size > Length then
            Size := Length;
         end if;
      end;
      
      declare
         subtype Array_Subtype is
            Element_Array (Index_Type'First .. To_Index (Size));
            
         EA : Element_Array_Access := new Array_Subtype;
      begin
         declare
            subtype Range_Subtype is Index_Type range
               Index_Type'First .. Container.Last;
               
            Source : Element_Array renames
               Container.Elements (Range_Subtype);
         begin
            EA (Range_Subtype) := Source;
         exception
            when others =>
               Free (EA);
               raise;
         end;
         
         declare
            subtype Range_Subtype is Index_Type range 
               Index_Type'Succ (Container.Last) .. New_Last;
         begin
            EA (Range_Subtype) := (others => New_Item);
         exception
            when others =>
               Free (EA);
               raise;               
         end;

         begin
            Free (Container.Elements);
         exception
            when others =>
               Container.Elements := null;
               Container.Last := Last_Subtype'First;
               Free (EA);
               raise;
         end;
            
         Container.Elements := EA;
         Container.Last := New_Last;
      end;               

   end Append_N;
   


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


   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) 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);
      
      subtype Index_Subtype is Index_Type'Base range
         Index_Type'First .. Index_Type'Succ (Old_Last);
         
      Size : Positive;

   begin
   
      if Container.Elements = null then
         pragma Assert (Old_Last = Last_Subtype'First);
         
         declare
            First : constant Index_Subtype := Before;
            
            subtype Array_Subtype is 
               Element_Array (First .. New_Last);
         begin
            Container.Elements := new Array_Subtype;
            Container.Last := New_Last;
         end;         
         
         return;
      end if;
      
      if Count = 0 then
         return;
      end if;
      
      if Container.Elements'Length >= New_Length then
         declare
            Index : constant Index_Subtype := Before;
            
            First : constant Index_Type'Base := 
               To_Index (To_Integer (Index) + Count);
         begin
            Container.Elements (First .. New_Last) := 
                Container.Elements (Index .. Old_Last);

            Container.Last := New_Last;
         end;
                
         return;
      end if;
      
      Size := 2 * Integer'Max (Container.Elements'Length, 1); --?


      declare
         Length : constant Positive := To_Integer (Index_Type'Last);
      begin
         if Size > Length then
            Size := Length;
         end if;
      end;
      
      declare
         Index : constant Index_Subtype := Before;

         subtype Array_Subtype is
            Element_Array (Index_Type'First .. To_Index (Size));
            
         EA : Element_Array_Access := new Array_Subtype;
      begin
         declare
            subtype Range_Subtype is Index_Type'Base range
               Index_Type'First .. Index_Type'Pred (Index);
         begin
            EA (Range_Subtype) := Container.Elements (Range_Subtype);
         exception
            when others =>
               Free (EA);
               raise;
         end;
         
         declare
            First : constant Index_Type'Base :=
               To_Index (To_Integer (Index) + Count);
         begin
            EA (First .. New_Last) := 
               Container.Elements (Index .. Old_Last);
         exception
            when others =>
               Free (EA);
               raise;
         end;

         begin
            Free (Container.Elements);
         exception
            when others =>
               Container.Elements := null;
               Container.Last := Last_Subtype'First;
               Free (EA);
               raise;
         end;
            
         Container.Elements := EA;
         Container.Last := New_Last;
      end;                     
      
   end Insert_N;

      
   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_Length : constant Natural := To_Integer (Old_Last);
      
      New_Length : constant Natural := Old_Length + Count;
      New_Last : constant Last_Subtype := To_Index (New_Length);
      
      subtype Index_Subtype is Index_Type'Base range
         Index_Type'First .. Index_Type'Succ (Old_Last);
         
      Size : Positive;

   begin
   
      if Container.Elements = null then
         pragma Assert (Old_Last = Last_Subtype'First);
         
         declare
            First : constant Index_Subtype := Before;

            subtype Array_Subtype is 
               Element_Array (First .. New_Last);
         begin
            Container.Elements := new Array_Subtype'(others => New_Item);
            Container.Last := New_Last;
         end;         
         
         return;
      end if;
      
      if Count = 0 then
         return;
      end if;

      if Container.Elements'Length >= New_Length then
         declare
            Index : constant Index_Subtype := Before;
      
            subtype New_Items_Array_Subtype is
               Element_Array (Index_Type'First .. To_Index (Count));
         begin
            Container.Elements (Index .. New_Last) := 
                New_Items_Array_Subtype'(others => New_Item) & 
                Container.Elements (Index .. Old_Last);

            Container.Last := New_Last;
         end;
                
         return;
      end if;
      
      Size := 2 * Integer'Max (Container.Elements'Length, 1); --?


      declare
         Length : constant Positive := To_Integer (Index_Type'Last);
      begin
         if Size > Length then
            Size := Length;
         end if;
      end;
      
      declare
         Index : constant Index_Subtype := Before;
      
         subtype Array_Subtype is
            Element_Array (Index_Type'First .. To_Index (Size));
            
         EA : Element_Array_Access := new Array_Subtype;
      begin
         declare
            subtype New_Items_Array_Subtype is
               Element_Array (Index_Type'First .. To_Index (Count));
               
            Src : Element_Array renames Container.Elements.all;
         begin
            EA (Index_Type'First .. New_Last) :=
               Src (Index_Type'First .. Index_Type'Pred (Index)) &
               New_Items_Array_Subtype'(others => New_Item) &
               Src (Index .. Old_Last);
         exception
            when others =>
               Free (EA);
               raise;
         end;
         
         begin
            Free (Container.Elements);
         exception
            when others =>
               Container.Elements := null;
               Container.Last := Last_Subtype'First;
               Free (EA);
               raise;
         end;
            
         Container.Elements := EA;
         Container.Last := New_Last;
      end;                     
      
   end Insert_N;



   procedure Insert
     (Container : in out Container_Type;
      Before    : in     Index_Type) is
   begin
      Insert_N (Container, Before, Count => 1);  
   end;
   
   
   procedure Insert
     (Container : in out Container_Type;
      Before    : in     Index_Type;
      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) is
         
      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;

            
   procedure Do_Delete
     (Container : in out Container_Type;
      F, B      : in     Index_Type'Base) is

      N : constant Positive := Index_Type'Pos (B) - Index_Type'Pos (F);

      Old_Last : constant Index_Type := Container.Last;
      Old_Length : constant Positive := To_Integer (Old_Last);
      
      New_Length : constant Natural := Old_Length - N;
      New_Last : constant Last_Subtype := To_Index (New_Length);

      EA : Element_Array renames Container.Elements.all;
   begin      
      EA (F .. New_Last) := EA (B .. Old_Last); 
      Container.Last := New_Last;
   end;
   
   


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

   end Delete;
   

   procedure Delete_N
     (Container : in out Container_Type;
      First     : in     Index_Type'Base;
      Count     : in     Natural) 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));
      end;
               
   end Delete_N;


   procedure Do_Delete
     (Container : in out Container_Type;
      F, B      : in     Index_Type'Base;
      Item      : in     Element_Type) is

      N : constant Positive := Index_Type'Pos (B) - Index_Type'Pos (F);
      
      Old_Last : constant Index_Type := Container.Last;
      Old_Length : constant Positive := To_Integer (Old_Last);

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

      EA : Element_Array renames Container.Elements.all;
   begin      
      EA (F .. New_Last) := EA (B .. Old_Last);
      EA (Index_Type'Succ (New_Last) .. Old_Last) := (others => Item);

      Container.Last := New_Last;
   end;
   
   


   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;
      else
         return Container.Elements'Length;
      end if;
   end;
   

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

   begin
   
      if Container.Elements = null then  
         pragma Assert (Container.Last = Last_Subtype'First);
    
         declare
            Last : constant Last_Subtype := To_Index (Size);
         begin
            Container.Elements := 
               new Element_Array (Index_Type'First .. Last);
         end;
         
         return;
      end if;
      
      if Container.Elements'Length >= Size then
         return;
      end if;

      declare
         Last : constant Index_Type := To_Index (Size);

         EA : Element_Array_Access :=
            new Element_Array (Index_Type'First .. Last);
            
         Target : Element_Array renames
            EA (Index_Type'First .. Container.Last);               

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

         begin 
            Free (Container.Elements);   
         exception
            when others =>
               Container.Elements := null;
               Container.Last := Last_Subtype'First;
               Free (EA);
               raise;
         end;

         Container.Elements := EA;         
      end;
      
   end Resize;
   

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

   begin
   
      if Container.Elements = null then  
         pragma Assert (Container.Last = Last_Subtype'First);
    
         declare
            Last : constant Last_Subtype := To_Index (Size);
            
            subtype Array_Subtype is 
               Element_Array (Index_Type'First .. Last);
         begin
            Container.Elements := new Array_Subtype'(others => Item);
         end;
         
         return;
      end if;
      
      if Container.Elements'Length >= Size then
         return;
      end if;

      declare
         Last : constant Index_Type := To_Index (Size);

         Source : Element_Array renames
            Container.Elements (Index_Type'First .. Container.Last);
            
         subtype Array_Subtype is
            Element_Array (Index_Type'Succ (Container.Last) .. Last);

         EA : Element_Array_Access :=
            new Element_Array'(Source & Array_Subtype'(others => Item));
      begin      
         begin 
            Free (Container.Elements);   
         exception
            when others =>
               Container.Elements := null;
               Container.Last := Last_Subtype'First;
               Free (EA);
               raise;
         end;

         Container.Elements := EA;         
      end;
      
   end Resize;


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


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


   function Last
     (Container : Container_Type) return Index_Type'Base is
   begin
      return Container.Last;
   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) 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) 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;
      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 Copy_Element
     (Container : in     Container_Type;
      Index     : in     Index_Type;
      Item      :    out Element_Type) is

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


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

      subtype Index_Subtype is Index_Type'Base range
         Index_Type'First .. Container.Last;
      
      EA : Element_Array renames Container.Elements.all;
      
      E : constant Element_Type := EA (Index_Subtype'(Index));
   begin
      EA (Index_Subtype'(Index)) := Item;
      Item := E;
   end;


   procedure Generic_Swap_Element
     (Container : in     Container_Type;
      Index     : in     Index_Type;
      Item      : in out Element_Type) is
      
      subtype Index_Subtype is Index_Type'Base range
         Index_Type'First .. Container.Last;
         
      EA : Element_Array renames Container.Elements.all;
      
      E : Element_Type renames EA (Index_Subtype'(Index));      
   begin
      Swap (E, Item);
   end;



   procedure Swap
     (Container   : in Container_Type;
      Left, Right : in Index_Type) is
      
      subtype T is Index_Type'Base range
         Index_Type'First .. Container.Last;
      
      EA : Element_Array renames Container.Elements.all;
      
      LE : constant Element_Type := EA (T'(Left));      
   begin
      EA (Left) := EA (T'(Right));
      EA (Right) := LE;
   end;
   
      
      
   procedure Generic_Swap
     (Container   : in Container_Type;
      Left, Right : in Index_Type) is
      
      subtype T is Index_Type'Base range
         Index_Type'First .. Container.Last;
   
      EA : Element_Array renames Container.Elements.all;      
   begin
      Swap (EA (T'(Left)), EA (T'(Right)));
   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;
      First     : Index_Type'Base;
      Back      : Index_Type'Base) return Index_Type'Base is

      subtype T is Index_Type'Base range
         Index_Type'First .. Container.Last;
   begin
      if Back <= First then
         return Back;
      end if;
      
      for I in T'(First) .. T'(Index_Type'Pred (Back)) loop
         if Predicate (Container.Elements (I)) then
            return I;
         end if;
      end loop;
         
      return Back;
   end;
   
      
   function Find 
     (Container : Container_Type;
      First     : Index_Type'Base;
      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, Back);
   end;
      
      
   function Find 
     (Container : Container_Type;
      Item      : Element_Type) return Index_Type'Base is
   begin
      return Find (Container,
                   First (Container),
                   Back (Container),
                   Item);
   end;
   
      
   function Generic_Reverse_Find 
     (Container : Container_Type;
      First     : Index_Type'Base;
      Back      : Index_Type'Base) return Index_Type'Base is

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

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


   function Reverse_Find 
     (Container : Container_Type;
      First     : Index_Type'Base;
      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, Back);
   end;
         
      
   function Reverse_Find 
     (Container : Container_Type;
      Item      : Element_Type) return Index_Type'Base is
   begin
      return Reverse_Find (Container,
                           First (Container),
                           Back (Container),
                           Item);
   end;


end Charles.Vectors.Unbounded;