-- ============================================================================
-- >>>>>>>>>>>>>>>>>>>>>>>>>> ADA COMPILATION UNIT <<<<<<<<<<<<<<<<<<<<<<<<<<<<
-- ============================================================================
--
-- NAME:        Control_Flow_Save
--
--              BODY
--
-- AUTHOR:      Pilar Montes
--              General Research Corporation
--
--                            CHANGE 
--
-- MM-DD-YY | Initials | Description
-- ---------------------------------------------------------------------------
-- 03/29/94    PNM       Added edge (arc) labels.
-- 04/27/94    PNM       Send output to standard output instead of a .grl file.
-- 01/24/95    CWH       Revised to reflect change in interface. Process_Node
--                       and Process_Edge are now internal operations.
-- ===========================================================================

with Asis;
with Control_Flow_Defs;
with Text_Io;
with Unchecked_Deallocation;

package body Control_Flow_Save is

    Cuid : constant String := "Control_Flow_Save";

    package Cf_Defs renames Control_Flow_Defs;
    package Cf_Graph renames Control_Flow_Defs.Control_Graph;
    package Asis_Cu renames Asis.Compilation_Units;
    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_Td renames Asis.Type_Definitions;
    package Asis_T renames Asis.Text;
    package Asis_X renames Asis.Expressions;

--| Using String_Ptr's instead of String's makes string manipulation easier.

    type String_Ptr is access String;
    procedure Free is new Unchecked_Deallocation (String, String_Ptr);

----------------------------------------------------------------------------
-- LOCAL SUBPROGRAM DECLARATIONS
----------------------------------------------------------------------------

    procedure Concatenate (The_String : in out String_Ptr; 
			   And_The_String : in String);

--| Concatenates two strings.  The first string is specified by a pointer;
--| the second, directly.  The first string is freed, and the pointer is
--| updated to point to the resultant string.

    function Node_Title (The_Vertex : in Cf_Graph.Vertex) return String;

--| Builds the node title for the given vertex.  The node title contains
--| the Asis element kind and line number (e.g. If_Statement(200) )


    procedure Process_Edge (The_Arc : in Cf_Graph.Arc; Continue : out Boolean);

--| Create a text line which describes the edge for the Edge program.
--| The format:  edge: { sourcename: "node_title1" targetname: "node_title2"
--|   label: "edge_label" }

    procedure Process_Node (The_Vertex : in Cf_Graph.Vertex; 
			    Continue : out Boolean);

--| Creates a text line which describes the node for the Edge program.
--| The format:      node: { title: "node_title" }

    procedure Save_Nodes is new Cf_Graph.Iterate_Vertices (Process_Node);
    procedure Save_Edges is new Cf_Graph.Iterate_Arcs (Process_Edge);

----------------------------------------------------------------------------
-- EXPORTED SUBPROGRAM BODIES
----------------------------------------------------------------------------

    procedure Save_In_Grl_Format (The_View : in 
				     Control_Flow_Defs.Control_Flow_View; 
				  To_The_File : in Text_Io.File_Type) is
    begin
	-- Save the graph data to standard output.  The output is formatted 
	-- in a form suitable for input to the Edge program.

	Text_Io.Put_Line ("graph: {");
	Text_Io.Put_Line ("/* list of nodes */");
	Save_Nodes (Over_The_Graph => The_View.Graph);

	Text_Io.Put_Line ("/* list of edges */");
	Save_Edges (Over_The_Graph => The_View.Graph);
	Text_Io.Put_Line ("}");
    end Save_In_Grl_Format;

