----------------------------------------------------------------------
-- Copyright 1987 by the Swiss Federal Institute of Technology (EPFL),
-- Prof. A. Strohmeier, EPFL-DI-LGL, CH-1015 Lausanne, Switzerland.
----------------------------------------------------------------------
-- Title : Generic Package for Sets.
-- Revision : 13-Jul-1992 Ph. Kipfer (PKR), File header format
-- Approval : 02-Dec-1987 C. Genillard.
-- Creation : 31-Aug-1987 A. Strohmeier.
generic
type Item_Type is (<>); -- type of the elements in the sets.
package Set_Of_Discrete_Items_G is
-- OVERVIEW:
-- This package provides sets of elements of type ITEM_TYPE, where ITEM_TYPE
-- is specified by a generic parameter.
-- The type SET_TYPE is implemented in such a way that every object has the
-- initial value of an empty set.
-- If ITEM_TYPE is a discrete type of small size, use of the package
-- SET_OF_DISCRETE_ITEMS_G is recommended.
-- The other forms of the abstract data type provide sets of unlimited
-- dynamic size.
-- In our terminology, a static type is a type which is neither a limited
-- type nor an access type. When an actual generic access type is associated
-- with a generic static type, objects would be shared, i.e. only the access
-- value would be stored, without copying the accessed object.
-- On the opposite, a dynamic type may be limited or an access type. However
-- a dynamic type must have the feature that every object has an implied
-- initial value.
-- Depending on the very nature of the type ITEM_TYPE, one of the following
-- packages has to be used for sets of dynamic size:
-- SET_OF_STATIC_ITEMS_G
-- SET_OF_DYNAMIC_ITEMS_G
--
-- PRIMITIVES:
-- CONSTRUCTORS:
-- TO_SET
-- SET_FROM_RANGE
-- ASSIGN
-- DESTROY
-- ADD
-- INSERT (2)
-- DELETE
-- REMOVE (2)
-- REMOVE_MIN (2)
-- REMOVE_MAX (2)
-- QUERIES:
-- SIZE
-- IS_EMPTY
-- IS_FULL
-- IS_PRESENT
-- MIN
-- GET_MIN
-- MAX
-- GET_MAX
-- LESS
-- GET_LESS (2)
-- LESS_OR_EQUAL
-- GET_LESS_OR_EQUAL (2)
-- GREATER
-- GET_GREATER (2)
-- GREATER_OR_EQUAL
-- GET_GREATER_OR_EQUAL (2)
-- SET OPERATIONS:
-- COMPLEMENT (2)
-- "-" (unary)
-- "not"
-- UNION (2)
-- "+"
-- "or"
-- INTERSECTION (2)
-- "*"
-- "and"
-- DIFFERENCE (2)
-- "-" (binary)
-- SYMMETRIC_DIFFERENCE (2)
-- "xor"
-- "<" (strict set inclusion)
-- "<=" (set inclusion)
-- ">=" (set inclusion)
-- ">" (strict set inclusion)
-- ITERATORS:
-- TRAVERSE_ASC_G
-- TRAVERSE_DESC_G
--
-- ALGORITHM:
-- A set object is a record whose only component is an array of bits.
type Set_Type is private;
type List_Type is array (Positive range <>) of Item_Type;
-- provides an aggregate like notation for constant sets.
Full_Set, Empty_Set: constant Set_Type;
Duplicate_Item_Error: exception;
Missing_Item_Error: exception;
Empty_Structure_Error: exception;
-- raised when search for MIN or MAX of an empty set.
--/ CONSTRUCTORS:
function To_Set (List: List_Type) return Set_Type;
pragma Inline (To_Set);
function Set_From_Range (Lower_Bound, Upper_Bound: Item_Type) return Set_Type;
-- OVERVIEW:
-- Build the set of all items between LOWER_BOUND and UPPER_BOUND. If
-- LOWER_BOUND > UPPER_BOUND then the set will be empty.
procedure Assign (Destination: out Set_Type;
Source: in Set_Type);
pragma Inline (Assign);
-- OVERVIEW:
-- Copies SOURCE into DESTINATION.
procedure Destroy (Set: in out Set_Type);
pragma Inline (Destroy);
-- OVERVIEW:
-- Empties the SET.
procedure Add (Set: in out Set_Type;
Item: in Item_Type);
pragma Inline (Add);
-- OVERVIEW:
-- Inserts ITEM into SET. No action is taken and no error occurs, if
-- ITEM is already in SET.
procedure Insert (Set: in out Set_Type;
Item: in Item_Type);
-- OVERVIEW:
-- Inserts ITEM into SET.
-- ERROR:
-- If ITEM is already in SET, the exception DUPLICATE_ITEM_ERROR is raised.
procedure Insert (Set: in out Set_Type;
Item: in Item_Type;
Duplicate_Item: out Boolean);
-- OVERVIEW:
-- Inserts ITEM into SET. No action is taken and no error occurs if ITEM
-- is already in SET, except that DUPLICATE_ITEM is set to true.
procedure Delete (Set: in out Set_Type; Item: in Item_Type);
pragma Inline (Delete);
-- OVERVIEW:
-- Removes ITEM from SET. No action is taken and no error occurs, if ITEM
-- is not in SET.
procedure Remove (Set: in out Set_Type; Item: in Item_Type);
-- OVERVIEW:
-- Removes ITEM from SET.
-- ERROR:
-- If ITEM is not in SET, the exception MISSING_ITEM_ERROR is raised.
procedure Remove (Set: in out Set_Type;
Item: in Item_Type;
Found: out Boolean);
-- OVERVIEW:
-- Removes ITEM from SET. No action is taken and no error occurs if ITEM
-- is not in SET, except that FOUND is set to false.
procedure Remove_Min (Set: in out Set_Type);
procedure Remove_Min (Set: in out Set_Type;
Item: out Item_Type);
-- OVERVIEW:
-- Returns the smallest item in SET and removes it from SET.
-- ERROR:
-- The exception EMPTY_STRUCTURE_ERROR is raised if the SET is empty.
procedure Remove_Max (Set: in out Set_Type);
procedure Remove_Max (Set: in out Set_Type;
Item: out Item_Type);
-- OVERVIEW:
-- Returns the greatest item in SET and removes it from SET.
-- ERROR:
-- The exception EMPTY_STRUCTURE_ERROR is raised if the SET is empty.
--/ QUERIES:
function Size (Set: Set_Type) return Natural;
-- OVERVIEW:
-- Returns the number of items currently in SET.
function Is_Empty (Set: Set_Type) return Boolean;
-- OVERVIEW:
-- Test for the empty set.
function Is_Full (Set: Set_Type) return Boolean;
-- OVERVIEW:
-- Test for the full set.
function Is_Present (Set: Set_Type; Item: Item_Type) return Boolean;
-- OVERVIEW:
-- Membership test.
function Min (Set: Set_Type) return Item_Type;
procedure Get_Min (Set: in Set_Type; Item: out Item_Type);
-- OVERVIEW:
-- Gets the first (smallest) item in SET, without removing it.
-- ERROR:
-- The exception EMPTY_STRUCTURE_ERROR is raised if the SET is empty.
function Max (Set: Set_Type) return Item_Type;
procedure Get_Max (Set: in Set_Type; Item: out Item_Type);
-- OVERVIEW:
-- Gets the last (greatest) item in SET, without removing it.
-- ERROR:
-- The exception EMPTY_STRUCTURE_ERROR is raised if the SET is empty.
function Less (Set: Set_Type; Item: Item_Type) return Item_Type;
procedure Get_Less (Set: in Set_Type; Item: in out Item_Type);
-- OVERVIEW:
-- Returns the item having the greatest value less than the value of
-- the actual parameter ITEM.
-- ERROR:
-- The exception MISSING_ITEM_ERROR is raised if there is not such
-- an item in the SET.
procedure Get_Less (Set: in Set_Type;
Item: in out Item_Type;
Found: out Boolean);
-- OVERVIEW:
-- Returns the item having the greatest value less than the value of
-- the actual parameter ITEM. FOUND is set to TRUE or FALSE depending on
-- success of search.
function Less_Or_Equal (Set: Set_Type; Item: Item_Type) return Item_Type;
procedure Get_Less_Or_Equal (Set: in Set_Type;
Item: in out Item_Type);
-- OVERVIEW:
-- Returns the item having the greatest value less than or equal to
-- the value of the actual parameter ITEM.
-- ERROR:
-- The exception MISSING_ITEM_ERROR is raised if there is not such
-- an item in the SET.
procedure Get_Less_Or_Equal (Set: in Set_Type;
Item: in out Item_Type;
Found: out Boolean);
-- OVERVIEW:
-- Returns the item having the greatest value less than or equal to
-- the value of the actual parameter ITEM. FOUND is set to TRUE or FALSE
-- depending on success of search.
function Greater (Set: Set_Type; Item: Item_Type) return Item_Type;
procedure Get_Greater (Set: in Set_Type; Item: in out Item_Type);
-- OVERVIEW:
-- Returns the item having the smallest value greater than the value of
-- the actual parameter ITEM.
-- ERROR:
-- The exception MISSING_ITEM_ERROR is raised if there is not such
-- an item in the SET.
procedure Get_Greater (Set: in Set_Type;
Item: in out Item_Type;
Found: out Boolean);
-- OVERVIEW:
-- Returns the item having the smallest value greater than the value of
-- the actual parameter ITEM. FOUND is set to TRUE or FALSE depending on
-- success of search.
function Greater_Or_Equal (Set: Set_Type; Item: Item_Type) return Item_Type;
procedure Get_Greater_Or_Equal (Set: in Set_Type;
Item: in out Item_Type);
-- OVERVIEW:
-- Returns the item having the smallest value greater than or equal to
-- the value of the actual parameter ITEM.
-- ERROR:
-- The exception MISSING_ITEM_ERROR is raised if there is not such
-- an item in the SET.
procedure Get_Greater_Or_Equal (Set: in Set_Type;
Item: in out Item_Type;
Found: out Boolean);
-- OVERVIEW:
-- Returns the item having the smallest value greater than or equal
-- to the value of the actual parameter ITEM. FOUND is set to TRUE or FALSE
-- depending on success of search.
--/ SET OPERATIONS:
procedure Complement (Destination: out Set_Type; Source: in Set_Type);
function Complement (Set: Set_Type) return Set_Type;
function "-" (Set: Set_Type) return Set_Type renames Complement;
function "not" (Set: Set_Type) return Set_Type renames Complement;
pragma Inline (Complement);
-- OVERVIEW:
-- Complement, unary "-".
procedure Union (Destination: out Set_Type;
Left,
Right: in Set_Type);
function Union (Left, Right: Set_Type) return Set_Type;
function "+" (Left, Right: Set_Type) return Set_Type renames Union;
function "or" (Left, Right: Set_Type) return Set_Type renames Union;
pragma Inline (Union);
-- OVERVIEW:
-- Union.
procedure Intersection (Destination: out Set_Type;
Left,
Right: in Set_Type);
function Intersection (Left, Right: Set_Type) return Set_Type;
function "*" (Left, Right: Set_Type) return Set_Type renames Intersection;
function "and" (Left, Right: Set_Type) return Set_Type renames Intersection;
pragma Inline (Intersection);
-- OVERVIEW:
-- Intersection.
procedure Difference (Destination: out Set_Type;
Left,
Right: in Set_Type);
function Difference (Left, Right: Set_Type) return Set_Type;
function "-" (Left, Right: Set_Type) return Set_Type renames Difference;
pragma Inline (Difference);
-- OVERVIEW:
-- Set difference. An item is in DESTINATION if it is in LEFT but not in
-- RIGHT.
procedure Symmetric_Difference (Destination: out Set_Type;
Left,
Right: in Set_Type);
function Symmetric_Difference (Left, Right: Set_Type) return Set_Type;
function "xor" (Left, Right: Set_Type) return Set_Type
renames Symmetric_Difference;
pragma Inline (Symmetric_Difference);
-- OVERVIEW:
-- Symmetric set difference. An item is in DESTINATION if it is in LEFT
-- but not in RIGHT or if it is in RIGHT but not in LEFT.
function "<" (Left: Set_Type; Right: Set_Type) return Boolean;
pragma Inline ("<");
-- OVERVIEW:
-- Strict inclusion of LEFT in RIGHT.
function "<=" (Left: Set_Type; Right: Set_Type) return Boolean;
pragma Inline ("<=");
-- OVERVIEW:
-- Inclusion of LEFT in RIGHT.
function ">=" (Left: Set_Type; Right: Set_Type) return Boolean;
pragma Inline (">=");
-- OVERVIEW:
-- Inclusion of RIGHT in LEFT .
function ">" (Left: Set_Type; Right: Set_Type) return Boolean;
pragma Inline (">");
-- OVERVIEW:
-- Strict inclusion of RIGHT in LEFT .
--/ ITERATORS:
generic
with procedure Action (Item: in Item_Type;
Order_Number: in Positive;
Continue: in out Boolean);
procedure Traverse_Asc_G (Set: in Set_Type);
-- OVERVIEW:
-- Applies procedure ACTION on each ITEM of the SET, traversing it in
-- ascending order. ORDER_NUMBER is the order of ITEM within SET. The
-- boolean CONTINUE specifies if you want to proceed to the next item or if
-- you want to stop traversing. As long as you do not modify its value
-- within ACTION, its value remains TRUE.
-- REQUIREMENT:
-- For your actual procedure ACTION, you must not use a procedure
-- which modifies the traversed set.
generic
with procedure Action (Item: in Item_Type;
Order_Number: in Positive;
Continue: in out Boolean);
procedure Traverse_Desc_G (Set: in Set_Type);
-- OVERVIEW:
-- Applies procedure ACTION on each ITEM of the SET, traversing it in
-- descending order. ORDER_NUMBER is the order of ITEM within SET. The
-- boolean CONTINUE specifies if you want to proceed to the next item or if
-- you want to stop traversing. As long as you do not modify its value
-- within ACTION, its value remains TRUE.
-- REQUIREMENT:
-- For your actual procedure ACTION, you must not use a procedure
-- which modifies the traversed set.
private
type Table_Type is array (Item_Type) of Boolean;
type Set_Type is record
Table: Table_Type := (others => False);
end record;
Full_Set: constant Set_Type := (Table => (others => True));
Empty_Set: constant Set_Type := (Table => (others => False));
-- named notation is required: LRM 4.3 (4)
end Set_Of_Discrete_Items_G;