----------------------------------------------------------------------
-- 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 : 22-Feb-1995 A. Pappas (AP)
-- because of Apex compiler:
-- o explicit procedure calls of Table_Of_Static_Keys
-- o type conversion of Set_Type to Table_Type, in
-- procedure calls of Table_Of_Static_Keys.
-- Approval : 03-Dec-1987 C. Genillard.
-- Creation : 31-Aug-1987 A. Strohmeier.
with Table_Of_Dynamic_Keys_And_Static_Values_G;
generic
type Item_Type is limited private;
-- Type of the items in the sets.
with function Less (Left, Right : Item_Type) return Boolean;
-- Defines ordering of items.
with function Equals (Left, Right : Item_Type) return Boolean;
-- Defines equality between items.
with procedure Assign (Destination : in out Item_Type;
Source : in Item_Type);
-- Assigns SOURCE to DESTINATION. If needed, DESTINATION has to be destroyed
-- before assignement, since ASSIGN is called without a previous call to
-- DESTROY in the implementation of the package.
with procedure Destroy (Item : in out Item_Type);
package Set_Of_Dynamic_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
-- implied 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.
-- Two items i1 and i2 are equal if and only if EQUALS (i1, i2). This
-- function therefore defines what we mean by saying "two items have same
-- value" or "an item in a set has same value as a given item".
-- A set cannot contain duplicate items.
-- The following consistency conditions must be fullfilled by the relational
-- operations LESS and EQUALS:
-- (i) EQUALS (i1, i2) implies not LESS (i1, i2) and not LESS (i2, i1)
-- (ii) not LESS (i1, i2) and not EQUALS (i1, i2) implies LESS (i2, i1)
-- 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:
-- ASSIGN
-- ADD
-- INSERT (2)
-- DELETE
-- REMOVE (2)
-- REMOVE_MIN (2)
-- REMOVE_MAX (2)
-- QUERIES:
-- SIZE
-- IS_EMPTY
-- 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:
-- SET_OPERATIONS_G
-- UNION
-- INTERSECTION
-- DIFFERENCE
-- SYMMETRIC_DIFFERENCE
-- "=" (set equality)
-- "<" (strict set inclusion)
-- "<=" (set inclusion)
-- ">" (strict set inclusion)
-- ">=" (set inclusion)
-- ITERATORS :
-- TRAVERSE_ASC_G
-- TRAVERSE_DESC_G
-- DISORDER_TRAVERSE_G
-- HEAP MANAGEMENT:
-- DESTROY
-- RELEASE_FREE_LIST
-- SET_MAX_FREE_LIST_SIZE
-- FREE_LIST_SIZE
--
-- ALGORITHM:
-- A set is implemented as a balanced search binary tree (AVL-tree)
-- using pointers. The items are sorted in the tree by increasing values
-- in conformance to inorder.
-- An internal free list is used to avoid returning each free item (i.e.
-- coming from REMOVE) to the system, so long as the length of this list does
-- not exceed MAX_FREE_LIST_SIZE, in which case the free item is immediately
-- returned to the system. When a new item has to be inserted (i.e. by a call
-- to INSERT), an element is recovered from the free list if it is not empty.
-- Otherwise, new space is taken from the system.
type Set_Type is limited private;
Duplicate_Item_Error : exception;
Missing_Item_Error : exception;
Empty_Structure_Error : exception;
-- raised when search for MIN or MAX of an empty set.
--/ CONSTRUCTORS:
procedure Assign (Destination : in out Set_Type; Source : in Set_Type);
-- OVERVIEW:
-- Begins by a call to DESTROY(DESTINATION) and then copies SOURCE into
-- DESTINATION. Note the "in out" mode of the formal parameter DESTINATION.
procedure Add (Set : in out Set_Type; Item : in Item_Type);
-- 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);
-- 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 : in out Item_Type);
-- OVERVIEW:
-- Returns the first (smallest) item in SET and removes this item
-- from the 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 : in out Item_Type);
-- OVERVIEW:
-- Returns the last (greatest) item in SET and removes this item
-- from the 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;
function Is_Present (Set : Set_Type; Item : Item_Type) return Boolean;
function Min (Set : Set_Type) return Item_Type;
procedure Get_Min (Set : in Set_Type; Item : in 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 : in 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:
generic
package Set_Operations_G is
procedure Union (Destination : in out Set_Type;
Left, Right : in Set_Type);
-- OVERVIEW:
-- Union of LEFT and RIGHT.
procedure Intersection (Destination : in out Set_Type;
Left, Right : in Set_Type);
-- OVERVIEW:
-- Intersection of LEFT and RIGHT.
procedure Difference (Destination : in out Set_Type;
Left, Right : in Set_Type);
-- OVERVIEW:
-- Set difference of LEFT and RIGHT. An item is in the resulting set
-- if it is in LEFT and not in RIGHT.
procedure Symmetric_Difference
(Destination : in out Set_Type; Left, Right : in Set_Type);
-- OVERVIEW:
-- Symmetric set difference of LEFT and RIGHT. An item is in the
-- resulting set if it is in LEFT and not in RIGHT or if it is in RIGHT
-- but not in LEFT.
function "=" (Left, Right : Set_Type) return Boolean;
-- OVERVIEW:
-- Set equality; the LEFT and RIGHT sets contain the same values.
function "<" (Left, Right : Set_Type) return Boolean;
-- OVERVIEW:
-- Strict set inclusion; to each item in the LEFT set an item with
-- same value is associated in the RIGHT set, but the two sets are not
-- identical.
function "<=" (Left, Right : Set_Type) return Boolean;
-- OVERVIEW:
-- Set inclusion; to each item in the LEFT set an item with same value
-- is associated in the RIGHT set.
function ">" (Left, Right : Set_Type) return Boolean;
-- OVERVIEW:
-- Strict set inclusion; to each item in the RIGHT set an item with
-- same value is associated in the LEFT set, but the two sets are not
-- identical.
function ">=" (Left, Right : Set_Type) return Boolean;
-- OVERVIEW:
-- Set inclusion; to each item in the RIGHT set an item with same
-- value is associated in the LEFT set.
end Set_Operations_G;
--/ 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 gives the position of the visited item in order of
-- traversal. 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 gives the position of the visited item in order of
-- traversal. 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) is <>;
procedure Disorder_Traverse_G (Set : in Set_Type);
-- OVERVIEW:
-- Remember that SET is implemented as a binary search SET. The items
-- in SET are visited level by level: the first visited node is the root,
-- then its descendants are visited in order of increasing values, then the
-- nodes of height 2 are visited, etc.
-- ORDER_NUMBER gives the position of the visited item in order of
-- traversal. 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.
-- Traversal by DISORDER_TRAVERSE_G is faster than by TRAVERSE_ASC_G or
-- TRAVERSE_DESC_G. Moreover, use of the generic procedure
-- DISORDER_TRAVERSE_G is recommended for saving a SET in a backstore
-- (file or linear list) because recovery will be efficient.
-- REQUIREMENT:
-- For your actual procedure ACTION, you must not use a procedure
-- which modifies the traversed SET.
--/ HEAP MANAGEMENT:
procedure Destroy (Set : in out Set_Type);
-- OVERVIEW:
-- Empties the SET and returns space to the free list.
procedure Release_Free_List;
-- OVERVIEW:
-- Releases all items from the free list giving their space back to the
-- system.
procedure Set_Max_Free_List_Size (Max_Free_List_Size : in Natural);
-- OVERVIEW:
-- Sets the maximum length of the free list which is 0 by default. If
-- parameter MAX_FREE_LIST_SIZE is smaller than the current size of the
-- list, the items in excess are returned to the system.
function Free_List_Size return Natural;
-- OVERVIEW:
-- Returns the actual length of the free list.
private
type Value_Type is
record
null;
end record;
package Table_Of_Dynamic_Keys is
new Table_Of_Dynamic_Keys_And_Static_Values_G (Key_Type => Item_Type,
Less => Less,
Equals => Equals,
Assign => Assign,
Destroy => Destroy,
Value_Type => Value_Type);
type Set_Type is new Table_Of_Dynamic_Keys.Table_Type;
end Set_Of_Dynamic_Items_G;