mercury/extras/morphine/source/control_flow.op

%------------------------------------------------------------------------------%
% Copyright (C) 1999-2002 INRIA/INSA de Rennes/IFSIC.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file License in the Morphine distribution.
% 
% Author : Erwan Jahier
% File   : control_flow.op
%

%------------------------------------------------------------------------------%
opium_scenario(
	name		: control_flow,
	files		: [control_flow],
	scenarios	: [collect],
	message		:
"Scenario that provides commands which generates various control flow graphs. \
This scenario make use of the graph generator `dot' program (so you will need to \
have dot available from your PATH environment variable to be able to use this \
scenario)."
	).

%------------------------------------------------------------------------------%
opium_parameter(
	name		: ps_viewer,
	arg_list	: [String],
	arg_type_list	: [string],
	parameter_type	: single,
	default		: ["gv "],
	commands	: [control_flow_graph, dynamic_call_graph],
	message		: 
"Parameter which sets the name of the command used to visualize the generated \
post-script file."
	).


%------------------------------------------------------------------------------%
opium_command(
	name		: control_flow_graph,
	arg_list	: [ProgramCall],
	arg_type_list	: [is_mercury_program_call],
	abbrev		: cfg,
	interface	: button,
	command_type	: opium,
	implementation	: control_flow_graph_Op,
	parameters	: [ps_viewer],
	message		:
"This command generates a control flow graph of the Mercury program \
execution."
	).

control_flow_graph_Op(Program) :-
	( getval(state_of_morphine, running) ->
		abort_trace
	;
		true
	),
	run(Program),
	generate_filename(Program, ".cfg.dot", ".cfg.ps", DotFile, PsFile),
	generate_control_flow_graph(Graph),
	display_graph(Graph, DotFile, PsFile).

 
% :- type graph ---> list(arc(procedure, procedure)).
%
%:- pred generate_control_flow_graph(graph).
%:- mode generate_control_flow_graph(out) is det.
%
generate_control_flow_graph(G) :-
	getenv("MERCURY_MORPHINE_DIR", MorphineDir),
	append_strings(MorphineDir, "/source/collect__control_flow_graph", 
		CollectFile),
	collect(CollectFile, Result),
	Result = collected_type(G).

% This is the pure Morphine version of generate_control_flow_graph that
% I originally wrote and which is about 20 times as slow as the collect 
% one:
%
% generate_control_flow_graph(G0, Proc, G) :-
% 	( fget_np(port = [call, exit,redo,fail]) ->
% 		current(proc_name = Name and arity = N),
% 		CurrentProc = Name/N,
% 		G1 = [arc(Proc, CurrentProc)|G0],
% 		generate_control_flow_graph(G1, CurrentProc, G),
% 		!
% 	;
% 		% end of the execution
% 		remove_dupl(G0, G)
% 	).


%------------------------------------------------------------------------------%
opium_command(
	name		: dynamic_call_graph,
	arg_list	: [ProgramCall],
	arg_type_list	: [is_mercury_program_call],
	abbrev		: dcg,
	interface	: button,
	command_type	: opium,
	implementation	: dynamic_call_graph_Op,
	parameters	: [ps_viewer],
	message		:
"This command generates a dynamic call  graph of the Mercury program \
execution. We call a dynamic call graph  the dynamic slice of the (static)  \
call graph, i.e. the calls that have effectively been done during the execution."
	).

dynamic_call_graph_Op(Program) :-
	run(Program),
	generate_filename(Program, ".dcg.dot", ".dcg.ps", DotFile, PsFile),
	generate_dynamic_call_graph(Graph),
	display_graph(Graph, DotFile, PsFile).

%
%:- pred generate_dynamic_call_graph(graph).
%:- mode generate_dynamic_call_graph(out) is det.
%

generate_dynamic_call_graph(G) :-
	getenv("MERCURY_MORPHINE_DIR", MorphineDir),
	append_strings(MorphineDir, "/source/collect__dynamic_call_graph", 
		CollectFile),
	collect(CollectFile, Result),
	Result = collected_type(G0),
	reverse(G0, G).

% This is the pure Morphine version:
%
% generate_dynamic_call_graph(G0, G) :-
% 	( fget_np(port = call) ->
% 		current(proc_name = Name and arity = N),
% 		ancestor(Anc),
% 		CurrentProc = Name/N,
% 		G1 = [arc(Anc, CurrentProc)|G0],
% 		generate_dynamic_call_graph(G1, G),
% 		!
% 	;
% 		% end of the execution
% 		remove_dupl(G0, G)
% 	).

% ancestor(Anc) :-
% 	current(stack = [_, List|_]),
% 	member(proc(_,Name,Arity,_), List), 
% 	Anc = Name/Arity,
% 	!.
% ancestor(none).

%------------------------------------------------------------------------------%
%
%:- pred generate_filename(string, string, string, string, string).
%:- mode generate_filename(in ,in, in, out, out) is det.
%
generate_filename(Program, DotExt, PsExt, DotFile, PsFile) :-
	( string(Program) ->
		ProgramStr = Program,
		!
	;
		term_string(Program, ProgramStr)
	),
	decompose_path_call_and_args1(ProgramStr, _, ProgramCallStr, _),
	append_strings(ProgramCallStr, DotExt, DotFile),
	append_strings(ProgramCallStr, PsExt, PsFile).

