Hosted by
 |
with Ada.Unchecked_Deallocation;
package body Lists is
procedure Push
(This : in out List;
Content : in Content_Type)
is
New_Item : Lists.Item := new Item_Record;
begin
New_Item.Content := Content;
if This = null then This := new List_Record; end if;
if This.First = null
then This.First := New_Item;
else This.Last.Next := New_Item;
end if;
This.Last := New_Item;
This.Count := This.Count + 1;
end Push;
procedure Unshift
(This : in out List;
Content : in Content_Type)
is
New_Item : Lists.Item := new Item_Record;
begin
New_Item.Content := Content;
if This = null then This := new List_Record; end if;
New_Item.Next := This.First;
This.First := New_Item;
if This.Last = null then This.Last := New_Item; end if;
This.Count := This.Count + 1;
end Unshift;
procedure Append
(This : in out List;
Tail : in out List) is
begin
This.Last.Next := Tail.First;
This.Count := This.Count + Tail.Count;
This.Last := Tail.Last;
end Append;
function Count
(This : in List)
return Natural is
begin
if This = null
then return 0;
else return This.Count;
end if;
end Count;
function Empty
(This : in List)
return Boolean is
begin
if This = null
then return True;
else return This.First = null;
end if;
end Empty;
function Index
(This : in List)
return Natural is
begin
if This = null
then return 0;
else return This.Index;
end if;
end Index;
function First
(This : in List)
return Content_Type is
begin
return This.First.Content;
end First;
function Last
(This : in List)
return Content_Type is
begin
return This.Last.Content;
end Last;
procedure Reset
(This : in List) is
begin
if This /= null then
This.Current := null;
This.Index := 0;
end if;
end Reset;
procedure Next
(This : in List) is
begin
if This = null then return; end if;
This.Prev := This.Current;
if This.Current = null
then This.Current := This.First;
else This.Current := This.Current.Next;
end if;
if This.Current /= null then
This.Next := This.Current.Next;
This.Index := This.Index + 1;
else
This.Next := null;
This.Index := 0;
end if;
end Next;
function Next
(This : in List)
return Boolean is
begin
if This = null then return False; end if;
This.Prev := This.Current;
if This.Current = null
then This.Current := This.First;
else This.Current := This.Current.Next;
end if;
if This.Current /= null then
This.Next := This.Current.Next;
This.Index := This.Index + 1;
return True;
else
This.Next := null;
This.Index := 0;
return False;
end if;
end Next;
function Next_Available
(This : in List)
return Boolean is
begin
return This.Next /= null;
end Next_Available;
function Next_Content
(This : in List)
return Content_Type is
begin
return This.Next.Content;
end Next_Content;
function End_Of_List
(This : in List)
return Boolean is
begin
if This = null
then return True;
else return This.Current = null;
end if;
end End_Of_List;
function Current
(This : in List)
return Content_Type is
begin
return This.Current.Content;
end Current;
procedure Update_Current
(This : in List;
Content : in Content_Type) is
begin
This.Current.Content := Content;
end Update_Current;
procedure Free is new Ada.Unchecked_Deallocation(Item_Record, Item);
procedure Free is new Ada.Unchecked_Deallocation(List_Record, List);
procedure Remove_Current
(This : in out List)
is
Old_Item : Item := This.Current;
begin
This.Count := This.Count - 1;
This.Current := Old_Item.Next;
if This.First = Old_Item then This.First := This.Current; end if;
if This.Last = Old_Item then This.Last := This.Prev; end if;
if This.Current /= null then This.Next := This.Current.Next; end if;
if This.Prev /= null then This.Prev.Next := This.Current; end if;
if This.Count = 0 then
Free(This);
This := null;
end if;
Free(Old_Item);
end Remove_Current;
procedure Insert_Before_Current
(This : in out List;
Content : in Content_Type)
is
New_Item : Lists.Item := new Item_Record;
begin
New_Item.Content := Content;
if This = null then This := new List_Record; end if;
if This.Current = null then
if This.Last = null
then This.First := New_Item;
else This.Last.Next := New_Item;
end if;
This.Last := New_Item;
else
New_Item.Next := This.Current;
if This.Prev /= null then This.Prev.Next := New_Item; end if;
if This.First = This.Current then This.First := New_Item; end if;
end if;
This.Prev := New_Item;
This.Index := This.Index + 1;
This.Count := This.Count + 1;
end Insert_Before_Current;
procedure Insert_After_Current
(This : in out List;
Content : in Content_Type)
is
New_Item : Lists.Item := new Item_Record;
begin
New_Item.Content := Content;
if This = null then This := new List_Record; end if;
if This.Current = null then
New_Item.Next := This.First;
This.First := New_Item;
if This.Last = null then This.Last := New_Item; end if;
else
New_Item.Next := This.Current.Next;
This.Current.Next := New_Item;
if This.Last = This.Current then This.Last := New_Item; end if;
end if;
This.Next := New_Item;
This.Count := This.Count + 1;
end Insert_After_Current;
function First_Item
(This : in List)
return Item is
begin
return This.First;
end First_Item;
function Last_Item
(This : in List)
return Item is
begin
return This.Last;
end Last_Item;
procedure Next_Item
(This : in out Item) is
begin
This := This.Next;
end Next_Item;
function Next_Item
(This : in Item)
return Item is
begin
return This.Next;
end Next_Item;
function Item_Invalid
(This : in Item)
return Boolean is
begin
return This = null;
end Item_Invalid;
function Item_Equals
(This : in Item;
Other : in Item)
return Boolean is
begin
return This = Other;
end Item_Equals;
function Item_Content
(This : in Item)
return Content_Type is
begin
return This.Content;
end Item_Content;
procedure Update_Item
(This : in Item;
Content : in Content_Type) is
begin
This.Content := Content;
end Update_Item;
procedure Remove_Item
(Previous : in Item;
This : in out Item;
Context : in out List)
is
Next : Item := This.Next;
begin
Context.Count := Context.Count - 1;
if This = Context.First then
pragma Assert(Next /= null);
Context.First := Next;
end if;
if This = Context.Last then
pragma Assert(Previous /= null);
pragma Assert(Next = null);
Context.Last := Previous;
end if;
if Previous /= null then
if Previous = Context.Last
then Previous.Next := null;
else Previous.Next := Next;
end if;
end if;
if Context.Count = 0 then
Free(Context);
Context := null;
end if;
Free(This);
This := Next;
end Remove_Item;
end Lists;
|