------------------------------------------------------------------------------ ------------------------------------------------------------------------------ -- 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-2016, Frank Singhoff, Alain Plantec, Jerome Legrand -- -- The Cheddar project was started in 2002 by -- Frank Singhoff, Lab-STICC UMR 6285 laboratory, 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: 1249 $ -- $Date: 2014-08-28 07:02:15 +0200 (Fri, 28 Aug 2014) $ -- $Author: singhoff $ ------------------------------------------------------------------------------ ------------------------------------------------------------------------------ with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; with Ada.Finalization; with Ada.Numerics.Discrete_Random; generic max_element : Natural := 100; type element is private; with procedure put (a_element : in element); with procedure free (a_element : in out element); with function copy (e_lement : in element) return element; with function xml_string (e : in element) return Unbounded_String; with function xml_ref_string (E : in element) return Unbounded_String; package sets is type set is tagged private; type iterator is private; type iterator_ptr is access iterator; type element_range is new Natural range 0 .. max_element; type element_range_ptr is access element_range; type set_ptr is access all set'Class; package rand is new Ada.Numerics.Discrete_Random (element_range); use rand; G : Generator; invalid_argument : exception; element_not_found : exception; full_set : exception; empty_set : exception; procedure initialize (my_set : in out set); -- Initialize "My_Set" to 0 elements -- If "Free_Object" is true, release memory -- of all objects stored in the set -- procedure reset (my_set : in out set; free_object : in Boolean := False); -- Release memory of the set -- If "Free_Object" is true, also release -- memory of elements stored in the set -- procedure free (my_set : in out set_ptr; free_object : in Boolean := True); -- Release memory of all elements stored in the -- set -- procedure free (my_set : in out set); -- Release memory of Set.Container -- procedure free_container(my_set : in out set); -- Put a set to the screen -- procedure put (my_set : in set); procedure put (my_set : in set_ptr); -- Export the data to XML stream -- function xml_string (my_set : in set) return Unbounded_String; function xml_string (my_set : in set_ptr) return Unbounded_String; function xml_root_string (My_Set : in set) return Unbounded_String; function xml_root_string (My_Set : in set_ptr) return Unbounded_String; -- Copy all elements of Src into Dest -- procedure duplicate (src : in set; dest : in out set); -- Copy elements of Src into dest -- when elements are selected with according to -- "Must_Select" into Dest -- type select_function is access function (op1 : in element) return Boolean; type select_function_parameterizable is access function (op1 : in element; op2 : in element) return Boolean; procedure select_and_copy (src : in set; dest : in out set; must_select : select_function); function select_and_copy (src : in set; must_select : select_function) return set; procedure select_and_copy (src : in set; dest : in out set; must_select : select_function_parameterizable; parameter : element); function select_and_copy (src : in set; must_select : in select_function_parameterizable; parameter : element) return set; -- Add into the set "My_Set" the element "A_element" -- procedure add (my_set : in out set; a_element : in element); -- Delete from "My_Set" the element "A_element" -- procedure delete (my_set : in out set; a_element : in element; free_object : in Boolean := False); -- From from "My_Set" all elements stored in "Elements" -- procedure delete (my_set : in out set; elements : in set; free_object : in Boolean := False); ----------------------------------------------- -- Theses functions/procedures can be used to -- scan a set ----------------------------------------------- -- Lets go to the next element of the set -- procedure next_element (my_set : in set; my_iterator : in out iterator); -- Lets go to the previous element of the set -- procedure Previous_Element (My_Set : in Set; My_Iterator : in out Iterator); -- Get the element currently pointed by -- the iterator -- procedure current_element (my_set : in set; return_element : out element; my_iterator : in iterator); -- Get the element at a position -- procedure get_element_number (my_set : in set; return_element : out element; position : in element_range); -- Reset the iterator, point to the first element of a set -- procedure reset_iterator (my_set : in set; my_iterator : in out iterator); --Reset the iterator point to the last element of a set -- procedure Reset_Tail_Iterator (My_Set : in Set; My_Iterator : in out Iterator); --Get the number of elements of a set. -- function get_number_of_elements (my_set : in set) return element_range; function is_empty (my_set : in set) return Boolean; function is_last_element (my_set : in set; my_iterator : in iterator) return Boolean; function is_first_element (my_set : in set; my_iterator : in iterator) return Boolean; function get_random_element (my_set : in set) return element; -- Sort utilitiy. The "order_function" return -- if op1 and op2 are not n the right order -- type order_function is access function (op1 : in element; op2 : in element) return Boolean; procedure sort (my_set : in out set; order : order_function); procedure swap (my_set : in out set; i : in Iterator; j : in Iterator); private type element_table is array (element_range) of element; type element_table_ptr is access element_table; type set is new Ada.Finalization.Controlled with record number_of_elements : element_range := 0; container : element_table_ptr; end record; type iterator is record current : element_range := element_range'First; end record; pragma Inline (current_element); pragma Inline (next_element); pragma Inline (is_last_element); end sets;