dialyzer_dataflow.erl

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

		end,
	      case ((t_is_atom(true, Bool1) andalso t_is_bool(Bool2))
		    orelse 
		    (t_is_atom(true, Bool2) andalso t_is_bool(Bool1))) of
		true -> {join_maps([Map1, Map2], Map), t_from_term(true)};
		false -> throw({fail, none})
	      end;
	    neg ->
	      {Map1, Type1} = bind_guard(Arg1, Map, Env, neg, State),
	      case t_is_atom(true, Type1) of
		false -> throw({fail, none});
		true ->
		  {Map2, Type2} = bind_guard(Arg2, Map1, Env, neg, State),
		  case t_is_atom(true, Type2) of
		    false -> throw({fail, none});
		    true -> {Map2, t_atom(false)}
		  end
	      end;
	    dont_know ->
	      {Map1, Bool1} = bind_guard(Arg1, Map, Env, dont_know, State),
	      {Map2, Bool2} = bind_guard(Arg2, Map, Env, dont_know, State),
	      case t_is_bool(Bool1) andalso t_is_bool(Bool2) of
		true -> {join_maps([Map1, Map2], Map), t_sup(Bool1, Bool2)};
		false -> throw({fail, none})
	      end
	  end;
	{erlang, 'not', 1} ->
	  [Arg] = Args,
	  case Eval of
	    neg -> 
	      {Map1, Type} = bind_guard(Arg, Map, Env, pos, State),
	      case t_is_atom(true, Type) of
		true -> {Map1, t_atom(false)};
		false -> throw({fail, none})
	      end;
	    pos -> 
	      {Map1, Type} = bind_guard(Arg, Map, Env, neg, State),
	      case t_is_atom(false, Type) of
		true -> {Map1, t_atom(true)};
		false -> throw({fail, none})
	      end;
	    dont_know -> 
	      {Map1, Type} = bind_guard(Arg, Map, Env, dont_know, State),
	      Bool = t_inf(Type, t_bool()),
	      case t_is_none(Bool) of
		true -> throw({fatal_fail, none});
		false ->
		  case t_atom_vals(Type) of
		    [true] -> {Map1, t_from_term(false)};
		    [false] -> {Map1, t_from_term(true)};
		    [_, _] -> {Map1, Type}
		  end
	      end
	  end;
	{M, F, A} ->
	  {Map1, As} = bind_guard_list(Args, Map, Env, dont_know, State),
	  BifRet = erl_bif_types:type(M, F, A, As),
	  case t_is_none(BifRet) of
	    true ->
	      %% Is this an error-bif?
	      case t_is_none(erl_bif_types:type(M, F, A)) of
		true -> signal_guard_fail(Guard, As, State);
		false -> signal_guard_fatal_fail(Guard, As, State)
	      end;
	    false ->
	      case erl_bif_types:arg_types(M, F, A) of
		any -> BifArgs = duplicate(A, t_any());
		List -> BifArgs = List
	      end,
	      Map2 = enter_type_lists(Args, t_inf_lists(BifArgs, As), Map1),
	      Ret = 
		case Eval of
		  pos -> t_inf(t_from_term(true), BifRet);
		  neg -> t_inf(t_from_term(false), BifRet);
		  dont_know -> BifRet
		end,
	      case t_is_none(Ret) of
		true ->
		  case Eval =:= pos of
		    true -> signal_guard_fail(Guard, As, State);
		    false -> throw({fail, none})
		  end;
		false -> {Map2, Ret}
	      end
	  end
      end
  end.

bind_type_test(Eval, TypeTest, ArgType) ->
  Type = case TypeTest of
	   is_atom -> t_atom();
	   is_boolean -> t_bool();
	   is_binary -> t_binary();
	   is_float -> t_float();
	   is_function -> t_fun();
	   is_integer -> t_integer();
	   is_list -> t_pos_improper_list();
	   is_number -> t_number();
	   is_pid -> t_pid();
	   is_port -> t_port();
	   is_reference -> t_ref();
	   is_tuple -> t_tuple()
	 end,
  case Eval of
    pos ->
      Inf = t_inf(Type, ArgType),
      case t_is_none(Inf) of
	true -> error;
	false -> {ok, Inf, t_from_term(true)}
      end;
    neg ->
      Sub = t_subtract(ArgType, Type),
      case t_is_none(Sub) of
	true -> error;
	false -> {ok, Sub, t_from_term(false)}
      end;
    dont_know ->
      {ok, ArgType, t_bool()}
  end.

