compiler: Use type information to improve destructive update pass

Make use of type information when tracking initial values during the
destructive update pass. Using argument type annotations allows the
find-initial-values phase of the pass to stop exploring impossible
value chains which previously lead to infinite loops which in turn
made the pass abort.

lib/compiler/src/beam_ssa_destructive_update.erl

@@ -334,7 +334,7 @@ fiv_track_value_in_fun([{#b_var{}=V,Element}|Rest], Fun, Work0, Defs,
     ?DP("Tracking ~p of ~p in fun ~s~n", [Element, V, ff(Fun)]),
     ValuesInFun = ValuesInFun0#{{V,Element}=>visited},
     case Defs of
-        #{V:=#b_set{dst=V,op=Op,args=Args}} ->
+        #{V:=#b_set{dst=V,op=Op,args=Args,anno=Anno}} ->
             case {Op,Args,Element} of
                 {bs_create_bin,[#b_literal{val=append},_,Arg|_],
                  {self,init_writable}} ->
@@ -378,20 +378,74 @@ fiv_track_value_in_fun([{#b_var{}=V,Element}|Rest], Fun, Work0, Defs,
                     %% be able to safely rewrite an accumulator in the
                     %% tail field of the cons, thus we will never
                     %% have to track it.
-                    Depth = fiv_get_new_depth(Element),
-                    ?DP("value is created by a get_hd, adding ~p.~n",
-                        [{List,{hd,Element,Depth}}]),
-                    fiv_track_value_in_fun(
-                      [{List,{hd,Element,Depth}}|Rest], Fun, Work0,
-                      Defs, ValuesInFun, FivSt0);
+
+                    %% We know that there will be type information
+                    %% about the list as get_hd is never used
+                    %% unprotected without a guard (which will allow
+                    %% the type pass to deduce the type) or when
+                    %% existing type information allows the guard to
+                    %% be eliminated.
+                    #{arg_types:=#{0:=#t_cons{type=Type}}} = Anno,
+                    IsComp = fiv_elem_is_compatible(Element, Type),
+                    ?DP("~p is ~scompatible with ~p~n",
+                        [Element,
+                         case IsComp of true -> ""; false -> "not " end,
+                         Type]),
+                    case IsComp of
+                        true ->
+                            Depth = fiv_get_new_depth(Element),
+                            ?DP("value is created by a get_hd, adding ~p.~n",
+                                [{List,{hd,Element,Depth}}]),
+                            fiv_track_value_in_fun(
+                              [{List,{hd,Element,Depth}}|Rest], Fun, Work0,
+                              Defs, ValuesInFun, FivSt0);
+                        false ->
+                            ?DP("value type is not compatible with element.~n"),
+                            fiv_track_value_in_fun(
+                              Rest, Fun, Work0, Defs, ValuesInFun, FivSt0)
+                    end;
                 {get_tuple_element,[#b_var{}=Tuple,#b_literal{val=Idx}],_} ->
-                    Depth = fiv_get_new_depth(Element),
-                    ?DP("value is created by a get_tuple_element, adding ~p.~n",
-                        [{Tuple,{tuple_element,Idx,Element,Depth}}]),
-                    fiv_track_value_in_fun(
-                      [{Tuple,{tuple_element,Idx,Element,Depth}}|Rest],
-                      Fun, Work0,
-                      Defs, ValuesInFun, FivSt0);
+                    %% The type annotation is present following the
+                    %% same argument as for get_hd. We know that it
+                    %% must be either a #t_tuple{} or a #t_union{}
+                    %% containing tuples.
+                    #{arg_types:=#{0:=TupleType}} = Anno,
+                    ?DP("  tuple-type: ~p~n", [TupleType]),
+                    ?DP("  idx: ~p~n", [Idx]),
+                    ?DP("  element: ~p~n", [Element]),
+                    Type =
+                        case TupleType of
+                            #t_tuple{elements=Es} ->
+                                T = maps:get(Idx + 1, Es, any),
+                                ?DP(" type: ~p~n", [T]),
+                                T;
+                            #t_union{tuple_set=TS} ->
+                                ?DP(" tuple-set: ~p~n", [TS]),
+                                JointType =
+                                    fiv_get_effective_tuple_set_type(Idx, TS),
+                                ?DP(" joint-type: ~p~n", [JointType]),
+                                JointType
+                        end,
+                    IsComp = fiv_elem_is_compatible(Element, Type),
+                    ?DP("~p is ~scompatible with ~p~n",
+                        [Element,
+                         case IsComp of true -> ""; false -> "not " end,
+                         TupleType]),
+                    case IsComp of
+                        true ->
+                            Depth = fiv_get_new_depth(Element),
+                            ?DP("value is created by a get_tuple_element,"
+                                " adding ~p.~n",
+                                [{Tuple,{tuple_element,Idx,Element,Depth}}]),
+                            fiv_track_value_in_fun(
+                              [{Tuple,{tuple_element,Idx,Element,Depth}}|Rest],
+                              Fun, Work0,
+                              Defs, ValuesInFun, FivSt0);
+                        false ->
+                            ?DP("value type is not compatible with element.~n"),
+                            fiv_track_value_in_fun(
+                              Rest, Fun, Work0, Defs, ValuesInFun, FivSt0)
+                    end;
                 {phi,_,_} ->
                     ?DP("value is created by a phi~n"),
                     {ToExplore,FivSt} = fiv_handle_phi(Fun, V, Args,
@@ -702,6 +756,52 @@ fiv_get_new_depth({hd,_,D}) ->
 fiv_get_new_depth(_) ->
     0.
 
+fiv_elem_is_compatible({tuple_element,Idx,Element,_},
+                       #t_tuple{exact=true,elements=Types}) ->
+    %% There is no need to check if the index is within bounds as the
+    %% compiler will ensure that the size of the tuple, and that, in
+    %% turn, will ensure that there is type information.
+    fiv_elem_is_compatible(Element, maps:get(Idx + 1, Types, any));
+fiv_elem_is_compatible({tuple_element,_,_,_}=Element,
+                       #t_union{tuple_set=TS}) ->
+    fiv_elem_is_compatible_with_ts(Element, TS);
+fiv_elem_is_compatible({self,heap_tuple}, #t_tuple{}) ->
+    true;
+fiv_elem_is_compatible({self,heap_tuple}=Element, #t_union{tuple_set=TS}) ->
+    fiv_elem_is_compatible_with_ts(Element, TS);
+fiv_elem_is_compatible({self,heap_tuple}, any) ->
+    true;
+fiv_elem_is_compatible({self,heap_tuple}, _) ->
+    %% With a heap_tuple, anything which isn't t_union{}, #t_tuple{}
+    %% or any is not compatible.
+    false;
+fiv_elem_is_compatible({hd,Element,_}, #t_cons{type=T}) ->
+    fiv_elem_is_compatible(Element, T);
+fiv_elem_is_compatible({hd,Element,_}, #t_union{list=T}) ->
+    fiv_elem_is_compatible(Element, T);
+fiv_elem_is_compatible({hd,_,_}, _) ->
+    %% With a hd, anything which isn't t_list{}, t_cons{} or
+    %% #t_union{} is not compatible.
+    false;
+fiv_elem_is_compatible(_Element, _Type) ->
+    %% Conservatively consider anything which isn't explicitly flagged
+    %% as incompatible as compatible.
+    true.
+
+fiv_get_effective_tuple_set_type(TupleIdx, TS) ->
+    beam_types:join([maps:get(TupleIdx + 1, Es, any)
+                     || {_,#t_tuple{elements=Es}} <- TS]).
+
+%% Check if the element is compatible with a record_set()
+fiv_elem_is_compatible_with_ts(Element, #t_tuple{}=Type) ->
+    fiv_elem_is_compatible(Element, Type);
+fiv_elem_is_compatible_with_ts(Element, [{_,T}|Rest]) ->
+    fiv_elem_is_compatible(Element, T)
+        orelse fiv_elem_is_compatible_with_ts(Element, Rest);
+fiv_elem_is_compatible_with_ts(_Element, []) ->
+    %% The element was not compatible with any of the record sets.
+    false.
+
 patch_f(SSA0, Cnt0, Patches) ->
     patch_f(SSA0, Cnt0, Patches, [], []).
 

lib/compiler/test/beam_ssa_check_SUITE.erl

@@ -105,7 +105,9 @@ private_append_checks(Config) when is_list(Config) ->
 tuple_inplace_checks(Config) when is_list(Config) ->
     run_post_ssa_opt(tuple_inplace_checks, Config),
     run_post_ssa_opt(tuple_inplace_abort0, Config),
-    run_post_ssa_opt(tuple_inplace_abort1, Config).
+    run_post_ssa_opt(tuple_inplace_abort1, Config),
+    run_post_ssa_opt(tuple_inplace_abort2, Config),
+    run_post_ssa_opt(tuple_inplace_abort3, Config).
 
 ret_annotation_checks(Config) when is_list(Config) ->
     run_post_ssa_opt(ret_annotation, Config).

lib/compiler/test/beam_ssa_check_SUITE_data/alias.erl

@@ -819,8 +819,8 @@ aliasing_after_tuple_extract(N, Acc) ->
     aliasing_after_tuple_extract(N - 1, {<<X/bitstring, 1>>, Acc}).
 
 
-%% Check that both the pair (Acc) and the extracted element (X) are
-%% aliased.
+%% Check that the pair (Acc) is unique on entry but that its contents
+%% are alised.
 alias_after_pair_hd(N) ->
     alias_after_pair_hd(N, [<<>>|dummy]).
 
@@ -834,8 +834,8 @@ alias_after_pair_hd(N, Acc) ->
     [X|_] = Acc,
     alias_after_pair_hd(N - 1, [<<X/bitstring, 1>>|Acc]).
 
-%% Check that both the pair (Acc) and the extracted element (X) are
-%% aliased.
+%% Check that the pair (Acc) is unique on entry but that its contents
+%% are alised.
 alias_after_pair_tl(N) ->
     alias_after_pair_tl(N, [dummy|<<>>]).
 

lib/compiler/test/beam_ssa_check_SUITE_data/tuple_inplace_abort0.erl

@@ -31,6 +31,6 @@ f() ->
 g([A]) ->
     g(A);
 g(#rec{} = A) ->
-%ssa% xfail (_) when post_ssa_opt ->
+%ssa% (_) when post_ssa_opt ->
 %ssa% _ = update_record(inplace, 3, ...).
     A#rec{ a = a }.

lib/compiler/test/beam_ssa_check_SUITE_data/tuple_inplace_abort1.erl

@@ -29,7 +29,7 @@ f() ->
     g({#rec{}}).
 
 g({A}) ->
-%ssa% xfail (_) when post_ssa_opt ->
+%ssa% (_) when post_ssa_opt ->
 %ssa% _ = update_record(inplace, 3, ...).
     g(A);
 g(#rec{} = A) ->

lib/compiler/test/beam_ssa_check_SUITE_data/tuple_inplace_abort2.erl

@@ -0,0 +1,44 @@
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2024. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%%     http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Check that the compiler doesn't enter an infinite loop while trying
+%% to run the destructive update pass.
+%%
+-module(tuple_inplace_abort2).
+
+-export([f0/0,f1/0,f2/0]).
+
+-record(rec, {a, b = ext:ernal()}).
+
+f0() ->
+    g([#rec{}]).
+
+f1() ->
+    g({#rec{}}).
+
+f2() ->
+    g([[{#rec{}}]]).
+
+g([A]) ->
+    g(A);
+g({A}) ->
+    g(A);
+g(#rec{} = A) ->
+%ssa% (_) when post_ssa_opt ->
+%ssa% _ = update_record(reuse, 3, ...).
+    A#rec{ a = a }.

lib/compiler/test/beam_ssa_check_SUITE_data/tuple_inplace_abort3.erl

@@ -0,0 +1,49 @@
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2024. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%%     http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Check that the compiler doesn't enter an infinite loop while trying
+%% to run the destructive update pass.
+%%
+-module(tuple_inplace_abort3).
+
+-export([f0/0,f1/0,f2/0,f3/0]).
+
+-record(rec, {a, b = ext:ernal()}).
+
+f0() ->
+    g([#rec{}]).
+
+f1() ->
+    g({#rec{}}).
+
+f2() ->
+    g([[{#rec{}}]]).
+
+f3() ->
+    g([[[#rec{}]]]).
+
+g({A}) ->
+    g(A);
+g([[A]]) ->
+    g(A);
+g([A]) ->
+    g(A);
+g(#rec{} = A) ->
+%ssa% (_) when post_ssa_opt ->
+%ssa% _ = update_record(reuse, 3, ...).
+    A#rec{ a = a }.

lib/compiler/test/beam_ssa_check_SUITE_data/tuple_inplace_checks.erl

@@ -22,7 +22,7 @@
 
 -export([do0a/0, do0b/2, different_sizes/2, ambiguous_inits/1,
          update_record0/0, fc/0, track_update_record/1,
-         gh8124_a/0, gh8124_b/0]).
+         gh8124_a/0, gh8124_b/0, tuple_set_a/1, tuple_set_b/0]).
 
 -record(r, {a=0,b=0,c=0,tot=0}).
 -record(r1, {a}).
@@ -236,3 +236,30 @@ gh8124_b() ->
     [R] = gh8124_b_inner(),
     R#r{a = <<"value 2">>}.
 
+
+%% Example which provides a get_tuple_element instruction with a tuple
+%% typed as a tuple set.
+tuple_set_a(Something) ->
+    case ex:f() of
+	a ->
+	    {ok,
+	     {key_a, Something}};
+	b ->
+	    {error, {override_include}}
+    end.
+
+tuple_set_b() ->
+%ssa% () when post_ssa_opt ->
+%ssa% _ = update_record(inplace, 2, _, ...).
+    case tuple_set_a(ex:f()) of
+	{ok, A} ->
+	    case e:f() of
+		{} ->
+		    case A of
+			{key_a, _} ->
+			    setelement(1, A, aa)
+		    end
+	    end;
+	{error,_} ->
+	    bad
+    end.