diff options
Diffstat (limited to 'lib/compiler/src/sys_core_fold.erl')
-rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 159 |
1 files changed, 88 insertions, 71 deletions
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 08b02101a6..006bb56bf4 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -83,10 +83,11 @@ -ifdef(DEBUG). -define(ASSERT(E), case E of - true -> ok; + true -> + ok; false -> io:format("~p, line ~p: assertion failed\n", [?MODULE,?LINE]), - exit(assertion_failed) + error(assertion_failed) end). -else. -define(ASSERT(E), ignore). @@ -120,7 +121,10 @@ module(#c_module{defs=Ds0}=Mod, Opts) -> function_1({#c_var{name={F,Arity}}=Name,B0}) -> try - B = expr(B0, value, sub_new()), %This must be a fun! + B = find_fixpoint(fun(Core) -> + %% This must be a fun! + expr(Core, value, sub_new()) + end, B0, 20), {Name,B} catch Class:Error -> @@ -129,6 +133,14 @@ function_1({#c_var{name={F,Arity}}=Name,B0}) -> erlang:raise(Class, Error, Stack) end. +find_fixpoint(_OptFun, Core, 0) -> + Core; +find_fixpoint(OptFun, Core0, Max) -> + case OptFun(Core0) of + Core0 -> Core0; + Core -> find_fixpoint(OptFun, Core, Max-1) + end. + %% body(Expr, Sub) -> Expr. %% body(Expr, Context, Sub) -> Expr. %% No special handling of anything except values. @@ -239,7 +251,7 @@ expr(#c_cons{anno=Anno,hd=H0,tl=T0}=Cons, Ctxt, Sub) -> case Ctxt of effect -> add_warning(Cons, useless_building), - expr(make_effect_seq([H1,T1], Sub), Ctxt, Sub); + make_effect_seq([H1,T1], Sub); value -> ann_c_cons(Anno, H1, T1) end; @@ -248,7 +260,7 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) -> case Ctxt of effect -> add_warning(Tuple, useless_building), - expr(make_effect_seq(Es, Sub), Ctxt, Sub); + make_effect_seq(Es, Sub); value -> ann_c_tuple(Anno, Es) end; @@ -257,7 +269,7 @@ expr(#c_map{anno=Anno,arg=V0,es=Es0}=Map, Ctxt, Sub) -> case Ctxt of effect -> add_warning(Map, useless_building), - expr(make_effect_seq(Es, Sub), Ctxt, Sub); + make_effect_seq(Es, Sub); value -> V = expr(V0, Ctxt, Sub), ann_c_map(Anno,V,Es) @@ -310,7 +322,7 @@ expr(#c_let{}=Let0, Ctxt, Sub) -> Expr -> %% The let body was successfully moved into the let argument. %% Now recursively re-process the new expression. - expr(Expr, Ctxt, sub_new_preserve_types(Sub)) + Expr end; expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) -> %% This is named fun in an 'effect' context. Warn and ignore. @@ -364,7 +376,7 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> impossible -> bsm_an(Expr); Other -> - expr(Other, Ctxt, sub_new_preserve_types(Sub)) + Other end; Other -> expr(Other, Ctxt, Sub) @@ -1397,9 +1409,6 @@ sub_new() -> #sub{v=orddict:new(),s=cerl_sets:new(),t=#{}}. sub_new(#sub{}=Sub) -> Sub#sub{v=orddict:new(),t=#{}}. -sub_new_preserve_types(#sub{}=Sub) -> - Sub#sub{v=orddict:new()}. - sub_get_var(#c_var{name=V}=Var, #sub{v=S}) -> case orddict:find(V, S) of {ok,Val} -> Val; @@ -2017,10 +2026,10 @@ case_opt_lit_1(_, []) -> []. %% the clauses where it is actually needed. case_opt_data(E, Cs0) -> - Es = cerl:data_es(E), TypeSig = {cerl:data_type(E),cerl:data_arity(E)}, - try case_opt_data_1(Cs0, Es, TypeSig) of + try case_opt_data_1(Cs0, TypeSig) of Cs -> + Es = cerl:data_es(E), {ok,Es,Cs} catch throw:impossible -> @@ -2028,44 +2037,47 @@ case_opt_data(E, Cs0) -> {error,Cs0} end. -case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) -> +case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], TypeSig) -> P = case_opt_compiler_generated(P0), - BindTo = #c_var{name=dummy}, - {Ps1,[{BindTo,_}|Bs1]} = case_data_pat_alias(P, BindTo, TypeSig, []), - [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|case_opt_data_1(Cs, Es, TypeSig)]; -case_opt_data_1([], _, _) -> []. + {Ps1,Bs} = case_opt_data_2(P, TypeSig, Bs0), + [{Ps1++Ps0,C,PsAcc,Bs}|case_opt_data_1(Cs, TypeSig)]; +case_opt_data_1([], _) -> []. -case_data_pat_alias(P, BindTo0, TypeSig, Bs0) -> - case cerl:type(P) of - alias -> - %% Recursively handle the pattern and bind to - %% the alias variable. - BindTo = cerl:alias_var(P), - Apat0 = cerl:alias_pat(P), - Ann = [compiler_generated], - Apat = cerl:set_ann(Apat0, Ann), - {Ps,Bs} = case_data_pat_alias(Apat, BindTo, TypeSig, Bs0), - {Ps,[{BindTo0,BindTo}|Bs]}; - var -> - %% Here we will need to actually build the data and bind - %% it to the variable. +case_opt_data_2(P, TypeSig, Bs0) -> + case case_analyze_pat(P) of + {[],Pat} when Pat =/= none -> + DataEs = cerl:data_es(P), + {DataEs,Bs0}; + {[V|Vs],none} -> {Type,Arity} = TypeSig, Ann = [compiler_generated], Vars = make_vars(Ann, Arity), Data = cerl:ann_make_data(Ann, Type, Vars), - Bs = [{BindTo0,P},{P,Data}|Bs0], + Bs = [{V,Data} | [{Var,V} || Var <- Vs] ++ Bs0], {Vars,Bs}; - _ -> - %% Since case_opt_nomatch/3 has removed all clauses that - %% cannot match, we KNOW that this clause must match and - %% that the pattern must be a data constructor. - %% Here we must build the data and bind it to the variable. + {[V|Vs],Pat} when Pat =/= none -> {Type,_} = TypeSig, - DataEs = cerl:data_es(P), + DataEs = cerl:data_es(Pat), Vars = pat_to_expr_list(DataEs), Ann = [compiler_generated], Data = cerl:ann_make_data(Ann, Type, Vars), - {DataEs,[{BindTo0,Data}]} + Bs = [{V,Data} | [{Var,V} || Var <- Vs] ++ Bs0], + {DataEs,Bs} + end. + +case_analyze_pat(P) -> + case_analyze_pat_1(P, [], none). + +case_analyze_pat_1(P, Vs, Pat) -> + case cerl:type(P) of + alias -> + V = cerl:alias_var(P), + Apat = cerl:alias_pat(P), + case_analyze_pat_1(Apat, [V|Vs], Pat); + var -> + {[P|Vs],Pat}; + _ -> + {Vs,P} end. %% pat_to_expr(Pattern) -> Expression. @@ -2109,7 +2121,7 @@ make_var(A) -> make_var_name() -> N = get(new_var_num), put(new_var_num, N+1), - list_to_atom("fol"++integer_to_list(N)). + list_to_atom("@f"++integer_to_list(N)). letify(Bs, Body) -> Ann = cerl:get_ann(Body), @@ -2216,24 +2228,24 @@ inverse_rel_op('=<') -> '>'; inverse_rel_op(_) -> no. -%% opt_bool_case_in_let(LetExpr, Sub) -> Core +%% opt_bool_case_in_let(LetExpr) -> Core -opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> - opt_case_in_let_1(Vs, Arg, B, Let, Sub). +opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) -> + opt_bool_case_in_let_1(Vs, Arg, B, Let). -opt_case_in_let_1([#c_var{name=V}], Arg, - #c_case{arg=#c_var{name=V}}=Case0, Let, Sub) -> +opt_bool_case_in_let_1([#c_var{name=V}], Arg, + #c_case{arg=#c_var{name=V}}=Case0, Let) -> case is_simple_case_arg(Arg) of true -> Case = opt_bool_case(Case0#c_case{arg=Arg}), case core_lib:is_var_used(V, Case) of - false -> expr(Case, sub_new(Sub)); + false -> Case; true -> Let end; false -> Let end; -opt_case_in_let_1(_, _, _, Let, _) -> Let. +opt_bool_case_in_let_1(_, _, _, Let) -> Let. %% is_simple_case_arg(Expr) -> true|false %% Determine whether the Expr is simple enough to be worth @@ -2641,25 +2653,23 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> false -> %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody), - expr(#c_seq{arg=Arg,body=Body}, Ctxt, - sub_new_preserve_types(Sub)) + #c_seq{arg=Arg,body=Body} end; {[],#c_values{es=[]},_} -> %% No variables left. Body; {Vs,Arg1,#c_literal{}} -> Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), - E = 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, - expr(E, Ctxt, sub_new_preserve_types(Sub)); + 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: @@ -2668,11 +2678,10 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> case is_any_var_used(Vs, Body) of false -> Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody), - expr(#c_seq{arg=Arg,body=Body}, Ctxt, - sub_new_preserve_types(Sub)); + #c_seq{arg=Arg,body=Body}; true -> Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body}, - Let2 = opt_bool_case_in_let(Let1, Sub), + Let2 = opt_bool_case_in_let(Let1), opt_case_in_let_arg(Let2, Ctxt, Sub) end end. @@ -2830,16 +2839,16 @@ opt_case_in_let_arg(#c_let{arg=#c_case{}=Case}=Let, Ctxt, opt_case_in_let_arg(Let, _, _) -> Let. opt_case_in_let_arg_1(Let0, #c_case{arg=#c_values{es=[]}, - clauses=Cs}=Case0, Ctxt, Sub) -> + clauses=Cs}=Case0, _Ctxt, _Sub) -> Let = mark_compiler_generated(Let0), case Cs of [#c_clause{body=#c_literal{}=BodyA}=Ca0, #c_clause{body=#c_literal{}=BodyB}=Cb0] -> Ca = Ca0#c_clause{body=Let#c_let{arg=BodyA}}, Cb = Cb0#c_clause{body=Let#c_let{arg=BodyB}}, - Case = Case0#c_case{clauses=[Ca,Cb]}, - expr(Case, Ctxt, sub_new_preserve_types(Sub)); - _ -> Let + Case0#c_case{clauses=[Ca,Cb]}; + _ -> + Let end; opt_case_in_let_arg_1(Let, _, _, _) -> Let. @@ -2950,7 +2959,9 @@ returns_integer(bit_size, [_]) -> true; returns_integer('bsl', [_,_]) -> true; returns_integer('bsr', [_,_]) -> true; returns_integer(byte_size, [_]) -> true; +returns_integer(ceil, [_]) -> true; returns_integer('div', [_,_]) -> true; +returns_integer(floor, [_]) -> true; returns_integer(length, [_]) -> true; returns_integer('rem', [_,_]) -> true; returns_integer('round', [_]) -> true; @@ -3440,12 +3451,18 @@ format_error(bin_var_used_in_guard) -> verify_scope(E, #sub{s=Scope}) -> Free0 = cerl_trees:free_variables(E), Free = [V || V <- Free0, not is_tuple(V)], %Ignore function names. - case ordsets:is_subset(Free, cerl_sets:to_list(Scope)) of - true -> true; + case is_subset_of_scope(Free, Scope) of + true -> + true; false -> io:format("~p\n", [E]), io:format("~p\n", [Free]), - io:format("~p\n", [cerl_sets:to_list(Scope)]), + io:format("~p\n", [ordsets:from_list(cerl_sets:to_list(Scope))]), false end. + +is_subset_of_scope([V|Vs], Scope) -> + cerl_sets:is_element(V, Scope) andalso is_subset_of_scope(Vs, Scope); +is_subset_of_scope([], _) -> true. + -endif. |