-- $Date: 2004/01/10 03:45:57 $
-- $Revision: 1.18 $
-- $Author: jcrocholl $

with Ada.Unchecked_Deallocation;

package body Lists is

   --------------------
   -- Construct a list.
   --------------------

   -- Insert an item at the end of the list.
   procedure Push
     (This    : in out List;     -- Push into this list.
      Content : in Content_Type-- The new item.
   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;

   -- Insert an item at the beginning of the list.
   procedure Unshift
     (This    : in out List;     -- Insert into this list.
      Content : in Content_Type-- The new item.
   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;

   -- 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 : in out List;    -- Append to this list.
      Tail : in out 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;

   -----------------
   -- 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 : in List)  -- Get information about this list.
     return Natural is -- The number of items in the list.
   begin
      if This = null
      then return 0;
      else return This.Count;
      end if;
   end Count;

   -- Is the list empty? Returns True if and only if there are no
   -- items in the list.
   function Empty
     (This : in List)  -- Get information about this list.
     return Boolean is -- This list empty?
   begin
      if This = null
      then return True;
      else return This.First = null;
      end if;
   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 : in List)  -- Get information about this list.
     return Natural is -- Iteration index of this list.
   begin
      if This = null
      then return 0;
      else return This.Index;
      end if;
   end Index;

   --------------------
   -- Read from a list.
   --------------------

   -- Read the first item in the list.
   function First
     (This : in 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 : in 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 : in List) is -- The list to iterate over.
   begin
      if This /= null then
         This.Current := null;
         This.Index := 0;
      end if;
   end Reset;

   -- Go to the next item.
   procedure Next
     (This : in List) is -- The list to iterate over.
   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;

   -- Go to the next item. Returns False if and only if we reached the
   -- end of the list.
   function Next
     (This : in List)  -- The list to iterate over.
     return Boolean is -- Successfully moved to next item?
   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;

   -- Is the a next item available? Returns False if the current item
   -- is the last one in the list.
   function Next_Available
     (This : in 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 : in 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 : in List)  -- The list to iterate over.
     return Boolean is -- Reached end of list?
   begin
      if This = null
      then return True;
      else return This.Current = null;
      end if;
   end End_Of_List;

   -- Read the item at the current iteration pointer.
   function Current
     (This : in List)       -- The list to iterate over.
     return Content_Type is -- Current item.
   begin
      return This.Current.Content;
   end Current;

   -----------------------------------
   -- Manipulate list while iterating.
   -----------------------------------

   -- Update the item at the current iteration pointer.
   procedure Update_Current
     (This    : in List;            -- The list to modify.
      Content : in Content_Type) is -- New content for the current item.
   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);

   -- Remove the item at the current iteration pointer from the list.
   procedure Remove_Current
     (This : in out List-- The list to modify.
   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;

   -- Insert an item directly before the item at the current iteration
   -- pointer.
   procedure Insert_Before_Current
     (This    : in out List;     -- The list to modify.
      Content : in Content_Type-- The item to insert.
   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;

   -- Insert an item directly after the item at the current iteration
   -- pointer.
   procedure Insert_After_Current
     (This    : in out List;     -- The list to modify.
      Content : in Content_Type-- The item to insert.
   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;

   ------------------------
   -- Item direct iteration
   ------------------------

   -- Get the first item of the list.
   function First_Item
     (This : in List-- Read from this list.
     return Item is   -- The first item.
   begin
      return This.First;
   end First_Item;

   -- Get the last item of the list.
   function Last_Item
     (This : in List-- Read from this list.
     return Item is   -- The last item.
   begin
      return This.Last;
   end Last_Item;

   -- Go to the next item.
   procedure Next_Item
     (This : in out Item) is -- Advance this item.
   begin
      This := This.Next;
   end Next_Item;

   -- Get the next item.
   function Next_Item
     (This : in Item-- Get this item's successor.
     return Item 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)  -- 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-- Compare this item.
      Other : in Item-- 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 : in Item)       -- Read content from this item.
     return Content_Type is -- Content of this item.
   begin
      return This.Content;
   end Item_Content;

   -- Change an item's content.
   procedure Update_Item
     (This    : in Item;            -- Modify this item.
      Content : in Content_Type) is -- New content.
   begin
      This.Content := Content;
   end Update_Item;

   -- Remove an item from the list and advance the item pointer.
   procedure Remove_Item
     (Previous : in Item;     -- May be null if removing first.
      This     : in out Item-- Remove and advance this item.
      Context  : in out List-- Remove the item from this 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;