From 0c59cb0a4092b091fbdc62f740fdb91b5b876e49 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?John=20H=C3=B6gberg?= Date: Wed, 21 Dec 2022 08:06:37 +0100 Subject: [PATCH] dialyzer: Rename t_is_none_or_unit/1 to t_is_impossible/1 Calling this function t_is_none_or_unit/1 is like saying t_is_integer_or_float/1 instead of t_is_number/1. I wouldn't be the least bit surprised if this weird naming was the root cause of GH-6580. --- lib/dialyzer/src/dialyzer_contracts.erl | 4 ++-- lib/dialyzer/src/dialyzer_dataflow.erl | 14 +++++++------- lib/dialyzer/src/dialyzer_typesig.erl | 8 ++++---- lib/dialyzer/src/erl_bif_types.erl | 8 ++++---- lib/dialyzer/src/erl_types.erl | 17 +++++++++++------ 5 files changed, 28 insertions(+), 23 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 713e475b175d..067e7956f301 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -346,11 +346,11 @@ check_contract_inf_list(List, SuccType, Opaques) -> check_contract_inf_list([{Contract, FunType}|Left], SuccType, Opaques, OM) -> FunArgs = erl_types:t_fun_args(FunType), - case lists:any(fun erl_types:t_is_none_or_unit/1, FunArgs) of + case lists:any(fun erl_types:t_is_impossible/1, FunArgs) of true -> check_contract_inf_list(Left, SuccType, Opaques, OM); false -> STRange = erl_types:t_fun_range(SuccType), - case erl_types:t_is_none_or_unit(STRange) of + case erl_types:t_is_impossible(STRange) of true -> ok; false -> Range = erl_types:t_fun_range(FunType), diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 664ef479fe2e..ece162382fa3 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -43,7 +43,7 @@ t_is_any/1, t_is_atom/1, t_is_atom/2, t_is_any_atom/3, t_is_boolean/2, t_is_integer/2, t_is_list/1, - t_is_nil/2, t_is_none/1, t_is_none_or_unit/1, + t_is_nil/2, t_is_none/1, t_is_impossible/1, t_is_number/2, t_is_reference/2, t_is_pid/2, t_is_port/2, t_is_unit/1, t_limit/2, t_list/0, t_list_elements/2, @@ -256,7 +256,7 @@ traverse(Tree, Map, State) -> Arg = cerl:seq_arg(Tree), Body = cerl:seq_body(Tree), {State1, Map1, ArgType} = SMA = traverse(Arg, Map, State), - case t_is_none_or_unit(ArgType) of + case t_is_impossible(ArgType) of true -> SMA; false -> @@ -924,7 +924,7 @@ handle_case(Tree, Map, State) -> Arg = cerl:case_arg(Tree), Clauses = cerl:case_clauses(Tree), {State1, Map1, ArgType} = SMA = traverse(Arg, Map, State), - case t_is_none_or_unit(ArgType) of + case t_is_impossible(ArgType) of true -> SMA; false -> Map2 = join_maps_begin(Map1), @@ -974,7 +974,7 @@ handle_let(Tree, Map, State) -> end, Body = cerl:let_body(Tree), {State1, Map1, ArgTypes} = SMA = traverse(Arg, Map0, State0), - case t_is_none_or_unit(ArgTypes) of + case t_is_impossible(ArgTypes) of true -> SMA; false -> Map2 = enter_type_lists(Vars, t_to_tlist(ArgTypes), Map1), @@ -1059,7 +1059,7 @@ handle_map(Tree,Map,State) -> Arg = cerl:map_arg(Tree), {State1, Map1, ArgType} = traverse(Arg, Map, State), ArgType1 = t_inf(t_map(), ArgType), - case t_is_none_or_unit(ArgType1) of + case t_is_impossible(ArgType1) of true -> {State1, Map1, ArgType1}; false -> @@ -1681,7 +1681,7 @@ bitstr_bitsize_type(Size) -> %% possible value (not 'none' or 'unit'), otherwise raise a bind_error(). bind_checked_inf(Pat, ExpectedType, Type, Opaques) -> Inf = t_inf(ExpectedType, Type, Opaques), - case t_is_none_or_unit(Inf) of + case t_is_impossible(Inf) of true -> case t_find_opaque_mismatch(ExpectedType, Type, Opaques) of {ok, T1, T2} -> @@ -2411,7 +2411,7 @@ handle_guard_map(Guard, Map, Env, State) -> Arg = cerl:map_arg(Guard), {Map1, ArgType0} = bind_guard(Arg, Map, Env, dont_know, State), ArgType1 = t_inf(t_map(), ArgType0), - case t_is_none_or_unit(ArgType1) of + case t_is_impossible(ArgType1) of true -> {Map1, t_none()}; false -> {Map2, TypePairs} = bind_guard_map_pairs(Pairs, Map1, Env, State, []), diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 3198d8e62416..bbddf2a0a350 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -42,7 +42,7 @@ t_is_float/1, t_is_fun/1, t_is_integer/1, t_non_neg_integer/0, t_is_list/1, t_is_nil/1, t_is_none/1, t_is_number/1, - t_is_singleton/1, t_is_none_or_unit/1, + t_is_singleton/1, t_is_impossible/1, t_limit/2, t_list/0, t_list/1, t_list_elements/1, t_nonempty_list/1, t_maybe_improper_list/0, @@ -534,14 +534,14 @@ traverse(Tree, DefinedVars, State) -> false -> t_any(); true -> MT = t_inf(lookup_type(MapVar, Map), t_map()), - case t_is_none_or_unit(MT) of + case t_is_impossible(MT) of true -> t_none(); false -> DisjointFromKeyType = fun(ShadowKey) -> ST = t_inf(lookup_type(ShadowKey, Map), KeyType), - t_is_none_or_unit(ST) + t_is_impossible(ST) end, case lists:all(DisjointFromKeyType, ShadowKeys) of true -> t_map_get(KeyType, MT); @@ -575,7 +575,7 @@ traverse(Tree, DefinedVars, State) -> cerl:concrete(OpTree) =:= exact of true -> ST = t_inf(ShadowedKeys, KeyType), - case t_is_none_or_unit(ST) of + case t_is_impossible(ST) of true -> t_map_put({KeyType, t_any()}, AccType); false -> diff --git a/lib/dialyzer/src/erl_bif_types.erl b/lib/dialyzer/src/erl_bif_types.erl index eb795af0c995..27e6a8f4cd48 100644 --- a/lib/dialyzer/src/erl_bif_types.erl +++ b/lib/dialyzer/src/erl_bif_types.erl @@ -67,10 +67,10 @@ t_is_cons/2, t_is_float/2, t_is_fun/2, + t_is_impossible/1, t_is_integer/2, t_is_nil/1, t_is_nil/2, t_is_none/1, - t_is_none_or_unit/1, t_is_number/2, t_is_pid/2, t_is_port/2, @@ -1680,7 +1680,7 @@ list_replace(1, E, [_X | Xs]) -> [E | Xs]. any_is_none_or_unit(Ts) -> - lists:any(fun erl_types:t_is_none_or_unit/1, Ts). + lists:any(fun erl_types:t_is_impossible/1, Ts). check_guard([X], Test, Type, Opaques) -> check_guard_single(X, Test, Type, Opaques). @@ -2565,7 +2565,7 @@ check_fun_application(Fun, Args, Opaques) -> true -> case t_fun_args(Fun, Opaques) of unknown -> - case t_is_none_or_unit(t_fun_range(Fun, Opaques)) of + case t_is_impossible(t_fun_range(Fun, Opaques)) of true -> error; false -> ok end; @@ -2573,7 +2573,7 @@ check_fun_application(Fun, Args, Opaques) -> case any_is_none_or_unit(inf_lists(FunDom, Args, Opaques)) of true -> error; false -> - case t_is_none_or_unit(t_fun_range(Fun, Opaques)) of + case t_is_impossible(t_fun_range(Fun, Opaques)) of true -> error; false -> ok end diff --git a/lib/dialyzer/src/erl_types.erl b/lib/dialyzer/src/erl_types.erl index 6fe811148204..ed0264cc2fef 100644 --- a/lib/dialyzer/src/erl_types.erl +++ b/lib/dialyzer/src/erl_types.erl @@ -116,6 +116,7 @@ t_is_float/1, t_is_float/2, t_is_fun/1, t_is_fun/2, t_is_identifier/1, + t_is_impossible/1, t_is_instance/2, t_is_integer/1, t_is_integer/2, t_is_list/1, @@ -794,11 +795,15 @@ t_unit() -> t_is_unit(?unit) -> true; t_is_unit(_) -> false. +-spec t_is_impossible(erl_type()) -> boolean(). + +t_is_impossible(?none) -> true; +t_is_impossible(?unit) -> true; +t_is_impossible(_) -> false. + -spec t_is_none_or_unit(erl_type()) -> boolean(). -t_is_none_or_unit(?none) -> true; -t_is_none_or_unit(?unit) -> true; -t_is_none_or_unit(_) -> false. +t_is_none_or_unit(T) -> t_is_impossible(T). %%----------------------------------------------------------------------------- %% Atoms and the derived type boolean @@ -1679,7 +1684,7 @@ t_map(L) -> t_map(Pairs0, DefK0, DefV0) -> DefK1 = lists:foldl(fun({K,_,_},Acc)->t_subtract(Acc,K)end, DefK0, Pairs0), {DefK2, DefV1} = - case t_is_none_or_unit(DefK1) orelse t_is_none_or_unit(DefV0) of + case t_is_impossible(DefK1) orelse t_is_impossible(DefV0) of true -> {?none, ?none}; false -> {DefK1, DefV0} end, @@ -1940,7 +1945,7 @@ t_map_put(KV, Map, Opaques) -> map_put(_, ?none, _) -> ?none; map_put(_, ?unit, _) -> ?none; map_put({Key, Value}, ?map(Pairs,DefK,DefV), Opaques) -> - case t_is_none_or_unit(Key) orelse t_is_none_or_unit(Value) of + case t_is_impossible(Key) orelse t_is_impossible(Value) of true -> ?none; false -> case is_singleton_type(Key) of @@ -3994,7 +3999,7 @@ t_is_instance(ConcreteType, Type) -> -spec t_do_overlap(erl_type(), erl_type()) -> boolean(). t_do_overlap(TypeA, TypeB) -> - not (t_is_none_or_unit(t_inf(TypeA, TypeB))). + not (t_is_impossible(t_inf(TypeA, TypeB))). -spec t_unopaque(erl_type()) -> erl_type().