package Ada_Store.Support.List

generic

   type Element_Type is private;

package Ada_Store.Support.List is

   type Instance is private;

   procedure Append
     (List    : access Instance;
      Element : in     Element_Type);

   function  Get
     (List    : access Instance) return Element_Type;

   function  Peek
     (List    : access Instance) return Element_Type;

   List_Empty : exception;

private
   type Element_Holder;
   type List_Ptr       is access Element_Holder;

   type Element_Holder is
      record
	 Actual   : Element_Type;
	 Next     : List_Ptr := null;
      end record;

   type Instance is 
     record
	Head : List_Ptr := null;
	Tail : List_Ptr := null;
     end record;

end Ada_Store.Support.List;

with Unchecked_Deallocation;

package body Ada_Store.Support.List is

   procedure Free is new Unchecked_Deallocation(Element_Holder, List_Ptr);

   procedure Append
     (List    : access Instance;
      Element : in     Element_Type) is

      Temp_Tail : List_Ptr;
   begin
      if List.Tail = null then

	 List.Tail := new Element_Holder'(Actual => Element, 
					  Next   => null);
	 List.Head := List.Tail;
      else

	 Temp_Tail := List.Tail;
	 List.Tail.Next := new Element_Holder'(Actual => Element, 
					       Next   => null);
      end if;
   end Append;

   function  Get
     (List    : access Instance) return Element_Type is

      Element : Element_Type;
   begin
      if List.Head = null then
	 
	 raise List_Empty;
      end if;

      Element := List.Head.Actual;
      
      List.Head := List.Head.Next;

      if List.Head = null then

	 List.Tail := null;
      end if;

      Free(List.Head);
      
      return Element;
   end Get;

   function  Peek
     (List    : access Instance) return Element_Type is
   begin
      if List.Head = null then
	 
	 raise List_Empty;
      end if;

      return List.Head.Actual;
   end Peek;

end Ada_Store.Support.List;

Contents Page

Copyright © 1996 Simon Johnston &
Addison Wesley Longman