-----------------------------------------------------------------------------
--
--                     Onions Network Streams Library
--
--                   O N I O N S . L I S T _ Q U E U E S
--
--                                 B o d y
--
--     Copyright (C) 1997-1998  Regents of the University of California
--
--  Onions is free software; you can redistribute it and/or modify it under
--  the terms of the GNU General Public License as published by the Free
--  Software Foundation, with or without the single exception listed below;
--  either version 2, or (at your option) any later version.  Onions 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 Onions; see the file COPYING.  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
--  library, or you link this library with other files to produce an
--  executable, this library 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 General Public License.
--
--  Created in 1997 by Roy T. Fielding and Kari Nies
-----------------------------------------------------------------------------

with Unchecked_Deallocation;

package body Onions.List_Queues is

   -----------------------
   --  List Operations  --
   -----------------------

   procedure Dispose is new Unchecked_Deallocation (Cell, List);

   function IsEmpty (L : in List) return Boolean is
   begin
      return (L = null);
   end IsEmpty;

   function Length (L : in List) return Natural is
      Count : Natural;
      Pos   : List;
   begin
      if L = null then
         return 0;
      end if;
      Count := 1;
      Pos   := L;
      while Pos.Next /= null loop
         Count := Count + 1;
         Pos   := Pos.Next;
      end loop;
      return Count;
   end Length;

   function Front_of_List (L : in List) return List is
      Pos : List;
   begin
      if L = null then
         return null;
      end if;
      Pos := L;
      while Pos.Prev /= null loop
         Pos := Pos.Prev;
      end loop;
      return Pos;
   end Front_of_List;

   function End_of_List (L : in List) return List is
      Pos : List;
   begin
      if L = null then
         return null;
      end if;
      Pos := L;
      while Pos.Next /= null loop
         Pos := Pos.Next;
      end loop;
      return Pos;
   end End_of_List;

   function Add_Before (Successor : in List; Element : in Element_Type)
   return List is
      L : List;
   begin
      L := new Cell'(Data => Element, Prev => null, Next => Successor);
      if Successor /= null then
         L.Prev := Successor.Prev;
         Successor.Prev := L;
         if L.Prev /= null then
            L.Prev.Next := L;
         end if;
      end if;
      return L;
   end Add_Before;

   function Add_After (Predecessor : in List; Element : in Element_Type)
   return List is
      L : List;
   begin
      L := new Cell'(Data => Element, Prev => Predecessor, Next => null);
      if Predecessor /= null then
         L.Next := Predecessor.Next;
         Predecessor.Next := L;
         if L.Next /= null then
            L.Next.Prev := L;
         end if;
      end if;
      return L;
   end Add_After;

   --  Head is a non-destructive grab of the first element in L
   --  Raises Constraint_Error if L is empty.
   --
   function Head (L : in List) return Element_Type is
   begin
      return L.Data;
   end Head;

   --  Tail is a non-destructive grab of the list after L.
   --  Raises Constraint_Error if L is empty.
   --
   function Tail (L : in List) return List is
   begin
      return L.Next;
   end Tail;

   --  Nose is a non-destructive grab of the list before L.
   --  Raises Constraint_Error if L = null.
   --
   function Nose (L : in List) return List is
   begin
      return L.Prev;
   end Nose;

   --  Extract is a destructive Head + Tail combo.
   --  Raises Constraint_Error if Pos is empty.
   --
   procedure Extract (Pos : in out List; Element : out Element_Type) is
      To_Be_Disposed : List := Pos;
   begin
      Element := Pos.Data;
      if Pos.Prev /= null then
         Pos.Prev.Next := Pos.Next;
      end if;
      if Pos.Next /= null then
         Pos.Next.Prev := Pos.Prev;
      end if;
      Pos := Pos.Next;
      Dispose (To_Be_Disposed);
   end Extract;

   --  Extract_Last is kinda like a destructive pop.
   --  Raises Constraint_Error if Front is empty.
   --
   procedure Extract_Last (Front : in out List; Element : out Element_Type) is
      Pos : List;
   begin
      if Front.Next = null then
         Element := Front.Data;
         Dispose (Front);
      else
         Pos := Front.Next;
         while Pos.Next /= null loop
            Pos := Pos.Next;
         end loop;
         Pos.Prev.Next := null;
         Element := Pos.Data;
         Dispose (Pos);
      end if;
   end Extract_Last;

   --  Split separates a list into two lists, where Pos is the beginning
   --  of the second list.  It is assumed the caller knows where the
   --  resulting two lists begin (e.g., Front_of_List(Pos) and Pos).
   --  Raises Constraint_Error if Pos is empty.
   --
   procedure Split (Pos : in List) is
   begin
      if Pos.Prev /= null then
         Pos.Prev.Next := null;
      end if;
      Pos.Prev := null;
   end Split;

   --  Splice inserts a list into another list without copying.
   --  Raises Constraint_Error if After is empty.
   --
   procedure Splice (After : in List; Wedgie : in List) is
      L, Rest : List;
   begin
      if Wedgie = null then
         return;
      end if;
      Rest := After.Next;
      if Rest /= null then
         L := End_of_List (After);
         L.Next := Rest;
         Rest.Prev := L;
      end if;
      After.Next := Wedgie;
      Wedgie.Prev := After;
   end Splice;

   --  Copy a list as if it were fronted at Pos (not a deep copy).
   --
   function Copy (L : in List) return List is
      Clone, Pos, Last : List;
   begin
      if L = null then
         return null;
      end if;
      Pos   := L;
      Clone := new Cell'(Data => Pos.Data, Prev => null, Next => null);
      Last  := Clone;
      while Pos.Next /= null loop
         Pos  := Pos.Next;
         Last.Next := new Cell'(Data => Pos.Data, Prev => Last, Next => null);
         Last := Last.Next;
      end loop;
      return Clone;
   end Copy;

   --  The "&" operator returns a new list consisting of a copy of
   --  Front linked to a copy of Back.  Use Splice to avoid copying.
   --
   function "&" (Front, Back : in List) return List is
      Clone, Pos, Last : List;
   begin
      if Front = null then
         Clone := Copy (Back);
      else
         Pos   := Front;
         Clone := new Cell'(Data => Pos.Data, Prev => null, Next => null);
         Last  := Clone;
         while Pos.Next /= null loop
            Pos  := Pos.Next;
            Last.Next := new Cell'(Data => Pos.Data,
                                   Prev => Last,
                                   Next => null);
            Last := Last.Next;
         end loop;
         if Back /= null then
            Last.Next := Copy (Back);
            Last.Next.Prev := Last;
         end if;
      end if;
      return Clone;
   end "&";

   ------------------------
   --  Queue Operations  --
   ------------------------

   function Length (Q : in Queue) return Natural is
   begin
      return Q.Count;
   end Length;

   procedure Enqueue (Q : in out Queue; Element : in Element_Type) is
   begin
      if Q.Count = 0 then
         Q.First := Add_After (null, Element);
         Q.Last  := Q.First;
      else
         Q.Last  := Add_After (Q.Last, Element);
      end if;
      Q.Count := Q.Count + 1;
   end Enqueue;

   procedure Enqueue (Q : in out Queue; L : in List) is
   begin
      if Q.Count = 0 then
         L.Prev  := null;
         Q.First := L;
      else
         L.Prev  := Q.Last;
         Q.Last.Next := L;
      end if;
      Q.Last  := End_of_List (L);
      Q.Count := Q.Count + 1;
   end Enqueue;

   procedure Dequeue (Q : in out Queue; Element : out Element_Type) is
   begin
      if Q.Count = 0 then
         raise Empty;
      end if;
      Extract (Q.First, Element);
      Q.Count := Q.Count - 1;
      if Q.Count = 0 then
         Q.Last := null;
      end if;
   end Dequeue;

   procedure Dequeue (Q : in out Queue; L : out List) is
   begin
      L := Q.First;
      Q.Count := 0;
      Q.First := null;
      Q.Last  := null;
   end Dequeue;

   procedure Undequeue (Q : in out Queue; Element : in Element_Type) is
   begin
      if Q.Count = 0 then
         Q.First := Add_Before (null, Element);
         Q.Last  := Q.First;
      else
         Q.First := Add_Before (Q.First, Element);
      end if;
      Q.Count := Q.Count + 1;
   end Undequeue;

   procedure Undequeue (Q : in out Queue; L : in List) is
      X : List;
   begin
      X := End_of_List (L);
      if Q.Count = 0 then
         Q.First := L;
         Q.Last  := X;
      else
         X.Next       := Q.First;
         Q.First.Prev := X;
         Q.First      := L;
      end if;
      Q.Count := Q.Count + Length (L);
   end Undequeue;

end Onions.List_Queues;