aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src/v3_core.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src/v3_core.erl')
-rw-r--r--lib/compiler/src/v3_core.erl291
1 files changed, 130 insertions, 161 deletions
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 9dd6b319a3..ecaecb0ff6 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2014. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2015. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -78,13 +78,11 @@
splitwith/2,keyfind/3,sort/1,foreach/2,droplast/1,last/1]).
-import(ordsets, [add_element/2,del_element/2,is_element/2,
union/1,union/2,intersection/2,subtract/2]).
--import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1,
+-import(cerl, [ann_c_cons/3,ann_c_tuple/2,c_tuple/1,
ann_c_map/3]).
-include("core_parse.hrl").
--define(REC_OFFSET, 100000000). % Also in erl_expand_records.
-
%% Internal core expressions and help functions.
%% N.B. annotations fields in place as normal Core expressions.
@@ -170,8 +168,10 @@ form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) ->
form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) ->
{Fs,[attribute(F)|As],Ws,File}.
-attribute({attribute,Line,Name,Val}) ->
- {#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}.
+attribute(Attribute) ->
+ Fun = fun(A) -> [erl_anno:location(A)] end,
+ {attribute,Line,Name,Val} = erl_parse:map_anno(Fun, Attribute),
+ {#c_literal{val=Name, anno=Line}, #c_literal{val=Val, anno=Line}}.
%% function_dump(module_info,_,_,_) -> ok;
%% function_dump(Name,Arity,Format,Terms) ->
@@ -538,19 +538,8 @@ expr({tuple,L,Es0}, St0) ->
{annotate_tuple(A, Es1, St1),Eps,St1};
expr({map,L,Es0}, St0) ->
map_build_pairs(#c_literal{val=#{}}, Es0, full_anno(L, St0), St0);
-expr({map,L,M0,Es0}, St0) ->
- try expr_map(M0,Es0,lineno_anno(L, St0),St0) of
- {_,_,_}=Res -> Res
- catch
- throw:{bad_map,Warning} ->
- St = add_warning(L, Warning, St0),
- LineAnno = lineno_anno(L, St),
- As = [#c_literal{anno=LineAnno,val=badarg}],
- {#icall{anno=#a{anno=LineAnno}, %Must have an #a{}
- module=#c_literal{anno=LineAnno,val=erlang},
- name=#c_literal{anno=LineAnno,val=error},
- args=As},[],St}
- end;
+expr({map,L,M,Es}, St) ->
+ expr_map(M, Es, L, St);
expr({bin,L,Es0}, St0) ->
try expr_bin(Es0, full_anno(L, St0), St0) of
{_,_,_}=Res -> Res
@@ -740,7 +729,7 @@ make_bool_switch(L, E, V, T, F, #core{}) ->
make_bool_switch_body(L, E, V, T, F).
make_bool_switch_body(L, E, V, T, F) ->
- NegL = neg_line(abs_line(L)),
+ NegL = no_compiler_warning(L),
Error = {tuple,NegL,[{atom,NegL,badarg},V]},
{'case',NegL,E,
[{clause,NegL,[{atom,NegL,true}],[],[T]},
@@ -751,39 +740,50 @@ make_bool_switch_body(L, E, V, T, F) ->
make_bool_switch_guard(_, E, _, {atom,_,true}, {atom,_,false}) -> E;
make_bool_switch_guard(L, E, V, T, F) ->
- NegL = neg_line(abs_line(L)),
+ NegL = no_compiler_warning(L),
{'case',NegL,E,
[{clause,NegL,[{atom,NegL,true}],[],[T]},
{clause,NegL,[{atom,NegL,false}],[],[F]},
{clause,NegL,[V],[],[V]}
]}.
-expr_map(M0,Es0,A,St0) ->
- {M1,Mps,St1} = safe(M0, St0),
+expr_map(M0, Es0, L, St0) ->
+ {M1,Eps0,St1} = safe(M0, St0),
+ Badmap = badmap_term(M1, St1),
+ A = lineno_anno(L, St1),
+ Fc = fail_clause([], [{eval_failure,badmap}|A], Badmap),
case is_valid_map_src(M1) of
true ->
- case {M1,Es0} of
- {#c_var{}, []} ->
- %% transform M#{} to is_map(M)
- {Vpat,St2} = new_var(St1),
- {Fpat,St3} = new_var(St2),
- Cs = [#iclause{
- anno=A,
- pats=[Vpat],
- guard=[#icall{anno=#a{anno=A},
+ {M2,Eps1,St2} = map_build_pairs(M1, Es0, full_anno(L, St1), St1),
+ M3 = case Es0 of
+ [] -> M1;
+ [_|_] -> M2
+ end,
+ Cs = [#iclause{
+ anno=#a{anno=[compiler_generated|A]},
+ pats=[],
+ guard=[#icall{anno=#a{anno=A},
module=#c_literal{anno=A,val=erlang},
name=#c_literal{anno=A,val=is_map},
- args=[Vpat]}],
- body=[Vpat]}],
- Fc = fail_clause([Fpat], A, #c_literal{val=badarg}),
- {#icase{anno=#a{anno=A},args=[M1],clauses=Cs,fc=Fc},Mps,St3};
- {_,_} ->
- {M2,Eps,St2} = map_build_pairs(M1, Es0, A, St1),
- {M2,Mps++Eps,St2}
- end;
- false -> throw({bad_map,bad_map})
+ args=[M1]}],
+ body=[M3]}],
+ Eps = Eps0 ++ Eps1,
+ {#icase{anno=#a{anno=A},args=[],clauses=Cs,fc=Fc},Eps,St2};
+ false ->
+ %% Not a map source. The update will always fail.
+ St2 = add_warning(L, badmap, St1),
+ #iclause{body=[Fail]} = Fc,
+ {Fail,Eps0,St2}
end.
+badmap_term(_Map, #core{in_guard=true}) ->
+ %% The code generator cannot handle complex error reasons
+ %% in guards. But the exact error reason does not matter anyway
+ %% since it is not user-visible.
+ #c_literal{val=badmap};
+badmap_term(Map, #core{in_guard=false}) ->
+ #c_tuple{es=[#c_literal{val=badmap},Map]}.
+
map_build_pairs(Map, Es0, Ann, St0) ->
{Es,Pre,St1} = map_build_pairs_1(Es0, St0),
{ann_c_map(Ann, Map, Es),Pre,St1}.
@@ -869,10 +869,10 @@ constant_bin_1(Es) ->
({float,_,F}, B) -> {value,F,B};
({atom,_,undefined}, B) -> {value,undefined,B}
end,
- case catch eval_bits:expr_grp(Es, EmptyBindings, EvalFun) of
+ try eval_bits:expr_grp(Es, EmptyBindings, EvalFun) of
{value,Bin,EmptyBindings} ->
- Bin;
- _ ->
+ Bin
+ catch error:_ ->
error
end.
@@ -919,7 +919,7 @@ verify_suitable_fields([]) -> ok.
%% (We don't need an exact result for this purpose.)
count_bits(Int) ->
- count_bits_1(abs_line(Int), 64).
+ count_bits_1(abs(Int), 64).
count_bits_1(0, Bits) -> Bits;
count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64).
@@ -1623,49 +1623,30 @@ pattern_map_pairs(Ps, St) ->
{CMapPair,EpsP,Sti1} = pattern_map_pair(P,Sti0),
{CMapPair, {EpsM++EpsP,Sti1}}
end, {[],St}, Ps),
- {pat_alias_map_pairs(CMapPairs,[]),Eps,St1}.
-
-%% remove cluddering annotations
-pattern_map_clean_key(#c_literal{val=V}) -> {literal,V};
-pattern_map_clean_key(#c_var{name=V}) -> {var,V}.
-
-pat_alias_map_pairs(Ps1,Ps2) ->
- Ps = Ps1 ++ Ps2,
- F = fun(#c_map_pair{key=Ck,val=Cv},Dbi) ->
- K = pattern_map_clean_key(Ck),
- case dict:find(K,Dbi) of
- {ok,Cvs} -> dict:store(K,[Cv|Cvs],Dbi);
- _ -> dict:store(K,[Cv],Dbi)
- end
- end,
- Kdb = lists:foldl(F,dict:new(),Ps),
- pat_alias_map_pairs(Ps,Kdb,sets:new()).
-
-pat_alias_map_pairs([],_,_) -> [];
-pat_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Set) ->
- K = pattern_map_clean_key(Ck),
- case sets:is_element(K,Set) of
- true ->
- pat_alias_map_pairs(Pairs,Kdb,Set);
- false ->
- Cvs = dict:fetch(K,Kdb),
- Cv = pat_alias_map_pair_values(Cvs),
- Set1 = sets:add_element(K,Set),
- [Pair#c_map_pair{val=Cv}|pat_alias_map_pairs(Pairs,Kdb,Set1)]
- end.
-
-pat_alias_map_pair_values([Cv]) -> Cv;
-pat_alias_map_pair_values([Cv1,Cv2|Cvs]) ->
- pat_alias_map_pair_values([pat_alias(Cv1,Cv2)|Cvs]).
+ {pat_alias_map_pairs(CMapPairs),Eps,St1}.
pattern_map_pair({map_field_exact,L,K,V}, St0) ->
- {Ck,EpsK,St1} = safe_pattern_expr(K,St0),
+ {Ck,EpsK,St1} = safe_pattern_expr(K, St0),
{Cv,EpsV,St2} = pattern(V, St1),
- {#c_map_pair{anno=lineno_anno(L,St2),
+ {#c_map_pair{anno=lineno_anno(L, St2),
op=#c_literal{val=exact},
key=Ck,
val=Cv},EpsK++EpsV,St2}.
+pat_alias_map_pairs(Ps) ->
+ D = foldl(fun(#c_map_pair{key=K0}=Pair, D0) ->
+ K = cerl:set_ann(K0, []),
+ dict:append(K, Pair, D0)
+ end, dict:new(), Ps),
+ pat_alias_map_pairs_1(dict:to_list(D)).
+
+pat_alias_map_pairs_1([{_,[#c_map_pair{val=V0}=Pair|Vs]}|T]) ->
+ V = foldl(fun(#c_map_pair{val=V}, Pat) ->
+ pat_alias(V, Pat)
+ end, V0, Vs),
+ [Pair#c_map_pair{val=V}|pat_alias_map_pairs_1(T)];
+pat_alias_map_pairs_1([]) -> [].
+
%% pat_bin([BinElement], State) -> [BinSeg].
pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps].
@@ -1681,48 +1662,55 @@ pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) ->
%% pat_alias(CorePat, CorePat) -> AliasPat.
%% Normalise aliases. Trap bad aliases by throwing 'nomatch'.
-pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2};
-pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1};
-
-%% alias cons
-pat_alias(#c_cons{}=Cons, #c_literal{anno=A,val=[H|T]}=S) ->
- pat_alias(Cons, ann_c_cons_skel(A, #c_literal{anno=A,val=H},
- S#c_literal{val=T}));
-pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) ->
- pat_alias(ann_c_cons_skel(A, #c_literal{anno=A,val=H},
- S#c_literal{val=T}), Cons);
-pat_alias(#c_cons{anno=Anno,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) ->
- ann_c_cons(Anno, pat_alias(H1, H2), pat_alias(T1, T2));
-
-%% alias tuples
-pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_literal{val=T}) when is_tuple(T) ->
- Es2 = [#c_literal{val=E} || E <- tuple_to_list(T)],
- ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
-pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(T) ->
- Es1 = [#c_literal{val=E} || E <- tuple_to_list(T)],
- ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
-pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_tuple{es=Es2}) ->
- ann_c_tuple(Anno, pat_alias_list(Es1, Es2));
-
-%% alias maps
-%% There are no literals in maps patterns (patterns are always abstract)
-pat_alias(#c_map{es=Es1}=M,#c_map{es=Es2}) ->
- M#c_map{es=pat_alias_map_pairs(Es1,Es2)};
-
-pat_alias(#c_alias{var=V1,pat=P1},
- #c_alias{var=V2,pat=P2}) ->
- if V1 =:= V2 -> #c_alias{var=V1,pat=pat_alias(P1, P2)};
- true -> #c_alias{var=V1,pat=#c_alias{var=V2,pat=pat_alias(P1, P2)}}
+pat_alias(#c_var{name=V1}=P, #c_var{name=V1}) -> P;
+pat_alias(#c_var{name=V1}=Var,
+ #c_alias{var=#c_var{name=V2},pat=Pat}=Alias) ->
+ if
+ V1 =:= V2 ->
+ Alias;
+ true ->
+ Alias#c_alias{pat=pat_alias(Var, Pat)}
+ end;
+pat_alias(#c_var{}=P1, P2) -> #c_alias{var=P1,pat=P2};
+
+pat_alias(#c_alias{var=#c_var{name=V1}}=Alias, #c_var{name=V1}) ->
+ Alias;
+pat_alias(#c_alias{var=#c_var{name=V1}=Var1,pat=P1},
+ #c_alias{var=#c_var{name=V2}=Var2,pat=P2}) ->
+ Pat = pat_alias(P1, P2),
+ if
+ V1 =:= V2 ->
+ #c_alias{var=Var1,pat=Pat};
+ true ->
+ pat_alias(Var1, pat_alias(Var2, Pat))
end;
-pat_alias(#c_alias{var=V1,pat=P1}, P2) ->
- #c_alias{var=V1,pat=pat_alias(P1, P2)};
-pat_alias(P1, #c_alias{var=V2,pat=P2}) ->
- #c_alias{var=V2,pat=pat_alias(P1, P2)};
+pat_alias(#c_alias{var=#c_var{}=Var,pat=P1}, P2) ->
+ #c_alias{var=Var,pat=pat_alias(P1, P2)};
+
+pat_alias(#c_map{es=Es1}=M, #c_map{es=Es2}) ->
+ M#c_map{es=pat_alias_map_pairs(Es1 ++ Es2)};
+
+pat_alias(P1, #c_var{}=Var) ->
+ #c_alias{var=Var,pat=P1};
+pat_alias(P1, #c_alias{pat=P2}=Alias) ->
+ Alias#c_alias{pat=pat_alias(P1, P2)};
+
pat_alias(P1, P2) ->
- case {set_anno(P1, []),set_anno(P2, [])} of
- {P,P} -> P;
+ %% Aliases between binaries are not allowed, so the only
+ %% legal patterns that remain are data patterns.
+ case cerl:is_data(P1) andalso cerl:is_data(P2) of
+ false -> throw(nomatch);
+ true -> ok
+ end,
+ Type = cerl:data_type(P1),
+ case cerl:data_type(P2) of
+ Type -> ok;
_ -> throw(nomatch)
- end.
+ end,
+ Es1 = cerl:data_es(P1),
+ Es2 = cerl:data_es(P2),
+ Es = pat_alias_list(Es1, Es2),
+ cerl:make_data(Type, Es).
%% pat_alias_list([A1], [A2]) -> [A].
@@ -1819,7 +1807,7 @@ uclauses(Lcs, Ks, St0) ->
uclause(Cl0, Ks, St0) ->
{Cl1,_Pvs,Used,New,St1} = uclause(Cl0, Ks, Ks, St0),
- A0 = get_ianno(Cl1),
+ A0 = get_anno(Cl1),
A = A0#a{us=Used,ns=New},
{Cl1#iclause{anno=A},St1}.
@@ -2006,7 +1994,7 @@ ufun_clauses(Lcs, Ks, St0) ->
ufun_clause(Cl0, Ks, St0) ->
{Cl1,Pvs,Used,_,St1} = uclause(Cl0, [], Ks, St0),
- A0 = get_ianno(Cl1),
+ A0 = get_anno(Cl1),
A = A0#a{us=subtract(intersection(Used, Ks), Pvs),ns=[]},
{Cl1#iclause{anno=A},St1}.
@@ -2323,22 +2311,15 @@ bitstr_vars(Segs, Vs) ->
lit_vars(V, lit_vars(S, Vs0))
end, Vs, Segs).
-record_anno(L, St) when L >= ?REC_OFFSET ->
- case member(dialyzer, St#core.opts) of
- true ->
- [record | lineno_anno(L - ?REC_OFFSET, St)];
- false ->
- full_anno(L, St)
- end;
-record_anno(L, St) when L < -?REC_OFFSET ->
- case member(dialyzer, St#core.opts) of
+record_anno(L, St) ->
+ case
+ erl_anno:record(L) andalso member(dialyzer, St#core.opts)
+ of
true ->
- [record | lineno_anno(L + ?REC_OFFSET, St)];
+ [record | lineno_anno(L, St)];
false ->
full_anno(L, St)
- end;
-record_anno(L, St) ->
- full_anno(L, St).
+ end.
full_anno(L, #core{wanted=false}=St) ->
[result_not_wanted|lineno_anno(L, St)];
@@ -2346,19 +2327,10 @@ full_anno(L, #core{wanted=true}=St) ->
lineno_anno(L, St).
lineno_anno(L, St) ->
- {line, Line} = erl_parse:get_attribute(L, line),
- if
- Line < 0 ->
- [-Line] ++ St#core.file ++ [compiler_generated];
- true ->
- [Line] ++ St#core.file
- end.
-
-get_ianno(Ce) ->
- case get_anno(Ce) of
- #a{}=A -> A;
- A when is_list(A) -> #a{anno=A}
- end.
+ Line = erl_anno:line(L),
+ Generated = erl_anno:generated(L),
+ CompilerGenerated = [compiler_generated || Generated],
+ [Line] ++ St#core.file ++ CompilerGenerated.
get_lineno_anno(Ce) ->
case get_anno(Ce) of
@@ -2366,15 +2338,8 @@ get_lineno_anno(Ce) ->
A when is_list(A) -> A
end.
-location(L) ->
- {location,Location} = erl_parse:get_attribute(L, location),
- Location.
-
-abs_line(L) ->
- erl_parse:set_line(L, fun(Line) -> abs(Line) end).
-
-neg_line(L) ->
- erl_parse:set_line(L, fun(Line) -> -abs(Line) end).
+no_compiler_warning(Anno) ->
+ erl_anno:set_generated(true, Anno).
%%
%% The following three functions are used both with cerl:cerl() and with i()'s
@@ -2415,9 +2380,13 @@ format_error(nomatch) ->
"pattern cannot possibly match";
format_error(bad_binary) ->
"binary construction will fail because of a type mismatch";
-format_error(bad_map) ->
+format_error(badmap) ->
"map construction will fail because of a type mismatch".
-add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 ->
- St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]};
-add_warning(_, _, St) -> St.
+add_warning(Anno, Term, #core{ws=Ws,file=[{file,File}]}=St) ->
+ case erl_anno:generated(Anno) of
+ false ->
+ St#core{ws=[{File,[{erl_anno:location(Anno),?MODULE,Term}]}|Ws]};
+ true ->
+ St
+ end.
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-20 12:43:50 +0000