Re: Ada and pointers

[James Rogers <jimmaureenrogers@worldnet.att.net>]

Darren New wrote:
> 
> As an aside, I have a C library right now that uses lots of linked
> lists. Linked lists of messages to send, linked lists of messages
> awaiting answers, linked lists of message numbers sent for which no
> answer has been received, etc.  Basically, most of these would be better
> as arrays where I could add elements to either end or delete elements
> from either end or the middle. Is there a better idiom for doing this in
> Ada, rather than using access types?
> 
> Basically, I guess I'm asking whether there's an idiom for building
> unbounded queues rather than with linked lists using access types?
> 

Remember that Ada does not have a concept of an unbounded array.
It does have a concept of an unconstrained array, which is really
quite different.

Every array has an index type. That index type must be a discrete
type. All discrete types have bounded ranges. This means that all
arrays are bounded.

That said, within the index range of an unconstrained array you
can provide some flexibility for queues or other buffer types.
This can be done in the same manner as the C++ (or Java) Vector
class.

The following code is a simple example of an Ada version of a C++
vector. Note that access types are used, but only because that
simplifies dynamic allocation and deallocation.

-- File: Tagged_Vector.ads
--
-- Generic vector for tagged types following C++ rules

generic
	type Element_Type is tagged private;
	with function ">=" (Left, Right : Element_Type) return Boolean;
package Tagged_Vector is
   type Group is array(Positive range <>) of Element_Type;
	type Vector is private;
	function First(Item : in Vector) return Natural;
	function Last(Item : in Vector) return Natural;
	function Size(Item : in Vector) return Natural;
	function Capacity(Item : in Vector) return Natural;
	function Is_Empty(Item : in Vector) return Boolean;
	function Element(Num : in Positive; 
	                 Item : in Vector) return Element_Type;
	procedure Reserve(Num_Items : in Positive;
	                  Item : in out Vector);
	function Front(Item : in Vector) return Element_Type;
	function Back(Item : in Vector) return Element_Type;
	procedure Push_Back(Value : in Element_Type;
	                    Onto  : in out Vector);
	procedure Pop_Back(Value : out Element_Type;
	                   From  : in out Vector);
	procedure Insert(Value  : in Element_Type;
	                 Before : in Positive;
			 Onto   : in out Vector);
	procedure Insert(Value      : in Element_Type;
	                 Num_Copies : in Positive;
			 Before     : in Positive;
			 Onto       : in out Vector);
	procedure Insert(The_Group : in Group;
	                 Before    : in Positive;
			 Onto      : in out Vector);
	procedure Erase(Index : in Positive;
	                From  : in out Vector);
	procedure Erase(First : in Positive;
	                Last  : in Positive;
			From  : in out Vector);
	procedure Resize(Num  : in Positive;
	                 Item : in out Vector);
	function "="(Left, Right : Vector) return Boolean;
	function "<"(Left, Right : Vector) return Boolean;
	
	Vector_Empty_Error : Exception;
private
   type Group_Access is access all Group;
   type Vector is record
	Buffer : Group_Access := new Group(1..20);
	Num_Elements : Natural := 0;
   end record;
end Tagged_Vector; 

