pragma License (Modified_GPL);

------------------------------------------------------------------------------
--                                                                          --
--                      CHARLES CONTAINER LIBRARY                           --
--                                                                          --
--              Copyright (C) 2001-2003 Matthew J Heaney                    --
--                                                                          --
-- The Charles Container Library ("Charles") is free software; you can      --
-- redistribute it and/or modify it under terms of the GNU General Public   --
-- License as published by the Free Software Foundation; either version 2,  --
-- or (at your option) any later version.  Charles is distributed in the    --
-- hope that it will be useful, but WITHOUT ANY WARRANTY; without even the  --
-- implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- See the GNU General Public License for more details.  You should have    --
-- received a copy of the GNU General Public License distributed with       --
-- Charles;  see file COPYING.TXT.  If not, write to the Free Software      --
-- Foundation,  59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.    --
--                                                                          --
-- As a special exception, if other files instantiate generics from this    --
-- unit, or you link this unit with other files to produce an executable,   --
-- this unit does not by itself cause the resulting executable to be        --
-- covered by the GNU General Public License.  This exception does not      --
-- however invalidate any other reasons why the executable file might be    --
-- covered by the GNU Public License.                                       --
--                                                                          --
-- Charles is maintained by Matthew J Heaney.                               --
--                                                                          --
-- http://home.earthlink.net/~matthewjheaney/index.html                     --
-- mailto:matthewjheaney@earthlink.net                                      --
--                                                                          --
------------------------------------------------------------------------------
with System;  use type System.Address;
with Ada.Unchecked_Deallocation;
with Charles.Algorithms.Generic_Lexicographical_Compare;

package body Charles.Lists.Single.Unbounded is


   function Empty_Container return Container_Type is
   begin
      return (Controlled with First => null, Last => null, Length => 0);
   end;


   procedure Free is
      new Ada.Unchecked_Deallocation (Node_Type, Node_Access);


   procedure Adjust (Container : in out Container_Type) is

      Src : Node_Access := Container.First;

   begin

      if Src = null then
         pragma Assert (Container.Last = null);
         pragma Assert (Container.Length = 0);
         return;
      end if;

      Container.First := null;
      Container.Last := null;
      Container.Length := 0;

      Container.First := new Node_Type'(Src.Element, null);
      Container.Last := Container.First;

      loop

         Container.Length := Container.Length + 1;

         Src := Src.Next;

         exit when Src = null;

         Container.Last.Next := new Node_Type'(Src.Element, null);
         Container.Last := Container.Last.Next;

      end loop;

   end Adjust;


