File : charles-double_lists.adb


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

--                                                                          --

--                      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 Charles.Algorithms.Generic_Lexicographical_Compare;
with Charles.Algorithms.Generic_Compare;

package body Charles.Double_Lists is


   procedure Free_List (Head : in out Node_Access) is
   
      Node : Node_Access;
      
   begin
   
      while Head /= Null_Node loop
               
         Node := Head;
         
         Head := Succ (Head);
         
         Free (Node);
                  
      end loop;
      
   end Free_List;   
      

   procedure Initialize (List : in out List_Type) is
   
      Back : Node_Access renames List.Back;
      pragma Assert (Back /= Null_Node);
      
   begin
         
      Set_Succ (Node => Back, Succ => Back);
      Set_Pred (Node => Back, Pred => Back);
      
      List.Length := 0;
      
   end;
   
   
--   procedure Do_Finalize (Back : in out Node_Access) is

--      First : Node_Access := Get_Next (Back);

--   begin

--      while First /= Back loop

--         declare

--            X : Node_Access := First;

--         begin

--            First := Get_Next (First);

--            Free (X);

--         end;

--      end loop;

--            

--      Free (Back);

--   end Do_Finalize;

   
   
--   procedure Adjust (List : in out List_Type) is

--   

--      Source_Back : constant Node_Access := List.Back;      

--   begin   

--      List.Back := null;

--      

--      declare

--         Iter : Node_Access := Get_Next (Source_Back);

--         Back_Iter : constant Node_Access := Source_Back;

--         

--         Back : Node_Access := New_Node;

--         Last : Node_Access;

--      begin

--         Set_Next (Node => Back, Next => Back);

--         Set_Prev (Node => Back, Prev => Back);

--         

--         Last := Back;

--      

--         while Iter /= Back_Iter loop

--         

--            declare

--               Node : constant Node_Access := 

--                  New_Node (Curr => Iter, 

--                            Next => Back,

--                            Prev => Last);

--            begin

--               Set_Next (Last, Next => Node);

--            end;


--            Last := Get_Next (Last);

--            Iter := Get_Next (Iter);


--         end loop;


--         List.Back := Back;

--      exception

--         when others =>

--            Do_Finalize (Back);         

--            raise;

--      end;               

--   end Adjust;



   procedure Finalize (List : access List_Type) is
   begin
   
      if List.Back = Null_Node then
         return;
      end if;

      Set_Succ (Node => Last (List.all), Succ => Null_Node);

      List.Length := 0;

      declare
         Head : Node_Access := List.Back;
      begin
         List.Back := Null_Node;
         Free_List (Head);
      end;
      
   end Finalize;
      
   
   function Generic_Equal (Left, Right : List_Type) return Boolean is
   
      function Compare is
         new Algorithms.Generic_Compare 
               (Node_Access, 
                Succ, 
                Is_Equal);
               
   begin
      
      if Left.Length /= Right.Length then
         return False;
      end if;
      
      return Compare (First (Left), Back (Left), First (Right));
      
   end Generic_Equal;

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

      function Lexicographical_Compare is
         new Algorithms.Generic_Lexicographical_Compare 
               (Node_Access, 
                Succ, 
                Is_Less);
               
   begin
      
      if Left.Length > Right.Length then
         return False;
      end if;
         
      return Lexicographical_Compare 
               (First (Left), Back (Left), 
                First (Right), Back (Right));   

   end Generic_Less;



   function Length (List : List_Type) return Natural is
   begin
      return List.Length;
   end;
   

   procedure Clear (List : in out List_Type) is
      Head : Node_Access := First (List);
   begin
      if List.Length = 0 then
         pragma Assert (Head = List.Back);
         pragma Assert (Last (List) = List.Back);         
         return;
      end if;

      pragma Assert (Head /= List.Back);
      pragma Assert (Last (List) /= List.Back);
      
      Set_Succ (Node => Last (List), Succ => Null_Node);
      
      Initialize (List);
      
      Free_List (Head);
   end;

   
   procedure Swap (Left, Right : in out List_Type) is
   
      L_Back : constant Node_Access := Left.Back;
      L_Length : constant Natural := Left.Length;

   begin

      Left.Back := Right.Back;
      Left.Length := Right.Length;
      
      Right.Back := L_Back;
      Right.Length := L_Length;

   end Swap;
         
   
   
   
--   function To_List (Length : Natural) return List_Type is

--   

