dialyzer_dataflow.erl

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

	case t_is_none(Cons) of
	  true -> error;
	  false ->
	    case bind_pat_vars([cerl:cons_hd(Pat), cerl:cons_tl(Pat)],
			       [t_cons_hd(Cons), t_cons_tl(Cons)], 
			       [], Map, State) of
	      error -> error;
	      {Map1, [HdType, TlType]} -> {Map1, t_cons(HdType, TlType)}
	    end
	end;
      literal ->
	Literal = literal_type(Pat),
	case t_is_none(t_inf(Literal, Type)) of
	  true -> error;
	  false -> {Map, Literal}
	end;
      tuple ->	
	Es = cerl:tuple_es(Pat),
	Prototype = 
	  case Es of
	    [] -> t_tuple([]);
	    [Tag|Left] ->
	      case cerl:is_c_atom(Tag) of
		true ->
		  TagAtom = cerl:atom_val(Tag),
		  case state__lookup_record(TagAtom, length(Left), State) of
		    error -> t_tuple(length(Es));
		    {ok, Record} -> Record
		  end;
		false -> t_tuple(length(Es))
	      end
	  end,
	Tuple = t_inf(Prototype, Type),
	case t_is_none(Tuple) of
	  true -> error;
	  false ->
	    SubTuples = t_tuple_subtypes(Tuple),
	    Results = [bind_pat_vars(Es, t_tuple_args(SubTuple), [], Map, State)
		       || SubTuple <- SubTuples],
	    case lists:all(fun(X) -> X =:= error end, Results) of
	      true -> error;
	      false ->
		Map1 = join_maps([M || {M, _} <- Results], Map),
		TupleType = t_sup([t_tuple(EsTypes)|| {_, EsTypes} <- Results]),
		{Map1, TupleType}
	    end
	end;
      values ->
	Es = cerl:values_es(Pat),
	case bind_pat_vars(Es, t_components(Type), [], Map, State) of
	  error -> error;
	  {Map1, EsTypes} -> {Map1, t_product(EsTypes)}
	end;
      var ->
	%% Must do inf when binding args to pats. Vars in pats are fresh.
	VarType = t_inf(lookup_type(Pat, Map), Type),
	case t_is_none(VarType) of
	  true -> error;
	  false ->
	    Map1 = enter_type(Pat, VarType, Map),
	    {Map1, Type}
	end;
      _Other ->
	%% Catch all is needed when binding args to pats
	?debug("Failed match for ~p\n", [_Other]),
	error
    end,
  case Res of
    error -> error;
    {NewMap, TypeOut} -> 
      bind_pat_vars(PatLeft, TypeLeft, [TypeOut|Acc], NewMap, State)
  end;
bind_pat_vars([], [], Acc, Map, _State) ->
  {Map, lists:reverse(Acc)};
bind_pat_vars(Pats, Type, Acc, Map, State) ->
  case t_is_any(Type) of
    true -> 
      bind_pat_vars(Pats, duplicate(length(Pats), t_any()), Acc, Map, State);
    false ->
      case t_is_none_or_unit(Type) of
	true -> error;
	false -> erlang:fault({'Error binding pats', Pats, Type})
      end
  end.
	  
bind_bin_segs([Bitstr|Left], Map) ->
  %% Only care about Size and Value since the other fields are
  %% constant literals. Size must be an integer - NO, it can be 'all'
  Val = cerl:bitstr_val(Bitstr),
  Size = cerl:bitstr_size(Bitstr),
  SizeType =  
    case cerl:type(Size) of
      literal ->
	%% Safety check
	case cerl:concrete(Size) of
	  all -> t_from_term(all);
	  N when is_integer(N) -> t_from_term(N)
	end;
      var ->
	t_inf(t_non_neg_integer(), lookup_type(cerl:bitstr_size(Bitstr), Map))
    end,
  ValType = case cerl:type(Val) of
	      literal -> t_from_term(cerl:concrete(Val));
	      var -> t_any()
	    end,
  PatType =
    case cerl:concrete(cerl:bitstr_type(Bitstr)) of
      float -> t_float();
      binary -> t_binary();
      integer ->
	case t_is_integer(SizeType) of
	  true ->
	    case t_number_vals(SizeType) of
	      any -> t_integer();
	      List ->
		Unit = cerl:concrete(cerl:bitstr_unit(Bitstr)),
		SizeVal = lists:max(List),
		Flags = cerl:concrete(cerl:bitstr_flags(Bitstr)),
		case lists:member(signed, Flags) of
		  true -> 
		    t_from_range(-(1 bsl (SizeVal*Unit - 1)), 
				 1 bsl (SizeVal*Unit - 1) - 1);
		  false -> 
		    t_from_range(0, 1 bsl SizeVal*Unit - 1)
		end
	    end;
	  false -> 
	    case t_is_atom(SizeType) of
	      true ->
		case t_atom_vals(SizeType) of
		  [all] -> t_integer();
		  _ -> t_none()
		end;
	      false ->
		t_none()
	    end
	end
    end,  
  Type = t_inf(ValType, PatType),
  bind_bin_segs(Left, enter_type(Val, Type, enter_type(Size, SizeType, Map)));
