1/* Part of fileutils 2 Copyright 2014-215 Samer Abdallah (UCL) 3 4 This program is free software; you can redistribute it and/or 5 modify it under the terms of the GNU Lesser General Public License 6 as published by the Free Software Foundation; either version 2 7 of the License, or (at your option) any later version. 8 9 This program is distributed in the hope that it will be useful, 10 but WITHOUT ANY WARRANTY; without even the implied warranty of 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12 GNU Lesser General Public License for more details. 13 14 You should have received a copy of the GNU Lesser General Public 15 License along with this library; if not, write to the Free Software 16 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 17*/ 18 19:- module(callgraph, 20 [ module_dotpdf/2 21 , modules_dotpdf/3 22 , module_dot/2 23 , modules_dot/3 24 , module_render/2 25 , modules_render/3 26 ]).
101:- set_prolog_flag(double_quotes, codes). 102 103:- predicate_options(module_dot/2,2,[pass_to(module_graph/3,2)]). 104:- predicate_options(module_render/2,2,[filename(text), format(any),method(any),pass_to(module_graph/3,2)]). 105:- predicate_options(modules_dot/3,2,[pass_to(modules_graph/4,2)]). 106:- predicate_options(modules_render/3,2,[filename(text), format(any),method(any),pass_to(modules_graph/4,2)]). 107 108:- predicate_options(module_graph/3,2, 109 [ prune(boolean) 110 , hide_list(list) 111 , recursive(boolean) 112 , arrowhead(atom) 113 , font(list(integer)) 114 , linkbase(atom) 115 , pass_to(predopt//2,1) 116 , pass_to(edgeopt//2,1) 117 ]). 118 119:- predicate_options(modules_graph/4,2, 120 [ cluster_recorded(oneof([false,by_key,true])) 121 , prune(boolean) 122 , hide_list(list) 123 , recursive(boolean) 124 , arrowhead(atom) 125 , font(list(integer)) 126 , linkbase(atom) 127 , pass_to(predopt//2,1) 128 , pass_to(edgeopt//2,1) 129 ]). 130 131:- predicate_options(predopt//2,1, 132 [ dynamic_style(atom) 133 , dynamic_shape(atom) 134 , export_style(atom) 135 , multifile_style(atom) 136 , multifile_shape(atom) 137 , recorded_style(atom) 138 , recorded_shape(atom) 139 , font(list(integer)) 140 ]). 141 142:- predicate_options(edgeopt//2,1, 143 [ mutate_style(atom) 144 , read_style(atom) 145 , write_style(atom) 146 ]). 147 148 149:- use_module(library(dcg_core)). 150:- use_module(library(dcg_codes)). 151:- use_module('library/dot'). 152 153% ------------ Building the call graph in the Prolog database ----------------------- 154 155:- dynamic edge/3.
159retract_graph :- retractall(edge(_,_,_)).
164assert_graph(Mods) :-
165 retract_graph,
166 sort(Mods,Mods1), % to get rid of duplicates
167 forall( member(Mod,Mods1),
168 prolog_walk_code([ trace_reference(_), module(Mod), on_trace(trace_call(Mods1)), source(false) ])
169 ),
170 predicate_property(edge(_,_,_), number_of_clauses(N)),
171 format('Got ~D edges.~n', [N]).
176trace_call(Mods, M1:H1, M2:H2, _) :- 177 debug(callgraph,'Considering ~w <--- ~w.',[M1:H1,M2:H2]), 178 %memberchk(M1,Mods), memberchk(M2,Mods), 179 head_node(M2:H2,Caller), 180 (classify(M1:H1,Class) -> true; Class=normal(M1:H1)), 181 assert_edges(Class,Caller,Mods). 182trace_call(_,Goal,Caller,_) :- 183 debug(callgraph,'Ignoring ~q ---> ~q.',[Caller,Goal]).
188classify(M:assert(C), dynamic(M,C,[mutates])). 189classify(M:assertz(C), dynamic(M,C,[mutates])). 190classify(M:asserta(C), dynamic(M,C,[mutates])). 191classify(M:retractall(C), dynamic(M,C,[mutates])). 192classify(M:retract(C), dynamic(M,C,[mutates,calls])). 193classify(_:recorded(K,T,_), recorded(reads,K:T)). 194classify(_:recorda(K,T,_), recorded(writes,K:T)). 195classify(_:recorda(K,T), recorded(writes,K:T)). 196classify(_:recordz(K,T,_), recorded(writes,K:T)). 197classify(_:recordz(K,T), recorded(writes,K:T)).
201assert_edges(normal(Goal), Caller, Ms) :- goal_pred_head(Goal,H), assert_types([calls],H,Caller,Ms). 202assert_edges(recorded(T,Spec),Caller,_) :- rec_spec_node(Spec,N), assert_edge(T,Caller,N). 203assert_edges(dynamic(M,C,Ts), Caller, Ms) :- 204 nonvar(C), mod_clause_head(M,C,H), 205 assert_types(Ts,H,Caller,Ms). 206assert_edges(_,_,_). % catch all if other clauses fail 207 208rec_spec_node(Key:Term,Node) :- 209 ( var(Key) -> K='unknown'; K=Key), 210 ( var(Term) -> Node=K:unknown; head_node(K:Term,Node)).
217mod_clause_head(_, (M:H:-_), M:H) :- !. 218mod_clause_head(_, (M:H), M:H) :- !. 219mod_clause_head(M, (H:-_), M:H) :- !. 220mod_clause_head(M, H, M:H).
225assert_types(Types,M3:H,Caller,_Mods) :-
226 %memberchk(M3,Mods),
227 head_node(M3:H,Node),
228 forall(member(T,Types), assert_edge(T,Caller,Node)).
233goal_pred_head(M1:H,M3:H) :-
234 \+predicate_property(M1:H, built_in),
235 (predicate_property(M1:H, imported_from(M3)) -> true; M3=M1).
239assert_edge(T,N1,N2) :-
240 ( edge(T,N1,N2) -> true
241 ; debug(callgraph,'Adding edge: ~w --> ~w.',[N1,N2]),
242 assertz(edge(T,N1,N2))).
head ---> atom:term.
250head_node(M:H,M:F/A) :- must_be(nonvar,M), (nonvar(H);ground(F/A)), functor(H,F,A).
260prune_subtrees :- do_until(prune_subtrees). 261 262prune_subtrees(false) :- 263 bagof(Node, prunable(Node), Nodes), !, 264 forall(member(N,Nodes), (writeln(pruning:N), retractall(edge(calls,_,N)))). 265prune_subtrees(true). 266 267prunable(Node) :- 268 setof( Parent, edge(calls,Parent,Node), [_]), % node has exactly one caller 269 \+edge(_,Node,_), % edges out 270 head_node(G,Node), 271 \+predicate_property(G,dynamic), 272 \+predicate_property(G,multifile), 273 \+predicate_property(G,exported). 274 275do_until(P) :- 276 call(P,Flag), 277 ( Flag=true -> true 278 ; do_until(P) 279 ). 280 281 282% ----------------------- GraphML output ---------------------- 283% Leaving this out for the time being. 284 285% module_graphml(Mod) :- 286% assert_graph([Mod]), 287% current_ugraph(Graph), 288% retract_graph, 289% format(atom(File),'~w.graphml',[Mod]), 290% graphml_write_ugraph(File, nomap, [], Graph). 291 292% nomap(id,node(N),A) :- term_to_atom(N,A), writeln(nomap(id,node(N),A)). 293% % nomap(id,edge(_,_),''). 294% % [key(node, color, string), key(edge,color,string)], 295% % cmap(color, node(_), green). 296% % cmap(color, edge(_), red). 297 298 299% %% current_ugraph(-Graph:graphml) is det. 300% % Returns the current call graph as a GraphML document structure. 301% current_ugraph(Graph) :- 302% findall(Pred, (calls_ir(Mod:Pred,_);calls_ir(_,Mod:Pred)), Preds), 303% sort(Preds,Preds1), 304% setof(Caller-Callees, (member(Caller,Preds1), callees(Mod,Caller,Callees)), Graph). 305 306% callees(Mod,Caller,Callees) :- setof(Callee, calls_ir(Mod:Caller,Mod:Callee),Callees), !. 307% callees(_,[]). 308 309 310 311% ----------------------- Dot output ----------------------
Types for Dot attributes: see http://graphviz.org/Documentation.php for more details on
line_style ---> solid ; dashed ; dotted ; bold. arrow_type ---> normal ; vee ; empty ; box ; none ; dot ; ... . node_shape ---> box ; ellipse ; circle ; diamond ; trapezium ; parallelogram ; house ; square ; pentagon ; hexagon ; septagon ; octagon ; ... . node_style ---> solid ; dashed ; dotted ; bold ; rounded ; diagonals ; filled ; striped ; wedged.
373module_dot(Mod,Opts) :-
374 check_options(module_dot/2,2,Opts),
375 module_graph(Mod,Opts,Graph),
376 format(atom(File),'~w.dot',[Mod]),
377 graph_dot(Graph,File).
format(pdf)
option supplied.
382module_dotpdf(Mod,Opts) :- module_render(Mod,[format(pdf)|Opts]).
graphviz_method ---> dot ; neato; fdp ; sfdp ; circo ; twopi ; unflatten(list(unflatten_opt)) ; unflatten. unflatten_opt ---> l(N:natural) % -l<N> ; fl(N:natural) % -f -l<N> ; c(natural). % -c<N>
The unflatten methods filter the graph through unflatten before passing on to dot.
403module_render(Mod,Opts) :-
404 check_options(module_render/2,2,Opts),
405 module_graph(Mod,Opts,Graph),
406 option(method(Method),Opts,unflatten),
407 option(format(Fmt),Opts,pdf),
408 file_name_extension(Mod,Fmt,DefaultFilename),
409 option(filename(Filename),Opts,DefaultFilename),
410 dotrun(Method,Fmt,Graph,Filename).
421modules_dot(Mods,Opts,Name) :-
422 check_options(modules_dot/3,2,Opts),
423 modules_graph(Mods,Opts,Name,Graph),
424 format(atom(File),'~w.dot',[Name]),
425 graph_dot(Graph,File).
format(pdf)
option supplied.
430modules_dotpdf(Mods,Opts,Name) :- modules_render(Mods,[format(pdf)|Opts],Name).
441modules_render(Mods,Opts,Name) :- 442 check_options(modules_render/3,2,Opts), 443 modules_graph(Mods,Opts,Name,Graph), 444 option(method(Method),Opts,unflatten), 445 option(format(Fmt),Opts,pdf), 446 file_name_extension(Name,Fmt,DefaultFilename), 447 option(filename(Filename),Opts,DefaultFilename), 448 dotrun(Method,Fmt,Graph,Filename). 449 450check_options(Pred,Arg,Opts) :- maplist(check_predicate_option(Pred,Arg),Opts). 451 452module_graph(Mod,Opts,digraph(Mod,Statements)) :- 453 assert_graph([Mod]), 454 (option(prune(true),Opts) -> prune_subtrees; true), 455 phrase(( 456 seqmap(global_opts(Opts),[graph,node,edge]), 457 recorded_nodes(Opts), 458 module_statements(Opts,Mod), 459 module_recorded_edges(Opts,Mod) 460 ), Statements, []), 461 retract_graph. 462 463modules_graph(Mods,Opts,Name,digraph(Name,Statements)) :- 464 assert_graph(Mods), 465 (option(prune(true),Opts) -> prune_subtrees; true), 466 option(cluster_recorded(CR),Opts,false), 467 phrase(( 468 seqmap(global_opts(Opts),[graph,node,edge]), % global attributes 469 recorded_nodes(Opts), 470 seqmap(module_subgraph(Opts),Mods), 471 seqmap(modules_module_edges(Opts,Mods),Mods), 472 recorded_edges(CR,Opts,Mods) 473 ), Statements, []), 474 retract_graph. 475 476recorded_edges(false,Opts,Mods) --> seqmap(module_recorded_edges(Opts),Mods). 477recorded_edges(true,Opts,Mods) --> in_cluster(Opts,recorded, recorded, recorded_edges(false,Opts,Mods)). 478recorded_edges(by_key,Opts,Mods) --> 479 {esetof(Key,recorded_key(Key),Keys)}, 480 seqmap(recorded_key_edges(Opts,Mods),Keys). 481 482recorded_key_edges(Opts,Mods,Key) --> 483 {atom_concat(recorded_,Key,ClusterName)}, 484 in_cluster(Opts,ClusterName, key(Key), seqmap(key_module_recorded_edges(Opts,Key),Mods)). 485 486recorded_node(Node) :- edge(reads,_,Node); edge(writes,_,Node). 487recorded_key(Key) :- recorded_node(Key:_). 488 489modules_module_edges(Opts,Mods,M1) --> 490 seqmap(inter_module_edges(Opts,M1),Mods). 491 492inter_module_edges(Opts,M1,M2) --> 493 ({M1\=M2} -> module_module_edges(Opts,M1,M2);[]). 494 495module_subgraph(Opts,Mod) --> 496 in_cluster(Opts,Mod, module(Mod), module_statements(Opts,Mod)). 497 498% declare recorded nodes 499recorded_nodes(Opts) --> 500 {predopt(Opts,recorded,RecNodeAttr,[])}, 501 {esetof(with_opts(node(N),RecNodeAttr), recorded_node(N), RecNodes)}, 502 list(RecNodes).
508module_statements(Opts,Mod) --> 509 module_nodes(Opts,Mod), 510 module_module_edges(Opts,Mod,Mod). 511 512module_nodes(Opts,Mod) --> 513 % declare other declarable nodes 514 {esetof(with_opts(node(Pred),Attrs), node_decl(Opts,Mod,Pred,Attrs), Decls)}, 515 list(Decls). 516 517module_recorded_edges(Opts,Mod) --> 518 key_module_recorded_edges(Opts,_,Mod,reads), 519 key_module_recorded_edges(Opts,_,Mod,writes). 520 521key_module_recorded_edges(Opts,Key,Mod) --> 522 key_module_recorded_edges(Opts,Key,Mod,reads), 523 key_module_recorded_edges(Opts,Key,Mod,writes). 524 525key_module_recorded_edges(Opts,Key,Mod,Type) --> 526 {edgeopt(Opts,Type,RAttr,[])}, 527 findall(with_opts(arrow(Pred,Key:Term),RAttr), edge(Type,Mod:Pred,Key:Term)). 528 529module_module_edges(Opts,M1,M2) --> 530 {edgeopt(Opts,mutates,MAttr,[])}, 531 findall(with_opts(arrow(Mutator,Mutatee),MAttr), visible_mutation(Opts,M1:Mutator,M2:Mutatee)), 532 findall(arrow(Caller,Callee), visible_call(Opts,M1:Caller,M2:Callee)). 533 534node_decl(Opts,Mod,Pred,Attrs) :- 535 declarable_node(Opts,Mod,Pred), 536 debug(callgraph,'Declarable node: ~w.',[Mod:Pred]), 537 pred_attr(Opts,Mod:Pred,Attrs). 538 539visible_predicate(Mod:Head) :- 540 current_predicate(Mod:Name/Arity), 541 functor(Head,Name,Arity), 542 predicate_property(Mod:Head,visible). 543 544declarable_node(Opts,M,Pred) :- 545 option(hide_list(HideList),Opts,[]), 546 ( option(linkbase(_),Opts) 547 -> visible_predicate(M:Head) 548 ; ( predicate_property(M:Head, dynamic) 549 ; predicate_property(M:Head, exported) 550 ; predicate_property(M:Head, multifile) 551 ) 552 ), 553 \+predicate_property(M:Head, built_in), 554 \+predicate_property(M:Head, imported_from(_)), 555 head_node(M:Head,M:Pred), 556 \+member(Pred, ['$mode'/2,'$pldoc'/4, '$pldoc_link'/2, '$pred_option'/4]), 557 \+member(Pred,HideList). 558 559declarable_node(Opts,M,Pred) :- 560 option(hide_list(HideList),Opts,[]), 561 (edge(reads,M:Pred,_); edge(writes,M:Pred,_)), 562 \+edge(calls,_,M:Pred), 563 \+edge(calls,M:Pred,_), 564 \+edge(mutates,M:Pred,_), 565 \+member(Pred,HideList). 566 567visible_call(Opts,M1:Caller,M2:Callee) :- 568 option(hide_list(L),Opts,[]), 569 option(recursive(T),Opts,false), 570 edge(calls,M1:Caller,M2:Callee), 571 (T=false -> Caller\=Callee; true), 572 \+member(Caller,L), 573 \+member(Callee,L). 574 575visible_mutation(Opts,M1:P1,M2:P2) :- 576 option(hide_list(L),Opts,[]), 577 edge(mutates,M1:P1,M2:P2), 578 \+member(P1,L), 579 \+member(P2,L). 580 581 582 583global_opts(_,graph) --> []. 584global_opts(O,node) --> {font(normal,O,F)}, [node_opts([ shape=at(box), fontname=qq(F) ])]. 585global_opts(O,edge) --> {option(arrowhead(AH),O,vee)}, [edge_opts([ arrowhead=at(AH) ])]. 586 587predopt(O,exported) --> 588 {option(export_style(S),O,bold)}, 589 {font(bold,O,F)}, 590 [ style = qq(at(S)), fontname=qq(F) ]. 591predopt(O,dynamic) --> 592 {option(dynamic_shape(S),O,box)}, 593 {option(dynamic_style(St),O,filled)}, 594 {font(italic,O,F)}, 595 [ shape = at(S), fontname=qq(F), style = qq(at(St)) ]. 596predopt(O,multifile) --> 597 {option(multifile_shape(S),O,box)}, 598 {option(multifile_style(St),O,diagonals)}, 599 [ shape = at(S), style = qq(at(St)) ]. 600predopt(O,recorded) --> 601 {option(recorded_shape(S),O,octagon)}, 602 {option(recorded_style(St),O,filled)}, 603 [ shape = at(S), style = qq(at(St)) ]. 604 605edgeopt(O,mutates) --> {option(mutate_style(S),O,dashed)}, [ style = qq(at(S)) ]. 606edgeopt(O,writes) --> {option(write_style(S),O,dashed)}, [ style = qq(at(S)) ]. 607edgeopt(O,reads) --> {option(read_style(S),O,solid)}, [ style = qq(at(S)) ]. 608 609pred_attr(O,Pred,Attrs1) :- 610 head_node(Goal,Pred), 611 phrase( ( if( predicate_property(Goal,dynamic), predopt(O,dynamic)), 612 if( predicate_property(Goal,multifile), predopt(O,multifile)), 613 if( predicate_property(Goal,exported), predopt(O,exported)), 614 if( option(linkbase(Base),O), nodelink(Base,Goal)) 615 ), 616 Attrs, []), 617 % Attrs = [_|_], 618 compile_attrs(Attrs,[],Attrs1). 619 620nodelink(Base,Goal) --> 621 { Goal=Mod:Head }, 622 { functor(Head,Name,Arity), 623 format(string(URL),'~w~q',[Base,Mod:Name/Arity]) 624 }, 625 [ 'URL' = qq(URL), target=at('_blank') ]. 626 627compile_attrs([],A,A). 628compile_attrs([style=S|AX],AttrsSoFar,FinalAttrs) :- !, 629 ( select(style=OS,AttrsSoFar,A1) 630 -> combine_styles(S,OS,NS), A2=[style=NS|A1] 631 ; A2=[style=S|AttrsSoFar] 632 ), 633 compile_attrs(AX,A2,FinalAttrs). 634compile_attrs([A|AX],A0,A2) :- compile_attrs(AX,[A|A0],A2). 635 636combine_styles(qq(S1),qq(S2),qq((S1,",",S2))). 637 638% compile_attrs1([],A,[]). 639% compile_attrs1([A|AX],A0,[A|A1]) :- compile_attrs1(AX,[A|A0],A1). 640 641font_family(O) --> {option(font(FF),O,"Times")}, seqmap(out,FF). 642font(normal,O,F) :- phrase(font_family(O),F,[]). 643font(italic,O,F) :- phrase((font_family(O)," Italic"),F,[]). 644font(bold,O,F) :- phrase((font_family(O)," Bold"),F,[]). 645 646in_cluster(Opts,Name, Label, Phrase) --> 647 {atom_concat(cluster_,Name,SubName)}, 648 {phrase((subgraph_opts(Opts), ),Statements,[])}, 649 [subgraph(SubName,[label=qq(wr(Label)) | Statements])]. 650 651subgraph_opts(Opts) --> 652 {font(bold,Opts,F)}, 653 [labeljust=qq(at(l))], 654 [fontname=qq(F)]. 655 656% general utilities 657esetof(A,B,C) :- setof(A,B,C) *-> true; C=[]
Visualisation of inter-predicate call graphs
Usage
This module allows you to produce a call graph of one or more modules, where nodes (boxes) represent predicates and an edge between two predicates indicates that one (the source end) calls the other (the pointy end).
By default, node styles are used to indicate whether or not the predicate is exported (bold outline), dynamic (italic label, filled), multifile (box with diagonals in the corners). For dynamic predicates, dashed edges are used to represent operations which mutate (assert to or retract from) the predicate.
Items in the recorded database are also represented, as they consitute mutable state much like dynamic predicates. Recorded items are labelled as Key:Functor/Arity and drawn in a filled octagonal box. Dashed edges represents writing to the recorded database and ordinary solid edges represent reading.
Basic method of usage is:
See module_dot/2 for options that affect graph content and style, and module_dotpdf/2 for options that affect rendering.
Multi-module graphs
The predicates modules_dotpdf/3 and modules_dot/3 support graphing multiple modules. Each module is drawn inside a box (a Graphviz cluster). Items in the recorded database are outside the module system. They can optionally be collected into one cluster or into several clusters by key.
Implementation notes
NB. This is very preliminary. The intereface is not necessarily stable. The dot DCG implementation is a bit embarassing but it does the job for now.
Three parts to this:
dotdct.pl
Types used internally
*/