--      Back : Node_Access := new Node_Type;

--      

--   begin

--      

--      Back.Next := Back;

--      Back.Prev := Back;

--   

--      for I in 1 .. Length loop

--      

--         declare

--            Node : constant Node_Access := new Node_Type;

--            First : constant Node_Access := Back.Next;

--         begin

--            Node.Next := First;

--            Node.Prev := Back;

--            

--            Back.Next := Node;      

--            First.Prev := Node;

--         end;

--         

--      end loop;


--      return (Ada.Finalization.Controlled with Back, Length);

--      

--   exception

--      when others =>

--         

--         Do_Finalize (Back);

--         raise;

--               

--   end To_List;   

--      

--      

--   function To_List 

--     (Length : Natural;

--      Item   : Element_Type) return List_Type is

--   

--      Back : Node_Access := new Node_Type;

--      

--   begin

--      

--      Back.Next := Back;

--      Back.Prev := Back;

--   

--      for I in 1 .. Length loop

--      

--         declare

--            First : constant Node_Access := Back.Next;


--            Node : constant Node_Access := 

--               new Node_Type'(Element => Item,

--                              Next    => First,

--                              Prev    => Back);

--         begin

--            Back.Next := Node;      

--            First.Prev := Node;

--         end;

--         

--      end loop;


--      return (Ada.Finalization.Controlled with Back, Length);

--      

--   exception

--      when others =>

--         

--         Do_Finalize (Back);

--         raise;

--               

--   end To_List;   

--      

--      

--   function To_List 

--     (First  : Iterator_Type;

--      Back   : Iterator_Type) return List_Type is


--      Target_Back : Node_Access := new Node_Type;

--      Length      : Natural := 0;

--      

--      I : Iterator_Type := First;

--      

--   begin

--      

--      Target_Back.Next := Target_Back;

--      Target_Back.Prev := Target_Back;

--   

--      while I /= Back loop

--      

--         declare

--            Target_Last : constant Node_Access := Target_Back.Prev;


--            Node : constant Node_Access := 

--               new Node_Type'(Element => I.Node.Element,

--                              Next    => Target_Back,

--                              Prev    => Target_Last);

--         begin

--            Target_Back.Prev := Node;

--            Target_Last.Next := Node;

--         end;

--         

--         Length := Length + 1;

--         

--         I := Succ (I);

--         

--      end loop;


--      return (Ada.Finalization.Controlled with Target_Back, Length);

--      

--   exception

--      when others =>

--         

--         Do_Finalize (Target_Back);

--         raise;

--               

--   end To_List;   



--   procedure Assign

--     (Target : in out List_Type;

--      Length : in     Natural) is

--      

--      Source : List_Type := To_List (Length);

--   begin

--      Swap (Target, Source);

--   end;

--            


--   procedure Assign

--     (Target : in out List_Type;

--      Length : in     Natural;

--      Item   : in     Element_Type) is

--      

--      Source : List_Type := To_List (Length, Item);

--   begin

--      Swap (Target, Source);

--   end;

--            


--   

--   procedure Assign

--     (Target : in out List_Type;

--      Source : in     List_Type) is

--   begin

--      if Target'Address = Source'Address then

--         return;

--      end if;

--      

--      declare

--         C : List_Type := Source;

--      begin

--         Swap (Target, C);

--      end;

--   end Assign;



--   procedure Assign

--     (Target : in out List_Type;

--      Source : in     List_Type;

--      First  : in     Iterator_Type;

--      Back   : in     Iterator_Type) is

--      

--      pragma Assert (Target'Address /= Source'Address);


--      C : List_Type := To_List (Source, First, Back);

--   begin

--      Swap (Target, C);

--   end;

   
   
   procedure Insert
     (List   : in out List_Type;
      Before : in     Node_Access;
      Node   : in     Node_Access) is
      
      pragma Assert (Succ (Node) = Before);
      pragma Assert (Pred (Node) = Pred (Before));
   begin      
--      Set_Succ (Node => Node, Succ => Before);

--      Set_Pred (Node => Node, Pred => Pred (Before));


      Set_Succ (Node => Pred (Before), Succ => Node);      
      Set_Pred (Node => Before, Pred => Node); 

      List.Length := List.Length + 1;
   end;


--   procedure Push_Front 

--     (List : in out List_Type) is

--      

--      Before   : Iterator_Type := First (List);

--      New_Node : Node_Access;

--   begin

