----------------------------------------------------------------------
-- 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 private;
  with function Equals (Left,Right: Item_Type) return Boolean;

package Stack_Of_Static_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: 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: in Stack_Type) return Boolean;

  function Top_Value (Stack: in Stack_Type) return Item_Type;

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

  function Is_Empty (Stack: in Stack_Type) return Boolean;

  function Size (Stack: in 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_Static_Items_G;