-- ============================================================================
-- >>>>>>>>>>>>>>>>>>>>>>>>>> ADA COMPILATION UNIT <<<<<<<<<<<<<<<<<<<<<<<<<<<<
-- ============================================================================
--
-- NAME:        Stack_Sequential_Unbounded_Managed_Iterator
--
--              BODY
-- 
-- AUTHOR:      Chuck Hobin
--
-- DATE:        27 September 1993
--
--                               CHANGE HISTORY
--
-- MM-DD-YY | Initials | Description
-- ----------------------------------------------------------------------------
-- <include SPR#, if applicable>
-- ============================================================================

with Unchecked_Deallocation;

package body Stack_Sequential_Unbounded_Managed_Iterator is

    type Node is
	record
	    The_Item : Item;
	    Next : Stack;
	end record;

    procedure Free is new Unchecked_Deallocation (Node, Stack);

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

    procedure Copy (From_The_Stack : in Stack; To_The_Stack : in out Stack) is
	From_Index : Stack := From_The_Stack;
	To_Index : Stack;
    begin
	Clear (To_The_Stack);
	if From_The_Stack = null then
	    To_The_Stack := null;
	else
	    To_The_Stack := 
	       new Node'(The_Item => From_Index.The_Item, Next => null);
	    To_Index := To_The_Stack;
	    From_Index := From_Index.Next;
	    while From_Index /= null loop
		To_Index.Next := 
		   new Node'(The_Item => From_Index.The_Item, Next => null);
		To_Index := To_Index.Next;
		From_Index := From_Index.Next;
	    end loop;
	end if;
    exception
	when Storage_Error =>
	    raise Overflow;
    end Copy;

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

    procedure Clear (The_Stack : in out Stack) is
	Index : Stack := The_Stack;
	Next : Stack;
    begin
	while Index /= null loop
	    Next := Index.Next;
	    Free (Index);
	    Index := Next;
	end loop;
	The_Stack := null;
    end Clear;

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

    procedure Push (The_Item : in Item; On_The_Stack : in out Stack) is
    begin
	On_The_Stack := new Node'(The_Item => The_Item, Next => On_The_Stack);
    exception
	when Storage_Error =>
	    raise Overflow;
    end Push;

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

    procedure Pop (The_Stack : in out Stack) is
	Top : Stack := The_Stack;
    begin
	The_Stack := The_Stack.Next;
	Free (Top);
    exception
	when Constraint_Error =>
	    raise Underflow;
    end Pop;

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

    function Is_Equal (Left : in Stack; Right : in Stack) return Boolean is
	Left_Index : Stack := Left;
	Right_Index : Stack := Right;
    begin
	while Left_Index /= null loop
	    if Left_Index.The_Item /= Right_Index.The_Item then
		return False;
	    end if;
	    Left_Index := Left_Index.Next;
	    Right_Index := Right_Index.Next;
	end loop;
	return (Right_Index = null);
    exception
	when Constraint_Error =>
	    return False;
    end Is_Equal;

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

    function Depth_Of (The_Stack : in Stack) return Natural is
	Count : Natural := 0;
	Index : Stack := The_Stack;
    begin
	while Index /= null loop
	    Count := Count + 1;
	    Index := Index.Next;
	end loop;
	return Count;
    end Depth_Of;

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

    function Is_Empty (The_Stack : in Stack) return Boolean is
    begin
	return (The_Stack = null);
    end Is_Empty;

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

    function Top_Of (The_Stack : in Stack) return Item is
    begin
	return The_Stack.The_Item;
    exception
	when Constraint_Error =>
	    raise Underflow;
    end Top_Of;

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

    procedure Iterate (Over_The_Stack : in Stack) is
	The_Iterator : Stack := Over_The_Stack;
	Continue : Boolean;
    begin
	while The_Iterator /= null loop
	    Process (The_Iterator.The_Item, Continue);
	    exit when not Continue;
	    The_Iterator := The_Iterator.Next;
	end loop;
    end Iterate;

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

    procedure Initialize (The_Iterator : in out Iterator; 
			  With_The_Stack : in Stack) is
    begin
	The_Iterator := Iterator (With_The_Stack);
    end Initialize;

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

    function Is_Done (The_Iterator : in Iterator) return Boolean is
    begin
	return (The_Iterator = null);
    end Is_Done;

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

    function Value_Of (The_Iterator : in Iterator) return Item is
    begin
	return The_Iterator.The_Item;
    exception
	when Constraint_Error =>
	    raise Iterator_Error;
    end Value_Of;

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

    procedure Get_Next (The_Iterator : in out Iterator) is
    begin
	The_Iterator := Iterator (The_Iterator.Next);
    exception
	when Constraint_Error =>
	    raise Iterator_Error;
    end Get_Next;

end Stack_Sequential_Unbounded_Managed_Iterator;