------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Cheddar is a GNU GPL real time scheduling analysis tool.
-- This program provides services to automatically check performances
-- of real time architectures.
--
-- Copyright (C) 2002-2010,  by Frank Singhoff, Alain Plantec, Jerome Legrand
--
-- The Cheddar project was started in 2002 by
-- the LISyC Team, University of Western Britanny.
--
-- Since 2008, Ellidiss technologies also contributes to the development of
-- Cheddar and provides industrial support.
--
-- This program 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 of the License, or
-- (at your option) any later version.
--
-- This program 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
-- along with this program; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--
--
-- Contact : cheddar@listes.univ-brest.fr
--
-----------------------------------------------------------------------------
-- Last update :
--    $Rev: 541 $
--    $Date: 2012-10-08 22:23:24 +0200 (Mon, 08 Oct 2012) $
--    $Author: singhoff $
------------------------------------------------------------------------------
------------------------------------------------------------------------------
with Text_IO; use Text_IO;
with Unchecked_Deallocation;
with Ada.Numerics;
with Ada.Numerics.Discrete_Random;

package body Sets is

   procedure Reset (My_Set : in out Set; Free_Object : in Boolean := False) is
   begin
      if Free_Object then
         Free (My_Set);
      end if;
      My_Set.Number_Of_Elements := 0;
   end Reset;

   procedure Free (My_Set : in out Set) is

   begin
      for I in 0 .. My_Set.Number_Of_Elements - 1 loop
         Free (My_Set.Container (I));
      end loop;
   end Free;

   procedure Free
     (My_Set      : in out Set_Ptr;
      Free_Object : in Boolean := True)
   is

      procedure Free_Pointer is new Unchecked_Deallocation (
         Set'Class,
         Set_Ptr);

   begin
      if Free_Object then
         for I in 0 .. My_Set.Number_Of_Elements - 1 loop
            Free (My_Set.Container (I));
         end loop;
      end if;
      Free_Pointer (My_Set);
   end Free;

   procedure Initialize (My_Set : in out Set) is
   begin
      My_Set.Container := new Element_Table;
      Reset (My_Set);
   end Initialize;

   procedure Add (My_Set : in out Set; A_Element : in Element) is
   begin

      if (My_Set.Number_Of_Elements = Element_Range (Max_Element)) then
         raise Full_Set;
      end if;

      My_Set.Container (My_Set.Number_Of_Elements) := A_Element;
      My_Set.Number_Of_Elements                    :=
        My_Set.Number_Of_Elements + 1;
   end Add;

   procedure Delete
     (My_Set      : in out Set;
      Elements    : in Set;
      Free_Object : in Boolean := False)
   is

   begin

      if (My_Set.Number_Of_Elements = 0) then
         raise Empty_Set;
      end if;

      for I in 0 .. Elements.Number_Of_Elements - 1 loop
         Delete (My_Set, Elements.Container (I), Free_Object);
      end loop;

   end Delete;

   procedure Delete
     (My_Set      : in out Set;
      A_Element   : in Element;
      Free_Object : in Boolean := False)
   is

      Found : Boolean := False;
   begin

      if (My_Set.Number_Of_Elements = 0) then
         raise Empty_Set;
      end if;

      for I in 0 .. (My_Set.Number_Of_Elements - 1) loop
         if (A_Element = My_Set.Container (I)) then
            if Free_Object then
               Free (My_Set.Container (I));
            end if;
            My_Set.Container (I)      :=
              My_Set.Container (My_Set.Number_Of_Elements - 1);
            My_Set.Number_Of_Elements := My_Set.Number_Of_Elements - 1;
            Found                     := True;
            exit;
         end if;
      end loop;
      if not Found then
         raise Element_Not_Found;
      end if;
   end Delete;

   procedure Next_Element (My_Set : in Set; My_Iterator : in out Iterator) is
   begin
      if (My_Set.Number_Of_Elements = 0) then
         raise Empty_Set;
      end if;

      My_Iterator.Current := My_Iterator.Current + 1;

   end Next_Element;

   procedure Current_Element
     (My_Set         : in Set;
      Return_Element : out Element;
      My_Iterator    : in Iterator)
   is
   begin
      if (My_Set.Number_Of_Elements = 0) then
         raise Empty_Set;
      end if;

      Return_Element := My_Set.Container (My_Iterator.Current);
   end Current_Element;

   procedure Get_Element_Number
     (My_Set         : in Set;
      Return_Element : out Element;
      Position       : in Element_Range)
   is
   begin
      if (My_Set.Number_Of_Elements <= Position or Position < 0) then
         raise Invalid_Argument;
      end if;

      Return_Element := My_Set.Container (Position);

   end Get_Element_Number;

   function Get_Number_Of_Elements (My_Set : in Set) return Element_Range is
   begin
      return (My_Set.Number_Of_Elements);
   end Get_Number_Of_Elements;

   function Is_Empty (My_Set : in Set) return Boolean is
   begin
      return (My_Set.Number_Of_Elements = 0);
   end Is_Empty;

   function Is_Last_Element
     (My_Set      : in Set;
      My_Iterator : in Iterator)
      return        Boolean
   is
   begin
      return (My_Iterator.Current = (My_Set.Number_Of_Elements - 1));
   end Is_Last_Element;

   function Is_First_Element
     (My_Set      : in Set;
      My_Iterator : in Iterator)
      return        Boolean
   is
   begin
      return (My_Iterator.Current = 0);
   end Is_First_Element;

   procedure Reset_Iterator
     (My_Set      : in Set;
      My_Iterator : in out Iterator)
   is
   begin
      My_Iterator.Current := 0;
   end Reset_Iterator;

   procedure Sort (My_Set : in out Set; Order : Order_Function) is

      Temp : Element;

   begin
      for I in 0 .. My_Set.Number_Of_Elements - 1 loop
         for J in 0 .. (My_Set.Number_Of_Elements - 2) loop
            if not Order
                     (My_Set.Container (J),
                      My_Set.Container (J + 1))
            then
               Temp                     := My_Set.Container (J);
               My_Set.Container (J)     := My_Set.Container (J + 1);
               My_Set.Container (J + 1) := Temp;
            end if;
         end loop;
      end loop;
   end Sort;

   procedure Select_And_Copy
     (Src         : in Set;
      Dest        : in out Set;
      Must_Select : Select_Function)
   is

      Tmp : Element;
   begin
      for I in 0 .. Src.Number_Of_Elements - 1 loop
         if Must_Select (Src.Container (I)) then
            Tmp := Copy (Src.Container (I));
            Add (Dest, Tmp);
         end if;
      end loop;
   end Select_And_Copy;

 function  Select_And_Copy
     (Src         : in Set;
      Must_Select : in Select_Function)
    return Set
   is
      Dest : Set;
      Tmp : Element;
   begin
      for I in 0 .. Src.Number_Of_Elements - 1 loop
         if Must_Select (Src.Container (I)) then
            Tmp := Copy (Src.Container (I));
            Add (Dest, Tmp);
         end if;
      end loop;
	return Dest;
   end Select_And_Copy;

  procedure Select_And_Copy
     (Src         : in Set;
      Dest        : in out Set;
      Must_Select : Select_Function_parameterizable;
      Parameter : Element)
   is

      Tmp : Element;
   begin
      for I in 0 .. Src.Number_Of_Elements - 1 loop
         if Must_Select (Src.Container (I), Parameter) then
            Tmp := Copy (Src.Container (I));
            Add (Dest, Tmp);
         end if;
      end loop;
   end Select_And_Copy;

   function Select_And_Copy
     (Src         : in Set;
      Must_Select : Select_Function_parameterizable;
      Parameter : Element)
    return Set
   is
      Dest : Set;
      Tmp : Element;
   begin
      for I in 0 .. Src.Number_Of_Elements - 1 loop
         if Must_Select (Src.Container (I), Parameter) then
            Tmp := Copy (Src.Container (I));
            Add (Dest, Tmp);
         end if;
      end loop;
	return Dest;
   end Select_And_Copy;


   procedure Duplicate (Src : in Set; Dest : in out Set) is

      Tmp : Element;
   begin
      Dest.Number_Of_Elements := Src.Number_Of_Elements;
      for I in 0 .. Src.Number_Of_Elements - 1 loop
         Tmp                := Copy (Src.Container (I));
         Dest.Container (I) := Tmp;
      end loop;
   end Duplicate;

   function xml_string (My_Set : in Set_ptr)
        return unbounded_string is
