--| +=========================================================================+
--| |                                                                         |
--| | REFERENCE_SCAN.SCAN_PARAMETER_ASSOCIATION (body)                        |
--| |                                                                         |
--| | Greg Janee                                                              |
--| | General Research Corporation                                            |
--| |                                                                         |
--| +=========================================================================+

separate (Reference_Scan)
procedure Scan_Parameter_Association (The_Association : in Asis.Association; 
				      The_Context : in Context) is

    Cuid : constant String := "Reference_Scan.Scan_Parameter_Association";
    Puid : constant String := "Scan_Parameter_Association";

    package Ctx renames Reference_Scan.Context_Support;
    package Error renames Reference_Scan.Error_Handling_Support;
    package Trace renames Reference_Scan.Trace_Support;

    subtype Valid_Parameter_Mode_Kinds is 
       Asis_D.Parameter_Mode_Kinds 
	  range Asis_D.A_Default_In_Mode .. Asis_D.An_In_Out_Mode;

--| +-------------------------------------------------------------------------+
--| | NORMALIZED_PARAMETER_LIST (local)                                       |
--| +-------------------------------------------------------------------------+
--|
--| Returns the normalized parameter list of a procedure, function, or
--| task entry call, or a generic instantiation.

    function Normalized_Parameter_List 
		(The_Call : in Asis.Element) return Asis.Association_List is

	Puid : constant String := "Normalized_Parameter_List";

	The_Kind : Asis_E.Element_Kinds := Asis_E.Element_Kind (The_Call);

    begin

	if Asis_E."=" (The_Kind, Asis_E.A_Statement) and then 
	   (Asis_S."=" (Asis_S.Kind (The_Call), 
			Asis_S.A_Procedure_Call_Statement) or 
	    Asis_S."=" (Asis_S.Kind (The_Call), 
			Asis_S.An_Entry_Call_Statement)) then
	    return Asis_S.Call_Parameters (The_Call, Normalized => True);
	elsif Asis_E."=" (The_Kind, Asis_E.An_Expression) and then 
	      Asis_X."=" (Asis_X.Kind (The_Call), Asis_X.A_Function_Call) then
	    return Asis_X.Function_Call_Parameters 
		      (The_Call, Normalized => True);
	elsif Asis_E."=" (The_Kind, Asis_E.A_Declaration) and then 
	      (Asis_D."=" (Asis_D.Kind (The_Call), 
			   Asis_D.A_Package_Instantiation) or 
	       Asis_D."=" (Asis_D.Kind (The_Call), 
			   Asis_D.A_Procedure_Instantiation) or 
	       Asis_D."=" (Asis_D.Kind (The_Call), 
			   Asis_D.A_Function_Instantiation)) then
	    return Asis_D.Generic_Parameters (The_Call, Normalized => True);
	else
	    Error.Semantic_Error ("unhandled case", 
				  "starting from.enclosing element.", 
				  (The_Association, The_Call), Cuid, Puid);
	    raise Traversal_Error;
	end if;

    end Normalized_Parameter_List;

