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;
Copyright ©
1996 Simon Johnston &
Addison Wesley Longman