----------------------------------------------------------------------
-- Copyright 1987 by the Swiss Federal Institute of Technology (EPFL),
-- Prof. A. Strohmeier, EPFL-DI-LGL, CH-1015 Lausanne, Switzerland.
----------------------------------------------------------------------
-- Title : Generic Package for Queues.
-- 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 Queue_Of_Static_Items_G is
--------------------------------
-- OVERVIEW:
-- This package provides queues of unlimited dynamic size with elements
-- of type ITEM_TYPE, where ITEM_TYPE is specified by a generic parameter.
-- The type QUEUE_TYPE is implemented in such a way that every object has
-- the implied initial value of an empty queue.
-- Use of the package QUEUE_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 queue, without copying the object designated by it.
-- The package QUEUE_OF_DYNAMIC_ITEMS_G has to be used if the item type
-- is dynamic, that is an access type or a limited type for wich 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
-- INSERT
-- REMOVE (2)
-- QUERIES:
-- "="
-- FIRST_VALUE
-- GET_FIRST_VALUE
-- LAST_VALUE
-- GET_LAST_VALUE
-- IS_EMPTY
-- SIZE
-- ITERATORS:
-- TRAVERSE_G
-- HEAP MANAGEMENT:
-- DESTROY
-- RELEASE_FREE_LIST
-- SET_MAX_FREE_LIST_SIZE
-- FREE_LIST_SIZE
--
-- ALGORITHM:
-- The queue objects are implemented with linked lists. An internal free
-- list is used to avoid returning each free item (i.e. coming from REMOVE) 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
-- INSERT), an element is recovered from the free list if it is not empty.
-- Otherwise, new space is taken from the system.
type Queue_Type is limited private;
Empty_Structure_Error: exception;
--/ CONSTRUCTORS:
procedure Assign (Destination: in out Queue_Type; Source: in Queue_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 Insert (Queue: in out Queue_Type; Item: in Item_Type);
-- OVERVIEW:
-- Inserts an ITEM into the QUEUE as the last item.
procedure Remove (Queue: in out Queue_Type);
procedure Remove (Queue: in out Queue_Type; Item: out Item_Type);
-- OVERVIEW:
-- Removes the first ITEM from the QUEUE.
-- ERROR:
-- If the QUEUE is empty then EMPTY_STRUCTURE_ERROR is raised.
--/ QUERIES:
function "=" (Left,Right: in Queue_Type) return Boolean;
function First_Value (Queue: in Queue_Type) return Item_Type;
procedure Get_First_Value (Queue: in Queue_Type; Item: out Item_Type);
-- OVERVIEW:
-- Shows the value of the first item of the QUEUE.
-- ERROR:
-- If the QUEUE is empty then EMPTY_STRUCTURE_ERROR is raised.
function Last_Value (Queue: in Queue_Type) return Item_Type;
procedure Get_Last_Value (Queue: in Queue_Type; Item: out Item_Type);
-- OVERVIEW:
-- Shows the value of the last item of the QUEUE.
-- ERROR:
-- If the QUEUE is empty then EMPTY_STRUCTURE_ERROR is raised.
function Is_Empty (Queue: in Queue_Type) return Boolean;
function Size (Queue: in Queue_Type) return Natural;
-- OVERVIEW:
-- Returns the number of items that are currently stored in QUEUE.
--/ ITERATORS:
generic
with procedure Action (Item: in Item_Type;
Order_Number: in Positive;
Continue: in out Boolean) is <>;
procedure Traverse_G (Queue: in Queue_Type);
-- OVERVIEW:
-- Applies procedure ACTION on each ITEM of the QUEUE, traversing
-- it from the first item to the last one (FIFO). 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 queue.
--/ HEAP MANAGEMENT:
procedure Destroy (Queue: in out Queue_Type);
-- OVERVIEW:
-- Empties the QUEUE 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 Queue_Type is record
First, Last: Link_Type;
Count: Natural := 0;
end record;
end Queue_Of_Static_Items_G;