--| +-------------------------------------------------------------------------+
--| | FORMAL_PARAMETER_IS_IN_MODE_GENERIC_FORMAL_OBJECT (local)               |
--| +-------------------------------------------------------------------------+
--|
--| Returns true if the formal parameter corresponding to a parameter
--| association in a generic instantiation is an in-mode generic formal
--| object.

    function Formal_Parameter_Is_In_Mode_Generic_Formal_Object 
		(The_Association : in Asis.Association) return Boolean is

	Puid : constant String := 
	   "Formal_Parameter_Is_In_Mode_Generic_Formal_Object";

	Actual_Part : Asis.Expression;
	Formal_Part : Asis.Entity_Name_Definition;
	The_Declaration : Asis.Declaration;
	The_Instantiation : Asis.Declaration;
	This_Actual_Part : Asis.Expression;

    begin

	This_Actual_Part := Asis_S.Actual_Parameter (The_Association);
	The_Instantiation := Asis_E.Enclosing_Element (The_Association);

	declare
	    Parameters : constant Asis.Association_List := 
	       Normalized_Parameter_List (The_Instantiation);
	begin

	    for I in Parameters'Range loop
		Formal_Part := Asis_S.Formal_Parameter (Parameters (I));
		Actual_Part := Asis_S.Actual_Parameter (Parameters (I));
		if Asis_E.Is_Equal (Actual_Part, This_Actual_Part) then
		    The_Declaration := Asis_E.Enclosing_Element (Formal_Part);
		    if Asis_D."=" 
			  (Asis_D.Kind (The_Declaration), 
			   Asis_D.A_Generic_Formal_Object_Declaration) and then 
		       (Asis_D."=" (Asis_D.Parameter_Mode_Kind 
				       (The_Declaration), 
				    Asis_D.A_Default_In_Mode) or 
			Asis_D."=" (Asis_D.Parameter_Mode_Kind 
				       (The_Declaration), 
				    Asis_D.An_In_Mode)) then
			return True;
		    else
			return False;
		    end if;
		end if;
	    end loop;

	    Error.Semantic_Error 
	       ("corresponding normalized association not found", 
		"starting from.actual part.enclosing instantiation.", 
		(The_Association, This_Actual_Part, The_Instantiation), 
		Cuid, Puid);
	    raise Traversal_Error;

	end;

    exception

	when Asis.Asis_Inappropriate_Element | Asis.Asis_Failed =>
	    Error.Semantic_Error 
	       ("exception raised", 
		"starting from.actual part.enclosing instantiation." & 
		   "a normalized association actual part." & 
		   "a normalized association formal part." & 
		   "enclosing declaration.", 
		(The_Association, This_Actual_Part, The_Instantiation, 
		 Actual_Part, Formal_Part, The_Declaration), Cuid, Puid);
	    raise;

    end Formal_Parameter_Is_In_Mode_Generic_Formal_Object;

--| +-------------------------------------------------------------------------+
--| | FORMAL_PARAMETER_MODE (local)                                           |
--| +-------------------------------------------------------------------------+
--|
--| Returns the mode (in, out, or in/out) of the formal parameter
--| corresponding to a parameter association in a procedure, function,
--| or task entry call.

    function Formal_Parameter_Mode (The_Association : in Asis.Association) 
				   return Valid_Parameter_Mode_Kinds is

	Puid : constant String := "Formal_Parameter_Mode";

	Actual_Part : Asis.Expression;
	Formal_Part : Asis.Entity_Name_Definition;
	The_Call : Asis.Element;
	The_Mode : Asis_D.Parameter_Mode_Kinds;
	The_Specification : Asis.Parameter_Specification;
	This_Actual_Part : Asis.Expression;

    begin

	This_Actual_Part := Asis_S.Actual_Parameter (The_Association);
	The_Call := Asis_E.Enclosing_Element (The_Association);

	declare
	    Parameters : constant Asis.Association_List := 
	       Normalized_Parameter_List (The_Call);
	begin

	    for I in Parameters'Range loop
		Formal_Part := Asis_S.Formal_Parameter (Parameters (I));
		Actual_Part := Asis_S.Actual_Parameter (Parameters (I));
		if Asis_E.Is_Equal (Actual_Part, This_Actual_Part) then
		    The_Specification := Asis_E.Enclosing_Element (Formal_Part);
		    The_Mode := Asis_D.Parameter_Mode_Kind (The_Specification);
		    case The_Mode is
			when Asis_D.Not_A_Parameter_Mode =>
			    Error.Semantic_Error 
			       ("unhandled case", 
				"starting from.actual part.enclosing call." & 
				   "corresponding normalized association " & 
				   "actual part." & 
				   "corresponding normalized association " & 
				   "formal part." & 
				   "enclosing specification.", 
				(The_Association, This_Actual_Part, The_Call, 
				 Actual_Part, Formal_Part, The_Specification), 
				Cuid, Puid);
			    raise Traversal_Error;
			when others =>
			    return The_Mode;
		    end case;
		end if;
	    end loop;

	    Error.Semantic_Error 
	       ("corresponding normalized association not found", 
		"starting from.actual part.enclosing call.", 
		(The_Association, This_Actual_Part, The_Call), Cuid, Puid);
	    raise Traversal_Error;

	end;

    exception

	when Asis.Asis_Inappropriate_Element | Asis.Asis_Failed =>
	    Error.Semantic_Error 
	       ("exception raised", 
		"starting from.actual part.enclosing call." & 
		   "a normalized association actual part." & 
		   "a normalized association formal part." & 
		   "enclosing specification.", 
		(The_Association, This_Actual_Part, The_Call, 
		 Actual_Part, Formal_Part, The_Specification), Cuid, Puid);
	    raise;

    end Formal_Parameter_Mode;

