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.erl75
-rw-r--r--lib/compiler/src/core_lib.erl9
-rw-r--r--lib/compiler/src/sys_core_fold.erl213
-rw-r--r--lib/compiler/src/v3_core.erl112
4 files changed, 266 insertions, 143 deletions
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
index 5a4621dc37..a452d30b61 100644
--- a/lib/compiler/src/beam_bool.erl
+++ b/lib/compiler/src/beam_bool.erl
@@ -126,44 +126,53 @@ bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) ->
%% There was a reference to a boolean expression
%% from inside a protected block (try/catch), to
%% a boolean expression outside.
- throw:protected_barrier ->
+ throw:protected_barrier ->
failed;
- %% The 'xor' operator was used. We currently don't
- %% find it worthwile to translate 'xor' operators
- %% (the code would be clumsy).
- throw:'xor' ->
+ %% The 'xor' operator was used. We currently don't
+ %% find it worthwile to translate 'xor' operators
+ %% (the code would be clumsy).
+ throw:'xor' ->
failed;
- %% The block does not contain a boolean expression,
- %% but only a call to a guard BIF.
- %% For instance: ... when element(1, T) ->
- throw:not_boolean_expr ->
+ %% The block does not contain a boolean expression,
+ %% but only a call to a guard BIF.
+ %% For instance: ... when element(1, T) ->
+ throw:not_boolean_expr ->
failed;
- %% The block contains a 'move' instruction that could
- %% not be handled.
- throw:move ->
+ %% The block contains a 'move' instruction that could
+ %% not be handled.
+ throw:move ->
failed;
- %% The optimization is not safe. (A register
- %% used by the instructions following the
- %% optimized code is either not assigned a
- %% value at all or assigned a different value.)
- throw:all_registers_not_killed ->
+ %% The optimization is not safe. (A register
+ %% used by the instructions following the
+ %% optimized code is either not assigned a
+ %% value at all or assigned a different value.)
+ throw:all_registers_not_killed ->
failed;
- throw:registers_used ->
+ throw:registers_used ->
failed;
- %% A protected block refered to the value
- %% returned by another protected block,
- %% probably because the Core Erlang code
- %% used nested try/catches in the guard.
- %% (v3_core never produces nested try/catches
- %% in guards, so it must have been another
- %% Core Erlang translator.)
- throw:protected_violation ->
+ %% A protected block refered to the value
+ %% returned by another protected block,
+ %% probably because the Core Erlang code
+ %% used nested try/catches in the guard.
+ %% (v3_core never produces nested try/catches
+ %% in guards, so it must have been another
+ %% Core Erlang translator.)
+ throw:protected_violation ->
+ failed;
+
+ %% Failed to work out the live registers for a GC
+ %% BIF. For example, if the number of live registers
+ %% needed to be 4 because {x,3} was a source register,
+ %% but {x,2} was not known to be initialized, this
+ %% exception would be thrown.
+ throw:gc_bif_alloc_failure ->
failed
+
end
end.
@@ -665,10 +674,16 @@ put_reg_1(V, [], I) -> [{I,V}].
fetch_reg(V, [{I,V}|_]) -> {x,I};
fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs).
-live_regs(Regs) ->
- foldl(fun ({I,_}, _) ->
- I
- end, -1, Regs)+1.
+live_regs([{_,reserved}|_]) ->
+ %% We are not sure that this register is initialized, so we must
+ %% abort the optimization.
+ throw(gc_bif_alloc_failure);
+live_regs([{I,_}]) ->
+ I+1;
+live_regs([{_,_}|Regs]) ->
+ live_regs(Regs);
+live_regs([]) ->
+ 0.
%%%
diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl
index 2792fd8fa5..0d95971f91 100644
--- a/lib/compiler/src/core_lib.erl
+++ b/lib/compiler/src/core_lib.erl
@@ -212,6 +212,8 @@ vu_pattern(V, #c_tuple{es=Es}, St) ->
vu_pattern_list(V, Es, St);
vu_pattern(V, #c_binary{segments=Ss}, St) ->
vu_pat_seg_list(V, Ss, St);
+vu_pattern(V, #c_map{es=Es}, St) ->
+ vu_map_pairs(V, Es, St);
vu_pattern(V, #c_alias{var=Var,pat=P}, St0) ->
case vu_pattern(V, Var, St0) of
{true,_}=St1 -> St1;
@@ -234,6 +236,13 @@ vu_pat_seg_list(V, Ss, St) ->
end
end, St, Ss).
+vu_map_pairs(V, [#c_map_pair{val=Pat}|T], St0) ->
+ case vu_pattern(V, Pat, St0) of
+ {true,_}=St -> St;
+ St -> vu_map_pairs(V, T, St)
+ end;
+vu_map_pairs(_, [], St) -> St.
+
-spec vu_var_list(cerl:var_name(), [cerl:c_var()]) -> boolean().
vu_var_list(V, Vs) ->
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index ce40213bad..ed8f609082 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -1229,6 +1229,11 @@ is_non_numeric([H|T]) ->
is_non_numeric(H) andalso is_non_numeric(T);
is_non_numeric(Tuple) when is_tuple(Tuple) ->
is_non_numeric_tuple(Tuple, tuple_size(Tuple));
+is_non_numeric(Map) when is_map(Map) ->
+ %% Note that 17.x and 18.x compare keys in different ways.
+ %% Be very conservative -- require that both keys and values
+ %% are non-numeric.
+ is_non_numeric(maps:to_list(Map));
is_non_numeric(Num) when is_number(Num) ->
false;
is_non_numeric(_) -> true.
@@ -1338,9 +1343,12 @@ eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types)
{ok,#c_tuple{es=Elements}} ->
if
1 =< Pos, Pos =< length(Elements) ->
- case lists:nth(Pos, Elements) of
- #c_alias{var=Alias} -> Alias;
- Res -> Res
+ El = lists:nth(Pos, Elements),
+ try
+ pat_to_expr(El)
+ catch
+ throw:impossible ->
+ Call
end;
true ->
eval_failure(Call, badarg)
@@ -2040,17 +2048,18 @@ case_opt_args([], Cs, _Sub, _LitExpr, Acc) ->
%% Try to expand one argument to several arguments (if tuple/list)
%% or to remove a literal argument.
%%
-case_opt_arg(E0, Sub, Cs, LitExpr) ->
+case_opt_arg(E0, Sub, Cs0, LitExpr) ->
E = maybe_replace_var(E0, Sub),
case cerl:is_data(E) of
false ->
- {error,Cs};
+ {error,Cs0};
true ->
+ Cs = case_opt_nomatch(E, Cs0, LitExpr),
case cerl:data_type(E) of
{atomic,_} ->
- case_opt_lit(E, Cs, LitExpr);
+ case_opt_lit(E, Cs);
_ ->
- case_opt_data(E, Cs, LitExpr)
+ case_opt_data(E, Cs)
end
end.
@@ -2072,19 +2081,67 @@ maybe_replace_var_1(E, #sub{t=Tdb}) ->
false ->
E;
true ->
- cerl_trees:map(fun(C) ->
- case cerl:is_c_alias(C) of
- false -> C;
- true -> cerl:alias_pat(C)
- end
- end, T0)
+ %% The pattern was a tuple. Now we must make sure
+ %% that the elements of the tuple are suitable. In
+ %% particular, we don't want binary or map
+ %% construction here, since that means that the
+ %% binary or map will be constructed in the 'case'
+ %% argument. That is wasteful for binaries. Even
+ %% worse is that any map pattern that use the ':='
+ %% operator will fail when used in map
+ %% construction (only the '=>' operator is allowed
+ %% when constructing a map from scratch).
+ ToData = fun coerce_to_data/1,
+ try
+ cerl_trees:map(ToData, T0)
+ catch
+ throw:impossible ->
+ %% Something unsuitable was found (map or
+ %% or binary). Keep the variable.
+ E
+ end
end;
error ->
E
end.
-%% case_opt_lit(Literal, Clauses0, LitExpr) ->
-%% {ok,[],Clauses} | error
+%% coerce_to_data(Core) -> Core'
+%% Coerce an element originally from a pattern to an data item or or
+%% variable. Throw an 'impossible' exception if non-data Core Erlang
+%% terms such as binary construction or map construction are
+%% 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))
+ end.
+
+%% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses'
+%% Remove all clauses that cannot possibly match.
+
+case_opt_nomatch(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) ->
+ case cerl_clauses:match(P, E) of
+ none ->
+ %% The pattern will not match the case expression. 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_nomatch(E, Cs, LitExpr);
+ _ ->
+ [Current|case_opt_nomatch(E, Cs, LitExpr)]
+ end;
+case_opt_nomatch(_, [], _) -> [].
+
+%% case_opt_lit(Literal, Clauses0) -> {ok,[],Clauses} | error
%% The current part of the case expression is a literal. That
%% means that we will know at compile-time whether a clause
%% will match, and we can remove the corresponding pattern from
@@ -2093,68 +2150,48 @@ maybe_replace_var_1(E, #sub{t=Tdb}) ->
%% The only complication is if the literal is a binary. Binary
%% pattern matching is tricky, so we will give up in that case.
-case_opt_lit(Lit, Cs0, LitExpr) ->
- Cs1 = case_opt_lit_1(Lit, Cs0, LitExpr),
- try case_opt_lit_2(Lit, Cs1) of
+case_opt_lit(Lit, Cs0) ->
+ try case_opt_lit_1(Lit, Cs0) of
Cs ->
{ok,[],Cs}
catch
throw:impossible ->
- {error,Cs1}
+ {error,Cs0}
end.
-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_opt_lit_1(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) ->
+ %% Non-matching clauses have already been removed
+ %% in case_opt_nomatch/3.
case cerl_clauses:match(P, E) of
{true,Bs} ->
%% The pattern matches the literal. Remove the pattern
%% and update the bindings.
- [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_2(E, Cs)];
+ [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(E, Cs)];
{false,_} ->
%% Binary literal and pattern. We are not sure whether
%% the pattern will match.
throw(impossible)
end;
-case_opt_lit_2(_, []) -> [].
+case_opt_lit_1(_, []) -> [].
%% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses}
-case_opt_data(E, Cs0, LitExpr) ->
+case_opt_data(E, Cs0) ->
Es = cerl:data_es(E),
- Cs = case_opt_data_1(Cs0, Es,
- {cerl:data_type(E),cerl:data_arity(E)},
- LitExpr),
- {ok,Es,Cs}.
-
-case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig, LitExpr) ->
- case case_data_pat(P, TypeSig) of
- {ok,Ps1,Bs1} ->
- [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|
- case_opt_data_1(Cs, Es, TypeSig,LitExpr)];
- error ->
- case LitExpr of
- false -> add_warning(C, nomatch_clause_type);
- true -> ok
- end,
- case_opt_data_1(Cs, Es, TypeSig, LitExpr)
- end;
-case_opt_data_1([], _, _, _) -> [].
+ TypeSig = {cerl:data_type(E),cerl:data_arity(E)},
+ try case_opt_data_1(Cs0, Es, TypeSig) of
+ Cs ->
+ {ok,Es,Cs}
+ catch
+ throw:impossible ->
+ {error,Cs0}
+ end.
+
+case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) ->
+ {ok,Ps1,Bs1} = case_data_pat(P, TypeSig),
+ [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|
+ case_opt_data_1(Cs, Es, TypeSig)];
+case_opt_data_1([], _, _) -> [].
%% case_data_pat(Pattern, Type, Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error.
@@ -2163,12 +2200,7 @@ case_data_pat(P, TypeSig) ->
false ->
case_data_pat_var(P, TypeSig);
true ->
- case {cerl:data_type(P),cerl:data_arity(P)} of
- TypeSig ->
- {ok,cerl:data_es(P),[]};
- {_,_} ->
- error
- end
+ {ok,cerl:data_es(P),[]}
end.
%% case_data_pat_var(Pattern, {DataType,ArityType}) ->
@@ -2188,35 +2220,38 @@ case_data_pat_var(P, {Type,Arity}=TypeSig) ->
alias ->
V = cerl:alias_var(P),
Apat = cerl:alias_pat(P),
- case case_data_pat(Apat, TypeSig) of
- {ok,Ps,Bs} ->
- {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, unalias_pat_list(Ps))}|Bs]};
- error ->
- error
- end;
- _ ->
- error
+ {ok,Ps,Bs} = case_data_pat(Apat, TypeSig),
+ {ok,Ps,[{V,cerl:ann_make_data(Ann, Type,
+ pat_to_expr_list(Ps))}|Bs]}
end.
-%% unalias_pat(Pattern) -> Pattern.
-%% Remove all the aliases in a pattern but using the alias variables
-%% instead of the values. We KNOW they will be bound.
+%% pat_to_expr(Pattern) -> Expression.
+%% Convert a pattern to an expression if possible. We KNOW that
+%% all variables in the pattern will be bound.
+%%
+%% Throw an 'impossible' exception if a map or (non-literal)
+%% binary is encountered. Trying to use a map pattern as an
+%% expression is incorrect, while rebuilding a potentially
+%% huge binary in an expression would be wasteful.
-unalias_pat(P) ->
- case cerl:is_c_alias(P) of
- true ->
+pat_to_expr(P) ->
+ case cerl:type(P) of
+ alias ->
cerl:alias_var(P);
- false ->
+ var ->
+ P;
+ _ ->
case cerl:is_data(P) of
false ->
- P;
+ %% Map or binary.
+ throw(impossible);
true ->
- Es = unalias_pat_list(cerl:data_es(P)),
+ Es = pat_to_expr_list(cerl:data_es(P)),
cerl:update_data(P, cerl:data_type(P), Es)
end
end.
-unalias_pat_list(Ps) -> [unalias_pat(P) || P <- Ps].
+pat_to_expr_list(Ps) -> [pat_to_expr(P) || P <- Ps].
make_vars(A, Max) ->
make_vars(A, 1, Max).
@@ -2248,23 +2283,23 @@ letify(#c_var{name=Vname}=Var, Val, Body) ->
%% opt_case_in_let(LetExpr) -> LetExpr'
-opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let) ->
- opt_case_in_let_0(Vs, Arg, B, Let).
+opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) ->
+ opt_case_in_let_0(Vs, Arg, B, Let, Sub).
opt_case_in_let_0([#c_var{name=V}], Arg,
- #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let) ->
+ #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) ->
case opt_case_in_let_1(V, Arg, Cs) of
impossible ->
case is_simple_case_arg(Arg) andalso
not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of
true ->
- expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new());
+ expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub));
false ->
Let
end;
Expr -> Expr
end;
-opt_case_in_let_0(_, _, _, Let) -> Let.
+opt_case_in_let_0(_, _, _, Let, _) -> Let.
opt_case_in_let_1(V, Arg, Cs) ->
try
@@ -2607,7 +2642,7 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body0, effect, Sub) ->
expr(#c_seq{arg=Arg,body=Body}, effect, sub_new_preserve_types(Sub));
true ->
Let = Let0#c_let{vars=Vs,arg=Arg,body=Body},
- opt_case_in_let_arg(opt_case_in_let(Let), effect, Sub)
+ opt_case_in_let_arg(opt_case_in_let(Let, Sub), effect, Sub)
end
end;
opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) ->
@@ -2630,7 +2665,7 @@ opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) ->
expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub));
{Vs,Arg,Body} ->
opt_case_in_let_arg(
- opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}),
+ opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}, Sub),
value, Sub)
end.
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 8c18f6a9f7..59ec0d4199 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2014. 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
@@ -82,6 +82,8 @@
-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.
@@ -501,7 +503,7 @@ expr({cons,L,H0,T0}, St0) ->
{H1,Hps,St1} = safe(H0, St0),
{T1,Tps,St2} = safe(T0, St1),
A = lineno_anno(L, St2),
- {ann_c_cons(A, H1, T1),Hps ++ Tps,St2};
+ {annotate_cons(A, H1, T1, St2),Hps ++ Tps,St2};
expr({lc,L,E,Qs0}, St0) ->
{Qs1,St1} = preprocess_quals(L, Qs0, St0),
lc_tq(L, E, Qs1, #c_literal{anno=lineno_anno(L, St1),val=[]}, St1);
@@ -509,8 +511,8 @@ expr({bc,L,E,Qs}, St) ->
bc_tq(L, E, Qs, {nil,L}, St);
expr({tuple,L,Es0}, St0) ->
{Es1,Eps,St1} = safe_list(Es0, St0),
- A = lineno_anno(L, St1),
- {ann_c_tuple(A, Es1),Eps,St1};
+ A = record_anno(L, St1),
+ {annotate_tuple(A, Es1, St1),Eps,St1};
expr({map,L,Es0}, St0) ->
% erl_lint should make sure only #{ K => V } are allowed
% in map construction.
@@ -645,8 +647,8 @@ expr({'fun',L,{clauses,Cs},Id}, St) ->
fun_tq(Id, Cs, L, St, unnamed);
expr({named_fun,L,'_',Cs,Id}, St) ->
fun_tq(Id, Cs, L, St, unnamed);
-expr({named_fun,L,Name,Cs,{Index,Uniq,_Fname}}, St) ->
- fun_tq({Index,Uniq,Name}, Cs, L, St, {named, Name});
+expr({named_fun,L,Name,Cs,Id}, St) ->
+ fun_tq(Id, Cs, L, St, {named,Name});
expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) ->
{[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0),
Lanno = lineno_anno(L, St1),
@@ -784,23 +786,42 @@ is_valid_map_src(_) -> false.
map_pair_list(Es, St) ->
foldr(fun
({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) ->
- {K,Ep0,St1} = safe(K0, St0),
- ok = ensure_valid_map_key(K),
+ {K1,Ep0,St1} = safe(K0, St0),
+ K = ensure_valid_map_key(K1),
{V,Ep1,St2} = safe(V0, St1),
A = lineno_anno(L, St2),
Pair = #c_map_pair{op=#c_literal{val=assoc},anno=A,key=K,val=V},
{[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2};
({map_field_exact,L,K0,V0}, {Ces,Esp,St0}) ->
- {K,Ep0,St1} = safe(K0, St0),
- ok = ensure_valid_map_key(K),
+ {K1,Ep0,St1} = safe(K0, St0),
+ K = ensure_valid_map_key(K1),
{V,Ep1,St2} = safe(V0, St1),
A = lineno_anno(L, St2),
Pair = #c_map_pair{op=#c_literal{val=exact},anno=A,key=K,val=V},
{[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2}
end, {[],[],St}, Es).
-ensure_valid_map_key(#c_literal{}) -> ok;
-ensure_valid_map_key(_) -> throw({bad_map,bad_map_key}).
+ensure_valid_map_key(K0) ->
+ case coalesced_map_key(K0) of
+ {ok,K1} -> K1;
+ error -> throw({bad_map,bad_map_key})
+ end.
+
+coalesced_map_key(#c_literal{}=K) -> {ok,K};
+%% Dialyzer hack redux
+%% DO coalesce tuples and list in maps for dialyzer
+%% Dialyzer tries to break this apart, don't let it
+coalesced_map_key(#c_tuple{}=K) ->
+ case core_lib:is_literal(K) of
+ true -> {ok,cerl:fold_literal(K)};
+ false -> error
+ end;
+coalesced_map_key(#c_cons{}=K) ->
+ case core_lib:is_literal(K) of
+ true -> {ok,cerl:fold_literal(K)};
+ false -> error
+ end;
+coalesced_map_key(_) -> error.
%% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}.
@@ -1557,9 +1578,9 @@ pattern({atom,L,A}, St) -> #c_literal{anno=lineno_anno(L, St),val=A};
pattern({string,L,S}, St) -> #c_literal{anno=lineno_anno(L, St),val=S};
pattern({nil,L}, St) -> #c_literal{anno=lineno_anno(L, St),val=[]};
pattern({cons,L,H,T}, St) ->
- ann_c_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St));
+ annotate_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St), St);
pattern({tuple,L,Ps}, St) ->
- ann_c_tuple(lineno_anno(L, St), pattern_list(Ps, St));
+ annotate_tuple(record_anno(L, St), pattern_list(Ps, St), St);
pattern({map,L,Ps}, St) ->
#c_map{anno=lineno_anno(L, St), es=pattern_map_pairs(Ps, St)};
pattern({bin,L,Ps}, St) ->
@@ -1604,17 +1625,23 @@ pattern_alias_map_pair_patterns([Cv]) -> Cv;
pattern_alias_map_pair_patterns([Cv1,Cv2|Cvs]) ->
pattern_alias_map_pair_patterns([pat_alias(Cv1,Cv2)|Cvs]).
-pattern_map_pair({map_field_exact,L,K,V}, St) ->
+pattern_map_pair({map_field_exact,L,K,V},St) ->
+ #c_map_pair{anno=lineno_anno(L, St),
+ op=#c_literal{val=exact},
+ key=pattern_map_key(K,St),
+ val=pattern(V, St)}.
+
+pattern_map_key(K,St) ->
+ %% Throws 'nomatch' if the key can't be a literal
+ %% this will be a cryptic error message but it is better than nothing
case expr(K,St) of
- {#c_literal{}=Key,_,_} ->
- #c_map_pair{anno=lineno_anno(L, St),
- op=#c_literal{val=exact},
- key=Key,
- val=pattern(V, St)};
- _ ->
- %% this will throw a cryptic error message
- %% but it is better than nothing
- throw(nomatch)
+ {Key0,[],_} ->
+ %% Dialyzer hack redux
+ case coalesced_map_key(Key0) of
+ {ok,Key1} -> Key1;
+ error -> throw(nomatch)
+ end;
+ _ -> throw(nomatch)
end.
%% pat_bin([BinElement], State) -> [BinSeg].
@@ -1721,6 +1748,26 @@ fail_clause(Pats, Anno, Arg) ->
body=[#iprimop{anno=#a{anno=Anno},name=#c_literal{val=match_fail},
args=[Arg]}]}.
+annotate_tuple(A, Es, St) ->
+ case member(dialyzer, St#core.opts) of
+ true ->
+ %% Do not coalesce constant tuple elements. A Hack.
+ Node = cerl:ann_c_tuple(A, [cerl:c_var(any)]),
+ cerl:update_c_tuple_skel(Node, Es);
+ false ->
+ ann_c_tuple(A, Es)
+ end.
+
+annotate_cons(A, H, T, St) ->
+ case member(dialyzer, St#core.opts) of
+ true ->
+ %% Do not coalesce constant conses. A Hack.
+ Node= cerl:ann_c_cons(A, cerl:c_var(any), cerl:c_var(any)),
+ cerl:update_c_cons_skel(Node, H, T);
+ false ->
+ ann_c_cons(A, H, T)
+ end.
+
ubody(B, St) -> uexpr(B, [], St).
%% uclauses([Lclause], [KnownVar], State) -> {[Lclause],State}.
@@ -2238,6 +2285,23 @@ 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 ->
+ lineno_anno(L, St)
+ end;
+record_anno(L, St) when L < -?REC_OFFSET ->
+ case member(dialyzer, St#core.opts) of
+ true ->
+ [record | lineno_anno(L + ?REC_OFFSET, St)];
+ false ->
+ lineno_anno(L, St)
+ end;
+record_anno(L, St) ->
+ lineno_anno(L, St).
+
lineno_anno(L, St) ->
{line, Line} = erl_parse:get_attribute(L, line),
if
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-28 13:17:16 +0000