-------------------------------------------------------------------------------
--
-- <STRONG>Copyright (c) 2001-2003 by Thomas Wolf.</STRONG>
-- <BLOCKQUOTE>
--    This piece of software 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; either version 2, or (at your option)
--    any later version. This unit is distributed in the hope that it will be
--    useful, but <EM>without any warranty</EM>; without even the implied
--    warranty of <EM>merchantability or fitness for a particular purpose.</EM>
--    See the GNU General Public License for  more details. You should have
--    received a copy of the GNU General Public License with this distribution,
--    see file "<A HREF="GPL.txt">GPL.txt</A>". If not, write to the Free
--    Software Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307,
--    USA.
-- </BLOCKQUOTE>
-- <BLOCKQUOTE>
--   As a special exception from the GPL, 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 GPL. This exception does not however invalidate any
--   other reasons why the executable file might be covered by the GPL.
-- </BLOCKQUOTE>
--
-- <DL><DT><STRONG>
-- Author:</STRONG><DD>
--   Thomas Wolf  (TW)
--   <ADDRESS><A HREF="mailto:twolf@acm.org">twolf@acm.org</A></ADDRESS></DL>
--
-- <DL><DT><STRONG>
-- Purpose:</STRONG><DD>
--   Simple dynamic container, implemented as a very simple singly linked list.
--   Only operations are adding items, sorting, and finally traversing. It's
--   truly simple, but captures a very common case.
--   </DL>
--
-- <DL><DT><STRONG>
-- Tasking semantics:</STRONG><DD>
--   N/A. Not abortion-safe.</DL>
--
-- <DL><DT><STRONG>
-- Storage semantics:</STRONG><DD>
--   Dynamic storage allocation in a user-supplied storage pool.</DL>
--
-- <!--
-- Revision History
--
--   16-JUN-2003   TW  Initial version.
-- -->
-------------------------------------------------------------------------------

pragma License (Modified_GPL);

with Ada.Unchecked_Deallocation;

with GAL.Support;
with GAL.Support.List_Sort;

