-- ============================================================================
-- >>>>>>>>>>>>>>>>>>>>>>>>>> ADA COMPILATION UNIT <<<<<<<<<<<<<<<<<<<<<<<<<<<<
-- ============================================================================
--
-- NAME:        Dump_Region_View
--
--              BODY
-- 
-- AUTHOR:      Chuck Hobin
--              General Research Corporation
--
--                               CHANGE HISTORY
--
-- MM-DD-YY | Initials | Description
-- ----------------------------------------------------------------------------
-- <include SPR#, if applicable>
-- ============================================================================

with Asis;
with Asis_Debug_Support;
with Region_Support;
with Unchecked_Deallocation;

package body Dump_Region_View is

    package Asis_D renames Asis.Declarations;
    package Asis_E renames Asis.Elements;
    package Asis_Rc renames Asis.Representation_Clauses;
    package Asis_S renames Asis.Statements;
    package Asis_X renames Asis.Expressions;
    package Structures renames Region_View_Structures;

-- An association list associates a unique integer Id with a region part.

    type Association_List_Element;

    type Association_List is access Association_List_Element;

    type Association_List_Element is
	record
	    Id : Positive;
	    Part : Structures.Region_Part_Ptr;
	    Next : Association_List;
	end record;

-- Global variables

    The_Association_List : Association_List;
    Next_Id : Positive;


    procedure Dump_Region_Part_Tree (The_Tree : in Structures.Region_Part_Ptr; 
				     To_The_File : in Text_Io.File_Type);

    procedure Dump_Declarative_Region_Tree 
		 (The_Tree : in Structures.Declarative_Region_Ptr; 
		  To_The_File : in Text_Io.File_Type);

    procedure Dump_Parts_Of_Declarative_Region 
		 (The_Region : in Structures.Declarative_Region_Ptr; 
		  Depth : Natural; 
		  To_The_File : in Text_Io.File_Type);

    procedure Put_Indent (Depth : in Natural; 
			  To_The_File : in Text_Io.File_Type);

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

    procedure Associate_Id_With_Part (Id : in Positive; 
				      Region_Part : Structures.Region_Part_Ptr);

    function Get_Id_Of_Part 
		(Region_Part : in Structures.Region_Part_Ptr) return Positive;
    -- Get_Id_Of_Part raises Part_Not_Found if no Id has been associated with
    -- the Region_Part.

    Part_Not_Found : exception;

    procedure Destroy_Association_List (The_List : in out Association_List);

    procedure Free is new Unchecked_Deallocation 
			     (Association_List_Element, Association_List);

    package Integer_Io is new Text_Io.Integer_Io (Integer);

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

    procedure Dump (The_View : in Region_View_Structures.Region_View; 
		    To_The_File : in Text_Io.File_Type := 
		       Text_Io.Standard_Output) is

	F : Text_Io.File_Type renames To_The_File;
	Comp_Unit_List : Structures.Comp_Unit_List;

	use Region_View_Structures; -- for direct visibility of operators

    begin
	Text_Io.Put_Line 
	   (F, "===================> DUMP OF REGION VIEW <==================");
	Text_Io.New_Line (F);

	if The_View = null then
	    Text_Io.Put_Line (F, "-- the view is null --");
	    return;
	end if;

	-- Print the name of each compilation unit in the view.

	Text_Io.Put_Line 
	   (F, "-------------------> Compilation Units <--------------------");
	Text_Io.New_Line (F);

	if The_View.Comp_Units = null then
	    Text_Io.Put_Line (F, "-- none --");
	    return;
	end if;

	Comp_Unit_List := The_View.Comp_Units;
	while Comp_Unit_List /= null loop
	    Text_Io.Put_Line (F, Asis_Debug_Support.Compilation_Unit_Image 
				    (Comp_Unit_List.The_Unit.Asis_Comp_Unit));
	    Comp_Unit_List := Comp_Unit_List.Next;
	end loop;
	Text_Io.New_Line (F);

	-- Print the current compilation unit, if any.

	Text_Io.Put (F, "Current Compilation Unit : ");
	if The_View.Current_Comp_Unit /= null then
	    Text_Io.Put_Line (F, 
			      Asis_Debug_Support.Compilation_Unit_Image 
				 (The_View.Current_Comp_Unit.Asis_Comp_Unit));
	else
	    Text_Io.Put_Line (F, "-- none --");
	end if;
	Text_Io.New_Line (F);

	-- Print the region part tree of each compilation unit.  Each region
	-- part is assigned an integer value to enable cross-checking
	-- betweeen the region part trees and the declarative region tree.

	Next_Id := 1;

	Comp_Unit_List := The_View.Comp_Units;
	while Comp_Unit_List /= null loop
	    Text_Io.Put_Line 
	       (F, 
		"--------------------> Region Part Tree <--------------------");
	    Text_Io.New_Line (F);
	    Text_Io.Put_Line (F, Asis_Debug_Support.Compilation_Unit_Image 
				    (Comp_Unit_List.The_Unit.Asis_Comp_Unit));
	    Text_Io.New_Line (F);
	    Dump_Region_Part_Tree 
	       (Comp_Unit_List.The_Unit.Region_Part_Tree, To_The_File => F);
	    Text_Io.New_Line (F);

	    Comp_Unit_List := Comp_Unit_List.Next;
	end loop;

	-- Print the declarative region tree.

	Text_Io.Put_Line 
	   (F, "-----------------> Declarative Region Tree <----------------");
	Text_Io.New_Line (F);

	Dump_Declarative_Region_Tree 
	   (The_View.Declarative_Region_Tree, To_The_File => F);

	Destroy_Association_List (The_Association_List);

    end Dump;
