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.erl29
-rw-r--r--lib/compiler/src/beam_disasm.erl9
-rw-r--r--lib/compiler/src/beam_jump.erl2
-rw-r--r--lib/compiler/src/beam_utils.erl2
-rw-r--r--lib/compiler/src/cerl.erl94
-rw-r--r--lib/compiler/src/cerl_clauses.erl23
-rw-r--r--lib/compiler/src/cerl_inline.erl25
-rw-r--r--lib/compiler/src/cerl_trees.erl8
-rw-r--r--lib/compiler/src/compile.erl61
-rw-r--r--lib/compiler/src/compiler.app.src4
-rw-r--r--lib/compiler/src/core_lib.erl2
-rw-r--r--lib/compiler/src/core_lint.erl27
-rw-r--r--lib/compiler/src/core_parse.hrl20
-rw-r--r--lib/compiler/src/core_parse.yrl8
-rw-r--r--lib/compiler/src/core_pp.erl14
-rw-r--r--lib/compiler/src/erl_bifs.erl1
-rw-r--r--lib/compiler/src/sys_core_fold.erl83
-rw-r--r--lib/compiler/src/sys_pre_expand.erl7
-rw-r--r--lib/compiler/src/v3_codegen.erl6
-rw-r--r--lib/compiler/src/v3_core.erl199
-rw-r--r--lib/compiler/src/v3_kernel.erl39
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl18
-rw-r--r--lib/compiler/src/v3_life.erl3
23 files changed, 499 insertions, 185 deletions
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
index 124abd13c1..5a4621dc37 100644
--- a/lib/compiler/src/beam_bool.erl
+++ b/lib/compiler/src/beam_bool.erl
@@ -318,6 +318,8 @@ split_block_label_used([{set,[_],_,{bif,_,{f,Fail}}}|_], Fail) ->
true;
split_block_label_used([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}|_], Fail) ->
true;
+split_block_label_used([{set,[_],_,{alloc,_,{put_map,_,{f,Fail}}}}|_], Fail) ->
+ true;
split_block_label_used([_|Is], Fail) ->
split_block_label_used(Is, Fail);
split_block_label_used([], _) -> false.
@@ -391,10 +393,14 @@ bopt_tree([{set,_,_,{bif,'xor',_}}|_], _, _) ->
throw('xor');
bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) ->
ProtForest0 = gb_trees:from_orddict([P || {_,any}=P <- gb_trees:to_list(Forest0)]),
- {ProtPre,[{_,ProtTree}]} = bopt_tree(Code, ProtForest0, []),
- Prot = {prot,ProtPre,ProtTree},
- Forest = gb_trees:enter(Dst, Prot, Forest0),
- bopt_tree(Is, Forest, Pre);
+ case bopt_tree(Code, ProtForest0, []) of
+ {ProtPre,[{_,ProtTree}]} ->
+ Prot = {prot,ProtPre,ProtTree},
+ Forest = gb_trees:enter(Dst, Prot, Forest0),
+ bopt_tree(Is, Forest, Pre);
+ _Res ->
+ throw(not_boolean_expr)
+ end;
bopt_tree([{set,[Dst],[Src],move}=Move|Is], Forest, Pre) ->
case {Src,Dst} of
{{tmp,_},_} -> throw(move);
@@ -432,9 +438,10 @@ bopt_bool_args(As, Forest) ->
mapfoldl(fun bopt_bool_arg/2, Forest, As).
bopt_bool_arg({T,_}=R, Forest) when T =:= x; T =:= y; T =:= tmp ->
- Val = case gb_trees:get(R, Forest) of
- any -> {test,is_eq_exact,fail,[R,{atom,true}]};
- Val0 -> Val0
+ Val = case gb_trees:lookup(R, Forest) of
+ {value,any} -> {test,is_eq_exact,fail,[R,{atom,true}]};
+ {value,Val0} -> Val0;
+ none -> throw(mixed)
end,
{Val,gb_trees:delete(R, Forest)};
bopt_bool_arg(Term, Forest) ->
@@ -525,7 +532,9 @@ bopt_cg({prot,Pre0,Tree}, Fail, Rs0, Acc, St0) ->
bopt_cg({atom,true}, _Fail, _Rs, Acc, St) ->
{Acc,St};
bopt_cg({atom,false}, Fail, _Rs, Acc, St) ->
- {[{jump,{f,Fail}}|Acc],St}.
+ {[{jump,{f,Fail}}|Acc],St};
+bopt_cg(_, _, _, _, _) ->
+ throw(not_boolean_expr).
bopt_cg_not({'and',As0}) ->
As = [bopt_cg_not(A) || A <- As0],
@@ -538,7 +547,9 @@ bopt_cg_not({'not',Arg}) ->
bopt_cg_not({test,Test,Fail,As}) ->
{inverted_test,Test,Fail,As};
bopt_cg_not({atom,Bool}) when is_boolean(Bool) ->
- {atom,not Bool}.
+ {atom,not Bool};
+bopt_cg_not(_) ->
+ throw(not_boolean_expr).
bopt_cg_not_not({'and',As}) ->
{'and',[bopt_cg_not_not(A) || A <- As]};
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index 4bdfe4e0c2..c45596f236 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1030,6 +1030,7 @@ resolve_inst({gc_bif2,Args},Imports,_,_) ->
[F,Live,Bif,A1,A2,Reg] = resolve_args(Args),
{extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports),
{gc_bif,BifName,F,Live,[A1,A2],Reg};
+
%%
%% New instruction in R14, gc_bif with 3 arguments
%%
@@ -1146,21 +1147,17 @@ resolve_inst({put_map_assoc,Args},_,_,_) ->
[FLbl,Src,Dst,{u,N},{{z,1},{u,_Len},List0}] = Args,
List = resolve_args(List0),
{put_map_assoc,FLbl,Src,Dst,N,{list,List}};
-
resolve_inst({put_map_exact,Args},_,_,_) ->
[FLbl,Src,Dst,{u,N},{{z,1},{u,_Len},List0}] = Args,
List = resolve_args(List0),
{put_map_exact,FLbl,Src,Dst,N,{list,List}};
-
-resolve_inst({is_map,Args0},_,_,_) ->
+resolve_inst({is_map=I,Args0},_,_,_) ->
[FLbl|Args] = resolve_args(Args0),
- {test, is_map, FLbl, Args};
-
+ {test,I,FLbl,Args};
resolve_inst({has_map_fields,Args0},_,_,_) ->
[FLbl,Src,{{z,1},{u,_Len},List0}] = Args0,
List = resolve_args(List0),
{test,has_map_fields,FLbl,Src,{list,List}};
-
resolve_inst({get_map_elements,Args0},_,_,_) ->
[FLbl,Src,{{z,1},{u,_Len},List0}] = Args0,
List = resolve_args(List0),
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 0fc8d45c80..b952139f2c 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -446,11 +446,13 @@ is_label_used_in_2({set,_,_,Info}, Lbl) ->
case Info of
{bif,_,{f,F}} -> F =:= Lbl;
{alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl;
+ {alloc,_,{put_map,_,{f,F}}} -> F =:= Lbl;
{'catch',{f,F}} -> F =:= Lbl;
{alloc,_,_} -> false;
{put_tuple,_} -> false;
{get_tuple_element,_} -> false;
{set_tuple_element,_} -> false;
+ {get_map_elements,{f,F}} -> F =:= Lbl;
{line,_} -> false;
_ when is_atom(Info) -> false
end.
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 27034aecce..8ca368c167 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -748,6 +748,8 @@ live_opt([{try_end,_}=I|Is], Regs, D, Acc) ->
live_opt(Is, Regs, D, [I|Acc]);
live_opt([{loop_rec_end,_}=I|Is], Regs, D, Acc) ->
live_opt(Is, Regs, D, [I|Acc]);
+live_opt([{wait_timeout,_,nil}=I|Is], Regs, D, Acc) ->
+ live_opt(Is, Regs, D, [I|Acc]);
live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x ->
live_opt(Is, Regs, D, [I|Acc]);
live_opt([{line,_}=I|Is], Regs, D, Acc) ->
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 3c121f3b04..ed11c8de4d 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -124,21 +124,17 @@
%% keep map exports here for now
map_es/1,
- map_val/1,
+ map_arg/1,
update_c_map/3,
- ann_c_map/3,
+ ann_c_map/2, ann_c_map/3,
map_pair_op/1,map_pair_key/1,map_pair_val/1,
update_c_map_pair/4,
ann_c_map_pair/4
]).
--export_type([c_binary/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, c_literal/0,
- c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]).
-
-%%
-%% needed by the include file below -- do not move
-%%
--type var_name() :: integer() | atom() | {atom(), integer()}.
+-export_type([c_binary/0, c_bitstr/0, c_call/0, c_clause/0, c_cons/0, c_fun/0,
+ c_literal/0, c_map_pair/0, c_module/0, c_tuple/0,
+ c_values/0, c_var/0, cerl/0, var_name/0]).
-include("core_parse.hrl").
@@ -173,6 +169,8 @@
| c_module() | c_primop() | c_receive() | c_seq()
| c_try() | c_tuple() | c_values() | c_var().
+-type var_name() :: integer() | atom() | {atom(), integer()}.
+
%% =====================================================================
%% Representation (general)
%%
@@ -204,13 +202,15 @@
%% <td>call</td>
%% <td>case</td>
%% <td>catch</td>
-%% </tr><tr>
%% <td>clause</td>
+%% </tr><tr>
%% <td>cons</td>
%% <td>fun</td>
%% <td>let</td>
%% <td>letrec</td>
%% <td>literal</td>
+%% <td>map</td>
+%% <td>map_pair</td>
%% <td>module</td>
%% </tr><tr>
%% <td>primop</td>
@@ -261,10 +261,10 @@
%% @see subtrees/1
%% @see meta/1
--type ctype() :: 'alias' | 'apply' | 'binary' | 'bitrst' | 'call' | 'case'
- | 'catch' | 'clause' | 'cons' | 'fun' | 'let' | 'letrec'
- | 'literal' | 'map' | 'module' | 'primop' | 'receive' | 'seq'
- | 'try' | 'tuple' | 'values' | 'var'.
+-type ctype() :: 'alias' | 'apply' | 'binary' | 'bitrst' | 'call' | 'case'
+ | 'catch' | 'clause' | 'cons' | 'fun' | 'let' | 'letrec'
+ | 'literal' | 'map' | 'map_pair' | 'module' | 'primop'
+ | 'receive' | 'seq' | 'try' | 'tuple' | 'values' | 'var'.
-spec type(cerl()) -> ctype().
@@ -1575,20 +1575,70 @@ ann_make_list(_, [], Node) ->
%% ---------------------------------------------------------------------
%% maps
--spec map_es(c_map()) -> [cerl()].
+-spec map_es(c_map()) -> [c_map_pair()].
map_es(#c_map{es = Es}) ->
Es.
--spec map_val(c_map()) -> cerl().
-map_val(#c_map{var = M}) ->
+-spec map_arg(c_map()) -> c_map() | c_literal().
+
+map_arg(#c_map{arg = M}) ->
M.
+-spec ann_c_map([term()], [cerl()]) -> c_map() | c_literal().
+
+ann_c_map(As,Es) ->
+ ann_c_map(As, #c_literal{val=#{}}, Es).
+
+-spec ann_c_map([term()], c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal().
+
+ann_c_map(As,#c_literal{val=Mval}=M,Es) when is_map(Mval), map_size(Mval) =:= 0 ->
+ Pairs = [[Ck,Cv]||#c_map_pair{key=Ck,val=Cv}<-Es],
+ IsLit = lists:foldl(fun(Pair,Res) ->
+ Res andalso is_lit_list(Pair)
+ end, true, Pairs),
+ Fun = fun(Pair) -> [K,V] = lit_list_vals(Pair), {K,V} end,
+ case IsLit of
+ false ->
+ #c_map{arg=M, es=Es, anno=As };
+ true ->
+ #c_literal{anno=As, val=maps:from_list(lists:map(Fun, Pairs))}
+ end;
+ann_c_map(As,#c_literal{val=M},Es) when is_map(M) ->
+ fold_map_pairs(As,Es,M);
ann_c_map(As,M,Es) ->
- #c_map{var=M,es = Es, anno = As }.
+ #c_map{arg=M, es=Es, anno=As }.
+
+fold_map_pairs(As,[],M) -> #c_literal{anno=As,val=M};
+%% M#{ K => V}
+fold_map_pairs(As,[#c_map_pair{op=#c_literal{val=assoc},key=Ck,val=Cv}=E|Es],M) ->
+ case is_lit_list([Ck,Cv]) of
+ true ->
+ [K,V] = lit_list_vals([Ck,Cv]),
+ fold_map_pairs(As,Es,maps:put(K,V,M));
+ false ->
+ #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As }
+ end;
+%% M#{ K := V}
+fold_map_pairs(As,[#c_map_pair{op=#c_literal{val=exact},key=Ck,val=Cv}=E|Es],M) ->
+ case is_lit_list([Ck,Cv]) of
+ true ->
+ [K,V] = lit_list_vals([Ck,Cv]),
+ case maps:is_key(K,M) of
+ true -> fold_map_pairs(As,Es,maps:put(K,V,M));
+ false ->
+ #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As }
+ end;
+ false ->
+ #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As }
+ end;
+fold_map_pairs(As,Es,M) ->
+ #c_map{arg=#c_literal{val=M,anno=As}, es=Es, anno=As }.
+
+%-spec update_c_map(c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal().
update_c_map(Old,M,Es) ->
- #c_map{var=M, es = Es, anno = get_ann(Old)}.
+ #c_map{arg=M, es = Es, anno = get_ann(Old)}.
map_pair_key(#c_map_pair{key=K}) -> K.
map_pair_val(#c_map_pair{val=V}) -> V.
@@ -4324,12 +4374,8 @@ meta_1(cons, Node) ->
%% we get exactly one element, we generate a 'c_cons' call
%% instead of 'make_list' to reconstruct the node.
case split_list(Node) of
- {[H], none} ->
- meta_call(c_cons, [meta(H), meta(c_nil())]);
{[H], Node1} ->
meta_call(c_cons, [meta(H), meta(Node1)]);
- {L, none} ->
- meta_call(make_list, [make_list(meta_list(L))]);
{L, Node1} ->
meta_call(make_list,
[make_list(meta_list(L)), meta(Node1)])
@@ -4416,8 +4462,6 @@ split_list(Node, L) ->
case type(Node) of
cons when A =:= [] ->
split_list(cons_tl(Node), [cons_hd(Node) | L]);
- nil when A =:= [] ->
- {lists:reverse(L), none};
_ ->
{lists:reverse(L), Node}
end.
diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl
index 99fa8dd9d5..87bd47c08b 100644
--- a/lib/compiler/src/cerl_clauses.erl
+++ b/lib/compiler/src/cerl_clauses.erl
@@ -354,6 +354,29 @@ match(P, E, Bs) ->
{false, Bs}
end
end;
+ map ->
+ %% The most we can do is to say "definitely no match" if a
+ %% map pattern is matched against non-map data.
+ case E of
+ any ->
+ {false, Bs};
+ _ ->
+ case type(E) of
+ literal ->
+ case is_map(concrete(E)) of
+ false ->
+ none;
+ true ->
+ {false, Bs}
+ end;
+ cons ->
+ none;
+ tuple ->
+ none;
+ _ ->
+ {false, Bs}
+ end
+ end;
_ ->
match_1(P, E, Bs)
end.
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index 44293bb8ce..75740e8b9d 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -42,7 +42,7 @@
bitstr_flags/1, binary_segments/1, update_c_alias/3,
update_c_apply/3, update_c_binary/2, update_c_bitstr/6,
update_c_call/4, update_c_case/3, update_c_catch/2,
- update_c_clause/4, c_fun/2, c_int/1, c_let/3,
+ update_c_clause/4, c_fun/2, c_int/1, c_let/3, ann_c_let/4,
update_c_let/4, update_c_letrec/3, update_c_module/5,
update_c_primop/3, update_c_receive/4, update_c_seq/3,
c_seq/2, update_c_try/6, c_tuple/1, update_c_values/2,
@@ -51,7 +51,7 @@
catch_body/1, clause_body/1, clause_guard/1,
clause_pats/1, clause_vars/1, concrete/1, cons_hd/1,
cons_tl/1, data_arity/1, data_es/1, data_type/1,
- fun_body/1, fun_vars/1, get_ann/1, int_val/1,
+ fname_arity/1, fun_body/1, fun_vars/1, get_ann/1, int_val/1,
is_c_atom/1, is_c_cons/1, is_c_fname/1, is_c_int/1,
is_c_list/1, is_c_seq/1, is_c_tuple/1, is_c_var/1,
is_data/1, is_literal/1, is_literal_term/1, let_arg/1,
@@ -64,7 +64,7 @@
seq_body/1, set_ann/2, try_arg/1, try_body/1, try_vars/1,
try_evars/1, try_handler/1, tuple_es/1, tuple_arity/1,
type/1, values_es/1, var_name/1,
- map_val/1, map_es/1, update_c_map/3,
+ map_arg/1, map_es/1, update_c_map/3,
update_c_map_pair/4,
map_pair_op/1, map_pair_key/1, map_pair_val/1
]).
@@ -1030,8 +1030,17 @@ i_apply(E, Ctxt, Ren, Env, S) ->
visit_and_count_size(Opnd, S)
end,
S3, Opnds),
- N = apply_size(length(Es)),
- {update_c_apply(E, E1, Es), count_size(N, S4)}
+ Arity = length(Es),
+ E2 = case is_c_fname(E1) andalso length(Es) =/= fname_arity(E1) of
+ true ->
+ V = new_var(Env),
+ ann_c_let(get_ann(E), [V], E1,
+ update_c_apply(E, V, Es));
+ false ->
+ update_c_apply(E, E1, Es)
+ end,
+ N = apply_size(Arity),
+ {E2, count_size(N, S4)}
end.
apply_size(A) ->
@@ -1334,7 +1343,7 @@ i_bitstr(E, Ren, Env, S) ->
i_map(E, Ctx, Ren, Env, S) ->
%% Visit the segments for value.
- {M1, S1} = i(map_val(E), value, Ren, Env, S),
+ {M1, S1} = i(map_arg(E), value, Ren, Env, S),
{Es, S2} = mapfoldl(fun (E, S) ->
i_map_pair(E, Ctx, Ren, Env, S)
end, S1, map_es(E)),
@@ -1411,8 +1420,8 @@ i_pattern(E, Ren, Env, Ren0, Env0, S) ->
S2 = count_size(weight(binary), S1),
{update_c_binary(E, Es), S2};
map ->
- %% map patterns should not have vals
- M = map_val(E),
+ %% map patterns should not have args
+ M = map_arg(E),
{Es, S1} = mapfoldl(fun (E, S) ->
i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S)
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index 2ebeab243f..e53bdd4efb 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -57,7 +57,7 @@
update_c_try/6, update_c_tuple/2, update_c_tuple_skel/2,
update_c_values/2, values_es/1, var_name/1,
- map_val/1, map_es/1,
+ map_arg/1, map_es/1,
ann_c_map/3,
update_c_map/3,
map_pair_key/1,map_pair_val/1,map_pair_op/1,
@@ -138,7 +138,7 @@ map_1(F, T) ->
tuple ->
update_c_tuple_skel(T, map_list(F, tuple_es(T)));
map ->
- update_c_map(T, map(F,map_val(T)), map_list(F, map_es(T)));
+ update_c_map(T, map(F, map_arg(T)), map_list(F, map_es(T)));
map_pair ->
update_c_map_pair(T, map(F, map_pair_op(T)),
map(F, map_pair_key(T)),
@@ -372,7 +372,7 @@ mapfold(F, S0, T) ->
{Ts, S1} = mapfold_list(F, S0, tuple_es(T)),
F(update_c_tuple_skel(T, Ts), S1);
map ->
- {M , S1} = mapfold(F, S0, map_val(T)),
+ {M , S1} = mapfold(F, S0, map_arg(T)),
{Ts, S2} = mapfold_list(F, S1, map_es(T)),
F(update_c_map(T, M, Ts), S2);
map_pair ->
@@ -724,7 +724,7 @@ label(T, N, Env) ->
{As, N2} = label_ann(T, N1),
{ann_c_tuple_skel(As, Ts), N2};
map ->
- {M, N1} = label(map_val(T), N, Env),
+ {M, N1} = label(map_arg(T), N, Env),
{Ts, N2} = label_list(map_es(T), N1, Env),
{As, N3} = label_ann(T, N2),
{ann_c_map(As, M, Ts), N3};
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index b88f9792a5..c7d91070f6 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -234,7 +234,9 @@ format_error({crash,Pass,Reason}) ->
format_error({bad_return,Pass,Reason}) ->
io_lib:format("internal error in ~p;\nbad return value: ~ts", [Pass,format_error_reason(Reason)]);
format_error({module_name,Mod,Filename}) ->
- io_lib:format("Module name '~s' does not match file name '~ts'", [Mod,Filename]).
+ io_lib:format("Module name '~s' does not match file name '~ts'", [Mod,Filename]);
+format_error(reparsing_invalid_unicode) ->
+ "Non-UTF-8 character(s) detected, but no encoding declared. Encode the file in UTF-8 or add \"%% coding: latin-1\" at the beginning of the file. Retrying with latin-1 encoding.".
format_error_reason({Reason, Stack}) when is_list(Stack) ->
StackFun = fun
@@ -246,7 +248,7 @@ format_error_reason({Reason, Stack}) when is_list(Stack) ->
end,
FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end,
[io_lib:format("~tp", [Reason]),"\n\n",
- lib:format_stacktrace(1, erlang:get_stacktrace(), StackFun, FormatFun)];
+ lib:format_stacktrace(1, Stack, StackFun, FormatFun)];
format_error_reason(Reason) ->
io_lib:format("~tp", [Reason]).
@@ -792,20 +794,59 @@ no_native_compilation(BeamFile, #compile{options=Opts0}) ->
_ -> false
end.
-parse_module(St) ->
- Opts = St#compile.options,
- Cwd = ".",
- IncludePath = [Cwd, St#compile.dir|inc_paths(Opts)],
- R = epp:parse_file(St#compile.ifile, IncludePath, pre_defs(Opts)),
+parse_module(St0) ->
+ case do_parse_module(utf8, St0) of
+ {ok,_}=Ret ->
+ Ret;
+ {error,_}=Ret ->
+ Ret;
+ {invalid_unicode,File,Line} ->
+ case do_parse_module(latin1, St0) of
+ {ok,St} ->
+ Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}],
+ {ok,St#compile{warnings=Es++St#compile.warnings}};
+ {error,St} ->
+ Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}],
+ {error,St#compile{errors=Es++St#compile.errors}}
+ end
+ end.
+
+do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) ->
+ R = epp:parse_file(File,
+ [{includes,[".",Dir|inc_paths(Opts)]},
+ {macros,pre_defs(Opts)},
+ {default_encoding,DefEncoding},
+ extra]),
case R of
- {ok,Forms} ->
- Encoding = epp:read_encoding(St#compile.ifile),
- {ok,St#compile{code=Forms,encoding=Encoding}};
+ {ok,Forms,Extra} ->
+ Encoding = proplists:get_value(encoding, Extra),
+ case find_invalid_unicode(Forms, File) of
+ none ->
+ {ok,St#compile{code=Forms,encoding=Encoding}};
+ {invalid_unicode,_,_}=Ret ->
+ case Encoding of
+ none ->
+ Ret;
+ _ ->
+ {ok,St#compile{code=Forms,encoding=Encoding}}
+ end
+ end;
{error,E} ->
Es = [{St#compile.ifile,[{none,?MODULE,{epp,E}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}}
end.
+find_invalid_unicode([H|T], File0) ->
+ case H of
+ {attribute,_,file,{File,_}} ->
+ find_invalid_unicode(T, File);
+ {error,{Line,file_io_server,invalid_unicode}} ->
+ {invalid_unicode,File0,Line};
+ _Other ->
+ find_invalid_unicode(T, File0)
+ end;
+find_invalid_unicode([], _) -> none.
+
parse_core(St) ->
case file:read_file(St#compile.ifile) of
{ok,Bin} ->
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index 8775c84698..8f68915f8e 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -67,4 +67,6 @@
]},
{registered, []},
{applications, [kernel, stdlib]},
- {env, []}]}.
+ {env, []},
+ {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0",
+ "crypto-3.3"]}]}.
diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl
index ed181e3baa..93ec3bbad5 100644
--- a/lib/compiler/src/core_lib.erl
+++ b/lib/compiler/src/core_lib.erl
@@ -105,7 +105,7 @@ vu_expr(V, #c_cons{hd=H,tl=T}) ->
vu_expr(V, H) orelse vu_expr(V, T);
vu_expr(V, #c_tuple{es=Es}) ->
vu_expr_list(V, Es);
-vu_expr(V, #c_map{var=M,es=Es}) ->
+vu_expr(V, #c_map{arg=M,es=Es}) ->
vu_expr(V, M) orelse vu_expr_list(V, Es);
vu_expr(V, #c_map_pair{key=Key,val=Val}) ->
vu_expr_list(V, [Key,Val]);
diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl
index 36165245a6..25df33a287 100644
--- a/lib/compiler/src/core_lint.erl
+++ b/lib/compiler/src/core_lint.erl
@@ -267,10 +267,21 @@ gexpr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) ->
St1 = gbody(Arg, Def, let_varcount(Vs), St0), %This is a guard body
{Lvs,St2} = variable_list(Vs, St1),
gbody(B, union(Lvs, Def), Rt, St2);
-gexpr(#c_call{module=#c_literal{val=erlang},
- name=#c_literal{},
- args=As}, Def, 1, St) ->
- gexpr_list(As, Def, St);
+gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record},
+ args=[Arg,#c_literal{val=Tag},#c_literal{val=Size}]},
+ Def, 1, St) when is_atom(Tag), is_integer(Size) ->
+ gexpr(Arg, Def, 1, St);
+gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}},
+ _Def, 1, St) ->
+ add_error({illegal_guard,St#lint.func}, St);
+gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As},
+ Def, 1, St) when is_atom(Name) ->
+ case is_guard_bif(Name, length(As)) of
+ true ->
+ gexpr_list(As, Def, St);
+ false ->
+ add_error({illegal_guard,St#lint.func}, St)
+ end;
gexpr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) ->
gexpr_list(As, Def, St0);
gexpr(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X},
@@ -298,6 +309,14 @@ gbitstr_list(Es, Def, St0) ->
gbitstr(#c_bitstr{val=V,size=S}, Def, St) ->
gexpr_list([V,S], Def, St).
+%% is_guard_bif(Name, Arity) -> Boolean.
+
+is_guard_bif(Name, Arity) ->
+ erl_internal:guard_bif(Name, Arity)
+ orelse erl_internal:arith_op(Name, Arity)
+ orelse erl_internal:bool_op(Name, Arity)
+ orelse erl_internal:comp_op(Name, Arity).
+
%% expr(Expr, Defined, RetCount, State) -> State.
expr(#c_var{name={_,_}=FA}, Def, _Rt, St) ->
diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl
index d54715ef59..4a00535360 100644
--- a/lib/compiler/src/core_parse.hrl
+++ b/lib/compiler/src/core_parse.hrl
@@ -34,7 +34,7 @@
-record(c_apply, {anno=[], op, % op :: Tree,
args}). % args :: [Tree]
--record(c_binary, {anno=[], segments}). % segments :: [#c_bitstr{}]
+-record(c_binary, {anno=[], segments :: [cerl:c_bitstr()]}).
-record(c_bitstr, {anno=[], val, % val :: Tree,
size, % size :: Tree,
@@ -70,6 +70,15 @@
-record(c_literal, {anno=[], val}). % val :: literal()
+-record(c_map, {anno=[],
+ arg=#c_literal{val=#{}} :: cerl:c_var() | cerl:c_literal(),
+ es :: [cerl:c_map_pair()]}).
+
+-record(c_map_pair, {anno=[],
+ op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'},
+ key,
+ val}).
+
-record(c_module, {anno=[], name, % name :: Tree,
exports, % exports :: [Tree],
attrs, % attrs :: [#c_def{}],
@@ -96,12 +105,3 @@
-record(c_values, {anno=[], es}). % es :: [Tree]
-record(c_var, {anno=[], name :: cerl:var_name()}).
-
--record(c_map_pair, {anno=[],
- op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'},
- key,
- val}).
-
--record(c_map, {anno=[],
- var=#c_literal{val=[]} :: #c_var{} | #c_literal{},
- es :: [#c_map_pair{}]}).
diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl
index b8db0f683a..a66ad4235f 100644
--- a/lib/compiler/src/core_parse.yrl
+++ b/lib/compiler/src/core_parse.yrl
@@ -21,7 +21,7 @@
%% Have explicit productions for annotated phrases named anno_XXX.
%% This just does an XXX and adds the annotation.
-Expect 1.
+Expect 0.
Nonterminals
@@ -285,9 +285,9 @@ tuple -> '{' '}' : c_tuple([]).
tuple -> '{' anno_expressions '}' : c_tuple('$2').
map_expr -> '~' '{' '}' '~' : #c_map{es=[]}.
-map_expr -> '~' '{' map_pairs '}' '~' : #c_map{es='$3'}.
-map_expr -> variable '~' '{' '}' '~' : #c_map{var='$1',es=[]}.
-map_expr -> variable '~' '{' map_pairs '}' '~' : #c_map{var='$1',es='$4'}.
+map_expr -> '~' '{' map_pairs '}' '~' : #c_map{es='$3'}.
+map_expr -> '~' '{' map_pairs '|' variable '}' '~' : #c_map{arg='$5',es='$3'}.
+map_expr -> '~' '{' map_pairs '|' map_expr '}' '~' : #c_map{arg='$5',es='$3'}.
map_pairs -> map_pair : ['$1'].
map_pairs -> map_pair ',' map_pairs : ['$1' | '$3'].
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index faa26ec6df..a76327457d 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -118,6 +118,12 @@ format_1(#c_literal{val=Tuple}, Ctxt) when is_tuple(Tuple) ->
format_1(#c_literal{anno=A,val=Bitstring}, Ctxt) when is_bitstring(Bitstring) ->
Segs = segs_from_bitstring(Bitstring),
format_1(#c_binary{anno=A,segments=Segs}, Ctxt);
+format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) ->
+ Pairs = maps:to_list(M),
+ Cpairs = [#c_map_pair{op=#c_literal{val=assoc},
+ key=#c_literal{val=V},
+ val=#c_literal{val=K}} || {K,V} <- Pairs],
+ format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt);
format_1(#c_var{name={I,A}}, _) ->
[core_atom(I),$/,integer_to_list(A)];
format_1(#c_var{name=V}, _) ->
@@ -161,15 +167,15 @@ format_1(#c_tuple{es=Es}, Ctxt) ->
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
$}
];
-format_1(#c_map{var=#c_var{}=Var,es=Es}, Ctxt) ->
- [format_1(Var, Ctxt),
- "~{",
+format_1(#c_map{arg=#c_literal{val=M},es=Es}, Ctxt) when is_map(M),map_size(M)=:=0 ->
+ ["~{",
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
"}~"
];
-format_1(#c_map{es=Es}, Ctxt) ->
+format_1(#c_map{arg=Var,es=Es}, Ctxt) ->
["~{",
format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2),
+ "|",format(Var, add_indent(Ctxt, 1)),
"}~"
];
format_1(#c_map_pair{op=#c_literal{val=assoc},key=K,val=V}, Ctxt) ->
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index 3ad3c8c690..6c75538194 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -91,6 +91,7 @@ is_pure(erlang, is_float, 1) -> true;
is_pure(erlang, is_function, 1) -> true;
is_pure(erlang, is_integer, 1) -> true;
is_pure(erlang, is_list, 1) -> true;
+is_pure(erlang, is_map, 1) -> true;
is_pure(erlang, is_number, 1) -> true;
is_pure(erlang, is_pid, 1) -> true;
is_pure(erlang, is_port, 1) -> true;
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),
diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index 9998043013..91a46a20fe 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -331,9 +331,10 @@ expr({tuple,Line,Es0}, St0) ->
expr({map,Line,Es0}, St0) ->
{Es1,St1} = expr_list(Es0, St0),
{{map,Line,Es1},St1};
-expr({map,Line,Var,Es0}, St0) ->
- {Es1,St1} = expr_list(Es0, St0),
- {{map,Line,Var,Es1},St1};
+expr({map,Line,E0,Es0}, St0) ->
+ {E1,St1} = expr(E0, St0),
+ {Es1,St2} = expr_list(Es0, St1),
+ {{map,Line,E1,Es1},St2};
expr({map_field_assoc,Line,K0,V0}, St0) ->
{K,St1} = expr(K0, St0),
{V,St2} = expr(V0, St1),
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index e00ee1f3ad..47a357c23d 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -960,7 +960,6 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) ->
end, {{[],[]},Bef}, Vs),
Code = case {HasKs,GetVs} of
- {[],[]} -> {[],Aft,St};
{HasKs,[]} ->
[{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}];
{[],GetVs} ->
@@ -1551,7 +1550,10 @@ map_pair_strip_and_termsort(Es) ->
%% [{map_pair,K,V}]
%% where K is for example {integer, 1} and we want to sort on 1.
Ls = [{K,V}||{_,K,V}<-Es],
- lists:sort(fun({{_,A},_},{{_,B},_}) -> erts_internal:cmp_term(A,B) < 0 end, Ls).
+ lists:sort(fun ({{_,A},_}, {{_,B},_}) -> erts_internal:cmp_term(A,B) =< 0;
+ ({nil,_}, {{_,B},_}) -> [] =< B;
+ ({{_,A},_}, {nil,_}) -> A =< []
+ end, Ls).
%%%
%%% Code generation for constructing binaries.
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index a50b46bd7b..a548ba2f7c 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -77,7 +77,8 @@
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_cons_skel/3,ann_c_tuple/2,c_tuple/1,
+ ann_c_map/2, ann_c_map/3]).
-include("core_parse.hrl").
@@ -274,51 +275,67 @@ gexpr({op,L,'orelse',E1,E2}, Bools, St0) ->
True = {atom,L,true},
E = make_bool_switch_guard(L, E1, V, True, E2),
gexpr(E, Bools, St);
-gexpr({op,Line,Op,L,R}=Call, Bools0, St0) ->
+gexpr({op,Line,Op,L,R}=E, Bools, St) ->
case erl_internal:bool_op(Op, 2) of
- true ->
- {Le,Lps,Bools1,St1} = gexpr(L, Bools0, St0),
- {Ll,Llps,St2} = force_safe(Le, St1),
- {Re,Rps,Bools,St3} = gexpr(R, Bools1, St2),
- {Rl,Rlps,St4} = force_safe(Re, St3),
- Anno = lineno_anno(Line, St4),
- {#icall{anno=#a{anno=Anno}, %Must have an #a{}
- module=#c_literal{anno=Anno,val=erlang},
- name=#c_literal{anno=Anno,val=Op},
- args=[Ll,Rl]},Lps ++ Llps ++ Rps ++ Rlps,Bools,St4};
- false ->
- gexpr_test(Call, Bools0, St0)
+ true ->
+ gexpr_bool(Op, L, R, Bools, St, Line);
+ false ->
+ gexpr_test(E, Bools, St)
end;
-gexpr({op,Line,Op,A}=Call, Bools0, St0) ->
- case Op of
- 'not' ->
- {Ae0,Aps,Bools,St1} = gexpr(A, Bools0, St0),
- case Ae0 of
- #icall{module=#c_literal{val=erlang},
- name=#c_literal{val='=:='},
- args=[E,#c_literal{val=true}]}=EqCall ->
- %%
- %% Doing the following transformation
- %% not(Expr =:= true) ==> Expr =:= false
- %% will help eliminating redundant is_boolean/1 tests.
- %%
- Ae = EqCall#icall{args=[E,#c_literal{val=false}]},
- {Al,Alps,St2} = force_safe(Ae, St1),
- {Al,Aps ++ Alps,Bools,St2};
- Ae ->
- {Al,Alps,St2} = force_safe(Ae, St1),
- Anno = lineno_anno(Line, St2),
- {#icall{anno=#a{anno=Anno}, %Must have an #a{}
- module=#c_literal{anno=Anno,val=erlang},
- name=#c_literal{anno=Anno,val=Op},
- args=[Al]},Aps ++ Alps,Bools,St2}
- end;
- _ ->
- gexpr_test(Call, Bools0, St0)
+gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,Op}},[L,R]}=E, Bools, St) ->
+ case erl_internal:bool_op(Op, 2) of
+ true ->
+ gexpr_bool(Op, L, R, Bools, St, Line);
+ false ->
+ gexpr_test(E, Bools, St)
end;
+gexpr({op,Line,'not',A}, Bools, St) ->
+ gexpr_not(A, Bools, St, Line);
+gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,'not'}},[A]}, Bools, St) ->
+ gexpr_not(A, Bools, St, Line);
gexpr(E0, Bools, St0) ->
gexpr_test(E0, Bools, St0).
+%% gexpr_not(L, R, Bools, State) -> {Cexpr,[PreExp],Bools,State}.
+%% Generate a guard for boolean operators
+
+gexpr_bool(Op, L, R, Bools0, St0, Line) ->
+ {Le,Lps,Bools1,St1} = gexpr(L, Bools0, St0),
+ {Ll,Llps,St2} = force_safe(Le, St1),
+ {Re,Rps,Bools,St3} = gexpr(R, Bools1, St2),
+ {Rl,Rlps,St4} = force_safe(Re, St3),
+ Anno = lineno_anno(Line, St4),
+ {#icall{anno=#a{anno=Anno}, %Must have an #a{}
+ module=#c_literal{anno=Anno,val=erlang},
+ name=#c_literal{anno=Anno,val=Op},
+ args=[Ll,Rl]},Lps ++ Llps ++ Rps ++ Rlps,Bools,St4}.
+
+%% gexpr_not(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}.
+%% Generate an erlang:'not'/1 guard test.
+
+gexpr_not(A, Bools0, St0, Line) ->
+ {Ae0,Aps,Bools,St1} = gexpr(A, Bools0, St0),
+ case Ae0 of
+ #icall{module=#c_literal{val=erlang},
+ name=#c_literal{val='=:='},
+ args=[E,#c_literal{val=true}]}=EqCall ->
+ %%
+ %% Doing the following transformation
+ %% not(Expr =:= true) ==> Expr =:= false
+ %% will help eliminating redundant is_boolean/1 tests.
+ %%
+ Ae = EqCall#icall{args=[E,#c_literal{val=false}]},
+ {Al,Alps,St2} = force_safe(Ae, St1),
+ {Al,Aps ++ Alps,Bools,St2};
+ Ae ->
+ {Al,Alps,St2} = force_safe(Ae, St1),
+ Anno = lineno_anno(Line, St2),
+ {#icall{anno=#a{anno=Anno}, %Must have an #a{}
+ module=#c_literal{anno=Anno,val=erlang},
+ name=#c_literal{anno=Anno,val='not'},
+ args=[Al]},Aps ++ Alps,Bools,St2}
+ end.
+
%% gexpr_test(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}.
%% Generate a guard test. At this stage we must be sure that we have
%% a proper boolean value here so wrap things with an true test if we
@@ -335,7 +352,8 @@ gexpr_test(E0, Bools0, St0) ->
#icall{anno=Anno,module=#c_literal{val=erlang},name=#c_literal{val=N},args=As} ->
Ar = length(As),
case erl_internal:type_test(N, Ar) orelse
- erl_internal:comp_op(N, Ar) of
+ erl_internal:comp_op(N, Ar) orelse
+ erl_internal:bool_op(N, Ar) of
true -> {E1,Eps0,Bools0,St1};
false ->
Lanno = Anno#a.anno,
@@ -496,14 +514,33 @@ expr({tuple,L,Es0}, St0) ->
expr({map,L,Es0}, St0) ->
% erl_lint should make sure only #{ K => V } are allowed
% in map construction.
- {Es1,Eps,St1} = map_pair_list(Es0, St0),
- A = lineno_anno(L, St1),
- {#c_map{anno=A,es=Es1},Eps,St1};
+ try map_pair_list(Es0, St0) of
+ {Es1,Eps,St1} ->
+ A = lineno_anno(L, St1),
+ {ann_c_map(A,Es1),Eps,St1}
+ 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,M0,Es0}, St0) ->
- {M1,Mps,St1} = safe(M0, St0),
- {Es1,Eps,St2} = map_pair_list(Es0, St1),
- A = lineno_anno(L, St2),
- {#c_map{anno=A,var=M1,es=Es1},Mps++Eps,St2};
+ 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({bin,L,Es0}, St0) ->
try expr_bin(Es0, lineno_anno(L, St0), St0) of
{_,_,_}=Res -> Res
@@ -623,7 +660,7 @@ expr({call,Lc,{atom,Lf,F},As0}, St0) ->
Op = #c_var{anno=lineno_anno(Lf, St1),name={F,length(As1)}},
{#iapply{anno=#a{anno=lineno_anno(Lc, St1)},op=Op,args=As1},Aps,St1};
expr({call,L,FunExp,As0}, St0) ->
- {Fun,Fps,St1} = safe(FunExp, St0),
+ {Fun,Fps,St1} = safe_fun(length(As0), FunExp, St0),
{As1,Aps,St2} = safe_list(As0, St1),
Lanno = lineno_anno(L, St2),
{#iapply{anno=#a{anno=Lanno},op=Fun,args=As1},Fps ++ Aps,St2};
@@ -713,22 +750,58 @@ make_bool_switch_guard(L, E, V, T, F) ->
{clause,NegL,[V],[],[V]}
]}.
+expr_map(M0,Es0,A,St0) ->
+ {M1,Mps,St1} = safe(M0, St0),
+ 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},
+ 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};
+ {_,_} ->
+ {Es1,Eps,St2} = map_pair_list(Es0, St1),
+ {ann_c_map(A,M1,Es1),Mps++Eps,St2}
+ end;
+ false -> throw({bad_map,bad_map})
+ end.
+
+is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true;
+is_valid_map_src(#c_map{}) -> true;
+is_valid_map_src(#c_var{}) -> true;
+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),
{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),
{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}).
+
%% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}.
try_exception(Ecs0, St0) ->
@@ -1408,6 +1481,15 @@ safe(E0, St0) ->
{Se,Sps,St2} = force_safe(E1, St1),
{Se,Eps ++ Sps,St2}.
+safe_fun(A0, E0, St0) ->
+ case safe(E0, St0) of
+ {#c_var{name={_,A1}}=E1,Eps,St1} when A1 =/= A0 ->
+ {V,St2} = new_var(St1),
+ {V,Eps ++ [#iset{var=V,arg=E1}],St2};
+ Result ->
+ Result
+ end.
+
safe_list(Es, St) ->
foldr(fun (E, {Ces,Esp,St0}) ->
{Ce,Ep,St1} = safe(E, St0),
@@ -1529,7 +1611,9 @@ pattern_map_pair({map_field_exact,L,K,V}, St) ->
{bin,L,Es0} ->
case constant_bin(Es0) of
error ->
- throw(badmatch);
+ %% this will throw a cryptic error message
+ %% but it is better than nothing
+ throw(nomatch);
Bin ->
#c_literal{anno=lineno_anno(L,St),val=Bin}
end;
@@ -1756,13 +1840,16 @@ uexpr(#iletrec{anno=A,defs=Fs0,body=B0}, Ks, St0) ->
{B1,St2} = uexprs(B0, Ks, St1),
Used = used_in_any(map(fun ({_,F}) -> F end, Fs1) ++ B1),
{#iletrec{anno=A#a{us=Used,ns=[]},defs=Fs1,body=B1},St2};
-uexpr(#icase{anno=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) ->
+uexpr(#icase{anno=#a{anno=Anno}=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) ->
%% As0 will never generate new variables.
{As1,St1} = uexpr_list(As0, Ks, St0),
{Cs1,St2} = uclauses(Cs0, Ks, St1),
{Fc1,St3} = uclause(Fc0, Ks, St2),
Used = union(used_in_any(As1), used_in_any(Cs1)),
- New = new_in_all(Cs1),
+ New = case member(list_comprehension, Anno) of
+ true -> [];
+ false -> new_in_all(Cs1)
+ end,
{#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3};
uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}, Ks0, St0) ->
Avs = lit_list_vars(As),
@@ -2137,6 +2224,8 @@ lit_vars(Lit) -> lit_vars(Lit, []).
lit_vars(#c_cons{hd=H,tl=T}, Vs) -> lit_vars(H, lit_vars(T, Vs));
lit_vars(#c_tuple{es=Es}, Vs) -> lit_list_vars(Es, Vs);
+lit_vars(#c_map{arg=V,es=Es}, Vs) -> lit_vars(V, lit_list_vars(Es, Vs));
+lit_vars(#c_map_pair{key=K,val=V}, Vs) -> lit_vars(K, lit_vars(V, Vs));
lit_vars(#c_var{name=V}, Vs) -> add_element(V, Vs);
lit_vars(_, Vs) -> Vs. %These are atomic
@@ -2227,7 +2316,11 @@ is_simple_list(Es) -> lists:all(fun is_simple/1, Es).
format_error(nomatch) ->
"pattern cannot possibly match";
format_error(bad_binary) ->
- "binary construction will fail because of a type mismatch".
+ "binary construction will fail because of a type mismatch";
+format_error(bad_map_key) ->
+ "map construction will fail because of none literal key (large binaries are not literals)";
+format_error(bad_map) ->
+ "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]};
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 5675572092..40d2f72b4c 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -272,9 +272,18 @@ expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) ->
expr(#c_tuple{anno=A,es=Ces}, Sub, St0) ->
{Kes,Ep,St1} = atomic_list(Ces, Sub, St0),
{#k_tuple{anno=A,es=Kes},Ep,St1};
-expr(#c_map{anno=A,var=Var0,es=Ces}, Sub, St0) ->
- {Var,[],St1} = expr(Var0, Sub, St0),
- map_split_pairs(A, Var, Ces, Sub, St1);
+expr(#c_map{anno=A,arg=Var,es=Ces}, Sub, St0) ->
+ try expr_map(A,Var,Ces,Sub,St0) of
+ {_,_,_}=Res -> Res
+ catch
+ throw:bad_map ->
+ St1 = add_warning(get_line(A), bad_map, A, St0),
+ Erl = #c_literal{val=erlang},
+ Name = #c_literal{val=error},
+ Args = [#c_literal{val=badarg}],
+ Error = #c_call{anno=A,module=Erl,name=Name,args=Args},
+ expr(Error, Sub, St1)
+ end;
expr(#c_binary{anno=A,segments=Cv}, Sub, St0) ->
try atomic_bin(Cv, Sub, St0) of
{Kv,Ep,St1} ->
@@ -496,6 +505,21 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) ->
translate_fc(Args) ->
[#c_literal{val=function_clause},make_list(Args)].
+expr_map(A,Var0,Ces,Sub,St0) ->
+ %% An extra pass of validation of Map src because of inlining
+ {Var,Mps,St1} = expr(Var0, Sub, St0),
+ case is_valid_map_src(Var) of
+ true ->
+ {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1),
+ {Km,Eps++Mps,St2};
+ false -> throw(bad_map)
+ end.
+
+is_valid_map_src(#k_map{}) -> true;
+is_valid_map_src(#k_literal{val=M}) when is_map(M) -> true;
+is_valid_map_src(#k_var{}) -> true;
+is_valid_map_src(_) -> false.
+
map_split_pairs(A, Var, Ces, Sub, St0) ->
%% two steps
%% 1. force variables
@@ -519,7 +543,7 @@ map_split_pairs(A, Var, Ces, Sub, St0) ->
Kes1 = [#k_map_pair{key=K,val=V}||{_,{assoc,K,V}} <- Assoc],
{Mvar,Em,St2} = force_atomic(#k_map{anno=A,op=assoc,var=Var,es=Kes1},St1),
Kes2 = [#k_map_pair{key=K,val=V}||{_,{exact,K,V}} <- Exact],
- {#k_map{anno=A,op=exact,var=Mvar,es=Kes2},Em ++ Esp,St2}
+ {#k_map{anno=A,op=exact,var=Mvar,es=Kes2},Esp ++ Em,St2}
end.
@@ -557,8 +581,7 @@ map_key_clean(#k_literal{val=V}) -> {k_literal,V};
map_key_clean(#k_int{val=V}) -> {k_int,V};
map_key_clean(#k_float{val=V}) -> {k_float,V};
map_key_clean(#k_atom{val=V}) -> {k_atom,V};
-map_key_clean(#k_nil{}) -> k_nil;
-map_key_clean(#k_var{name=V}) -> {k_var,V}.
+map_key_clean(#k_nil{}) -> k_nil.
%% call_type(Module, Function, Arity) -> call | bif | apply | error.
@@ -1986,7 +2009,9 @@ format_error(nomatch_shadow) ->
format_error(bad_call) ->
"invalid module and/or function name; this call will always fail";
format_error(bad_segment_size) ->
- "binary construction will fail because of a type mismatch".
+ "binary construction will fail because of a type mismatch";
+format_error(bad_map) ->
+ "map construction will fail because of a type mismatch".
add_warning(none, Term, Anno, #kern{ws=Ws}=St) ->
File = get_file(Anno),
diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl
index b4e486f97c..b33eba50eb 100644
--- a/lib/compiler/src/v3_kernel_pp.erl
+++ b/lib/compiler/src/v3_kernel_pp.erl
@@ -104,20 +104,26 @@ format_1(#k_tuple{es=Es}, Ctxt) ->
format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
$}
];
-format_1(#k_map{var=#k_var{}=Var,es=Es}, Ctxt) ->
- [$~,${,
+format_1(#k_map{var=#k_literal{val=M},op=assoc,es=Es}, Ctxt) when is_map(M), map_size(M) =:= 0 ->
+ ["~{",
format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
- " | ",format_1(Var, Ctxt),
- $},$~
+ "}~"
];
-format_1(#k_map{op=assoc,es=Es}, Ctxt) ->
+format_1(#k_map{var=#k_literal{val=M},op=exact,es=Es}, Ctxt) when is_map(M), map_size(M) =:= 0 ->
+ ["::{",
+ format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
+ "}::"
+ ];
+format_1(#k_map{var=Var,op=assoc,es=Es}, Ctxt) ->
["~{",
format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
+ " | ",format_1(Var, Ctxt),
"}~"
];
-format_1(#k_map{es=Es}, Ctxt) ->
+format_1(#k_map{var=Var,op=exact,es=Es}, Ctxt) ->
["::{",
format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2),
+ " | ",format_1(Var, Ctxt),
"}::"
];
format_1(#k_map_pair{key=K,val=V}, Ctxt) ->
diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl
index c4f54a7970..cd4b5fd674 100644
--- a/lib/compiler/src/v3_life.erl
+++ b/lib/compiler/src/v3_life.erl
@@ -324,8 +324,7 @@ type(k_binary) -> binary;
type(k_bin_seg) -> bin_seg;
type(k_bin_int) -> bin_int;
type(k_bin_end) -> bin_end;
-type(k_map) -> map;
-type(k_map_pair) -> map_pair.
+type(k_map) -> map.
%% variable(Klit) -> Lit.
%% var_list([Klit]) -> [Lit].
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 16:39:09 +0000