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.erl83
1 files changed, 57 insertions, 26 deletions
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index eb9c302334..b7422318b2 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -72,7 +72,7 @@
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2,
reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]).
--import(cerl, [ann_c_cons/3,ann_c_tuple/2]).
+-import(cerl, [ann_c_cons/3,ann_c_map/3,ann_c_tuple/2]).
-include("core_parse.hrl").
@@ -246,7 +246,7 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) ->
value ->
ann_c_tuple(Anno, Es)
end;
-expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) ->
+expr(#c_map{anno=Anno,arg=V0,es=Es0}=Map, Ctxt, Sub) ->
Es = pair_list(Es0, Ctxt, Sub),
case Ctxt of
effect ->
@@ -254,7 +254,7 @@ expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) ->
expr(make_effect_seq(Es, Sub), Ctxt, Sub);
value ->
V = expr(V0, Ctxt, Sub),
- Map#c_map{var=V,es=Es}
+ ann_c_map(Anno,V,Es)
end;
expr(#c_binary{segments=Ss}=Bin0, Ctxt, Sub) ->
%% Warn for useless building, but always build the binary
@@ -1378,6 +1378,7 @@ eval_is_record(Call, _, _, _, _) -> Call.
is_not_integer(#c_literal{val=Val}) when not is_integer(Val) -> true;
is_not_integer(#c_tuple{}) -> true;
is_not_integer(#c_cons{}) -> true;
+is_not_integer(#c_map{}) -> true;
is_not_integer(_) -> false.
%% is_not_tuple(Core) -> true | false.
@@ -1385,6 +1386,7 @@ is_not_integer(_) -> false.
is_not_tuple(#c_literal{val=Val}) when not is_tuple(Val) -> true;
is_not_tuple(#c_cons{}) -> true;
+is_not_tuple(#c_map{}) -> true;
is_not_tuple(_) -> false.
%% eval_setelement(Call, Pos, Tuple, NewVal) -> Core.
@@ -1810,9 +1812,14 @@ opt_bool_clauses([#c_clause{pats=[#c_literal{val=Lit}],
true ->
%% This clause will match.
C = C0#c_clause{body=opt_bool_case(B)},
- case Lit of
- false -> [C|opt_bool_clauses(Cs, SeenT, true)];
- true -> [C|opt_bool_clauses(Cs, true, SeenF)]
+ case {Lit,SeenT,SeenF} of
+ {false,_,false} ->
+ [C|opt_bool_clauses(Cs, SeenT, true)];
+ {true,false,_} ->
+ [C|opt_bool_clauses(Cs, true, SeenF)];
+ _ ->
+ add_warning(C, nomatch_shadow),
+ opt_bool_clauses(Cs, SeenT, SeenF)
end
end;
opt_bool_clauses([#c_clause{pats=Ps,guard=#c_literal{val=true}}=C|Cs], SeenT, SeenF) ->
@@ -2024,9 +2031,9 @@ case_opt(Arg, Cs0, Sub) ->
case_opt_args([A0|As0], Cs0, Sub, LitExpr, Acc) ->
case case_opt_arg(A0, Sub, Cs0, LitExpr) of
- error ->
+ {error,Cs1} ->
%% Nothing to be done. Move on to the next argument.
- Cs = [{Ps,C,[P|PsAcc],Bs} || {[P|Ps],C,PsAcc,Bs} <- Cs0],
+ Cs = [{Ps,C,[P|PsAcc],Bs} || {[P|Ps],C,PsAcc,Bs} <- Cs1],
case_opt_args(As0, Cs, Sub, LitExpr, [A0|Acc]);
{ok,As1,Cs} ->
%% The argument was either expanded (from tuple/list) or
@@ -2045,7 +2052,7 @@ case_opt_arg(E0, Sub, Cs, LitExpr) ->
E = maybe_replace_var(E0, Sub),
case cerl:is_data(E) of
false ->
- error;
+ {error,Cs};
true ->
case cerl:data_type(E) of
{atomic,_} ->
@@ -2095,35 +2102,44 @@ maybe_replace_var_1(E, #sub{t=Tdb}) ->
%% pattern matching is tricky, so we will give up in that case.
case_opt_lit(Lit, Cs0, LitExpr) ->
- try case_opt_lit_1(Cs0, Lit, LitExpr) of
+ Cs1 = case_opt_lit_1(Lit, Cs0, LitExpr),
+ try case_opt_lit_2(Lit, Cs1) of
Cs ->
{ok,[],Cs}
catch
throw:impossible ->
- error
+ {error,Cs1}
end.
-case_opt_lit_1([{[P|Ps],C,PsAcc,Bs0}|Cs], E, LitExpr) ->
+case_opt_lit_1(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) ->
+ case cerl_clauses:match(P, E) of
+ none ->
+ %% The pattern will not match the literal. Remove the clause.
+ %% Unless the entire case expression is a literal, also
+ %% emit a warning.
+ case LitExpr of
+ false -> add_warning(C, nomatch_clause_type);
+ true -> ok
+ end,
+ case_opt_lit_1(E, Cs, LitExpr);
+ _ ->
+ [Current|case_opt_lit_1(E, Cs, LitExpr)]
+ end;
+case_opt_lit_1(_, [], _) -> [].
+
+case_opt_lit_2(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) ->
+ %% Non-matching clauses have already been removed in case_opt_lit_1/3.
case cerl_clauses:match(P, E) of
- none ->
- %% The pattern will not match the literal. Remove the clause.
- %% Unless the entire case expression is a literal, also
- %% emit a warning.
- case LitExpr of
- false -> add_warning(C, nomatch_clause_type);
- true -> ok
- end,
- case_opt_lit_1(Cs, E, LitExpr);
{true,Bs} ->
%% The pattern matches the literal. Remove the pattern
%% and update the bindings.
- [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(Cs, E, LitExpr)];
+ [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_2(E, Cs)];
{false,_} ->
%% Binary literal and pattern. We are not sure whether
%% the pattern will match.
throw(impossible)
end;
-case_opt_lit_1([], _, _) -> [].
+case_opt_lit_2(_, []) -> [].
%% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses}
@@ -2346,16 +2362,31 @@ is_safe_bool_expr(Core, Sub) ->
is_safe_bool_expr_1(Core, Sub, gb_sets:empty()).
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=is_record},
- args=[_,_]},
- _Sub, _BoolVars) ->
+ name=#c_literal{val=is_record},
+ args=[A,#c_literal{val=Tag},#c_literal{val=Size}]},
+ Sub, _BoolVars) when is_atom(Tag), is_integer(Size) ->
+ is_safe_simple(A, Sub);
+is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_record}},
+ _Sub, _BoolVars) ->
%% The is_record/2 BIF is NOT allowed in guards.
+ %% The is_record/3 BIF where its second argument is not an atom or its third
+ %% is not an integer is NOT allowed in guards.
%%
%% NOTE: Calls like is_record(Expr, LiteralTag), where LiteralTag
%% is a literal atom referring to a defined record, have already
%% been rewritten to is_record(Expr, LiteralTag, TupleSize).
false;
is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_function},
+ args=[A,#c_literal{val=Arity}]},
+ Sub, _BoolVars) when is_integer(Arity), Arity >= 0 ->
+ is_safe_simple(A, Sub);
+is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=is_function}},
+ _Sub, _BoolVars) ->
+ false;
+is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang},
name=#c_literal{val=Name},args=Args},
Sub, BoolVars) ->
NumArgs = length(Args),