-- ============================================================================
-- >>>>>>>>>>>>>>>>>>>>>>>>>> ADA COMPILATION UNIT <<<<<<<<<<<<<<<<<<<<<<<<<<<<
-- ============================================================================
--
-- NAME:        
-- Map_Simple_Noncached_Sequential_Unbounded_Managed_Iterator_Semilimited_Domain
--
--              SPECIFICATION
-- 
-- AUTHOR:      Chuck Hobin
--
-- DATE:        6 September 1994
--
--                               CHANGE HISTORY
--
-- MM-DD-YY | Initials | Description
-- ----------------------------------------------------------------------------
-- <include SPR#, if applicable>
-- ============================================================================

with Unchecked_Deallocation;

package body Map_Simple_Noncached_Sequential_Unbounded_Managed_Iterator_Semilimited_Domain is

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

    type Node is
	record
	    The_Domain : Domain;
	    The_Range : Ranges;
	    Next : Structure;
	end record;

    procedure Free is new Unchecked_Deallocation (Node, Structure);

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

    procedure Find (The_Domain : in Domain; 
		    In_The_Map : in Map; 
		    The_Bucket : out Positive; 
		    Previous_Node : in out Structure; 
		    Current_Node : in out Structure) is
	Temporary_Bucket : Positive := 
	   (Hash_Of (The_Domain) mod Number_Of_Buckets) + 1;
    begin
	The_Bucket := Temporary_Bucket;
	Current_Node := In_The_Map (Temporary_Bucket);
	while Current_Node /= null loop
	    if Is_Equal (Current_Node.The_Domain, The_Domain) then
		return;
	    else
		Previous_Node := Current_Node;
		Current_Node := Current_Node.Next;
	    end if;
	end loop;
    end Find;