--      Insert (List, Before.Node, New_Node);

--   end;



--   procedure Push_Front 

--     (List : in out List_Type;

--      New_Item  : in     Element_Type) is

--      

--      Before   : Iterator_Type := First (List);

--      New_Node : Node_Access;

--   begin

--      Insert (List, Before.Node, New_Item, New_Node);

--   end;


--      

--     

--   procedure Pop_Front (List : in out List_Type) is

--   

--      Iter : Iterator_Type := First (List);

--   begin

--      Delete (List, Iter.Node);

--   end;

--   

--      

--   procedure Push_Back

--     (List : in out List_Type) is

--      

--      Before   : Iterator_Type := Back (List);

--      New_Node : Node_Access;

--   begin

--      Insert (List, Before.Node, New_Node);

--   end;

--      

--      


--   procedure Push_Back

--     (List : in out List_Type;

--      New_Item  : in     Element_Type) is

--      

--      Before   : Iterator_Type := Back (List);

--      New_Node : Node_Access;

--   begin

--      Insert (List, Before.Node, New_Item, New_Node);

--   end;

--      

--      

--   procedure Pop_Back (List : in out List_Type) is

--   

--      Iter : Iterator_Type := Last (List);

--   begin

--      Delete (List, Iter.Node);

--   end;


--   

--   

--   procedure Insert

--     (List : in out List_Type;

--      Before    : in     Iterator_Type) is

--   

--      New_Node : Node_Access;

--   begin

--      Insert (List, Before.Node, New_Node);

--   end;




--   procedure Insert

--     (List : in out List_Type;

--      Before    : in     Iterator_Type;

--      New_Item  : in     Element_Type) is

--   

--      New_Node : Node_Access;

--   begin

--      Insert (List, Before.Node, New_Item, New_Node);

--   end;



--   procedure Insert

--     (List : in out List_Type;

--      Before    : in     Iterator_Type;

--      New_Item  : in     Element_Type;

--      Iterator  :    out Iterator_Type) is

--   begin

--      Insert (List, Before.Node, New_Item, Iterator.Node);

--   end;



--   procedure Insert

--     (List : in out List_Type;

--      Before    : in     Iterator_Type;

--      Iterator  :    out Iterator_Type) is

--   begin

--      Insert (List, Before.Node, Iterator.Node);

--   end;



--   procedure Insert_Range

--     (List   : in out List_Type;

--      Before : in     Node_Access;

--      Length : in     Natural;

--      Node   :    out Node_Access) is

--      

--   begin

--   

--      if Length = 0 then

--         Node := Before;

--         return;

--      end if;

--      

--      declare

--         New_List : List_Type := To_List (Length);

--      begin

--         Node := First (New_List);

--         Splice (List, Before, Source => New_List);

--      end;

--      

