dialyzer_succ_typings.erl

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

%% -*- erlang-indent-level: 2 -*-
%%%-------------------------------------------------------------------
%%% File    : dialyzer_succ_typings.erl
%%% Author  : Tobias Lindahl <[e-mail]>
%%% Description : 
%%%
%%% Created : 11 Sep 2006 by Tobias Lindahl <[e-mail]>
%%%-------------------------------------------------------------------
-module(dialyzer_succ_typings).

-export([analyze_callgraph/3,
	 get_warnings/6]).

%% These are only intended as debug functions.
-export([doit/1,
	 analyze_callgraph_only_typesig/3,
	 analyze_callgraph_only_dataflow/3,
	 get_top_level_signatures/2,
	 get_top_level_signatures/3]).

-define(TYPE_LIMIT, 4).

%-define(DEBUG, true).
%-define(DEBUG_PP, true).

-ifdef(DEBUG).
-define(debug(X__, Y__), io:format(X__, Y__)).
-else.
-define(debug(X__, Y__), ok).
-endif.

analyze_callgraph(Callgraph, Plt, Codeserver) ->
  get_refined_success_typings(Callgraph, Plt, Codeserver).

analyze_callgraph_only_dataflow(Callgraph, Plt, Codeserver) ->
  ModulePostorder = dialyzer_callgraph:module_postorder(Callgraph),
  refine_succ_typings(ModulePostorder, Callgraph, Codeserver, true, Plt),
  Plt.

analyze_callgraph_only_typesig(Callgraph, Plt, Codeserver) ->
  find_succ_typings(Callgraph, Codeserver, Plt),
  Plt.

get_refined_success_typings(Callgraph, Plt, Codeserver) ->  
  case find_succ_typings(Callgraph, Codeserver, Plt) of
    fixpoint -> Plt;
    {not_fixpoint, Callgraph1, NotFixpoint1} ->
      NotFixpoint2 = [lookup_name(F, Callgraph) || F <- NotFixpoint1],
      ModulePostorder = 
	dialyzer_callgraph:module_postorder_from_funs(NotFixpoint2, Callgraph),
      case refine_succ_typings(ModulePostorder, Callgraph1, 
			       Codeserver, false, Plt) of
	fixpoint ->
	  Plt;
	{not_fixpoint, NotFixpoint3} ->
	  %% Need to reset the callgraph.
	  NotFixpoint4 = [lookup_name(F, Callgraph1) || F <- NotFixpoint3],
	  Callgraph2 = 
	    dialyzer_callgraph:reset_from_funs(NotFixpoint4, Callgraph1),
	  get_refined_success_typings(Callgraph2, Plt, Codeserver)
      end
  end.

get_warnings(Callgraph, Plt, DocPlt, Codeserver, NoWarnUnused, AnalysisType) ->
  {Modules, Store} = 
    case AnalysisType of
      dataflow -> {dialyzer_callgraph:module_postorder(Callgraph), true};
      succ_typings ->
	analyze_callgraph(Callgraph, Plt, Codeserver),
	{[[M] || M <- dialyzer_callgraph:modules(Callgraph)], false}
    end,
  get_warnings(Modules, Callgraph, Plt, DocPlt, Codeserver, NoWarnUnused, 
	       Store, []).

get_warnings([[M]|Left], Callgraph, Plt, DocPlt, 
	     Codeserver, NoWarnUnused, Store, Acc) ->
  %% We can get the warnings straight away.
  {ok, Tree} = dialyzer_codeserver:lookup(M, core, Codeserver),
  Records = dialyzer_codeserver:lookup_records(M, Codeserver),
  {Warnings, FunTypes} = 
    dialyzer_dataflow:get_warnings(Tree, Plt, Callgraph, Records, NoWarnUnused),
  if DocPlt =:= undefined -> ok;
     true -> insert_into_plt(FunTypes, Callgraph, DocPlt)
  end,
  if Store -> insert_into_plt(FunTypes, Callgraph, Plt);
     true -> ok
  end,
  get_warnings(Left, Callgraph, Plt, DocPlt, Codeserver, 
	       NoWarnUnused, Store, [Warnings|Acc]);
