------------------------------------------------------------------------------
--                                                                          --
--                      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 Charles.Algorithms.Generic_Lexicographical_Compare_2;

package body Charles.Lists.Double.Bounded is


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

      LN : Node_Array renames Left.Nodes;
      LI : Natural := Left.First;

      RN : Node_Array renames Right.Nodes;
      RI : Natural := Right.First;

   begin

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

      if Left.Length = 0 then
         return Right.Length = 0;
      end if;

      if Right.Length = 0 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 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 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.First).Prev = 0);
      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 (Container, First (Container), New_Item);
   end;


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


   procedure Insert_Post
     (Container : in out Container_Type;
      Before    : in     Natural;
      Index     : in     Positive) is

      NA : Node_Array renames Container.Nodes;
      N  : Node_Type renames NA (Index);

   begin

      if Before = 0 then

         if Container.Length = 0 then

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

            N.Prev := 0;
            N.Next := 0;

            Container.First := Index;

         else

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

            N.Prev := Container.Last;
            N.Next := 0;

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

         end if;

         Container.Last := Index;

      elsif Before = Container.First then

         pragma Assert (Container.First >= 1);
         pragma Assert (Container.Last >= 1);
         pragma Assert (NA (Container.First).Prev = 0);

         N.Prev := 0;
         N.Next := Container.First;

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

         Container.First := Index;

      else

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

         N.Prev := NA (Before).Prev;
         N.Next := Before;

         NA (N.Prev).Next := Index;
         NA (Before).Prev := Index;

      end if;

      Container.Length := Container.Length + 1;
      pragma Assert (Container.Length <= Container.Size);

   end Insert_Post;


   procedure Insert
     (Container : in out Container_Type;
      Before    : in     Iterator_Type;
      New_Item  : in     Element_Type;
      Iterator  :    out Iterator_Type) is

      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_Post (Container, Before.Index, Iterator.Index);

   end Insert;


   procedure Insert
     (Container : in out Container_Type;
      Before    : in     Iterator_Type;
      New_Item  : in     Element_Type) is

      Iterator : Iterator_Type;
   begin
      Insert (Container, Before, New_Item, Iterator);
   end;


   procedure Insert
     (Container : in out Container_Type;
      Before    : in     Iterator_Type;
      Iterator  :    out Iterator_Type) is

      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_Post (Container, Before.Index, Iterator.Index);

   end Insert;



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

      NA : Node_Array renames Container.Nodes;

   begin

      if Iterator.Index = 0 then
         return;
      end if;

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

      Container.Length := Container.Length - 1;

      declare
         NI : constant Positive := Iterator.Index;
         N  : Node_Type renames NA (NI);
      begin
         Iterator.Index := N.Next;

         if Container.Length = 0 then

            pragma Assert (N.Next = 0);
            pragma Assert (N.Prev = 0);
            pragma Assert (NI = Container.First);
            pragma Assert (NI = Container.Last);

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

         elsif NI = Container.First then

            pragma Assert (N.Next /= 0);
            pragma Assert (N.Prev = 0);

            NA (N.Next).Prev := 0;

            Container.First := N.Next;

         elsif NI = Container.Last then

            pragma Assert (N.Next = 0);
            pragma Assert (N.Prev /= 0);

            NA (N.Prev).Next := 0;

            Container.Last := N.Prev;

         else

            pragma Assert (N.Next /= 0);
            pragma Assert (N.Prev /= 0);

            NA (N.Next).Prev := N.Prev;
            NA (N.Prev).Next := N.Next;

         end if;

         if Container.Free >= 0 then

            N.Next := Container.Free;
            Container.Free := NI;

         elsif NI + 1 = abs Container.Free then

            Container.Free := Container.Free + 1;

         else

            Initialize (Container);

            N.Next := Container.Free;
            Container.Free := NI;

         end if;
      end;

   end Delete;


   procedure Delete_First
     (Container : in out Container_Type) is

      Iterator : Iterator_Type := First (Container);
   begin
      Delete (Container, Iterator);
   end;


   procedure Delete_Last
     (Container : in out Container_Type) is

      Iterator : Iterator_Type := Last (Container);
   begin
      Delete (Container, Iterator);
   end;


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


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


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


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


   function Back
     (Container : Container_Type) return Iterator_Type is

      pragma Warnings (Off, Container);
   begin
      return Iterator_Type'(Index => 0);
   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;



   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;



   procedure Generic_Reverse_Iteration
     (Container : in Container_Type) is

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

   begin

      while I /= 0 loop
         Process (Iterator_Type'(Index => I));
         I := N (I).Prev;
      end loop;

   end Generic_Reverse_Iteration;



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

   begin

      if Iterator.Index = 0 then
         return Iterator_Type'(Index => Container.First);
      end if;

      pragma Assert (Container.Length > 0);

      return (Index => Container.Nodes (Iterator.Index).Next);

   end Succ;


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

   begin

      if Iterator.Index = 0 then
         return Iterator_Type'(Index => Container.Last);
      end if;

      pragma Assert (Container.Length > 0);

      return (Index => Container.Nodes (Iterator.Index).Prev);

   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_Sort (Container : in Container_Type) is

      NA : Node_Array renames Container.Handle.Container.Nodes;

      procedure Partition
        (Pivot : in Positive;
         Back  : in Natural) is

         Node : Natural := NA (Pivot).Next;

      begin

         while Node /= Back loop

            if NA (Node).Element < NA (Pivot).Element then

               declare
                  Prev : constant Natural := NA (Node).Prev;
                  Next : constant Natural := NA (Node).Next;
               begin
                  NA (Prev).Next := Next;

                  if Next >= 1 then
                     NA (Next).Prev := Prev;
                  else
                     pragma Assert (Node = Container.Last);
                     Container.Handle.Container.Last := Prev;
                  end if;

                  NA (Node).Next := Pivot;
                  NA (Node).Prev := NA (Pivot).Prev;

                  NA (Pivot).Prev := Node;

                  if NA (Node).Prev >= 1 then
                     NA (NA (Node).Prev).Next := Node;
                  else
                     pragma Assert (Pivot = Container.First);
                     Container.Handle.Container.First := Node;
                  end if;

                  Node := Next;
               end;

            else

               Node := NA (Node).Next;

            end if;

         end loop;

      end Partition;


      procedure Sort (Front, Back : Natural) is

         Pivot : Natural;

      begin

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

         if Pivot /= Back then

            Partition (Pivot, Back);

            Sort (Front, Pivot);

            Sort (Pivot, Back);

         end if;

      end Sort;

   begin

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

   end Generic_Sort;


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

      NA : Node_Array renames Container.Nodes;

      I : Natural := Position.Index;

   begin

      if I = 0 then
         I := Container.First;
      end if;

      while I /= 0 loop

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

         I := NA (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) /= Back (Container);
   end;


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

      NA : Node_Array renames Container.Nodes;

      I  : Natural := Position.Index;

   begin

      if I = 0 then
         I := Container.Last;
      end if;

      while I /= 0 loop

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

         I := NA (I).Prev;

      end loop;

      return Null_Iterator;  -- Back

   end Generic_Reverse_Find;



   function Reverse_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 Reverse_Find is
         new Generic_Reverse_Find (Predicate);
   begin
      return Reverse_Find (Container, Position);
   end;


   procedure Splice
     (Container : in Container_Type;
      Before    : in Iterator_Type;
      Iterator  : in Iterator_Type) is

      NA : Node_Array renames Container.Handle.Container.Nodes;

   begin

      if Iterator = Back (Container)
        or else Iterator = Before
        or else Succ (Container, Iterator) = Before
      then
         return;
      end if;

      pragma Assert (Container.Length > 1);

      if NA (Iterator.Index).Prev >= 1 then
         NA (NA (Iterator.Index).Prev).Next := NA (Iterator.Index).Next;
      else
         pragma Assert (Iterator.Index = Container.First);
         Container.Handle.Container.First := NA (Iterator.Index).Next;
      end if;

      if NA (Iterator.Index).Next >= 1 then
         NA (NA (Iterator.Index).Next).Prev := NA (Iterator.Index).Prev;
      else
         pragma Assert (Iterator.Index = Container.Last);
         Container.Handle.Container.Last := NA (Iterator.Index).Prev;
      end if;

      if Before.Index >= 1 then

         if NA (Before.Index).Prev >= 1 then
            NA (NA (Before.Index).Prev).Next := Iterator.Index;
         else
            pragma Assert (Before.Index = Container.First);
            Container.Handle.Container.First := Iterator.Index;
         end if;

         NA (Iterator.Index).Prev := NA (Before.Index).Prev;

         NA (Before.Index).Prev := Iterator.Index;

         NA (Iterator.Index).Next := Before.Index;

      else

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

         NA (Iterator.Index).Prev := Container.Last;

         NA (Iterator.Index).Next := 0;

         Container.Handle.Container.Last := Iterator.Index;

      end if;

   end Splice;


   procedure Reverse_Container (Container : in Container_Type) is

      NA : Node_Array renames Container.Handle.Container.Nodes;

      procedure Swap (L, R : Positive) is

         LN : constant Natural := NA (L).Next;
         LP : constant Natural := NA (L).Prev;

         RN : constant Natural := NA (R).Next;
         RP : constant Natural := NA (R).Prev;

      begin

         if LP >= 1 then
            NA (LP).Next := R;
         end if;

         if RN >= 1 then
            NA (RN).Prev := L;
         end if;

         NA (L).Next := RN;
         NA (R).Prev := LP;

         if LN = R then

            pragma Assert (RP = L);

            NA (L).Prev := R;
            NA (R).Next := L;

         else

            NA (L).Prev := RP;
            NA (RP).Next := L;

            NA (R).Next := LN;
            NA (LN).Prev := R;

         end if;

      end Swap;

      I, J : Positive;

   begin -- Reverse_Container

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

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

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

      loop

         Swap (L => I, R => J);

         J := NA (J).Next;  -- J is first (left)

         exit when I = J;

         I := NA (I).Prev;  -- I is last (right)

         exit when I = J;

         Swap (L => J, R => I);

         I := NA (I).Next;   -- I is first (left)

         exit when I = J;

         J := NA (J).Prev;   -- J is last (right)

         exit when I = J;

      end loop;

   end Reverse_Container;


   procedure Generic_Delete_Duplicates
     (Container : in out Container_Type) is

      NA : Node_Array renames Container.Nodes;

      I : Iterator_Type := First (Container);
      J : Iterator_Type := Succ (Container, I);

   begin

      while J /= Null_Iterator loop

         if Predicate (NA (I.Index).Element, NA (J.Index).Element) then
            Delete (Container, J);
         else
            I := J;
            J := Succ (Container, I);
         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 Generic_Delete
     (Container : in out Container_Type) is

      NA : Node_Array renames Container.Nodes;

      I : Iterator_Type := First (Container);

   begin

      while I /= Null_Iterator loop

         if Predicate (NA (I.Index).Element) then
            Delete (Container, I);
         else
            Increment (Container, I);
         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 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;


end Charles.Lists.Double.Bounded;
