[m-dev.] [reuse] diff: write out call graph

[Peter Ross]

Hi,


===================================================================


Estimated hours taken: 4

Output the call graph of the module in the .profile file.
Nodes which are red squares are those which have structure reuse.

dependency_graph.m:
    Add dependency_graph__build_dependency_graph with an option of
    whether or not we consider imported procedures.
    Add some higher order code to write out a dependency graph.

sr_profile.m:
    Write out the dependency graph, coloring any procedures which have
    reuse.

sr_profile_run.m:
    Pass the HLDS to sr_profile__write_profiling.


Index: dependency_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.48.2.1
diff -u -r1.48.2.1 dependency_graph.m
--- dependency_graph.m	2000/09/27 14:59:12	1.48.2.1
+++ dependency_graph.m	2000/10/23 14:33:48
@@ -21,11 +21,18 @@
 
 :- interface.
 :- import_module hlds_module, hlds_pred.
-:- import_module list, io.
+:- import_module bool, list, io.
 
 :- pred module_info_ensure_dependency_info(module_info, module_info).
 :- mode module_info_ensure_dependency_info(in, out) is det.
 
+	% Give me the dependency graph.  If the bool is yes then
+	% imported_procedures aren't included in the dependency graph,
+	% otherwise they are.
+:- pred dependency_graph__build_dependency_graph(module_info, bool,
+		dependency_info).
+:- mode dependency_graph__build_dependency_graph(in, in, out) is det.
+
 :- pred dependency_graph__write_dependency_graph(module_info, module_info,
 						io__state, io__state).
 :- mode dependency_graph__write_dependency_graph(in, out, di, uo) is det.
@@ -56,6 +63,28 @@
 :- pred module_info_ensure_aditi_dependency_info(module_info, module_info).
 :- mode module_info_ensure_aditi_dependency_info(in, out) is det.
 