get_warnings([SCC|Left], Callgraph, Plt, DocPlt, 
	     Codeserver, NoWarnUnused, Store, Acc) ->
  %% In a scc we must first analyze the modules until fixpoint, and
  %% then get the warnings.
  refine_succ_typings([SCC], Callgraph, Codeserver, true, Plt),
  NewAcc = get_warnings([[M] || M <- SCC], Callgraph, Plt, DocPlt, 
			Codeserver, NoWarnUnused, Store, Acc),
  get_warnings(Left, Callgraph, Plt, DocPlt, Codeserver, 
	       NoWarnUnused, Store, NewAcc);
get_warnings([], _Callgraph, _Plt, _DocPlt, _Codeserver, 
	     _NoWarnUnused, _Store, Acc) ->
  lists:flatten(Acc).

refine_succ_typings(ModulePostorder, Callgraph, Codeserver, StoreAll, Plt) ->
  ?debug("Module postorder: ~p\n", [ModulePostorder]),
  refine_succ_typings(ModulePostorder, Callgraph, 
		      Codeserver, Plt, StoreAll, []).

refine_succ_typings([[M]|Left], Callgraph, Codeserver, Plt, StoreAll, 
		    Fixpoint) ->
  ?debug("Dataflow of one module: ~w\n", [M]),
  {ok, Tree} = dialyzer_codeserver:lookup(M, core, Codeserver),
  AllFuns = traverse_tree_list([Tree]),
  FunTypes = get_fun_types_from_plt(AllFuns, Callgraph, Plt),
  Records = dialyzer_codeserver:lookup_records(M, Codeserver),
  NewFunTypes = dialyzer_dataflow:get_fun_types(Tree, Plt, Callgraph, Records),

  FP = 
    case reached_fixpoint(FunTypes, NewFunTypes) of
      true -> Fixpoint;
      {false, NotFixpoint} ->
	?debug("Not fixpoint\n", []),
	NotFixpoint1 = [Fun || {Fun, _Type} <- NotFixpoint],
	case StoreAll of
	  true -> 
 	    insert_into_plt(NewFunTypes, Callgraph, Plt);
	  false -> 
	    insert_into_plt(dict:from_list(NotFixpoint), Callgraph, Plt)
	end,
	ordsets:union(ordsets:from_list(NotFixpoint1), Fixpoint)
    end,
  refine_succ_typings(Left, Callgraph, Codeserver, Plt, StoreAll, FP);
refine_succ_typings(Mods = [SCC|Left], Callgraph, Codeserver, 
		    Plt, StoreAll, Fixpoint) ->
  ?debug("Dataflow of one SCC: ~w\n", [SCC]),
  AnsList = [refine_succ_typings([[M]], Callgraph, Codeserver, 
				 Plt, StoreAll, [])
	     || M <- SCC],
  case lists:flatten([Set || {not_fixpoint, Set} <- AnsList]) of
    [] -> 
      refine_succ_typings(Left, Callgraph, Codeserver, Plt, StoreAll, Fixpoint);
    NotFixpoint ->
      NewFixpoint = ordsets:union(ordsets:from_list(NotFixpoint), Fixpoint),
      refine_succ_typings(Mods, Callgraph, Codeserver, Plt, 
			  StoreAll, NewFixpoint)
  end;
refine_succ_typings([], _Callgraph, _Codeserver, _Plt, _StoreAll, Fixpoint) ->
  case Fixpoint of
    [] -> fixpoint;
    List -> {not_fixpoint, List}
  end.

reached_fixpoint(OldTypes, NewTypes) ->
  reached_fixpoint(OldTypes, NewTypes, false).

reached_fixpoint_strict(OldTypes, NewTypes) ->
  reached_fixpoint(OldTypes, NewTypes, true).

