Vectors.adb

with Unchecked_Deallocation;

package body Vectors is

  procedure Free is new Unchecked_Deallocation
    (Object => Elements_Type, Name => Elements_Access);

  procedure Inflate (V: in out Vector; Incr : in Integer := 100) is
    Quantity_As_Int : constant Integer := Integer (V.Quantity) + Incr;
    Quantity : constant Index_Type := Index_Type (Quantity_As_Int);
    New_Elements : constant Elements_Access :=
      new Elements_Type (Index_Type'First .. Quantity);
  begin
    if V.Last /= Last_Subtype'First then
      New_Elements(Index_Type'First .. V.Last) :=
        V.Elements(Index_Type'First .. V.Last);
      Free(V.Elements);
    end if;
      V.Elements := New_Elements;
      V.Quantity := Quantity;
  end Inflate;

  procedure Push(V : in out Vector; In_Item : in Element_Type) is
  begin
    if Is_Full(V) then    
      Inflate(V);
    end if;
      V.Last := V.Last + 1;
      V.Elements(V.Last) := In_Item;
  end Push;


  procedure Pop(V : in out Vector; Out_Item : out Element_Type) is
  begin
    if Is_Empty(V) then   
      raise Constraint_Error;
    end if;
      Out_Item := V.Elements(V.Last);
      V.Last := V.Last - 1;
  end Pop;


  function Peek(V : in Vector; Index : Index_Type) return Element_Type is
  begin
    if Is_Empty(V) and  Index > V.Last then
      raise Constraint_Error;
    end if;
    return V.Elements(Index);
  end Peek;


  function Is_Empty(V : in Vector) return Boolean is
  begin
    return V.Last = Index_Type'Pred (Index_Type'First);
  end Is_Empty;


  function Is_Full(V : in Vector) return Boolean is
  begin
    return V.Last = V.Quantity;
  end Is_Full;


  function Last(V : in Vector) return Index_Type is
  begin
    return V.Last;
  end Last;


  function Capacity(V : in Vector) return Integer is
    Down : constant Integer := Integer (Index_Type'Pred(Index_Type'First));
    Last : constant Integer := Integer (V.Last);
  begin
    return Last - Down;
  end Capacity;


  procedure Clear(V : in out Vector) is
  begin
    V.Last := Index_Type'Pred (Index_Type'First);
  end Clear;

  procedure Finalize(V: in out Vector) is
  begin
    null; -- TODO
  end Finalize;

  procedure Adjust(V: in out Vector) is
  begin
    null; -- TODO
  end Adjust;

end Vectors;

Vectors.ads

with Ada.Finalization;

generic

  type Index_Type is range <>;

  type Element_Type is private;

package Vectors is

  type Vector is tagged private;

  procedure Push(V : in out Vector; In_Item  : in  Element_Type);
  procedure Pop (V : in out Vector; Out_Item : out Element_Type);

  function Peek (V : in Vector; Index : Index_Type) return Element_Type;

  function Is_Empty (V : in Vector) return Boolean;
  function Last     (V : in Vector) return Index_Type;
  function Capacity (V : in Vector) return Integer;
  procedure Clear   (V : in out Vector);

private
  
  type Elements_Type is array (Index_Type range <>) of Element_Type;
  type Elements_Access is access Elements_Type;

  subtype Last_Subtype is Index_Type'Base range
    Index_Type'Pred (Index_Type'First) .. Index_Type'Last;

  use Ada.Finalization;

  type Vector is new Controlled with record
    Elements : Elements_Access;
    Last     : Last_Subtype := Last_Subtype'First;
    Quantity : Last_Subtype := Last_Subtype'First;
  end record;

  procedure Finalize (V : in out Vector);
  procedure Adjust   (V : in out Vector);

  function Is_Full   (V : in Vector) return Boolean;
  procedure Inflate  (V: in out Vector; Incr : in Integer := 100);

end Vectors;