--  generic
--     type Item is private;
--
--     with package Memory is new GAL.Storage.Memory (<>);
--
--     with function "=" (Left, Right : in Item) return Boolean is <>;
--
package body GAL.Containers.Simple is

   procedure Swap
     (Left, Right : in out Simple_Container)
   is
      procedure Exchange is new GAL.Support.Swap (Link);
      procedure Exchange is new GAL.Support.Swap (Natural);
   begin
      Exchange (Left.C.Anchor, Right.C.Anchor);
      Exchange (Left.C.Last,   Right.C.Last);
      Exchange (Left.C.Count,  Right.C.Count);
   end Swap;

   function Nof_Elements
     (Container : in Simple_Container)
     return Natural
   is
   begin
      return Container.C.Count;
   end Nof_Elements;

   function Is_Empty
     (Container : in Simple_Container)
     return Boolean
   is
   begin
      return Container.C.Last = null;
   end Is_Empty;

   procedure Add
     (What : in     Item;
      To   : in out True_Container)
   is
      New_Item : constant Link := new Node'(Data => What, Next => null);
   begin
      if To.Last = null then
         To.Anchor := New_Item;
      else
         To.Last.Next := New_Item;
      end if;
      To.Last  := New_Item;
      To.Count := To.Count + 1;
   end Add;

   procedure Add
     (What : in     Item;
      To   : in out Simple_Container)
   is
   begin
      Add (What, To.C);
   end Add;

   procedure Reset
     (Container : in out True_Container)
   is
      P : Link := Container.Anchor;

      procedure Free is new Ada.Unchecked_Deallocation (Node, Link);

   begin
      while P /= null loop
         declare
            Q : constant Link := P.Next;
         begin
            Free (P); P := Q;
         end;
      end loop;
      Container.Anchor := null;
      Container.Last   := null;
      Container.Count  := 0;
   end Reset;

   procedure Reset
     (Container : in out Simple_Container)
   is
   begin
      Reset (Container.C);
   end Reset;

   procedure Traverse
     (Container : in     Simple_Container;
      V         : in out Visitor'Class)
   is
      P    : Link    := Container.C.Anchor;
      Quit : Boolean := False;
   begin
      while P /= null and then not Quit loop
         Execute (V, P.Data, Quit);
         P := P.Next;
      end loop;
   end Traverse;

   --  generic
   --     with procedure Execute
   --            (Value : in out Item;
   --             Quit  : in out Boolean);
   procedure Traverse_G
     (Container : in Simple_Container)
   is
      P    : Link    := Container.C.Anchor;
      Quit : Boolean := False;
   begin
      while P /= null and then not Quit loop
         Execute (P.Data, Quit);
         P := P.Next;
      end loop;
   end Traverse_G;

   --  generic
   --     type Auxiliary (<>) is limited private;
   --     with procedure Execute
   --            (Value : in out Item;
   --             Data  : in out Auxiliary;
   --             Quit  : in out Boolean);
   procedure Traverse_Aux_G
     (Container : in     Simple_Container;
      Data      : in out Auxiliary)
   is
      P    : Link    := Container.C.Anchor;
      Quit : Boolean := False;
   begin
      while P /= null and then not Quit loop
         Execute (P.Data, Data, Quit);
         P := P.Next;
      end loop;
   end Traverse_Aux_G;

   --  generic
   --     with function "<" (Left, Right : in Item) return Boolean is <>;
   procedure Sort
     (Container : in out Simple_Container)
   is
      function Smaller (L, R : in Link) return Boolean;
      pragma Inline (Smaller);

      function Smaller (L, R : in Link) return Boolean
      is
      begin
         return L.Data < R.Data;
      end Smaller;

      function Next (L : in Link) return Link;
      pragma Inline (Next);

      function Next (L : in Link) return Link
      is
      begin
         return L.Next;
      end Next;

      procedure Set_Next (L, Next : in Link);
      pragma Inline (Set_Next);

      procedure Set_Next (L, Next : in Link)
      is
      begin
         L.Next := Next;
      end Set_Next;

      procedure Post_Process (First, Last : in out Link)
      is
         pragma Warnings (Off, First); --  silence -gnatwa
         pragma Warnings (Off, Last);  --  silence -gnatwa
      begin
         null;
      end Post_Process;

      procedure Sort is
         new GAL.Support.List_Sort
               (Node, Link, Smaller, Next, Set_Next, Post_Process);

   begin
      Sort (Container.C.Anchor, Container.C.Last);
   end Sort;

   procedure Adjust   (Container : in out True_Container)
   is
      P : Link := Container.Anchor;
   begin
      Container.Anchor := null;
      Container.Last   := null;
      Container.Count  := 0;
      while P /= null loop
         Add (P.Data, Container);
         P := P.Next;
      end loop;
   end Adjust;

   procedure Finalize (Container : in out True_Container)
   is
   begin
      Reset (Container);
   end Finalize;

   procedure Write
     (Stream    : access Ada.Streams.Root_Stream_Type'Class;
      Container : in     Simple_Container)
   is
      P : Link := Container.C.Anchor;
   begin
      Natural'Write (Stream, Container.C.Count);
      while P /= null loop
         Item'Write (Stream, P.Data);
         P := P.Next;
      end loop;
   end Write;

   procedure Read
     (Stream    : access Ada.Streams.Root_Stream_Type'Class;
      Container :    out Simple_Container)
   is
   begin
      Reset (Container);
      declare
         N : Natural;
      begin
         Natural'Read (Stream, N);
         while N > 0 loop
            declare
               Data : Item;
            begin
               Item'Read (Stream, Data);
               Add (Data, Container);
            end;
            N := N - 1;
         end loop;
      end;
   end Read;

end GAL.Containers.Simple;
