dialyzer_callgraph.erl

来自「OTP是开放电信平台的简称」· ERL 代码 · 共 564 行 · 第 1/2 页

  %% functions will be analysed together with their parents. 
  Defs = cerl:module_defs(Tree),
  Mod = cerl:atom_val(cerl:module_name(Tree)),
  lists:foldl(fun({Var, Function}, {AccNameMap, AccRevNameMap, AccRecVarMap}) ->
		  FunName = cerl:fname_id(Var),
		  Arity = cerl:fname_arity(Var),
		  MFA = {Mod, FunName, Arity},
		  {dict:store(get_label(Function), MFA, AccNameMap),
		   dict:store(MFA, get_label(Function), AccRevNameMap),
		   dict:store(get_label(Var), MFA, AccRecVarMap)}
	      end, {NameMap, RevNameMap, RecVarMap}, Defs).


get_edges_from_deps(Deps) ->
  %% Convert the dependencies as produced by dialyzer_dep to a list of
  %% edges. Also, remove 'external' since we are not interested
  %% in this information.
  Edges = dict:fold(fun(external, _Set, Acc) -> Acc;
		       (Caller, Set, Acc)    -> [[{Caller, Callee} 
						  || Callee <- Set, 
						     Callee =/= external]|Acc]
		    end, [], Deps),
  lists:flatten(Edges).

name_edges(Edges, NameMap) ->
  %% If a label is present in the name map it is renamed. Otherwise
  %% keep the label as the identity.
  MapFun = fun(X) -> 
	       case dict:find(X, NameMap) of
		 error -> X;
		 {ok, MFA} -> MFA
	       end
	   end,
  name_edges(Edges, MapFun, NameMap, []).

name_edges([{From, To}|Left], MapFun, NameMap, Acc) ->
  NewFrom = MapFun(From),
  NewTo = MapFun(To),
  name_edges(Left, MapFun, NameMap, [{NewFrom, NewTo}|Acc]);
name_edges([], _MapFun, _NameMap, Acc) ->
  Acc.

scan_core_funs(Tree) ->
  Defs = cerl:module_defs(Tree),
  Mod = cerl:atom_val(cerl:module_name(Tree)),
  DeepEdges = lists:foldl(fun({Var, Function}, Edges) ->
			      FunName = cerl:fname_id(Var),
			      Arity = cerl:fname_arity(Var),
			      MFA = {Mod, FunName, Arity},
			      [scan_one_core_fun(Function, MFA)|Edges]
			  end, [], Defs),
  lists:flatten(DeepEdges).

scan_one_core_fun(TopTree, FunName) ->
  FoldFun = fun(Tree, Acc) ->
		case cerl:type(Tree) of
		  call ->
		    CalleeM = cerl:call_module(Tree),
		    CalleeF = cerl:call_name(Tree),
		    A = length(cerl:call_args(Tree)),
		    case (cerl:is_c_atom(CalleeM) andalso 
			  cerl:is_c_atom(CalleeF)) of
		      true -> 
			M = cerl:atom_val(CalleeM),
			F = cerl:atom_val(CalleeF),
			case erl_bif_types:is_known(M, F, A) of
			  true -> Acc;
			  false -> [{FunName, {M, F, A}}|Acc]
			end;
		      false -> 
			%% We cannot handle run-time bindings
			Acc
		    end;
		  _ ->
		    %% Nothing that can introduce new edges in the callgraph.
		    Acc
		end
	    end,
  cerl_trees:fold(FoldFun, [], TopTree).
				      
get_label(T) ->
  case cerl:get_ann(T) of
    [{label, L} | _] -> L;
    _ -> erlang:fault({missing_label, T})
  end.


%%____________________________________________________________
%%
%% Icode
%%