bind_bin_segs([], Map) ->
  Map.
  
  

%%________________________________________
%%
%% Guards
%%

bind_guard(Guard, Map, State) ->
  try bind_guard(Guard, Map, dict:new(), pos, State) of
      {Map1, _Type} -> Map1
  catch
    throw:{fail, Warning} -> {error, Warning};
    throw:{fatal_fail, Warning} -> {error, Warning}
  end.

bind_guard(Guard, Map, Env, Eval, State) ->
  ?debug("Handling ~w guard: ~s\n", 
	 [Eval, cerl_prettypr:format(Guard, [{noann, true}])]),
  case cerl:type(Guard) of
    binary -> 
      {Map, t_binary()};
    'case' ->
      Arg = cerl:case_arg(Guard),
      Clauses = cerl:case_clauses(Guard),
      bind_guard_case_clauses(Arg, Clauses, Map, Env, Eval, State);
    cons ->
      Hd = cerl:cons_hd(Guard),
      Tl = cerl:cons_tl(Guard),
      {Map1, HdType} = bind_guard(Hd, Map, Env, dont_know, State),
      {Map2, TlType} = bind_guard(Tl, Map1, Env, dont_know, State),
      {Map2, t_cons(HdType, TlType)};
    literal ->
      {Map, literal_type(Guard)};
    'try' ->
      Arg = cerl:try_arg(Guard),
      [Var] = cerl:try_vars(Guard),
      %%?debug("Storing: ~w\n", [Var]),
      NewEnv = dict:store(get_label(Var), Arg, Env),
      bind_guard(cerl:try_body(Guard), Map, NewEnv, Eval, State);
    tuple ->
      Es0 = cerl:tuple_es(Guard),
      {Map1, Es} = bind_guard_list(Es0, Map, Env, dont_know, State),
      {Map1, t_tuple(Es)};
    'let' ->
      Arg = cerl:let_arg(Guard),
      [Var] = cerl:let_vars(Guard),
      %%?debug("Storing: ~w\n", [Var]),
      NewEnv = dict:store(get_label(Var), Arg, Env),
      bind_guard(cerl:let_body(Guard), Map, NewEnv, Eval, State);
    values ->
      Es = cerl:values_es(Guard),
      List = [bind_guard(V, Map, Env, dont_know, State) || V <- Es],
      Type = t_product([T || {_, T} <- List]),
      {Map, Type};
    var ->
      ?debug("Looking for var(~w)...", [cerl_trees:get_label(Guard)]),
      case dict:find(get_label(Guard), Env) of
	error -> 
	  ?debug("Did not find it\n", []),
	  Type = lookup_type(Guard, Map),
	  Constr = 
	    case Eval of
	      pos -> t_from_term(true);
	      neg -> t_from_term(false);
	      dont_know -> Type
	    end,
	  Inf = t_inf(Constr, Type),
	  {enter_type(Guard, Inf, Map), Inf};
	{ok, Tree} -> 
	  ?debug("Found it\n", []),
	  {Map1, Type} = bind_guard(Tree, Map, Env, Eval, State),
	  {enter_type(Guard, Type, Map1), Type}
      end;
    call ->
      Args = cerl:call_args(Guard),      
      MFA = {cerl:atom_val(cerl:call_module(Guard)),
	     cerl:atom_val(cerl:call_name(Guard)),
	     length(Args)},
      case MFA of
	{erlang, F, 1} when F =:= is_atom; F =:= is_boolean;
			    F =:= is_binary; F =:= is_float;
			    F =:= is_function; F =:= is_integer;
			    F =:= is_list; F =:= is_number;
			    F =:= is_pid; F =:= is_port;
			    F =:= is_reference; F =:= is_tuple ->
	  [Arg] = Args,
	  {Map1, ArgType} = bind_guard(Arg, Map, Env, dont_know, State),
	  case bind_type_test(Eval, F, ArgType) of
	    error -> 
	      ?debug("Type test: ~w failed\n", [F]),
	      signal_guard_fail(Guard, [ArgType], State);
	    {ok, NewArgType, Ret} -> 
	      ?debug("Type test: ~w succeeded, NewType: ~s, Ret: ~s\n", 
		     [F, t_to_string(NewArgType), t_to_string(Ret)]),
	      {enter_type(Arg, NewArgType, Map1), Ret}
	  end;
	{erlang, is_function, 2} ->
	  {Map1, [FunType0, ArityType0]} = 
	    bind_guard_list(Args, Map, Env, dont_know, State),
	  ArityType = t_inf(ArityType0, t_integer()),
	  case t_is_none(ArityType) of
	    true -> signal_guard_fail(Guard, [FunType0, ArityType0], State);
	    false ->
	      FunTypeConstr =
		case t_number_vals(ArityType) of
		  any -> t_fun();
		  Vals -> 
		    t_sup([t_fun(duplicate(X, t_any()), t_any())|| X <- Vals])
		end,
	      FunType = t_inf(FunType0, FunTypeConstr),
	      case t_is_none(FunType) of
		true -> 
		  case Eval of
		    pos -> signal_guard_fail(Guard, [FunType0, ArityType0], 
					     State);
		    neg -> {Map1, t_atom(false)};
		    dont_know -> {Map1, t_atom(false)}
		  end;
		false ->
		  case Eval of
		    pos -> {enter_type_lists(Args, [FunType, ArityType], Map1), 
			    t_atom(true)};
		    neg -> {Map1, t_atom(false)};
		    dont_know -> {Map1, t_bool()}
		  end
	      end
	  end;
	MFA when (MFA =:= {erlang, internal_is_record, 3}) or 
		 (MFA =:= {erlang, is_record, 3}) ->
	  [Rec, Tag0, Arity0] = Args,
	  Tag = cerl:atom_val(Tag0),
	  Arity = cerl:int_val(Arity0),
	  {Map1, RecType} = bind_guard(Rec, Map, Env, dont_know, State),
	  TupleType =
	    case state__lookup_record(Tag, Arity - 1, State) of
	      error -> t_tuple([t_atom(Tag)|duplicate(Arity - 1, t_any())]);
	      {ok, Prototype} -> Prototype
	    end,
	  Type = t_inf(TupleType, RecType),
	  case t_is_none(Type) of
	    true -> 
	      case Eval of
		pos -> signal_guard_fail(Guard, 
					 [RecType, t_from_term(Tag), 
					  t_from_term(Arity)],
					 State);
		neg -> {Map1, t_atom(false)};
		dont_know -> {Map1, t_atom(false)}
	      end;
	    false -> 
	      case Eval of
		pos -> {enter_type(Rec, Type, Map1), t_atom(true)};
		neg -> {Map1, t_atom(false)};
		dont_know -> {Map1, t_bool()}
	      end
	  end;
	{erlang, '=:=', 2} ->
	  [Arg1, Arg2] = Args,
	  case {cerl:type(Arg1), cerl:type(Arg2)} of
	    {literal, literal} ->
	      case cerl:concrete(Arg1) =:= cerl:concrete(Arg2) of
		true ->
		  if Eval =:= neg -> throw({fail, none});
		     Eval =:= pos -> {Map, t_from_term(true)};
		     Eval =:= dont_know -> {Map, t_from_term(true)}
		  end;
		false ->
		  if Eval =:= neg -> {Map, t_from_term(false)};
		     Eval =:= dont_know -> {Map, t_from_term(false)};
		     Eval =:= pos -> 
 		      ArgTypes = [t_from_term(cerl:concrete(Arg1)),
				  t_from_term(cerl:concrete(Arg2))],
		      signal_guard_fail(Guard, ArgTypes, State)
		  end
	      end;
	    {literal, _} when Eval =:= pos ->
	      bind_eqeq_guard_lit_other(Guard, Arg1, Arg2, Map, Env, State);
	    {_, literal} when Eval =:= pos ->
	      bind_eqeq_guard_lit_other(Guard, Arg2, Arg1, Map, Env, State);
	    {_, _} ->
	      bind_eqeq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State)
	  end;
	{erlang, '==', 2} ->
	  [Arg1, Arg2] = Args,
	  case {cerl:type(Arg1), cerl:type(Arg2)} of
	    {literal, literal} ->
	      case cerl:concrete(Arg1) == cerl:concrete(Arg2) of
		true -> 
		  if 
		    Eval =:= pos -> {Map, t_from_term(true)};
		    Eval =:= neg -> throw({fail, none});
		    Eval =:= dont_know -> {Map, t_from_term(true)}
		  end;
		false ->
		  if 
		    Eval =:= neg -> {Map, t_from_term(false)};
		    Eval =:= dont_know -> {Map, t_from_term(false)};
		    Eval =:= pos -> 
		      ArgTypes = [t_from_term(cerl:concrete(Arg1)),
				  t_from_term(cerl:concrete(Arg2))],
		      signal_guard_fail(Guard, ArgTypes, State)
		  end
	      end;
	    {literal, _} when Eval =:= pos ->
	      case cerl:concrete(Arg1) of
		Atom when is_atom(Atom) ->
		  bind_eqeq_guard_lit_other(Guard, Arg1, Arg2, Map, Env, State);
		[] ->
		  bind_eqeq_guard_lit_other(Guard, Arg1, Arg2, Map, Env, State);
		_ ->
		  bind_eq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State)
	      end;
	    {_, literal} when Eval =:= pos ->
	      case cerl:concrete(Arg2) of
		Atom when is_atom(Atom) ->
		  bind_eqeq_guard_lit_other(Guard, Arg2, Arg1, Map, Env, State);
		[] ->
		  bind_eqeq_guard_lit_other(Guard, Arg2, Arg1, Map, Env, State);
		_ ->
		  bind_eq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State)
	      end;
	    {_, _} ->
	      bind_eq_guard(Guard, Arg1, Arg2, Map, Env, Eval, State)
	  end;
	{erlang, 'and', 2} ->
	  [Arg1, Arg2] = Args,
	  case Eval of
	    pos ->
	      {Map1, Type1} = bind_guard(Arg1, Map, Env, Eval, State),
	      case t_is_atom(true, Type1) of
		false -> throw({fail, none});
		true ->
		  {Map2, Type2} = bind_guard(Arg2, Map1, Env, Eval, State),
		  case t_is_atom(true, Type2) of
		    false -> throw({fail, none});
		    true -> {Map2, t_atom(true)}
		  end
	      end;
	    neg ->
	      {Map1, Type1} = 
		try bind_guard(Arg1, Map, Env, neg, State)
		catch throw:{fail, _} -> bind_guard(Arg2, Map, Env, pos, State)
		end,
	      {Map2, Type2} = 
		try bind_guard(Arg1, Map, Env, neg, State)
		catch throw:{fail, _} -> bind_guard(Arg2, Map, Env, pos, State)
		end,
	      case t_is_atom(false, Type1) orelse t_is_atom(false, Type2) of
		true -> {join_maps([Map1, Map2], Map), t_from_term(false)};
		false -> throw({fail, none})
	      end;
	    dont_know ->
	      True = t_atom(true),
	      {Map1, Type1} = bind_guard(Arg1, Map, Env, dont_know, State),
	      case t_is_none(t_inf(Type1, t_bool())) of
		true -> throw({fail, none});
		false ->
		  {Map2, Type2} = bind_guard(Arg2, Map1, Env, Eval, State),
		  case t_is_none(t_inf(Type2, t_bool())) of
		    true -> throw({fail, none});
		    false -> {Map2, True}
		  end
	      end
	  end;
	{erlang, 'or', 2} ->
	  [Arg1, Arg2] = Args,
	  case Eval of
	    pos ->
	      {Map1, Bool1} = 
		try bind_guard(Arg1, Map, Env, pos, State)
		catch 
		  throw:{fail,_} -> bind_guard(Arg1, Map, Env, dont_know, State)
		end,
	      {Map2, Bool2} = 
		try bind_guard(Arg2, Map, Env, pos, State)
		catch 
		  throw:{fail,_} -> bind_guard(Arg2, Map, Env, dont_know, State)