----------------------------------------------------------------------
-- Copyright 1987 by the Swiss Federal Institute of Technology (EPFL),
-- Prof. A. Strohmeier, EPFL-DI-LGL, CH-1015 Lausanne, Switzerland.
----------------------------------------------------------------------
-- Title : Generic Package for Stacks.
-- Revision : 14-Jul-1992 Ph. Kipfer (PKR), Comment ACT_ON_ITEM -> ACTION
-- File header format
-- 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 ACTION 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 ACTION, its value
-- remains TRUE.
-- REQUIREMENT:
-- For your actual procedure ACTION, 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;