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.erl159
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.