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.erl136
1 files changed, 126 insertions, 10 deletions
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index ceb7d56221..d848cd8f19 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -99,7 +99,7 @@
t=#{} :: map(), %Types
in_guard=false}). %In guard or not.
--type type_info() :: cerl:cerl() | 'bool' | 'integer'.
+-type type_info() :: cerl:cerl() | 'bool' | 'integer' | {'fun', pos_integer()}.
-type yes_no_maybe() :: 'yes' | 'no' | 'maybe'.
-type sub() :: #sub{}.
@@ -115,13 +115,6 @@ module(#c_module{defs=Ds0}=Mod, Opts) ->
{ok,Mod#c_module{defs=Ds1},get_warnings()}.
function_1({#c_var{name={F,Arity}}=Name,B0}) ->
- %% Find a suitable starting value for the variable counter. Note
- %% that this pass assumes that new_var_name/1 returns a variable
- %% name distinct from any variable used in the entire body of
- %% the function. We use integers as variable names to avoid
- %% filling up the atom table when compiling huge functions.
- Count = cerl_trees:next_free_variable_name(B0),
- put(new_var_num, Count),
try
%% Find a suitable starting value for the variable
%% counter. Note that this pass assumes that new_var_name/1
@@ -352,7 +345,12 @@ expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) ->
void();
expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) ->
Fs1 = map(fun ({Name,Fb}) ->
- {Name,expr(Fb, {letrec,Ctxt}, Sub)}
+ case Ctxt =:= effect andalso is_fun_effect_safe(Name, B0) of
+ true ->
+ {Name,expr(Fb, {letrec, effect}, Sub)};
+ false ->
+ {Name,expr(Fb, {letrec, value}, Sub)}
+ end
end, Fs0),
B1 = body(B0, Ctxt, Sub),
Letrec#c_letrec{defs=Fs1,body=B1};
@@ -480,9 +478,101 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0)
false ->
{Evs1,Sub2} = var_list(Evs0, Sub0),
H1 = body(H0, value, Sub2),
- Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H1}
+ H2 = opt_try_handler(H1, lists:last(Evs1)),
+ Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H2}
end.
+%% Attempts to convert old erlang:get_stacktrace/0 calls into the new
+%% three-argument catch, with possibility of further optimisations.
+opt_try_handler(#c_call{anno=A,module=#c_literal{val=erlang},name=#c_literal{val=get_stacktrace},args=[]}, Var) ->
+ #c_primop{anno=A,name=#c_literal{val=build_stacktrace},args=[Var]};
+opt_try_handler(#c_case{clauses=Cs0} = Case, Var) ->
+ Cs = [C#c_clause{body=opt_try_handler(B, Var)} || #c_clause{body=B} = C <- Cs0],
+ Case#c_case{clauses=Cs};
+opt_try_handler(#c_let{arg=Arg} = Let, Var) ->
+ Let#c_let{arg=opt_try_handler(Arg, Var)};
+opt_try_handler(X, _) -> X.
+
+%% If a fun or its application is used as an argument, then it's unsafe to
+%% handle it in effect context as the side-effects may rely on its return
+%% value. The following is a minimal example of where it can go wrong:
+%%
+%% do letrec 'f'/0 = fun () -> ... whatever ...
+%% in call 'side':'effect'(apply 'f'/0())
+%% 'ok'
+%%
+%% This function returns 'true' if Body definitely does not rely on a
+%% value produced by FVar, or 'false' if Body depends on or might depend on
+%% a value produced by FVar.
+
+is_fun_effect_safe(#c_var{}=FVar, Body) ->
+ ifes_1(FVar, Body, true).
+
+ifes_1(FVar, #c_alias{pat=Pat}, _Safe) ->
+ ifes_1(FVar, Pat, false);
+ifes_1(FVar, #c_apply{op=Op,args=Args}, Safe) ->
+ %% FVar(...) is safe as long its return value is ignored, but it's never
+ %% okay to pass FVar as an argument.
+ ifes_list(FVar, Args, false) andalso ifes_1(FVar, Op, Safe);
+ifes_1(FVar, #c_binary{segments=Segments}, _Safe) ->
+ ifes_list(FVar, Segments, false);
+ifes_1(FVar, #c_bitstr{val=Val,size=Size,unit=Unit}, _Safe) ->
+ ifes_list(FVar, [Val, Size, Unit], false);
+ifes_1(FVar, #c_call{args=Args}, _Safe) ->
+ ifes_list(FVar, Args, false);
+ifes_1(FVar, #c_case{arg=Arg,clauses=Clauses}, Safe) ->
+ ifes_1(FVar, Arg, false) andalso ifes_list(FVar, Clauses, Safe);
+ifes_1(FVar, #c_catch{body=Body}, _Safe) ->
+ ifes_1(FVar, Body, false);
+ifes_1(FVar, #c_clause{pats=Pats,guard=Guard,body=Body}, Safe) ->
+ ifes_list(FVar, Pats, false) andalso
+ ifes_1(FVar, Guard, false) andalso
+ ifes_1(FVar, Body, Safe);
+ifes_1(FVar, #c_cons{hd=Hd,tl=Tl}, _Safe) ->
+ ifes_1(FVar, Hd, false) andalso ifes_1(FVar, Tl, false);
+ifes_1(FVar, #c_fun{body=Body}, _Safe) ->
+ ifes_1(FVar, Body, false);
+ifes_1(FVar, #c_let{arg=Arg,body=Body}, Safe) ->
+ ifes_1(FVar, Arg, false) andalso ifes_1(FVar, Body, Safe);
+ifes_1(FVar, #c_letrec{defs=Defs,body=Body}, Safe) ->
+ Funs = [Fun || {_,Fun} <- Defs],
+ ifes_list(FVar, Funs, false) andalso ifes_1(FVar, Body, Safe);
+ifes_1(_FVar, #c_literal{}, _Safe) ->
+ true;
+ifes_1(FVar, #c_map{arg=Arg,es=Elements}, _Safe) ->
+ ifes_1(FVar, Arg, false) andalso ifes_list(FVar, Elements, false);
+ifes_1(FVar, #c_map_pair{key=Key,val=Val}, _Safe) ->
+ ifes_1(FVar, Key, false) andalso ifes_1(FVar, Val, false);
+ifes_1(FVar, #c_primop{args=Args}, _Safe) ->
+ ifes_list(FVar, Args, false);
+ifes_1(FVar, #c_receive{timeout=Timeout,action=Action,clauses=Clauses}, Safe) ->
+ ifes_1(FVar, Timeout, false) andalso
+ ifes_1(FVar, Action, Safe) andalso
+ ifes_list(FVar, Clauses, Safe);
+ifes_1(FVar, #c_seq{arg=Arg,body=Body}, Safe) ->
+ %% Arg of a #c_seq{} has no effect so it's okay to use FVar there even if
+ %% Safe=false.
+ ifes_1(FVar, Arg, true) andalso ifes_1(FVar, Body, Safe);
+ifes_1(FVar, #c_try{arg=Arg,handler=Handler,body=Body}, Safe) ->
+ ifes_1(FVar, Arg, false) andalso
+ ifes_1(FVar, Handler, Safe) andalso
+ ifes_1(FVar, Body, Safe);
+ifes_1(FVar, #c_tuple{es=Elements}, _Safe) ->
+ ifes_list(FVar, Elements, false);
+ifes_1(FVar, #c_values{es=Elements}, _Safe) ->
+ ifes_list(FVar, Elements, false);
+ifes_1(#c_var{name=Name}, #c_var{name=Name}, Safe) ->
+ %% It's safe to return FVar if it's unused.
+ Safe;
+ifes_1(_FVar, #c_var{}, _Safe) ->
+ true.
+
+ifes_list(FVar, [E|Es], Safe) ->
+ ifes_1(FVar, E, Safe) andalso ifes_list(FVar, Es, Safe);
+ifes_list(_FVar, [], _Safe) ->
+ true.
+
+
expr_list(Es, Ctxt, Sub) ->
[expr(E, Ctxt, Sub) || E <- Es].
@@ -883,6 +973,10 @@ fold_non_lit_args(Call, erlang, setelement, [Arg1,Arg2,Arg3], _) ->
eval_setelement(Call, Arg1, Arg2, Arg3);
fold_non_lit_args(Call, erlang, is_record, [Arg1,Arg2,Arg3], Sub) ->
eval_is_record(Call, Arg1, Arg2, Arg3, Sub);
+fold_non_lit_args(Call, erlang, is_function, [Arg1], Sub) ->
+ eval_is_function_1(Call, Arg1, Sub);
+fold_non_lit_args(Call, erlang, is_function, [Arg1,Arg2], Sub) ->
+ eval_is_function_2(Call, Arg1, Arg2, Sub);
fold_non_lit_args(Call, erlang, N, Args, Sub) ->
NumArgs = length(Args),
case erl_internal:comp_op(N, NumArgs) of
@@ -898,6 +992,22 @@ fold_non_lit_args(Call, erlang, N, Args, Sub) ->
end;
fold_non_lit_args(Call, _, _, _, _) -> Call.
+eval_is_function_1(Call, Arg1, Sub) ->
+ case get_type(Arg1, Sub) of
+ none -> Call;
+ {'fun',_} -> #c_literal{anno=cerl:get_ann(Call),val=true};
+ _ -> #c_literal{anno=cerl:get_ann(Call),val=false}
+ end.
+
+eval_is_function_2(Call, Arg1, #c_literal{val=Arity}, Sub)
+ when is_integer(Arity), Arity > 0 ->
+ case get_type(Arg1, Sub) of
+ none -> Call;
+ {'fun',Arity} -> #c_literal{anno=cerl:get_ann(Call),val=true};
+ _ -> #c_literal{anno=cerl:get_ann(Call),val=false}
+ end;
+eval_is_function_2(Call, _Arg1, _Arg2, _Sub) -> Call.
+
%% Evaluate a relational operation using type information.
eval_rel_op(Call, Op, [#c_var{name=V},#c_var{name=V}], _) ->
Bool = erlang:Op(same, same),
@@ -3105,6 +3215,10 @@ update_types_2(V, [#c_tuple{}=P], Types) ->
Types#{V=>P};
update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) ->
Types#{V=>bool};
+update_types_2(V, [#c_fun{vars=Vars}], Types) ->
+ Types#{V=>{'fun',length(Vars)}};
+update_types_2(V, [#c_var{name={_,Arity}}], Types) ->
+ Types#{V=>{'fun',Arity}};
update_types_2(V, [Type], Types) when is_atom(Type) ->
Types#{V=>Type};
update_types_2(_, _, Types) -> Types.
@@ -3123,6 +3237,8 @@ kill_types2(V, [{_,#c_tuple{}=Tuple}=Entry|Tdb]) ->
false -> [Entry|kill_types2(V, Tdb)];
true -> kill_types2(V, Tdb)
end;
+kill_types2(V, [{_, {'fun',_}}=Entry|Tdb]) ->
+ [Entry|kill_types2(V, Tdb)];
kill_types2(V, [{_,Atom}=Entry|Tdb]) when is_atom(Atom) ->
[Entry|kill_types2(V, Tdb)];
kill_types2(_, []) -> [].
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-15 05:55:16 +0000