diff options
Diffstat (limited to 'lib/compiler/src/sys_core_fold.erl')
-rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 138 |
1 files changed, 127 insertions, 11 deletions
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 47042c2393..d848cd8f19 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2017. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. 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. @@ -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(_, []) -> []. |