diff options
Diffstat (limited to 'lib/compiler/src')
| -rw-r--r-- | lib/compiler/src/beam_except.erl | 6 | ||||
| -rw-r--r-- | lib/compiler/src/beam_ssa_opt.erl | 1 | ||||
| -rw-r--r-- | lib/compiler/src/beam_ssa_type.erl | 80 | ||||
| -rw-r--r-- | lib/compiler/src/beam_validator.erl | 60 | ||||
| -rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 153 |
5 files changed, 164 insertions, 136 deletions
diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index 09925b2872..28c89782c9 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -225,7 +225,11 @@ moves_from_stack(nil, I, Acc) -> {reverse(Acc),I}; moves_from_stack({literal,[H|T]}, I, Acc) -> Cons = {cons,tag_literal(H),tag_literal(T)}, - moves_from_stack(Cons, I, Acc). + moves_from_stack(Cons, I, Acc); +moves_from_stack(_, _, _) -> + %% Not understood. Give up. + {[],-1}. + get_reg(R, Regs) -> case Regs of diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index f8e19d0aa7..6e548dd529 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -849,6 +849,7 @@ cse_expr(#b_set{op=Op,args=Args}=I) -> cse_suitable(#b_set{op=get_hd}) -> true; cse_suitable(#b_set{op=get_tl}) -> true; cse_suitable(#b_set{op=put_list}) -> true; +cse_suitable(#b_set{op=get_tuple_element}) -> true; cse_suitable(#b_set{op=put_tuple}) -> true; cse_suitable(#b_set{op={bif,tuple_size}}) -> %% Doing CSE for tuple_size/1 can prevent the diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index 5fbb679c6f..aa4720d222 100644 --- a/lib/compiler/src/beam_ssa_type.erl +++ b/lib/compiler/src/beam_ssa_type.erl @@ -24,7 +24,7 @@ -include("beam_ssa_opt.hrl"). -import(lists, [all/2,any/2,droplast/1,foldl/3,last/1,member/2, keyfind/3,partition/2,reverse/1,reverse/2, - seq/2,sort/1]). + seq/2,sort/1,split/2]). -define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). @@ -358,6 +358,17 @@ simplify_call(I) -> I. %% Simplify a remote call to a pure BIF. simplify_remote_call(erlang, '++', [#b_literal{val=[]},Tl], _I) -> Tl; +simplify_remote_call(erlang, setelement, + [#b_literal{val=Pos}, + #b_literal{val=Tuple}, + #b_var{}=Value], I) + when is_integer(Pos), 1 =< Pos, Pos =< tuple_size(Tuple) -> + %% Position is a literal integer and the shape of the + %% tuple is known. + Els0 = [#b_literal{val=El} || El <- tuple_to_list(Tuple)], + {Bef,[_|Aft]} = split(Pos - 1, Els0), + Els = Bef ++ [Value|Aft], + I#b_set{op=put_tuple,args=Els}; simplify_remote_call(Mod, Name, Args0, I) -> case make_literal_list(Args0) of none -> @@ -873,6 +884,9 @@ type(call, [#b_remote{mod=#b_literal{val=Mod}, end; {erlang,'--',[_,_]} -> list; + {lists,F,Args} -> + Types = get_types(Args, Ts), + lists_function_type(F, Types); {math,_,_} -> case is_math_bif(Name, length(Args)) of false -> any; @@ -964,6 +978,70 @@ arith_op_type(Args, Ts) -> (_, _) -> none end, unknown, Types). +lists_function_type(F, Types) -> + case {F,Types} of + %% Functions that return booleans. + {all,[_,_]} -> + t_boolean(); + {any,[_,_]} -> + t_boolean(); + {keymember,[_,_,_]} -> + t_boolean(); + {member,[_,_]} -> + t_boolean(); + {prefix,[_,_]} -> + t_boolean(); + {suffix,[_,_]} -> + t_boolean(); + + %% Functions that return lists. + {dropwhile,[_,_]} -> + list; + {duplicate,[_,_]} -> + list; + {filter,[_,_]} -> + list; + {flatten,[_]} -> + list; + {map,[_Fun,List]} -> + same_length_type(List); + {MapFold,[_Fun,_Acc,List]} when MapFold =:= mapfoldl; + MapFold =:= mapfoldr -> + #t_tuple{size=2,exact=true, + elements=#{1=>same_length_type(List)}}; + {partition,[_,_]} -> + t_two_tuple(list, list); + {reverse,[List]} -> + same_length_type(List); + {sort,[List]} -> + same_length_type(List); + {splitwith,[_,_]} -> + t_two_tuple(list, list); + {takewhile,[_,_]} -> + list; + {unzip,[List]} -> + ListType = same_length_type(List), + t_two_tuple(ListType, ListType); + {usort,[List]} -> + same_length_type(List); + {zip,[_,_]} -> + list; + {zipwith,[_,_,_]} -> + list; + {_,_} -> + any + end. + +%% For a lists function that return a list of the same +%% length as the input list, return the type of the list. +same_length_type(cons) -> cons; +same_length_type(nil) -> nil; +same_length_type(_) -> list. + +t_two_tuple(Type1, Type2) -> + #t_tuple{size=2,exact=true, + elements=#{1=>Type1,2=>Type2}}. + %% will_succeed(TestOperation, Type) -> yes|no|maybe. %% Test whether TestOperation applied to an argument of type Type %% will succeed. Return yes, no, or maybe. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 8ca90870c4..5175be3ad5 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -2502,6 +2502,8 @@ call_return_type_1(erlang, '--', 2, _Vst) -> list; call_return_type_1(erlang, F, A, _) -> erlang_mod_return_type(F, A); +call_return_type_1(lists, F, A, Vst) -> + lists_mod_return_type(F, A, Vst); call_return_type_1(math, F, A, _) -> math_mod_return_type(F, A); call_return_type_1(M, F, A, _) when is_atom(M), is_atom(F), is_integer(A), A >= 0 -> @@ -2540,6 +2542,64 @@ math_mod_return_type(fmod, 2) -> {float,[]}; math_mod_return_type(pi, 0) -> {float,[]}; math_mod_return_type(F, A) when is_atom(F), is_integer(A), A >= 0 -> term. +lists_mod_return_type(dropwhile, 2, _Vst) -> + list; +lists_mod_return_type(duplicate, 2, _Vst) -> + list; +lists_mod_return_type(filter, 2, _Vst) -> + list; +lists_mod_return_type(flatten, 2, _Vst) -> + list; +lists_mod_return_type(map, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(MF, 3, Vst) when MF =:= mapfoldl; MF =:= mapfoldr -> + ListType = same_length_type({x,2}, Vst), + {tuple,2,#{1=>ListType}}; +lists_mod_return_type(partition, 2, _Vst) -> + two_tuple(list, list); +lists_mod_return_type(reverse, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(seq, 2, _Vst) -> + list; +lists_mod_return_type(seq, 3, _Vst) -> + list; +lists_mod_return_type(sort, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(sort, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(splitwith, 2, _Vst) -> + two_tuple(list, list); +lists_mod_return_type(takewhile, 2, _Vst) -> + list; +lists_mod_return_type(unzip, 1, Vst) -> + ListType = same_length_type({x,0}, Vst), + two_tuple(ListType, ListType); +lists_mod_return_type(usort, 1, Vst) -> + same_length_type({x,0}, Vst); +lists_mod_return_type(usort, 2, Vst) -> + same_length_type({x,1}, Vst); +lists_mod_return_type(zip, 2, _Vst) -> + list; +lists_mod_return_type(zip3, 3, _Vst) -> + list; +lists_mod_return_type(zipwith, 3, _Vst) -> + list; +lists_mod_return_type(zipwith3, 4, _Vst) -> + list; +lists_mod_return_type(_, _, _) -> + term. + +two_tuple(Type1, Type2) -> + {tuple,2,#{1=>Type1,2=>Type2}}. + +same_length_type(Reg, Vst) -> + case get_term_type(Reg, Vst) of + {literal,[_|_]} -> cons; + cons -> cons; + nil -> nil; + _ -> list + end. + check_limit({x,X}) when is_integer(X), X < 1023 -> %% Note: x(1023) is reserved for use by the BEAM loader. ok; diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 43c99be982..7e219da0af 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -961,18 +961,12 @@ fold_lit_args(Call, Module, Name, Args0) -> %% fold_non_lit_args(Call, erlang, is_boolean, [Arg], Sub) -> eval_is_boolean(Call, Arg, Sub); -fold_non_lit_args(Call, erlang, element, [Arg1,Arg2], Sub) -> - eval_element(Call, Arg1, Arg2, Sub); fold_non_lit_args(Call, erlang, length, [Arg], _) -> eval_length(Call, Arg); fold_non_lit_args(Call, erlang, '++', [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) -> eval_append(Call, Arg1, Arg2); -fold_non_lit_args(Call, erlang, setelement, [Arg1,Arg2,Arg3], _) -> - eval_setelement(Call, Arg1, Arg2, Arg3); -fold_non_lit_args(Call, erlang, is_record, [Arg1,Arg2,Arg3], Sub) -> - eval_is_record(Call, Arg1, Arg2, Arg3, Sub); fold_non_lit_args(Call, erlang, is_function, [Arg1], Sub) -> eval_is_function_1(Call, Arg1, Sub); fold_non_lit_args(Call, erlang, is_function, [Arg1,Arg2], Sub) -> @@ -1141,96 +1135,6 @@ eval_append(Call, #c_cons{anno=Anno,hd=H,tl=T}, List) -> eval_append(Call, X, Y) -> Call#c_call{args=[X,Y]}. %Rebuild call arguments. -%% eval_element(Call, Pos, Tuple, Types) -> Val. -%% Evaluates element/2 if the position Pos is a literal and -%% the shape of the tuple Tuple is known. -%% -eval_element(Call, #c_literal{val=Pos}, Tuple, Types) - when is_integer(Pos) -> - case get_type(Tuple, Types) of - none -> - Call; - Type -> - Es = case cerl:is_c_tuple(Type) of - false -> []; - true -> cerl:tuple_es(Type) - end, - if - 1 =< Pos, Pos =< length(Es) -> - El = lists:nth(Pos, Es), - try - cerl:set_ann(pat_to_expr(El), [compiler_generated]) - catch - throw:impossible -> - Call - end; - true -> - %% Index outside tuple or not a tuple. - eval_failure(Call, badarg) - end - end; -eval_element(Call, Pos, Tuple, Sub) -> - case is_int_type(Pos, Sub) =:= no orelse - is_tuple_type(Tuple, Sub) =:= no of - true -> - eval_failure(Call, badarg); - false -> - Call - end. - -%% eval_is_record(Call, Var, Tag, Size, Types) -> Val. -%% Evaluates is_record/3 using type information. -%% -eval_is_record(Call, Term, #c_literal{val=NeededTag}, - #c_literal{val=Size}, Types) -> - case get_type(Term, Types) of - none -> - Call; - Type -> - Es = case cerl:is_c_tuple(Type) of - false -> []; - true -> cerl:tuple_es(Type) - end, - case Es of - [#c_literal{val=Tag}|_] -> - Bool = Tag =:= NeededTag andalso - length(Es) =:= Size, - #c_literal{val=Bool}; - _ -> - #c_literal{val=false} - end - end; -eval_is_record(Call, _, _, _, _) -> Call. - -%% eval_setelement(Call, Pos, Tuple, NewVal) -> Core. -%% Evaluates setelement/3 if position Pos is an integer -%% and the shape of the tuple Tuple is known. -%% -eval_setelement(Call, #c_literal{val=Pos}, Tuple, NewVal) - when is_integer(Pos) -> - case cerl:is_data(Tuple) of - false -> - Call; - true -> - Es0 = case cerl:is_c_tuple(Tuple) of - false -> []; - true -> cerl:tuple_es(Tuple) - end, - if - 1 =< Pos, Pos =< length(Es0) -> - Es = eval_setelement_1(Pos, Es0, NewVal), - cerl:update_c_tuple(Tuple, Es); - true -> - eval_failure(Call, badarg) - end - end; -eval_setelement(Call, _, _, _) -> Call. - -eval_setelement_1(1, [_|T], NewVal) -> - [NewVal|T]; -eval_setelement_1(Pos, [H|T], NewVal) when Pos > 1 -> - [H|eval_setelement_1(Pos-1, T, NewVal)]. - %% eval_failure(Call, Reason) -> Core. %% Warn for a call that will fail and replace the call with %% a call to erlang:error(Reason). @@ -1290,16 +1194,15 @@ clause(#c_clause{pats=Ps0}=Cl, Cexpr, Ctxt, Sub0) -> end. clause_1(#c_clause{guard=G0,body=B0}=Cl, Ps1, Cexpr, Ctxt, Sub1) -> - Sub2 = update_types(Cexpr, Ps1, Sub1), GSub = case {Cexpr,Ps1,G0} of {_,_,#c_literal{}} -> %% No need for substitution tricks when the guard %% does not contain any variables. - Sub2; + Sub1; {#c_var{name='_'},_,_} -> %% In a 'receive', Cexpr is the variable '_', which represents the %% message being matched. We must NOT do any extra substiutions. - Sub2; + Sub1; {#c_var{},[#c_var{}=Var],_} -> %% The idea here is to optimize expressions such as %% @@ -1321,16 +1224,16 @@ clause_1(#c_clause{guard=G0,body=B0}=Cl, Ps1, Cexpr, Ctxt, Sub1) -> %% case cerl:is_c_fname(Cexpr) of false -> - sub_set_var(Var, Cexpr, Sub2); + sub_set_var(Var, Cexpr, Sub1); true -> %% We must not copy funs, and especially not into guards. - Sub2 + Sub1 end; _ -> - Sub2 + Sub1 end, G1 = guard(G0, GSub), - B1 = body(B0, Ctxt, Sub2), + B1 = body(B0, Ctxt, Sub1), Cl#c_clause{pats=Ps1,guard=G1,body=B1}. %% let_substs(LetVars, LetArg, Sub) -> {[Var],[Val],Sub}. @@ -1414,8 +1317,7 @@ pattern(#c_binary{segments=V0}=Pat, Isub, Osub0) -> {Pat#c_binary{segments=V1},Osub1}; pattern(#c_alias{var=V0,pat=P0}=Pat, Isub, Osub0) -> {V1,Osub1} = pattern(V0, Isub, Osub0), - {P1,Osub2} = pattern(P0, Isub, Osub1), - Osub = update_types(V1, [P1], Osub2), + {P1,Osub} = pattern(P0, Isub, Osub1), {Pat#c_alias{var=V1,pat=P1},Osub}. map_pair_pattern_list(Ps0, Isub, Osub0) -> @@ -2137,14 +2039,9 @@ case_expand_var(E, #sub{t=Tdb}) -> %% encountered. coerce_to_data(C) -> - case cerl:is_c_alias(C) of - false -> - case cerl:is_data(C) orelse cerl:is_c_var(C) of - true -> C; - false -> throw(impossible) - end; - true -> - coerce_to_data(cerl:alias_pat(C)) + case cerl:is_data(C) orelse cerl:is_c_var(C) of + true -> C; + false -> throw(impossible) end. %% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses' @@ -3140,14 +3037,6 @@ is_int_type(Var, Sub) -> C -> yes_no(cerl:is_c_int(C)) end. --spec is_tuple_type(cerl:cerl(), sub()) -> yes_no_maybe(). - -is_tuple_type(Var, Sub) -> - case get_type(Var, Sub) of - none -> maybe; - C -> yes_no(cerl:is_c_tuple(C)) - end. - yes_no(true) -> yes; yes_no(false) -> no. @@ -3209,27 +3098,23 @@ returns_integer(_, _) -> false. %% update_types(Expr, Pattern, Sub) -> Sub' %% Update the type database. --spec update_types(cerl:cerl(), [type_info()], sub()) -> sub(). +-spec update_types(cerl:c_var(), [type_info()], sub()) -> sub(). -update_types(Expr, Pat, #sub{t=Tdb0}=Sub) -> - Tdb = update_types_1(Expr, Pat, Tdb0), +update_types(#c_var{name=V}, Pat, #sub{t=Tdb0}=Sub) -> + Tdb = update_types_1(V, Pat, Tdb0), Sub#sub{t=Tdb}. -update_types_1(#c_var{name=V}, Pat, Types) -> - update_types_2(V, Pat, Types); -update_types_1(_, _, Types) -> Types. - -update_types_2(V, [#c_tuple{}=P], Types) -> +update_types_1(V, [#c_tuple{}=P], Types) -> Types#{V=>P}; -update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> +update_types_1(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> Types#{V=>bool}; -update_types_2(V, [#c_fun{vars=Vars}], Types) -> +update_types_1(V, [#c_fun{vars=Vars}], Types) -> Types#{V=>{'fun',length(Vars)}}; -update_types_2(V, [#c_var{name={_,Arity}}], Types) -> +update_types_1(V, [#c_var{name={_,Arity}}], Types) -> Types#{V=>{'fun',Arity}}; -update_types_2(V, [Type], Types) when is_atom(Type) -> +update_types_1(V, [Type], Types) when is_atom(Type) -> Types#{V=>Type}; -update_types_2(_, _, Types) -> Types. +update_types_1(_, _, Types) -> Types. %% kill_types(V, Tdb) -> Tdb' %% Kill any entries that references the variable, |