--| +-------------------------------------------------------------------------+
--| | SCAN_PARAMETER_ASSOCIATION (exported)                                   |
--| +-------------------------------------------------------------------------+

begin

    declare
	Actual_Part : Asis.Expression := 
	   Asis_S.Actual_Parameter (The_Association);
	Formal_Part : Asis.Element := Asis_S.Formal_Parameter (The_Association);
    begin

	if Trace.On then
	    Trace.Log (The_Association, The_Context);
	    Trace.Add_Level (Reference_Scan.One_If_True 
				(not Asis_X.Is_Normalized (The_Association)) * 
			     Reference_Scan.One_If_Present (Formal_Part) + 1);
	end if;

	if not Asis_X.Is_Normalized (The_Association) and 
	   not Asis_E.Is_Nil (Formal_Part) then
	    if Rvs."=" (The_Context.Basic_Context, 
			Rvs.A_Generic_Association) then
		Reference_Scan.Scan_Expression (Formal_Part, The_Context);
	    else
		Reference_Scan.Scan_Expression 
		   (Formal_Part, Ctx.Set (The_Context, 
					  Basic_Context => 
					     Rvs.A_Parameter_Association, 
					  Weight => 92));
	    end if;
	end if;

	if Rvs."=" (The_Context.Basic_Context, Rvs.A_Generic_Association) then
	    if Formal_Parameter_Is_In_Mode_Generic_Formal_Object 
		  (The_Association) then
		Reference_Scan.Scan_Expression 
		   (Actual_Part, Ctx.Set (The_Context, 
					  Basic_Context => Rvs.A_Read, 
					  Weight => 95, 
					  New_Weight => 5, 
					  Add_Data_Access_Context => 
					     Rvs.A_Generic_Actual_Parameter));
	    else
		Reference_Scan.Scan_Expression 
		   (Actual_Part, Ctx.Set (The_Context, 
					  Basic_Context => 
					     Rvs.A_Generic_Actual_Parameter, 
					  Weight => 92));
	    end if;
	else
	    case Valid_Parameter_Mode_Kinds'
		    (Formal_Parameter_Mode (The_Association)) is
		when Asis_D.A_Default_In_Mode | Asis_D.An_In_Mode =>
		    Reference_Scan.Scan_Expression 
		       (Actual_Part, Ctx.Set (The_Context, 
					      Basic_Context => Rvs.A_Read, 
					      Weight => 95, 
					      New_Weight => 5, 
					      Add_Data_Access_Context => 
						 Rvs.An_Actual_Parameter));
		when Asis_D.An_Out_Mode =>
		    Reference_Scan.Scan_Expression 
		       (Actual_Part, Ctx.Set (The_Context, 
					      Basic_Context => Rvs.An_Update, 
					      Weight => 95, 
					      New_Weight => 5, 
					      Add_Data_Access_Context => 
						 Rvs.An_Actual_Parameter));
		when Asis_D.An_In_Out_Mode =>
		    Reference_Scan.Scan_Expression 
		       (Actual_Part, 
			Ctx.Set (The_Context, 
				 Basic_Context => Rvs.A_Read_And_Update, 
				 Weight => 95, 
				 New_Weight => 5, 
				 Add_Data_Access_Context => 
				    Rvs.An_Actual_Parameter));
	    end case;
	end if;

    end;

exception

    when Asis.Asis_Inappropriate_Element =>
	Error.Log (Error.A_Bad_Element, Cuid, Puid, The_Association);
	raise Traversal_Error;

    when Asis.Asis_Failed =>
	Error.Log (Error.An_Asis_Failure, Cuid, Puid, The_Association);
	raise Traversal_Error;

    when Traversal_Error =>
	Error.Log (Error.A_Previous_Error, Cuid, Puid, The_Association);
	raise;

end Scan_Parameter_Association;