------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Cheddar is a GNU GPL real-time scheduling analysis tool.
-- This program provides services to automatically check schedulability and
-- other performance criteria of real-time architecture models.
--
-- Copyright (C) 2002-2020, Frank Singhoff, Alain Plantec, Jerome Legrand,
--                          Hai Nam Tran, Stephane Rubini
--
-- The Cheddar project was started in 2002 by 
-- Frank Singhoff, Lab-STICC UMR 6285, Université de Bretagne Occidentale
-- 
-- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008. 
-- Since 2008, Ellidiss technologies also contributes to the development of 
-- Cheddar and provides industrial support.
--
-- The full list of contributors and sponsors can be found in AUTHORS.txt and SPONSORS.txt
--
-- 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$
--    $Date$
--    $Author: singhoff $
------------------------------------------------------------------------------
------------------------------------------------------------------------------

with Ada.Text_IO;		use Ada.Text_IO;
with Strings;               	use Strings;
with Ada.Strings.Unbounded; 	use Ada.Strings.Unbounded;
with Ada.Strings;		use Ada.Strings;
with Ada.Unchecked_Deallocation;
with GNAT.String_Split;


package body Integer_Arrays is

   procedure Initialize (arr : in out Integer_Array)
   is
   begin
      arr.Elements := new Integer_Arr(0..0);
      arr.Size := 0;
   end Initialize;

   procedure Initialize (arr 	   : in out Integer_Array;
                         Elements  : in STRING;
                         Separator : in STRING)
   is
      Subs : GNAT.String_Split.Slice_Set;
      Sub  : Unbounded_String;
   begin
      arr.Elements := new Integer_Arr(0..0);
      arr.Size := 0;

      GNAT.String_Split.Create (Subs, Elements, Separator, Mode => GNAT.String_Split.Multiple);
      for I in 1 .. GNAT.String_Split.Slice_Count (Subs) loop
         declare
            Sub : String := GNAT.String_Split.Slice (Subs, I);
         begin
            if(Sub'Length>0)then
               Add(arr,Integer'Value(Sub));
            end if;
         end;
      end loop;
   end Initialize;

   procedure Add
     (arr 	: in out Integer_Array;
      element 	: in Integer)
   is
      temp_arr 	: Integer_Array;
   begin

      if(arr.Size = 0) then
         arr.Size := arr.Size + 1;
         arr.Elements(0) := element;
      else
         temp_arr.Size := arr.Size+1;
         temp_arr.Elements := new Integer_Arr(0..temp_arr.Size);
         for i in 0..arr.Size-1 loop
            temp_arr.Elements(i) := arr.Elements(i);
         end loop;
         
         --TODO: Free the array when the feature with UCB-ECB analysis is fixed
         --Free(arr.Elements);

         temp_arr.Elements(temp_arr.Size-1) := element;
         arr := temp_arr;
      end if;
   end Add;

   procedure Add
     (arr 	: in out Integer_Array;
      element_identical : in Boolean;
      element 	: in Integer)
   is
      temp_arr 	: Integer_Array;
   begin

      if(element_identical) then
         for i in 0..arr.Size -1 loop
            if(element = arr.Elements(i)) then
               return;
            end if;
         end loop;
      end if;

      if(arr.Size = 0) then
         arr.Size := arr.Size + 1;
         arr.Elements(0) := element;
      else
         temp_arr.Size := arr.Size+1;
         temp_arr.Elements := new Integer_Arr(0..temp_arr.Size);
         for i in 0..arr.Size-1 loop
            temp_arr.Elements(i) := arr.Elements(i);
         end loop;

         Free(arr.Elements);

         temp_arr.Elements(temp_arr.Size-1) := element;
         arr := temp_arr;
      end if;
   end Add;

   function Copy
     (arr : in Integer_Array)
      return Integer_Array
   is
      arr_c : Integer_Array;
   begin
      Initialize(arr_c);
      for i in 0..arr.Size-1 loop
         Add(arr_c,arr.Elements(i));
      end loop;
      return arr_c;
   end Copy;
   
   procedure Remove
     (arr 	: in out Integer_Array;
      index 	: Integer)
   is
      temp_arr 	: Integer_Array;
   begin
      if(arr.Size > 1) then
         for i in index..arr.Size-2 loop
            arr.Elements(i) := arr.Elements(i+1);
         end loop;
         arr.Size := arr.Size -1;
      else
         arr.Size := 0;
      end if;
   end Remove;

   procedure Remove_By_Value
     (arr	: in out Integer_Array;
      value	: Integer)
   is
   begin
      for i in 0..arr.Size-1 loop
         if(arr.Elements(i) = value) then
            Remove(arr, i);
         end if;
      end loop;
   end Remove_By_Value;

   function Remove_By_Value
     (arr	: in out Integer_Array;
      value	: Integer)
      return Boolean
   is
   begin
      for i in 0..arr.Size-1 loop
         if(arr.Elements(i) = value) then
            Remove(arr, i);
            return true;
         end if;
      end loop;
      return false;
   end Remove_By_Value;

   procedure Union
     (arr_a	: in out Integer_Array;
      arr_b 	: in Integer_Array)
   is
      s_a, s_b	: Integer;
      flag	: boolean;
   begin
      s_a := arr_a.Size-1;
      s_b := arr_b.Size-1;
      
      for j in 0..s_b loop
         flag := true;
         for i in 0..s_a loop
            --Put_Line("s_a" & s_a'Img & " - s_b" & s_b'Img & " - i:" & i'Img & " - j:" & j'Img);
            --Print(arr_a);
            --Print(arr_b);
            if((arr_a.Elements(i) = arr_b.Elements(j)) or (arr_b.Elements(j) = -1)) then
               flag := false;
            end if;
         end loop;

         if(flag) then
            Add(arr     => arr_a,
                element => arr_b.Elements(j));
         end if;
      end loop;

   end Union;

   procedure Union
     (arr_a	: in Integer_Array;
      arr_b 	: in Integer_Array;
      arr_c	: out Integer_Array)
   is
      s_a, s_b	: Integer;
      flag	: boolean;
   begin
      arr_c.Elements := new Integer_Arr(0..0);
      arr_c.Size := 0;

      s_a := arr_a.Size-1;
      s_b := arr_b.Size-1;

      for j in 0..s_a loop
         Add(arr_c, arr_a.Elements(j));
      end loop;

      for j in 0..s_b loop
         flag := true;
         for i in 0..s_a loop
            if((arr_a.Elements(i) = arr_b.Elements(j)) or (arr_b.Elements(j) = -1)) then
               flag := false;
            end if;
         end loop;

         if(flag) then
            Add(arr     => arr_c,
                element => arr_b.Elements(j));
         end if;
      end loop;
   end Union;

   procedure Intersect
     (arr_a	: in Integer_Array;
      arr_b 	: in Integer_Array;
      arr_c	: out Integer_Array;
      n : out Integer)
   is
      flag : Boolean := false;
   begin
      n := 0;
      Initialize(arr_c);

      for i in 0 .. arr_a.Size-1 loop
         flag := false;
         for j in 0 .. arr_b.Size-1 loop
            if (arr_a.Elements(i) = arr_b.Elements(j) AND arr_a.Elements(i) > -1 AND To_Unbounded_String(arr_a.Elements(i)'Img) /= "") then
               flag := true;
            end if;
         end loop;

         if(flag)then
            Integer_Arrays.Add(arr     => arr_c,
                              element => arr_a.Elements(i));
              n := n+1;
         end if;
      end loop;

   end Intersect;

   procedure Intersect
     (arr_a	: in Integer_Array;
      arr_b 	: in Integer_Array;
      n : out Integer)
   is
      flag : Boolean := false;
   begin
      n := 0;
      for i in 0 .. arr_a.Size-1 loop
         flag := false;
         for j in 0 .. arr_b.Size-1 loop
            if (arr_a.Elements(i) = arr_b.Elements(j) AND arr_a.Elements(i) > -1 AND To_Unbounded_String(arr_a.Elements(i)'Img) /= "") then
               flag := true;
            end if;
         end loop;

         if(flag)then
              n := n+1;
         end if;
      end loop;
   end Intersect;

   procedure Sort_DESC
     (arr_a	: in out Integer_Array)
   is
      finished : boolean;
      temp : integer;
   begin
      loop
         finished := true;
         for j in 0 .. arr_a.Size-2 loop
            if(arr_a.Elements(j+1) > arr_a.Elements(j)) then
               finished := false;
               temp := arr_a.Elements(j+1);
               arr_a.Elements(j+1) := arr_a.Elements(j);
               arr_a.Elements(j) := temp;
            end if;
         end loop;

         exit when finished;
      end loop;
   end Sort_DESC;

   procedure Sort_ASC
     (arr_a	: in out Integer_Array)
   is
      finished : boolean;
      temp : integer;
   begin
      loop
         finished := true;
         for j in 0 .. arr_a.Size-2 loop
            if(arr_a.Elements(j+1) < arr_a.Elements(j)) then
               finished := false;
               temp := arr_a.Elements(j+1);
               arr_a.Elements(j+1) := arr_a.Elements(j);
               arr_a.Elements(j) := temp;
            end if;
         end loop;

         exit when finished;
      end loop;
   end Sort_ASC;

   procedure Print(arr : in Integer_Array)
   is
   begin
      for i in 0..arr.Size-1 loop
         Put(arr.Elements(i)'Img);
      end loop;
      Put_Line("");
   end Print;

   procedure Put(arr : in Integer_Array)
   is
   begin
      for i in 0..arr.Size-1 loop
         Put(arr.Elements(i)'Img);
      end loop;
      Put_Line("");
   end Put;

   function XML_String (obj : in Integer_Array)
   return  Unbounded_String
   is
   begin
      return To_Unbounded_String("NOT IMPLEMENTED YET");
   end XML_String;

   procedure Free (arr : in out Integer_Array)
   is
   begin
      Free(arr.Elements);
      arr.Size := 0;
   end Free;

   function Occurrence(arr : in Integer_Array;
                       e   : in Integer)
                       return Integer
   is
      n : Integer := 0;
   begin
      for i in 0..arr.Size-1 loop
         if(arr.Elements(i) = e) then
            n := n+1;
         end if;
      end loop;
      return n;
   end Occurrence;

   function Multiset_Intersection (arr_a : in Integer_Array;
                                   arr_b : in Integer_Array)
                                   return Integer_Array
   is
      arr_c : Integer_Array;
      i, e, n_a, n_b : Integer;
   begin
      arr_c := Copy(arr_a);

      i := 0;
      while i < arr_c.Size loop         
         e := arr_c.Elements(i);
         n_a := Occurrence(arr_c,e);
         n_b := Occurrence(arr_b,e);
         --           Put_line("e:" & e'Img);
         --           Put_line("n_a: " & n_a'Img);
         --           Put_line("n_b: " & n_b'Img);
         --           Print(arr_c);
         --           Print(arr_b);

         if(n_a > n_b) then
            i := i;
         else
            i := i+1;
         end if;

         while (n_a > n_b) loop
            Remove_By_Value(arr_c,e);
            n_a := n_a - 1;
         end loop;

      end loop;

      return arr_c;
   end Multiset_Intersection;
   
end Integer_Arrays;