+	% write_graph(Graph, WriteNode, WriteEdge)
+	%
+	% Write out the dependency graph using two higher predicates to
+	% decide output a node and any edges.
+	%
+:- pred write_graph(dependency_info::in,
+	pred(pred_proc_id, io__state, io__state)::pred(in, di, uo) is det,
+	pred(pred_proc_id, pred_proc_id, io__state, io__state)::
+			pred(in, in, di, uo) is det,
+	io__state::di, io__state::uo) is det.
+
+	% write_graph_nodes(Nodes, Graph, WriteNode, WriteEdge)
+	%
+	% Write out each of the Nodes in the Graph and any edges
+	% origination in Nodes.
+	%
+:- pred write_graph_nodes(list(pred_proc_id)::in, dependency_graph::in,
+	pred(pred_proc_id, io__state, io__state)::pred(in, di, uo) is det,
+	pred(pred_proc_id, pred_proc_id, io__state, io__state)::
+			pred(in, in, di, uo) is det,
+	io__state::di, io__state::uo) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -85,21 +114,19 @@
 	( MaybeDepInfo = yes(_) ->
 	    ModuleInfo = ModuleInfo0
 	;
-	    dependency_graph__build_dependency_graph(ModuleInfo0, ModuleInfo)
+	    dependency_graph__build_dependency_graph(ModuleInfo0, yes, DepInfo),
+	    module_info_set_dependency_info(ModuleInfo0, DepInfo, ModuleInfo)
 	).
 
 	% Traverse the module structure, calling `dependency_graph__add_arcs'
 	% for each procedure body.
 
-:- pred dependency_graph__build_dependency_graph(module_info, module_info).
-:- mode dependency_graph__build_dependency_graph(in, out) is det.
-
-dependency_graph__build_dependency_graph(ModuleInfo0, ModuleInfo) :-
+dependency_graph__build_dependency_graph(ModuleInfo0, LocalOnly, DepInfo) :-
 	module_info_predids(ModuleInfo0, PredIds),
 	relation__init(DepGraph0),
-	dependency_graph__add_pred_nodes(PredIds, ModuleInfo0,
+	dependency_graph__add_pred_nodes(PredIds, ModuleInfo0, LocalOnly,
 				DepGraph0, DepGraph1),
-	dependency_graph__add_pred_arcs(PredIds, ModuleInfo0,
+	dependency_graph__add_pred_arcs(PredIds, ModuleInfo0, LocalOnly,
 				DepGraph1, DepGraph),
 	hlds_dependency_info_init(DepInfo0),
 	hlds_dependency_info_set_dependency_graph(DepInfo0, DepGraph,
@@ -107,8 +134,7 @@
 	relation__atsort(DepGraph, DepOrd0),
 	dependency_graph__sets_to_lists(DepOrd0, [], DepOrd),
 	hlds_dependency_info_set_dependency_ordering(DepInfo1, DepOrd,
-				DepInfo),
-	module_info_set_dependency_info(ModuleInfo0, DepInfo, ModuleInfo).
+				DepInfo).
 
 :- pred dependency_graph__sets_to_lists( list(set(pred_proc_id)),
 			list(list(pred_proc_id)), list(list(pred_proc_id))).
@@ -123,21 +149,28 @@
 %-----------------------------------------------------------------------------%
 
 :- pred dependency_graph__add_pred_nodes(list(pred_id), module_info,
-                        dependency_graph, dependency_graph).
-:- mode dependency_graph__add_pred_nodes(in, in, in, out) is det.
+		bool, dependency_graph, dependency_graph).
+:- mode dependency_graph__add_pred_nodes(in, in, in, in, out) is det.
 
-dependency_graph__add_pred_nodes([], _ModuleInfo, DepGraph, DepGraph).
-dependency_graph__add_pred_nodes([PredId | PredIds], ModuleInfo,
+dependency_graph__add_pred_nodes([], _ModuleInfo, _, DepGraph, DepGraph).
+dependency_graph__add_pred_nodes([PredId | PredIds], ModuleInfo, LocalOnly,
                                         DepGraph0, DepGraph) :-
         module_info_preds(ModuleInfo, PredTable),
         map__lookup(PredTable, PredId, PredInfo),
-	% Don't bother adding nodes (or arcs) for procedures
-	% which which are imported (ie we don't have any `clauses'
-	% for).
-	pred_info_non_imported_procids(PredInfo, ProcIds),
+	(
+		% Don't bother adding nodes (or arcs) for procedures
+		% which which are imported (ie we don't have any
+		% `clauses' for).
+		LocalOnly = yes,
+		pred_info_non_imported_procids(PredInfo, ProcIds)
+	;
+		LocalOnly = no,
+		pred_info_procids(PredInfo, ProcIds)
+	),
+
 	dependency_graph__add_proc_nodes(ProcIds, PredId, ModuleInfo,
 		DepGraph0, DepGraph1),
-        dependency_graph__add_pred_nodes(PredIds, ModuleInfo,
+        dependency_graph__add_pred_nodes(PredIds, ModuleInfo, LocalOnly,
 		DepGraph1, DepGraph).
 
 :- pred dependency_graph__add_proc_nodes(list(proc_id), pred_id, module_info,
@@ -154,39 +187,70 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-:- pred dependency_graph__add_pred_arcs(list(pred_id), module_info,
+:- pred dependency_graph__add_pred_arcs(list(pred_id), module_info, bool,
 			dependency_graph, dependency_graph).
-:- mode dependency_graph__add_pred_arcs(in, in, in, out) is det.
+:- mode dependency_graph__add_pred_arcs(in, in, in, in, out) is det.
 
-dependency_graph__add_pred_arcs([], _ModuleInfo, DepGraph, DepGraph).
-dependency_graph__add_pred_arcs([PredId | PredIds], ModuleInfo,
+dependency_graph__add_pred_arcs([], _ModuleInfo, _, DepGraph, DepGraph).
+dependency_graph__add_pred_arcs([PredId | PredIds], ModuleInfo, LocalOnly,
 					DepGraph0, DepGraph) :-
 	module_info_preds(ModuleInfo, PredTable),
 	map__lookup(PredTable, PredId, PredInfo),
-	pred_info_non_imported_procids(PredInfo, ProcIds),
-	dependency_graph__add_proc_arcs(ProcIds, PredId, ModuleInfo,
+	(
+		% Don't bother adding nodes (or arcs) for procedures
+		% which which are imported (ie we don't have any
+		% `clauses' for).
+		LocalOnly = yes,
+		pred_info_non_imported_procids(PredInfo, ProcIds)
+	;
+		LocalOnly = no,
+		pred_info_procids(PredInfo, ProcIds)
+	),
+	dependency_graph__add_proc_arcs(ProcIds, PredId, ModuleInfo, LocalOnly,
 			DepGraph0, DepGraph1),
-	dependency_graph__add_pred_arcs(PredIds, ModuleInfo,
+	dependency_graph__add_pred_arcs(PredIds, ModuleInfo, LocalOnly,
 			DepGraph1, DepGraph).
 
 :- pred dependency_graph__add_proc_arcs(list(proc_id), pred_id, module_info,
-			dependency_graph, dependency_graph).
-:- mode dependency_graph__add_proc_arcs(in, in, in, in, out) is det.
+			bool, dependency_graph, dependency_graph).
+:- mode dependency_graph__add_proc_arcs(in, in, in, in, in, out) is det.
 
-dependency_graph__add_proc_arcs([], _PredId, _ModuleInfo, DepGraph, DepGraph).
+dependency_graph__add_proc_arcs([], _PredId, _ModuleInfo, _,
+		DepGraph, DepGraph).
 dependency_graph__add_proc_arcs([ProcId | ProcIds], PredId, ModuleInfo,
-						DepGraph0, DepGraph) :-
+		LocalOnly, DepGraph0, DepGraph) :-
+
 	module_info_preds(ModuleInfo, PredTable0),
 	map__lookup(PredTable0, PredId, PredInfo0),
 	pred_info_procedures(PredInfo0, ProcTable0),
 	map__lookup(ProcTable0, ProcId, ProcInfo0),
 
