--| +=========================================================================+
--| |                                                                         |
--| | REGION_SCAN (body)                                                      |
--| |                                                                         |
--| | Greg Janee                                                              |
--| | General Research Corporation                                            |
--| |                                                                         |
--| +=========================================================================+

with Asis_Debug_Support;
with Text_Io;

package body Region_Scan is

--| Standard renames...

    package Asis_E renames Asis.Elements;
    package Rgn renames Region_Support;

--| The following exceptions are used to implement the corresponding
--| control flows.

    Abandon_Siblings : exception;
    Terminate_Scan : exception;

--| Local variables.

    Expand_Instantiations : Boolean;
    Include_Instance_Bodies : Boolean;
    Trace_Scan : Boolean;
    Current_Level : Natural;

--| +-------------------------------------------------------------------------+
--| | REGION_SCAN_INTERNAL (local)                                            |
--| +-------------------------------------------------------------------------+

--| +=========================================================================+
--| |                                                                         |
--| | REGION_SCAN_INTERNAL - scan for declarative region parts                |
--| |                                                                         |
--| | This package scans for declarative region parts.  It is a               |
--| | pseudo-instantiation of package Scan.  The comments from the original   |
--| | package have been preserved; modifications have been noted as           |
--| | appropriate.                                                            |
--| |                                                                         |
--| | SCAN - generic Asis traversal                                           |
--| |                                                                         |
--| | This package provides the procedures to perform a generic               |
--| | traversal of the Asis source code representation tree.  The traversal   |
--| | is not generic in the strict Ada sense of the word, but rather          |
--| | in the more general sense that this package can be copied, and code     |
--| | can be emplaced in the copied procedures to cause the traversal to      |
--| | perform a specific function.                                            |
--| |                                                                         |
--| | The traversal has the following properties:                             |
--| |                                                                         |
--| | 1. The traversal is in top-down, source code order (unless flags such   |
--| | as Normalize_Procedure_Call_Parameters are set).                        |
--| |                                                                         |
--| | 2. An object of a user-defined type is carried throughout the           |
--| | traversal.  It can be used to hold contextual information.              |
--| |                                                                         |
--| | 3. The traversal can be traced.  If tracing is on, a textual            |
--| | representation of each element encountered is indented appropriately    |
--| | and written to a user-defined file.                                     |
--| |                                                                         |
--| | 4. Asis exceptions (e.g., Asis_Inappropriate_Element and Asis_Failed)   |
--| | are caught at each step of the traversal.  When an exception is         |
--| | caught, a message is written using the Msg_Log package and the          |
--| | universal exception Traversal_Error is raised.  This causes a           |
--| | stack traceback to be produced and results in Traversal_Error being     |
--| | propagated outside this package.                                        |
--| |                                                                         |
--| | Greg Janee                                                              |
--| | General Research Corporation                                            |
--| |                                                                         |
--| +=========================================================================+

    package Region_Scan_Internal is

--| Context.  An object of type Context is carried throughout the traversal.
--| To customize this object, edit its type definition here.
--|
--| For the region scan, we pass along the caller's state variable.

	subtype Context is State_Information;

--| Flags.  Some of these flags may have no effect.  For example,
--| normalization of procedure call parameters may always be performed by the
--| underlying Asis implementation.

	Include_Accept_Statement_Pragmas : Boolean := True;
	Include_Block_Statement_Pragmas : Boolean := True;
	Include_Case_Statement_Pragmas : Boolean := True;
	Include_Context_Clause_Pragmas : Boolean := True;
	Include_Exception_Handler_Pragmas : Boolean := True;
	Include_Generic_Formal_Part_Pragmas : Boolean := True;
	Include_If_Statement_Pragmas : Boolean := True;
	Include_Loop_Statement_Pragmas : Boolean := True;
	Include_Package_Pragmas : Boolean := True;
	Include_Record_Representation_Clause_Pragmas : Boolean := True;
	Include_Record_Type_Definition_Pragmas : Boolean := True;
	Include_Select_Statement_Pragmas : Boolean := True;
	Include_Task_Declaration_Pragmas : Boolean := True;
	Include_Task_Type_Definition_Pragmas : Boolean := True;

	Include_Implicit_Record_Components : Boolean := False;

	Normalize_Discriminant_Constraint_Components : Boolean := False;
	Normalize_Entry_Call_Parameters : Boolean := False;
	Normalize_Function_Call_Parameters : Boolean := False;
	Normalize_Instantiation_Parameters : Boolean := False;
	Normalize_Procedure_Call_Parameters : Boolean := False;
	Normalize_Record_Aggregate_Components : Boolean := False;

	Expand_Procedure_Instantiations : Boolean := False;
	Expand_Function_Instantiations : Boolean := False;
	Expand_Package_Instantiations : Boolean := False;

