--| +=========================================================================+
--| |                                                                         |
--| | SCAN.ERROR_HANDLING_SUPPORT (body)                                      |
--| |                                                                         |
--| | Greg Janee                                                              |
--| | General Research Corporation                                            |
--| |                                                                         |
--| +=========================================================================+

with Asis_Debug_Support;
with Msg_Log;

separate (Scan)
package body Error_Handling_Support is

--| Local subprograms.

    function Current_Element_Clause 
		(The_Element : in Asis.Element) return String;

    function Current_Unit_Clause 
		(The_Unit : in Asis.Compilation_Unit) return String;

    function Diagnosis return String;

    function Status_Clause return String;

--| +-------------------------------------------------------------------------+
--| | CURRENT_ELEMENT_CLAUSE (local)                                          |
--| +-------------------------------------------------------------------------+

    function Current_Element_Clause 
		(The_Element : in Asis.Element) return String is
    begin

	return "; current element is " & 
		  Asis_Debug_Support.Element_Image (The_Element);

    end Current_Element_Clause;

--| +-------------------------------------------------------------------------+
--| | CURRENT_UNIT_CLAUSE (local)                                             |
--| +-------------------------------------------------------------------------+

    function Current_Unit_Clause 
		(The_Unit : in Asis.Compilation_Unit) return String is
    begin

	return "; current unit is " & 
		  Asis_Debug_Support.Compilation_Unit_Image (The_Unit);

    end Current_Unit_Clause;

--| +-------------------------------------------------------------------------+
--| | DIAGNOSIS (local)                                                       |
--| +-------------------------------------------------------------------------+

    function Diagnosis return String is

	Asis_Diagnosis : constant String := 
	   Asis_Str.To_Standard_String (Asis_En.Diagnosis);

    begin

	if Asis_Diagnosis = "" then
	    return "<no diagnosis available>";
	else
	    return Asis_Diagnosis;
	end if;

    end Diagnosis;

--| +-------------------------------------------------------------------------+
--| | LOG/1 (exported)                                                        |
--| +-------------------------------------------------------------------------+

    procedure Log (Error_Kind : in Error_Kinds; 
		   Library_Unit : in String; 
		   Program_Unit : in String; 
		   Current_Unit : in Asis.Compilation_Unit) is
    begin

	case Error_Kind is

	    when A_Previous_Error =>
		Msg_Log.Put_Msg_Debug 
		   (Library_Unit, Program_Unit, 
		    "enclosing unit is " & 
		       Asis_Debug_Support.Compilation_Unit_Image 
			  (Current_Unit));

	    when An_Unhandled_Case =>
		Msg_Log.Put_Msg_Debug 
		   (Library_Unit, Program_Unit, 
		    "unhandled case" & Current_Unit_Clause (Current_Unit));

	    when An_Asis_Failure =>
		Msg_Log.Put_Msg_Debug ("exception Asis_Failed raised" & 
				       Current_Unit_Clause (Current_Unit) & 
				       Status_Clause & "; diagnosis follows");
		Msg_Log.Put_Msg_Debug (Library_Unit, Program_Unit, Diagnosis);

	    when A_Bad_Element =>
		Msg_Log.Put_Msg_Debug 
		   ("exception Asis_Inappropriate_Compilation_Unit raised" & 
		    Current_Unit_Clause (Current_Unit) & 
		    Status_Clause & "; diagnosis follows");
		Msg_Log.Put_Msg_Debug (Library_Unit, Program_Unit, Diagnosis);

	end case;

    end Log;

--| +-------------------------------------------------------------------------+
--| | LOG/2 (exported)                                                        |
--| +-------------------------------------------------------------------------+

    procedure Log (Error_Kind : in Error_Kinds; 
		   Library_Unit : in String; 
		   Program_Unit : in String; 
		   Current_Element : in Asis.Element) is
    begin

	case Error_Kind is

	    when A_Previous_Error =>
		Msg_Log.Put_Msg_Debug 
		   (Library_Unit, Program_Unit, 
		    "enclosing element is " & 
		       Asis_Debug_Support.Element_Image (Current_Element));

	    when An_Unhandled_Case =>
		Msg_Log.Put_Msg_Debug (Library_Unit, Program_Unit, 
				       "unhandled case" & Current_Element_Clause 
							     (Current_Element));

	    when An_Asis_Failure =>
		Msg_Log.Put_Msg_Debug 
		   ("exception Asis_Failed raised" & 
		    Current_Element_Clause (Current_Element) & 
		    Status_Clause & "; diagnosis follows");
		Msg_Log.Put_Msg_Debug (Library_Unit, Program_Unit, Diagnosis);

	    when A_Bad_Element =>
		Msg_Log.Put_Msg_Debug 
		   ("exception Asis_Inappropriate_Element raised" & 
		    Current_Element_Clause (Current_Element) & 
		    Status_Clause & "; diagnosis follows");
		Msg_Log.Put_Msg_Debug (Library_Unit, Program_Unit, Diagnosis);

	end case;

    end Log;

--| +-------------------------------------------------------------------------+
--| | STATUS_CLAUSE (local)                                                   |
--| +-------------------------------------------------------------------------+

    function Status_Clause return String is
    begin

	return "; status is " & Asis_En.Error_Kinds'Image (Asis_En.Status);

    end Status_Clause;

end Error_Handling_Support;