-- File : Tagged_Vector.adb
   with Ada.Unchecked_Deallocation;

   package body Tagged_Vector is
      procedure Free is new Ada.Unchecked_Deallocation(
                        Object => Group,
                        Name =>Group_Access);
   
      function First(Item : in Vector) return Natural is
      begin
         if Item.Num_Elements > 0 then
            return 1;
         else
            return 0;
         end if;
      end First;
   
      function Last(Item : in Vector) return Natural is
      begin
         return Item.Num_Elements;
      end Last;
   
      function Size(Item : in Vector) return Natural is
      begin
         return Item.Num_Elements;
      end Size;
   
      function Capacity(Item : in Vector) return Natural is
      begin
         if Item.Buffer /= null then
            return Item.Buffer.all'Last;
         else
            return 0;
         end if;
      end Capacity;
   
      function Is_Empty(Item : in Vector) return Boolean is
      begin
         return Item.Num_Elements = 0;
      end Is_Empty;
   
      function Element(Num : in Positive;
                       Item : in Vector) return Element_Type is
      begin
         if Num <= Item.Num_Elements then
            return Item.Buffer.all(Num);
         else
            return Item.Buffer.all(Item.Num_Elements);
         end if;
      end Element;
   
      procedure Reserve(Num_Items : in Positive;
                        Item : in out Vector) is
         Temp : Group_Access;
      begin
         if Num_Items > Item.Buffer.all'Last then
            Temp := new Group(1..(2 * Num_Items));
         -- Copy Elements to new buffer
            Temp.all(1..Item.Num_Elements) :=
                Item.Buffer.all(1..Item.Num_Elements);
            Free(Item.Buffer);
         end if;
         Item.Buffer := Temp;
      end Reserve;
   
      function Front(Item : in Vector) return Element_Type is
      begin
         if Item.Num_Elements = 0 then
            raise Vector_Empty_Error;
         end if;
         return Item.Buffer.all(1);
      end Front;
   
      function Back(Item : in Vector) return Element_Type is
      begin
         if Item.Num_Elements = 0 then
            raise Vector_Empty_Error;
         end if;
         return Item.Buffer.all(Item.Num_Elements);
      end Back;
   
      procedure Push_Back(Value : in Element_Type;
                          Onto  : in out Vector) is
         Temp : Group_Access;
      begin
         if Onto.Num_Elements = Onto.Buffer.All'Last then
            Temp := new Group(1..(2 * Onto.Num_Elements));
            Temp.all(1..Onto.Num_Elements) := 
               Onto.Buffer.all(1..Onto.Num_Elements);
            Free(Onto.Buffer);
            Onto.Buffer := Temp;
         end if;
         Onto.Num_Elements := Onto.Num_Elements + 1;
         Onto.Buffer.all(Onto.Num_Elements) := Value;
      end Push_Back;
   
      procedure Pop_Back(Value : out Element_Type;
                         From  : in out Vector) is
      begin
         if From.Num_Elements = 0 then
            raise Vector_Empty_Error;
         end if;
         Value := From.Buffer.all(From.Num_Elements);
         From.Num_Elements := From.Num_Elements - 1;
      end Pop_Back;
   
      procedure Insert(Value : in Element_Type;
                       Before : in Positive;
                       Onto   : in out Vector) is
         Temp : Group_Access;
         new_Pos : Positive;
      begin
         if Onto.Num_Elements = Onto.Buffer.All'Last then
            Temp := new Group(1..(2 * Onto.Num_Elements));
            Temp.all(1..Onto.Num_Elements) := 
               Onto.Buffer.all(1..Onto.Num_elements);
            Free(Onto.Buffer);
            Onto.Buffer := Temp;
         end if;
         if Before <= Onto.Num_Elements then
            for num in reverse Before..Onto.Num_Elements loop
               Onto.Buffer.all(Num + 1) := Onto.Buffer.All(Num);
            end loop;
            New_Pos := Before;
         else
            New_Pos := Onto.Num_Elements + 1;
         end if;
         Onto.Buffer.All(New_Pos) := Value;
         Onto.Num_Elements := Onto.Num_Elements + 1;
      end Insert;
   
      procedure Insert(Value      : in Element_Type;
                       Num_Copies : in Positive;
                       Before     : in Positive;
                       Onto       : in out Vector) is
      begin
         for copy in 1..Num_Copies loop
            Insert(Value => Value, Before => Before, Onto => Onto);
         end loop;
      end Insert;
   
      procedure Insert(The_Group : in Group;
                       Before    : in Positive;
                       Onto      : in out Vector) is
      begin
         for Index in reverse The_Group'Range loop
            Insert(Value  => The_Group(Index),
                   Before => Before,
                   Onto   => Onto);
         end loop;
      end Insert;
   
      procedure Erase(Index : in Positive;
                      From  : in out Vector) is
      begin
         if Index <= From.Num_Elements then
            for num in Index + 1..From.Num_Elements loop
               From.Buffer.all(Num - 1) := From.Buffer.all(Num);
            end loop;
            From.Num_Elements := From.Num_Elements - 1;
         end if;
      end Erase;
   
      procedure Erase(First : in Positive;
                      Last  : in Positive;
                      From  : in out Vector) is
         Final : Positive;
      begin
         if Last >= First then
            if Last > From.Num_Elements then
               Final := From.Num_Elements;
            else
               Final := Last;
            end if;
            for num in First..Final loop
               Erase(Index => First, From => From);
            end loop;
         end if;
      end Erase;
   
      procedure Resize(Num : in Positive;
                       Item : in out Vector) is
         Temp : Group_Access;
      begin
         if Num >= (2 * Item.Num_Elements) then
            Temp := new Group(1..Num);
            for index in 1..Item.Num_Elements loop
               Temp.all(index) := Item.Buffer.all(Index);
            end loop;
            Free(Item.Buffer);
            Item.Buffer := Temp;
         end if;
      end Resize;
   
      function "="(Left, Right : in Vector) return Boolean is
         Result : Boolean;
      begin
         if Left.Num_Elements = Right.Num_Elements then
            Result := True;
            for index in 1..Left.Num_Elements loop
               if Left.Buffer.all(index) /= Right.Buffer.all(Index) then
                  Result := False;
               end if;
               exit when Result = False;
            end loop;
         else
            Result := False;
         end if;
         return Result;
      end "=";
   
      function "<"(Left, Right : in Vector) return Boolean is
         Result : Boolean;
      begin
         if Left.Num_Elements <= Right.Num_Elements then
            Result := True;
            for index in 1..Left.Num_Elements loop
               if Left.Buffer.all(Index) >= Right.Buffer.all(Index) then
                  Result := False;
               end if;
               exit when Result = False;
            end loop;
         else
            Result := False;
         end if;
         return Result;
      end "<";
   end Tagged_Vector;
-------------------------------------------

You will notice that using a Tagged_Vector as a resizable array has some
real costs. For instance, inserting or erasing elements causes massive
copy operations. There is also the cost of enlarging the array, which
also requires massive copying.

I created this version using the SGI definition of the C++ Standard
Template Library. It therefore satisfies all the behavior requirements
stated by the SGI definition.

Jim Rogers
Colorado Springs, Colorado USA