pragma License (Modified_GPL);

------------------------------------------------------------------------------
--                                                                          --
--                      CHARLES CONTAINER LIBRARY                           --
--                                                                          --
--              Copyright (C) 2001-2004 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 Charles.Algorithms.Generic_Lexicographical_Compare_2;

package body Charles.Lists.Single.Bounded is


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

      subtype Length_Subtype is
        Integer range 0 .. Target.Size;

      New_Length : constant Length_Subtype := Source.Length;

      N : Node_Array renames Source.Nodes;
      I : Natural := Source.First;

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

      Clear (Target);

      for Index in 1 .. New_Length loop
         Append (Target, New_Item => N (I).Element);
         I := N (I).Next;
      end loop;
      
   end Assign;
   

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

      LN : Node_Array renames Left.Nodes;
      RN : Node_Array renames Right.Nodes;

      LI : Natural := Left.First;
      RI : Natural := Right.First;

   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 LN (LI).Element /= RN (RI).Element then
            return False;
         end if;

         LI := LN (LI).Next;
         RI := RN (RI).Next;

      end loop;

      return True;
      
   end "=";


   function Generic_Less (Left, Right : Container_Type) return Boolean is
      
      LN : Node_Array renames Left.Nodes;
      RN : Node_Array renames Right.Nodes;

      function Left_Succ (LI : Positive) return Natural is
         pragma Inline (Left_Succ);
      begin
         return LN (LI).Next;
      end;

      function Right_Succ (RI : Positive) return Natural is
         pragma Inline (Right_Succ);
      begin
         return RN (RI).Next;
      end;

      function Left_Less (LI, RI : Positive) return Boolean is
         pragma Inline (Left_Less);
      begin
         return LN (LI).Element < RN (RI).Element;
      end;

      function Right_Less (RI, LI : Positive) return Boolean is
         pragma Inline (Right_Less);
      begin
         return RN (RI).Element < LN (LI).Element;
      end;

      function Lexicographical_Compare is
        new Charles.Algorithms.Generic_Lexicographical_Compare_2
          (Natural,
           Natural,
           Left_Succ,
           Right_Succ,
           Left_Less,
           Right_Less);

   begin

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

      return Lexicographical_Compare
               (Left_First  => Left.First,
                Left_Back   => 0,
                Right_First => Right.First,
                Right_Back  => 0);
      
   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;
   

   function Is_Full (Container : Container_Type) return Boolean is
   begin
      return Container.Length = Container.Size;
   end;


   procedure Clear (Container : in out Container_Type) is

      N : Node_Array renames Container.Nodes;

   begin

      if Container.Length = 0 then
         return;
      end if;

      pragma Assert (Container.First >= 1);
      pragma Assert (Container.Last >= 1);
      pragma Assert (N (Container.Last).Next = 0);

      if Container.Free < 0 then
         Container.Free := -1;
      else
         N (Container.Last).Next := Container.Free;
         Container.Free := Container.First;
      end if;

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

   end Clear;


   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_Post
     (Container : in out Container_Type;
      Position  : in     Natural;
      Index     : in     Positive) is

      NA : Node_Array renames Container.Nodes;

   begin

      if Position = 0 then

         NA (Index).Next := Container.First;
         Container.First := Index;

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

      elsif Position = Container.Last then

         NA (Index).Next := 0;
         NA (Container.Last).Next := Index;
         Container.Last := Index;

      else

         NA (Index).Next := NA (Position).Next;
         NA (Position).Next := Index;

      end if;
   
   end Insert_After_Post;


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

      subtype Length_Subtype is Positive range 1 .. Container.Size;
      
      New_Length : constant Length_Subtype := Container.Length + 1;
        
      NA : Node_Array renames Container.Nodes;

   begin
      
      if Container.Free >= 0 then

         Iterator.Index := Container.Free;

         declare
            N : Node_Type renames NA (Iterator.Index);
         begin
            N.Element := New_Item;
            Container.Free := N.Next;
         end;

      else

         Iterator.Index := abs Container.Free;

         declare
            N : Node_Type renames NA (Iterator.Index);
         begin
            N.Element := New_Item;
            Container.Free := Container.Free - 1;
         end;

      end if;

      Insert_After_Post (Container, Position.Index, Iterator.Index);

      Container.Length := New_Length;
   
   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

      subtype Length_Subtype is Positive range 1 .. Container.Size;
      
      New_Length : constant Length_Subtype := Container.Length + 1;
        
      NA : Node_Array renames Container.Nodes;

   begin
      
      if Container.Free >= 0 then

         Iterator.Index := Container.Free;

         declare
            N : Node_Type renames NA (Iterator.Index);
         begin
            Container.Free := N.Next;
         end;

      else

         declare
            subtype Index_Subtype is Positive range 1 .. Container.Size;
         begin
            Iterator.Index := Index_Subtype'(abs Container.Free);
            Container.Free := Container.Free - 1;
         end;

      end if;

      Insert_After_Post (Container, Position.Index, Iterator.Index);

      Container.Length := New_Length;
      
   end Insert_After;
   

   procedure Initialize (Container : in out Container_Type) is

      pragma Assert (Container.Size > 0);
      pragma Assert (Container.Free < 0);

      N : Node_Array renames Container.Nodes;

   begin

      Container.Free := abs Container.Free;

      if Container.Free > Container.Size then
         Container.Free := 0;
         return;
      end if;

      for I in Container.Free .. Container.Size - 1 loop
         N (I).Next := I + 1;
      end loop;

      N (Container.Size).Next := 0;

   end Initialize;


   procedure Free 
     (Container : in out Container_Type;
      Index     : in     Positive) is
      
      N : Node_Array renames Container.Nodes;

   begin

      if Container.Free >= 0 then

         N (Index).Next := Container.Free;
         Container.Free := Index;

      elsif Index + 1 = abs Container.Free then

         Container.Free := Container.Free + 1;

      else

         Initialize (Container);

         N (Index).Next := Container.Free;
         Container.Free := Index;

      end if;
      
   end Free;


   procedure Delete_After
     (Container : in out Container_Type;
      Position  : in     Iterator_Type) is
      
      N : Node_Array renames Container.Nodes;
      I : Positive;

   begin
      
      if Container.Length = 0 then
         pragma Assert (Container.First = 0);
         pragma Assert (Container.Last = 0);
         return;
      end if;

      pragma Assert (Container.First /= 0);
      pragma Assert (Container.Last /= 0);
      pragma Assert (N (Container.Last).Next = 0);
      
      if Position.Index = Container.Last then
         return;
      end if;
      
      Container.Length := Container.Length - 1;

      if Position.Index = 0 then

         I := Container.First;
         Container.First := N (I).Next;

      else
        
         I := N (Position.Index).Next;
         N (Position.Index).Next := N (I).Next;
         
      end if;
       
      if Container.Last = I then
         Container.Last := Position.Index;
      end if;
         
      Free (Container, Index => I);

   end Delete_After;


   procedure Delete_First (Container : in out Container_Type) is
   begin
      Delete_After (Container, Position => Null_Iterator);
   end;


   procedure Generic_Delete (Container : in out Container_Type) is
      
      N    : Node_Array renames Container.Nodes;
      I, J : Positive;

   begin

      loop

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

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

         I := Container.First;
         Container.First := N (I).Next;

         if Container.Last = I then
            pragma Assert (Container.First = 0);
            Container.Last := 0;
         end if;

         Container.Length := Container.Length - 1;

         Free (Container, Index => I);

      end loop;

      J := Container.First;

      while N (J).Next /= 0 loop

         if Predicate (N (N (J).Next).Element) then

            I := N (J).Next;
            N (J).Next := N (I).Next;

            if Container.Last = I then
               pragma Assert (N (J).Next = 0);
               Container.Last := J;
            end if;

            Container.Length := Container.Length - 1;

            Free (Container, Index => I);

         else

            J := N (J).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
      
      N    : Node_Array renames Container.Nodes;
      I, J : Iterator_Type;

   begin

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

      I := First (Container);

      loop

         J := Succ (Container, I);

         exit when J = Null_Iterator;

         if Predicate (N (I.Index).Element, N (J.Index).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 Reverse_Container (Container : in out Container_Type) is
      
      N : Node_Array renames Container.Nodes;

      I : Positive;
      J : Natural;

   begin

      if Container.Length <= 1 then
         return;
      end if;
      
      I := Container.First;

      J := N (I).Next;
      N (I).Next := 0;

      loop

         declare
            Next : constant Natural := N (J).Next;
         begin
            N (J).Next := I;
            I := J;
            J := Next;
         end;

         exit when J = 0;

      end loop;

      pragma Assert (I = Container.Last);

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

   end Reverse_Container;


   procedure Generic_Sort (Container : in out Container_Type) is
      
      N : Node_Array renames Container.Nodes;

      procedure Partition (Front, Back : in Natural) is

         Pivot_Prev : Natural := Front;
         Pivot      : Positive;
         Node_Prev  : Positive;

      begin

         if Pivot_Prev = 0 then
            Pivot := Container.First;
         else
            Pivot := N (Pivot_Prev).Next;
         end if;

         Node_Prev := Pivot;

         while N (Node_Prev).Next /= Back loop

            if N (N (Node_Prev).Next).Element < N (Pivot).Element then

               declare
                  I : constant Positive := N (Node_Prev).Next;
               begin
                  N (Node_Prev).Next := N (I).Next;

                  N (I).Next := Pivot;

                  if Pivot_Prev = 0 then
                     Container.First := I;
                  else
                     N (Pivot_Prev).Next := I;
                  end if;

                  Pivot_Prev := I;
               end;

            else

               Node_Prev := N (Node_Prev).Next;

            end if;

         end loop;

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

      end Partition;

      procedure Sort (Front, Back : in Natural) is

         Pivot : Natural;

      begin

         if Front = 0 then
            Pivot := Container.First;
         else
            Pivot := N (Front).Next;
         end if;

         if Pivot /= Back then

            Partition (Front, Back);

            Sort (Front, Pivot);

            Sort (Pivot, Back);

         end if;

      end Sort;

   begin

      Sort (Front => 0, Back => 0);
      
   end Generic_Sort;


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

      N : Node_Array renames Container.Nodes;

   begin

      if Position = Pred then
         return;
      end if;

      if Position = Null_Iterator then

         --move Pred.Next prior to First

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

         if N (Pred.Index).Next = Container.Last then

            N (Container.Last).Next := Container.First;
            Container.First := Container.Last;
            N (Pred.Index).Next := 0;
            Container.Last := Pred.Index;

         else

            declare
               I : constant Positive := N (Pred.Index).Next;
            begin
               N (Pred.Index).Next := N (I).Next;
               N (I).Next := Container.First;
               Container.First := I;
            end;

         end if;

      elsif Pred = Null_Iterator then

         --move First after Position

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

         if Position.Index = Container.Last then

            N (Container.Last).Next := Container.First;
            Container.First := N (Container.First).Next;
            Container.Last := N (Container.Last).Next;
            N (Container.Last).Next := 0;

         else

            declare
               I : constant Positive := Container.First;
            begin
               Container.First := N (Container.First).Next;
               N (I).Next := N (Position.Index).Next;
               N (Position.Index).Next := I;
            end;

         end if;

      elsif Pred.Index = Container.Last then

         null;

      elsif Position.Index = Container.Last then

         --move Pred.Next to after Last

         if Position.Index = N (Pred.Index).Next then
            return;
         end if;

         declare
            I : constant Positive := N (Pred.Index).Next;
         begin
            N (Pred.Index).Next := N (I).Next;
            N (Container.Last).Next := I;
            Container.Last := I;
            N (Container.Last).Next := 0;
         end;

      else

         --move Pred.Next to after Position

         if Position.Index = N (Pred.Index).Next then
            return;
         end if;

         declare
            I : constant Positive := N (Pred.Index).Next;
         begin
            N (Pred.Index).Next := N (I).Next;

            if Container.Last = I then
               pragma Assert (N (Pred.Index).Next = 0);
               Container.Last := Pred.Index;
            end if;

            N (I).Next := N (Position.Index).Next;
            N (Position.Index).Next := I;
         end;

      end if;
      
   end Splice_After;
   

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

   function First_Element (Container : Container_Type) return Element_Type is
      I : constant Positive := Container.First;
   begin
      return Container.Nodes (I).Element;
   end;
   

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

   function Last_Element (Container : Container_Type) return Element_Type is
      I : constant Positive := Container.Last;
   begin
      return Container.Nodes (I).Element;
   end;
   

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

   function Element 
     (Container : Container_Type;
      Iterator  : Iterator_Type) return Element_Type is
   begin
      return Container.Nodes (Iterator.Index).Element;
   end;
   

   function Generic_Element
     (Container : Container_Type;
      Iterator  : Iterator_Type) return Element_Access is

      N : Node_Array renames Container.Handle.Container.Nodes;
   begin
      return N (Iterator.Index).Element'Access;
   end;
      
      

   procedure Replace_Element
     (Container : in Container_Type;
      Iterator  : in Iterator_Type;
      By        : in Element_Type) is

      N : Node_Array renames Container.Handle.Container.Nodes;
   begin
      N (Iterator.Index).Element := By;
   end;

      

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

      N : Node_Array renames Container.Nodes;
      I : Natural := Container.First;

   begin

      while I /= 0 loop

         if Predicate (N (I).Element) then
            return Iterator_Type'(Index => I);
         end if;

         I := N (I).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
     (Container : Container_Type;
      Iterator  : Iterator_Type) return Iterator_Type is
   begin
      return (Index => Container.Nodes (Iterator.Index).Next);
   end;


   function Pred
     (Container : Container_Type;
      Iterator  : Iterator_Type) return Iterator_Type is
      
   begin
      
      if Iterator = Null_Iterator then
         return Last (Container);
      end if;

      pragma Assert (Container.Length > 0);

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

      pragma Assert (Container.Length > 1);

      declare
         N : Node_Array renames Container.Nodes;
         I : Positive := Container.First;
      begin
         while N (I).Next /= Iterator.Index loop
            I := N (I).Next;
         end loop;

         return Iterator_Type'(Index => I);
      end;
      
   end Pred;


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


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


   procedure Generic_Iteration (Container : in Container_Type) is
      
      N : Node_Array renames Container.Nodes;
      I : Natural := Container.First;
      
   begin
      
      while I /= 0 loop
         Process (Iterator_Type'(Index => I));
         I := N (I).Next;
      end loop;
      
   end Generic_Iteration;
      

end Charles.Lists.Single.Bounded;
