⟦3ff0a7acc⟧

TextFile

--------------------------------- COPYRIGHT ------------------------------------
-- (C) 1986 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:   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;
DataMuseum.dk

Rational R1000/400 Tapes

⟦3ff0a7acc⟧ TextFile

Derivation

TextFile
