dialyzer_dataflow.erl

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

	  end
      end;
    'catch' ->
      {State1, _Map1, _} = traverse(cerl:catch_body(Tree), Map, DefVars, State),
      {State1, Map, t_any()};
    cons ->
      Hd = cerl:cons_hd(Tree),
      Tl = cerl:cons_tl(Tree),
      {State1, Map1, HdType} = traverse(Hd, Map, DefVars, State),
      {State2, Map2, TlType} = traverse(Tl, Map1, DefVars, State1),
      State3 = 
	case t_is_none(t_inf(TlType, t_list())) of
	  true ->
	    Msg = io_lib:format("Cons will produce an improper list since its "
				"2nd argument is ~s\n",
				[format_type(TlType, State2)]),
	    state__add_warning(State2, ?WARN_NON_PROPER_LIST, Tree, Msg);
	  false ->
	    State2
	end,
      Type = t_cons(HdType, TlType),
      {State3, Map2, Type};
    'fun' ->
      Type = state__fun_type(Tree, State),
      case state__warning_mode(State) of
	true -> {State, Map, Type};
	false ->
	  State1 = state__add_work(get_label(Tree), State),
	  State2 = state__update_fun_env(Tree, {Map, DefVars}, State1),
	  {State2, Map, Type}
      end;
    'let' ->
      Arg = cerl:let_arg(Tree),
      Vars = cerl:let_vars(Tree),
      Map0 =
	case cerl:is_c_var(Arg) of
	  true ->
	    [Var] = Vars,
	    enter_subst(Var, Arg, Map);
	  false ->
	    Map
	end,
      Body = cerl:let_body(Tree),
      {State1, Map1, ArgTypes} = traverse(Arg, Map0, DefVars, State),
      case t_is_none_or_unit(ArgTypes) of
	true -> {State1, Map1, ArgTypes};
	false -> 
	  VarTypes = wrap_if_single(t_components(ArgTypes)),
	  Map2 = enter_type_lists(Vars, VarTypes, Map1),
	  traverse(Body, Map2, add_def_vars(Vars, DefVars), State1)
      end;
    letrec ->
      Defs = cerl:letrec_defs(Tree),
      Body = cerl:letrec_body(Tree),
      %% By not including the variables in scope we can assure that we
      %% will get the current function type when using the variables.
      FoldFun = fun({Var, Fun}, {AccState, AccMap}) ->
		    {NewAccState, NewAccMap0, FunType} = 
		      traverse(Fun, AccMap, DefVars, AccState),
		    NewAccMap = enter_type(Var, FunType, NewAccMap0),
		    {NewAccState, NewAccMap}
		end,
      {State1, Map1} = lists:foldl(FoldFun, {State, Map}, Defs),
      traverse(Body, Map1, DefVars, State1);
    literal ->
      %% This is needed for finding records
      case cerl:unfold_literal(Tree) of
	Tree -> {State, Map, literal_type(Tree)};
	NewTree -> traverse(NewTree, Map, DefVars, State)
      end;
    module ->
      %% By not including the variables in scope we can assure that we
      %% will get the current function type when using the variables.
      Defs = cerl:module_defs(Tree),
      PartFun = fun({_Var, Fun}) -> 
		    state__is_escaping(get_label(Fun), State)
		end,
      {Defs1, Defs2} = 	lists:partition(PartFun, Defs),
      Letrec = cerl:c_letrec(Defs1, cerl:c_int(42)),
      {State1, Map1, _FunTypes} = traverse(Letrec, Map, DefVars, State),
      %% Also add environments for the other top-level functions.
      VarTypes = [{Var, state__fun_type(Fun, State1)} || {Var, Fun} <- Defs],
      EnvMap = enter_type_list(VarTypes, Map),
      FoldFun = fun({_Var, Fun}, AccState) ->
		    state__update_fun_env(Fun, {EnvMap, DefVars}, AccState)
		end,
      State2 = lists:foldl(FoldFun, State1, Defs2),
      {State2, Map1, t_any()};
    primop ->
      Type =
	case cerl:atom_val(cerl:primop_name(Tree)) of
	  match_fail -> t_none();
	  raise -> t_none();
	  Other -> erlang:fault({'Unsupported primop', Other})
	end,
      {State, Map, Type};      
    'receive' ->
      Clauses = filter_match_fail(cerl:receive_clauses(Tree)),
      Timeout = cerl:receive_timeout(Tree),
      {MapList, State1, ReceiveType} = 
	handle_clauses(Clauses, none, t_any(), t_any(),
		       State, [], Map, DefVars, []),
      Map1 = join_maps(MapList, Map),
      {State2, Map2, TimeoutType} = traverse(Timeout, Map1, DefVars, State1),
      case (t_is_atom(TimeoutType) andalso 
	    (t_atom_vals(TimeoutType) =:= [infinity])) of
	true ->
	  {State2, Map2, ReceiveType};
	false ->
	  Action = cerl:receive_action(Tree),
	  {State3, Map3, ActionType} = traverse(Action, Map, DefVars, State2),
	  Map4 = join_maps([Map3, Map1], Map),
	  Type = t_sup(ReceiveType, ActionType),
	  {State3, Map4, Type}
      end;
    seq ->
      Arg = cerl:seq_arg(Tree),
      Body = cerl:seq_body(Tree),
      {State1, Map1, ArgType} = traverse(Arg, Map, DefVars, State),
      case t_is_none_or_unit(ArgType) of
	true ->
	  {State1, Map1, ArgType};
	false ->
	  traverse(Body, Map1, DefVars, State1)
      end;
    'try' ->
      Arg = cerl:try_arg(Tree),
      EVars = cerl:try_evars(Tree),
      Vars = cerl:try_vars(Tree),
      Body = cerl:try_body(Tree),
      Handler = cerl:try_handler(Tree),

      {State1, Map1, ArgType} = traverse(Arg, Map, DefVars, State),      
      Map2 = mark_as_fresh(Vars, Map1),
      ArgTypes = wrap_if_single(t_components(ArgType)),
      {SuccState, SuccMap, SuccType} =       
	case bind_pat_vars(Vars, ArgTypes, [], Map2, State1) of
	  error -> 
	    {State1, map__new(), t_none()};
	  {SuccMap1, VarTypes} ->
	    %% Try to bind the argument. Will only succeed if 
	    %% it is a simple structured term.
	    case bind_pat_vars([Arg], [t_product(VarTypes)], [], 
			       SuccMap1, State1) of
	      error -> SuccMap2 = SuccMap1;
	      {SuccMap2, _} -> ok
	    end,
	    DefVars1 = add_def_vars(Vars, DefVars),
	    traverse(Body, SuccMap2, DefVars1, State1)
	end,
      ExcMap1 = mark_as_fresh(EVars, Map),
      DefVars2 = add_def_vars(EVars, DefVars),
      {State2, ExcMap2, HandlerType} = 
	traverse(Handler, ExcMap1, DefVars2, SuccState),
      TryType = t_sup(SuccType, HandlerType),
      {State2, join_maps([ExcMap2, SuccMap], Map1), TryType};
    tuple ->
      Elements = cerl:tuple_es(Tree),
      {State1, Map1, EsType} = traverse_list(Elements, Map, DefVars, State),
      %% Let's find out if this is a record construction.
      case Elements of
	[Tag|Left] ->
	  case cerl:is_c_atom(Tag) of
	    true ->
	      TagVal = cerl:atom_val(Tag),
	      case state__lookup_record(TagVal, length(Left), State1) of
		error -> {State1, Map1, t_tuple(EsType)};
		{ok, Prototype} -> 
		  TupleType = t_inf(Prototype, t_tuple(EsType)),
		  case t_is_none(TupleType) of
		    true ->
		      {State1, Map1, t_none()};
		    false ->
		      case bind_pat_vars(Elements, t_tuple_args(TupleType), [], 
					 Map1, State1) of
			error ->
			  {State1, Map1, t_none()};
			{Map2, ETypes} ->
			  {State1, Map2, t_tuple(ETypes)}
		      end
		  end
	      end;
	    false ->
	      {State1, Map1, t_tuple(EsType)}
	  end;
	[] ->
	  {State1, Map1, t_tuple([])}
      end;
    values ->
      Elements = cerl:values_es(Tree),
      {State1, Map1, EsType} = traverse_list(Elements, Map, DefVars, State),
      Type  = t_product(EsType),
      {State1, Map1, Type};
    var ->
      case is_def_var(Tree, DefVars) of
	true ->
	  {State, Map, lookup_type(Tree, Map)};
	false ->
	  ?debug("Looking up unknown variable: ~p\n", [Tree]),
	  case state__lookup_type_for_rec_var(Tree, State) of
	    error -> erlang:fault({'Non-defined variable', Tree});
	    {ok, Type} -> {State, Map, Type}
	  end
      end;
    Other ->
      erlang:fault({'Unsupported type', Other})
  end.