scan_icode(List, Callgraph = #dialyzer_callgraph{self_rec=SelfRec}) ->
  {NewSelfRec, Edges} = scan_icode_funs(List, SelfRec, []),
  MFAs = [MFA || {MFA, _} <- List],
  add_edges(Edges, MFAs, Callgraph#dialyzer_callgraph{self_rec=NewSelfRec}).
  %add_edges(Edges, Callgraph#dialyzer_callgraph{self_rec=NewSelfRec}).

scan_icode_funs([{MFA, Cfg}|Left], SelfRec, Edges) ->
  Icode = hipe_icode_cfg:cfg_to_linear(Cfg),
  Code = hipe_icode:icode_code(Icode),
  {NewSelfRec, NewEdges} = scan_icode_code(Code, MFA, SelfRec, 
					   [{MFA, MFA}|Edges]),
  scan_icode_funs(Left, NewSelfRec, NewEdges);
scan_icode_funs([], SelfRec, Edges) ->
  {SelfRec, Edges}.

scan_icode_code([Ins|Left], MFA, SelfRecs, Edges) ->
  {NewSelfRecs, NewEdges} =
    case hipe_icode:is_call(Ins) orelse hipe_icode:is_enter(Ins) of
      true ->
	case call_or_enter_fun(Ins) of
	  {mkfun, Closure,_,_} -> {SelfRecs, [{MFA, Closure}|Edges]};
	  MFA ->
	    %% A self recursive call.
	    {sets:add_element(MFA, SelfRecs), Edges};
	  {M, F, A} -> 
	    case erl_bif_types:is_known(M, F, A) of
	      true -> {SelfRecs, Edges};
	      false -> {SelfRecs, [{MFA, {M, F, A}}|Edges]}
	    end;
	  _ -> {SelfRecs, Edges}
	end;
      false ->
	{SelfRecs, Edges}
    end,
  scan_icode_code(Left, MFA, NewSelfRecs, NewEdges);
scan_icode_code([], _MFA, SelfRecs, Edges) ->
  {SelfRecs, Edges}.	  

call_or_enter_fun(Ins) ->      
  case hipe_icode:is_call(Ins) of
    true -> hipe_icode:call_fun(Ins);
    false -> hipe_icode:enter_fun(Ins)
  end.


%%____________________________________________________________
%%
%% Digraph
%%

digraph_new() ->
  digraph:new().

digraph_add_edges([{From, To}|Left], DG) ->
  digraph_add_edges(Left, digraph_add_edge(From, To, DG));
digraph_add_edges([], DG) ->
  DG.

digraph_add_edge(From, To, DG) ->
  case digraph:vertex(DG, From) of
    false -> digraph:add_vertex(DG, From);
    {From, _} -> ok
  end,
  case digraph:vertex(DG, To) of
    false -> digraph:add_vertex(DG, To);
    {To, _} -> ok
  end,
  digraph:add_edge(DG, {From, To}, From, To, []),
  DG.

digraph_confirm_vertices([MFA|Left], DG) ->
  digraph:add_vertex(DG, MFA, confirmed),
  digraph_confirm_vertices(Left, DG);
digraph_confirm_vertices([], DG) ->
  DG.
  
digraph_remove_external(DG) ->
  Vertices = digraph:vertices(DG),
  Unconfirmed = remove_unconfirmed(Vertices, DG),
  {DG, Unconfirmed}.

remove_unconfirmed(Vertexes, DG) ->
  remove_unconfirmed(Vertexes, DG, []).

remove_unconfirmed([V|Left], DG, Unconfirmed) ->
  case digraph:vertex(DG, V) of
    {V, confirmed} -> remove_unconfirmed(Left, DG, Unconfirmed);
    {V, []} -> remove_unconfirmed(Left, DG, [V|Unconfirmed])
  end;
remove_unconfirmed([], DG, Unconfirmed) ->
  BadCalls = lists:append([digraph:in_edges(DG, V) || V <- Unconfirmed]),
  BadCallsSorted = lists:keysort(1, BadCalls),
  digraph:del_vertices(DG, Unconfirmed),
  BadCallsSorted.

digraph_delete(DG) ->
  digraph:delete(DG).

digraph_edges(DG) ->
  digraph:edges(DG).

digraph_vertices(DG) ->
  digraph:vertices(DG).

digraph_in_neighbours(V, DG) ->
  case digraph:in_neighbours(DG, V) of
    [] -> none;
    List -> List
  end.

digraph_components(Digraph) ->
  Res = [digraph_utils:subgraph(Digraph, Vertices) 
	 || Vertices <- digraph_utils:components(Digraph)],
  digraph_delete(Digraph),
  Res.

digraph_postorder(Digraph) ->
  %% Remove all self-edges for Sccs.
  Edges = [digraph:edge(Digraph, E) || E <- digraph:edges(Digraph)],
  SelfEdges = [E || {E, V, V, _} <- Edges],
  true = digraph:del_edges(Digraph, SelfEdges),
  digraph_postorder(Digraph, -1, []).


%%% Pick all the independent nodes (leaves) from one module. Then try
%%% to stay within the module until no more independent nodes can be
%%% chosen. Then pick a new module and so on.
%%%
%%% Note that a SCC that range over more than one module is considered
%%% to belong to all modules to make sure that we do not lose any
%%% nodes.
digraph_postorder(Digraph, LastModule, Acc) ->
  Leaves = [V || V <- digraph:vertices(Digraph),
		 digraph:out_degree(Digraph, V) =:= 0],
  case Leaves =:= [] of
    true -> lists:append(lists:reverse(Acc));
    false ->
      case [SCC || SCC <- Leaves, scc_belongs_to_module(SCC, LastModule)] of
	[] ->
	  %% Choose a new module.
	  NewModule = find_module(hd(Leaves)),
	  NewTaken = [SCC || SCC <- Leaves, 
			     scc_belongs_to_module(SCC, NewModule)],
	  true = digraph:del_vertices(Digraph, NewTaken),
	  digraph_postorder(Digraph, NewModule, [NewTaken|Acc]);
	NewTaken ->
	  true = digraph:del_vertices(Digraph, NewTaken),
	  digraph_postorder(Digraph, LastModule, [NewTaken|Acc])
      end
  end.

scc_belongs_to_module([Label|Left], Module) when is_integer(Label) ->
  scc_belongs_to_module(Left, Module);
scc_belongs_to_module([{M, _, _}|Left], Module) ->
  if M =:= Module -> true;
     true -> scc_belongs_to_module(Left, Module)
  end;
scc_belongs_to_module([], _Module) ->
  false.
      
find_module([{M, _, _}|_]) -> M;
find_module([Label|Left]) when is_integer(Label) -> find_module(Left).
  

digraph_finalize(DG) ->
  DG1 = digraph_utils:condensation(DG),
  Postorder = digraph_postorder(DG1),
  digraph:delete(DG1),
  Postorder.

digraph_reaching_subgraph(Funs, DG) ->  
  Vertices = digraph_utils:reaching(Funs, DG),
  digraph_utils:subgraph(DG, Vertices).

-ifndef(NO_UNUSED).
to_dot(CG = #dialyzer_callgraph{digraph=DG, esc=Esc}) ->
  Fun = fun(L) ->
	    case lookup_name(L, CG) of
	      error -> L;
	      {ok, Name} -> Name
	    end
	end,
  Escaping = [{Fun(L), {color, red}} 
	      || L <- sets:to_list(Esc), L =/= external],
  Vertices = digraph_edges(DG),
  hipe_dot:translate_list(Vertices, "/tmp/cg.dot", "CG", Escaping),
  os:cmd("dot -T ps -o /tmp/cg.ps /tmp/cg.dot"),
  ok.
-endif.