DataMuseum.dk

top - metrics - download

    Length: 14414 (0x384e)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

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 DMA-EPFL CH-1015 Lausanne
--+ APPROVAL:
--+ CREATION: 29-JUN-1987 A. Strohmeier.


package body Set_Of_Static_Items_G is

--/ LOCAL SUBPROGRAM:
    procedure Assign_Item (Destination : out Item_Type; Source : in Item_Type);
    procedure Assign (Destination : out Item_Type; Source : in Item_Type)
        renames Assign_Item;

--/ LOCAL SUBPROGRAM:
    procedure Destroy_Item (Item : in Item_Type);
    procedure Destroy (Item : in Item_Type) renames Destroy_Item;

-------------------------------------

    Null_Value : Value_Type;
    -- A local dummy variable.

--/ CONSTRUCTORS:

    procedure Assign (Destination : in out Set_Type; Source : in Set_Type) is
    begin
        Table_Of_Static_Keys.Assign
           (Table_Of_Static_Keys.Table_Type (Destination),
            Table_Of_Static_Keys.Table_Type (Source));
    end Assign;

    procedure Add (Set : in out Set_Type; Item : in Item_Type) is
        Found : Boolean;
    begin
        Insert (Set, Item, Null_Value, Found);
    end Add;

    procedure Insert (Set : in out Set_Type; Item : in Item_Type) is
    begin
        Insert (Set, Item, Null_Value);
    exception
        when Table_Of_Static_Keys.Duplicate_Item_Error =>
            raise Duplicate_Item_Error;
    end Insert;

    procedure Insert (Set : in out Set_Type;
                      Item : in Item_Type;
                      Duplicate_Item : out Boolean) is
    begin
        Insert (Set, Item, Null_Value, Duplicate_Item);
    end Insert;

    procedure Delete (Set : in out Set_Type; Item : in Item_Type) is
        Found : Boolean;
    begin
        Table_Of_Static_Keys.Remove
           (Table_Of_Static_Keys.Table_Type (Set), Item, Found);
    end Delete;

    procedure Remove (Set : in out Set_Type; Item : in Item_Type) is
    begin
        Table_Of_Static_Keys.Remove
           (Table_Of_Static_Keys.Table_Type (Set), Item);
    exception
        when Table_Of_Static_Keys.Missing_Item_Error =>
            raise Missing_Item_Error;
    end Remove;

    procedure Remove (Set : in out Set_Type;
                      Item : in Item_Type;
                      Found : out Boolean) is
    begin
        Table_Of_Static_Keys.Remove
           (Table_Of_Static_Keys.Table_Type (Set), Item, Found);
    end Remove;

    procedure Remove_Min (Set : in out Set_Type) is
    begin
        Table_Of_Static_Keys.Remove_Min (Table_Of_Static_Keys.Table_Type (Set));
    exception
        when Table_Of_Static_Keys.Empty_Structure_Error =>
            raise Empty_Structure_Error;
    end Remove_Min;

    procedure Remove_Min (Set : in out Set_Type; Item : out Item_Type) is
    begin
        Table_Of_Static_Keys.Remove_Min
           (Table_Of_Static_Keys.Table_Type (Set), Item);
    exception
        when Table_Of_Static_Keys.Empty_Structure_Error =>
            raise Empty_Structure_Error;
    end Remove_Min;

    procedure Remove_Max (Set : in out Set_Type) is
    begin
        Table_Of_Static_Keys.Remove_Max (Table_Of_Static_Keys.Table_Type (Set));
    exception
        when Table_Of_Static_Keys.Empty_Structure_Error =>
            raise Empty_Structure_Error;
    end Remove_Max;

    procedure Remove_Max (Set : in out Set_Type; Item : out Item_Type) is
    begin
        Table_Of_Static_Keys.Remove_Max
           (Table_Of_Static_Keys.Table_Type (Set), Item);
    exception
        when Table_Of_Static_Keys.Empty_Structure_Error =>
            raise Empty_Structure_Error;
    end Remove_Max;

