File : agpl-dynamic_vector.adb


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

--                         ADAGIO - ADALID - AENEA.                         --

--                                                                          --

--                            Copyright (C) 2003                            --

--                                 A. Mosteo.                               --

--                                                                          --

--  Authors: A. Mosteo. (adagio@mosteo.com)                                 --

--                                                                          --

--  If you have any questions in regard to this software, please address    --

--  them to the above email.                                                --

--                                                                          --

--  This program is free software; you can redistribute it and/or modify    --

--  it under the terms of the GNU General Public License as published by    --

--  the Free Software Foundation; either version 2 of the License, or (at   --

--  your option) any later version.                                         --

--                                                                          --

--  This program 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       --

--  along with this library; if not, write to the Free Software Foundation, --

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

--                                                                          --

--  You are not allowed to use any part of this code to develop a program   --

--  whose output would be used to harass or prosecute other users of the    --

--  networks Adagio connects with. All data collected with Adagio or a tool --

--  containing Adagio code about other network users must remain            --

--  confidential and cannot be made public by any mean, nor be used to      --

--  harass or legally prosecute these users.                                --

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

--  $Id: agpl-dynamic_vector.adb,v 1.3 2004/02/24 15:26:09 Jano Exp $


-- Package for unbounded vectors, integer-indexed


with Ada.Unchecked_deallocation;

with Text_io;