-	proc_info_goal(ProcInfo0, Goal),
+	(
+		LocalOnly = yes,
+		proc_info_goal(ProcInfo0, Goal),
 
-	relation__lookup_element(DepGraph0, proc(PredId, ProcId), Caller),
-	dependency_graph__add_arcs_in_goal(Goal, Caller, DepGraph0, DepGraph1),
+		relation__lookup_element(DepGraph0,
+				proc(PredId, ProcId), Caller),
+		dependency_graph__add_arcs_in_goal(Goal, Caller,
+				DepGraph0, DepGraph1)
+	;
+		LocalOnly = no,
+		pred_info_import_status(PredInfo0, ImportStatus),
+		status_is_imported(ImportStatus, Imported),
+		(
+			Imported = yes,
+			DepGraph1 = DepGraph0
+		;
+			Imported = no,
+			proc_info_goal(ProcInfo0, Goal),
 
-	dependency_graph__add_proc_arcs(ProcIds, PredId, ModuleInfo,
+			relation__lookup_element(DepGraph0,
+					proc(PredId, ProcId), Caller),
+			dependency_graph__add_arcs_in_goal(Goal, Caller,
+					DepGraph0, DepGraph1)
+		)
+	),
+	dependency_graph__add_proc_arcs(ProcIds, PredId, ModuleInfo, LocalOnly,
 						DepGraph1, DepGraph).
 
 %-----------------------------------------------------------------------------%
@@ -514,6 +578,38 @@
 	io__write_string("\n"),
 	dependency_graph__write_prof_dependency_graph_3(Ss, Node, DepGraph, 
 					ModuleInfo).
+
+%-----------------------------------------------------------------------------%
+
+write_graph(DepInfo, WriteNode, WriteLink) -->
+	{ hlds_dependency_info_get_dependency_graph(DepInfo, DepGraph) },
+	{ relation__domain(DepGraph, DomSet) },
+	{ set__to_sorted_list(DomSet, DomList) },
+	write_graph_nodes(DomList, DepGraph, WriteNode, WriteLink).
+
+write_graph_nodes([], _Graph, _WriteNode, _WriteLink) --> [].
+write_graph_nodes([Node | Nodes], Graph, WriteNode, WriteLink) -->
+	WriteNode(Node),
+
+	{ relation__lookup_element(Graph, Node, NodeKey) },
+	{ relation__lookup_from(Graph, NodeKey, ChildrenSet) },
+	{ set__to_sorted_list(ChildrenSet, Children) },
+
+	write_graph_children(Children, Node, Graph, WriteLink),
+
+	write_graph_nodes(Nodes, Graph, WriteNode, WriteLink).
+
+:- pred write_graph_children(list(relation_key)::in, pred_proc_id::in,
+	dependency_graph::in,
+	pred(pred_proc_id, pred_proc_id, io__state, io__state)::
+			pred(in, in, di, uo) is det,
+	io__state::di, io__state::uo) is det.
+
+write_graph_children([], _Parent, _Graph, _WriteLink) --> [].
+write_graph_children([ChildKey | Children], Parent, Graph, WriteLink) -->
+	{ relation__lookup_key(Graph, ChildKey, Child) },
+	WriteLink(Parent, Child),
+	write_graph_children(Children, Parent, Graph, WriteLink).
 
 %-----------------------------------------------------------------------------%
 
Index: sr_profile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_profile.m,v
retrieving revision 1.1.2.1
diff -u -r1.1.2.1 sr_profile.m
--- sr_profile.m	2000/10/18 22:38:09	1.1.2.1
+++ sr_profile.m	2000/10/23 14:33:48
@@ -12,6 +12,7 @@
 :- interface.
 
 :- import_module io, int, string. 
+:- import_module hlds_module.
 
 :- type profiling_info ---> 
 		prof(
@@ -66,14 +67,15 @@
 :- pred inc_no_reuse_calls( profiling_info::in, profiling_info::out ) is det.
 
 
-:- pred write_profiling( string::in, profiling_info::in, 
+:- pred write_profiling( string::in, profiling_info::in, module_info::in,
 			io__state::di, io__state::uo ) is det. 
 
 %-----------------------------------------------------------------------------%
 
 :- implementation. 
 
-:- import_module require, time, list. 
+:- import_module bool, relation, require, set, time, list, std_util. 
+:- import_module dependency_graph, hlds_out, hlds_pred.
 
 init( P ) :- 
 	P = prof( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0). 
@@ -134,13 +136,13 @@
 reuse_calls( P0, P0 ^ reuse_calls ).
 no_reuse_calls( P0, P0 ^ no_reuse_calls ).
 
-write_profiling( String, Prof ) --> 
+write_profiling( String, Prof, HLDS ) --> 
 	{ string__append(String, ".profile", String2) }, 
 	io__open_output( String2, IOResult), 
 	(
 		{ IOResult = ok(Stream) },
 		% top
-		io__write_string(Stream, "Profiling output for module: "), 
+		io__write_string(Stream, "/*\nProfiling output for module: "), 
 		io__write_string(Stream, String), 
 		io__nl(Stream),
 		% date
@@ -187,12 +189,88 @@
 				"# calls to procedures with reuse"),
 		write_prof_item( Stream, no_reuse_calls, Prof, 
 				"# failed calls to procedures with reuse"),
+
+		io__write_string( Stream, "*/\ndigraph "),
+		io__write_string(Stream, String), 
+		io__write_string(Stream, " {\n"),
+		{ dependency_graph__build_dependency_graph(HLDS,
+				no, DepInfo) },
+		{ hlds_dependency_info_get_dependency_graph(DepInfo,
+				DepGraph) },
+		{ relation__components(DepGraph, ComponentsSet) },
+		{ list__filter_map(
+			(pred(ComponentSet::in, Component::out) is semidet :-
+				( set__singleton_set(ComponentSet, C0) ->
+					relation__lookup_key(DepGraph, C0, C),
+					C = proc(PredId, _ProcId),
+					module_info_pred_info(HLDS,
+							PredId, PredInfo),
+					pred_info_import_status(PredInfo,
+							ImportStatus),
+					status_defined_in_this_module(
+							ImportStatus, yes)
+				;
+					\+ set__singleton_set(ComponentSet, _)
+				),
+				Component = set__to_sorted_list(ComponentSet)
+			), set__to_sorted_list(ComponentsSet), DomList0) },
+		{ list__condense(DomList0, DomList1) },
+		{ list__map(relation__lookup_key(DepGraph), DomList1,
+				DomList) },
+		
+		write_graph_nodes(DomList, DepGraph,
+				write_procedure_node(HLDS, Stream),
+				write_procedure_link(HLDS, Stream)),
+
+		io__write_string(Stream, "\n}\n"),
+
 		io__close_output(Stream)
 	;
 		{ IOResult = error(IOError) },
 		{ io__error_message(IOError, IOErrorString) }, 
 		{ require__error(IOErrorString) }
 	).
+
+:- pred write_procedure_node(module_info::in, io__output_stream::in,
+		pred_proc_id::in, io__state::di, io__state::uo) is det.
+
+write_procedure_node(HLDS, Stream, PredProcId) -->
+	io__set_output_stream(Stream, OldStream),
+	{ PredProcId = proc(PredId, ProcId) },
+	{ module_info_pred_proc_info(HLDS, PredProcId, _PredInfo, ProcInfo) },
+	{ proc_info_reuse_information(ProcInfo, ReuseInfo) },
+
+	io__write_char('"'),
+	hlds_out__write_pred_proc_id(HLDS, PredId, ProcId),
+	io__write_char('"'),
+
+	( { ReuseInfo = yes(_) } ->
+		io__write_string(" [style=filled,color=red,shape=box];\n")
+	;
+		io__write_string(";\n")
+	),
+
+	io__set_output_stream(OldStream, _).
+
+:- pred write_procedure_link(module_info::in, io__output_stream::in,
+		pred_proc_id::in, pred_proc_id::in,
+		io__state::di, io__state::uo) is det.
+
+write_procedure_link(HLDS, Stream, Parent, Child) -->
+	io__set_output_stream(Stream, OldStream),
+	{ Parent = proc(ParentPredId, ParentProcId) },
+	{ Child = proc(ChildPredId, ChildProcId) },
+
+	io__write_char('"'),
+	hlds_out__write_pred_proc_id(HLDS, ParentPredId, ParentProcId),
+	io__write_string("\" -> "),
+
+	io__write_char('"'),
+	hlds_out__write_pred_proc_id(HLDS, ChildPredId, ChildProcId),
+	io__write_string("\";\n"),
+
+	io__set_output_stream(OldStream, _).
+	
 
 :- pred write_prof_item( io__output_stream, pred(profiling_info, int), 
 			profiling_info, 
Index: sr_profile_run.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/Attic/sr_profile_run.m,v
retrieving revision 1.1.2.1
diff -u -r1.1.2.1 sr_profile_run.m
--- sr_profile_run.m	2000/10/18 22:38:10	1.1.2.1
+++ sr_profile_run.m	2000/10/23 14:33:48
@@ -36,7 +36,7 @@
 	{ collect_profiling_information( HLDS, Profiling) }, 
 	{ module_info_name( HLDS, ModuleName ) }, 
 	{ prog_out__sym_name_to_string( ModuleName, ModuleNameString) }, 
-	sr_profile__write_profiling( ModuleNameString, Profiling ), 
+	sr_profile__write_profiling( ModuleNameString, Profiling, HLDS ), 
 	maybe_write_string( Verbose, "done.\n"). 
 
 :- pred collect_profiling_information( module_info::in, 

--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------