aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/src/compile.erl6
-rw-r--r--lib/compiler/src/sys_core_fold.erl102
-rw-r--r--lib/compiler/src/v3_core.erl22
-rw-r--r--lib/compiler/test/core_SUITE.erl5
-rw-r--r--lib/compiler/test/core_SUITE_data/eval_case.core34
5 files changed, 150 insertions, 19 deletions
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 5588f1fbe5..e79fe41f9b 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -626,7 +626,8 @@ core_passes() ->
{iff,dcorefold,{listing,"corefold"}},
{core_inline_module,fun test_core_inliner/1,fun core_inline_module/1},
{iff,dinline,{listing,"inline"}},
- {core_fold_after_inlining,fun test_core_inliner/1,fun core_fold_module_after_inlining/1},
+ {core_fold_after_inlining,fun test_any_inliner/1,
+ fun core_fold_module_after_inlining/1},
?pass(core_transforms)]},
{iff,dcopt,{listing,"copt"}},
{iff,'to_core',{done,"core"}}]}
@@ -1172,6 +1173,9 @@ test_core_inliner(#compile{options=Opts}) ->
end, Opts)
end.
+test_any_inliner(St) ->
+ test_old_inliner(St) orelse test_core_inliner(St).
+
core_old_inliner(#compile{code=Code0,options=Opts}=St) ->
{ok,Code} = sys_core_inline:module(Code0, Opts),
{ok,St#compile{code=Code}}.
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index e302e2324d..e2b9213891 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -353,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;
@@ -1940,7 +1945,9 @@ 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]
@@ -1955,7 +1962,7 @@ eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) ->
%%
%% let <X,Y> = <SomeSideEffect(),SomeSideEffect()> in ...
%%
- %% because SomeSideEffect() would be called evaluated twice.
+ %% because SomeSideEffect() would be evaluated twice.
%%
%% Instead we must evaluate the case expression in an outer let
%% like this:
@@ -1964,11 +1971,19 @@ eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) ->
%% let <X,Y> = <NewVar,NewVar> in ...
%%
Vs = make_vars([], length(Es)),
- {true,Bs} = cerl_clauses:match_list(Ps0, Vs),
- {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));
+ 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]}.
@@ -2596,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
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 291443f824..ec5deb6905 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -900,6 +900,7 @@ lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) ->
{Head,St2} = new_var(St1),
{Tname,St3} = new_var_name(St2),
LA = lineno_anno(Line, St3),
+ CGAnno = #a{anno=[list_comprehension|LA]},
LAnno = #a{anno=LA},
Tail = #c_var{anno=LA,name=Tname},
{Arg,St4} = new_var(St3),
@@ -937,7 +938,7 @@ lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) ->
body=Lps ++ [Lc]}|Cs0]
end,
Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc},
- {#iletrec{anno=LAnno,defs=[{{Name,1},Fun}],
+ {#iletrec{anno=CGAnno,defs=[{{Name,1},Fun}],
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,1}},
args=[Gc]}]},
@@ -947,6 +948,7 @@ lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) ->
{Name,St1} = new_fun_name("blc", St0),
LA = lineno_anno(Line, St1),
LAnno = #a{anno=LA},
+ CGAnno = #a{anno=[list_comprehension|LA]},
HeadBinPattern = pattern(P, St1),
#c_binary{segments=Ps0} = HeadBinPattern,
{Ps,Tail,St2} = append_tail_segment(Ps0, St1),
@@ -975,7 +977,7 @@ lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) ->
pats=[#c_binary{anno=LA,segments=TailSegList}],guard=[],
body=[Mc]}],
Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc},
- {#iletrec{anno=LAnno,defs=[{{Name,1},Fun}],
+ {#iletrec{anno=CGAnno,defs=[{{Name,1},Fun}],
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,1}},
args=[Gc]}]},
@@ -984,12 +986,13 @@ lc_tq(Line, E, [Fil0|Qs0], Mc, St0) ->
%% Special case sequences guard tests.
LA = lineno_anno(element(2, Fil0), St0),
LAnno = #a{anno=LA},
+ CGAnno = #a{anno=[list_comprehension|LA]},
case is_guard_test(Fil0) of
true ->
{Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Lc,Lps,St1} = lc_tq(Line, E, Qs1, Mc, St0),
{Gs,St2} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat!
- {#icase{anno=LAnno,
+ {#icase{anno=CGAnno,
args=[],
clauses=[#iclause{anno=LAnno,pats=[],
guard=Gs,body=Lps ++ [Lc]}],
@@ -1003,7 +1006,7 @@ lc_tq(Line, E, [Fil0|Qs0], Mc, St0) ->
c_tuple([#c_literal{val=case_clause},Fpat])),
%% Do a novars little optimisation here.
{Filc,Fps,St3} = novars(Fil0, St2),
- {#icase{anno=LAnno,
+ {#icase{anno=CGAnno,
args=[Filc],
clauses=[#iclause{anno=LAnno,
pats=[#c_literal{anno=LA,val=true}],
@@ -1047,6 +1050,7 @@ bc_tq1(Line, E, [{generate,Lg,P,G}|Qs0], AccExpr, St0) ->
LA = lineno_anno(Line, St1),
{[Head,Tail,AccVar],St2} = new_vars(LA, 3, St1),
LAnno = #a{anno=LA},
+ CGAnno = #a{anno=[list_comprehension|LA]},
{Arg,St3} = new_var(St2),
NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name},
{var,Lg,AccVar#c_var.name}]},
@@ -1080,7 +1084,7 @@ bc_tq1(Line, E, [{generate,Lg,P,G}|Qs0], AccExpr, St0) ->
body=Body}|Cs0]
end,
Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc},
- {#iletrec{anno=LAnno,defs=[{{Name,2},Fun}],
+ {#iletrec{anno=CGAnno,defs=[{{Name,2},Fun}],
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,2}},
args=[Gc,AccExpr]}]},
@@ -1091,6 +1095,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
LA = lineno_anno(Line, St1),
{AccVar,St2} = new_var(LA, St1),
LAnno = #a{anno=LA},
+ CGAnno = #a{anno=[list_comprehension|LA]},
HeadBinPattern = pattern(P, St2),
#c_binary{segments=Ps0} = HeadBinPattern,
{Ps,Tail,St3} = append_tail_segment(Ps0, St2),
@@ -1119,7 +1124,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
pats=[#c_binary{anno=LA,segments=TailSegList},AccVar],
guard=[],
body=[AccVar]}],
- Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc},
+ Fun = #ifun{anno=CGAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc},
{#iletrec{anno=LAnno,defs=[{{Name,2},Fun}],
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,2}},
@@ -1129,12 +1134,13 @@ bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) ->
%% Special case sequences guard tests.
LA = lineno_anno(element(2, Fil0), St0),
LAnno = #a{anno=LA},
+ CGAnno = #a{anno=[list_comprehension|LA]},
case is_guard_test(Fil0) of
true ->
{Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Bc,Bps,St1} = bc_tq1(Line, E, Qs1, AccVar, St0),
{Gs,St} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat!
- {#icase{anno=LAnno,
+ {#icase{anno=CGAnno,
args=[],
clauses=[#iclause{anno=LAnno,
pats=[],
@@ -1149,7 +1155,7 @@ bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) ->
c_tuple([#c_literal{val=case_clause},Fpat])),
%% Do a novars little optimisation here.
{Filc,Fps,St} = novars(Fil0, St2),
- {#icase{anno=LAnno,
+ {#icase{anno=CGAnno,
args=[Filc],
clauses=[#iclause{anno=LAnno,
pats=[#c_literal{anno=LA,val=true}],
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index 1a521c3591..aa222c48de 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -24,7 +24,7 @@
dehydrated_itracer/1,nested_tries/1,
seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1,
unsafe_case/1,nomatch_shadow/1,reversed_annos/1,
- map_core_test/1]).
+ map_core_test/1,eval_case/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -50,7 +50,7 @@ groups() ->
[{p,test_lib:parallel(),
[dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq,
eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos,
- map_core_test
+ map_core_test,eval_case
]}].
@@ -76,6 +76,7 @@ end_per_group(_GroupName, Config) ->
?comp(nomatch_shadow).
?comp(reversed_annos).
?comp(map_core_test).
+?comp(eval_case).
try_it(Mod, Conf) ->
Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)),
diff --git a/lib/compiler/test/core_SUITE_data/eval_case.core b/lib/compiler/test/core_SUITE_data/eval_case.core
new file mode 100644
index 0000000000..f2776e2b1f
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/eval_case.core
@@ -0,0 +1,34 @@
+module 'eval_case' ['eval_case'/0]
+ attributes []
+'eval_case'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ case apply 'do_case'/0() of
+ <'ok'> when 'true' ->
+ 'ok'
+ ( <_cor0> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor0})
+ -| ['compiler_generated'] )
+ end
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'eval_case',0}}] )
+ -| ['compiler_generated'] )
+ end
+'do_case'/0 =
+ fun () ->
+ case let <_cor0> =
+ apply 'id'/1(42)
+ in let <_cor1> =
+ call 'erlang':'+'
+ (_cor0, 7)
+ in {'x',_cor1} of
+ <{'x',49}> when 'true' ->
+ 'ok'
+ end
+'id'/1 =
+ fun (_cor0) -> _cor0
+end
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-10 10:53:37 +0000