--| Convenience procedures for setting the above...

	procedure Include_All_Pragmas (Yes : in Boolean);
	procedure Normalize_All_Associations (Yes : in Boolean);
	procedure Expand_All_Instantiations (Yes : in Boolean);

--| Scan procedures, one per element kind.  Scan_Declarative_Item_List scans
--| a list of declarations, pragmas, representation clauses, and use
--| clauses.  Scan_Statement_List scans a list of statements and pragmas.
--| Scan_Context_Clause_List scans a list of with clauses, use clauses,
--| and pragmas.  Scan_Component_Clause_List scans a list of
--| component clauses and pragmas.  Scan_Record_Component_List scans a list
--| of declarations, variant parts, null components, and pragmas.
--| Scan_Case_Statement_Alternative_List scans a list of case statement
--| alternatives and pragmas.  Scan_Variant_List scans a list of variants
--| and pragmas.

	procedure Scan_Any (The_Element : in Asis.Element; 
			    The_Context : in out Context);

	procedure Scan_Any_List (The_List : in Asis.Element_List; 
				 The_Context : in out Context);

	procedure Scan_Argument_Association 
		     (The_Association : in Asis.Association; 
		      The_Context : in out Context);

	procedure Scan_Argument_Association_List 
		     (The_List : in Asis.Argument_Association_List; 
		      The_Context : in out Context);

	procedure Scan_Case_Statement_Alternative 
		     (The_Alternative : in Asis.Case_Statement_Alternative; 
		      The_Context : in out Context);

	procedure Scan_Case_Statement_Alternative_List 
		     (The_List : in Asis.Case_Statement_Alternative_List; 
		      The_Context : in out Context);

	procedure Scan_Choice (The_Choice : in Asis.Choice; 
			       The_Context : in out Context);

	procedure Scan_Choice_List (The_List : in Asis.Choice_List; 
				    The_Context : in out Context);

	procedure Scan_Compilation_Unit (The_Unit : in Asis.Compilation_Unit; 
					 The_Context : in out Context);

	procedure Scan_Component_Association 
		     (The_Association : in Asis.Component_Association; 
		      The_Context : in out Context);

	procedure Scan_Component_Association_List 
		     (The_List : in Asis.Component_Association_List; 
		      The_Context : in out Context);

	procedure Scan_Component_Clause (The_Clause : in Asis.Component_Clause; 
					 The_Context : in out Context);

	procedure Scan_Component_Clause_List 
		     (The_List : in Asis.Component_Clause_List; 
		      The_Context : in out Context);

	procedure Scan_Constraint (The_Constraint : in Asis.Constraint; 
				   The_Context : in out Context);

	procedure Scan_Context_Clause_List 
		     (The_List : in Asis.Context_Clause_List; 
		      The_Context : in out Context);

	procedure Scan_Declaration (The_Declaration : in Asis.Declaration; 
				    The_Context : in out Context);

	procedure Scan_Declaration_List (The_List : in Asis.Declaration_List; 
					 The_Context : in out Context);

	procedure Scan_Declarative_Item_List 
		     (The_List : in Asis.Declarative_Item_List; 
		      The_Context : in out Context);

	procedure Scan_Discrete_Range (The_Range : in Asis.Discrete_Range; 
				       The_Context : in out Context);

	procedure Scan_Discrete_Range_List 
		     (The_List : in Asis.Discrete_Range_List; 
		      The_Context : in out Context);

	procedure Scan_Discriminant_Association 
		     (The_Association : in Asis.Discriminant_Association; 
		      The_Context : in out Context);

	procedure Scan_Discriminant_Association_List 
		     (The_List : in Asis.Discriminant_Association_List; 
		      The_Context : in out Context);

	procedure Scan_Entity_Name_Definition 
		     (The_Definition : in Asis.Entity_Name_Definition; 
		      The_Context : in out Context);

	procedure Scan_Entity_Name_Definition_List 
		     (The_List : in Asis.Entity_Name_Definition_List; 
		      The_Context : in out Context);

	procedure Scan_Exception_Handler 
		     (The_Handler : in Asis.Exception_Handler; 
		      The_Context : in out Context);

	procedure Scan_Exception_Handler_List 
		     (The_List : in Asis.Exception_Handler_List; 
		      The_Context : in out Context);

	procedure Scan_Expression (The_Expression : in Asis.Expression; 
				   The_Context : in out Context);

	procedure Scan_Expression_List (The_List : in Asis.Expression_List; 
					The_Context : in out Context);

	procedure Scan_If_Statement_Arm (The_Arm : in Asis.If_Statement_Arm; 
					 The_Context : in out Context);

	procedure Scan_If_Statement_Arm_List 
		     (The_List : in Asis.If_Statement_Arm_List; 
		      The_Context : in out Context);

	procedure Scan_Null_Component (The_Component : in Asis.Record_Component; 
				       The_Context : in out Context);

	procedure Scan_Parameter_Association 
		     (The_Association : in Asis.Association; 
		      The_Context : in out Context);

	procedure Scan_Parameter_Association_List 
		     (The_List : in Asis.Association_List; 
		      The_Context : in out Context);

	procedure Scan_Pragma (The_Pragma : in Asis.Pragma_Element; 
			       The_Context : in out Context);

	procedure Scan_Pragma_List (The_List : in Asis.Pragma_Element_List; 
				    The_Context : in out Context);

	procedure Scan_Record_Component_List 
		     (The_List : in Asis.Record_Component_List; 
		      The_Context : in out Context);

	procedure Scan_Representation_Clause 
		     (The_Clause : in Asis.Representation_Clause; 
		      The_Context : in out Context);

	procedure Scan_Select_Alternative 
		     (The_Alternative : in Asis.Select_Alternative; 
		      The_Context : in out Context);

	procedure Scan_Select_Statement_Arm 
		     (The_Arm : in Asis.Select_Statement_Arm; 
		      The_Context : in out Context);

	procedure Scan_Select_Statement_Arm_List 
		     (The_List : in Asis.Select_Statement_Arm_List; 
		      The_Context : in out Context);

	procedure Scan_Statement (The_Statement : in Asis.Statement; 
				  The_Context : in out Context);

	procedure Scan_Statement_List (The_List : in Asis.Statement_List; 
				       The_Context : in out Context);

	procedure Scan_Subtype_Indication 
		     (The_Indication : in Asis.Subtype_Indication; 
		      The_Context : in out Context);

	procedure Scan_Type_Definition 
		     (The_Definition : in Asis.Type_Definition; 
		      The_Context : in out Context);

	procedure Scan_Use_Clause (The_Clause : in Asis.Context_Clause; 
				   The_Context : in out Context);

	procedure Scan_Variant (The_Variant : in Asis.Variant; 
				The_Context : in out Context);

	procedure Scan_Variant_List (The_List : in Asis.Variant_List; 
				     The_Context : in out Context);

	procedure Scan_Variant_Part (The_Part : in Asis.Record_Component; 
				     The_Context : in out Context);

	procedure Scan_With_Clause (The_Clause : in Asis.Context_Clause; 
				    The_Context : in out Context);

