aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src/sys_core_fold.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src/sys_core_fold.erl')
-rw-r--r--lib/compiler/src/sys_core_fold.erl146
1 files changed, 135 insertions, 11 deletions
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 1cdbac5693..eb9c302334 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -305,6 +305,10 @@ expr(#c_let{}=Let, Ctxt, Sub) ->
%% Now recursively re-process the new expression.
expr(Expr, Ctxt, sub_new_preserve_types(Sub))
end;
+expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) ->
+ %% This is named fun in an 'effect' context. Warn and ignore.
+ add_warning(Letrec, useless_building),
+ void();
expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) ->
Fs1 = map(fun ({Name,Fb}) ->
{Name,expr(Fb, {letrec,Ctxt}, Sub)}
@@ -349,7 +353,12 @@ expr(#c_case{}=Case0, Ctxt, Sub) ->
Case = Case1#c_case{arg=Arg2,clauses=Cs2},
warn_no_clause_match(Case1, Case),
Expr = eval_case(Case, Sub),
- bsm_an(Expr);
+ case move_case_into_arg(Case, Sub) of
+ impossible ->
+ bsm_an(Expr);
+ Other ->
+ expr(Other, Ctxt, sub_new_preserve_types(Sub))
+ end;
Other ->
expr(Other, Ctxt, Sub)
end;
@@ -598,6 +607,14 @@ eval_binary_1([#c_bitstr{val=#c_literal{val=Val},size=#c_literal{val=Sz},
error:_ ->
throw(impossible)
end;
+eval_binary_1([#c_bitstr{val=#c_literal{},size=#c_literal{},
+ unit=#c_literal{},type=#c_literal{},
+ flags=#c_cons{}=Flags}=Bitstr|Ss], Acc0) ->
+ case cerl:fold_literal(Flags) of
+ #c_literal{} = Flags1 ->
+ eval_binary_1([Bitstr#c_bitstr{flags=Flags1}|Ss], Acc0);
+ _ -> throw(impossible)
+ end;
eval_binary_1([], Acc) -> Acc;
eval_binary_1(_, _) -> throw(impossible).
@@ -1536,9 +1553,17 @@ map_pair_pattern_list(Ps0, Isub, Osub0) ->
{Ps,{_,Osub}} = mapfoldl(fun map_pair_pattern/2, {Isub,Osub0}, Ps0),
{Ps,Osub}.
-map_pair_pattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair, {Isub,Osub0}) ->
- {K,Osub1} = pattern(K0, Isub, Osub0),
- {V,Osub} = pattern(V0, Isub, Osub1),
+map_pair_pattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,{Isub,Osub0}) ->
+ {K,Osub1} = case cerl:type(K0) of
+ binary ->
+ K1 = eval_binary(K0),
+ case cerl:type(K1) of
+ literal -> {K1,Osub0};
+ _ -> pattern(K0,Isub,Osub0)
+ end;
+ _ -> pattern(K0,Isub,Osub0)
+ end,
+ {V,Osub} = pattern(V0,Isub,Osub1),
{Pair#c_map_pair{key=K,val=V},{Isub,Osub}}.
bin_pattern_list(Ps0, Isub, Osub0) ->
@@ -1920,14 +1945,45 @@ opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=false}]}=Fc,Tc]) ->
%% last clause is guaranteed to match so if there is only one clause
%% with a pattern containing only variables then rewrite to a let.
-eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) ->
+eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,
+ guard=#c_literal{val=true},
+ body=B}]}=Case, Sub) ->
Es = case cerl:is_c_values(E) of
true -> cerl:values_es(E);
false -> [E]
end,
- {true,Bs} = cerl_clauses:match_list(Ps0, Es),
- {Ps,As} = unzip(Bs),
- expr(#c_let{vars=Ps,arg=core_lib:make_values(As),body=B}, sub_new(Sub));
+ %% Consider:
+ %%
+ %% case SomeSideEffect() of
+ %% X=Y -> ...
+ %% end
+ %%
+ %% We must not rewrite it to:
+ %%
+ %% let <X,Y> = <SomeSideEffect(),SomeSideEffect()> in ...
+ %%
+ %% because SomeSideEffect() would be evaluated twice.
+ %%
+ %% Instead we must evaluate the case expression in an outer let
+ %% like this:
+ %%
+ %% let NewVar = SomeSideEffect() in
+ %% let <X,Y> = <NewVar,NewVar> in ...
+ %%
+ Vs = make_vars([], length(Es)),
+ case cerl_clauses:match_list(Ps0, Vs) of
+ {false,_} ->
+ %% This can only happen if the Core Erlang code is
+ %% handwritten or generated by another code generator
+ %% than v3_core. Assuming that the Core Erlang program
+ %% is correct, the clause will always match at run-time.
+ Case;
+ {true,Bs} ->
+ {Ps,As} = unzip(Bs),
+ InnerLet = cerl:c_let(Ps, core_lib:make_values(As), B),
+ Let = cerl:c_let(Vs, E, InnerLet),
+ expr(Let, sub_new(Sub))
+ end;
eval_case(Case, _) -> Case.
%% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}.
@@ -2555,6 +2611,77 @@ opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) ->
value, Sub)
end.
+move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg,
+ body=InnerArg0}=Outer,
+ clauses=InnerClauses}=Inner, Sub) ->
+ %%
+ %% case let <OuterVars> = <OuterArg> in <InnerArg> of
+ %% <InnerClauses>
+ %% end
+ %%
+ %% ==>
+ %%
+ %% let <OuterVars> = <OuterArg>
+ %% in case <InnerArg> of <InnerClauses> end
+ %%
+ ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}),
+ {OuterVars,ScopeSub} = pattern_list(OuterVars0, ScopeSub0),
+ InnerArg = body(InnerArg0, ScopeSub),
+ Outer#c_let{vars=OuterVars,arg=OuterArg,
+ body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}};
+move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg,
+ clauses=[OuterCa0,OuterCb]}=Outer,
+ clauses=InnerClauses}=Inner0, Sub) ->
+ case is_failing_clause(OuterCb) of
+ true ->
+ #c_clause{pats=OuterPats0,guard=OuterGuard0,
+ body=InnerArg0} = OuterCa0,
+ %%
+ %% case case <OuterArg> of
+ %% <OuterPats> when <OuterGuard> -> <InnerArg>
+ %% <OuterCb>
+ %% ...
+ %% end of
+ %% <InnerClauses>
+ %% end
+ %%
+ %% ==>
+ %%
+ %% case <OuterArg> of
+ %% <OuterPats> when <OuterGuard> ->
+ %% case <InnerArg> of <InnerClauses> end
+ %% <OuterCb>
+ %% end
+ %%
+ ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}),
+ {OuterPats,ScopeSub} = pattern_list(OuterPats0, ScopeSub0),
+ OuterGuard = guard(OuterGuard0, ScopeSub),
+ InnerArg = body(InnerArg0, ScopeSub),
+ Inner = Inner0#c_case{arg=InnerArg,clauses=InnerClauses},
+ OuterCa = OuterCa0#c_clause{pats=OuterPats,guard=OuterGuard,
+ body=Inner},
+ Outer#c_case{arg=OuterArg,
+ clauses=[OuterCa,OuterCb]};
+ false ->
+ impossible
+ end;
+move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer,
+ clauses=InnerClauses}=Inner, _Sub) ->
+ %%
+ %% case do <OuterArg> <InnerArg> of
+ %% <InnerClauses>
+ %% end
+ %%
+ %% ==>
+ %%
+ %% do <OuterArg>
+ %% case <InnerArg> of <InerClauses> end
+ %%
+ Outer#c_seq{arg=OuterArg,
+ body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}};
+move_case_into_arg(_, _) ->
+ impossible.
+
%% In guards only, rewrite a case in a let argument like
%%
%% let <Var> = case <> of
@@ -3019,9 +3146,6 @@ format_error(result_ignored) ->
"(suppress the warning by assigning the expression to the _ variable)";
format_error(useless_building) ->
"a term is constructed, but never used";
-format_error({map_pair_key_overloaded,K}) ->
- M = io_lib:format("the key ~p is used multiple times in map value association",[K]),
- flatten(M);
format_error(bin_opt_alias) ->
"INFO: the '=' operator will prevent delayed sub binary optimization";
format_error(bin_partition) ->
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-10 12:57:00 +0000