1%% -*- erlang-indent-level: 2 -*-
2%%
3%% Licensed under the Apache License, Version 2.0 (the "License");
4%% you may not use this file except in compliance with the License.
5%% You may obtain a copy of the License at
6%%
7%%     http://www.apache.org/licenses/LICENSE-2.0
8%%
9%% Unless required by applicable law or agreed to in writing, software
10%% distributed under the License is distributed on an "AS IS" BASIS,
11%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12%% See the License for the specific language governing permissions and
13%% limitations under the License.
14
15%%%-------------------------------------------------------------------
16%%% File    : dialyzer_callgraph.erl
17%%% Author  : Tobias Lindahl <tobiasl@it.uu.se>
18%%% Description :
19%%%
20%%% Created : 30 Mar 2005 by Tobias Lindahl <tobiasl@it.uu.se>
21%%%-------------------------------------------------------------------
22-module(dialyzer_callgraph).
23
24-export([add_edges/2,
25	 add_edges/3,
26	 all_nodes/1,
27	 delete/1,
28	 finalize/1,
29	 is_escaping/2,
30	 is_self_rec/2,
31	 non_local_calls/1,
32	 lookup_letrec/2,
33	 lookup_rec_var/2,
34	 lookup_call_site/2,
35	 lookup_label/2,
36	 lookup_name/2,
37	 modules/1,
38	 module_deps/1,
39	 %% module_postorder/1,
40	 module_postorder_from_funs/2,
41	 new/0,
42	 get_depends_on/2,
43	 %% get_required_by/2,
44	 in_neighbours/2,
45	 renew_race_info/4,
46	 renew_race_code/2,
47	 renew_race_public_tables/2,
48	 reset_from_funs/2,
49	 scan_core_tree/2,
50	 strip_module_deps/2,
51	 remove_external/1,
52	 to_dot/2,
53	 to_ps/3]).
54
55-export([cleanup/1, get_digraph/1, get_named_tables/1, get_public_tables/1,
56         get_race_code/1, get_race_detection/1, race_code_new/1,
57         put_digraph/2, put_race_code/2, put_race_detection/2,
58         put_named_tables/2, put_public_tables/2, put_behaviour_api_calls/2,
59	 get_behaviour_api_calls/1, dispose_race_server/1, duplicate/1]).
60
61-export_type([callgraph/0, mfa_or_funlbl/0, callgraph_edge/0, mod_deps/0]).
62
63-include("dialyzer.hrl").
64
65%%----------------------------------------------------------------------
66
67-type scc()	      :: [mfa_or_funlbl()].
68-type mfa_call()      :: {mfa_or_funlbl(), mfa_or_funlbl()}.
69-type mfa_calls()     :: [mfa_call()].
70-type mod_deps()      :: dict:dict(module(), [module()]).
71
72%%-----------------------------------------------------------------------------
73%% A callgraph is a directed graph where the nodes are functions and a
74%% call between two functions is an edge from the caller to the callee.
75%%
76%% calls	-  A mapping from call site (and apply site) labels
77%%		   to the possible functions that can be called.
78%% digraph	-  A digraph representing the callgraph.
79%%		   Nodes are represented as MFAs or labels.
80%% esc		-  A set of all escaping functions as reported by dialyzer_dep.
81%% letrec_map	-  A dict mapping from letrec bound labels to function labels.
82%%		   Includes all functions.
83%% name_map	-  A mapping from label to MFA.
84%% rev_name_map	-  A reverse mapping of the name_map.
85%% rec_var_map	-  A dict mapping from letrec bound labels to function names.
86%%		   Only for top level functions (from module defs).
87%% self_rec	-  A set containing all self recursive functions.
88%%		   Note that this contains MFAs for named functions and labels
89%%		   whenever applicable.
90%%-----------------------------------------------------------------------------
91
92%% Types with comment 'race' are due to dialyzer_races.erl.
93-record(callgraph, {digraph        = digraph:new() :: digraph:graph(),
94		    active_digraph                 :: active_digraph()
95                                                    | 'undefined', % race
96                    esc	                           :: ets:tid()
97                                                    | 'undefined', % race
98                    letrec_map                     :: ets:tid()
99                                                    | 'undefined', % race
100                    name_map	                   :: ets:tid(),
101                    rev_name_map                   :: ets:tid(),
102                    rec_var_map                    :: ets:tid()
103                                                    | 'undefined', % race
104                    self_rec	                   :: ets:tid()
105                                                    | 'undefined', % race
106                    calls                          :: ets:tid()
107                                                    | 'undefined', % race
108                    race_detection = false         :: boolean(),
109		    race_data_server = dialyzer_race_data_server:new() :: pid()}).
110
111%% Exported Types
112
113-opaque callgraph() :: #callgraph{}.
114
115-type active_digraph() :: {'d', digraph:graph()}
116                        | {'e',
117                           Out :: ets:tid(),
118                           In :: ets:tid(),
119                           Map :: ets:tid()}.
120
121%%----------------------------------------------------------------------
122
123-spec new() -> callgraph().
124
125new() ->
126  [ETSEsc, ETSNameMap, ETSRevNameMap, ETSRecVarMap, ETSLetrecMap, ETSSelfRec, ETSCalls] =
127    [ets:new(N,[public, {read_concurrency, true}]) ||
128      N <- [callgraph_esc, callgraph_name_map, callgraph_rev_name_map,
129	    callgraph_rec_var_map, callgraph_letrec_map, callgraph_self_rec, callgraph_calls]],
130  #callgraph{esc            = ETSEsc,
131	     letrec_map     = ETSLetrecMap,
132	     name_map       = ETSNameMap,
133	     rev_name_map   = ETSRevNameMap,
134	     rec_var_map    = ETSRecVarMap,
135	     self_rec       = ETSSelfRec,
136	     calls          = ETSCalls}.
137
138-spec delete(callgraph()) -> 'true'.
139
140delete(#callgraph{digraph = Digraph}) ->
141  digraph_delete(Digraph).
142
143-spec all_nodes(callgraph()) -> [mfa()].
144
145all_nodes(#callgraph{digraph = DG}) ->
146  digraph_vertices(DG).
147
148-spec lookup_rec_var(label(), callgraph()) -> 'error' | {'ok', mfa()}.
149
150lookup_rec_var(Label, #callgraph{rec_var_map = RecVarMap})
151  when is_integer(Label) ->
152  ets_lookup_dict(Label, RecVarMap).
153
154-spec lookup_letrec(label(), callgraph()) -> 'error' | {'ok', label()}.
155
156lookup_letrec(Label, #callgraph{letrec_map = LetrecMap})
157  when is_integer(Label) ->
158  ets_lookup_dict(Label, LetrecMap).
159
160-spec lookup_call_site(label(), callgraph()) -> 'error' | {'ok', [_]}. % XXX: refine
161
162lookup_call_site(Label, #callgraph{calls = Calls})
163  when is_integer(Label) ->
164  ets_lookup_dict(Label, Calls).
165
166-spec lookup_name(label(), callgraph()) -> 'error' | {'ok', mfa()}.
167
168lookup_name(Label, #callgraph{name_map = NameMap})
169  when is_integer(Label) ->
170  ets_lookup_dict(Label, NameMap).
171
172-spec lookup_label(mfa_or_funlbl(), callgraph()) -> 'error' | {'ok', integer()}.
173
174lookup_label({_,_,_} = MFA, #callgraph{rev_name_map = RevNameMap}) ->
175  ets_lookup_dict(MFA, RevNameMap);
176lookup_label(Label, #callgraph{}) when is_integer(Label) ->
177  {ok, Label}.
178
179-spec in_neighbours(mfa_or_funlbl(), callgraph()) -> 'none' | [mfa_or_funlbl(),...].
180
181in_neighbours(Label, #callgraph{digraph = Digraph} = CG)
182  when is_integer(Label) ->
183  Name = case lookup_name(Label, CG) of
184	   {ok, Val} -> Val;
185	   error -> Label
186	 end,
187  digraph_in_neighbours(Name, Digraph);
188in_neighbours({_, _, _} = MFA, #callgraph{digraph = Digraph}) ->
189  digraph_in_neighbours(MFA, Digraph).
190
191-spec is_self_rec(mfa_or_funlbl(), callgraph()) -> boolean().
192
193is_self_rec(MfaOrLabel, #callgraph{self_rec = SelfRecs}) ->
194  ets_lookup_set(MfaOrLabel, SelfRecs).
195
196-spec is_escaping(label(), callgraph()) -> boolean().
197
198is_escaping(Label, #callgraph{esc = Esc}) when is_integer(Label) ->
199  ets_lookup_set(Label, Esc).
200
201-type callgraph_edge() :: {mfa_or_funlbl(),mfa_or_funlbl()}.
202-spec add_edges([callgraph_edge()], callgraph()) -> ok.
203
204add_edges([], _CG) ->
205  ok;
206add_edges(Edges, #callgraph{digraph = Digraph}) ->
207  digraph_add_edges(Edges, Digraph).
208
209-spec add_edges([callgraph_edge()], [mfa_or_funlbl()], callgraph()) -> ok.
210
211add_edges(Edges, MFAs, #callgraph{digraph = DG} = CG) ->
212  digraph_confirm_vertices(MFAs, DG),
213  add_edges(Edges, CG).
214
215-spec remove_external(callgraph()) -> {callgraph(), [tuple()]}.
216
217remove_external(#callgraph{digraph = DG} = CG) ->
218  {DG, External} = digraph_remove_external(DG),
219  {CG, External}.
220
221-spec non_local_calls(callgraph()) -> mfa_calls().
222
223non_local_calls(#callgraph{digraph = DG}) ->
224  Edges = digraph_edges(DG),
225  find_non_local_calls(Edges, sets:new()).
226
227-type call_tab() :: sets:set(mfa_call()).
228
229-spec find_non_local_calls([{mfa_or_funlbl(), mfa_or_funlbl()}], call_tab()) ->
230        mfa_calls().
231
232find_non_local_calls([{{M,_,_}, {M,_,_}}|Left], Set) ->
233  find_non_local_calls(Left, Set);
234find_non_local_calls([{{M1,_,_}, {M2,_,_}} = Edge|Left], Set) when M1 =/= M2 ->
235  find_non_local_calls(Left, sets:add_element(Edge, Set));
236find_non_local_calls([{{_,_,_}, Label}|Left], Set) when is_integer(Label) ->
237  find_non_local_calls(Left, Set);
238find_non_local_calls([{Label, {_,_,_}}|Left], Set) when is_integer(Label) ->
239  find_non_local_calls(Left, Set);
240find_non_local_calls([{Label1, Label2}|Left], Set) when is_integer(Label1),
241							is_integer(Label2) ->
242  find_non_local_calls(Left, Set);
243find_non_local_calls([], Set) ->
244  sets:to_list(Set).
245
246-spec get_depends_on(scc() | module(), callgraph()) -> [scc()].
247
248get_depends_on(SCC, #callgraph{active_digraph = {'e', Out, _In, Maps}}) ->
249  lookup_scc(SCC, Out, Maps);
250get_depends_on(SCC, #callgraph{active_digraph = {'d', DG}}) ->
251  digraph:out_neighbours(DG, SCC).
252
253%% -spec get_required_by(scc() | module(), callgraph()) -> [scc()].
254
255%% get_required_by(SCC, #callgraph{active_digraph = {'e', _Out, In, Maps}}) ->
256%%   lookup_scc(SCC, In, Maps);
257%% get_required_by(SCC, #callgraph{active_digraph = {'d', DG}}) ->
258%%   digraph:in_neighbours(DG, SCC).
259
260lookup_scc(SCC, Table, Maps) ->
261  case ets_lookup_dict({'scc', SCC}, Maps) of
262    {ok, SCCInt} ->
263      case ets_lookup_dict(SCCInt, Table) of
264        {ok, Ints} ->
265          [ets:lookup_element(Maps, Int, 2) || Int <- Ints];
266        error ->
267          []
268      end;
269    error -> []
270  end.
271
272%%----------------------------------------------------------------------
273%% Handling of modules & SCCs
274%%----------------------------------------------------------------------
275
276-spec modules(callgraph()) -> [module()].
277
278modules(#callgraph{digraph = DG}) ->
279  ordsets:from_list([M || {M,_F,_A} <- digraph_vertices(DG)]).
280
281-spec module_postorder(callgraph()) -> {[module()], {'d', digraph:graph()}}.
282
283module_postorder(#callgraph{digraph = DG}) ->
284  Edges = lists:foldl(fun edge_fold/2, sets:new(), digraph_edges(DG)),
285  Nodes = sets:from_list([M || {M,_F,_A} <- digraph_vertices(DG)]),
286  MDG = digraph:new([acyclic]),
287  digraph_confirm_vertices(sets:to_list(Nodes), MDG),
288  Foreach = fun({M1,M2}) -> _ = digraph:add_edge(MDG, M1, M2) end,
289  lists:foreach(Foreach, sets:to_list(Edges)),
290  %% The out-neighbors of a vertex are the vertices called directly.
291  %% The used vertices are to occur *before* the calling vertex:
292  {lists:reverse(digraph_utils:topsort(MDG)), {'d', MDG}}.
293
294edge_fold({{M1,_,_},{M2,_,_}}, Set) ->
295  case M1 =/= M2 of
296    true  -> sets:add_element({M1,M2},Set);
297    false -> Set
298  end;
299edge_fold(_, Set) -> Set.
300
301
302%% The module deps of a module are modules that depend on the module
303-spec module_deps(callgraph()) -> mod_deps().
304
305module_deps(#callgraph{digraph = DG}) ->
306  Edges = lists:foldl(fun edge_fold/2, sets:new(), digraph_edges(DG)),
307  Nodes = sets:from_list([M || {M,_F,_A} <- digraph_vertices(DG)]),
308  MDG = digraph:new(),
309  digraph_confirm_vertices(sets:to_list(Nodes), MDG),
310  Foreach = fun({M1,M2}) -> check_add_edge(MDG, M1, M2) end,
311  lists:foreach(Foreach, sets:to_list(Edges)),
312  Deps = [{N, ordsets:from_list(digraph:in_neighbours(MDG, N))}
313	  || N <- sets:to_list(Nodes)],
314  digraph_delete(MDG),
315  dict:from_list(Deps).
316
317-spec strip_module_deps(mod_deps(), sets:set(module())) -> mod_deps().
318
319strip_module_deps(ModDeps, StripSet) ->
320  FilterFun1 = fun(Val) -> not sets:is_element(Val, StripSet) end,
321  MapFun = fun(_Key, ValSet) -> ordsets:filter(FilterFun1, ValSet) end,
322  ModDeps1 = dict:map(MapFun, ModDeps),
323  FilterFun2 = fun(_Key, ValSet) -> ValSet =/= [] end,
324  dict:filter(FilterFun2, ModDeps1).
325
326-spec finalize(callgraph()) -> {[scc()], callgraph()}.
327
328finalize(#callgraph{digraph = DG} = CG) ->
329  {ActiveDG, Postorder} = condensation(DG),
330  {Postorder, CG#callgraph{active_digraph = ActiveDG}}.
331
332-spec reset_from_funs([mfa_or_funlbl()], callgraph()) -> {[scc()], callgraph()}.
333
334reset_from_funs(Funs, #callgraph{digraph = DG, active_digraph = ADG} = CG) ->
335  active_digraph_delete(ADG),
336  SubGraph = digraph_reaching_subgraph(Funs, DG),
337  {NewActiveDG, Postorder} = condensation(SubGraph),
338  digraph_delete(SubGraph),
339  {Postorder, CG#callgraph{active_digraph = NewActiveDG}}.
340
341-spec module_postorder_from_funs([mfa_or_funlbl()], callgraph()) ->
342        {[module()], callgraph()}.
343
344module_postorder_from_funs(Funs, #callgraph{digraph = DG,
345					    active_digraph = ADG} = CG) ->
346  active_digraph_delete(ADG),
347  SubGraph = digraph_reaching_subgraph(Funs, DG),
348  {PO, Active} = module_postorder(CG#callgraph{digraph = SubGraph}),
349  digraph_delete(SubGraph),
350  {PO, CG#callgraph{active_digraph = Active}}.
351
352ets_lookup_dict(Key, Table) ->
353  try ets:lookup_element(Table, Key, 2) of
354      Val -> {ok, Val}
355  catch
356    _:_ -> error
357  end.
358
359ets_lookup_set(Key, Table) ->
360  ets:lookup(Table, Key) =/= [].
361
362%%----------------------------------------------------------------------
363%% Core code
364%%----------------------------------------------------------------------
365
366%% The core tree must be labeled as by cerl_trees:label/1 (or /2).
367%% The set of labels in the tree must be disjoint from the set of
368%% labels already occurring in the callgraph.
369
370-spec scan_core_tree(cerl:c_module(), callgraph()) ->
371        {[mfa_or_funlbl()], [callgraph_edge()]}.
372
373scan_core_tree(Tree, #callgraph{calls = ETSCalls,
374				esc = ETSEsc,
375				letrec_map = ETSLetrecMap,
376				name_map = ETSNameMap,
377				rec_var_map = ETSRecVarMap,
378				rev_name_map = ETSRevNameMap,
379				self_rec = ETSSelfRec}) ->
380  %% Build name map and recursion variable maps.
381  build_maps(Tree, ETSRecVarMap, ETSNameMap, ETSRevNameMap, ETSLetrecMap),
382
383  %% First find the module-local dependencies.
384  {Deps0, EscapingFuns, Calls, Letrecs} = dialyzer_dep:analyze(Tree),
385  true = ets:insert(ETSCalls, dict:to_list(Calls)),
386  true = ets:insert(ETSLetrecMap, dict:to_list(Letrecs)),
387  true = ets:insert(ETSEsc, [{E} || E <- EscapingFuns]),
388
389  LabelEdges = get_edges_from_deps(Deps0),
390
391  %% Find the self recursive functions. Named functions get both the
392  %% key and their name for convenience.
393  SelfRecs0 = lists:foldl(fun({Key, Key}, Acc) ->
394			      case ets_lookup_dict(Key, ETSNameMap) of
395				error      -> [Key|Acc];
396				{ok, Name} -> [Key, Name|Acc]
397			      end;
398			     (_, Acc) -> Acc
399			  end, [], LabelEdges),
400  true = ets:insert(ETSSelfRec, [{S} || S <- SelfRecs0]),
401
402  NamedEdges1 = name_edges(LabelEdges, ETSNameMap),
403
404  %% We need to scan for inter-module calls since these are not tracked
405  %% by dialyzer_dep. Note that the caller is always recorded as the
406  %% top level function. This is OK since the included functions are
407  %% stored as scc with the parent.
408  NamedEdges2 = scan_core_funs(Tree),
409
410  %% Confirm all nodes in the tree.
411  Names1 = lists:append([[X, Y] || {X, Y} <- NamedEdges1]),
412  Names2 = ordsets:from_list(Names1),
413
414  %% Get rid of the 'top' function from nodes and edges.
415  Names3 = ordsets:del_element(top, Names2),
416  NewNamedEdges2 =
417    [E || {From, To} = E <- NamedEdges2, From =/= top, To =/= top],
418  NewNamedEdges1 =
419    [E || {From, To} = E <- NamedEdges1, From =/= top, To =/= top],
420  NamedEdges3 = NewNamedEdges1 ++ NewNamedEdges2,
421  {Names3, NamedEdges3}.
422
423build_maps(Tree, ETSRecVarMap, ETSNameMap, ETSRevNameMap, ETSLetrecMap) ->
424  %% We only care about the named (top level) functions. The anonymous
425  %% functions will be analysed together with their parents.
426  Defs = cerl:module_defs(Tree),
427  Mod = cerl:atom_val(cerl:module_name(Tree)),
428  Fun =
429    fun({Var, Function}) ->
430	FunName = cerl:fname_id(Var),
431	Arity = cerl:fname_arity(Var),
432	MFA = {Mod, FunName, Arity},
433	FunLabel = get_label(Function),
434	VarLabel = get_label(Var),
435	true = ets:insert(ETSLetrecMap, {VarLabel, FunLabel}),
436	true = ets:insert(ETSNameMap, {FunLabel, MFA}),
437	true = ets:insert(ETSRevNameMap, {MFA, FunLabel}),
438	true = ets:insert(ETSRecVarMap, {VarLabel, MFA})
439    end,
440  lists:foreach(Fun, Defs).
441
442get_edges_from_deps(Deps) ->
443  %% Convert the dependencies as produced by dialyzer_dep to a list of
444  %% edges. Also, remove 'external' since we are not interested in
445  %% this information.
446  Edges = dict:fold(fun(external, _Set, Acc) -> Acc;
447		       (Caller, Set, Acc)    ->
448			[[{Caller, Callee} || Callee <- Set,
449					      Callee =/= external]|Acc]
450		    end, [], Deps),
451  lists:flatten(Edges).
452
453name_edges(Edges, ETSNameMap) ->
454  %% If a label is present in the name map it is renamed. Otherwise
455  %% keep the label as the identity.
456  MapFun = fun(X) ->
457	       case ets_lookup_dict(X, ETSNameMap) of
458		 error -> X;
459		 {ok, MFA} -> MFA
460	       end
461	   end,
462  name_edges(Edges, MapFun, []).
463
464name_edges([{From, To}|Left], MapFun, Acc) ->
465  NewFrom = MapFun(From),
466  NewTo = MapFun(To),
467  name_edges(Left, MapFun, [{NewFrom, NewTo}|Acc]);
468name_edges([], _MapFun, Acc) ->
469  Acc.
470
471scan_core_funs(Tree) ->
472  Defs = cerl:module_defs(Tree),
473  Mod = cerl:atom_val(cerl:module_name(Tree)),
474  DeepEdges = lists:foldl(fun({Var, Function}, Edges) ->
475			      FunName = cerl:fname_id(Var),
476			      Arity = cerl:fname_arity(Var),
477			      MFA = {Mod, FunName, Arity},
478			      [scan_one_core_fun(Function, MFA)|Edges]
479			  end, [], Defs),
480  lists:flatten(DeepEdges).
481
482scan_one_core_fun(TopTree, FunName) ->
483  FoldFun = fun(Tree, Acc) ->
484		case cerl:type(Tree) of
485		  call ->
486		    CalleeM = cerl:call_module(Tree),
487		    CalleeF = cerl:call_name(Tree),
488		    CalleeArgs = cerl:call_args(Tree),
489		    A = length(CalleeArgs),
490		    case (cerl:is_c_atom(CalleeM) andalso
491			  cerl:is_c_atom(CalleeF)) of
492		      true ->
493			M = cerl:atom_val(CalleeM),
494			F = cerl:atom_val(CalleeF),
495			case erl_bif_types:is_known(M, F, A) of
496			  true ->
497			    case {M, F, A} of
498			      {erlang, make_fun, 3} ->
499				[CA1, CA2, CA3] = CalleeArgs,
500				case
501				  cerl:is_c_atom(CA1) andalso
502				  cerl:is_c_atom(CA2) andalso
503				  cerl:is_c_int(CA3)
504				of
505				  true ->
506				    MM = cerl:atom_val(CA1),
507				    FF = cerl:atom_val(CA2),
508				    AA = cerl:int_val(CA3),
509				    case erl_bif_types:is_known(MM, FF, AA) of
510				      true -> Acc;
511				      false -> [{FunName, {MM, FF, AA}}|Acc]
512				    end;
513				  false ->
514				    Acc
515				end;
516			      _ ->
517				Acc
518			    end;
519			  false -> [{FunName, {M, F, A}}|Acc]
520			end;
521		      false ->
522			%% We cannot handle run-time bindings
523			Acc
524		    end;
525		  _ ->
526		    %% Nothing that can introduce new edges in the callgraph.
527		    Acc
528		end
529	    end,
530  cerl_trees:fold(FoldFun, [], TopTree).
531
532get_label(T) ->
533  case cerl:get_ann(T) of
534    [{label, L} | _] when is_integer(L) -> L;
535    _ -> erlang:error({missing_label, T})
536  end.
537
538%%----------------------------------------------------------------------
539%% Digraph
540%%----------------------------------------------------------------------
541
542digraph_add_edges([{From, To}|Left], DG) ->
543  digraph_add_edge(From, To, DG),
544  digraph_add_edges(Left, DG);
545digraph_add_edges([], _DG) ->
546  ok.
547
548digraph_add_edge(From, To, DG) ->
549  case digraph:vertex(DG, From) of
550    false -> digraph:add_vertex(DG, From);
551    {From, _} -> ok
552  end,
553  case digraph:vertex(DG, To) of
554    false -> digraph:add_vertex(DG, To);
555    {To, _} -> ok
556  end,
557  check_add_edge(DG, {From, To}, From, To, []),
558  ok.
559
560check_add_edge(G, V1, V2) ->
561  case digraph:add_edge(G, V1, V2) of
562    {error, Error} -> exit({add_edge, V1, V2, Error});
563    _Edge -> ok
564  end.
565
566check_add_edge(G, E, V1, V2, L) ->
567  case digraph:add_edge(G, E, V1, V2, L) of
568    {error, Error} -> exit({add_edge, E, V1, V2, L, Error});
569    _Edge -> ok
570  end.
571
572digraph_confirm_vertices([MFA|Left], DG) ->
573  digraph:add_vertex(DG, MFA, confirmed),
574  digraph_confirm_vertices(Left, DG);
575digraph_confirm_vertices([], _DG) ->
576  ok.
577
578digraph_remove_external(DG) ->
579  Vertices = digraph:vertices(DG),
580  Unconfirmed = remove_unconfirmed(Vertices, DG),
581  {DG, Unconfirmed}.
582
583remove_unconfirmed(Vertexes, DG) ->
584  remove_unconfirmed(Vertexes, DG, []).
585
586remove_unconfirmed([V|Left], DG, Unconfirmed) ->
587  case digraph:vertex(DG, V) of
588    {V, confirmed} -> remove_unconfirmed(Left, DG, Unconfirmed);
589    {V, []} -> remove_unconfirmed(Left, DG, [V|Unconfirmed])
590  end;
591remove_unconfirmed([], DG, Unconfirmed) ->
592  BadCalls = lists:append([digraph:in_edges(DG, V) || V <- Unconfirmed]),
593  BadCallsSorted = lists:keysort(1, BadCalls),
594  digraph:del_vertices(DG, Unconfirmed),
595  BadCallsSorted.
596
597digraph_delete(DG) ->
598  digraph:delete(DG).
599
600active_digraph_delete({'d', DG}) ->
601  digraph:delete(DG);
602active_digraph_delete({'e', Out, In, Maps}) ->
603  ets:delete(Out),
604  ets:delete(In),
605  ets:delete(Maps).
606
607digraph_edges(DG) ->
608  digraph:edges(DG).
609
610digraph_vertices(DG) ->
611  digraph:vertices(DG).
612
613digraph_in_neighbours(V, DG) ->
614  case digraph:in_neighbours(DG, V) of
615    [] -> none;
616    List -> List
617  end.
618
619digraph_reaching_subgraph(Funs, DG) ->
620  Vertices = digraph_utils:reaching(Funs, DG),
621  digraph_utils:subgraph(DG, Vertices).
622
623%%----------------------------------------------------------------------
624%% Races
625%%----------------------------------------------------------------------
626
627-spec renew_race_info(callgraph(), dict:dict(), [label()], [string()]) ->
628        callgraph().
629
630renew_race_info(#callgraph{race_data_server = RaceDataServer} = CG,
631		RaceCode, PublicTables, NamedTables) ->
632  ok = dialyzer_race_data_server:cast(
633	 {renew_race_info, {RaceCode, PublicTables, NamedTables}},
634	 RaceDataServer),
635  CG.
636
637-spec renew_race_code(dialyzer_races:races(), callgraph()) -> callgraph().
638
639renew_race_code(Races, #callgraph{race_data_server = RaceDataServer} = CG) ->
640  Fun = dialyzer_races:get_curr_fun(Races),
641  FunArgs = dialyzer_races:get_curr_fun_args(Races),
642  Code = lists:reverse(dialyzer_races:get_race_list(Races)),
643  ok = dialyzer_race_data_server:cast(
644	 {renew_race_code, {Fun, FunArgs, Code}},
645	 RaceDataServer),
646  CG.
647
648-spec renew_race_public_tables(label(), callgraph()) -> callgraph().
649
650renew_race_public_tables(VarLabel,
651			 #callgraph{race_data_server = RaceDataServer} = CG) ->
652  ok =
653    dialyzer_race_data_server:cast({renew_race_public_tables, VarLabel}, RaceDataServer),
654  CG.
655
656-spec cleanup(callgraph()) -> callgraph().
657
658cleanup(#callgraph{digraph = Digraph,
659                   name_map = NameMap,
660                   rev_name_map = RevNameMap,
661		   race_data_server = RaceDataServer}) ->
662  #callgraph{digraph = Digraph,
663	     name_map = NameMap,
664             rev_name_map = RevNameMap,
665	     race_data_server = dialyzer_race_data_server:duplicate(RaceDataServer)}.
666
667-spec duplicate(callgraph()) -> callgraph().
668
669duplicate(#callgraph{race_data_server = RaceDataServer} = Callgraph) ->
670  Callgraph#callgraph{
671    race_data_server = dialyzer_race_data_server:duplicate(RaceDataServer)}.
672
673-spec dispose_race_server(callgraph()) -> ok.
674
675dispose_race_server(#callgraph{race_data_server = RaceDataServer}) ->
676  dialyzer_race_data_server:stop(RaceDataServer).
677
678-spec get_digraph(callgraph()) -> digraph:graph().
679
680get_digraph(#callgraph{digraph = Digraph}) ->
681  Digraph.
682
683-spec get_named_tables(callgraph()) -> [string()].
684
685get_named_tables(#callgraph{race_data_server = RaceDataServer}) ->
686  dialyzer_race_data_server:call(get_named_tables, RaceDataServer).
687
688-spec get_public_tables(callgraph()) -> [label()].
689
690get_public_tables(#callgraph{race_data_server = RaceDataServer}) ->
691  dialyzer_race_data_server:call(get_public_tables, RaceDataServer).
692
693-spec get_race_code(callgraph()) -> dict:dict().
694
695get_race_code(#callgraph{race_data_server = RaceDataServer}) ->
696  dialyzer_race_data_server:call(get_race_code, RaceDataServer).
697
698-spec get_race_detection(callgraph()) -> boolean().
699
700get_race_detection(#callgraph{race_detection = RD}) ->
701  RD.
702
703-spec get_behaviour_api_calls(callgraph()) -> [{mfa(), mfa()}].
704
705get_behaviour_api_calls(#callgraph{race_data_server = RaceDataServer}) ->
706  dialyzer_race_data_server:call(get_behaviour_api_calls, RaceDataServer).
707
708-spec race_code_new(callgraph()) -> callgraph().
709
710race_code_new(#callgraph{race_data_server = RaceDataServer} = CG) ->
711  ok = dialyzer_race_data_server:cast(race_code_new, RaceDataServer),
712  CG.
713
714-spec put_digraph(digraph:graph(), callgraph()) -> callgraph().
715
716put_digraph(Digraph, Callgraph) ->
717  Callgraph#callgraph{digraph = Digraph}.
718
719-spec put_race_code(dict:dict(), callgraph()) -> callgraph().
720
721put_race_code(RaceCode, #callgraph{race_data_server = RaceDataServer} = CG) ->
722  ok = dialyzer_race_data_server:cast({put_race_code, RaceCode}, RaceDataServer),
723  CG.
724
725-spec put_race_detection(boolean(), callgraph()) -> callgraph().
726
727put_race_detection(RaceDetection, Callgraph) ->
728  Callgraph#callgraph{race_detection = RaceDetection}.
729
730-spec put_named_tables([string()], callgraph()) -> callgraph().
731
732put_named_tables(NamedTables,
733		 #callgraph{race_data_server = RaceDataServer} = CG) ->
734  ok = dialyzer_race_data_server:cast({put_named_tables, NamedTables}, RaceDataServer),
735  CG.
736
737-spec put_public_tables([label()], callgraph()) -> callgraph().
738
739put_public_tables(PublicTables,
740		 #callgraph{race_data_server = RaceDataServer} = CG) ->
741  ok = dialyzer_race_data_server:cast({put_public_tables, PublicTables}, RaceDataServer),
742  CG.
743
744-spec put_behaviour_api_calls([{mfa(), mfa()}], callgraph()) -> callgraph().
745
746put_behaviour_api_calls(Calls,
747		 #callgraph{race_data_server = RaceDataServer} = CG) ->
748  ok = dialyzer_race_data_server:cast({put_behaviour_api_calls, Calls}, RaceDataServer),
749  CG.
750
751%%=============================================================================
752%% Utilities for 'dot'
753%%=============================================================================
754
755-spec to_dot(callgraph(), file:filename()) -> 'ok'.
756
757to_dot(#callgraph{digraph = DG, esc = Esc} = CG, File) ->
758  %% TODO: handle Unicode names.
759  Fun = fun(L) ->
760	    case lookup_name(L, CG) of
761	      error -> L;
762	      {ok, Name} -> Name
763	    end
764	end,
765  Escaping = [{Fun(L), {color, red}}
766	      || L <- [E || {E} <- ets:tab2list(Esc)], L =/= external],
767  Vertices = digraph_edges(DG),
768  dialyzer_dot:translate_list(Vertices, File, "CG", Escaping).
769
770-spec to_ps(callgraph(), file:filename(), string()) -> 'ok'.
771
772to_ps(#callgraph{} = CG, File, Args) ->
773  %% TODO: handle Unicode names.
774  Dot_File = filename:rootname(File) ++ ".dot",
775  to_dot(CG, Dot_File),
776  Command = io_lib:format("dot -Tps ~ts -o ~ts ~ts", [Args, File, Dot_File]),
777  _ = os:cmd(Command),
778  ok.
779
780condensation(G) ->
781  {Pid, Ref} = erlang:spawn_monitor(do_condensation(G, self())),
782  receive {'DOWN', Ref, process, Pid, Result} ->
783      {SCCInts, OutETS, InETS, MapsETS} = Result,
784      NewSCCs = [ets:lookup_element(MapsETS, SCCInt, 2) || SCCInt <- SCCInts],
785      {{'e', OutETS, InETS, MapsETS}, NewSCCs}
786  end.
787
788-spec do_condensation(digraph:graph(), pid()) -> fun(() -> no_return()).
789
790do_condensation(G, Parent) ->
791  fun() ->
792      [OutETS, InETS, MapsETS] =
793        [ets:new(Name,[{read_concurrency, true}]) ||
794          Name <- [callgraph_deps_out, callgraph_deps_in, callgraph_scc_map]],
795      SCCs = digraph_utils:strong_components(G),
796      %% Assign unique numbers to SCCs:
797      Ints = lists:seq(1, length(SCCs)),
798      IntToSCC = lists:zip(Ints, SCCs),
799      IntScc = sofs:relation(IntToSCC, [{int, scc}]),
800      %% Create mapping from unique integers to SCCs:
801      ets:insert(MapsETS, IntToSCC),
802      %% Subsitute strong components for vertices in edges using the
803      %% unique numbers:
804      C2V = sofs:relation([{SC, V} || SC <- SCCs, V <- SC], [{scc, v}]),
805      I2V = sofs:relative_product(IntScc, C2V), % [{v, int}]
806      Es = sofs:relation(digraph:edges(G), [{v, v}]),
807      R1 = sofs:relative_product(I2V, Es),
808      R2 = sofs:relative_product(I2V, sofs:converse(R1)),
809      R2Strict = sofs:strict_relation(R2),
810      %% Create out-neighbours:
811      Out = sofs:relation_to_family(sofs:converse(R2Strict)),
812      ets:insert(OutETS, sofs:to_external(Out)),
813      %% Sort the SCCs topologically:
814      DG = sofs:family_to_digraph(Out),
815      lists:foreach(fun(I) -> digraph:add_vertex(DG, I) end, Ints),
816      SCCInts0 = digraph_utils:topsort(DG),
817      digraph:delete(DG),
818      %% The out-neighbors of a vertex are the vertices called directly.
819      %% The used vertices are to occur *before* the calling vertex:
820      SCCInts = lists:reverse(SCCInts0),
821      %% Create in-neighbours:
822      In = sofs:relation_to_family(R2Strict),
823      ets:insert(InETS, sofs:to_external(In)),
824      %% Create mapping from SCCs to unique integers:
825      ets:insert(MapsETS, lists:zip([{'scc', SCC} || SCC<- SCCs], Ints)),
826      lists:foreach(fun(E) -> true = ets:give_away(E, Parent, any)
827                    end, [OutETS, InETS, MapsETS]),
828      exit({SCCInts, OutETS, InETS, MapsETS})
829  end.
830