⟦ca7660a0e⟧

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 STACKS.
--+ SUPPORT:     S.R.Y. Louboutin DMA-EPFL CH-1015 Lausanne
--+ APPROVAL:    03-DEC-1987 C. Genillard.
--+ CREATION:    18-AUG-1987 A. Strohmeier.

generic
    type Item_Type is limited private; -- type of the items in the stacks
    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);
    with function Equals (Left, Right : Item_Type) return Boolean;

package Stack_Of_Dynamic_Items_G is
--------------------------------
--+ OVERVIEW:
--+   This package provides stacks of unlimited dynamic size with elements
--+ of type ITEM_TYPE, where ITEM_TYPE is specified by a generic parameter.
--+ The type STACK_TYPE is implemented in such a way that every object has
--+ the implied initial value of an empty stack.
--+   Use of the package STACK_OF_STATIC_ITEMS_G is strongly recommended if
--+ the item type is static, that is neither a limited type, nor an access
--+ type. When used with an access type, only the access value would be
--+ stored in the stack, without copying the object designated by it.
--+   The package STACK_OF_DYNAMIC_ITEMS_G has to be used if the item type
--+ is dynamic, that is an access type or a limited type for which assignment
--+ and equality can be provided. However the type ITEM_TYPE must have the
--+ feature, that every object has an implied initial value.
--+
--+   Example of a dynamic item type:
--+     type ITEM_TYPE is record
--+       P: POSITIVE := 1;
--+       B: BOOLEAN := TRUE;
--+       Q: QUEUE_OF_INTEGER.QUEUE_TYPE;
--+     end record;
--+
--+ CAUTION:
--+   Functions which return the value of an item (or part of it) of the
--+ structure share the item with the structure and do not return a copy of it.
--+ This may have consequences if the type of the item, (or some component of
--+ it) is an access type. For instance, when accessing an item by a function
--+ call, this item must not be destroyed or modified during the query.
--+
--+ PRIMITIVES:
--+   CONSTRUCTORS:
--+     ASSIGN
--+     POP (2)
--+     PUSH
--+   QUERIES:
--+     "="
--+     TOP_VALUE
--+     GET_TOP_VALUE
--+     IS_EMPTY
--+     SIZE
--+   ITERATORS:
--+     TRAVERSE_G
--+   HEAP MANAGEMENT:
--+     DESTROY
--+     RELEASE_FREE_LIST
--+     SET_MAX_FREE_LIST_SIZE
--+     FREE_LIST_SIZE
--+
--+ ALGORITHM:
--+    The stack objects are implemented with linked lists. An internal free
--+ list is used to avoid returning each free item (i.e. coming from POP) 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
--+ PUSH), an element is recovered from the free list if it is not empty.
--+ Otherwise, new space is taken from the system.

    type Stack_Type is limited private;

    Empty_Structure_Error : exception;

--/ CONSTRUCTORS:

    procedure Assign (Destination : in out Stack_Type; Source : in Stack_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 Pop (Stack : in out Stack_Type);
    procedure Pop (Stack : in out Stack_Type; Item : in out Item_Type);
    --+ ERROR:
    --+   If the STACK is empty, then EMPTY_STRUCTURE_ERROR is raised.

    procedure Push (Stack : in out Stack_Type; Item : in Item_Type);

--/ QUERIES:

    function "=" (Left, Right : Stack_Type) return Boolean;

    function Top_Value (Stack : Stack_Type) return Item_Type;

    procedure Get_Top_Value (Stack : in Stack_Type; Item : in out Item_Type);
    --+ ERROR:
    --+   If the STACK is empty, then EMPTY_STRUCTURE_ERROR is raised.

    function Is_Empty (Stack : Stack_Type) return Boolean;

    function Size (Stack : Stack_Type) return Natural;
    --+ OVERVIEW:
    --+   Returns the number of items that are currently stored in STACK.

--/ ITERATORS:

    generic
        with procedure Action (Item : in Item_Type;
                               Order_Number : in Positive;
                               Continue : in out Boolean) is <>;
    procedure Traverse_G (Stack : in Stack_Type);
    --+ OVERVIEW:
    --+   Applies procedure ACT_ON_ITEM on each ITEM of the STACK, traversing it
    --+ from top to bottom. ORDER_NUMBER gives the position of the visited item
    --+ in order of traversal. The boolean parameter 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 ACT_ON_ITEM, its value
    --+ remains TRUE.
    --+ REQUIREMENT:
    --+   For your actual procedure ACT_ON_ITEM, you must not use a procedure
    --+ which modifies the traversed stack.

--/ HEAP MANAGEMENT:

    procedure Destroy (Stack : in out Stack_Type);
    --+ OVERVIEW:
    --+   Empties the STACK 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 Cell_Type;
    type Link_Type is access Cell_Type;
    type Cell_Type is
        record
            Value : Item_Type;
            Next : Link_Type;
        end record;
    type Stack_Type is
        record
            Top : Link_Type;
            Count : Natural := 0;
        end record;

end Stack_Of_Dynamic_Items_G;
DataMuseum.dk

Rational R1000/400 Tapes

⟦ca7660a0e⟧ TextFile

Derivation

TextFile