traverse_list(Trees, Map, DefVars, State) ->
  traverse_list(Trees, Map, DefVars, State, []).

traverse_list([Tree|Tail], Map, DefVars, State, Acc) ->
  {State1, Map1, Type} = traverse(Tree, Map, DefVars, State),
  traverse_list(Tail, Map1, DefVars, State1, [Type|Acc]);
traverse_list([], Map, _DefVars, State, Acc) ->
  {State, Map, lists:reverse(Acc)}.

  
%%________________________________________
%%
%% Special instructions
%%

do_call(M, F, As, State) ->
  Arity = length(As),
  {Ret, ArgCs, Sig} = 
    case erl_bif_types:is_known(M, F, Arity) of
      true ->
	BifRet = erl_bif_types:type(M, F, Arity, As),
	BifArgs = 
	  case erl_bif_types:arg_types(M, F, Arity) of
	    any -> duplicate(Arity, t_any());
	    List -> List
	  end,
	{BifRet, BifArgs, t_fun(BifArgs, erl_bif_types:type(M, F, Arity))};
      false ->
	{PltRet, PltArg} = state__lookup_non_local(M, F, Arity, State, As),
	{PltRet, PltArg, t_fun(PltArg, PltRet)}
    end,
  NewArgs = t_inf_lists(ArgCs, As),  
  case any_none([Ret|NewArgs]) of
    true -> 
      case t_is_none(t_fun_range(Sig)) of
	true -> {t_none(), NewArgs};
	false -> {failed, Sig}
      end;
    false -> {Ret, NewArgs}
  end.
  
