with Unchecked_Deallocation;

package body Lists is

   procedure Free is new Unchecked_Deallocation
     (Element_Type, Element_Pointer);

   --------------------------------------------------------------------------

   procedure Attach (List1 : in out List; List2 : in List) is

      Endoflist1 : Element_Pointer;

      --| Attach List2 to List1.
      --| If List1 is null return List2
      --| If List1 equals List2 then raise CircularList
      --| Otherwise get the pointer to the last element of List1 and change
      --| its Next field to be List2.

   begin
      if List1.Head = null then
         List1 := List2;
      elsif List1 = List2 then
         raise Circularlist;
      else
         Endoflist1      := List1.Tail;
         Endoflist1.Next := List2.Head;
         List1.Tail      := List2.Tail;
      end if;
   end Attach;

   --------------------------------------------------------------------------

   procedure Attach (L : in out List; Element : in Itemtype) is

      Old_Tail, New_Element : Element_Pointer;

      --| Create a list containing Element and attach it to the end of L

   begin
      New_Element := new Element_Type'(Item => Element, Next => null);
      if L.Head = null then
         L.Head := New_Element;
         L.Tail := New_Element;
      else
         Old_Tail      := L.Tail;
         Old_Tail.Next := New_Element;
         L.Tail        := New_Element;
      end if;
   end Attach;

   --------------------------------------------------------------------------

   function Attach (Element1 : in Itemtype; Element2 : in Itemtype) return List
   is

      Newlist : List;

      --| Create a new list containing the information in Element1 and
      --| attach Element2 to that list.

   begin
      Newlist.Head := new Element_Type'(Item => Element1, Next => null);
      Newlist.Tail := Newlist.Head;
      Attach (Newlist, Element2);
      return Newlist;
   end Attach;

   --------------------------------------------------------------------------

   procedure Attach (Element : in Itemtype; L : in out List) is

      --|  Create a new cell whose information is Element and whose Next
      --|  field is the list L.  This prepends Element to the List L.

      Old_Head, New_Head : Element_Pointer;

   begin
      if L.Head = null then
         L.Head := new Element_Type'(Item => Element, Next => null);
         L.Tail := L.Head;
      else
         Old_Head := L.Head;
         New_Head := new Element_Type'(Item => Element, Next => Old_Head);
         L.Head   := New_Head;
      end if;
   end Attach;

   --------------------------------------------------------------------------

   function Attach (List1 : in List; List2 : in List) return List is

      --| Attach List2 to List1.
      --| If List1 is null return List2
      --| If List1 equals List2 then raise CircularList
      --| Otherwise get the pointer to the last element of List1 and change
      --| its Next field to be List2.

      End_Of_List1 : Element_Pointer;
      New_List     : List;

   begin
      if List1.Head = null then
         return List2;
      elsif List1 = List2 then
         raise Circularlist;
      else
         End_Of_List1      := List1.Tail;
         End_Of_List1.Next := List2.Head;
         New_List.Head     := List1.Head;
         New_List.Tail     := List2.Tail;
         return New_List;
      end if;
   end Attach;

   -------------------------------------------------------------------------

   function Attach (L : in List; Element : in Itemtype) return List is

      New_Element : Element_Pointer;
      New_List    : List;
      End_Of_List : Element_Pointer;

      --| Create a list called New_List and attach it to the end of L.
      --| If L is null return New_List
      --| Otherwise get the last element in L and make its Next field
      --| New_List.

   begin
      New_Element := new Element_Type'(Item => Element, Next => null);
      if L.Head = null then
         New_List := (Head => New_Element, Tail => New_Element);
      else
         End_Of_List      := L.Tail;
         End_Of_List.Next := New_Element;
         New_List         := (Head => L.Head, Tail => New_Element);
      end if;
      return New_List;
   end Attach;

   --------------------------------------------------------------------------

   function Attach (Element : in Itemtype; L : in List) return List is

      New_Element : Element_Pointer;

   begin
      if L.Head = null then
         New_Element := new Element_Type'(Item => Element, Next => null);
         return (Head => New_Element, Tail => New_Element);
      else
         New_Element := new Element_Type'(Item => Element, Next => L.Head);
         return (Head => New_Element, Tail => L.Tail);
      end if;
   end Attach;

   --------------------------------------------------------------------------

   function Copy (L : in List) return List is

      --| If L is null return null
      --| Otherwise recursively copy the list by first copying the information
      --| at the head of the list and then making the Next field point to
      --| a copy of the tail of the list.

      Current_Element : Element_Pointer := L.Head;
      New_List        : List            := (Head => null, Tail => null);

   begin
      while Current_Element /= null loop
         Attach (New_List, Current_Element.Item);
         Current_Element := Current_Element.Next;
      end loop;
      return New_List;
   end Copy;

   --------------------------------------------------------------------------

   --generic
   --  with function Copy (I : in Itemtype) return Itemtype;
   function Copydeep (L : in List) return List is

      --|  If L is null then return null.
      --|  Otherwise copy the first element of the list into the head of the
      --|  new list and copy the tail of the list recursively using CopyDeep.

      Current_Element : Element_Pointer := L.Head;
      New_List        : List            := (Head => null, Tail => null);

   begin
      while Current_Element /= null loop
         Attach (New_List, Copy (Current_Element.Item));
         Current_Element := Current_Element.Next;
      end loop;
      return New_List;
   end Copydeep;

   --------------------------------------------------------------------------

   function Create return List is

   --| Return the empty list.

   begin
      return (Head => null, Tail => null);
   end Create;

   --------------------------------------------------------------------------
   procedure Deletehead (L : in out List) is

      New_Head : Element_Pointer;

      --| Remove the element of the head of the list and return it to the heap.
      --| If L is null EmptyList.
      --| Otherwise save the Next field of the first element, remove the first
      --| element and then assign to L the Next field of the first element.

   begin
      if L.Head = null then
         raise Emptylist;
      else
         New_Head := L.Head.Next;
         Free (L.Head);
         L.Head := New_Head;
      end if;
   end Deletehead;

   --------------------------------------------------------------------------

   procedure Deleteitem (L : in out List; Element : in Itemtype) is

      --| Remove the first element in the list with the value Element.
      --| If the first element of the list is equal to element then
      --| remove it.  Otherwise, recurse on the tail of the list.

      Current_Element, Previous_Element : Element_Pointer;

   begin
      if L.Head = null then
         raise Itemnotpresent;
      elsif Equal (L.Head.Item, Element) then
         Deletehead (L);
      else
         Current_Element  := L.Head.Next;
         Previous_Element := L.Head;

         while Current_Element /= null
           and then not Equal (Current_Element.Item, Element)
         loop

            Previous_Element := Current_Element;
            Current_Element  := Current_Element.Next;

         end loop;

         if Current_Element = null then
            raise Itemnotpresent;
         else

            if Current_Element = L.Tail then
               L.Tail := Previous_Element;
            end if;

            Previous_Element.Next := Current_Element.Next;
            Free (Current_Element);

         end if;
      end if;
   end Deleteitem;

   --------------------------------------------------------------------------

   procedure Deleteitems (L : in out List; Element : in Itemtype) is

      Delete_List_Is_Empty  : Boolean         := True;
      New_List_Is_Empty     : Boolean         := True;
      Old_Tail              : Element_Pointer;
      Current_Element       : Element_Pointer := L.Head;
      New_List, Delete_List : List;

      procedure Append (Element : in Element_Pointer; To_List : in out List) is
      begin
         if To_List.Head = null then
            To_List.Head := Element;
            To_List.Tail := Element;
         else
            Old_Tail      := To_List.Tail;
            To_List.Tail  := Element;
            Old_Tail.Next := To_List.Tail;
         end if;
      end Append;

   begin
      while Current_Element /= null loop
         if Equal (Current_Element.Item, Element) then
            Append (Element => Current_Element, To_List => Delete_List);
            Delete_List_Is_Empty := False;
         else
            Append (Element => Current_Element, To_List => New_List);
            New_List_Is_Empty := False;
         end if;

         Current_Element := Current_Element.Next;
      end loop;

      if Delete_List_Is_Empty then
         raise Itemnotpresent;
      else
         Delete_List.Tail.Next := null;
         Destroy (Delete_List);
      end if;

      if not New_List_Is_Empty then
         New_List.Tail.Next := null;
      end if;

      L := New_List;
   end Deleteitems;

   --------------------------------------------------------------------------

   procedure Destroy (L : in out List) is

      Current_Element   : Element_Pointer := L.Head;
      Element_To_Delete : Element_Pointer;

      --| Walk down the list removing all the elements and set the list to
      --| the empty list.

   begin
      if L.Head /= null then
         while Current_Element /= null loop
            Element_To_Delete := Current_Element;
            Current_Element   := Current_Element.Next;
            Free (Element_To_Delete);
         end loop;
         L := (Head => null, Tail => null);
      end if;
   end Destroy;

   --------------------------------------------------------------------------

   function Firstvalue (L : in List) return Itemtype is

   --| Return the first value in the list.

   begin
      if L.Head = null then
         raise Emptylist;
      else
         return L.Head.Item;
      end if;
   end Firstvalue;

   --------------------------------------------------------------------------

   function Isinlist (L : in List; Element : in Itemtype) return Boolean is

      Current_Element : Element_Pointer := L.Head;

   --| Check if Element is in L.  If it is return true otherwise return false.

   begin
      while Current_Element /= null
        and then not Equal (Current_Element.Item, Element)
      loop
         Current_Element := Current_Element.Next;
      end loop;
      return Current_Element /= null;
   end Isinlist;

   --------------------------------------------------------------------------

   function Isempty (L : in List) return Boolean is

   --| Is the list L empty.

   begin
      return L.Head = null;
   end Isempty;

   --------------------------------------------------------------------------

   function Lastvalue (L : in List) return Itemtype is

   --| Return the value of the last element of the list. Get the pointer
   --| to the last element of L and then return its information.

   begin
      if L.Head = null then
         raise Emptylist;
      else
         return L.Tail.Item;
      end if;
   end Lastvalue;

   --------------------------------------------------------------------------

   function Length (L : in List) return Integer is

      --| Recursively compute the length of L.  The length of a list is
      --| 0 if it is null or  1 + the length of the tail.

      Current_Element : Element_Pointer := L.Head;
      List_Length     : Natural         := 0;

   begin
      while Current_Element /= null loop
         List_Length     := List_Length + 1;
         Current_Element := Current_Element.Next;
      end loop;

      return List_Length;
   end Length;

   --------------------------------------------------------------------------

   function Makelistiter (L : in List) return Listiter is

   --| Start an iteration operation on the list L.  Do a type conversion
   --| from List to ListIter.

   begin
      return Listiter (L);
   end Makelistiter;

   --------------------------------------------------------------------------

   function More (L : in Listiter) return Boolean is

   --| This is a test to see whether an iteration is complete.

   begin
      return L.Head /= null;
   end More;

   --------------------------------------------------------------------------

   procedure Next (Place : in out Listiter; Info : out Itemtype) is

      --| This procedure gets the information at the current place in the List
      --| and moves the ListIter to the next postion in the list.
      --| If we are at the end of a list then exception NoMore is raised.

      Next_Element : constant Element_Pointer := Place.Head;

   begin
      if Next_Element = null then
         raise Nomore;
      else
         Info       := Next_Element.Item;
         Place.Head := Next_Element.Next;
      end if;
   end Next;

   --------------------------------------------------------------------------

   procedure Replacehead (L : in out List; Info : in Itemtype) is

   --| This procedure replaces the information at the head of a list
   --| with the given information. If the list is empty the exception
   --| EmptyList is raised.

   begin
      if L.Head = null then
         raise Emptylist;
      else
         L.Head.Item := Info;
      end if;
   end Replacehead;

   --------------------------------------------------------------------------

   procedure Replacetail (L : in out List; Newtail : in List) is

      List_Head_Item : Itemtype;

      --| This destroys the tail of a list and replaces the tail with
      --| NewTail.  If L is empty EmptyList is raised.

   begin
      if L.Head = null then
         raise Emptylist;
      else
         List_Head_Item := L.Head.Item;
         Destroy (L);
         L := Attach (List_Head_Item, Newtail);
      end if;
   end Replacetail;

   --------------------------------------------------------------------------

   function Tail (L : in List) return List is

   --| This returns the list which is the tail of L.  If L is null Empty
   --| List is raised.

   begin
      if L.Head = null then
         raise Emptylist;
      else
         return (Head => L.Head.Next, Tail => L.Tail);
      end if;
   end Tail;

   --------------------------------------------------------------------------
   function Equal (List1 : in List; List2 : in List) return Boolean is

      Placeinlist1 : Element_Pointer := List1.Head;
      Placeinlist2 : Element_Pointer := List2.Head;
      -- Contents1    : Itemtype;
      -- Contents2    : Itemtype;

      --| This function tests to see if two lists are equal.  Two lists
      --| are equal if for all the elements of List1 the corresponding
      --| element of List2 has the same value.  Thus if the 1st elements
      --| are equal and the second elements are equal and so up to n.
      --|  Thus a necessary condition for two lists to be equal is that
      --| they have the same number of elements.

      --| This function walks over the two list and checks that the
      --| corresponding elements are equal.  As soon as we reach
      --| the end of a list (PlaceInList = null) we fall out of the loop.
      --| If both PlaceInList1 and PlaceInList2 are null after exiting the loop
      --| then the lists are equal.  If they both are not null the lists aren't
      --| equal.  Note that equality on elements is based on a user supplied
      --| function Equal which is used to test for item equality.

   begin
      while (Placeinlist1 /= null) and then (Placeinlist2 /= null) loop
         if not Equal (Placeinlist1.Item, Placeinlist2.Item) then
            return False;
         end if;
         Placeinlist1 := Placeinlist1.Next;
         Placeinlist2 := Placeinlist2.Next;
      end loop;
      return ((Placeinlist1 = null) and then (Placeinlist2 = null));
   end Equal;

end Lists;