bind_eq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State) ->
  {Map1, Type1} = bind_guard(Arg1, Map, Env, dont_know, State),
  {Map2, Type2} = bind_guard(Arg2, Map1, Env, dont_know, State),
  case (t_is_nil(Type1) orelse t_is_nil(Type2) orelse
	t_is_atom(Type1) orelse t_is_atom(Type2)) of
    true -> bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State);
    false ->
      case Eval of
	pos -> {Map2, t_from_term(true)};
	neg -> {Map2, t_from_term(false)};
	dont_know -> {Map2, t_bool()}
      end
  end.

bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State) ->
  {Map1, Type1} = bind_guard(Arg1, Map, Env, dont_know, State),
  {Map2, Type2} = bind_guard(Arg2, Map1, Env, dont_know, State),
  ?debug("Types are:~s =:= ~s\n", [t_to_string(Type1), 
				   t_to_string(Type2)]),
  Inf = t_inf(Type1, Type2),
  case t_is_none(Inf) of
    true ->
      case Eval of
	neg -> {Map2, t_from_term(false)};
	dont_know -> {Map2, t_from_term(false)};
	pos -> signal_guard_fail(Guard, [Type1, Type2], State)
      end;
    false ->
      case Eval of
	pos ->
	  case {cerl:type(Arg1), cerl:type(Arg2)} of
	    {var, var} ->
	      Map3 = enter_subst(Arg1, Arg2, Map2),
	      Map4 = enter_type(Arg2, Inf, Map3),
	      {Map4, t_atom(true)};
	    {var, _} ->
	      Map3 = enter_type(Arg1, Inf, Map2),
	      {Map3, t_atom(true)};
	    {_, var} ->
	      Map3 = enter_type(Arg2, Inf, Map2),
	      {Map3, t_atom(true)};
	    {_, _} ->
	      {Map2, t_atom(true)}
	  end;
	neg ->
	  {Map2, t_from_term(false)};
	dont_know ->
	  {Map2, t_bool()}
      end
  end.

bind_eqeq_guard_lit_other(Guard, Arg1, Arg2, Map, Env, State) ->
  %% Assumes positive evaluation
  case cerl:concrete(Arg1) of
    true ->
      {Map1, Type} = bind_guard(Arg2, Map, Env, pos, State),
      case t_is_atom(true, Type) of
	true -> {Map1, Type};
	false -> 
	  {_, Type0} = bind_guard(Arg2, Map, Env, dont_know, State),
	  signal_guard_fail(Guard, [Type0, t_from_term(true)], State)
      end;
    false -> 
      {Map1, Type} = bind_guard(Arg2, Map, Env, neg, State),
      case t_is_atom(false, Type) of
	true -> {Map1, t_atom(true)};
	false -> 
	  {_, Type0} = bind_guard(Arg2, Map, Env, dont_know, State),
	  signal_guard_fail(Guard, [Type0, t_from_term(true)], State)
      end;
    Term ->
      LitType = t_from_term(Term),
      {Map1, Type} = bind_guard(Arg2, Map, Env, dont_know, State),
      case t_is_subtype(LitType, Type) of
	false -> signal_guard_fail(Guard, [Type, LitType], State);
	true ->
	  case cerl:is_c_var(Arg2) of
	    true -> {enter_type(Arg2, LitType, Map1), t_from_term(true)};
	    false -> {Map1, t_from_term(true)}
	  end
      end
  end.

bind_guard_list(Guards, Map, Env, Eval, State) ->
  bind_guard_list(Guards, Map, Env, Eval, State, []).

bind_guard_list([G|Left], Map, Env, Eval, State, Acc) ->
  {Map1, T} = bind_guard(G, Map, Env, Eval, State),
  bind_guard_list(Left, Map1, Env, Eval, State, [T|Acc]);
bind_guard_list([], Map, _Env, _Eval, _State, Acc) ->
  {Map, lists:reverse(Acc)}.

