File : bag.adb

     -- An implementation of a simple (and very limited) abstract data type
     -- for a Bag.  COL Gene Ressler
     
     with Ada.Unchecked_Deallocation;
   5 
     package body Bag is
     
        procedure Free_Element_Vector is
           new Ada.Unchecked_Deallocation(Element_Vector_Type, Element_Vector_Ptr_Type);
  10 
        procedure Add(Bag : in out Bag_Type;
                      Element : in Element_Type) is
           New_Elements : Element_Vector_Ptr_Type;
        begin
  15       if Bag.N_Elements = Bag.Elements'Last then
              -- Double space available for the bag if we're out.
              New_Elements := new Element_Vector_Type(1..Bag.N_Elements * 2);
              New_Elements(Bag.Elements'Range) := Bag.Elements.all;
              Free_Element_Vector(Bag.Elements);
  20          Bag.Elements := New_Elements;
           end if;
           Bag.N_Elements := Bag.N_Elements + 1;
           Bag.Elements(Bag.N_Elements) := Element;
        end Add;
  25 
        -- Local procedure to check that index refers to a bag element.
        -- Raises constraint_error if there is a problem.
        procedure Check_Index(Bag : in Bag_Type;
                              Index : in Natural) is
  30    begin
           if not (Index in 1..Bag.N_Elements) then
              raise Constraint_Error;
           end if;
        end Check_Index;
  35 
        procedure Delete(Bag : in out Bag_Type;
                         Index : in out Natural) is
        begin
           Check_Index(Bag, Index);
  40       Bag.Elements(Index) := Bag.Elements(Bag.N_Elements);
           Bag.N_Elements := Bag.N_Elements - 1;
           Index := Index - 1;
        end Delete;
     
  45    procedure Clear(Bag : in out Bag_Type) is
        begin
           Bag.N_Elements := 0;
           Free_Element_Vector(Bag.Elements);
           Bag.Elements := new Element_Vector_Type(1..Initial_Bag_Size);
  50    end Clear;
     
        procedure Set(Bag : in out Bag_Type;
                      Index : in Natural;
                      Element : in Element_Type) is
  55    begin
           Check_Index(Bag, Index);
           Bag.Elements(Index) := Element;
        end Set;
     
  60    procedure Get_Next(Bag : in Bag_Type;
                           Index : in out Natural;
                           Element : out Element_Type) is
        begin
           if Index = Bag.N_Elements then
  65          Index := 0;
           else
              Index := Index + 1;
              Check_Index(Bag, Index);
              Element := Bag.Elements(Index);
  70       end if;
        end Get_Next;
     
     end Bag;