-------------------------------------------------------------------------------

    procedure Dump_Region_Part_Tree (The_Tree : in Structures.Region_Part_Ptr; 
				     To_The_File : in Text_Io.File_Type) is

	F : Text_Io.File_Type renames To_The_File;

	procedure Recursive_Dump (The_Tree : in Structures.Region_Part_Ptr; 
				  Depth : in Natural) is

	    Subtree_List : Structures.Region_Part_List;
	    Kind : Region_Support.Region_Kinds;
	    Region_Part_Id : Positive;

	    use Region_View_Structures;
	    use Region_Support;
	begin
	    if The_Tree /= null then

		Put_Indent (Depth, To_The_File);

		Kind := Region_Support.Kind (The_Tree.Region);
		if Kind = Region_Support.A_Compilation_Unit then
		    Text_Io.Put (F, Region_Support.Region_Kinds'Image (Kind));
		    Text_Io.New_Line (F);
		else
		    Region_Part_Id := Next_Id;
		    Next_Id := Next_Id + 1;
		    Associate_Id_With_Part (Region_Part_Id, The_Tree);

		    declare
			Num_String : constant String := 
			   Integer'Image (Region_Part_Id);
		    begin
			Text_Io.Put 
			   (F, '(' & 
				  Num_String 
				     (Num_String'First + 1 .. Num_String'Last) & 
				  ')');
		    end;
		    Text_Io.Put 
		       (F, ' ' & Region_Support.Region_Kinds'Image (Kind));
		    Text_Io.Put (F, ' ' & Element_String 
					     (Region_Support.Head_Element 
						 (The_Tree.Region)));
		    Text_Io.New_Line (F);
		end if;

		Subtree_List := The_Tree.Children;
		while Subtree_List /= null loop
		    Recursive_Dump (Subtree_List.Region_Part, Depth + 1);
		    Subtree_List := Subtree_List.Next;
		end loop;
	    end if;
	end Recursive_Dump;

    begin
	Recursive_Dump (The_Tree, Depth => 0);
    end Dump_Region_Part_Tree;

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

    procedure Dump_Declarative_Region_Tree 
		 (The_Tree : in Structures.Declarative_Region_Ptr; 
		  To_The_File : in Text_Io.File_Type) is

	F : Text_Io.File_Type renames To_The_File;

	procedure Recursive_Dump 
		     (The_Tree : in Structures.Declarative_Region_Ptr; 
		      Depth : in Natural) is

	    Subtree_List : Structures.Declarative_Region_List;

	    use Region_View_Structures;
	begin
	    if The_Tree /= null then

		Put_Indent (Depth, To_The_File);

		Text_Io.Put (F, Structures.Declarative_Region_Kinds'Image 
				   (The_Tree.Kind));
		Text_Io.Put (F, ' ' & Element_String 
					 (The_Tree.Defining_Element));
		Text_Io.New_Line (F);

		-- Print the region parts making up the region.

		Dump_Parts_Of_Declarative_Region (The_Tree, Depth, F);

		Subtree_List := The_Tree.Children;
		while Subtree_List /= null loop
		    Recursive_Dump (Subtree_List.Declarative_Region, Depth + 1);
		    Subtree_List := Subtree_List.Next;
		end loop;
	    end if;
	end Recursive_Dump;

    begin
	Recursive_Dump (The_Tree, Depth => 0);
    end Dump_Declarative_Region_Tree;

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

    procedure Dump_Parts_Of_Declarative_Region 
		 (The_Region : in Structures.Declarative_Region_Ptr; 
		  Depth : Natural; 
		  To_The_File : in Text_Io.File_Type) is

	procedure Print (Part : in Structures.Region_Part_Ptr; 
			 Label : in String) is
	    Part_Id : Positive;
	begin
	    Text_Io.Put (To_The_File, "| ");
	    for I in 1 .. Depth loop
		Text_Io.Put (To_The_File, "  | ");
	    end loop;

	    begin
		Part_Id := Get_Id_Of_Part (Part);
		declare
		    Num_String : constant String := Integer'Image (Part_Id);
		begin
		    Text_Io.Put 
		       (To_The_File, 
			'(' & Num_String 
				 (Num_String'First + 1 .. Num_String'Last) & 
			   ')');
		end;
	    exception
		when Part_Not_Found =>
		    Text_Io.Put (To_The_File, "(?)");
	    end;
	    Text_Io.Put (To_The_File, ' ' & Label);
	    Text_Io.New_Line (To_The_File);
	end Print;

	use Region_View_Structures;

    begin
	case The_Region.Kind is
	    when Structures.A_Package | Structures.A_Generic_Package =>
		case The_Region.Kind is
		    when Structures.A_Generic_Package =>
			if The_Region.Generic_Package_Formal_Part /= null then
			    Print (The_Region.Generic_Package_Formal_Part, 
				   "Generic_Package_Formal_Part");
			end if;
		    when others =>
			null;
		end case;
		if The_Region.Package_Visible_Region_Part /= null then
		    Print (The_Region.Package_Visible_Region_Part, 
			   "Package_Visible_Region_Part");
		end if;
		if The_Region.Package_Private_Region_Part /= null then
		    Print (The_Region.Package_Private_Region_Part, 
			   "Package_Private_Region_Part");
		end if;
		if The_Region.Package_Stub_Region_Part /= null then
		    Print (The_Region.Package_Stub_Region_Part, 
			   "Package_Stub_Region_Part");
		end if;
		if The_Region.Package_Body_Region_Part /= null then
		    Print (The_Region.Package_Body_Region_Part, 
			   "Package_Body_Region_Part");
		end if;
	    when Structures.A_Subprogram | Structures.A_Generic_Subprogram =>
		case The_Region.Kind is
		    when Structures.A_Generic_Subprogram =>
			if The_Region.Generic_Subprogram_Formal_Part /= 
			   null then
			    Print (The_Region.Generic_Subprogram_Formal_Part, 
				   "Generic_Subprogram_Formal_Part");
			end if;
		    when others =>
			null;
		end case;
		if The_Region.Subprogram_Spec_Region_Part /= null then
		    Print (The_Region.Subprogram_Spec_Region_Part, 
			   "Subprogram_Spec_Region_Part");
		end if;
		if The_Region.Subprogram_Stub_Region_Part /= null then
		    Print (The_Region.Subprogram_Stub_Region_Part, 
			   "Subprogram_Stub_Region_Part");
		end if;
		if The_Region.Subprogram_Body_Region_Part /= null then
		    Print (The_Region.Subprogram_Body_Region_Part, 
			   "Subprogram_Body_Region_Part");
		end if;
	    when Structures.A_Task =>
		if The_Region.Task_Spec_Region_Part /= null then
		    Print (The_Region.Task_Spec_Region_Part, 
			   "Task_Spec_Region_Part");
		end if;
		if The_Region.Task_Stub_Region_Part /= null then
		    Print (The_Region.Task_Stub_Region_Part, 
			   "Task_Stub_Region_Part");
		end if;
		if The_Region.Task_Body_Region_Part /= null then
		    Print (The_Region.Task_Body_Region_Part, 
			   "Task_Body_Region_Part");
		end if;
	    when Structures.An_Entry =>
		if The_Region.Entry_Declaration_Region_Part /= null then
		    Print (The_Region.Entry_Declaration_Region_Part, 
			   "Entry_Declaration_Region_Part");
		end if;
		declare
		    List : Structures.Region_Part_List := 
		       The_Region.Accept_Statement_Region_Parts;
		begin
		    while List /= null loop
			Print (List.Region_Part, 
			       "Accept_Statement_Region_Part");
			List := List.Next;
		    end loop;
		end;
	    when Structures.A_Record_Type =>
		if The_Region.Private_Or_Incomplete_Region_Part /= null then
		    Print (The_Region.Private_Or_Incomplete_Region_Part, 
			   "Private_Or_Incomplete_Region_Part");
		end if;
		if The_Region.Record_Type_Region_Part /= null then
		    Print (The_Region.Record_Type_Region_Part, 
			   "Record_Type_Region_Part");
		end if;
		if The_Region.Record_Rep_Clause_Region_Part /= null then
		    Print (The_Region.Record_Rep_Clause_Region_Part, 
			   "Record_Rep_Clause_Region_Part");
		end if;
	    when Structures.A_Rename =>
		if The_Region.Rename_Region_Part /= null then
		    Print (The_Region.Rename_Region_Part, "Rename_Region_Part");
		end if;
	    when Structures.A_Generic_Formal_Subprogram =>
		if The_Region.Generic_Formal_Subprogram_Region_Part /= null then
		    Print (The_Region.Generic_Formal_Subprogram_Region_Part, 
			   "Generic_Formal_Subprogram_Region_Part");
		end if;
	    when Structures.A_Generic_Formal_Private_Type =>
		if The_Region.Generic_Formal_Private_Type_Region_Part /= 
		   null then
		    Print (The_Region.Generic_Formal_Private_Type_Region_Part, 
			   "Generic_Formal_Private_Type_Region_Part");
		end if;
	    when Structures.A_Block_Statement =>
		if The_Region.Block_Statement_Region_Part /= null then
		    Print (The_Region.Block_Statement_Region_Part, 
			   "Block_Statement_Region_Part");
		end if;
	    when Structures.A_Loop_Statement =>
		if The_Region.Loop_Statement_Region_Part /= null then
		    Print (The_Region.Loop_Statement_Region_Part, 
			   "Loop_Statement_Region_Part");
		end if;
	end case;
    end Dump_Parts_Of_Declarative_Region;

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

    procedure Put_Indent (Depth : in Natural; 
			  To_The_File : in Text_Io.File_Type) is
    begin
	if Depth > 0 then
	    for I in 1 .. Depth - 1 loop
		Text_Io.Put (To_The_File, "|   ");
	    end loop;
	    Text_Io.Put (To_The_File, "+---");
	end if;
    end Put_Indent;

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

    function Element_String (The_Element : in Asis.Element) return String is
    begin
	case Asis_E.Element_Kind (The_Element) is
	    when Asis_E.A_Declaration =>
		return '"' & Asis_X.Name (Asis_D.Names (The_Element) (1)) & 
			  """ (" & Asis_D.Declaration_Kinds'Image 
				      (Asis_D.Kind (The_Element)) & ')';
	    when Asis_E.A_Statement =>
		return 
		   '(' & 
		      Asis_S.Statement_Kinds'Image (Asis_S.Kind (The_Element)) & 
		      ')';
	    when Asis_E.A_Representation_Clause =>
		-- Can only be a record rep clause.
		return 
		   '"' & 
		      Asis_X.Name 
			 (Asis_Rc.Record_Representation_Clause_Type_Simple_Name 
			     (The_Element)) & 
		      """ (" & 
		      Asis_Rc.Representation_Clause_Kinds'Image 
			 (Asis_Rc.Kind (The_Element)) & 
		      ')';
	    when others =>
		return "!!! (" & Asis_E.Element_Kinds'Image 
				    (Asis_E.Element_Kind (The_Element)) & ')';
	end case;
    end Element_String;

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

    procedure Associate_Id_With_Part 
		 (Id : in Positive; Region_Part : Structures.Region_Part_Ptr) is
    begin
	The_Association_List := 
	   new Association_List_Element'
		  (Id => Id, Part => Region_Part, Next => The_Association_List);
    end Associate_Id_With_Part;

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

    function Get_Id_Of_Part 
		(Region_Part : in Structures.Region_Part_Ptr) return Positive is

	List : Association_List := The_Association_List;

	use Region_View_Structures;
    begin
	while List /= null loop
	    if List.Part = Region_Part then
		return List.Id;
	    end if;
	    List := List.Next;
	end loop;

	raise Part_Not_Found;

    end Get_Id_Of_Part;

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

    procedure Destroy_Association_List (The_List : in out Association_List) is

	List : Association_List := The_List;
	Next : Association_List;

    begin
	while List /= null loop
	    Next := List.Next;
	    Free (List);
	    List := Next;
	end loop;
	The_List := null;
    end Destroy_Association_List;

end Dump_Region_View;