------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- 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;