handle_clauses([C|Left], Arg, ArgType, OrigArgType, 
	       State, CaseTypes, MapIn, DefVars, Acc) ->
  {State1, ClauseMap, BodyType, NewArgType} = 
    do_clause(C, Arg, ArgType, OrigArgType, MapIn, DefVars, State),
  {NewCaseTypes, NewAcc} =
    case t_is_none(BodyType) of
      true -> {CaseTypes, Acc};
      false -> {[BodyType|CaseTypes], [ClauseMap|Acc]}
    end,
  handle_clauses(Left, Arg, NewArgType, OrigArgType, State1, 
		 NewCaseTypes, MapIn, DefVars, NewAcc);
handle_clauses([], _Arg, _ArgType, _OrigArgType, State, CaseTypes, 
	       _MapIn, _DefVars, Acc) ->
  {lists:reverse(Acc), State, t_sup(CaseTypes)}.

do_clause(C, Arg, ArgType0, OrigArgType, Map, DefVars, State) ->
  Pats = cerl:clause_pats(C),
  Guard = cerl:clause_guard(C),
  Body = cerl:clause_body(C),
  Map0 = mark_as_fresh(Pats, Map),
  ArgTypes = t_components(ArgType0),  
  
  if Arg =:= none -> Map1 = Map0;
     true ->         Map1 = bind_subst(Arg, Pats, Map0)
  end,

  case bind_pat_vars(Pats, ArgTypes, [], Map1, State) of
    error -> 
      ?debug("Failed binding pattern: ~s\nto ~s\n", 
	     [cerl_prettypr:format(C), format_type(ArgType0, State)]),
      PatternString = format_patterns(Pats),
      {Msg, Force} = 
	case t_is_none(ArgType0) of
	  true ->
	    {io_lib:format("The ~s can never match since"
			   " previous clauses completely covered the type ~s\n",
			   [PatternString, format_type(OrigArgType, State)]),
	     false};
	  false ->
	    %% Try to find out if this is a default clause in a list 
	    %% comprehension and supress this. A real Hack(tm)
	    Force0 =
	      case is_compiler_generated(cerl:get_ann(C)) of
		true ->
		  case Pats of
		    [Pat] -> 
		      case cerl:is_c_cons(Pat) of
			true ->
			  not (cerl:is_c_var(cerl:cons_hd(Pat)) andalso
			       cerl:is_c_var(cerl:cons_tl(Pat)) andalso
			       cerl:is_literal(Guard) andalso
			       (cerl:concrete(Guard) =:= true));
			false ->
			  true
		      end;
		    _ -> true
		  end;
		false ->
		  true
	      end,
	    {io_lib:format("The ~s can never match the type ~s\n",
			   [PatternString, format_type(ArgType0, State)]),
	     Force0}
	end,
      {state__add_warning(State, ?WARN_MATCHING, C, Msg, Force), 
       Map, t_none(), ArgType0};
    {Map2, PatTypes} ->
      case Arg =:= none of
	true -> Map3 = Map2;
	false ->
	  %% Try to bind the argument. Will only succeed if 
	  %% it is a simple structured term.
	  case bind_pat_vars([Arg], [t_product(PatTypes)], [], Map2, State) of
	    error -> Map3 = Map2;
	    {Map3, _} -> ok
	  end
      end,
      NewArgType = 
	case Arg =:= none of
	  true -> ArgType0;
	  false ->
	    GenType = dialyzer_typesig:get_safe_underapprox(Pats, Guard),
	    t_subtract(t_product(wrap_if_single(ArgType0)), GenType)
	end,
      case bind_guard(Guard, Map3, State) of
	{error, Reason} -> 
	  ?debug("Failed guard: ~s\n", 
		 [cerl_prettypr:format(C, [{hook, cerl_typean:pp_hook()}])]),
	  PatternString = format_patterns(Pats),
	  DefaultMsg = 
	    case Pats =:= [] of
	      true -> "Clause guard cannot succeed.\n";
	      false ->
		io_lib:format("Clause guard cannot succeed. The ~s was matched"
			      " against the type ~s\n",
			      [PatternString, format_type(ArgType0, State)])
	    end,
	  State1 =
	    case Reason of
	      none -> state__add_warning(State, ?WARN_MATCHING, C, DefaultMsg);
	      {FailGuard, Msg} ->
		case is_compiler_generated(cerl:get_ann(FailGuard)) of
		  false -> 
		    state__add_warning(State, ?WARN_MATCHING, FailGuard, Msg);
		  true ->
		    state__add_warning(State, ?WARN_MATCHING, C, Msg)
		end
	    end,
	  {State1, Map, t_none(), NewArgType};
	Map4 ->
	  FoldFun = fun(ST, Acc) ->
			case cerl:is_c_var(ST) of
			  true -> [ST|Acc];
			  false -> Acc
			end
		    end,
	  PatVars = [cerl_trees:fold(FoldFun, [], Pat) || Pat <- Pats],
	  DefVars1 = add_def_vars(lists:flatten(PatVars), DefVars),
	  {RetState, RetMap, BodyType} = traverse(Body, Map4, DefVars1, State),
	  {RetState, RetMap, BodyType, NewArgType}
      end
  end.