begin
	return xml_string(my_set.all);
end xml_string;


   function xml_root_string (My_Set : in Set_ptr)
        return unbounded_string is
begin
	return xml_root_string(my_set.all);
end xml_root_string;


   function xml_root_string (My_Set : in Set)
        return unbounded_string is
str : unbounded_string := to_unbounded_string("");
begin
      for I in 0 .. My_Set.Number_Of_Elements - 1 loop
         str := str & xml_string (My_Set.Container (I));
      end loop;
	return str;
end xml_root_string;



   function xml_string (My_Set : in Set)
        return unbounded_string is
str : unbounded_string := to_unbounded_string("");
begin
      for I in 0 .. My_Set.Number_Of_Elements - 1 loop
         str := str & xml_ref_string (My_Set.Container (I));
      end loop;
	return str;
end xml_string;

   procedure Put (My_Set : in Set_ptr) is
begin
	put(my_set.all);
end put;

   procedure Put (My_Set : in Set) is
   begin
      Put_Line ("Number of elements : " & My_Set.Number_Of_Elements'Img);
      New_Line;
      for I in 0 .. My_Set.Number_Of_Elements - 1 loop
         Put (My_Set.Container (I));
         New_Line;
      end loop;
   end Put;

   function get_random_element(My_set : in Set) return Element is
      P : Element_range;
   begin
      P := Random(G) mod My_Set.Number_of_Elements;
      return My_Set.Container(P);
   end get_random_element;

begin
   Reset(G);
end Sets;