----------------------------------------------------------------------------- -- PACKAGE BODY: -- Array_Sets -- AUTHOR: -- Yoav Tzruya -- IMPLEMENTATION NOTES: -- The set here is implemented by array of elements - dynamically sized -- to fit the needs of the set. -- I use a controlled type to be in charge of the memory allocation for -- the instantiations of this type. ----------------------------------------------------------------------------- -- ** BODY IMPORTS ** with Ada.Unchecked_Deallocation; package body Array_Sets is type Set_Ptr is access Set; -- ** INTERNAL SUBPROGRAMS ** -- Discard an unused array of elements Procedure Discard is new Ada.Unchecked_Deallocation ( Object => Element_Array, Name => Access_Element_Array); -- check if an element exist in a (slice of) array function In_Array ( element_arg : in Set_Element; element_array_arg : in Element_Array; last_arg : in integer) return boolean is begin -- In_Array for i in element_array_arg'first .. last_arg loop if element_array_arg(i) = element_arg then return true; end if; end loop; return false; end In_Array; -- check if element is in the set function In_Set ( element_arg : in Set_Element; set_arg : in Set) return boolean is begin -- In_Set if set_arg.elements = null then return false; end if; return In_Array ( element_arg => element_arg, element_array_arg => set_arg.elements.all, last_arg => set_arg.elements.all'last); end In_Set; function Build_Set ( element_array_arg : in element_array; num_of_elements_arg : in integer) return Set is returned_set : Set_Ptr; begin if num_of_elements_arg = 0 then return Empty; else returned_set := new Set; returned_set.elements := new element_array(1 .. num_of_elements_arg); returned_set.elements.all(returned_set.elements.all'range) := element_array_arg (element_array_arg'first .. element_array_arg'first+num_of_elements_arg-1); return returned_set.all; end if; end Build_Set; -- return the number of elements in a set function number_of_elements ( set_arg : in Set) return integer is begin -- number_of_elements if set_arg.elements = null then return 0; else return set_arg.elements.all'length; end if; end number_of_elements; -- ** EXPORTED SUBPROGRAMS ** function Empty return Set is returned_set : set_ptr := new Set; begin -- Empty returned_set.all := ( Abstract_Set_Handling.Set with elements => null); return returned_set.all; end Empty; function Unit ( Element : in Set_Element) return Set is returned_set : Set_ptr := new Set; begin -- Unit returned_set.all := ( Abstract_Set_Handling.Set with elements => new element_array (1 .. 1)); returned_set.elements.all := (others => element); return returned_set.all; end Unit; function Union ( Left : in Set; Right : in Set) return Set is actual_number_of_elements : integer := 0; storing_array : element_array(1 .. number_of_elements(Left)+ number_of_elements(Right)); begin -- Union if Left.elements /= null then actual_number_of_elements := number_of_elements(Left); storing_array (1 .. actual_number_of_elements) := Left.elements.all (Left.elements.all'range); if Right.elements /= null then for i in Right.elements.all'range loop if not In_Array ( element_arg => Right.elements.all(i), element_array_arg => storing_array, last_arg => actual_number_of_elements) then actual_number_of_elements := actual_number_of_elements + 1; storing_array (actual_number_of_elements) := Right.elements.all(i); end if; end loop; end if; elsif Right.elements /= null then actual_number_of_elements := number_of_elements(Right); storing_array (1 .. actual_number_of_elements) := Right.elements.all (Right.elements.all'range); end if; return Build_Set ( num_of_elements_arg => actual_number_of_elements, element_array_arg => storing_array); end Union; function Intersection ( Left : in Set; Right : in Set) return Set is max_number_of_elements : constant integer := integer'min( number_of_elements(Left), number_of_elements(Right)); actual_number_of_elements : integer := 0; storing_array : element_array(1 .. max_number_of_elements); returned_set : Set_ptr := new Set; begin -- Intersection if Left.elements /= null and Right.elements /= null then for i in Left.elements.all'range loop if In_Set ( set_arg => Right, element_arg => Left.elements.all(i)) then actual_number_of_elements := actual_number_of_elements + 1; storing_array(actual_number_of_elements) := Left.elements.all(i); end if; end loop; end if; return Build_Set ( num_of_elements_arg => actual_number_of_elements, element_array_arg => storing_array); end Intersection; procedure Take ( From : in out Set; Element : out Set_Element) is old_elements : access_element_array := From.elements; begin -- Take if From.elements = null then raise set_is_empty_exception; else Element := From.elements.all(old_elements.all'last); if old_elements.all'length=1 then From.elements := null; else From.elements := new element_array ( old_elements.all'first .. old_elements.all'last - 1); From.elements.all(From.elements.all'range) := old_elements.all (old_elements.all'first .. old_elements.all'last - 1); end if; end if; end Take; function to_String ( set_arg : in Set) return String is begin -- to_String return Abstract_Set_Handling.to_String ( set_arg => set_arg); end to_String; procedure Adjust (Object : in out Set) is old_elements : access_element_array; begin -- Adjust if Object.elements = null then return; end if; old_elements := Object.elements; Object.elements := new Element_Array (old_elements.all'range); Object.elements.all (Object.elements.all'range) := old_elements.all(old_elements.all'range); end Adjust; procedure Finalize (Object : in out Set) is begin -- Finalize discard (object.elements); end Finalize; end Array_Sets;