--   end Insert_Range;

   
   

   procedure Delete_And_Free
     (List : in out List_Type;
      Node : in out Node_Access) is
   begin
      if Node = Null_Node 
        or else Node = List.Back
      then
         return;
      end if;
        
      List.Length := List.Length - 1;

      Set_Pred (Node => Succ (Node), Pred => Pred (Node));
      Set_Succ (Node => Pred (Node), Succ => Succ (Node));

      Free (Node);
   end;
       
         
   procedure Delete_And_Increment
     (List : in out List_Type;
      Node : in out Node_Access) is
   begin
      if Node = Null_Node 
        or else Node = List.Back
      then
         return;
      end if;
        
      List.Length := List.Length - 1;
      
      declare
         Curr : Node_Access := Node;
         Pred : constant Node_Access := Double_Lists.Pred (Curr);
      begin
         Node := Succ (Node);

         Set_Pred (Node => Node, Pred => Pred);
         Set_Succ (Node => Pred, Succ => Node);

         Free (Curr);
      end;
   end Delete_And_Increment;
       

   procedure Delete
     (List  : in out List_Type; 
      First : in out Node_Access;
      Back  : in     Node_Access) is      

      Prev : Node_Access;      
      Curr : Node_Access;
      
   begin
   
      if First = Null_Node
        or else Back = Null_Node
      then
         return;
      end if;

      if First = Double_Lists.First (List)
        and then Back = List.Back
      then
         Clear (List);
         return;
      end if;

      Prev := Pred (First);

      while First /= Back 
        and then First /= List.Back
      loop
         Curr := First;
         
         First := Succ (First);

         List.Length := List.Length - 1;

         Set_Pred (Node => First, Pred => Prev);
         Set_Succ (Node => Prev, Succ => First);

         Free (Curr);
      end loop;
                        
   end Delete;
   
         


   procedure Generic_Delete 
     (List  : in out List_Type;
      First : in out Node_Access;
      Back  : in     Node_Access;
      Count :    out Natural) is 
           
   begin
   
      if First = Null_Node
        or else Back = Null_Node
      then
         return;
      end if;
      
      Count := 0;
      
      while First /= Back 
        and then First /= List.Back
      loop
         if Predicate (First) then
            Delete_And_Increment (List, First);
            Count := Count + 1;
         else
            First := Succ (First);
         end if;
      end loop;      
      
   end Generic_Delete;


   
   procedure Reverse_List 
     (First : in     Node_Access;
      Back  : in     Node_Access) is

      procedure Swap (L, R : Node_Access) is
      
         LN : constant Node_Access := Succ (L);
         LP : constant Node_Access := Pred (L);
         
         RN : constant Node_Access := Succ (R);
         RP : constant Node_Access := Pred (R);
         
      begin

         Set_Succ (Node => LP, Succ => R);
         Set_Pred (Node => RN, Pred => L);

         Set_Succ (Node => L, Succ => RN);
         Set_Pred (Node => R, Pred => LP);
         
         if LN = R then
         
            pragma Assert (RP = L);
            
            Set_Pred (Node => L, Pred => R);            
            Set_Succ (Node => R, Succ => L);
            
         else
         
            Set_Pred (Node => L, Pred => RP);
            Set_Succ (Node => RP, Succ => L);
            
            Set_Succ (Node => R, Succ => LN);
            Set_Pred (Node => LN, Pred => R);
            
         end if;

      end Swap;

      I : Node_Access := First;
      J : Node_Access := Back;

   begin
   
      if I = Null_Node
        or else J = Null_Node
      then
         return;
      end if;
   
      while I /= J loop
      
         J := Pred (J);
         
         exit when I = J;
         
         Swap (I, J);
         
         J := Succ (J);
         
         exit when I = J;
         
         I := Pred (I);
         
         exit when I = J;
         
         Swap (J, I);
         
         I := Succ (I);
                    
      end loop;
      
   end Reverse_List;



   function First 
     (List : List_Type) return Node_Access is
   begin
      return Succ (List.Back);
   end;

   
   function Back 
     (List : List_Type) return Node_Access is
   begin
      return List.Back;
   end;
      

   function Last 
     (List : List_Type) return Node_Access is
   begin
      return Pred (List.Back);
   end;


   function Succ 
     (Node   : Node_Access;
      Offset : Natural) return Node_Access is
      
      Result : Node_Access := Node;
   begin
      for I in 1 .. Offset loop
         Result := Succ (Result);
      end loop;
      
      return Result;
   end;


   function Pred
     (Node   : Node_Access;
      Offset : Natural) return Node_Access is
      
      Result : Node_Access := Node;
   begin
      for I in 1 .. Offset loop
         Result := Pred (Result);
      end loop;
      
      return Result;
   end;


   function Offset
     (From, To : Node_Access) return Natural is
     
      Result : Integer'Base := 0;        
      Node   : Node_Access := From;
   begin
      while Node /= To loop
         Result := Result + 1;
         Node := Succ (Node);
      end loop;
      
      return Result;
   end;


         
   
   procedure Swap_Iterator (Left, Right : in out Node_Access) is
      LN : constant Node_Access := Left;
   begin
      Left := Right;
      Right := LN;
   end;


--   function Generic_Find 

--     (First : Node_Access;

--      Back  : Node_Access) return Node_Access is

--      

--      Iter : Node_Access := First;

--   begin

--      while Iter /= Back loop

--         if Predicate (Iter.all) then

--            return Iter;

--         end if;

--         

--         Iter := Get_Next (Iter);

--      end loop;

--      

--      return Back;

--   end;

      

--   function Find 

--     (First : Iterator_Type;

--      Back  : Iterator_Type;

--      Item  : Element_Type) return Iterator_Type is

--      

--      function Predicate (Element : Element_Type) return Boolean is

--      begin

--         return Item = Element;

--      end;

--      

--      function Find is 

--         new Generic_Find (Predicate);

--   begin

--      return Find (First, Back);

--   end;


--      

--   function Find 