signal_guard_fail(Guard, ArgTypes, State) ->
  Args = cerl:call_args(Guard),
  F = cerl:atom_val(cerl:call_name(Guard)),
  MFA = {cerl:atom_val(cerl:call_module(Guard)), F, length(Args)},
  Msg =
    case is_infix_op(MFA) of
      true -> 
	[ArgType1, ArgType2] = ArgTypes,
	[Arg1, Arg2] = Args,
	io_lib:format("Guard test ~s ~s ~s can never succeed.\n",
		      [format_args_1([Arg1], [ArgType1], State), 
		       atom_to_list(F),
		       format_args_1([Arg2], [ArgType2], State)]);
      false ->
	io_lib:format("Guard test ~w~s can never succeed\n", 
		      [F, format_args(Args, ArgTypes, State)])
    end,
  throw({fail, {Guard, Msg}}).

is_infix_op({erlang, '=:=', 2}) -> true;
is_infix_op({erlang, '==', 2}) -> true;
is_infix_op({erlang, '=/=', 2}) -> true;
is_infix_op({erlang, '=/', 2}) -> true;
is_infix_op({erlang, '<', 2}) -> true;
is_infix_op({erlang, '=<', 2}) -> true;
is_infix_op({erlang, '>', 2}) -> true;
is_infix_op({erlang, '>=', 2}) -> true;
is_infix_op({_, _, _}) -> false.


signal_guard_fatal_fail(Guard, ArgTypes, State) ->
  Args = cerl:call_args(Guard),      
  F = cerl:atom_val(cerl:call_name(Guard)),
  Msg = io_lib:format("Guard test ~w~s can never succeed\n",
		      [F, format_args(Args, ArgTypes, State)]),
  throw({fatal_fail, {Guard, Msg}}).

bind_guard_case_clauses(Arg, Clauses, Map, Env, Eval, State) ->
  Clauses1 = filter_fail_clauses(Clauses),
  {GenMap, GenArgType} = bind_guard(Arg, Map, Env, dont_know, State),
  bind_guard_case_clauses(GenArgType, GenMap, Arg, Clauses1, Map, Env, Eval, 
			  t_none(), [], State).

filter_fail_clauses([Clause|Left]) ->
  case (cerl:clause_pats(Clause) =:= []) of
    true ->
      Body = cerl:clause_body(Clause),
      case cerl:is_literal(Body) andalso (cerl:concrete(Body) =:= fail) of
	true -> filter_fail_clauses(Left);
	false -> [Clause|filter_fail_clauses(Left)]
      end;
    false ->
      [Clause|filter_fail_clauses(Left)]
  end;
filter_fail_clauses([]) ->
  [].

bind_guard_case_clauses(GenArgType, GenMap, ArgExpr, [Clause|Left], 
			Map, Env, Eval, AccType, AccMaps, State) ->
  Pats = cerl:clause_pats(Clause),
  {NewMap0, ArgType} =
    case Pats of
      [Pat] ->
	case cerl:is_literal(Pat) of
	  true ->
	    try
	      case cerl:concrete(Pat) of
		true -> bind_guard(ArgExpr, Map, Env, pos, State);
		false -> bind_guard(ArgExpr, Map, Env, neg, State);
		_ -> {GenMap, GenArgType}
	      end
	    catch 
	      throw:{fail, _} -> {none, GenArgType}
	    end;
	  false ->
	    {GenMap, GenArgType}
	end;
      _ -> {GenMap, GenArgType}
    end,
  NewMap1 =
    case Pats =:= [] of
      true -> NewMap0;
      false ->
	case bind_pat_vars(Pats, t_components(ArgType), [], NewMap0, State) of
	  error -> none;
	  {PatMap, _PatTypes} -> PatMap
	end
    end,
  Guard = cerl:clause_guard(Clause),
  GenPatType = dialyzer_typesig:get_safe_underapprox(Pats, Guard),
  NewGenArgType = t_subtract(GenArgType, GenPatType),
  case (NewMap1 =:= none) orelse t_is_none(GenArgType) of
    true ->
      bind_guard_case_clauses(NewGenArgType, GenMap, ArgExpr, Left, Map, Env, 
			      Eval, AccType, AccMaps, State);
    false ->
      {NewAccType, NewAccMaps} =
	try
	  {NewMap2, GuardType} = bind_guard(Guard, NewMap1, Env, pos, State),
	  case t_is_none(t_inf(t_from_term(true), GuardType)) of
	    true -> throw({fail, none});
	    false -> ok
	  end,
	  {NewMap3, CType} = bind_guard(cerl:clause_body(Clause), NewMap2, 
					Env, Eval, State),
	  case Eval of
	    pos -> 
	      case t_is_atom(true, CType) of
		true -> ok;
		false -> throw({fail, none})
	      end;
	    neg -> 
	      case t_is_atom(false, CType) of
		true -> ok;
		false -> throw({fail, none})
	      end;
	    dont_know ->
	      ok
	  end,
	  {t_sup(AccType, CType), [NewMap3|AccMaps]}
	catch
	  throw:{fail, _What} -> {AccType, AccMaps}
	end,
      bind_guard_case_clauses(NewGenArgType, GenMap, ArgExpr, Left, Map, Env, 
			      Eval, NewAccType, NewAccMaps, State)
  end;