wrap_if_single(X) when is_list(X) -> X;
wrap_if_single(X) -> [X].

bind_subst(Arg, Pats, Map) ->
  case cerl:type(Arg) of
    values -> 
      bind_subst_list(cerl:values_es(Arg), Pats, Map);
    var ->
      [Pat] = Pats,
      enter_subst(Arg, Pat, Map);
    _ ->
      Map
  end.

bind_subst_list([Arg|ArgLeft], [Pat|PatLeft], Map) ->
  NewMap =
    case {cerl:type(Arg), cerl:type(Pat)} of
      {var, var} ->         enter_subst(Arg, Pat, Map);
      {var, alias} ->       enter_subst(Arg, cerl:alias_pat(Pat), Map);
      {literal, literal} -> Map;
      {T, T} ->             bind_subst_list(lists:flatten(cerl:subtrees(Arg)),
					    lists:flatten(cerl:subtrees(Pat)),
					    Map);
      _ ->                  Map
    end,
  bind_subst_list(ArgLeft, PatLeft, NewMap);
bind_subst_list([], [], Map) ->
  Map.

bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State) ->
  ?debug("Binding pat: ~w to ~s\n", [cerl:type(Pat), format_type(Type, State)]),
  Res =
    case cerl:type(Pat) of
      alias ->
	AliasPat = cerl:alias_pat(Pat),
	Var = cerl:alias_var(Pat),
	Map1 = enter_subst(Var, AliasPat, Map),
	case bind_pat_vars([AliasPat], [Type], [], Map1, State) of
	  error -> error;
	  {Map2, [PatType]} -> {enter_type(Var, PatType, Map2), PatType}
	end;
      binary ->
	case t_is_none(t_inf(t_binary(), Type)) of
	  true -> error;
	  false -> {bind_bin_segs(cerl:binary_segments(Pat), Map), t_binary()}
	end;
      cons ->
	Cons = t_inf(Type, t_cons()),