--     (List : List_Type;

--      Item      : Element_Type) return Iterator_Type is

--   begin

--      return Find (First (List), Back (List), Item);

--   end;



--   function Generic_Reverse_Find 

--     (First : Node_Access;

--      Back  : Node_Access) return Node_Access is

--      

--      Iter : Node_Access := Back;

--   begin

--      while Iter /= First loop

--         Iter := Get_Prev (Iter);

--         

--         if Predicate (Iter.all) then

--            return Iter;

--         end if;

--      end loop;

--      

--      return Back;

--   end;



--   function Reverse_Find 

--     (First : Iterator_Type;

--      Back  : Iterator_Type;

--      Item  : Element_Type) return Iterator_Type is

--   

--      function Predicate (Element : Element_Type) return Boolean is

--      begin

--         return Item = Element;

--      end;

--      

--      function Reverse_Find is

--         new Generic_Reverse_Find (Predicate);

--   begin

--      return Reverse_Find (First, Back);

--   end;



--   function Reverse_Find 

--     (List : List_Type;

--      Item      : Element_Type) return Iterator_Type is

--   begin

--      return Reverse_Find (First (List), Back (List), Item);

--   end;



   procedure Splice
     (List   : in out List_Type;
      Before : in     Node_Access;
      Source : in out List_Type) is
      
   begin
   
      if Before = Null_Node then --?

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

      Set_Succ (Node => Pred (Before), Succ => First (Source));
      Set_Pred (Node => First (Source), Pred => Pred (Before));
      
      Set_Pred (Node => Before, Pred => Last (Source));
      Set_Succ (Node => Last (Source), Succ => Before);
      
      Set_Succ (Node => Source.Back, Succ => Source.Back);
      Set_Pred (Node => Source.Back, Pred => Source.Back);
      
      List.Length := List.Length + Source.Length;
      Source.Length := 0;

   end Splice;


   procedure Splice
     (List   : in List_Type;
      Before : in Node_Access;
      Node   : in Node_Access) is
      
   begin
   
      if Before = Null_Node
        or else Node = Null_Node
        or else Node = List.Back
        or else Node = Before
        or else Succ (Node) = Before
      then
         return;
      end if;
   
      pragma Assert (List.Length > 0);
      
      Set_Succ (Node => Pred (Node), Succ => Succ (Node));
      Set_Pred (Node => Succ (Node), Pred => Pred (Node));
   
      Set_Succ (Node => Pred (Before), Succ => Node);
      Set_Pred (Node => Node, Pred => Pred (Before));
      
      Set_Pred (Node => Before, Pred => Node);
      Set_Succ (Node => Node, Succ => Before);
      
   end Splice;


   procedure Splice
     (List   : in out List_Type;
      Before : in     Node_Access;
      Source : in out List_Type;
      Node   : in     Node_Access) is    

   begin
   
      if Before = Null_Node
         or else Node = Null_Node
         or else Node = Source.Back
      then
         return;
      end if;
      
      pragma Assert (Source.Length > 0);
   
      Set_Succ (Node => Pred (Node), Succ => Succ (Node));
      Set_Pred (Node => Succ (Node), Pred => Pred (Node));
   
      Set_Succ (Node => Pred (Before), Succ => Node);
      Set_Pred (Node => Node, Pred => Pred (Before));
      
      Set_Pred (Node => Before, Pred => Node);
      Set_Succ (Node => Node, Succ => Before);
      
      List.Length := List.Length + 1;
      Source.Length := Source.Length - 1;
      
   end Splice;


   procedure Splice
     (List   : in List_Type;
      Before : in Node_Access;
      First  : in Node_Access;
      Back   : in Node_Access) is

      Last  : Node_Access;
      
   begin

      if Before = Null_Node
        or else First = Null_Node
        or else Back = Null_Node
        or else Before = Back
        or else First = Back
      then
         return;
      end if;
      
      pragma Assert (List.Length > 0);
            
      Last := Pred (Back);
      
      Set_Succ (Node => Pred (First), Succ => Back);
      Set_Pred (Node => Back, Pred => Pred (First));
      
      Set_Pred (Node => First, Pred => Pred (Before));
      Set_Succ (Node => Pred (Before), Succ => First);
      
      Set_Succ (Node => Last, Succ => Before);
      Set_Pred (Node => Before, Pred => Last);
      
   end Splice;



   procedure Splice
     (List   : in out List_Type;
      Before : in     Node_Access;
      Source : in out List_Type;
      First  : in     Node_Access;
      Back   : in     Node_Access) is

      Count : Positive;
      Last  : Node_Access;
      
   begin
   
      if Before = Null_Node
        or else First = Null_Node
        or else Back = Null_Node
        or else First = Back
      then
         return;
      end if;

      if First = Double_Lists.First (Source)
        and then Back = Source.Back
      then
         Count := Source.Length;
      else
         Count := Offset (First, Back);
      end if;
      
      Last := Pred (Back);
      
      Set_Succ (Node => Pred (First), Succ => Back);
      Set_Pred (Node => Back, Pred => Pred (First));
      
      Set_Pred (Node => First, Pred => Pred (Before));
      Set_Succ (Node => Pred (Before), Succ => First);
      
      Set_Succ (Node => Last, Succ => Before);
      Set_Pred (Node => Before, Pred => Last);
      
      List.Length := List.Length + Count;
      Source.Length := Source.Length - Count;
      
   end Splice;
     

   procedure Generic_Unique 
     (List  : in out List_Type;
      First : in     Node_Access;
      Back  : in     Node_Access) is

      I : Node_Access := First;
      J : Node_Access;
      
   begin

      if First = Null_Node
        or else Back = Null_Node
        or else First = Back
      then
         return;
      end if;
      
      J := Succ (I);
      
      while J /= Back loop
            
         if Predicate (J, I) then

            Delete_And_Increment (List, J);

         else

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

         end if;

      end loop;
      
   end Generic_Unique;


   procedure Generic_Merge 
     (List   : in out List_Type;
      Source : in out List_Type;
      First  : in     Node_Access;
      Back   : in     Node_Access) is
   
      LI : Node_Access := Double_Lists.First (List);      
      RI : Node_Access := First;

   begin
   
      if First = Null_Node 
        or else Back = Null_Node
      then
         return;
      end if;

      while RI /= Back loop
      
         if LI = List.Back then
            Splice (List, List.Back, Source, RI, Back);
            return;
         end if;
         
         if Is_Less (RI, LI) then
            declare
               RJ : constant Node_Access := RI;
            begin
               RI := Succ (RI);
               Splice (List, LI, Source, RJ);
            end;            
         else
            LI := Succ (LI);
         end if;

      end loop;      
      
   end Generic_Merge;