--| Exceptions.  The idea here is that Traversal_Error is the only exception
--| that might propagate out of this package.  Strictly speaking,
--| though, this is not true.  Constraint_Error, Storage_Error, and the
--| I/O exceptions are not caught.  Also, to save space, "unlikely" Asis
--| exceptions such as Asis_Inappropriate_Library are not checked for.

	Traversal_Error : exception;

--| If the following flag is true, Traversal_Error is raised whenever an
--| unrecognized element is encountered.  If it is false, such elements are
--| ignored.

	Raise_Exception_On_Unhandled_Case : Boolean := True;

--| Support for tracing the scan.  The trace is written to Trace_File if
--| it is open, and otherwise to the default output file.  Start_Trace and
--| Stop_Trace may be called at any time and in any order.
--| Trace_On can be used to determine if tracing is currently on.
--|
--| For the region scan, tracing is not supported.

    end Region_Scan_Internal;

--| +-------------------------------------------------------------------------+
--| | LOG_REGION (local)                                                      |
--| +-------------------------------------------------------------------------+

    procedure Log_Region (The_Region : in Rgn.Region) is
    begin

	for I in 1 .. Region_Scan.Current_Level loop
	    Text_Io.Put ("   ");
	end loop;

	Text_Io.Put (Rgn.Region_Kinds'Image (Rgn.Kind (The_Region)));

	Text_Io.Put (" (");
	if Rgn."=" (Rgn.Kind (The_Region), Rgn.A_Compilation_Unit) then
	    Text_Io.Put (Asis_Debug_Support.Compilation_Unit_Image 
			    (Rgn.Head_Unit (The_Region)));
	else
	    Text_Io.Put (Asis_Debug_Support.Element_Image 
			    (Rgn.Head_Element (The_Region)));
	end if;
	Text_Io.Put_Line (")");

    end Log_Region;

--| +-------------------------------------------------------------------------+
--| | PROCESS_REGION (local)                                                  |
--| +-------------------------------------------------------------------------+
--|
--| Called when a declarative region part is encountered.

    procedure Process_Region (The_Region : in Rgn.Region; 
			      State : in out State_Information) is

	Control : Asis_E.Traverse_Control;
	Current_Level : Natural;
	Expand_Instantiations : Boolean;
	Include_Instance_Bodies : Boolean;
	Trace_Scan : Boolean;

    begin

	if Region_Scan.Trace_Scan then
	    Log_Region (The_Region);
	end if;

	Expand_Instantiations := Region_Scan.Expand_Instantiations;
	Include_Instance_Bodies := Region_Scan.Include_Instance_Bodies;
	Trace_Scan := Region_Scan.Trace_Scan;
	Current_Level := Region_Scan.Current_Level;

	Pre_Operation (The_Region, Current_Level, Control, State);

	Region_Scan.Expand_Instantiations := Expand_Instantiations;
	Region_Scan.Include_Instance_Bodies := Include_Instance_Bodies;
	Region_Scan_Internal.Expand_All_Instantiations (Expand_Instantiations);
	Region_Scan.Trace_Scan := Trace_Scan;
	Region_Scan.Current_Level := Current_Level;

	case Control is
	    when Asis_E.Continue =>
		Region_Scan.Current_Level := Region_Scan.Current_Level + 1;
		declare
		    Children : constant Asis.Element_List := 
		       Rgn.Subelements (The_Region);
		begin
		    Region_Scan_Internal.Scan_Any_List (Children, State);
		exception
		    when Abandon_Siblings =>
			null;
		end;
		Region_Scan.Current_Level := Region_Scan.Current_Level - 1;
	    when Asis_E.Abandon_Children =>
		null;
	    when Asis_E.Abandon_Siblings =>
		raise Abandon_Siblings;
	    when Asis_E.Terminate_Immediately =>
		raise Terminate_Scan;
	end case;

	Expand_Instantiations := Region_Scan.Expand_Instantiations;
	Include_Instance_Bodies := Region_Scan.Include_Instance_Bodies;
	Trace_Scan := Region_Scan.Trace_Scan;
	Current_Level := Region_Scan.Current_Level;

	Post_Operation (The_Region, Current_Level, Control, State);

	Region_Scan.Expand_Instantiations := Expand_Instantiations;
	Region_Scan.Include_Instance_Bodies := Include_Instance_Bodies;
	Region_Scan_Internal.Expand_All_Instantiations (Expand_Instantiations);
	Region_Scan.Trace_Scan := Trace_Scan;
	Region_Scan.Current_Level := Current_Level;

	case Control is
	    when Asis_E.Continue =>
		null;
	    when Asis_E.Abandon_Children =>
		null;
	    when Asis_E.Abandon_Siblings =>
		raise Abandon_Siblings;
	    when Asis_E.Terminate_Immediately =>
		raise Terminate_Scan;
	end case;

    end Process_Region;

--| +-------------------------------------------------------------------------+
--| | REGION_SCAN_INTERNAL (local)                                            |
--| +-------------------------------------------------------------------------+
--|
--| The body of Region_Scan_Internal is placed here so it has visibility of
--| procedure Process_Region.

    package body Region_Scan_Internal is separate;

--| +-------------------------------------------------------------------------+
--| | TRAVERSE_UNIT (exported)                                                |
--| +-------------------------------------------------------------------------+

    procedure Traverse_Unit (Unit : in Asis.Compilation_Unit; 
			     State : in out State_Information; 
			     Expand_Instantiations : in Boolean := False; 
			     Include_Instance_Bodies : in Boolean := False; 
			     Trace_Scan : in Boolean := False) is
    begin

	Region_Scan.Expand_Instantiations := Expand_Instantiations;
	Region_Scan.Include_Instance_Bodies := Include_Instance_Bodies;
	Region_Scan_Internal.Expand_All_Instantiations (Expand_Instantiations);
	Region_Scan.Trace_Scan := Trace_Scan;
	Region_Scan.Current_Level := 0;

	Region_Scan_Internal.Scan_Compilation_Unit (Unit, State);

    exception

	when Abandon_Siblings | Terminate_Scan =>
	    null;

	when Region_Scan_Internal.Traversal_Error | Rgn.Region_Error =>
	    raise Traversal_Error;

    end Traverse_Unit;

--| +-------------------------------------------------------------------------+
--| | TRAVERSE_ELEMENT (exported)                                             |
--| +-------------------------------------------------------------------------+

    procedure Traverse_Element (Element : in Asis.Element; 
				State : in out State_Information; 
				Expand_Instantiations : in Boolean := False; 
				Include_Instance_Bodies : in Boolean := False; 
				Trace_Scan : in Boolean := False) is
    begin

	Region_Scan.Expand_Instantiations := Expand_Instantiations;
	Region_Scan.Include_Instance_Bodies := Include_Instance_Bodies;
	Region_Scan_Internal.Expand_All_Instantiations (Expand_Instantiations);
	Region_Scan.Trace_Scan := Trace_Scan;
	Region_Scan.Current_Level := 0;

	Region_Scan_Internal.Scan_Any (Element, State);

    exception

	when Abandon_Siblings | Terminate_Scan =>
	    null;

	when Region_Scan_Internal.Traversal_Error | Rgn.Region_Error =>
	    raise Traversal_Error;

    end Traverse_Element;

end Region_Scan;