--/ QUERIES:

    function Size (Set : in Set_Type) return Natural is
    begin
        return Table_Of_Static_Keys.Size
                  (Table_Of_Static_Keys.Table_Type (Set));
    end Size;

    function Is_Empty (Set : in Set_Type) return Boolean is
    begin
        return Table_Of_Static_Keys.Is_Empty
                  (Table_Of_Static_Keys.Table_Type (Set));
    end Is_Empty;

    function Is_Present
                (Set : in Set_Type; Item : in Item_Type) return Boolean is
    begin
        return Table_Of_Static_Keys.Is_Present
                  (Table_Of_Static_Keys.Table_Type (Set), Item);
    end Is_Present;

    function Min (Set : in Set_Type) return Item_Type is
    begin
        return Min_Key (Set);
    exception
        when Table_Of_Static_Keys.Empty_Structure_Error =>
            raise Empty_Structure_Error;
    end Min;

    procedure Get_Min (Set : in Set_Type; Item : out Item_Type) is
    begin
        Get_Min_Key (Set, Item);
    exception
        when Table_Of_Static_Keys.Empty_Structure_Error =>
            raise Empty_Structure_Error;
    end Get_Min;


    function Max (Set : in Set_Type) return Item_Type is
    begin
        return Max_Key (Set);
    exception
        when Table_Of_Static_Keys.Empty_Structure_Error =>
            raise Empty_Structure_Error;
    end Max;

    procedure Get_Max (Set : in Set_Type; Item : out Item_Type) is
    begin
        Get_Max_Key (Set, Item);
    exception
        when Table_Of_Static_Keys.Empty_Structure_Error =>
            raise Empty_Structure_Error;
    end Get_Max;

    function Less (Set : in Set_Type; Item : in Item_Type) return Item_Type is
    begin
        return Less_Key (Set, Item);
    exception
        when Table_Of_Static_Keys.Missing_Item_Error =>
            raise Missing_Item_Error;
    end Less;

    procedure Get_Less (Set : in Set_Type; Item : in out Item_Type) is
    begin
        Get_Less_Key (Set, Item);
    exception
        when Table_Of_Static_Keys.Missing_Item_Error =>
            raise Missing_Item_Error;
    end Get_Less;

    procedure Get_Less (Set : in Set_Type;
                        Item : in out Item_Type;
                        Found : out Boolean) is
    begin
        Get_Less_Key (Set, Item, Found);
    end Get_Less;

    function Less_Or_Equal
                (Set : in Set_Type; Item : in Item_Type) return Item_Type is
    begin
        return Less_Or_Equal_Key (Set, Item);
    exception
        when Table_Of_Static_Keys.Missing_Item_Error =>
            raise Missing_Item_Error;
    end Less_Or_Equal;

    procedure Get_Less_Or_Equal (Set : in Set_Type; Item : in out Item_Type) is
    begin
        Get_Less_Or_Equal_Key (Set, Item);
    exception
        when Table_Of_Static_Keys.Missing_Item_Error =>
            raise Missing_Item_Error;
    end Get_Less_Or_Equal;

    procedure Get_Less_Or_Equal (Set : in Set_Type;
                                 Item : in out Item_Type;
                                 Found : out Boolean) is
    begin
        Get_Less_Or_Equal_Key (Set, Item, Found);
    end Get_Less_Or_Equal;

    function Greater (Set : in Set_Type; Item : in Item_Type)
                     return Item_Type is
    begin
        return Greater_Key (Set, Item);
    exception
        when Table_Of_Static_Keys.Missing_Item_Error =>
            raise Missing_Item_Error;
    end Greater;

    procedure Get_Greater (Set : in Set_Type; Item : in out Item_Type) is
    begin
        Get_Greater_Key (Set, Item);
    exception
        when Table_Of_Static_Keys.Missing_Item_Error =>
            raise Missing_Item_Error;
    end Get_Greater;

    procedure Get_Greater (Set : in Set_Type;
                           Item : in out Item_Type;
                           Found : out Boolean) is
    begin
        Get_Greater_Key (Set, Item, Found);
    end Get_Greater;

    function Greater_Or_Equal
                (Set : in Set_Type; Item : in Item_Type) return Item_Type is
    begin
        return Greater_Or_Equal_Key (Set, Item);
    exception
        when Table_Of_Static_Keys.Missing_Item_Error =>
            raise Missing_Item_Error;
    end Greater_Or_Equal;

    procedure Get_Greater_Or_Equal
                 (Set : in Set_Type; Item : in out Item_Type) is
    begin
        Get_Greater_Or_Equal_Key (Set, Item);
    exception
        when Table_Of_Static_Keys.Missing_Item_Error =>
            raise Missing_Item_Error;
    end Get_Greater_Or_Equal;

    procedure Get_Greater_Or_Equal (Set : in Set_Type;
                                    Item : in out Item_Type;
                                    Found : out Boolean) is
    begin
        Get_Greater_Or_Equal_Key (Set, Item, Found);
    end Get_Greater_Or_Equal;

