diff options
Diffstat (limited to 'lib/compiler/src/sys_core_fold.erl')
-rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 300 |
1 files changed, 212 insertions, 88 deletions
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index d73060fb7e..bb3a9c7628 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -108,25 +108,36 @@ module(#c_module{defs=Ds0}=Mod, Opts) -> put(no_inline_list_funcs, not member(inline_list_funcs, Opts)), - case get(new_var_num) of - undefined -> put(new_var_num, 0); - _ -> ok - end, init_warnings(), Ds1 = [function_1(D) || D <- Ds0], + erase(new_var_num), erase(no_inline_list_funcs), {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 + %% 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), B = find_fixpoint(fun(Core) -> %% This must be a fun! expr(Core, value, sub_new()) end, B0, 20), {Name,B} catch - Class:Error -> - Stack = erlang:get_stacktrace(), + Class:Error:Stack -> io:fwrite("Function: ~w/~w\n", [F,Arity]), erlang:raise(Class, Error, Stack) end. @@ -146,14 +157,9 @@ find_fixpoint(OptFun, Core0, Max) -> body(Body, Sub) -> body(Body, value, Sub). -body(#c_values{anno=A,es=Es0}, Ctxt, Sub) -> - Es1 = expr_list(Es0, Ctxt, Sub), - case Ctxt of - value -> - #c_values{anno=A,es=Es1}; - effect -> - make_effect_seq(Es1, Sub) - end; +body(#c_values{anno=A,es=Es0}, value, Sub) -> + Es1 = expr_list(Es0, value, Sub), + #c_values{anno=A,es=Es1}; body(E, Ctxt, Sub) -> ?ASSERT(verify_scope(E, Sub)), expr(E, Ctxt, Sub). @@ -314,9 +320,15 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) -> false -> %% Arg cannot be "values" here - only a single value %% make sense here. - case is_safe_simple(Arg, Sub) of - true -> B1; - false -> Seq0#c_seq{arg=Arg,body=B1} + case {Ctxt,is_safe_simple(Arg, Sub)} of + {effect,true} -> B1; + {effect,false} -> + case is_safe_simple(B1, Sub) of + true -> Arg; + false -> Seq0#c_seq{arg=Arg,body=B1} + end; + {value,true} -> B1; + {value,false} -> Seq0#c_seq{arg=Arg,body=B1} end end; expr(#c_let{}=Let0, Ctxt, Sub) -> @@ -380,10 +392,7 @@ 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), - case move_case_into_arg(Case, Sub) of - impossible -> Expr; - Other -> Other - end; + move_case_into_arg(Expr, Sub); Other -> expr(Other, Ctxt, Sub) end; @@ -395,7 +404,7 @@ expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) -> expr(#c_apply{anno=Anno,op=Op0,args=As0}=App, _, Sub) -> Op1 = expr(Op0, value, Sub), As1 = expr_list(As0, value, Sub), - case cerl:is_data(Op1) of + case cerl:is_data(Op1) andalso not is_literal_fun(Op1) of false -> App#c_apply{op=Op1,args=As1}; true -> @@ -415,9 +424,20 @@ expr(#c_call{module=M0,name=N0}=Call0, Ctxt, Sub) -> no -> call(Call, M1, N1, Sub); {yes,Seq} -> expr(Seq, Ctxt, Sub) end; +expr(#c_primop{name=#c_literal{val=build_stacktrace}}, effect, _Sub) -> + void(); expr(#c_primop{args=As0}=Prim, _, Sub) -> As1 = expr_list(As0, value, Sub), Prim#c_primop{args=As1}; +expr(#c_catch{anno=Anno,body=B}, effect, Sub) -> + %% When the return value of the 'catch' is ignored, we can replace it + %% with a try/catch to avoid building a stack trace when an exception + %% occurs. + Var = #c_var{name='catch_value'}, + Evs = [#c_var{name='Class'},#c_var{name='Reason'},#c_var{name='Stk'}], + Try = #c_try{anno=Anno,arg=B,vars=[Var],body=Var, + evars=Evs,handler=void()}, + expr(Try, effect, Sub); expr(#c_catch{body=B0}=Catch, _, Sub) -> %% We can remove catch if the value is simple B1 = body(B0, value, Sub), @@ -479,6 +499,9 @@ bitstr_list(Es, Sub) -> bitstr(#c_bitstr{val=Val,size=Size}=BinSeg, Sub) -> BinSeg#c_bitstr{val=expr(Val, Sub),size=expr(Size, value, Sub)}. +is_literal_fun(#c_literal{val=F}) -> is_function(F); +is_literal_fun(_) -> false. + %% is_safe_simple(Expr, Sub) -> true | false. %% A safe simple cannot fail with badarg and is safe to use %% in a guard. @@ -2146,7 +2169,7 @@ make_var(A) -> make_var_name() -> N = get(new_var_num), put(new_var_num, N+1), - list_to_atom("@f"++integer_to_list(N)). + N. letify(Bs, Body) -> Ann = cerl:get_ann(Body), @@ -2422,16 +2445,10 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner, Outer#c_let{vars=OuterVs,arg=Arg, body=Inner#c_let{vars=InnerVs,arg=OuterBody,body=InnerBody}}; move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, - #c_case{arg=Cexpr0,clauses=[Ca0,Cb0|Cs]}=Case, Sub0) -> - %% Test if there are no more clauses than Ca0 and Cb0, or if - %% Cb0 is guaranteed to match. - TwoClauses = Cs =:= [] orelse - case Cb0 of - #c_clause{pats=[#c_var{}],guard=#c_literal{val=true}} -> true; - _ -> false - end, - case {TwoClauses,is_failing_clause(Ca0),is_failing_clause(Cb0)} of - {true,false,true} -> + #c_case{arg=Cexpr0,clauses=[Ca0|Cs0]}=Case, Sub0) -> + case not is_failing_clause(Ca0) andalso + are_all_failing_clauses(Cs0) of + true -> %% let <Lvars> = case <Case-expr> of %% <Cpats> -> <Clause-body>; %% <OtherCpats> -> erlang:error(...) @@ -2467,8 +2484,8 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, body=Lbody}, Ca = Ca0#c_clause{pats=CaPats,guard=G,body=B}, - Cb = clause(Cb0, Cexpr, value, Sub0), - Case#c_case{arg=Cexpr,clauses=[Ca,Cb]} + Cs = [clause(C, Cexpr, value, Sub0) || C <- Cs0], + Case#c_case{arg=Cexpr,clauses=[Ca|Cs]} catch nomatch -> %% This is not a defeat. The code will eventually @@ -2476,7 +2493,7 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, %% optimizations done in this module. impossible end; - {_,_,_} -> impossible + false -> impossible end; move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, #c_seq{arg=Sarg0,body=Sbody0}=Seq, Sub0) -> @@ -2499,9 +2516,78 @@ move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, body=Lbody}}; move_let_into_expr(_Let, _Expr, _Sub) -> impossible. +are_all_failing_clauses(Cs) -> + all(fun is_failing_clause/1, Cs). + is_failing_clause(#c_clause{body=B}) -> will_fail(B). +%% opt_build_stacktrace(Let) -> Core. +%% If the stacktrace is *only* used in a call to erlang:raise/3, +%% there is no need to build a cooked stackframe using build_stacktrace/1. + +opt_build_stacktrace(#c_let{vars=[#c_var{name=Cooked}], + arg=#c_primop{name=#c_literal{val=build_stacktrace}, + args=[RawStk]}, + body=Body}=Let) -> + case Body of + #c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=raise}, + args=[Class,Exp,#c_var{name=Cooked}]} -> + %% The stacktrace is only used in a call to erlang:raise/3. + %% There is no need to build the stacktrace. Replace the + %% call to erlang:raise/3 with the the raw_raise/3 instruction, + %% which will use a raw stacktrace. + #c_primop{name=#c_literal{val=raw_raise}, + args=[Class,Exp,RawStk]}; + #c_let{vars=[#c_var{name=V}],arg=Arg,body=B0} when V =/= Cooked -> + case core_lib:is_var_used(Cooked, Arg) of + false -> + %% The built stacktrace is not used in the argument, + %% so we can sink the building of the stacktrace into + %% the body of the let. + B = opt_build_stacktrace(Let#c_let{body=B0}), + Body#c_let{body=B}; + true -> + Let + end; + #c_seq{arg=Arg,body=B0} -> + case core_lib:is_var_used(Cooked, Arg) of + false -> + %% The built stacktrace is not used in the argument, + %% so we can sink the building of the stacktrace into + %% the body of the sequence. + B = opt_build_stacktrace(Let#c_let{body=B0}), + Body#c_seq{body=B}; + true -> + Let + end; + #c_case{arg=Arg,clauses=Cs0} -> + case core_lib:is_var_used(Cooked, Arg) orelse + is_used_in_any_guard(Cooked, Cs0) of + false -> + %% The built stacktrace is not used in the argument, + %% so we can sink the building of the stacktrace into + %% each arm of the case. + Cs = [begin + B = opt_build_stacktrace(Let#c_let{body=B0}), + C#c_clause{body=B} + end || #c_clause{body=B0}=C <- Cs0], + Body#c_case{clauses=Cs}; + true -> + Let + end; + _ -> + Let + end; +opt_build_stacktrace(Expr) -> + Expr. + +is_used_in_any_guard(V, Cs) -> + any(fun(#c_clause{guard=G}) -> + core_lib:is_var_used(V, G) + end, Cs). + %% opt_case_in_let(Let) -> Let' %% Try to avoid building tuples that are immediately matched. %% A common pattern is: @@ -2616,9 +2702,13 @@ delay_build_expr_1(#c_receive{clauses=Cs0, timeout=Timeout, action=A0}=Rec, TypeSig) -> Cs = delay_build_cs(Cs0, TypeSig), - A = case Timeout of - #c_literal{val=infinity} -> A0; - _ -> delay_build_expr(A0, TypeSig) + A = case {Timeout,A0} of + {#c_literal{val=infinity},#c_literal{}} -> + {_Type,Arity} = TypeSig, + Es = lists:duplicate(Arity, A0), + core_lib:make_values(Es); + _ -> + delay_build_expr(A0, TypeSig) end, Rec#c_receive{clauses=Cs,action=A}; delay_build_expr_1(#c_seq{body=B0}=Seq, TypeSig) -> @@ -2653,53 +2743,94 @@ opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) -> %% Optimise let and add new substitutions. {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), BodySub = update_let_types(Vs, Args, Sub1), + Sub = Sub1#sub{v=[],s=cerl_sets:new()}, B = body(B0, Ctxt, BodySub), Arg = core_lib:make_values(Args), - opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1). + opt_simple_let_2(Let, Vs, Arg, B, B0, Sub). + -opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> +%% opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> Core. +%% Do final simplifications of the let. +%% +%% Note that the substitutions and scope in Sub have been cleared +%% and should not be used. + +opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) -> case {Vs0,Arg0,Body} of - {[#c_var{name=N1}],Arg1,#c_var{name=N2}} -> - case N1 =:= N2 of - true -> - %% let <Var> = Arg in <Var> ==> Arg - Arg1; - false -> - %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar - Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody), - #c_seq{arg=Arg,body=Body} - end; + {[#c_var{name=V}],Arg1,#c_var{name=V}} -> + %% let <Var> = Arg in <Var> ==> Arg + Arg1; {[],#c_values{es=[]},_} -> %% No variables left. Body; - {Vs,Arg1,#c_literal{}} -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), - case Ctxt of - effect -> - %% Throw away the literal body. - Arg; - value -> - %% Since the variable is not used in the body, we - %% can rewrite the let to a sequence. - %% let <Var> = Arg in Literal ==> seq Arg Literal - #c_seq{arg=Arg,body=Body} - end; - {Vs,Arg1,Body} -> - %% If none of the variables are used in the body, we can - %% rewrite the let to a sequence: - %% let <Var> = Arg in BodyWithoutVar ==> - %% seq Arg BodyWithoutVar - case is_any_var_used(Vs, Body) of - false -> - Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), - #c_seq{arg=Arg,body=Body}; - true -> - Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body}, - opt_bool_case_in_let(Let1, Sub) + {[#c_var{name=V}=Var|Vars]=Vars0,Arg1,Body} -> + case core_lib:is_var_used(V, Body) of + false when Vars =:= [] -> + %% If the variable is not used in the body, we can + %% rewrite the let to a sequence: + %% let <Var> = Arg in BodyWithoutVar ==> + %% seq Arg BodyWithoutVar + Arg = maybe_suppress_warnings(Arg1, Var, PrevBody), + #c_seq{arg=Arg,body=Body}; + false -> + %% There are multiple values returned by the argument + %% and the first value is not used (this is a 'case' + %% with exported variables, but the return value is + %% ignored). We can remove the first variable and the + %% the first value returned from the 'let' argument. + Arg2 = remove_first_value(Arg1, Sub), + Let1 = Let0#c_let{vars=Vars,arg=Arg2,body=Body}, + post_opt_let(Let1, Sub); + true -> + Let1 = Let0#c_let{vars=Vars0,arg=Arg1,body=Body}, + post_opt_let(Let1, Sub) end end. -%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody) -> Arg' +%% post_opt_let(Let, Sub) +%% Final optimizations of the let. +%% +%% Note that the substitutions and scope in Sub have been cleared +%% and should not be used. + +post_opt_let(Let0, Sub) -> + Let1 = opt_bool_case_in_let(Let0, Sub), + opt_build_stacktrace(Let1). + + +%% remove_first_value(Core0, Sub) -> Core. +%% Core0 is an expression that returns at least two values. +%% Remove the first value returned from Core0. + +remove_first_value(#c_values{es=[V|Vs]}, Sub) -> + Values = core_lib:make_values(Vs), + case is_safe_simple(V, Sub) of + false -> + #c_seq{arg=V,body=Values}; + true -> + Values + end; +remove_first_value(#c_case{clauses=Cs0}=Core, Sub) -> + Cs = remove_first_value_cs(Cs0, Sub), + Core#c_case{clauses=Cs}; +remove_first_value(#c_receive{clauses=Cs0,action=Act0}=Core, Sub) -> + Cs = remove_first_value_cs(Cs0, Sub), + Act = remove_first_value(Act0, Sub), + Core#c_receive{clauses=Cs,action=Act}; +remove_first_value(#c_let{body=B}=Core, Sub) -> + Core#c_let{body=remove_first_value(B, Sub)}; +remove_first_value(#c_seq{body=B}=Core, Sub) -> + Core#c_seq{body=remove_first_value(B, Sub)}; +remove_first_value(#c_primop{}=Core, _Sub) -> + Core; +remove_first_value(#c_call{}=Core, _Sub) -> + Core. + +remove_first_value_cs(Cs, Sub) -> + [C#c_clause{body=remove_first_value(B, Sub)} || + #c_clause{body=B}=C <- Cs]. + +%% maybe_suppress_warnings(Arg, #c_var{}, PreviousBody) -> Arg' %% Try to suppress false warnings when a variable is not used. %% For instance, we don't expect a warning for useless building in: %% @@ -2710,12 +2841,12 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> %% referenced in the original unoptimized code. If they were, we will %% consider the warning false and suppress it. -maybe_suppress_warnings(Arg, Vs, PrevBody) -> +maybe_suppress_warnings(Arg, #c_var{name=V}, PrevBody) -> case should_suppress_warning(Arg) of true -> Arg; %Already suppressed. false -> - case is_any_var_used(Vs, PrevBody) of + case core_lib:is_var_used(V, PrevBody) of true -> suppress_warning([Arg]); false -> @@ -2804,7 +2935,7 @@ move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg, Outer#c_case{arg=OuterArg, clauses=[OuterCa,OuterCb]}; false -> - impossible + Inner0 end; move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, clauses=InnerClauses}=Inner, _Sub) -> @@ -2820,15 +2951,8 @@ move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, %% Outer#c_seq{arg=OuterArg, body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}}; -move_case_into_arg(_, _) -> - impossible. - -is_any_var_used([#c_var{name=V}|Vs], Expr) -> - case core_lib:is_var_used(V, Expr) of - false -> is_any_var_used(Vs, Expr); - true -> true - end; -is_any_var_used([], _) -> false. +move_case_into_arg(Expr, _) -> + Expr. %%% %%% Retrieving information about types. |