dialyzer: Modify handling of singleton map key types

The test case loop.erl shows that there is a problem with certain
singleton key types. Here the internal representation toggles between
 #{a | b => ...} and #{a => ..., b => ...}

The choice is to turn #{a | b => ...} into #{a => ..., b => ...} early
(t_from_form()). The aim is to keep as much info as possible (in
pairs). However, including complex singleton keys (tuples, maps) in
this scheme is potentially too costly, and a bit complicated. So one
more choice is made: let atoms and number (and nothing else) be
singleton types, and let complex keys go into the default key.

7 files changed, 129 insertions, 19 deletions

diff --git a/lib/dialyzer/test/map_SUITE_data/results/loop b/lib/dialyzer/test/map_SUITE_data/results/loop
new file mode 100644
index 0000000000..2e956a5709
--- /dev/null
+++ b/lib/dialyzer/test/map_SUITE_data/results/loop
@@ -0,0 +1,4 @@
+
+loop.erl:63: The call loop:start_timer(#loop{state::'idle' | 'waiting',queues::#{'category1'=>#queue{limit::non_neg_integer(),buffer::[any()]}, 'category2'=>#queue{limit::non_neg_integer(),buffer::[any()]}},counters::#{'counter1':=10, 2:=10}}) does not have a term of type #loop{state::'idle' | 'waiting',timer::timer:tref(),queues::#{'category1'=>#queue{limit::non_neg_integer(),buffer::[any()]}, 'category2'=>#queue{limit::non_neg_integer(),buffer::[any()]}},counters::#{'counter1'=>non_neg_integer(), 2=>non_neg_integer()}} (with opaque subterms) as 1st argument
+loop.erl:67: Function wait/1 has no local return
+loop.erl:85: Record construction #loop{state::'idle' | 'waiting',timer::{'error',_} | {'ok',timer:tref()},queues::#{'category1'=>#queue{limit::non_neg_integer(),buffer::[any()]}, 'category2'=>#queue{limit::non_neg_integer(),buffer::[any()]}},counters::#{'counter1'=>non_neg_integer(), 2=>non_neg_integer()}} violates the declared type of field timer::'undefined' | timer:tref()
diff --git a/lib/dialyzer/test/map_SUITE_data/results/opaque_key b/lib/dialyzer/test/map_SUITE_data/results/opaque_key
index 2ae0e0c5c6..8d6379b5e0 100644
--- a/lib/dialyzer/test/map_SUITE_data/results/opaque_key
+++ b/lib/dialyzer/test/map_SUITE_data/results/opaque_key
@@ -1,4 +1,5 @@
 
+opaque_key_adt.erl:35: Invalid type specification for function opaque_key_adt:s2/0. The success typing is () -> #{3:='a'}
 opaque_key_adt.erl:41: Invalid type specification for function opaque_key_adt:s4/0. The success typing is () -> #{1:='a'}
 opaque_key_adt.erl:44: Invalid type specification for function opaque_key_adt:s5/0. The success typing is () -> #{2:=3}
 opaque_key_adt.erl:56: Invalid type specification for function opaque_key_adt:smt1/0. The success typing is () -> #{3:='a'}
diff --git a/lib/dialyzer/test/map_SUITE_data/src/loop.erl b/lib/dialyzer/test/map_SUITE_data/src/loop.erl
new file mode 100644
index 0000000000..c861052d9f
--- /dev/null
+++ b/lib/dialyzer/test/map_SUITE_data/src/loop.erl
@@ -0,0 +1,92 @@
+-module(loop).
+
+-export([timeout/2]).
+
+-export([idle/2, waiting/2]).
+
+-type request_category() :: category1 | category2.
+
+-type counter() :: counter1 | 2.
+
+-type counters() :: #{counter() => non_neg_integer()}.
+
+-record(queue, {limit  = 0  :: non_neg_integer(),
+                buffer = [] :: list()}).
+
+-type request_queues() :: #{request_category() => #queue{}}.
+
+-record(?MODULE,
+        {state    = idle                      :: idle | waiting,
+         timer    = undefined                 :: undefined | timer:tref(),
+         queues   = #{category1 => #queue{},
+                      category2 => #queue{}}  :: request_queues(),
+         counters = new_counters()            :: counters()}).
+-spec timeout(Ref, Timer :: timer:tref()) -> {noreply, Ref}.
+timeout(Ref, Timer) ->
+    handle_message(Ref, {timeout, Timer}).
+
+-type message() :: {reset, request_category()}
+                 | {timeout, timer:tref()}.
+
+-spec handle_message(Ref, Message :: message()) ->
+                            {reply, boolean(), Ref} | {noreply, Ref}.
+handle_message(Ref, Msg) ->
+    MV = #?MODULE{state = State} = get(mv),
+    case apply(?MODULE, State, [Msg, MV]) of
+        {reply, Result, NewMV} ->
+            put(mv, NewMV),
+            {reply, Result, Ref};
+        {noreply, NewMV} ->
+            put(mv, NewMV),
+            {noreply, Ref}
+    end.
+
+-spec idle(Message :: message(), #?MODULE{}) ->
+                  {reply, boolean(), #?MODULE{}} | {noreply, #?MODULE{}}.
+idle({reset, Category}, MV = #?MODULE{queues = Queues}) ->
+    case Queues of
+        #{Category := #queue{limit = 0}} ->
+            {reply, false, MV};
+        _ ->
+            wait(MV)
+    end;
+idle(_, MV) ->
+    {noreply, MV}.
+
+-spec waiting(Message :: message(), #?MODULE{}) ->
+                     {reply, boolean(), #?MODULE{}} | {noreply, #?MODULE{}}.
+waiting({reset, _Category}, MV = #?MODULE{}) ->
+    NewMV = stop_timer(MV),
+    {noreply, NewMV#?MODULE{state  = idle}};
+waiting({timeout, Timer}, #?MODULE{timer = Timer} = MV) ->
+    %% The opaque warning is an effect of the call to timer:send_after().
+    {noreply, start_timer(MV#?MODULE{timer    = undefined,
+                                     counters = new_counters()})}.
+
+-spec wait(#?MODULE{}) -> {noreply, #?MODULE{}}.
+wait(MV) ->
+    {noreply, start_timer(MV#?MODULE{state = waiting})}.
+
+-spec stop_timer(#?MODULE{}) -> #?MODULE{}.
+stop_timer(MV) ->
+    case MV#?MODULE.timer of
+        undefined ->
+            MV;
+        Timer ->
+            timer:cancel(Timer),
+            MV#?MODULE{timer = undefined}
+    end.
+
+-spec start_timer(MV :: #?MODULE{}) -> #?MODULE{}.
+start_timer(MV) ->
+    case MV#?MODULE.timer of
+        undefined ->
+            %% Note: timer:send_after() returns {ok, TRef} | {error, _}.
+            MV#?MODULE{timer = timer:send_after(1000, ?MODULE)};
+        _Timer ->
+            start_timer(stop_timer(MV))
+    end.
+
+-spec new_counters() -> counters().
+new_counters() ->
+    #{counter1 => 10, 2 => 10}.
diff --git a/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_adt.erl b/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_adt.erl
index b98c713c6b..9228cfa413 100644
--- a/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_adt.erl
+++ b/lib/dialyzer/test/map_SUITE_data/src/opaque_key/opaque_key_adt.erl
@@ -33,7 +33,7 @@ s0() -> #{}.
 s1() -> #{3 => a}.
 
 -spec s2() -> s(atom() | 3).
-s2() -> #{3 => a}. %% Contract breakage (not found)
+s2() -> #{3 => a}. %% Contract breakage
 
 -spec s3() -> s(atom() | 3).
 s3() -> #{3 => 5, a => 6, 7 => 8}.
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 0b9f0d5c3a..2627b08d7e 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -4655,7 +4655,8 @@ from_form({type, _L, map, List}, S, D0, L, C) ->
 	end
     end(List, L, C),
   try
-    {Pairs, DefK, DefV} = map_from_form(Pairs1, [], [], [], ?none, ?none),
+    Pairs2 = singleton_elements(Pairs1),
+    {Pairs, DefK, DefV} = map_from_form(Pairs2, [], [], [], ?none, ?none),
     {t_map(Pairs, DefK, DefV), L5, C5}
   catch none -> {t_none(), L5, C5}
   end;
@@ -4998,6 +4999,30 @@ list_from_form([H|Tail], S, D, L, C) ->
   {T1, L2, C2} = list_from_form(Tail, S, D, L1, C1),
   {[H1|T1], L2, C2}.
 
+%% Separates singleton types in keys (see is_singleton_type/1).
+singleton_elements([]) ->
+  [];
+singleton_elements([{K,?mand,V}=Pair|Pairs]) ->
+  case is_singleton_type(K) of
+    true ->
+      [Pair|singleton_elements(Pairs)];
+    false ->
+      singleton_elements([{K,?opt,V}|Pairs])
+  end;
+singleton_elements([{Key0,MNess,Val}|Pairs]) ->
+  [{Key,MNess,Val} || Key <- separate_key(Key0)] ++ singleton_elements(Pairs).
+
+%% To be in sync with is_singleton_type/1.
+%% Does not separate tuples and maps as doing that has potential
+%% to be very expensive.
+separate_key(?atom(Atoms)) when Atoms =/= ?any ->
+  [t_atom(A) || A <- Atoms];
+separate_key(?number(_, _) = T) ->
+  t_elements(T);
+separate_key(?union(List)) ->
+  lists:append([separate_key(K) || K <- List, not t_is_none(K)]);
+separate_key(Key) -> [Key].
+
 %% Sorts, combines non-singleton pairs, and applies precendence and
 %% mandatoriness rules.
 map_from_form([], ShdwPs, MKs, Pairs, DefK, DefV) ->
@@ -5447,7 +5472,8 @@ t_is_singleton(Type) ->
 t_is_singleton(Type, Opaques) ->
   do_opaque(Type, Opaques, fun is_singleton_type/1).
 
-%% Incomplete; not all representable singleton types are included.
+%% To be in sync with separate_key/1.
+%% Used to also recognize maps and tuples.
 is_singleton_type(?nil) -> true;
 is_singleton_type(?atom(?any)) -> false;
 is_singleton_type(?atom(Set)) ->
@@ -5455,13 +5481,6 @@ is_singleton_type(?atom(Set)) ->
 is_singleton_type(?int_range(V, V)) -> true;
 is_singleton_type(?int_set(Set)) ->
   ordsets:size(Set) =:= 1;
-is_singleton_type(?tuple(Types, Arity, _)) when is_integer(Arity) ->
-  lists:all(fun is_singleton_type/1, Types);
-is_singleton_type(?tuple_set([{Arity, [OnlyTuple]}])) when is_integer(Arity) ->
-  is_singleton_type(OnlyTuple);
-is_singleton_type(?map(Pairs, ?none, ?none)) ->
-  lists:all(fun({_,MNess,V}) -> MNess =:= ?mand andalso is_singleton_type(V)
-	    end, Pairs);
 is_singleton_type(_) ->
   false.
 
diff --git a/lib/hipe/test/opt_verify_SUITE.erl b/lib/hipe/test/opt_verify_SUITE.erl
index 86083fa02b..a323c10503 100644
--- a/lib/hipe/test/opt_verify_SUITE.erl
+++ b/lib/hipe/test/opt_verify_SUITE.erl
@@ -44,7 +44,7 @@ call_elim(Config) ->
     Icode5 = call_elim_test_file(Config, F3, icode_call_elim),
     0 = substring_count(binary:bin_to_list(Icode5), "is_key"),
     Icode6 = call_elim_test_file(Config, F3, no_icode_call_elim),
-    3 = substring_count(binary:bin_to_list(Icode6), "is_key"),
+    2 = substring_count(binary:bin_to_list(Icode6), "is_key"),
     ok.
 
 call_elim_test_file(Config, FileName, Option) ->
diff --git a/lib/hipe/test/opt_verify_SUITE_data/call_elim_test_branches_opt_poss.erl b/lib/hipe/test/opt_verify_SUITE_data/call_elim_test_branches_opt_poss.erl
index c8ddfa1e75..12875f41af 100644
--- a/lib/hipe/test/opt_verify_SUITE_data/call_elim_test_branches_opt_poss.erl
+++ b/lib/hipe/test/opt_verify_SUITE_data/call_elim_test_branches_opt_poss.erl
@@ -6,17 +6,11 @@ test(A) ->
     if A > 0 ->
 	    true = has_a_field(#{a=>true}),
 	    true = has_a_field(#{b=>1, a=>"2"}),
-	    true = has_a_field(#{a=>5, c=>4}),
-	    true = has_tuple_field(#{{ab, 1}=><<"qq">>, 1      =>0}),
-	    true = has_tuple_field(#{up     =>down,     {ab, 1}=>[]}),
-	    true = has_tuple_field(#{{ab, 1}=>42});
+	    true = has_a_field(#{a=>5, c=>4});
        A =< 0 ->
 	    true = has_a_field(#{a=>q,     'A'  =>nej}),
 	    true = has_a_field(#{a=>"hej", false=>true}),
-	    true = has_a_field(#{a=>3}),
-	    true = has_tuple_field(#{{ab, 1}=>q,     'A'  =>nej}),
-	    true = has_tuple_field(#{{ab, 1}=>"hej", false=>true}),
-	    true = has_tuple_field(#{{ab, 1}=>3})
+	    true = has_a_field(#{a=>3})
     end,
     true = has_nil_field(#{[]         =>3,  b =>"seven"}),
     true = has_nil_field(#{"seventeen"=>17, []=>nil}),