package body Agpl.Dynamic_vector is

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

   -- Utilities --

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


   procedure Free is new Unchecked_deallocation (
      Item_array, Item_array_access);

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

   -- Object --

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


   -- First "attribute"

   -- O (1)

   function First (this : in Object) return integer is
   begin
      return this.First;
   end First;

   -- Last "attribute"

   -- O (1)

   function Last (this : in Object) return integer is
   begin
      return this.Last;
   end Last;

   -- Length "attribute"

   -- O (1)

   function Length (this : in Object) return integer is
   begin
      return this.Last - this.Vector.all'First + 1;
   end Length;

   -- Grows the vector according to the Grow_factor. Should not be necessary

   --    to be used. It's used internally.

   -- O (n)

   procedure Grow (this : in out Object; Empty_side : Sides := Ending) is
   begin
      declare
         Increment  : Natural := Natural'Max (1, 
            Natural (Float (this.Vector.all'Length) * Grow_factor));
         New_vector : Item_array_access := 
            new Item_array (this.Vector.all'First ..
               this.Vector.all'Last + Increment);
      begin
         -- Assign values:

         if Empty_side = Ending then
            New_vector (New_vector'First .. this.Last) :=
               this.Vector (this.Vector.all'First .. this.Last);
         else
            New_vector (New_vector'First + 1 .. this.Last + 1) :=
               this.Vector (this.Vector.all'First .. this.Last);
         end if;
         -- Replace:

         Free (this.Vector);
         this.Vector := New_vector;
      end;
   end Grow;

   -- Adds an item to the end. Will grow the vector if necessary.

   -- O (1) or O (n) if growing occurs

   procedure Append (this : in out Object; Item : in Item_type) is
   begin
      if this.Last = this.Vector.all'Last then
         -- grow it!

         Grow (this);
         -- Assign value

         this.Last := this.Last + 1;
         this.Vector (this.Last) := Item;
      else
         this.Last := this.Last + 1;
         this.Vector (this.Last) := Item;
      end if;
   end Append;

   -- Adds an item before a certain position (that could not exist if we

   --    want insertion at Last + 1, i.e., the end. Will grow the vector

   --    if necessary.

   -- O (n)

   procedure Insert (
      this : in out Object; Item : in Item_type; Pos : in Integer) is
   begin
      if this.Last = this.Vector.all'Last then
         -- grow it!

         Grow (this);
      end if;
      -- Slide the values:

      if Pos <= this.Last then
         this.Vector (Pos + 1 .. this.Last + 1) :=
            this.Vector (Pos .. this.Last);
      end if;
      -- Assign value

      this.Last := this.Last + 1;
      this.Vector (Pos) := Item;
   end Insert;

   -- Deletes an item at given pos

   -- O (n)

   procedure Delete (this : in out Object; Pos : in Integer) is
   begin
      if Pos > this.Last or else Pos < this.First then
         raise Constraint_error;
      end if;
      -- Reassign:

      if Pos /= this.Last then
         this.Vector (Pos ..this.Last - 1) := 
            this.Vector (Pos + 1 .. this.Last);
      end if;
      -- Shrink:

      this.Last := this.Last - 1;
   end Delete;

   -- Delete all ocurrences of an item

   -- O (n^2)

   procedure Delete_item (this : in out Object; Item : in Item_type) is
   begin
      for N in reverse this.First .. this.Last loop
         if this.Vector (N) = Item then
            Delete (this, N);
         end if;
      end loop;
   end Delete_item;

   -- Clean the vector, starts afresh

   -- O (1)

   procedure Reset (this : in out Object) is
   begin
      Finalize   (Proto_object (this));
      Initialize (Proto_object (this));
      this.Last := this.First - 1;
   end Reset;

   -- Optimize memory usage, vector of only valid positions

   -- Right after optimize, 'Last is valid.

   -- O (n)

   procedure Optimize (this : in out Object) is
      New_vector : Item_array_access := 
         new Item_array (this.First .. this.Last);
   begin
      -- Copy:

      New_vector (this.First .. this.Last) := 
         this.Vector (this.First .. this.Last);
      -- Free old:

      Free (this.Vector);
      -- Replace:

      this.Vector := New_vector;
   end Optimize;

   -- Member functions, not very useful if you access the vector directly:

   function Value (this : in Object) return Item_array is
   begin
      return this.Vector.all;
   end Value;

   function Value (this : in Object; Pos : in Integer) return Item_type is
   begin
      return this.Vector (Pos);
   end Value;

   -- Basic searching:

   -- Raise Item_not_found

   -- O (n)

   function Pos (
      this : in Object; 
      Item : in Item_type;
      Pos  : in Integer := Integer'First) return Integer is
   begin
      for N in Integer'Max(Pos, this.First - 1) + 1 .. this.Last loop
         if this.Vector (N) = Item then
            return N;
         end if;
      end loop;
      raise Item_not_found;
      return 0;
   end Pos;

   procedure Initialize (this : in out Proto_object) is
   begin
      if this.Vector /= null then
         Free (this.Vector);
      end if;

      this.Vector := 
         new Item_array (this.First .. this.First + Initial_size - 1);
   exception
      when others =>
         Text_io.Put_line ("Exception in Proto_object.Initialize");
   end Initialize;

   procedure Adjust     (this : in out Proto_object) is
--      New_vector : Item_array_access;

   begin
      this.Vector := new Item_array'(this.Vector.all);
--      New_vector := new Item_array (this.Vector'Range);

--      New_vector.all := this.Vector.all;

--      this.Vector := New_vector;

   exception
      when others =>
         Text_io.Put_line ("Exception in Proto_object.Adjust");
   end Adjust;

   procedure Finalize   (this : in out Proto_object) is
   begin
      Free (this.Vector);
   exception
      when others =>
         Text_io.Put_line ("Exception in Proto_object.Finalize");
   end Finalize;

   -- Overriden attributes

   procedure Write (
      Stream : access Ada.Streams.Root_stream_type'Class;
      Item   : in Object) is
   begin
      Natural'Output (Stream, Length (Item));
      for N in Item.First .. Last (Item) loop
         Item_type'Output (Stream, Item.Vector (N));
      end loop;
   end Write;

   procedure Read (
      Stream : access Ada.Streams.Root_stream_type'Class;
      Result : out    Object)
   is
      Length : Natural := Natural'Input (Stream);
   begin
      for N in 1 .. Length loop
         Append (Result, Item_type'Input (Stream));
      end loop;
   end Read;

end Agpl.Dynamic_vector;