diff options
Diffstat (limited to 'lib/compiler/src/sys_core_fold.erl')
| -rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 202 |
1 files changed, 58 insertions, 144 deletions
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index fb23fd7d63..024b2d5f2a 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -93,6 +93,9 @@ -define(ASSERT(E), ignore). -endif. +-define(MAX_FUNC_ARGS, 255). +-define(IS_FUNC_ARITY(A), is_integer(A) andalso 0 =< A andalso A =< ?MAX_FUNC_ARGS). + %% Variable value info. -record(sub, {v=[], %Variable substitutions s=sets:new([{version, 2}]) :: sets:set(), %Variables in scope @@ -269,17 +272,8 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) -> end; expr(#c_let{}=Let0, Ctxt, Sub) -> Let = opt_case_in_let(Let0), - case simplify_let(Let, Sub) of - impossible -> - %% The argument for the let is "simple", i.e. has no - %% complex structures such as let or seq that can be entered. - ?ASSERT(verify_scope(Let, Sub)), - opt_fun_call(opt_simple_let(Let, Ctxt, Sub)); - Expr -> - %% The let body was successfully moved into the let argument. - %% Now recursively re-process the new expression. - Expr - end; + ?ASSERT(verify_scope(Let, Sub)), + opt_fun_call(opt_let(Let, Ctxt, Sub)); expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) -> %% This is named fun in an 'effect' context. Warn and ignore. add_warning(Letrec, {ignored,useless_building}), @@ -409,7 +403,9 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0) {Evs1,Sub2} = var_list(Evs0, Sub0), H1 = body(H0, value, Sub2), Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H1} - end. + end; +expr(#c_opaque{}=O, effect, _Sub) -> + O. %% 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 @@ -802,8 +798,6 @@ fold_apply(Apply, _, _) -> Apply. call(#c_call{args=As0}=Call0, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) -> As1 = expr_list(As0, value, Sub), case simplify_call(Call0, M, N, As1) of - #c_literal{}=Lit -> - Lit; #c_call{args=As}=Call -> case get(no_inline_list_funcs) of true -> @@ -813,7 +807,11 @@ call(#c_call{args=As0}=Call0, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) - none -> fold_call(Call, M0, N0, As, Sub); Core -> expr(Core, Sub) end - end + end; + #c_let{}=Let -> + Let; + #c_literal{}=Lit -> + Lit end; call(#c_call{args=As0}=Call, M, N, Sub) -> As = expr_list(As0, value, Sub), @@ -823,6 +821,33 @@ call(#c_call{args=As0}=Call, M, N, Sub) -> %% slightly at the cost of making tracing and stack traces incorrect. simplify_call(Call, maps, get, [Key, Map]) -> rewrite_call(Call, erlang, map_get, [Key, Map]); +simplify_call(#c_call{anno=Anno0}, maps, get, [Key0, Map, Default]) -> + Anno = [compiler_generated | Anno0], + + Key = make_var(Anno), + Value = make_var(Anno), + Fail = make_var(Anno), + Raise = #c_primop{name=#c_literal{val=match_fail}, + args=[#c_tuple{es=[#c_literal{val=badmap}, + Fail]}]}, + + Cs = [#c_clause{anno=Anno, + pats=[#c_map{es=[#c_map_pair{op=#c_literal{val=exact}, + key=Key, + val=Value}], + is_pat=true}], + guard=#c_literal{val=true}, + body=Value}, + #c_clause{anno=Anno, + pats=[#c_map{es=[],is_pat=true}], + guard=#c_literal{val=true}, + body=Default}, + #c_clause{anno=Anno, + pats=[Fail], + guard=#c_literal{val=true}, + body=Raise}], + + cerl:ann_c_let(Anno, [Key], Key0, #c_case{anno=Anno,arg=Map,clauses=Cs}); simplify_call(Call, maps, is_key, [Key, Map]) -> rewrite_call(Call, erlang, is_map_key, [Key, Map]); simplify_call(_Call, maps, new, []) -> @@ -1864,6 +1889,7 @@ case_opt_data_2(P, TypeSig, Bs0) -> {[V|Vs],none} -> {Type,Arity} = TypeSig, Ann = [compiler_generated], + true = ?IS_FUNC_ARITY(Arity), Vars = make_vars(Ann, Arity), Data = cerl:ann_make_data(Ann, Type, Vars), Bs = [{V,Data} | [{Var,V} || Var <- Vs] ++ Bs0], @@ -1921,7 +1947,7 @@ pat_to_expr(P) -> pat_to_expr_list(Ps) -> [pat_to_expr(P) || P <- Ps]. -make_vars(A, Max) -> +make_vars(A, Max) when ?IS_FUNC_ARITY(Max) -> make_vars(A, 1, Max). make_vars(A, I, Max) when I =< Max -> @@ -2183,112 +2209,6 @@ simplify_fun_call(V, Values, #c_fun{vars=Vars,body=FunBody}, CallArgs) -> throw(impossible) end. -%% simplify_let(Let, Sub) -> Expr | impossible -%% If the argument part of an let contains a complex expression, such -%% as a let or a sequence, move the original let body into the complex -%% expression. - -simplify_let(#c_let{arg=Arg}=Let, Sub) -> - move_let_into_expr(Let, Arg, Sub). - -move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner, - #c_let{vars=OuterVs0,arg=Arg0,body=OuterBody0}=Outer, Sub0) -> - %% - %% let <InnerVars> = let <OuterVars> = <Arg> - %% in <OuterBody> - %% in <InnerBody> - %% - %% ==> - %% - %% let <OuterVars> = <Arg> - %% in let <InnerVars> = <OuterBody> - %% in <InnerBody> - %% - Arg = body(Arg0, Sub0), - ScopeSub0 = sub_subst_scope(Sub0#sub{t=#{}}), - {OuterVs,ScopeSub} = var_list(OuterVs0, ScopeSub0), - - OuterBody = body(OuterBody0, ScopeSub), - - {InnerVs,Sub} = var_list(InnerVs0, Sub0), - InnerBody = body(InnerBody0, Sub), - 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|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(...) - %% end - %% in <Let-body> - %% - %% ==> - %% - %% case <Case-expr> of - %% <Cpats> -> - %% let <Lvars> = <Clause-body> - %% in <Let-body>; - %% <OtherCpats> -> erlang:error(...) - %% end - - Cexpr = body(Cexpr0, Sub0), - CaPats0 = Ca0#c_clause.pats, - G0 = Ca0#c_clause.guard, - B0 = Ca0#c_clause.body, - ScopeSub0 = sub_subst_scope(Sub0#sub{t=#{}}), - try pattern_list(CaPats0, ScopeSub0) of - {CaPats,ScopeSub} -> - G = guard(G0, ScopeSub), - - B1 = body(B0, ScopeSub), - - {Lvs,B2,Sub1} = let_substs(Lvs0, B1, Sub0), - Sub2 = Sub1#sub{s=sets:union(ScopeSub#sub.s, - Sub1#sub.s)}, - Lbody = body(Lbody0, Sub2), - B = Let#c_let{vars=Lvs, - arg=core_lib:make_values(B2), - body=Lbody}, - - Ca = Ca0#c_clause{pats=CaPats,guard=G,body=B}, - 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 - %% be optimized to erlang:error(...) by the other - %% optimizations done in this module. - impossible - end; - false -> impossible - end; -move_let_into_expr(#c_let{vars=Lvs0,body=Lbody0}=Let, - #c_seq{arg=Sarg0,body=Sbody0}=Seq, Sub0) -> - %% - %% let <Lvars> = do <Seq-arg> - %% <Seq-body> - %% in <Let-body> - %% - %% ==> - %% - %% do <Seq-arg> - %% let <Lvars> = <Seq-body> - %% in <Let-body> - %% - Sarg = body(Sarg0, Sub0), - Sbody1 = body(Sbody0, Sub0), - {Lvs,Sbody,Sub} = let_substs(Lvs0, Sbody1, Sub0), - Lbody = body(Lbody0, Sub), - Seq#c_seq{arg=Sarg,body=Let#c_let{vars=Lvs,arg=core_lib:make_values(Sbody), - 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). @@ -2441,6 +2361,7 @@ delay_build_1(Core0, TypeSig) -> Core -> {Type,Arity} = TypeSig, Ann = [compiler_generated], + true = ?IS_FUNC_ARITY(Arity), Vars = make_vars(Ann, Arity), Data = cerl:ann_make_data(Ann, Type, Vars), {yes,Vars,Core,Data} @@ -2483,42 +2404,41 @@ delay_build_expr_1(Core, _TypeSig) -> false -> throw(impossible) end. -%% opt_simple_let(#c_let{}, Context, Sub) -> CoreTerm -%% Optimize a let construct that does not contain any lets in -%% in its argument. +%% opt_let(#c_let{}, Context, Sub) -> CoreTerm +%% Optimize a let construct. -opt_simple_let(Let0, Ctxt, Sub) -> +opt_let(Let0, Ctxt, Sub) -> case opt_not_in_let(Let0) of #c_let{}=Let -> - opt_simple_let_0(Let, Ctxt, Sub); + opt_let_0(Let, Ctxt, Sub); Expr -> expr(Expr, Ctxt, Sub) end. -opt_simple_let_0(#c_let{arg=Arg0}=Let, Ctxt, Sub) -> +opt_let_0(#c_let{arg=Arg0}=Let, Ctxt, Sub) -> Arg = body(Arg0, value, Sub), %This is a body case will_fail(Arg) of true -> Arg; - false -> opt_simple_let_1(Let, Arg, Ctxt, Sub) + false -> opt_let_1(Let, Arg, Ctxt, Sub) end. -opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) -> +opt_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=sets:new([{version, 2}])}, B = body(B0, Ctxt, BodySub), Arg = core_lib:make_values(Args), - opt_simple_let_2(Let, Vs, Arg, B, B0, Sub). + opt_let_2(Let, Vs, Arg, B, B0, Sub). -%% opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> Core. +%% opt_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) -> +opt_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) -> case {Vs0,Arg0,Body} of {[#c_var{name=V}],Arg1,#c_var{name=V}} -> %% let <Var> = Arg in <Var> ==> Arg @@ -2704,17 +2624,11 @@ update_types(_, _, Sub) -> Sub. %% Kill any entries that references the variable, %% either in the key or in the value. -kill_types(V, Tdb) -> - maps:from_list(kill_types2(V,maps:to_list(Tdb))). - -kill_types2(V, [{V,_}|Tdb]) -> - kill_types2(V, Tdb); -kill_types2(V, [{_,#c_tuple{}=Tuple}=Entry|Tdb]) -> - case core_lib:is_var_used(V, Tuple) of - false -> [Entry|kill_types2(V, Tdb)]; - true -> kill_types2(V, Tdb) - end; -kill_types2(_, []) -> []. +kill_types(Var, Tdb) -> + #{Key => Value || + Key := Value <- Tdb, + Key =/= Var, + not core_lib:is_var_used(Var, Value)}. %% copy_type(DestVar, SrcVar, Tdb) -> Tdb' %% If the SrcVar has a type, assign it to DestVar. |