--     procedure Finalize (Container : in out Container_Type) is
--     begin
--        Clear (Container);
--     end;


   function "=" (Left, Right : Container_Type) return Boolean is

      LI : Iterator_Type := First (Left);
      RI : Iterator_Type := First (Right);

   begin

      if Left'Address = Right'Address then
         return True;
      end if;

      if Left.Length /= Right.Length then
         return False;
      end if;

      for I in 1 .. Left.Length loop

         if LI.Node.Element /= RI.Node.Element then
            return False;
         end if;

         LI := Succ (LI);
         RI := Succ (RI);

      end loop;

      return True;

   end "=";


   function Generic_Less
     (Left, Right : Container_Type) return Boolean is

      function Is_Less (L, R : Node_Access) return Boolean is
         pragma Inline (Is_Less);
      begin
         return L.Element < R.Element;
      end;

      function Succ (N : Node_Access) return Node_Access is
         pragma Inline (Succ);
      begin
         return N.Next;
      end;

      function Lexicographical_Compare is
         new Algorithms.Generic_Lexicographical_Compare (Node_Access);

      LF : constant Node_Access := Left.First;
      RF : constant Node_Access := Right.First;

   begin

      if Left'Address = Right'Address then
         return False;
      end if;

      return Lexicographical_Compare (LF, null, RF, null);

   end Generic_Less;


   function Length (Container : Container_Type) return Natural is
   begin
      return Container.Length;
   end;


   function Is_Empty (Container : Container_Type) return Boolean is
   begin
      return Container.Length = 0;
   end;


   procedure Clear (Container : in out Container_Type) is
   begin

      while Container.Length > 0 loop
         Delete_First (Container);
      end loop;

      pragma Assert (Container.First = null);
      pragma Assert (Container.Last = null);

   end Clear;


   procedure Swap (Left, Right : in out Container_Type) is

      L_Last   : constant Node_Access := Left.Last;
      L_First  : constant Node_Access := Left.First;
      L_Length : constant Natural := Left.Length;

   begin

      Left.Last := Right.Last;
      Left.First := Right.First;
      Left.Length := Right.Length;

      Right.Last := L_Last;
      Right.First := L_First;
      Right.Length := L_Length;

   end Swap;


   procedure Assign
     (Target : in out Container_Type;
      Source : in     Container_Type) is

   begin

      if Target'Address = Source'Address then
         return;
      end if;

      Clear (Target);

      declare
         Src : Node_Access := Source.First;
      begin
         while Src /= null loop
            Append (Target, New_Item => Src.Element);
            Src := Src.Next;
         end loop;
      end;

   end Assign;


   procedure Prepend
     (Container : in out Container_Type;
      New_Item  : in     Element_Type) is
   begin
      Insert_After (Container, Null_Iterator, New_Item);
   end;


   procedure Append
     (Container : in out Container_Type;
      New_Item  : in     Element_Type) is
   begin
      Insert_After (Container, Last (Container), New_Item);
   end;


   procedure Insert_After
     (Container : in out Container_Type;
      Position  : in     Iterator_Type;
      New_Item  : in     Element_Type;
      Iterator  :    out Iterator_Type) is

   begin

      if Position.Node = null then

         Iterator.Node := new Node_Type'(New_Item, Container.First);
         Container.First := Iterator.Node;

         if Container.Last = null then
            pragma Assert (Container.Length = 0);
            Container.Last := Iterator.Node;
         end if;

      elsif Position.Node = Container.Last then

         Iterator.Node := new Node_Type'(New_Item, null);

         Container.Last.Next := Iterator.Node;
         Container.Last := Iterator.Node;

      else

         Iterator.Node := new Node_Type'(New_Item, Position.Node.Next);
         Position.Node.Next := Iterator.Node;

      end if;

      Container.Length := Container.Length + 1;

   end Insert_After;


   procedure Insert_After
     (Container : in out Container_Type;
      Position  : in     Iterator_Type;
      New_Item  : in     Element_Type) is

      Iterator : Iterator_Type;
   begin
      Insert_After (Container, Position, New_Item, Iterator);
   end;


   procedure Insert_After
     (Container : in out Container_Type;
      Position  : in     Iterator_Type;
      Iterator  :    out Iterator_Type) is

   begin

      Iterator.Node := new Node_Type;

      if Position.Node = null then

         Iterator.Node.Next := Container.First;
         Container.First := Iterator.Node;

         if Container.Last = null then
            pragma Assert (Container.Length = 0);
            Container.Last := Iterator.Node;
         end if;

      elsif Position.Node = Container.Last then

         Container.Last.Next := Iterator.Node;
         Container.Last := Iterator.Node;

      else

         Iterator.Node.Next := Position.Node.Next;
         Position.Node.Next := Iterator.Node;

      end if;

      Container.Length := Container.Length + 1;

   end Insert_After;


   procedure Delete_After
     (Container : in out Container_Type;
      Position  : in     Iterator_Type) is

      X : Node_Access;

   begin

      if Position = Null_Iterator then
         Delete_First (Container);
         return;
      end if;

      if Position = Last (Container) then
         return;
      end if;

      Container.Length := Container.Length - 1;

      X := Position.Node.Next;
      Position.Node.Next := X.Next;

      if Container.Last = X then
         Container.Last := Position.Node;
      end if;

      Free (X);

   end Delete_After;


   procedure Delete_First (Container : in out Container_Type) is

      X : Node_Access := Container.First;

   begin

      if Container.Length = 0 then
         pragma Assert (X = null);
         pragma Assert (Container.Last = null);
         return;
      end if;

      pragma Assert (Container.First /= null);
      pragma Assert (Container.Last /= null);
      pragma Assert (Container.Last.Next = null);

      Container.First := X.Next;

      if Container.Last = X then
         pragma Assert (Container.First = null);
         pragma Assert (Container.Length = 1);
         Container.Last := null;
      end if;

      Container.Length := Container.Length - 1;

      Free (X);

   end Delete_First;



   procedure Generic_Delete (Container : in out Container_Type) is

      Node, X : Node_Access;

   begin

      loop

         if Container.First = null then
            return;
         end if;

         exit when not Predicate (Container.First.Element);

         X := Container.First;
         Container.First := X.Next;

         if Container.Last = X then
            pragma Assert (Container.First = null);
            Container.Last := null;
         end if;

         Container.Length := Container.Length - 1;

         Free (X);

      end loop;

      Node := Container.First;

      while Node.Next /= null loop

         if Predicate (Node.Next.Element) then

            X := Node.Next;
            Node.Next := X.Next;

            if Container.Last = X then
               pragma Assert (Node.Next = null);
               Container.Last := Node;
            end if;

            Container.Length := Container.Length - 1;

            Free (X);

         else

            Node := Node.Next;

         end if;

      end loop;

   end Generic_Delete;



   procedure Delete
     (Container : in out Container_Type;
      Item      : in     Element_Type) is

      function Predicate (E : Element_Type) return Boolean is
         pragma Inline (Predicate);
      begin
         return E = Item;
      end;

      procedure Delete is
         new Generic_Delete (Predicate);
   begin
      Delete (Container);
   end;



   procedure Generic_Delete_Duplicates
     (Container : in out Container_Type) is

      I, J : Iterator_Type;

   begin

      if Container.Length <= 1 then
         return;
      end if;

      I := First (Container);

      loop

         J := Succ (I);

         exit when J = Null_Iterator;

         if Predicate (I.Node.Element, J.Node.Element) then
            Delete_After (Container, Position => I);
         else
            I := J;
         end if;

      end loop;

   end Generic_Delete_Duplicates;



   procedure Delete_Duplicates (Container : in out Container_Type) is

      procedure Delete is
         new Generic_Delete_Duplicates (Predicate => "=");
   begin
      Delete (Container);
   end;


   procedure Splice_After
     (Container : in out Container_Type;
      Position  : in     Iterator_Type;
      Pred      : in     Iterator_Type) is

   begin

      if Position = Pred then
         return;
      end if;

      if Position = Null_Iterator then

         --move Pred.Next prior to First

         if Pred.Node = Container.Last then
            return;
         end if;

         if Pred.Node.Next = Container.Last then

            Container.Last.Next := Container.First;
            Container.First := Container.Last;
            Pred.Node.Next := null;
            Container.Last := Pred.Node;

         else

            declare
               Node : constant Node_Access := Pred.Node.Next;
            begin
               Pred.Node.Next := Node.Next;
               Node.Next := Container.First;
               Container.First := Node;
            end;

         end if;

      elsif Pred = Null_Iterator then

         --move First after Position

         if Position.Node = Container.First then
            return;
         end if;

         if Position.Node = Container.Last then

            Container.Last.Next := Container.First;
            Container.First := Container.First.Next;
            Container.Last := Container.Last.Next;
            Container.Last.Next := null;

         else

            declare
               Node : constant Node_Access := Container.First;
            begin
               Container.First := Container.First.Next;
               Node.Next := Position.Node.Next;
               Position.Node.Next := Node;
            end;

         end if;

      elsif Pred.Node = Container.Last then

         null;

      elsif Position.Node = Container.Last then

         --move Pred.Next to after Last

         if Position.Node = Pred.Node.Next then
            return;
         end if;

         declare
            Node : constant Node_Access := Pred.Node.Next;
         begin
            Pred.Node.Next := Node.Next;
            Container.Last.Next := Node;
            Container.Last := Node;
            Container.Last.Next := null;
         end;

      else

         --move Pred.Next to after Position

         if Position.Node = Pred.Node.Next then
            return;
         end if;

         declare
            Node : constant Node_Access := Pred.Node.Next;
         begin
            Pred.Node.Next := Node.Next;

            if Container.Last = Node then
               pragma Assert (Pred.Node.Next = null);
               Container.Last := Pred.Node;
            end if;

            Node.Next := Position.Node.Next;
            Position.Node.Next := Node;
         end;

      end if;

   end Splice_After;


   procedure Splice_After
     (Container : in out Container_Type;
      Position  : in     Iterator_Type;
      Source    : in out Container_Type;
      Pred      : in     Iterator_Type) is

      Node : Node_Access;

   begin

      if Source'Address = Container'Address then
         Splice_After (Container, Position, Pred);
         return;
      end if;

      if Source.Length = 0 then
         pragma Assert (Pred.Node = null);
         return;
      end if;

      if Pred.Node = Source.Last then
         return;
      end if;

      if Pred = Null_Iterator then

         --move Source.First to container

         Node := Source.First;
         Source.First := Source.First.Next;

         if Source.First = null then
            pragma Assert (Source.Last = Node);
            pragma Assert (Source.Length = 1);
            Source.Last := null;
         end if;

      elsif Pred.Node.Next = Source.Last then

         --move Source.Last to container

         Node := Source.Last;
         Source.Last := Pred.Node;
         Source.Last.Next := null;

      else

         --move interior node to container

         Node := Pred.Node.Next;
         Pred.Node.Next := Node.Next;

      end if;

      if Position = Null_Iterator then

         --move to front of container

         Node.Next := Container.First;
         Container.First := Node;

         if Container.Length = 0 then
            pragma Assert (Container.Last = null);
            Container.Last := Node;
         end if;

      elsif Position.Node = Container.Last then

         --move to back of container

         Container.Last.Next := Node;
         Container.Last := Node;
         Container.Last.Next := null;

      else

         --move to interior node of container

         Node.Next := Position.Node.Next;
         Position.Node.Next := Node;

      end if;

      Container.Length := Container.Length + 1;
      Source.Length := Source.Length - 1;

   end Splice_After;


   procedure Splice_After
     (Container : in out Container_Type;
      Position  : in     Iterator_Type;
      Source    : in out Container_Type) is

   begin

      if Container'Address = Source'Address then
         return;
      end if;

      if Source.Length = 0 then
         pragma Assert (Source.First = null);
         pragma Assert (Source.Last = null);
         return;
      end if;

      if Position = Null_Iterator then

         Source.Last.Next := Container.First;
         Container.First := Source.First;

         if Container.Last = null then
            pragma Assert (Container.Length = 0);
            pragma Assert (Source.Last.Next = null);
            Container.Last := Source.Last;
         end if;

      else

         pragma Assert (Container.Length > 0);
         pragma Assert (Container.First /= null);
         pragma Assert (Container.Last /= null);

         Source.Last.Next := Position.Node.Next;
         Position.Node.Next := Source.First;

         if Container.Last = Position.Node then
            Container.Last := Source.Last;
         end if;

      end if;

      Source.First := null;
      Source.Last := null;

      Container.Length := Container.Length + Source.Length;
      Source.Length := 0;

   end Splice_After;


   function First (Container : Container_Type) return Iterator_Type is
   begin
      return (Node => Container.First);
   end;


   function First_Element (Container : Container_Type) return Element_Type is
      Node : constant Node_Access := Container.First;
   begin
      return Node.Element;
   end;


   function Last (Container : Container_Type) return Iterator_Type is
   begin
      return (Node => Container.Last);
   end;


   function Last_Element (Container : Container_Type) return Element_Type is
      Node : constant Node_Access := Container.Last;
   begin
      return Node.Element;
   end;


   function Back (Container : Container_Type) return Iterator_Type is
      pragma Warnings (Off, Container);
   begin
      return Null_Iterator;
   end;


   function Element
     (Iterator : Iterator_Type) return Element_Type is
   begin
      return Iterator.Node.Element;
   end;


   function Generic_Element
     (Iterator : Iterator_Type) return Element_Access is
   begin
      return Iterator.Node.Element'Access;
   end;


   procedure Replace_Element
     (Iterator : in Iterator_Type;
      By       : in Element_Type) is
   begin
      Iterator.Node.Element := By;
   end;


   procedure Generic_Iteration (Container : in Container_Type) is

      Node : Node_Access := Container.First;

   begin

      while Node /= null loop
         Process (Iterator_Type'(Node => Node));
         Node := Node.Next;
      end loop;

   end Generic_Iteration;


   function Generic_Find
     (Container : Container_Type;
      Position  : Iterator_Type := Null_Iterator) return Iterator_Type is

      Node : Node_Access := Container.First;

   begin

      while Node /= null loop

         if Predicate (Node.Element) then
            return Iterator_Type'(Node => Node);
         end if;

         Node := Node.Next;

      end loop;

      return Null_Iterator;  -- Back

   end Generic_Find;


   function Find
     (Container : Container_Type;
      Item      : Element_Type;
      Position  : Iterator_Type := Null_Iterator) return Iterator_Type is

      function Predicate (E : Element_Type) return Boolean is
         pragma Inline (Predicate);
      begin
         return E = Item;
      end;

      function Find is
         new Generic_Find (Predicate);
   begin
      return Find (Container, Position);
   end;


   function Is_In
     (Item      : Element_Type;
      Container : Container_Type) return Boolean is
   begin
      return Find (Container, Item) /= Null_Iterator;
   end;


   function Succ (Iterator : Iterator_Type) return Iterator_Type is
   begin
      return (Node => Iterator.Node.Next);
   end;


   function Pred
     (Container : Container_Type;
      Iterator  : Iterator_Type) return Iterator_Type is

   begin

      if Iterator = Back (Container) then
         return Last (Container);
      end if;

      pragma Assert (Container.Length > 0);

      if Iterator = First (Container) then
         return Back (Container);
      end if;

      pragma Assert (Container.Length > 1);

      declare
         Result : Node_Access := Container.First;
      begin
         while Result.Next /= Iterator.Node loop
            Result := Result.Next;
         end loop;

         return Iterator_Type'(Node => Result);
      end;

   end Pred;


   procedure Generic_Sort
     (Container : in out Container_Type) is

      procedure Partition
        (Front : in Node_Access;
         Back  : in Node_Access) is

         Pivot_Prev : Node_Access := Front;
         Pivot      : Node_Access;

         Node_Prev : Node_Access;

      begin

         if Pivot_Prev = null then
            Pivot := Container.First;
         else
            Pivot := Pivot_Prev.Next;
         end if;

         Node_Prev := Pivot;

         while Node_Prev.Next /= Back loop

            if Node_Prev.Next.Element < Pivot.Element then

               declare
                  Node : constant Node_Access := Node_Prev.Next;
               begin
                  Node_Prev.Next := Node.Next;

                  Node.Next := Pivot;

                  if Pivot_Prev = null then
                     Container.First := Node;
                  else
                     Pivot_Prev.Next := Node;
                  end if;

                  Pivot_Prev := Node;
               end;

            else

               Node_Prev := Node_Prev.Next;

            end if;

         end loop;

         if Back = null then
            Container.Last := Node_Prev;
         end if;

      end Partition;


      procedure Sort (Front, Back : Node_Access) is

         Pivot : Node_Access;

      begin

         if Front = null then
            Pivot := Container.First;
         else
            Pivot := Front.Next;
         end if;

         if Pivot /= Back then

            Partition (Front, Back);

            Sort (Front, Pivot);

            Sort (Pivot, Back);

         end if;

      end Sort;

   begin

      Sort (Front => null, Back => null);

   end Generic_Sort;


   procedure Reverse_Container (Container : in out Container_Type) is

      I : Node_Access := Container.First;
      J : Node_Access;

   begin

      if Container.Length <= 1 then
         return;
      end if;

      J := I.Next;
      I.Next := null;

      loop

         declare
            Next : constant Node_Access := J.Next;
         begin
            J.Next := I;
            I := J;
            J := Next;
         end;

         exit when J = null;

      end loop;

      pragma Assert (I = Container.Last);

      Container.Last := Container.First;
      Container.First := I;

   end Reverse_Container;


   procedure Generic_Merge
     (Container : in out Container_Type;
      Source    : in out Container_Type) is

      I, J : Iterator_Type;

   begin

      if Container'Address = Source'Address then
         return;
      end if;

      if Container.Length = 0 then
         Splice_After (Container, Null_Iterator, Source);
         return;
      end if;

      J := Iterator_Type'(Node => Container.First);

      loop

         if Source.First = null then
            pragma Assert (Source.Length = 0);
            pragma Assert (Source.Last = null);
            return;
         end if;

         exit when not (Source.First.Element < J.Node.Element);

         declare
            Node : constant Node_Access := Source.First;
         begin
            Splice_After (Container, I, Source, Pred => Null_Iterator);
            I := Iterator_Type'(Node => Node);
         end;

      end loop;

      loop

         I := J;
         J := Succ (I);

         if J = Null_Iterator then
            pragma Assert (I = Last (Container));
            Splice_After (Container, I, Source);
            return;
         end if;

         while Source.First.Element < J.Node.Element loop

            Splice_After (Container, I, Source, Pred => Null_Iterator);

            if Source.First = null then
               pragma Assert (Source.Length = 0);
               pragma Assert (Source.Last = null);
               return;
            end if;

            I := Succ (I);

         end loop;

      end loop;

   end Generic_Merge;


   procedure Increment (Iterator : in out Iterator_Type) is
   begin
      Iterator := Succ (Iterator);
   end;


   procedure Decrement
     (Container :        Container_Type;
      Iterator  : in out Iterator_Type) is
   begin
      Iterator := Pred (Container, Iterator);
   end;


end Charles.Lists.Single.Unbounded;