bind_guard_case_clauses(_GenArgType, _GenMap, _ArgExpr, [], Map, _Env, _Eval, 
			AccType, AccMaps, _State) ->
  case t_is_none(AccType) of
    true -> throw({fail, none});
    false -> {join_maps(AccMaps, Map), AccType}
  end.

%%% ============================================================================
%%%
%%%  Maps and types.
%%%
%%% ============================================================================

map__new() ->
  {dict:new(), dict:new()}.

join_maps(Maps, MapOut) ->
  {Map, Subst} = MapOut,
  Keys = ordsets:from_list(dict:fetch_keys(Map) ++ dict:fetch_keys(Subst)),
  join_maps(Keys, Maps, MapOut).

join_maps([Key|Left], Maps, MapOut) ->
  Type = join_maps_one_key(Maps, Key, t_none()),
  case t_is_equal(lookup_type(Key, MapOut), Type) of
    true ->  join_maps(Left, Maps, MapOut);
    false -> join_maps(Left, Maps, enter_type(Key, Type, MapOut))
  end;
join_maps([], _Maps, MapOut) ->
  MapOut.

join_maps_one_key([Map|Left], Key, AccType) ->
  case t_is_any(AccType) of
    true ->
      %% We can stop here
      AccType;
    false ->
      join_maps_one_key(Left, Key, t_sup(lookup_type(Key, Map), AccType))
  end;
join_maps_one_key([], _Key, AccType) ->
  AccType.

enter_type_lists([Key|KeyTail], [Val|ValTail], Map) ->
  Map1 = enter_type(Key, Val, Map),
  enter_type_lists(KeyTail, ValTail, Map1);
enter_type_lists([], [], Map) ->
  Map.

enter_type_list([{Key, Val}|Left], Map) ->
  Map1 = enter_type(Key, Val, Map),
  enter_type_list(Left, Map1);
enter_type_list([], Map) ->
  Map.

enter_type(Key, Val, MS = {Map, Subst}) ->  
  case cerl:is_literal(Key) of
    true -> MS;
    false ->
      case cerl:is_c_values(Key) of
	true ->
	  Keys = cerl:values_es(Key),
	  case t_is_any(Val) orelse t_is_none(Val) of
	    true ->
	      enter_type_lists(Keys, duplicate(length(Keys), Val), MS);
	    false ->
	      enter_type_lists(cerl:values_es(Key), t_components(Val), MS)
	  end;
	false ->
	  KeyLabel = get_label(Key),
	  case dict:find(KeyLabel, Subst) of
	    {ok, NewKey} ->
	      ?debug("Binding ~p to ~p\n", [KeyLabel, NewKey]),
	      enter_type(NewKey, Val, MS);
	    error ->
	      ?debug("Entering ~p :: ~s\n", [KeyLabel, t_to_string(Val)]),
	      case dict:find(KeyLabel, Map) of
		{ok, Val} -> MS;
		{ok, _OldVal} -> {dict:store(KeyLabel, Val, Map), Subst};
		error -> {dict:store(KeyLabel, Val, Map), Subst}
	      end
	  end
      end
  end.