⟦862b0c46b⟧

TextFile

--------------------------------- COPYRIGHT ------------------------------------
-- (C) 1987 Swiss Federal Institute of Technology (EPFL).                     --
--     Represented by A. Strohmeier DMA-EPFL 1015 Lausanne Switzerland.       --
--     All Rights Reserved.                                                   --
--------------------------------------------------------------------------------

--+ TITLE:      GENERIC PACKAGE FOR SETS.
--+ SUPPORT:    S.R.Y. Louboutin,  CGL-DMA-EPFL,  CH-1015 LAUSANNE
--+ APPROVAL:   03-DEC-1987 C. Genillard.
--+ CREATION:   31-AUG-1987 A. Strohmeier.


with Table_Of_Static_Keys_And_Static_Values_G;

generic
    type Item_Type is 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;

package Set_Of_Static_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 : 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 : 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 : in Set_Type) return Natural;
    --+ OVERVIEW:
    --+   Returns the number of items currently in SET.

    function Is_Empty (Set : in Set_Type) return Boolean;

    function Is_Present (Set : in Set_Type; Item : in Item_Type) return Boolean;

    function Min (Set : in 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 : in 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 : in Set_Type; Item : in 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 : in Set_Type; Item : in 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 : in Set_Type; Item : in 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 : in Set_Type; Item : in 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 : in Set_Type) return Boolean;
        --+ OVERVIEW:
        --+   Set equality; the LEFT and RIGHT sets contain the same values.

        function "<" (Left, Right : in 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 : in 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 : in 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 : in 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_Static_Keys is
       new Table_Of_Static_Keys_And_Static_Values_G (Key_Type => Item_Type,
                                                     Less => Less,
                                                     Equals => Equals,
                                                     Value_Type => Value_Type);

    type Set_Type is new Table_Of_Static_Keys.Table_Type;

end Set_Of_Static_Items_G;
DataMuseum.dk

Rational R1000/400 Tapes

⟦862b0c46b⟧ TextFile

Derivation

TextFile