--/ SET_OPERATIONS:

    package body Set_Operations_G is

        package Instance is new Table_Of_Static_Keys.Set_Operations_G;

        procedure Union (Destination : in out Set_Type;
                         Left, Right : in Set_Type) is
        begin
            Instance.Union (Table_Of_Static_Keys.Table_Type (Destination),
                            Table_Of_Static_Keys.Table_Type (Left),
                            Table_Of_Static_Keys.Table_Type (Right));
        end Union;

        procedure Intersection (Destination : in out Set_Type;
                                Left, Right : in Set_Type) is
        begin
            Instance.Intersection
               (Table_Of_Static_Keys.Table_Type (Destination),
                Table_Of_Static_Keys.Table_Type (Left),
                Table_Of_Static_Keys.Table_Type (Right));
        end Intersection;

        procedure Difference (Destination : in out Set_Type;
                              Left, Right : in Set_Type) is
        begin
            Instance.Difference (Table_Of_Static_Keys.Table_Type (Destination),
                                 Table_Of_Static_Keys.Table_Type (Left),
                                 Table_Of_Static_Keys.Table_Type (Right));
        end Difference;

        procedure Symmetric_Difference (Destination : in out Set_Type;
                                        Left, Right : in Set_Type) is
        begin
            Instance.Symmetric_Difference
               (Table_Of_Static_Keys.Table_Type (Destination),
                Table_Of_Static_Keys.Table_Type (Left),
                Table_Of_Static_Keys.Table_Type (Right));
        end Symmetric_Difference;

        function "=" (Left, Right : in Set_Type) return Boolean is
        begin
            return Instance."=" (Table_Of_Static_Keys.Table_Type (Left),
                                 Table_Of_Static_Keys.Table_Type (Right));
        end "=";

        function "<" (Left, Right : in Set_Type) return Boolean is
        begin
            return Instance."<" (Table_Of_Static_Keys.Table_Type (Left),
                                 Table_Of_Static_Keys.Table_Type (Right));
        end "<";

        function "<=" (Left, Right : in Set_Type) return Boolean is
        begin
            return Instance."<=" (Table_Of_Static_Keys.Table_Type (Left),
                                  Table_Of_Static_Keys.Table_Type (Right));
        end "<=";

        function ">" (Left, Right : in Set_Type) return Boolean is
        begin
            return Instance.">" (Table_Of_Static_Keys.Table_Type (Left),
                                 Table_Of_Static_Keys.Table_Type (Right));
        end ">";

        function ">=" (Left, Right : in Set_Type) return Boolean is
        begin
            return Instance.">=" (Table_Of_Static_Keys.Table_Type (Left),
                                  Table_Of_Static_Keys.Table_Type (Right));
        end ">=";

    end Set_Operations_G;


--/ ITERATORS:

    procedure Traverse_Asc_G (Set : in Set_Type) is
        procedure Local_Action (Item : in Item_Type;
                                Value : in Value_Type;
                                Order_Number : in Positive;
                                Continue : in out Boolean) is
        begin
            Action (Item, Order_Number, Continue);
        end Local_Action;
        procedure Traverse_Asc is
           new Table_Of_Static_Keys.Traverse_Asc_G (Local_Action);
    begin
        Traverse_Asc (Table_Of_Static_Keys.Table_Type (Set));
    end Traverse_Asc_G;

    procedure Traverse_Desc_G (Set : in Set_Type) is
        procedure Local_Action (Item : in Item_Type;
                                Value : in Value_Type;
                                Order_Number : in Positive;
                                Continue : in out Boolean) is
        begin
            Action (Item, Order_Number, Continue);
        end Local_Action;
        procedure Traverse_Desc is
           new Table_Of_Static_Keys.Traverse_Desc_G (Local_Action);
    begin
        Traverse_Desc (Table_Of_Static_Keys.Table_Type (Set));
    end Traverse_Desc_G;

    procedure Disorder_Traverse_G (Set : in Set_Type) is
        procedure Local_Action (Item : in Item_Type;
                                Value : in Value_Type;
                                Order_Number : in Positive;
                                Continue : in out Boolean) is
        begin
            Action (Item, Order_Number, Continue);
        end Local_Action;
        procedure Disorder_Traverse is
           new Table_Of_Static_Keys.Disorder_Traverse_G (Local_Action);
    begin
        Disorder_Traverse (Table_Of_Static_Keys.Table_Type (Set));
    end Disorder_Traverse_G;

--/ HEAP MANAGEMENT:

    procedure Destroy (Set : in out Set_Type) is
    begin
        Table_Of_Static_Keys.Destroy (Table_Of_Static_Keys.Table_Type (Set));
    end Destroy;

    procedure Release_Free_List is
    begin
        Table_Of_Static_Keys.Release_Free_List;
    end Release_Free_List;

    procedure Set_Max_Free_List_Size (Max_Free_List_Size : in Natural) is
    begin
        Table_Of_Static_Keys.Set_Max_Free_List_Size (Max_Free_List_Size);
    end Set_Max_Free_List_Size;

    function Free_List_Size return Natural is
    begin
        return Table_Of_Static_Keys.Free_List_Size;
    end Free_List_Size;

    procedure Assign_Item (Destination : out Item_Type;
                           Source : in Item_Type) is
    begin
        Destination := Source;
    end Assign_Item;

    procedure Destroy_Item (Item : in Item_Type) is
        -- Mode of the parameter is artificial, but mode 'out' could raise
        -- CONSTRAINT_ERROR !
    begin
        null;
    end Destroy_Item;
    pragma Inline (Assign_Item);
    pragma Inline (Destroy_Item);


end Set_Of_Static_Items_G;