--   procedure Generic_Merge 

--     (List   : in out List_Type;

--      Source : in out List_Type) is

--   

--      LI : Node_Access := First (List);      

--      RI : Node_Access := First (Source);


--   begin


--      while RI /= Source.Back loop

--      

--         if LI = List.Back then

--            Splice (List, List.Back, Source);

--            return;

--         end if;

--         

--         if Is_Less (RI, LI) then


--            declare

--               RJ : constant Node_Access := RI;

--            begin

--               RI := Succ (RI);

--               Splice (List, LI, Source, RJ);

--            end;

--            

--         else


--            LI := Succ (LI);

--            

--         end if;


--      end loop;      

--      

--   end Generic_Merge;

   


   procedure Generic_Quicksort (First, Back : Node_Access) is

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

         Node : Node_Access := Succ (Pivot);
         
      begin
      
         while Node /= Back loop

            if Is_Less (Node, Pivot) then

               declare
                  Prev : constant Node_Access := Pred (Node);
                  Next : constant Node_Access := Succ (Node);
               begin
                  Set_Succ (Node => Prev, Succ => Next);
                  Set_Pred (Node => Next, Pred => Prev);
                  
                  Set_Succ (Node => Node, Succ => Pivot);
                  Set_Pred (Node => Node, Pred => Pred (Pivot));
                  
                  Set_Pred (Node => Pivot, Pred => Node);
                  Set_Succ (Node => Pred (Node), Succ => Node);

                  Node := Next;               
               end;

            else

               Node := Succ (Node);

            end if;

         end loop;      

      end Partition;


      procedure Sort (Front, Back : Node_Access) is

         Pivot : constant Node_Access := Succ (Front);

      begin

         if Pivot /= Back then

            Partition (Pivot, Back);

            Sort (Front, Pivot);

            Sort (Pivot, Back);

         end if;

      end Sort;   
      
   begin

      if First = Null_Node
         or else Back = Null_Node
      then
         return;
      end if;

      Sort (Front => Pred (First), Back => Back);   
      
   end Generic_Quicksort;


end Charles.Double_Lists;