beam_validator: Fix inference on singleton types in registers

lib/compiler/src/beam_validator.erl

@@ -2282,12 +2282,14 @@ infer_types(CompareOp, LHS, {Kind,_}=RHS, Vst) when Kind =:= x; Kind =:= y ->
 infer_types(CompareOp, LHS, RHS, #vst{current=#st{vs=Vs}}=Vst0) ->
     case Vs of
         #{ LHS := LEntry, RHS := REntry } ->
-            Vst = infer_types_1(LEntry, RHS, CompareOp, Vst0),
-            infer_types_1(REntry, LHS, CompareOp, Vst);
+            Vst = infer_types_1(LEntry, canonical_value(RHS, Vst0),
+                                CompareOp, Vst0),
+            infer_types_1(REntry, canonical_value(LHS, Vst),
+                          CompareOp, Vst);
         #{ LHS := LEntry } ->
-            infer_types_1(LEntry, RHS, CompareOp, Vst0);
+            infer_types_1(LEntry, canonical_value(RHS, Vst0), CompareOp, Vst0);
         #{ RHS := REntry } ->
-            infer_types_1(REntry, LHS, CompareOp, Vst0);
+            infer_types_1(REntry, canonical_value(LHS, Vst0), CompareOp, Vst0);
         #{} ->
             Vst0
     end.
@@ -2626,12 +2628,9 @@ update_ne_types_1(LHS, RHS, Vst0) ->
             %% If LHS has a specific value after subtraction we can infer types
             %% as if we've made an exact match, which is much stronger than
             %% ne_exact.
-            LType = get_term_type(LHS, Vst),
-            case beam_types:get_singleton_value(LType) of
-                {ok, Value} ->
-                    infer_types(eq_exact, LHS, value_to_literal(Value), Vst);
-                error ->
-                    Vst
+            case canonical_value(LHS, Vst) of
+                LHS -> Vst;
+                Value -> infer_types(eq_exact, LHS, Value, Vst)
             end;
         false ->
             Vst0
@@ -2761,6 +2760,18 @@ value_to_literal(F) when is_float(F) -> {float,F};
 value_to_literal(I) when is_integer(I) -> {integer,I};
 value_to_literal(Other) -> {literal,Other}.
 
+canonical_value(Val, Vst) ->
+    Type = get_term_type(Val, Vst),
+    case beam_types:is_singleton_type(Type) of
+        true ->
+            case beam_types:get_singleton_value(Type) of
+                {ok, Res} -> value_to_literal(Res);
+                error -> Val
+            end;
+        false ->
+            Val
+    end.
+
 %% These are just wrappers around their equivalents in beam_types, which
 %% handle the validator-specific #t_abstract{} type.
 %%

lib/compiler/test/beam_validator_SUITE.erl

@@ -42,7 +42,7 @@
          bs_saved_position_units/1,parent_container/1,
          container_performance/1,
          infer_relops/1,
-         not_equal_inference/1,bad_bin_unit/1]).
+         not_equal_inference/1,bad_bin_unit/1,singleton_inference/1]).
 
 -include_lib("common_test/include/ct.hrl").
 
@@ -78,7 +78,7 @@ groups() ->
        missing_return_type,will_succeed,
        bs_saved_position_units,parent_container,
        container_performance,infer_relops,
-       not_equal_inference,bad_bin_unit]}].
+       not_equal_inference,bad_bin_unit,singleton_inference]}].
 
 init_per_suite(Config) ->
     test_lib:recompile(?MODULE),
@@ -1100,5 +1100,19 @@ bad_bin_unit_2() ->
        #{X := _} <- ok
    ].
 
+%% GH-6962: Type inference with singleton types in registers was weaker than
+%% inference on their corresponding literals.
+singleton_inference(Config) ->
+    Mod = ?FUNCTION_NAME,
+
+    Data = proplists:get_value(data_dir, Config),
+    File = filename:join(Data, "singleton_inference.erl"),
+
+    {ok, Mod} = compile:file(File, [no_copt, no_bool_opt, no_ssa_opt]),
+
+    ok = Mod:test(),
+
+    ok.
+
 id(I) ->
     I.

lib/compiler/test/beam_validator_SUITE_data/singleton_inference.erl

@@ -0,0 +1,7 @@
+-module(singleton_inference).
+-export([test/0]).
+
+test() ->
+    {'EXIT',{{badmatch,true}, _}} =
+        catch [0 || (X = (true or (X = is_port(node()))))],
+    ok.