reached_fixpoint(OldTypes0, NewTypes0, Strict) ->
  MapFunAux = fun(Type) ->
		  case is_failed_or_not_called_fun(Type) of
		    true -> failed_fun;
		    false -> erl_types:t_limit(Type, ?TYPE_LIMIT)
		  end
	      end,
  MapFun = fun(_Key, {contract, Ret_Fun, Args}) ->
	       Type = erl_types:t_fun(Args, Ret_Fun(Args)),
	       MapFunAux(Type);
	      (_Key, {Ret_Fun, Args}) when is_function(Ret_Fun)->
	       Type = erl_types:t_fun(Args, Ret_Fun(Args)),
	       MapFunAux(Type);
	      (_Key, Type) ->  
	       MapFunAux(Type)    
	   end,
  OldTypes = dict:map(MapFun, OldTypes0),
  NewTypes = dict:map(MapFun, NewTypes0),
  compare_types(OldTypes, NewTypes, Strict).

is_failed_or_not_called_fun(Type) ->
  any_none([erl_types:t_fun_range(Type)|erl_types:t_fun_args(Type)]).


any_none([T|Ts]) ->
  case erl_types:t_is_none(T) of
    true -> true;
    false -> any_none(Ts)
  end;
any_none([]) ->
  false.
      
compare_types(Dict1, Dict2, Strict) ->  
  List1 = lists:keysort(1, dict:to_list(Dict1)),
  List2 = lists:keysort(1, dict:to_list(Dict2)),
  compare_types_1(List1, List2, Strict, []).

compare_types_1([{X, _Type1}|Left1], [{X, failed_fun}|Left2], 
		Strict, NotFixpoint) ->
  compare_types_1(Left1, Left2, Strict, NotFixpoint);
compare_types_1([{X, failed_fun}|Left1], [{X, _Type2}|Left2], 
		Strict, NotFixpoint) ->
  compare_types_1(Left1, Left2, Strict, NotFixpoint);
compare_types_1([{X, Type1}|Left1], [{X, Type2}|Left2], false, NotFixpoint) ->
  case erl_types:t_is_subtype(Type1, Type2) of
    true -> compare_types_1(Left1, Left2, false, NotFixpoint);
    false -> 
      ?debug("Failed fixpoint for ~w: ~s =/= ~s\n",
	     [X, erl_types:t_to_string(Type1), 
	      erl_types:t_to_string(Type2)]),
      compare_types_1(Left1, Left2, false, [{X, Type2}|NotFixpoint])
  end;
compare_types_1([{X, Type1}|Left1], [{X, Type2}|Left2], true, NotFixpoint) ->
  case erl_types:t_is_equal(Type1, Type2) of
    true -> compare_types_1(Left1, Left2, true, NotFixpoint);
    false -> 
      ?debug("Failed fixpoint for ~w: ~s =/= ~s\n",
	     [X, erl_types:t_to_string(Type1), 
	      erl_types:t_to_string(Type2)]),
      compare_types_1(Left1, Left2, true, [{X, Type2}|NotFixpoint])
  end;
compare_types_1([_|Left1], List2, Strict, NotFixpoint) ->
  %% If the function was not called.
  compare_types_1(Left1, List2, Strict, NotFixpoint);
compare_types_1([], [], _Strict, []) ->
  true;
compare_types_1([], [], _Strict, NotFixpoint) ->
  {false, NotFixpoint}.

find_succ_typings(Callgraph, Codeserver, Plt) ->
  find_succ_typings(Callgraph, Codeserver, Plt, []).

find_succ_typings(Callgraph, Codeserver, Plt, NotFixpoint) ->
  case dialyzer_callgraph:take_scc(Callgraph) of
    {ok, SCC, NewCallgraph} ->
      ?debug("Taking: ~w\n", [SCC]),      
      NewNotFixpoint1 = analyze_scc(SCC, Callgraph, Codeserver, Plt),
      NewNotFixpoint2 = ordsets:union(NewNotFixpoint1, NotFixpoint),
      find_succ_typings(NewCallgraph, Codeserver, Plt, NewNotFixpoint2);
    none ->
      ?debug("Done\n\n", []),
      case NotFixpoint =:= [] of
	true -> fixpoint;
	false -> {not_fixpoint, Callgraph, NotFixpoint}
      end
  end.

analyze_scc(SCC, Callgraph, Codeserver, Plt) ->
  NextLabel = dialyzer_codeserver:next_core_label(Codeserver),
  SCC1 = [{MFA, 
	   dialyzer_codeserver:lookup(MFA, core, Codeserver),