-------------------------------------------------------------------------------
-- EXPORTED OPERATIONS
-------------------------------------------------------------------------------

    procedure Copy (From_The_Map : in Map; To_The_Map : in out Map) is
	From_Index : Structure;
	To_Index : Structure;
    begin
	Clear (To_The_Map);
	for Index in From_The_Map'Range loop
	    From_Index := From_The_Map (Index);
	    if From_The_Map (Index) = null then
		To_The_Map (Index) := null;
	    else
		To_The_Map (Index) := 
		   new Node'(The_Domain => From_Index.The_Domain, 
			     The_Range => From_Index.The_Range, 
			     Next => null);
		To_Index := To_The_Map (Index);
		From_Index := From_Index.Next;
		while From_Index /= null loop
		    To_Index.Next := 
		       new Node'(The_Domain => From_Index.The_Domain, 
				 The_Range => From_Index.The_Range, 
				 Next => null);
		    To_Index := To_Index.Next;
		    From_Index := From_Index.Next;
		end loop;
	    end if;
	end loop;
    exception
	when Storage_Error =>
	    raise Overflow;
    end Copy;

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

    procedure Clear (The_Map : in out Map) is
	Pair_Index : Structure;
	Next_Pair : Structure;
    begin
	for Index in The_Map'Range loop
	    Pair_Index := The_Map (Index);
	    while Pair_Index /= null loop
		Next_Pair := Pair_Index.Next;
		Free (Pair_Index);
		Pair_Index := Next_Pair;
	    end loop;
	    The_Map (Index) := null;
	end loop;
    end Clear;

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

    procedure Bind (The_Domain : in Domain; 
		    And_The_Range : in Ranges; 
		    In_The_Map : in out Map) is
	The_Bucket : Positive;
	Previous_Node : Structure;
	Current_Node : Structure;
    begin
	Find (The_Domain, In_The_Map, The_Bucket, Previous_Node, Current_Node);
	if Current_Node /= null then
	    raise Multiple_Binding;
	else
	    In_The_Map (The_Bucket) := 
	       new Node'(The_Domain => The_Domain, 
			 The_Range => And_The_Range, 
			 Next => In_The_Map (The_Bucket));
	end if;
    exception
	when Storage_Error =>
	    raise Overflow;
    end Bind;

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

    procedure Unbind (The_Domain : in Domain; In_The_Map : in out Map) is
	The_Bucket : Positive;
	Previous_Node : Structure;
	Current_Node : Structure;
    begin
	Find (The_Domain, In_The_Map, The_Bucket, Previous_Node, Current_Node);
	if Previous_Node = null then
	    In_The_Map (The_Bucket) := Current_Node.Next;
	else
	    Previous_Node.Next := Current_Node.Next;
	end if;
	Free (Current_Node);
    exception
	when Constraint_Error =>
	    raise Domain_Is_Not_Bound;
    end Unbind;

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

    function Is_Equal (Left : in Map; Right : in Map) return Boolean is
	Left_Index : Structure;
	Right_Index : Structure;
	Left_Count : Natural;
	Right_Count : Natural;
    begin
	for Index in Left'Range loop
	    if (Left (Index) = null) xor (Right (Index) = null) then
		return False;
	    else
		Left_Index := Left (Index);
		Left_Count := 0;
		while Left_Index /= null loop
		    Right_Index := Right (Index);
		    while Right_Index /= null loop
			if Is_Equal (Left_Index.The_Domain, 
				     Right_Index.The_Domain) then
			    exit;
			else
			    Right_Index := Right_Index.Next;
			end if;
		    end loop;
		    if Left_Index.The_Range /= Right_Index.The_Range then
			return False;
		    else
			Left_Index := Left_Index.Next;
			Left_Count := Left_Count + 1;
		    end if;
		end loop;
		Right_Index := Right (Index);
		Right_Count := 0;
		while Right_Index /= null loop
		    Right_Index := Right_Index.Next;
		    Right_Count := Right_Count + 1;
		end loop;
		if Left_Count /= Right_Count then
		    return False;
		end if;
	    end if;
	end loop;
	return True;
    exception
	when Constraint_Error =>
	    return False;
    end Is_Equal;

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

    function Extent_Of (The_Map : in Map) return Natural is
	Count : Natural := 0;
	Temporary_Node : Structure;
    begin
	for Index in The_Map'Range loop
	    Temporary_Node := The_Map (Index);
	    while Temporary_Node /= null loop
		Count := Count + 1;
		Temporary_Node := Temporary_Node.Next;
	    end loop;
	end loop;
	return Count;
    end Extent_Of;

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

    function Is_Empty (The_Map : in Map) return Boolean is
    begin
	return (The_Map = Map'(others => null));
    end Is_Empty;

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

    function Is_Bound 
		(The_Domain : in Domain; In_The_Map : in Map) return Boolean is
	The_Bucket : Positive;
	Previous_Node : Structure;
	Current_Node : Structure;
    begin
	Find (The_Domain, In_The_Map, The_Bucket, Previous_Node, Current_Node);
	return (Current_Node /= null);
    end Is_Bound;

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

    function Range_Of 
		(The_Domain : in Domain; In_The_Map : in Map) return Ranges is
	The_Bucket : Positive;
	Previous_Node : Structure;
	Current_Node : Structure;
    begin
	Find (The_Domain, In_The_Map, The_Bucket, Previous_Node, Current_Node);
	return Current_Node.The_Range;
    exception
	when Constraint_Error =>
	    raise Domain_Is_Not_Bound;
    end Range_Of;

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

    procedure Iterate (Over_The_Map : in Map) is
	Temporary_Node : Structure;
	Continue : Boolean;
    begin
	Visit_Buckets:
	    for Index in Over_The_Map'Range loop
		Temporary_Node := Over_The_Map (Index);
		while Temporary_Node /= null loop
		    Process (Temporary_Node.The_Domain, 
			     Temporary_Node.The_Range, Continue);
		    exit Visit_Buckets when not Continue;
		    Temporary_Node := Temporary_Node.Next;
		end loop;
	    end loop Visit_Buckets;
    end Iterate;

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

    procedure Initialize (The_Iterator : in out Iterator; 
			  With_The_Map : in Map) is
    begin
	The_Iterator.The_Map := With_The_Map;
	The_Iterator.Current_Pair := null;
	for Index in The_Iterator.The_Map'Range loop
	    if The_Iterator.The_Map (Index) /= null then
		The_Iterator.Current_Pair := The_Iterator.The_Map (Index);
		The_Iterator.Map_Index := Index;
		exit;
	    end if;
	end loop;
    end Initialize;

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

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

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

    procedure Value_Of (The_Iterator : in Iterator; 
			The_Domain : out Domain; 
			The_Range : out Ranges) is
    begin
	The_Domain := The_Iterator.Current_Pair.The_Domain;
	The_Range := The_Iterator.Current_Pair.The_Range;
    exception
	when Constraint_Error =>
	    raise Iterator_Error;
    end Value_Of;

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

    procedure Get_Next (The_Iterator : in out Iterator) is
    begin
	The_Iterator.Current_Pair := The_Iterator.Current_Pair.Next;
	if The_Iterator.Current_Pair = null then
	    for Index in (The_Iterator.Map_Index + 1) .. 
			    The_Iterator.The_Map'Last loop
		if The_Iterator.The_Map (Index) /= null then
		    The_Iterator.Current_Pair := The_Iterator.The_Map (Index);
		    The_Iterator.Map_Index := Index;
		    exit;
		end if;
	    end loop;
	end if;
    exception
	when Constraint_Error =>
	    raise Iterator_Error;
    end Get_Next;

end Map_Simple_Noncached_Sequential_Unbounded_Managed_Iterator_Semilimited_Domain;