%:- pred display_graph(graph, string, string).
%:- mode display_graph(in, in, in) is det.
%
display_graph(Graph, DotFile, PsFile) :- 
	extract_proc_list_from_graph(Graph, ProcList),
	open(DotFile, write, dotfile),
	print(dotfile, "digraph G {\n\n"),
	print(dotfile, "ordering=out;\n\n"), 
		% so that the oroff tree nodes are displayed in their
		% order of creation
	dump_proc(ProcList),
	dump_graph(Graph),
	print(dotfile, "}\n"),
	close(dotfile),
	compile_dot(DotFile, PsFile),
	display_ps(PsFile).
dump_proc([]).
dump_proc([X|Xs]) :-
	printf(dotfile, "\t  \t \"%w\"\n", [X]),
	dump_proc2(Xs).


dump_proc2([]) :- nl(dotfile).
dump_proc2([X|Xs]) :-
	printf(dotfile, "\t ; \t \"%w\"\n", [X]),
	dump_proc2(Xs).

dump_graph([]) :- nl(dotfile).
dump_graph([arc(X,Y)|CG]) :-
	printf(dotfile, "\t\"%w\" -> \"%w\";\n", [X,Y]),
	dump_graph(CG).
dump_graph([arc(X, Label, Y)|CG]) :-
	printf(dotfile, "\t\"%w\" -> \"%w\"[label=%w];\n", [X,Y,Label]),
	dump_graph(CG).

%------------------------------------------------------------------------------%
opium_primitive(
	name		: compile_dot,
	arg_list	: [DotFile, PsFile],
	arg_type_list	: [string, string],
	abbrev		: _,
	implementation	: compile_dot_Op,
	message		:
"Primitive which applies `dot' to DotFile and outputs the resulting \
post-script in PsFile."
	).

compile_dot_Op(DotFile, PsFile) :-
	concat_string(["dot -Tps ", DotFile, " -o ", PsFile], Cmd),
	print(Cmd), nl,
	sh(Cmd).


%------------------------------------------------------------------------------%
opium_primitive(
	name		: display_ps,
	arg_list	: [PsFile],
	arg_type_list	: [string],
	abbrev		: _,
	implementation	: display_ps_Op,
	message		:
"primitive which displays post-script files."
	).

display_ps_Op(PsFile) :-
	ps_viewer(PsViewer),
	concat_string([PsViewer, " ", PsFile, " &"], Cmd),
	print(Cmd), nl,
	sh(Cmd).


%------------------------------------------------------------------------------%
%
% :- pred extract_proc_list_from_graph(graph, list(procedure)).
% :- mode extract_proc_list_from_graph(in, out) is det.
%
extract_proc_list_from_graph(Graph, ProcList) :-
	extract_proc_list_from_graph2(Graph, ProcList0),
	remove_dupl(ProcList0, ProcList1),
	reverse(ProcList1, ProcList).

extract_proc_list_from_graph2([], []).
extract_proc_list_from_graph2([Arc|Graph], [Proc|ProcList]) :-
	( Arc = arc(Proc,_), ! ; Arc = arc(Proc,_,_)),
	extract_proc_list_from_graph2(Graph, ProcList).


%------------------------------------------------------------------------------%
remove_dupl([], []).
remove_dupl(L0, L) :-
	L0 = [X|L1],
	remove_dupl(L1, L2), 
	( member(X, L2) ->
		L = L2
	 ;
		L = [X|L2]
	).   


%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
opium_command(
	name		: proof_tree,
	arg_list	: [ProgramCall],
	arg_type_list	: [is_mercury_program_call],
	abbrev		: pt,
	interface	: button,
	command_type	: opium,
	implementation	: proof_tree_Op,
	parameters	: [ps_viewer],
	message		:
"Computes the program proof tree."
	).

proof_tree_Op(Program) :-
	run(Program),
	generate_filename(Program, ".pt.dot", ".pt.ps", DotFile, PsFile),
	generate_proof_tree_graph(Graph),
	display_graph(Graph, DotFile, PsFile).

%
%:- pred generate_dynamic_call_graph(graph).
%:- mode generate_dynamic_call_graph(out) is det.
%

generate_proof_tree_graph(G) :-
	getenv("MERCURY_MORPHINE_DIR", MorphineDir),
	append_strings(MorphineDir, "/source/collect__proof_tree", 
		CollectFile),
	get_parameter(collect_arg, CollectArg),
	set_parameter(collect_arg, [yes]),
	collect(CollectFile, Result),
	set_parameter(collect_arg, CollectArg),
	( Result = ct(ProofTree), ! ; Result = pb(Msg), print(Msg), abort), 
	tree_to_graph(toplevel, ProofTree, G).

tree_to_graph(Father, leaf(_, PredUniv), [arc(Father, Pred)]) :-
	remove_type_pred(PredUniv, Pred).
tree_to_graph(Father, tree(_, PredUniv, TreeList), Graph) :-
	remove_type_pred(PredUniv, Pred),
	maplist(tree_to_graph(Pred), TreeList, GraphList),
	list_of_list_to_list(GraphList, Graph0),
	Graph = [arc(Father, Pred) | Graph0].

remove_type_pred(p(NameStr, _Arity, ArgUnivList), Pred) :-
	maplist(remove_type_arg, ArgUnivList, ArgList),
	( string(NameStr) -> atom_string(Name, NameStr) ; Name = NameStr),
	append([Name], ArgList, NameArgList),
	Pred =.. NameArgList.

remove_type_arg(univ_cons(state('<<c_pointer>>')), '-'). % We don't display that
remove_type_arg(univ_cons(Arg), Arg).


list_of_list_to_list([], []).
list_of_list_to_list([List], List).
list_of_list_to_list([List1, List2 | Tail], LList) :-
	append(List1, List2, List),
	LList0 = [List | Tail],
	list_of_list_to_list(LList0, LList).