aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src')
-rw-r--r--lib/compiler/src/beam_bool.erl2
-rw-r--r--lib/compiler/src/beam_reorder.erl9
-rw-r--r--lib/compiler/src/beam_type.erl66
-rw-r--r--lib/compiler/src/beam_validator.erl13
-rw-r--r--lib/compiler/src/v3_core.erl66
5 files changed, 127 insertions, 29 deletions
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
index 359fdb6d3c..99e4ccb1e9 100644
--- a/lib/compiler/src/beam_bool.erl
+++ b/lib/compiler/src/beam_bool.erl
@@ -311,6 +311,8 @@ dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) ->
dst_regs(Is, [D|Acc]);
dst_regs([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) ->
dst_regs(Is, [D|Acc]);
+dst_regs([{protected,_,Bl,_}|Is], Acc) ->
+ dst_regs(Bl, dst_regs(Is, Acc));
dst_regs([_|Is], Acc) ->
dst_regs(Is, Acc);
dst_regs([], Acc) -> ordsets:from_list(Acc).
diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl
index f1c0b3ef91..6a7c033ec6 100644
--- a/lib/compiler/src/beam_reorder.erl
+++ b/lib/compiler/src/beam_reorder.erl
@@ -87,6 +87,15 @@ reorder_1([{test,_,_,_}=I,
%% instruction between the test instruction and the select
%% instruction.
reorder_1(Is, D, [S,I|Acc]);
+reorder_1([{test,_,{f,_},[Src|_]}=I|Is], D,
+ [{get_tuple_element,Src,_,_}|_]=Acc) ->
+ %% We want to avoid code that can confuse beam_validator such as:
+ %% is_tuple Fail Src
+ %% test_arity Fail Src Arity
+ %% is_map Fail Src
+ %% get_tuple_element Src Pos Dst
+ %% Therefore, don't reorder the instructions in such cases.
+ reorder_1(Is, D, [I|Acc]);
reorder_1([{test,_,{f,L},Ss}=I|Is0], D0,
[{get_tuple_element,_,_,El}=G|Acc0]=Acc) ->
case member(El, Ss) of
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index 5076c5eb96..acaf3ede66 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -513,12 +513,23 @@ update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) ->
false -> tdb_kill_xregs(Ts)
end;
update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) ->
- Op = case tdb_find({x,1}, Ts0) of
- error -> kill;
- Info -> Info
- end,
- Ts1 = tdb_kill_xregs(Ts0),
- tdb_update([{{x,0},Op}], Ts1);
+ Ts = tdb_kill_xregs(Ts0),
+ case tdb_find({x,1}, Ts0) of
+ {tuple,Sz,_}=T0 ->
+ T = case tdb_find({x,0}, Ts0) of
+ {integer,{I,I}} when I > 1 ->
+ %% First element is not changed. The result
+ %% will have the same type.
+ T0;
+ _ ->
+ %% Position is 1 or unknown. May change the
+ %% first element of the tuple.
+ {tuple,Sz,[]}
+ end,
+ tdb_update([{{x,0},T}], Ts);
+ _ ->
+ Ts
+ end;
update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts);
update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts);
update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts);
@@ -748,7 +759,7 @@ checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs].
%%%
%%% {tuple,Size,First} means that the corresponding register contains a
%%% tuple with *at least* Size elements. An tuple with unknown
-%%% size is represented as {tuple,0}. First is either [] (meaning that
+%%% size is represented as {tuple,0,[]}. First is either [] (meaning that
%%% the tuple's first element is unknown) or [FirstElement] (the contents
%%% of the first element).
%%%
@@ -785,21 +796,45 @@ tdb_copy({Tag,_}=S, D, Ts) when Tag =:= x; Tag =:= y ->
error -> orddict:erase(D, Ts);
Type -> orddict:store(D, Type, Ts)
end;
-tdb_copy(Literal, D, Ts) -> orddict:store(D, Literal, Ts).
+tdb_copy(Literal, D, Ts) ->
+ Type = case Literal of
+ {atom,_} -> Literal;
+ {float,_} -> float;
+ {integer,Int} -> {integer,{Int,Int}};
+ {literal,[_|_]} -> nonempty_list;
+ {literal,#{}} -> map;
+ {literal,Tuple} when tuple_size(Tuple) >= 1 ->
+ Lit = tag_literal(element(1, Tuple)),
+ {tuple,tuple_size(Tuple),[Lit]};
+ _ -> term
+ end,
+ if
+ Type =:= term ->
+ orddict:erase(D, Ts);
+ true ->
+ verify_type(Type),
+ orddict:store(D, Type, Ts)
+ end.
+
+tag_literal(A) when is_atom(A) -> {atom,A};
+tag_literal(F) when is_float(F) -> {float,F};
+tag_literal(I) when is_integer(I) -> {integer,I};
+tag_literal([]) -> nil;
+tag_literal(Lit) -> {literal,Lit}.
%% tdb_update([UpdateOp], Db) -> NewDb
%% UpdateOp = {Register,kill}|{Register,NewInfo}
%% Updates a type database. If a 'kill' operation is given, the type
%% information for that register will be removed from the database.
%% A kill operation takes precedence over other operations for the same
-%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5}}] means that the
+%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5,[]}}] means that the
%% the existing type information, if any, will be discarded, and the
-%% the '{tuple,5}' information ignored.
+%% the '{tuple,5,[]}' information ignored.
%%
%% If NewInfo information is given and there exists information about
%% the register, the old and new type information will be merged.
-%% For instance, {tuple,5} and {tuple,10} will be merged to produce
-%% {tuple,10}.
+%% For instance, {tuple,5,_} and {tuple,10,_} will be merged to produce
+%% {tuple,10,_}.
tdb_update(Uis0, Ts0) ->
Uis1 = filter(fun ({{x,_},_Op}) -> true;
@@ -810,7 +845,8 @@ tdb_update(Uis0, Ts0) ->
tdb_update1([{Key,kill}|Ops], [{K,_Old}|_]=Db) when Key < K ->
tdb_update1(remove_key(Key, Ops), Db);
-tdb_update1([{Key,_New}=New|Ops], [{K,_Old}|_]=Db) when Key < K ->
+tdb_update1([{Key,Type}=New|Ops], [{K,_Old}|_]=Db) when Key < K ->
+ verify_type(Type),
[New|tdb_update1(Ops, Db)];
tdb_update1([{Key,kill}|Ops], [{Key,_}|Db]) ->
tdb_update1(remove_key(Key, Ops), Db);
@@ -820,7 +856,8 @@ tdb_update1([{_,_}|_]=Ops, [Old|Db]) ->
[Old|tdb_update1(Ops, Db)];
tdb_update1([{Key,kill}|Ops], []) ->
tdb_update1(remove_key(Key, Ops), []);
-tdb_update1([{_,_}=New|Ops], []) ->
+tdb_update1([{_,Type}=New|Ops], []) ->
+ verify_type(Type),
[New|tdb_update1(Ops, [])];
tdb_update1([], Db) -> Db.
@@ -855,6 +892,7 @@ merge_type_info(NewType, _) ->
verify_type(NewType),
NewType.
+verify_type({atom,_}) -> ok;
verify_type(boolean) -> ok;
verify_type(integer) -> ok;
verify_type({integer,{Min,Max}})
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 6877141885..faff9940ec 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -1165,12 +1165,17 @@ assert_type(WantedType, Term, Vst) ->
assert_type(Correct, Correct) -> ok;
assert_type(float, {float,_}) -> ok;
assert_type(tuple, {tuple,_}) -> ok;
+assert_type(tuple, {literal,Tuple}) when is_tuple(Tuple) -> ok;
assert_type({tuple_element,I}, {tuple,[Sz]})
when 1 =< I, I =< Sz ->
ok;
assert_type({tuple_element,I}, {tuple,Sz})
when is_integer(Sz), 1 =< I, I =< Sz ->
ok;
+assert_type({tuple_element,I}, {literal,Lit}) when I =< tuple_size(Lit) ->
+ ok;
+assert_type(cons, {literal,[_|_]}) ->
+ ok;
assert_type(Needed, Actual) ->
error({bad_type,{needed,Needed},{actual,Actual}}).
@@ -1549,8 +1554,12 @@ return_type_1(erlang, setelement, 3, Vst) ->
Tuple = {x,1},
TupleType =
case get_term_type(Tuple, Vst) of
- {tuple,_}=TT -> TT;
- _ -> {tuple,[0]}
+ {tuple,_}=TT ->
+ TT;
+ {literal,Lit} when is_tuple(Lit) ->
+ {tuple,tuple_size(Lit)};
+ _ ->
+ {tuple,[0]}
end,
case get_term_type({x,0}, Vst) of
{integer,[]} -> TupleType;
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 83b3650180..a3b0236134 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -510,16 +510,8 @@ unforce(_, Vs) -> Vs.
exprs([E0|Es0], St0) ->
{E1,Eps,St1} = expr(E0, St0),
- case E1 of
- #iprimop{name=#c_literal{val=match_fail}} ->
- %% Must discard the rest of the body, because it
- %% may refer to variables that have not been bound.
- %% Example: {ok={error,E}} = foo(), E.
- {Eps ++ [E1],St1};
- _ ->
- {Es1,St2} = exprs(Es0, St1),
- {Eps ++ [E1] ++ Es1,St2}
- end;
+ {Es1,St2} = exprs(Es0, St1),
+ {Eps ++ [E1] ++ Es1,St2};
exprs([], St) -> {[],St}.
%% expr(Expr, State) -> {Cexpr,[PreExp],State}.
@@ -689,14 +681,36 @@ expr({match,L,P0,E0}, St0) ->
Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])),
case P2 of
nomatch ->
+ %% The pattern will not match. We must take care here to
+ %% bind all variables that the pattern would have bound
+ %% so that subsequent expressions do not refer to unbound
+ %% variables.
+ %%
+ %% As an example, this code:
+ %%
+ %% [X] = {Y} = E,
+ %% X + Y.
+ %%
+ %% will be rewritten to:
+ %%
+ %% error({badmatch,E}),
+ %% case E of
+ %% {[X],{Y}} ->
+ %% X + Y;
+ %% Other ->
+ %% error({badmatch,Other})
+ %% end.
+ %%
St6 = add_warning(L, nomatch, St5),
- {Expr,Eps3,St} = safe(E1, St6),
- Eps = Eps1 ++ Eps2 ++ Eps3,
+ {Expr,Eps3,St7} = safe(E1, St6),
+ SanPat0 = sanitize(P1),
+ {SanPat,Eps4,St} = pattern(SanPat0, St7),
Badmatch = c_tuple([#c_literal{val=badmatch},Expr]),
Fail = #iprimop{anno=#a{anno=Lanno},
name=#c_literal{val=match_fail},
args=[Badmatch]},
- {Fail,Eps,St};
+ Eps = Eps3 ++ Eps4 ++ [Fail],
+ {#imatch{anno=#a{anno=Lanno},pat=SanPat,arg=Expr,fc=Fc},Eps,St};
Other when not is_atom(Other) ->
{#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5}
end;
@@ -738,6 +752,32 @@ expr({op,L,Op,L0,R0}, St0) ->
module=#c_literal{anno=LineAnno,val=erlang},
name=#c_literal{anno=LineAnno,val=Op},args=As},Aps,St1}.
+
+%% sanitize(Pat) -> SanitizedPattern
+%% Rewrite Pat so that it will be accepted by pattern/2 and will
+%% bind the same variables as the original pattern.
+%%
+%% Here is an example of a pattern that would cause a pattern/2
+%% to generate a 'nomatch' exception:
+%%
+%% #{k:=X,k:=Y} = [Z]
+%%
+%% The sanitized pattern will look like:
+%%
+%% {{X,Y},[Z]}
+
+sanitize({match,L,P1,P2}) ->
+ {tuple,L,[sanitize(P1),sanitize(P2)]};
+sanitize({cons,L,H,T}) ->
+ {cons,L,sanitize(H),sanitize(T)};
+sanitize({tuple,L,Ps0}) ->
+ Ps = [sanitize(P) || P <- Ps0],
+ {tuple,L,Ps};
+sanitize({map,L,Ps0}) ->
+ Ps = [sanitize(V) || {map_field_exact,_,_,V} <- Ps0],
+ {tuple,L,Ps};
+sanitize(P) -> P.
+
make_bool_switch(L, E, V, T, F, #core{in_guard=true}) ->
make_bool_switch_guard(L, E, V, T, F);
make_bool_switch(L, E, V, T, F, #core{}) ->
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-02 08:07:22 +0000