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

with Unchecked_Deallocation;

package body Set_Simple_Sequential_Unbounded_Managed_Iterator is

-- Based on the set structure presented in Booch, "Software Components
-- with Ada", Benjamin-Cummings, 1987, Chapter 10.

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

    procedure Free is new Unchecked_Deallocation (Node, Set);

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

    procedure Copy (From_The_Set : in Set; To_The_Set : in out Set) is
	From_Index : Set := From_The_Set;
	To_Index : Set;
    begin
	Clear (To_The_Set);
	if From_The_Set = null then
	    To_The_Set := null;
	else
	    To_The_Set := new Node'(The_Item => From_Index.The_Item, 
				    Next => null);
	    To_Index := To_The_Set;
	    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_Set : in out Set) is
	Index : Set := The_Set;
	Next : Set;
    begin
	while Index /= null loop
	    Next := Index.Next;
	    Free (Index);
	    Index := Next;
	end loop;
	The_Set := null;
    end Clear;

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

    procedure Add (The_Item : in Item; To_The_Set : in out Set) is
	Index : Set := To_The_Set;
    begin
	while Index /= null loop
	    if Index.The_Item = The_Item then
		raise Item_Is_In_Set;
	    else
		Index := Index.Next;
	    end if;
	end loop;
	To_The_Set := new Node'(The_Item => The_Item, Next => To_The_Set);
    exception
	when Storage_Error =>
	    raise Overflow;
    end Add;

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

    procedure Remove (The_Item : in Item; From_The_Set : in out Set) is
	Previous : Set;
	Index : Set := From_The_Set;
    begin
	while Index /= null loop
	    if Index.The_Item = The_Item then
		if Previous = null then
		    From_The_Set := From_The_Set.Next;
		else
		    Previous.Next := Index.Next;
		end if;
		Free (Index);
		return;
	    else
		Previous := Index;
		Index := Index.Next;
	    end if;
	end loop;
	raise Item_Is_Not_In_Set;
    end Remove;

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

    procedure Union (Of_The_Set : in Set; 
		     And_The_Set : in Set; 
		     To_The_Set : in out Set) is
	From_Index : Set := Of_The_Set;
	To_Index : Set;
	To_Top : Set;
    begin
	Clear (To_The_Set);
	while From_Index /= null loop
	    To_The_Set := new Node'(The_Item => From_Index.The_Item, 
				    Next => To_The_Set);
	    From_Index := From_Index.Next;
	end loop;
	To_Top := To_The_Set;
	From_Index := And_The_Set;
	while From_Index /= null loop
	    To_Index := To_Top;
	    while To_Index /= null loop
		if From_Index.The_Item = To_Index.The_Item then
		    exit;
		else
		    To_Index := To_Index.Next;
		end if;
	    end loop;
	    if To_Index = null then
		To_The_Set := new Node'(The_Item => From_Index.The_Item, 
					Next => To_The_Set);
	    end if;
	    From_Index := From_Index.Next;
	end loop;
    exception
	when Storage_Error =>
	    raise Overflow;
    end Union;

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

    procedure Intersection (Of_The_Set : in Set; 
			    And_The_Set : in Set; 
			    To_The_Set : in out Set) is
	Of_Index : Set := Of_The_Set;
	And_Index : Set;
    begin
	Clear (To_The_Set);
	while Of_Index /= null loop
	    And_Index := And_The_Set;
	    while And_Index /= null loop
		if Of_Index.The_Item = And_Index.The_Item then
		    To_The_Set := new Node'(The_Item => Of_Index.The_Item, 
					    Next => To_The_Set);
		    exit;
		else
		    And_Index := And_Index.Next;
		end if;
	    end loop;
	    Of_Index := Of_Index.Next;
	end loop;
    exception
	when Storage_Error =>
	    raise Overflow;
    end Intersection;

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

    procedure Difference (Of_The_Set : in Set; 
			  And_The_Set : in Set; 
			  To_The_Set : in out Set) is
	Of_Index : Set := Of_The_Set;
	And_Index : Set;
    begin
	Clear (To_The_Set);
	while Of_Index /= null loop
	    And_Index := And_The_Set;
	    while And_Index /= null loop
		if Of_Index.The_Item = And_Index.The_Item then
		    exit;
		else
		    And_Index := And_Index.Next;
		end if;
	    end loop;
	    if And_Index = null then
		To_The_Set := new Node'(The_Item => Of_Index.The_Item, 
					Next => To_The_Set);
	    end if;
	    Of_Index := Of_Index.Next;
	end loop;
    exception
	when Storage_Error =>
	    raise Overflow;
    end Difference;

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

    function Is_Equal (Left : in Set; Right : in Set) return Boolean is
	Left_Count : Natural := 0;
	Right_Count : Natural := 0;
	Left_Index : Set := Left;
	Right_Index : Set;
    begin
	while Left_Index /= null loop
	    Right_Index := Right;
	    while Right_Index /= null loop
		if Left_Index.The_Item = Right_Index.The_Item then
		    exit;
		else
		    Right_Index := Right_Index.Next;
		end if;
	    end loop;
	    if Right_Index = null then
		return False;
	    else
		Left_Count := Left_Count + 1;
		Left_Index := Left_Index.Next;
	    end if;
	end loop;
	Right_Index := Right;
	while Right_Index /= null loop
	    Right_Count := Right_Count + 1;
	    Right_Index := Right_Index.Next;
	end loop;
	return (Left_Count = Right_Count);
    end Is_Equal;

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

    function Extent_Of (The_Set : in Set) return Natural is
	Count : Natural := 0;
	Index : Set := The_Set;
    begin
	while Index /= null loop
	    Count := Count + 1;
	    Index := Index.Next;
	end loop;
	return Count;
    end Extent_Of;

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

    function Is_Empty (The_Set : in Set) return Boolean is
    begin
	return (The_Set = null);
    end Is_Empty;

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

    function Is_A_Member 
		(The_Item : in Item; Of_The_Set : in Set) return Boolean is
	Index : Set := Of_The_Set;
    begin
	while Index /= null loop
	    if The_Item = Index.The_Item then
		return True;
	    end if;
	    Index := Index.Next;
	end loop;
	return False;
    end Is_A_Member;

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

    function Is_A_Subset (Left : in Set; Right : in Set) return Boolean is
	Left_Index : Set := Left;
	Right_Index : Set;
    begin
	while Left_Index /= null loop
	    Right_Index := Right;
	    while Right_Index /= null loop
		if Left_Index.The_Item = Right_Index.The_Item then
		    exit;
		else
		    Right_Index := Right_Index.Next;
		end if;
	    end loop;
	    if Right_Index = null then
		return False;
	    else
		Left_Index := Left_Index.Next;
	    end if;
	end loop;
	return True;
    end Is_A_Subset;

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

    function Is_A_Proper_Subset 
		(Left : in Set; Right : in Set) return Boolean is
	Left_Count : Natural := 0;
	Right_Count : Natural := 0;
	Left_Index : Set := Left;
	Right_Index : Set;
    begin
	while Left_Index /= null loop
	    Right_Index := Right;
	    while Right_Index /= null loop
		if Left_Index.The_Item = Right_Index.The_Item then
		    exit;
		else
		    Right_Index := Right_Index.Next;
		end if;
	    end loop;
	    if Right_Index = null then
		return False;
	    else
		Left_Count := Left_Count + 1;
		Left_Index := Left_Index.Next;
	    end if;
	end loop;
	Right_Index := Right;
	while Right_Index /= null loop
	    Right_Count := Right_Count + 1;
	    Right_Index := Right_Index.Next;
	end loop;
	return (Left_Count < Right_Count);
    end Is_A_Proper_Subset;

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

    procedure Iterate (Over_The_Set : in Set) is
	The_Iterator : Set := Over_The_Set;
	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_Set : in Set) is
    begin
	The_Iterator := Iterator (With_The_Set);
    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 Set_Simple_Sequential_Unbounded_Managed_Iterator;