 |  | limited_lists |  |
 |  | limi_lists.ads |  |
 | limi_lists.adb |
|  | lists | |
| | limited_lists | |
| lists | ||
| string_lists | ||
| test_lists.adb | ||
| test_stri_list |
| | util | |
|  | hash_tables/ | |
| heaps/ | ||
| images/ | ||
| lists/ | ||
| maths/ | ||
| messages/ | ||
| pipes/ | ||
| primes/ | ||
| readers/ | ||
| strings/ | ||
| writers/ |
| | ada | |
| | bin/ | |
| engine/ | ||
| fonts/ | ||
| internal/ | ||
| text/ | ||
| util/ |
|  | Home | |
|  | Showcase | |
 | Snapshots | ||
 | Ada Source | ||
 | PHP Source | ||
 | Fonts |
|  | Sourceforge | |
|  | Summary | |
 | Downloads | ||
 | Browse CVS | ||
 | Donate | ||
 | Activity |
Hosted by
-- $Date: 2004/02/14 09:51:42 $
-- $Revision: 1.3 $
-- $Author: jcrocholl $
with Ada.Unchecked_Deallocation;
package body Limited_Lists is
--------------------
-- List construction
--------------------
-- Create a list.
function Create
return List_Access is
begin
return new List;
end Create;
-- Append a list at the end of another list. This is done by simply
-- linking from the last item to the first item of the tail, not by
-- copying the items of the tail. This means that if you modify the
-- tail list later, the modifications will appear in the appended
-- list as well.
procedure Append
(This : access List; -- Append to this list.
Tail : access List) is -- Append these items at the end.
begin
This.Last.Next := Tail.First;
This.Count := This.Count + Tail.Count;
This.Last := Tail.Last;
end Append;
---------------
-- Adding items
---------------
-- Insert an item at the end of the list.
function Push
(This : access List) -- Push into this list.
return Item_Access -- The newly created item.
is
New_Item : Item_Access := new Item;
begin
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;
-- New_Item.Content := Content;
return New_Item;
end Push;
-- Insert an item at the beginning of the list.
function Unshift
(This : access List) -- Unshift into this list.
return Item_Access -- The newly created item.
is
New_Item : Item_Access := new Item;
begin
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;
-- New_Item.Content := Content;
return New_Item;
end Unshift;
-----------------
-- Removing items
-----------------
-- Remove an item at the end of the list.
function Pop
(This : access List) -- Pop out of this list.
return Item_Access -- The removed item.
is
Not_Implemented : exception;
begin
raise Not_Implemented;
return null;
end Pop;
-- Remove an item at the beginning of the list.
function Shift
(This : access List) -- Shift out of this list.
return Item_Access -- The removed item.
is
Result : Item_Access := This.First;
begin
This.First := Result.Next;
if This.First = null then This.Last := null; end if;
This.Count := This.Count - 1;
return Result;
end Shift;
-----------------
-- Item indexing.
-----------------
-- Count items in this list. This operation is not O(n) but O(1)
-- because the result comes straight from a counter variable.
function Count
(This : access List) -- Get information about this list.
return Natural is -- The number of items in the list.
begin
return This.Count;
end Count;
-- Is the list empty? Returns True if and only if there are no
-- items in the list.
function Empty
(This : access List) -- Get information about this list.
return Boolean is -- This list empty?
begin
return This.First = null;
end Empty;
-- Read the current iteration position as a number, starting with 1
-- at the first item. An index of 0 means: no current item, so
-- either we're not currently iterating or the iteration has
-- finished.
function Index
(This : access List) -- Get information about this list.
return Natural is -- Iteration index of this list.
begin
return This.Index;
end Index;
----------------------
-- First and last item
----------------------
-- Read the first item in the list.
function First
(This : access List) -- Read from this list.
return Content_Type is -- The first item.
begin
return This.First.Content;
end First;
-- Read the last item in the list.
function Last
(This : access List) -- Read from this list.
return Content_Type is -- The last item.
begin
return This.Last.Content;
end Last;
-----------------------
-- Iterate over a list.
-----------------------
-- Reset the iteration index to 0. This starts a new
-- iteration. There must be a call to Next before the first item
-- can be read from the function Current.
procedure Reset
(This : access List) is -- The list to iterate over.
begin
This.Current := null;
This.Index := 0;
end Reset;
-- Go to the next item.
procedure Next
(This : access List) is -- The list to iterate over.
begin
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;
-- Go to the next item. Returns False if and only if we reached the
-- end of the list.
function Next
(This : access List) -- The list to iterate over.
return Boolean is -- Successfully moved to next item?
begin
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;
-- Is the a next item available? Returns False if the current item
-- is the last one in the list.
function Next_Available
(This : access List) -- The list to iterate over.
return Boolean is -- Next item available?
begin
return This.Next /= null;
end Next_Available;
-- Get the content of the next item.
function Next_Content
(This : access List) -- The list to iterate over.
return Content_Type is -- The content of the next item.
begin
return This.Next.Content;
end Next_Content;
-- End of list reached? Returns True if and only if the current
-- item pointer is null. This also occurs after calling Reset but
-- before calling Next.
function End_Of_List
(This : access List) -- The list to iterate over.
return Boolean is -- Reached end of list?
begin
return This.Current = null;
end End_Of_List;
-- Read the item at the current iteration pointer.
function Current
(This : access List) -- The list to iterate over.
return Content_Type is -- Current item.
begin
return This.Current.Content;
end Current;
-----------------------------------
-- Manipulate list while iterating.
-----------------------------------
procedure Free is new Ada.Unchecked_Deallocation(Item, Item_Access);
procedure Free is new Ada.Unchecked_Deallocation(List, List_Access);
-- Remove the item at the current iteration pointer from the list.
procedure Remove_Current
(This : access List) -- The list to modify.
is
Old_Item : Item_Access := 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;
Free(Old_Item);
end Remove_Current;
-- Insert an item directly before the item at the current iteration
-- pointer.
function Insert_Before_Current
(This : access List) -- The list to modify.
return Item_Access -- The newly created item.
is
New_Item : Item_Access := new Item;
begin
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;
-- New_Item.Content := Content;
return New_Item;
end Insert_Before_Current;
-- Insert an item directly after the item at the current iteration
-- pointer.
function Insert_After_Current
(This : access List) -- The list to modify.
return Item_Access -- The newly created item.
is
New_Item : Item_Access := new Item;
begin
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;
-- New_Item.Content := Content;
return New_Item;
end Insert_After_Current;
------------------------
-- Item direct iteration
------------------------
-- Get the first item of the list.
function First_Item
(This : access List) -- Read from this list.
return Item_Access is -- The first item.
begin
return This.First;
end First_Item;
-- Get the last item of the list.
function Last_Item
(This : access List) -- Read from this list.
return Item_Access is -- The last item.
begin
return This.Last;
end Last_Item;
-- Get the current iteration item of the list.
function Current_Item
(This : access List) -- Read from this list.
return Item_Access is -- The last item.
begin
return This.Current;
end Current_Item;
-- Go to the next item.
procedure Next_Item
(This : in out Item_Access) is -- Advance this item.
begin
This := This.Next;
end Next_Item;
-- Get the next item.
function Next_Item
(This : access Item) -- Get this item's successor.
return Item_Access is -- The successor of the input item.
begin
return This.Next;
end Next_Item;
-- Returns True if and only if the item pointer is null. This
-- happens after the last item in the list.
function Item_Invalid
(This : in Item_Access) -- The iterating list item.
return Boolean is -- Reached end of list?
begin
return This = null;
end Item_Invalid;
-- Compare two items (not the contents but the pointers).
function Item_Equals
(This : in Item_Access; -- Compare this item.
Other : in Item_Access) -- To that other item.
return Boolean is -- True if the pointers are the same.
begin
return This = Other;
end Item_Equals;
-- Read an item's content.
function Item_Content
(This : access Item) -- Read content from this item.
return Content_Type is -- Content of this item.
begin
return This.Content;
end Item_Content;
-- Remove an item from the list and advance the item pointer.
procedure Remove_Item
(Previous : in Item_Access; -- May be null if removing first.
This : in out Item_Access; -- Remove and advance this item.
Context : access List) -- Remove the item from this list.
is
Next : Item_Access := 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;
Free(This);
This := Next;
end Remove_Item;
end Limited_Lists;