----------------------------------------------------------------------------
-- LOCAL SUBPROGRAM BODIES
----------------------------------------------------------------------------

    procedure Concatenate (The_String : in out String_Ptr; 
			   And_The_String : in String) is

	S : String_Ptr;

    begin

	S := new String (1 .. The_String'Length + And_The_String'Length);
	S.all := The_String.all & And_The_String;
	Free (The_String);
	The_String := S;

    end Concatenate;

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

    function Node_Title (The_Vertex : in Cf_Graph.Vertex) return String is

	Puid : constant String := "Node_Title";

	If_Arm_Kind : Asis_S.If_Statement_Arm_Kinds;
	Statement_Kind : Asis_S.Statement_Kinds;
	The_Image : String_Ptr;
	The_Item : Cf_Defs.Item_Type_Ptr;
	The_Element : Asis.Element;
	The_Element_Kind : Asis_E.Element_Kinds;
	Vertex_Kind : Cf_Defs.Node_Kind_Type;

    begin

	The_Image := new String (1 .. 0);
	The_Item := Cf_Graph.Item_Of (The_Vertex => The_Vertex);
	Vertex_Kind := The_Item.Kind;
	The_Element := The_Item.Element;
	The_Element_Kind := Asis_E.Element_Kind (The_Element);

	case Vertex_Kind is
	    when Cf_Defs.Start =>
		Concatenate (The_Image, " Start");

	    when Cf_Defs.Terminal =>
		Concatenate (The_Image, " Terminal");

	    when others =>  
		case The_Element_Kind is
		    when Asis_E.A_Statement =>
			Statement_Kind := Asis_S.Kind (The_Element);
			Concatenate (The_Image, 
				     " " & Asis_S.Statement_Kinds'Image 
					      (Statement_Kind));

		    when Asis_E.An_If_Statement_Arm =>
			If_Arm_Kind := 
			   Asis_S.If_Statement_Arm_Kind (The_Element);
			Concatenate (The_Image, 
				     " " & Asis_S.If_Statement_Arm_Kinds'Image 
					      (If_Arm_Kind));
		    when others =>
			Concatenate (The_Image, "Improper Element ???");
		end case;

		Concatenate 
		   (The_Image, 
		    "(" & Asis.Line_Number'Image 
			     (Asis_T.First_Line_Number (The_Element)) & ")");
	end case;


	declare
	    Return_Image : String (1 .. The_Image'Length);
	begin
	    Return_Image := The_Image.all;
	    Free (The_Image);
	    return Return_Image;
	end;

    exception

	when Asis.Asis_Inappropriate_Element | Asis.Asis_Failed =>
	    Free (The_Image);
	    return "<unable to query element>";

    end Node_Title;

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

    procedure Process_Node (The_Vertex : in Cf_Graph.Vertex; 
			    Continue : out Boolean) is

	Puid : constant String := "Process_Node";

    begin

	Text_Io.Put_Line ("node: { title: """ & 
			  Node_Title (The_Vertex) & """ }");
	Continue := True;
	return;

    end Process_Node;

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

    procedure Process_Edge (The_Arc : in Cf_Graph.Arc; 
			    Continue : out Boolean) is

	Puid : constant String := "Process_Edge";
	The_Image : String_Ptr;
	The_Vertex : Cf_Graph.Vertex;
	The_Attribute : Cf_Defs.Edge_Type_Ptr;

    begin

	The_Image := new String (1 .. 0);
	Concatenate (The_Image, "edge: { sourcename: """);
	The_Vertex := Cf_Graph.Source_Of (The_Arc => The_Arc);

	Concatenate (The_Image, Node_Title (The_Vertex) & """ targetname: """);
	The_Vertex := Cf_Graph.Destination_Of (The_Arc => The_Arc);
	Concatenate (The_Image, Node_Title (The_Vertex) & """ label: """);

	The_Attribute := Cf_Graph.Attribute_Of (The_Arc => The_Arc);
	Concatenate 
	   (The_Image, 
	    Cf_Defs.Edge_Kind_Type'Image (The_Attribute.Kind) & """ }");

	Text_Io.Put_Line (The_Image.all);
	Continue := True;
    end Process_Edge;

end Control_Flow_Save;