%------------------------------------------------------------------------------% % 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('<>')), '-'). % 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).