aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src')
-rw-r--r--lib/compiler/src/beam_block.erl3
-rw-r--r--lib/compiler/src/beam_flatten.erl3
-rw-r--r--lib/compiler/src/beam_split.erl3
-rw-r--r--lib/compiler/src/beam_type.erl20
-rw-r--r--lib/compiler/src/beam_utils.erl14
-rw-r--r--lib/compiler/src/beam_validator.erl4
-rw-r--r--lib/compiler/src/cerl.erl4
-rw-r--r--lib/compiler/src/cerl_inline.erl36
-rw-r--r--lib/compiler/src/cerl_trees.erl4
-rw-r--r--lib/compiler/src/compile.erl5
-rw-r--r--lib/compiler/src/core_lint.erl102
-rw-r--r--lib/compiler/src/core_pp.erl4
-rw-r--r--lib/compiler/src/sys_core_fold.erl14
-rw-r--r--lib/compiler/src/sys_pre_expand.erl53
-rw-r--r--lib/compiler/src/v3_codegen.erl73
-rw-r--r--lib/compiler/src/v3_core.erl443
-rw-r--r--lib/compiler/src/v3_kernel.erl61
-rw-r--r--lib/compiler/src/v3_kernel.hrl2
18 files changed, 533 insertions, 315 deletions
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 7a30c68593..5626aa34ab 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -155,7 +155,8 @@ collect(remove_message) -> {set,[],[],remove_message};
collect({put_map,F,Op,S,D,R,{list,Puts}}) ->
{set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}};
collect({get_map_elements,F,S,{list,Gets}}) ->
- {set,Gets,[S],{get_map_elements,F}};
+ {Ss,Ds} = beam_utils:spliteven(Gets),
+ {set,Ds,[S|Ss],{get_map_elements,F}};
collect({'catch',R,L}) -> {set,[R],[],{'catch',L}};
collect(fclearerror) -> {set,[],[],fclearerror};
collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror};
diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl
index 46835bece1..05d067dc48 100644
--- a/lib/compiler/src/beam_flatten.erl
+++ b/lib/compiler/src/beam_flatten.erl
@@ -63,7 +63,8 @@ norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I};
norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2};
norm({set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}) ->
{put_map,F,Op,S,D,R,{list,Puts}};
-norm({set,Gets,[S],{get_map_elements,F}}) ->
+norm({set,Ds,[S|Ss],{get_map_elements,F}}) ->
+ Gets = beam_utils:joineven(Ss,Ds),
{get_map_elements,F,S,{list,Gets}};
norm({set,[],[],remove_message}) -> remove_message;
norm({set,[],[],fclearerror}) -> fclearerror;
diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl
index 688bba9a94..f5dba314ae 100644
--- a/lib/compiler/src/beam_split.erl
+++ b/lib/compiler/src/beam_split.erl
@@ -53,8 +53,9 @@ split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is],
Bl, Acc) when Lbl =/= 0 ->
split_block(Is, [], [{put_map,Fail,Op,S,D,R,{list,Puts}}|
make_block(Bl, Acc)]);
-split_block([{set,Gets,[S],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc)
+split_block([{set,Ds,[S|Ss],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc)
when Lbl =/= 0 ->
+ Gets = beam_utils:joineven(Ss,Ds),
split_block(Is, [], [{get_map_elements,Fail,S,{list,Gets}}|make_block(Bl, Acc)]);
split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) ->
split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]);
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index 58c0f765ae..cdddad4153 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -106,6 +106,20 @@ simplify_basic_1([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Acc) ->
Ts = update(I, Ts0),
simplify_basic_1(Is, Ts, [I|Acc])
end;
+simplify_basic_1([{test,is_map,_,[R]}=I|Is], Ts0, Acc) ->
+ case tdb_find(R, Ts0) of
+ map -> simplify_basic_1(Is, Ts0, Acc);
+ _Other ->
+ Ts = update(I, Ts0),
+ simplify_basic_1(Is, Ts, [I|Acc])
+ end;
+simplify_basic_1([{test,is_nonempty_list,_,[R]}=I|Is], Ts0, Acc) ->
+ case tdb_find(R, Ts0) of
+ nonempty_list -> simplify_basic_1(Is, Ts0, Acc);
+ _Other ->
+ Ts = update(I, Ts0),
+ simplify_basic_1(Is, Ts, [I|Acc])
+ end;
simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) ->
Acc = case tdb_find(R, Ts0) of
{atom,_}=Atom -> Acc0;
@@ -402,6 +416,10 @@ update({test,is_float,_Fail,[Src]}, Ts0) ->
tdb_update([{Src,float}], Ts0);
update({test,test_arity,_Fail,[Src,Arity]}, Ts0) ->
tdb_update([{Src,{tuple,Arity,[]}}], Ts0);
+update({test,is_map,_Fail,[Src]}, Ts0) ->
+ tdb_update([{Src,map}], Ts0);
+update({test,is_nonempty_list,_Fail,[Src]}, Ts0) ->
+ tdb_update([{Src,nonempty_list}], Ts0);
update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) ->
case tdb_find(Reg, Ts) of
error ->
@@ -710,6 +728,8 @@ merge_type_info(NewType, _) ->
verify_type(NewType),
NewType.
+verify_type(map) -> ok;
+verify_type(nonempty_list) -> ok;
verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok;
verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok;
verify_type({tuple_element,_,_}) -> ok;
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 8ca368c167..e82ba82d38 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -26,6 +26,8 @@
code_at/2,bif_to_test/3,is_pure_test/1,
live_opt/1,delete_live_annos/1,combine_heap_needs/2]).
+-export([joineven/2,spliteven/1]).
+
-import(lists, [member/2,sort/1,reverse/1,splitwith/2]).
-record(live,
@@ -832,3 +834,15 @@ x_live([_|Rs], Regs) -> x_live(Rs, Regs);
x_live([], Regs) -> Regs.
is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1.
+
+%% spliteven/1
+%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]}
+spliteven(Rs) -> spliteven(Rs,[],[]).
+spliteven([],Ss,Ds) -> {reverse(Ss),reverse(Ds)};
+spliteven([S,D|Rs],Ss,Ds) ->
+ spliteven(Rs,[S|Ss],[D|Ds]).
+
+%% joineven/1
+%% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6]
+joineven([],[]) -> [];
+joineven([S|Ss],[D|Ds]) -> [S,D|joineven(Ss,Ds)].
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 9d5563d13b..0acc7a227f 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -1123,7 +1123,9 @@ assert_freg_set(Fr, _) -> error({bad_source,Fr}).
%%% Maps
%% ensure that a list of literals has a strict
-%% ascending term order (also meaning unique literals)
+%% ascending term order (also meaning unique literals).
+%% Single item lists may have registers.
+assert_strict_literal_termorder([_]) -> ok;
assert_strict_literal_termorder(Ls) ->
Vs = lists:map(fun (L) -> get_literal(L) end, Ls),
case check_strict_value_termorder(Vs) of
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 9d6768b157..7a2c3d70de 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -3063,10 +3063,12 @@ pat_vars(Node, Vs) ->
map ->
pat_list_vars(map_es(Node), Vs);
map_pair ->
- pat_list_vars([map_pair_op(Node),map_pair_key(Node),map_pair_val(Node)],Vs);
+ %% map_pair_key is not a pattern var, excluded
+ pat_list_vars([map_pair_op(Node),map_pair_val(Node)],Vs);
binary ->
pat_list_vars(binary_segments(Node), Vs);
bitstr ->
+ %% bitstr_size is not a pattern var, excluded
pat_vars(bitstr_val(Node), Vs);
alias ->
pat_vars(alias_pat(Node), [alias_var(Node) | Vs])
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index 75740e8b9d..f8489a800b 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -1341,23 +1341,23 @@ i_bitstr(E, Ren, Env, S) ->
S3 = count_size(weight(bitstr), S2),
{update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}.
-i_map(E, Ctx, Ren, Env, S) ->
+i_map(E, Ctx, Ren, Env, S0) ->
%% Visit the segments for value.
- {M1, S1} = i(map_arg(E), value, Ren, Env, S),
+ {M1, S1} = i(map_arg(E), value, Ren, Env, S0),
{Es, S2} = mapfoldl(fun (E, S) ->
i_map_pair(E, Ctx, Ren, Env, S)
end, S1, map_es(E)),
S3 = count_size(weight(map), S2),
{update_c_map(E, M1,Es), S3}.
-i_map_pair(E, Ctx, Ren, Env, S) ->
- %% It is not necessary to visit the Op and Key fields,
- %% since these are always literals.
- {Val, S1} = i(map_pair_val(E), Ctx, Ren, Env, S),
+i_map_pair(E, Ctx, Ren, Env, S0) ->
+ %% It is not necessary to visit the Op field
+ %% since it is always a literal.
+ {Key, S1} = i(map_pair_key(E), value, Ren, Env, S0),
+ {Val, S2} = i(map_pair_val(E), Ctx, Ren, Env, S1),
Op = map_pair_op(E),
- Key = map_pair_key(E),
- S2 = count_size(weight(map_pair), S1),
- {update_c_map_pair(E, Op, Key, Val), S2}.
+ S3 = count_size(weight(map_pair), S2),
+ {update_c_map_pair(E, Op, Key, Val), S3}.
%% This is a simplified version of `i_pattern', for lists of parameter
@@ -1420,15 +1420,11 @@ 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 args
- M = map_arg(E),
-
{Es, S1} = mapfoldl(fun (E, S) ->
i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S)
- end,
- S, map_es(E)),
+ end, S, map_es(E)),
S2 = count_size(weight(map), S1),
- {update_c_map(E, M, Es), S2};
+ {update_c_map(E, map_arg(E), Es), S2};
_ ->
case is_literal(E) of
true ->
@@ -1464,12 +1460,12 @@ i_bitstr_pattern(E, Ren, Env, Ren0, Env0, S) ->
i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) ->
%% It is not necessary to visit the Op it is always a literal.
- %% Same goes for Key
- {Val, S1} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S),
+ %% Key is an expression
+ {Key, S1} = i(map_pair_key(E), value, Ren0, Env0, S),
+ {Val, S2} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S1),
Op = map_pair_op(E), %% should be 'exact' literal
- Key = map_pair_key(E),
- S2 = count_size(weight(map_pair), S1),
- {update_c_map_pair(E, Op, Key, Val), S2}.
+ S3 = count_size(weight(map_pair), S2),
+ {update_c_map_pair(E, Op, Key, Val), S3}.
%% ---------------------------------------------------------------------
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index e53bdd4efb..b93da8e97f 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -520,9 +520,9 @@ variables(T, S) ->
tuple ->
vars_in_list(tuple_es(T), S);
map ->
- vars_in_list(map_es(T), S);
+ vars_in_list([map_arg(T)|map_es(T)], S);
map_pair ->
- vars_in_list([map_pair_op(T),map_pair_key(T), map_pair_val(T)], S);
+ vars_in_list([map_pair_op(T),map_pair_key(T),map_pair_val(T)], S);
'let' ->
Vs = variables(let_body(T), S),
Vs1 = var_list_names(let_vars(T)),
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index c7d91070f6..f347438509 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -431,11 +431,6 @@ pass(from_core) ->
{".core",[?pass(parse_core)|core_passes()]};
pass(from_asm) ->
{".S",[?pass(beam_consult_asm)|asm_passes()]};
-pass(asm) ->
- %% TODO: remove 'asm' in 18.0
- io:format("compile:file/2 option 'asm' has been deprecated and will be~n"
- "removed in the 18.0 release. Use 'from_asm' instead.~n"),
- pass(from_asm);
pass(from_beam) ->
{".beam",[?pass(read_beam_file)|binary_passes()]};
pass(_) -> none.
diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl
index 25df33a287..c0e2bdaba0 100644
--- a/lib/compiler/src/core_lint.erl
+++ b/lib/compiler/src/core_lint.erl
@@ -33,9 +33,6 @@
%% Values only as multiple values/variables/patterns.
%% Return same number of values as requested
%% Correct number of arguments
-%%
-%% Checks to add:
-%%
%% Consistency of values/variables
%% Consistency of function return values/calls.
%%
@@ -211,7 +208,7 @@ functions(Fs, Def, St0) ->
function({#c_var{name={_,_}},B}, Def, St) ->
%% Body must be a fun!
case B of
- #c_fun{} -> expr(B, Def, any, St);
+ #c_fun{} -> expr(B, Def, 1, St);
_ -> add_error({illegal_expr,St#lint.func}, St)
end.
@@ -247,40 +244,42 @@ gbody(E, Def, Rt, St0) ->
false -> St1
end.
-gexpr(#c_var{name=N}, Def, _Rt, St) when is_atom(N); is_integer(N) ->
- expr_var(N, Def, St);
-gexpr(#c_literal{}, _Def, _Rt, St) -> St;
-gexpr(#c_cons{hd=H,tl=T}, Def, _Rt, St) ->
- gexpr_list([H,T], Def, St);
-gexpr(#c_tuple{es=Es}, Def, _Rt, St) ->
- gexpr_list(Es, Def, St);
-gexpr(#c_map{es=Es}, Def, _Rt, St) ->
- gexpr_list(Es, Def, St);
-gexpr(#c_map_pair{key=K,val=V}, Def, _Rt, St) ->
- gexpr_list([K,V], Def, St);
-gexpr(#c_binary{segments=Ss}, Def, _Rt, St) ->
- gbitstr_list(Ss, Def, St);
+gexpr(#c_var{name=N}, Def, Rt, St) when is_atom(N); is_integer(N) ->
+ return_match(Rt, 1, expr_var(N, Def, St));
+gexpr(#c_literal{}, _Def, Rt, St) ->
+ return_match(Rt, 1, St);
+gexpr(#c_cons{hd=H,tl=T}, Def, Rt, St) ->
+ return_match(Rt, 1, gexpr_list([H,T], Def, St));
+gexpr(#c_tuple{es=Es}, Def, Rt, St) ->
+ return_match(Rt, 1, gexpr_list(Es, Def, St));
+gexpr(#c_map{es=Es}, Def, Rt, St) ->
+ return_match(Rt, 1, gexpr_list(Es, Def, St));
+gexpr(#c_map_pair{key=K,val=V}, Def, Rt, St) ->
+ return_match(Rt, 1, gexpr_list([K,V], Def, St));
+gexpr(#c_binary{segments=Ss}, Def, Rt, St) ->
+ return_match(Rt, 1, gbitstr_list(Ss, Def, St));
gexpr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) ->
- St1 = gexpr(Arg, Def, any, St0), %Ignore values
- gbody(B, Def, Rt, St1);
+ St1 = gexpr(Arg, Def, 1, St0),
+ return_match(Rt, 1, gbody(B, Def, Rt, St1));
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{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);
+ Def, Rt, St) when is_atom(Tag), is_integer(Size) ->
+ return_match(Rt, 1, 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);
+ _Def, Rt, St) ->
+ return_match(Rt, 1, 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) ->
+ Def, Rt, St0) when is_atom(Name) ->
+ St1 = return_match(Rt, 1, St0),
case is_guard_bif(Name, length(As)) of
true ->
- gexpr_list(As, Def, St);
+ gexpr_list(As, Def, St1);
false ->
- add_error({illegal_guard,St#lint.func}, St)
+ add_error({illegal_guard,St1#lint.func}, St1)
end;
gexpr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) ->
gexpr_list(As, Def, St0);
@@ -319,23 +318,25 @@ is_guard_bif(Name, Arity) ->
%% expr(Expr, Defined, RetCount, State) -> State.
-expr(#c_var{name={_,_}=FA}, Def, _Rt, St) ->
- expr_fname(FA, Def, St);
-expr(#c_var{name=N}, Def, _Rt, St) -> expr_var(N, Def, St);
-expr(#c_literal{}, _Def, _Rt, St) -> St;
-expr(#c_cons{hd=H,tl=T}, Def, _Rt, St) ->
- expr_list([H,T], Def, St);
-expr(#c_tuple{es=Es}, Def, _Rt, St) ->
- expr_list(Es, Def, St);
-expr(#c_map{es=Es}, Def, _Rt, St) ->
- expr_list(Es, Def, St);
-expr(#c_map_pair{key=K,val=V},Def,_Rt,St) ->
- expr_list([K,V],Def,St);
-expr(#c_binary{segments=Ss}, Def, _Rt, St) ->
- bitstr_list(Ss, Def, St);
+expr(#c_var{name={_,_}=FA}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_fname(FA, Def, St));
+expr(#c_var{name=N}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_var(N, Def, St));
+expr(#c_literal{}, _Def, Rt, St) ->
+ return_match(Rt, 1, St);
+expr(#c_cons{hd=H,tl=T}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_list([H,T], Def, St));
+expr(#c_tuple{es=Es}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_list(Es, Def, St));
+expr(#c_map{es=Es}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_list(Es, Def, St));
+expr(#c_map_pair{key=K,val=V}, Def, Rt, St) ->
+ return_match(Rt, 1, expr_list([K,V], Def, St));
+expr(#c_binary{segments=Ss}, Def, Rt, St) ->
+ return_match(Rt, 1, bitstr_list(Ss, Def, St));
expr(#c_fun{vars=Vs,body=B}, Def, Rt, St0) ->
{Vvs,St1} = variable_list(Vs, St0),
- return_match(Rt, 1, body(B, union(Vvs, Def), any, St1));
+ return_match(Rt, 1, body(B, union(Vvs, Def), 1, St1));
expr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) ->
St1 = expr(Arg, Def, 1, St0),
body(B, Def, Rt, St1);
@@ -361,15 +362,26 @@ expr(#c_receive{clauses=Cs,timeout=T,action=A}, Def, Rt, St0) ->
St1 = expr(T, Def, 1, St0),
St2 = body(A, Def, Rt, St1),
clauses(Cs, Def, 1, Rt, St2);
-expr(#c_apply{op=Op,args=As}, Def, _Rt, St0) ->
+expr(#c_apply{op=Op,args=As}, Def, Rt, St0) ->
St1 = apply_op(Op, Def, length(As), St0),
- expr_list(As, Def, St1);
+ return_match(Rt, 1, expr_list(As, Def, St1));
+expr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As},
+ Def, Rt, St0) when is_atom(Name) ->
+ St1 = expr_list(As, Def, St0),
+ case erl_bifs:is_exit_bif(erlang, Name, length(As)) of
+ true -> St1;
+ false -> return_match(Rt, 1, St1)
+ end;
expr(#c_call{module=M,name=N,args=As}, Def, _Rt, St0) ->
St1 = expr(M, Def, 1, St0),
St2 = expr(N, Def, 1, St1),
expr_list(As, Def, St2);
-expr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) ->
- expr_list(As, Def, St0);
+expr(#c_primop{name=#c_literal{val=A},args=As}, Def, Rt, St0) when is_atom(A) ->
+ St1 = expr_list(As, Def, St0),
+ case A of
+ match_fail -> St1;
+ _ -> return_match(Rt, 1, St1)
+ end;
expr(#c_catch{body=B}, Def, Rt, St) ->
return_match(Rt, 1, body(B, Def, 1, St));
expr(#c_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Def, Rt, St0) ->
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index 83412ecdd7..03801a9b6d 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -125,8 +125,8 @@ format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) ->
_ -> assoc
end,
Cpairs = [#c_map_pair{op=#c_literal{val=Op},
- key=#c_literal{val=V},
- val=#c_literal{val=K}} || {K,V} <- Pairs],
+ key=#c_literal{val=K},
+ val=#c_literal{val=V}} || {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)];
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index ce40213bad..82817a987a 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -2248,23 +2248,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 +2607,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 +2630,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/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index 761ae8409c..f99307c865 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1996-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
@@ -33,12 +33,15 @@
-include("../include/erl_bits.hrl").
+-type fa() :: {atom(), arity()}.
+
-record(expand, {module=[], %Module name
exports=[], %Exports
imports=[], %Imports
compile=[], %Compile flags
attributes=[], %Attributes
callbacks=[], %Callbacks
+ optional_callbacks=[] :: [fa()], %Optional callbacks
defined, %Defined functions (gb_set)
vcount=0, %Variable counter
func=[], %Current function
@@ -99,7 +102,21 @@ define_functions(Forms, #expand{defined=Predef}=St) ->
module_attrs(#expand{attributes=Attributes}=St) ->
Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes],
Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs],
- {Attrs,St#expand{callbacks=Callbacks}}.
+ OptionalCallbacks = get_optional_callbacks(Attrs),
+ {Attrs,St#expand{callbacks=Callbacks,
+ optional_callbacks=OptionalCallbacks}}.
+
+get_optional_callbacks(Attrs) ->
+ L = [O ||
+ {attribute, _, optional_callbacks, O} <- Attrs,
+ is_fa_list(O)],
+ lists:append(L).
+
+is_fa_list([{FuncName, Arity}|L])
+ when is_atom(FuncName), is_integer(Arity), Arity >= 0 ->
+ is_fa_list(L);
+is_fa_list([]) -> true;
+is_fa_list(_) -> false.
module_predef_funcs(St) ->
{Mpf1,St1}=module_predef_func_beh_info(St),
@@ -108,19 +125,24 @@ module_predef_funcs(St) ->
module_predef_func_beh_info(#expand{callbacks=[]}=St) ->
{[], St};
-module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined,
+module_predef_func_beh_info(#expand{callbacks=Callbacks,
+ optional_callbacks=OptionalCallbacks,
+ defined=Defined,
exports=Exports}=St) ->
PreDef=[{behaviour_info,1}],
PreExp=PreDef,
- {[gen_beh_info(Callbacks)],
+ {[gen_beh_info(Callbacks, OptionalCallbacks)],
St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined),
exports=union(from_list(PreExp), Exports)}}.
-gen_beh_info(Callbacks) ->
+gen_beh_info(Callbacks, OptionalCallbacks) ->
List = make_list(Callbacks),
+ OptionalList = make_optional_list(OptionalCallbacks),
{function,0,behaviour_info,1,
[{clause,0,[{atom,0,callbacks}],[],
- [List]}]}.
+ [List]},
+ {clause,0,[{atom,0,optional_callbacks}],[],
+ [OptionalList]}]}.
make_list([]) -> {nil,0};
make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) ->
@@ -130,6 +152,14 @@ make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) ->
{integer,0,Arity}]},
make_list(Rest)}.
+make_optional_list([]) -> {nil,0};
+make_optional_list([{Name,Arity}|Rest]) ->
+ {cons,0,
+ {tuple,0,
+ [{atom,0,Name},
+ {integer,0,Arity}]},
+ make_optional_list(Rest)}.
+
module_predef_funcs_mod_info(St) ->
PreDef = [{module_info,0},{module_info,1}],
PreExp = PreDef,
@@ -232,9 +262,18 @@ pattern({map,Line,Ps}, St0) ->
{TPs,St1} = pattern_list(Ps, St0),
{{map,Line,TPs},St1};
pattern({map_field_exact,Line,K0,V0}, St0) ->
- {K,St1} = expr(K0, St0),
+ %% Key should be treated as an expression
+ %% but since expressions are not allowed yet,
+ %% process it through pattern .. and handle assoc
+ %% (normalise unary op integer -> integer)
+ {K,St1} = pattern(K0, St0),
{V,St2} = pattern(V0, St1),
{{map_field_exact,Line,K,V},St2};
+pattern({map_field_assoc,Line,K0,V0}, St0) ->
+ %% when keys are Maps
+ {K,St1} = pattern(K0, St0),
+ {V,St2} = pattern(V0, St1),
+ {{map_field_assoc,Line,K,V},St2};
%%pattern({struct,Line,Tag,Ps}, St0) ->
%% {TPs,TPsvs,St1} = pattern_list(Ps, St0),
%% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1};
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 47a357c23d..8c1a0c08ac 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -210,7 +210,7 @@ need_heap_0([], H, Acc) ->
need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H) ->
{need_heap_need(I, H),0};
-need_heap_1(#l{ke={set,_,{map,_,_}},i=I}, H) ->
+need_heap_1(#l{ke={set,_,{map,_,_,_}},i=I}, H) ->
{need_heap_need(I, H),0};
need_heap_1(#l{ke={set,_,Val}}, H) ->
%% Just pass through adding to needed heap.
@@ -643,10 +643,6 @@ select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
[{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis];
select_val_cg(tuple, R, Vls, Tf, Vf, Sis) ->
[{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis];
-select_val_cg(map, R, [_Val,{f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) ->
- [{test,is_map,{f,Fail},[R]}|Sis];
-select_val_cg(map, R, [_Val,{f,Lbl}|_], Tf, _Vf, [{label,Lbl}|Sis]) ->
- [{test,is_map,{f,Tf},[R]}|Sis];
select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) ->
[{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis];
select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) ->
@@ -947,27 +943,34 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) ->
%% Assume keys are term-sorted
Rsrc = fetch_var(Src, Bef),
- {{HasKs,GetVs},Aft} = lists:foldr(fun
- ({map_pair,Key,{var,V}},{{HasKsi,GetVsi},Int0}) ->
+ {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = lists:foldr(fun
+ ({map_pair,{var,K},{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
case vdb_find(V, Vdb) of
{V,_,L} when L =< I ->
- {{[Key|HasKsi],GetVsi},Int0};
+ RK = fetch_var(K,Int0),
+ {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0};
_Other ->
Reg1 = put_reg(V, Int0#sr.reg),
Int1 = Int0#sr{reg=Reg1},
- {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi]},Int1}
+ RK = fetch_var(K,Int0),
+ RV = fetch_reg(V,Reg1),
+ {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1}
+ end;
+ ({map_pair,Key,{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) ->
+ case vdb_find(V, Vdb) of
+ {V,_,L} when L =< I ->
+ {{[Key|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0};
+ _Other ->
+ Reg1 = put_reg(V, Int0#sr.reg),
+ Int1 = Int0#sr{reg=Reg1},
+ {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi],HasVarVsi,GetVarVsi},Int1}
end
- end, {{[],[]},Bef}, Vs),
-
- Code = case {HasKs,GetVs} of
- {HasKs,[]} ->
- [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}];
- {[],GetVs} ->
- [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}}];
- {HasKs,GetVs} ->
- [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}},
- {get_map_elements, {f,Fail},Rsrc,{list,GetVs}}]
- end,
+ end, {{[],[],[],[]},Bef}, Vs),
+
+ Code = [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}} || HasKs =/= []] ++
+ [{test,has_map_fields,{f,Fail},Rsrc,{list,[K]}} || K <- HasVarKs] ++
+ [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}} || GetVs =/= []] ++
+ [{get_map_elements, {f,Fail},Rsrc,{list,[K,V]}} || [K,V] <- GetVarVs],
{Code, Aft, St}.
@@ -1504,9 +1507,39 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef,
%% Now generate the complete code for constructing the binary.
Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a),
{Sis++Code,Aft,St};
+% Map single variable key
+set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef,
+ #cg{in_catch=InCatch,bfail=Bfail}=St) ->
+
+ Fail = {f,Bfail},
+ {Sis,Int0} =
+ case InCatch of
+ true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb);
+ false -> {[],Bef}
+ end,
+ SrcReg = cg_reg_arg(Map,Int0),
+ Line = line(Le#l.a),
+
+ List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)],
+
+ Live = max_reg(Bef#sr.reg),
+ Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)},
+ Aft = clear_dead(Int1, Le#l.i, Vdb),
+ Target = fetch_reg(R, Int1#sr.reg),
+
+ I = case Op of
+ assoc -> put_map_assoc;
+ exact -> put_map_exact
+ end,
+ {Sis++[Line]++[{I,Fail,SrcReg,Target,Live,{list,List}}],Aft,St};
+
+% Map (possibly) multiple literal keys
set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef,
#cg{in_catch=InCatch,bfail=Bfail}=St) ->
+ %% assert key literals
+ [] = [Var||{map_pair,{var,_}=Var,_} <- Es],
+
Fail = {f,Bfail},
{Sis,Int0} =
case InCatch of
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 83cf76f241..612660c2d6 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -78,7 +78,7 @@
-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,
- ann_c_map/2, ann_c_map/3]).
+ ann_c_map/3]).
-include("core_parse.hrl").
@@ -169,60 +169,81 @@ form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) ->
attribute({attribute,Line,Name,Val}) ->
{#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}.
+%% function_dump(module_info,_,_,_) -> ok;
+%% function_dump(Name,Arity,Format,Terms) ->
+%% io:format("~w/~w " ++ Format,[Name,Arity]++Terms),
+%% ok.
+
function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) ->
- %%ok = io:fwrite("~p - ", [{Name,Arity}]),
St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]},
{B0,St1} = body(Cs0, Name, Arity, St0),
- %%ok = io:fwrite("1", []),
- %%ok = io:fwrite("~w:~p~n", [?LINE,B0]),
+ %% ok = function_dump(Name,Arity,"body:~n~p~n",[B0]),
{B1,St2} = ubody(B0, St1),
- %%ok = io:fwrite("2", []),
- %%ok = io:fwrite("~w:~p~n", [?LINE,B1]),
+ %% ok = function_dump(Name,Arity,"ubody:~n~p~n",[B1]),
{B2,#core{ws=Ws}} = cbody(B1, St2),
- %%ok = io:fwrite("3~n", []),
- %%ok = io:fwrite("~w:~p~n", [?LINE,B2]),
+ %% ok = function_dump(Name,Arity,"cbody:~n~p~n",[B2]),
{{#c_var{name={Name,Arity}},B2},Ws}.
body(Cs0, Name, Arity, St0) ->
Anno = lineno_anno(element(2, hd(Cs0)), St0),
{Args,St1} = new_vars(Anno, Arity, St0),
- {Cs1,St2} = clauses(Cs0, St1),
- {Ps,St3} = new_vars(Arity, St2), %Need new variables here
- Fc = function_clause(Ps, Anno, {Name,Arity}),
- {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}.
+ case clauses(Cs0, St1) of
+ {Cs1,[],St2} ->
+ {Ps,St3} = new_vars(Arity, St2), %Need new variables here
+ Fc = function_clause(Ps, Anno, {Name,Arity}),
+ {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3};
+ {Cs1,Eps,St2} ->
+ %% We have pre-expressions from patterns and
+ %% these needs to be letified before matching
+ %% since only bound variables are allowed
+ AnnoGen = #a{anno=[compiler_generated]},
+ {Ps1,St3} = new_vars(Arity, St2), %Need new variables here
+ Fc1 = function_clause(Ps1, Anno, {Name,Arity}),
+ {Ps2,St4} = new_vars(Arity, St3), %Need new variables here
+ Fc2 = function_clause(Ps2, Anno, {Name,Arity}),
+ Case = #icase{anno=AnnoGen,args=Args,
+ clauses=Cs1,
+ fc=Fc2},
+ {#ifun{anno=#a{anno=Anno},id=[],vars=Args,
+ clauses=[#iclause{anno=AnnoGen,pats=Ps1,
+ guard=[#c_literal{val=true}],
+ body=Eps ++ [Case]}],
+ fc=Fc1},St4}
+ end.
%% clause(Clause, State) -> {Cclause,State} | noclause.
%% clauses([Clause], State) -> {[Cclause],State}.
%% Convert clauses. Trap bad pattern aliases and remove clause from
%% clause list.
-clauses([C0|Cs0], St0) ->
+clauses([C0|Cs0],St0) ->
case clause(C0, St0) of
- {noclause,St} -> clauses(Cs0, St);
- {C,St1} ->
- {Cs,St2} = clauses(Cs0, St1),
- {[C|Cs],St2}
+ {noclause,_,St} -> clauses(Cs0,St);
+ {C,Eps1,St1} ->
+ {Cs,Eps2,St2} = clauses(Cs0, St1),
+ {[C|Cs],Eps1++Eps2,St2}
end;
-clauses([], St) -> {[],St}.
+clauses([],St) -> {[],[],St}.
clause({clause,Lc,H0,G0,B0}, St0) ->
try head(H0, St0) of
- H1 ->
- {G1,St1} = guard(G0, St0),
- {B1,St2} = exprs(B0, St1),
- Anno = lineno_anno(Lc, St2),
- {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},St2}
+ {H1,Eps,St1} ->
+ {G1,St2} = guard(G0, St1),
+ {B1,St3} = exprs(B0, St2),
+ Anno = lineno_anno(Lc, St3),
+ {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},Eps,St3}
catch
throw:nomatch ->
St = add_warning(Lc, nomatch, St0),
- {noclause,St} %Bad pattern
+ {noclause,[],St} %Bad pattern
end.
clause_arity({clause,_,H0,_,_}) -> length(H0).
-%% head([P], State) -> [P].
+%% head([P], State) -> {[P],[Cexpr],State}.
-head(Ps, St) -> pattern_list(Ps, St).
+head(Ps, St) ->
+ pattern_list(Ps, St).
%% guard([Expr], State) -> {[Cexpr],State}.
%% Build an explict and/or tree of guard alternatives, then traverse
@@ -514,22 +535,7 @@ expr({tuple,L,Es0}, St0) ->
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.
- 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;
+ map_build_pair_chain(#c_literal{val=#{}},Es0,lineno_anno(L,St0),St0);
expr({map,L,M0,Es0}, St0) ->
try expr_map(M0,Es0,lineno_anno(L, St0),St0) of
{_,_,_}=Res -> Res
@@ -562,26 +568,26 @@ expr({block,_,Es0}, St0) ->
{E1,Eps,St2} = expr(last(Es0), St1),
{E1,Es1 ++ Eps,St2};
expr({'if',L,Cs0}, St0) ->
- {Cs1,St1} = clauses(Cs0, St0),
+ {Cs1,Ceps,St1} = clauses(Cs0, St0),
Lanno = lineno_anno(L, St1),
Fc = fail_clause([], Lanno, #c_literal{val=if_clause}),
- {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1};
+ {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},Ceps,St1};
expr({'case',L,E0,Cs0}, St0) ->
{E1,Eps,St1} = novars(E0, St0),
- {Cs1,St2} = clauses(Cs0, St1),
+ {Cs1,Ceps,St2} = clauses(Cs0, St1),
{Fpat,St3} = new_var(St2),
Lanno = lineno_anno(L, St2),
Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])),
- {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3};
+ {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps++Ceps,St3};
expr({'receive',L,Cs0}, St0) ->
- {Cs1,St1} = clauses(Cs0, St0),
- {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1}, [], St1};
+ {Cs1,Ceps,St1} = clauses(Cs0, St0),
+ {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1},Ceps, St1};
expr({'receive',L,Cs0,Te0,Tes0}, St0) ->
{Te1,Teps,St1} = novars(Te0, St0),
{Tes1,St2} = exprs(Tes0, St1),
- {Cs1,St3} = clauses(Cs0, St2),
+ {Cs1,Ceps,St3} = clauses(Cs0, St2),
{#ireceive2{anno=#a{anno=lineno_anno(L, St3)},
- clauses=Cs1,timeout=Te1,action=Tes1},Teps,St3};
+ clauses=Cs1,timeout=Te1,action=Tes1},Teps++Ceps,St3};
expr({'try',L,Es0,[],Ecs,[]}, St0) ->
%% 'try ... catch ... end'
{Es1,St1} = exprs(Es0, St0),
@@ -595,7 +601,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) ->
%% 'try ... of ... catch ... end'
{Es1,St1} = exprs(Es0, St0),
{V,St2} = new_var(St1), %This name should be arbitrary
- {Cs1,St3} = clauses(Cs0, St2),
+ {Cs1,Ceps,St3} = clauses(Cs0, St2),
{Fpat,St4} = new_var(St3),
Lanno = lineno_anno(L, St4),
Fc = fail_clause([Fpat], Lanno,
@@ -604,7 +610,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) ->
{#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1,
vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}],
evars=Evs,handler=Hs},
- [],St5};
+ Ceps,St5};
expr({'try',L,Es0,[],[],As0}, St0) ->
%% 'try ... after ... end'
{Es1,St1} = exprs(Es0, St0),
@@ -647,8 +653,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),
@@ -673,24 +679,24 @@ expr({match,L,P0,E0}, St0) ->
{var,_,'_'} -> St0#core{wanted=false};
_ -> St0
end,
- {E2,Eps,St2} = novars(E1, St1),
+ {E2,Eps1,St2} = novars(E1, St1),
St3 = St2#core{wanted=St0#core.wanted},
- P2 = try
- pattern(P1, St3)
+ {P2,Eps2,St4} = try
+ pattern(P1, St3)
catch
throw:Thrown ->
- Thrown
+ {Thrown,[],St3}
end,
- {Fpat,St4} = new_var(St3),
- Lanno = lineno_anno(L, St4),
+ {Fpat,St5} = new_var(St4),
+ Lanno = lineno_anno(L, St5),
Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])),
case P2 of
nomatch ->
- St = add_warning(L, nomatch, St4),
+ St = add_warning(L, nomatch, St5),
{#icase{anno=#a{anno=Lanno},
- args=[E2],clauses=[],fc=Fc},Eps,St};
+ args=[E2],clauses=[],fc=Fc},Eps1++Eps2,St};
Other when not is_atom(Other) ->
- {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4}
+ {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5}
end;
expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) ->
%% Optimise '++' here because of the list comprehension algorithm.
@@ -772,44 +778,77 @@ expr_map(M0,Es0,A,St0) ->
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}
+ {M2,Eps,St2} = map_build_pair_chain(M1,Es0,A,St1),
+ {M2,Mps++Eps,St2}
end;
false -> throw({bad_map,bad_map})
end.
+%% Group continuous literal blocks and single variables, i.e.
+%% M0#{ a := 1, b := V1, K1 := V2, K2 := 42}
+%% becomes equivalent to
+%% M1 = M0#{ a := 1, b := V1 },
+%% M2 = M1#{ K1 := V1 },
+%% M3 = M2#{ K2 := 42 }
+
+map_build_pair_chain(M,Es,A,St) ->
+ %% hack, remove iset if only literal
+ case map_build_pair_chain(M,Es,A,St,[]) of
+ {_,[#iset{arg=#c_literal{}=Val}],St1} -> {Val,[],St1};
+ Normal -> Normal
+ end.
+
+map_build_pair_chain(M0,[],_,St,Mps) ->
+ {M0,Mps,St};
+map_build_pair_chain(M0,Es0,A,St0,Mps) ->
+ % group continuous literal blocks
+ % Anno = #a{anno=[compiler_generated]},
+ % order is important, we need to reverse the literals
+ case map_pair_block(Es0,[],[],St0) of
+ {{CesL,EspL},{[],[]},Es1,St1} ->
+ {MVar,St2} = new_var(St1),
+ Pre = [#iset{var=MVar, arg=ann_c_map(A,M0,reverse(CesL))}],
+ map_build_pair_chain(MVar,Es1,A,St2,Mps++EspL++Pre);
+ {{[],[]},{CesV,EspV},Es1,St1} ->
+ {MVar,St2} = new_var(St1),
+ Pre = [#iset{var=MVar, arg=#c_map{arg=M0,es=CesV, anno=A}}],
+ map_build_pair_chain(MVar,Es1,A,St2,Mps ++ EspV++Pre);
+ {{CesL,EspL},{CesV,EspV},Es1,St1} ->
+ {MVarL,St2} = new_var(St1),
+ {MVarV,St3} = new_var(St2),
+ Pre = [#iset{var=MVarL, arg=ann_c_map(A,M0,reverse(CesL))},
+ #iset{var=MVarV, arg=#c_map{arg=MVarL,es=CesV,anno=A}}],
+ map_build_pair_chain(MVarV,Es1,A,St3,Mps++EspL++EspV++Pre)
+ end.
+
+map_pair_block([{Op,L,K0,V0}|Es],Ces,Esp,St0) ->
+ {K,Ep0,St1} = safe(K0, St0),
+ {V,Ep1,St2} = safe(V0, St1),
+ A = lineno_anno(L, St2),
+ Pair0 = map_op_to_c_map_pair(Op),
+ Pair1 = Pair0#c_map_pair{anno=A,key=K,val=V},
+ case cerl:is_literal(K) of
+ true ->
+ map_pair_block(Es,[Pair1|Ces],Ep0 ++ Ep1 ++ Esp,St2);
+ false ->
+ {{Ces,Esp},{[Pair1],Ep0++Ep1},Es,St2}
+ end;
+map_pair_block([],Ces,Esp,St) ->
+ {{Ces,Esp},{[],[]},[],St}.
+
+map_op_to_c_map_pair(map_field_assoc) -> #c_map_pair{op=#c_literal{val=assoc}};
+map_op_to_c_map_pair(map_field_exact) -> #c_map_pair{op=#c_literal{val=exact}}.
+
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) ->
%% Note that Tag is not needed for rethrow - it is already in Info.
{Evs,St1} = new_vars(3, St0), % Tag, Value, Info
- {Ecs1,St2} = clauses(Ecs0, St1),
+ {Ecs1,Ceps,St2} = clauses(Ecs0, St1),
[_,Value,Info] = Evs,
Ec = #iclause{anno=#a{anno=[compiler_generated]},
pats=[c_tuple(Evs)],guard=[#c_literal{val=true}],
@@ -817,15 +856,15 @@ try_exception(Ecs0, St0) ->
name=#c_literal{val=raise},
args=[Info,Value]}]},
Hs = [#icase{anno=#a{},args=[c_tuple(Evs)],clauses=Ecs1,fc=Ec}],
- {Evs,Hs,St2}.
+ {Evs,Ceps++Hs,St2}.
try_after(As, St0) ->
%% See above.
- {Evs,St1} = new_vars(3, St0), % Tag, Value, Info
+ {Evs,St1} = new_vars(3, St0), % Tag, Value, Info
[_,Value,Info] = Evs,
- B = As ++ [#iprimop{anno=#a{}, %Must have an #a{}
- name=#c_literal{val=raise},
- args=[Info,Value]}],
+ B = As ++ [#iprimop{anno=#a{}, % Must have an #a{}
+ name=#c_literal{val=raise},
+ args=[Info,Value]}],
Ec = #iclause{anno=#a{anno=[compiler_generated]},
pats=[c_tuple(Evs)],guard=[#c_literal{val=true}],
body=B},
@@ -959,7 +998,7 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) ->
fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) ->
Arity = clause_arity(hd(Cs0)),
- {Cs1,St1} = clauses(Cs0, St0),
+ {Cs1,Ceps,St1} = clauses(Cs0, St0),
{Args,St2} = new_vars(Arity, St1),
{Ps,St3} = new_vars(Arity, St2), %Need new variables here
Anno = lineno_anno(L, St3),
@@ -967,7 +1006,7 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) ->
Fun = #ifun{anno=#a{anno=Anno},
id=[{id,Id}], %We KNOW!
vars=Args,clauses=Cs1,fc=Fc,name=NameInfo},
- {Fun,[],St3}.
+ {Fun,Ceps,St3}.
%% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}.
%% This TQ from Simon PJ pp 127-138.
@@ -1134,7 +1173,7 @@ preprocess_quals(Line, [Q|Qs0], St0, Acc) ->
{Gen,St} = generator(Line, Q, Gs, St0),
preprocess_quals(Line, Qs, St, [Gen|Acc]);
false ->
- LAnno = #a{anno=lineno_anno(get_anno(Q), St0)},
+ LAnno = #a{anno=lineno_anno(get_qual_anno(Q), St0)},
case is_guard_test(Q) of
true ->
%% When a filter is a guard test, its argument in the
@@ -1159,6 +1198,11 @@ is_generator({generate,_,_,_}) -> true;
is_generator({b_generate,_,_,_}) -> true;
is_generator(_) -> false.
+%% Retrieve the annotation from an Erlang AST form.
+%% (Use get_anno/1 to retrieve the annotation from Core Erlang forms).
+
+get_qual_anno(Abstract) -> element(2, Abstract).
+
%%
%% Generators are abstracted as sextuplets:
%% - acc_pat is the accumulator pattern, e.g. [Pat|Tail] for Pat <- Expr.
@@ -1181,7 +1225,7 @@ is_generator(_) -> false.
generator(Line, {generate,Lg,P0,E}, Gs, St0) ->
LA = lineno_anno(Line, St0),
GA = lineno_anno(Lg, St0),
- {Head,St1} = list_gen_pattern(P0, Line, St0),
+ {Head,Ceps,St1} = list_gen_pattern(P0, Line, St0),
{[Tail,Skip],St2} = new_vars(2, St1),
{Cg,St3} = lc_guard_tests(Gs, St2),
{AccPat,SkipPat} = case Head of
@@ -1202,24 +1246,25 @@ generator(Line, {generate,Lg,P0,E}, Gs, St0) ->
end,
{Ce,Pre,St4} = safe(E, St3),
Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat,
- tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Pre,Ce}},
+ tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Ceps++Pre,Ce}},
{Gen,St4};
generator(Line, {b_generate,Lg,P,E}, Gs, St0) ->
LA = lineno_anno(Line, St0),
GA = lineno_anno(Lg, St0),
- Cp = #c_binary{segments=Segs} = pattern(P, St0),
+ {Cp = #c_binary{segments=Segs},[],St1} = pattern(P, St0),
+
%% The function append_tail_segment/2 keeps variable patterns as-is, making
%% it possible to have the same skip clause removal as with list generators.
- {AccSegs,Tail,TailSeg,St1} = append_tail_segment(Segs, St0),
+ {AccSegs,Tail,TailSeg,St2} = append_tail_segment(Segs, St1),
AccPat = Cp#c_binary{segments=AccSegs},
- {Cg,St2} = lc_guard_tests(Gs, St1),
- {SkipSegs,St3} = emasculate_segments(AccSegs, St2),
+ {Cg,St3} = lc_guard_tests(Gs, St2),
+ {SkipSegs,St4} = emasculate_segments(AccSegs, St3),
SkipPat = Cp#c_binary{segments=SkipSegs},
- {Ce,Pre,St4} = safe(E, St3),
+ {Ce,Pre,St5} = safe(E, St4),
Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat,
tail=Tail,tail_pat=#c_binary{anno=LA,segments=[TailSeg]},
arg={Pre,Ce}},
- {Gen,St4}.
+ {Gen,St5}.
append_tail_segment(Segs, St0) ->
{Var,St} = new_var(St0),
@@ -1248,9 +1293,9 @@ lc_guard_tests(Gs0, St0) ->
list_gen_pattern(P0, Line, St) ->
try
- {pattern(P0, St),St}
+ pattern(P0,St)
catch
- nomatch -> {nomatch,add_warning(Line, nomatch, St)}
+ nomatch -> {nomatch,[],add_warning(Line, nomatch, St)}
end.
%%%
@@ -1473,6 +1518,18 @@ force_novars(#ibinary{}=Bin, St) -> {Bin,[],St};
force_novars(Ce, St) ->
force_safe(Ce, St).
+
+%% safe_pattern_expr(Expr, State) -> {Cexpr,[PreExpr],State}.
+%% only literals and variables are safe expressions in patterns
+safe_pattern_expr(E,St0) ->
+ case safe(E,St0) of
+ {#c_var{},_,_}=Safe -> Safe;
+ {#c_literal{},_,_}=Safe -> Safe;
+ {Ce,Eps,St1} ->
+ {V,St2} = new_var(St1),
+ {V,Eps++[#iset{var=V,arg=Ce}],St2}
+ end.
+
%% safe(Expr, State) -> {Safe,[PreExpr],State}.
%% Generate an internal safe expression. These are simples without
%% binaries which can fail. At this level we do not need to do a
@@ -1547,84 +1604,109 @@ fold_match({match,L,P0,E0}, P) ->
{{match,L,P0,P1},E1};
fold_match(E, P) -> {P,E}.
-%% pattern(Pattern, State) -> CorePat.
+%% pattern(Pattern, State) -> {CorePat,[PreExp],State}.
%% Transform a pattern by removing line numbers. We also normalise
%% aliases in patterns to standard form, {alias,Pat,[Var]}.
-
-pattern({var,L,V}, St) -> #c_var{anno=lineno_anno(L, St),name=V};
-pattern({char,L,C}, St) -> #c_literal{anno=lineno_anno(L, St),val=C};
-pattern({integer,L,I}, St) -> #c_literal{anno=lineno_anno(L, St),val=I};
-pattern({float,L,F}, St) -> #c_literal{anno=lineno_anno(L, St),val=F};
-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=[]};
+%%
+%% In patterns we may have expressions
+%% 1) Binaries -> #c_bitstr{size=Expr}
+%% 2) Maps -> #c_map_pair{key=Expr}
+%%
+%% Both of these may generate pre-expressions since only bound variables
+%% or literals are allowed for these in core patterns.
+%%
+%% Therefor, we need to drag both the state and the collection of pre-expression
+%% around in the whole pattern transformation tree.
+
+pattern({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},[],St};
+pattern({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},[],St};
+pattern({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},[],St};
+pattern({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},[],St};
+pattern({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},[],St};
+pattern({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},[],St};
+pattern({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},[],St};
pattern({cons,L,H,T}, St) ->
- annotate_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St), St);
+ {Ph,Eps1,St1} = pattern(H, St),
+ {Pt,Eps2,St2} = pattern(T, St1),
+ {annotate_cons(lineno_anno(L, St), Ph, Pt, St2),Eps1++Eps2,St2};
pattern({tuple,L,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)};
+ {Ps1,Eps,St1} = pattern_list(Ps,St),
+ {annotate_tuple(record_anno(L, St), Ps1, St),Eps,St1};
+pattern({map,L,Pairs}, St0) ->
+ {Ps,Eps,St1} = pattern_map_pairs(Pairs, St0),
+ {#c_map{anno=lineno_anno(L, St1), es=Ps},Eps,St1};
pattern({bin,L,Ps}, St) ->
%% We don't create a #ibinary record here, since there is
%% no need to hold any used/new annotations in a pattern.
- #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)};
+ {#c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)},[],St};
pattern({match,_,P1,P2}, St) ->
- pat_alias(pattern(P1, St), pattern(P2, St)).
+ {Cp1,Eps1,St1} = pattern(P1,St),
+ {Cp2,Eps2,St2} = pattern(P2,St1),
+ {pat_alias(Cp1,Cp2),Eps1++Eps2,St2}.
%% pattern_map_pairs([MapFieldExact],State) -> [#c_map_pairs{}]
pattern_map_pairs(Ps, St) ->
- %% check literal key uniqueness (dict is needed)
- %% pattern all pairs
- {CMapPairs, Kdb} = lists:mapfoldl(fun
- (P,Kdbi) ->
- #c_map_pair{key=Ck,val=Cv} = CMapPair = pattern_map_pair(P,St),
- K = core_lib:literal_value(Ck),
- case dict:find(K,Kdbi) of
- {ok, Vs} ->
- {CMapPair, dict:store(K,[Cv|Vs],Kdbi)};
- _ ->
- {CMapPair, dict:store(K,[Cv],Kdbi)}
+ %% check literal key uniqueness
+ %% - guaranteed via aliasing map pairs
+ %% pattern all pairs in two steps
+ %% 1) Construct Core Pattern
+ %% 2) Alias Keys in Core Pattern
+ {CMapPairs, {Eps,St1}} = lists:mapfoldl(fun
+ (P,{EpsM,Sti0}) ->
+ {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, dict:new(), Ps),
- pattern_alias_map_pairs(CMapPairs,Kdb,dict:new(),St).
-
-pattern_alias_map_pairs([],_,_,_) -> [];
-pattern_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Kset,St) ->
- %% alias same keys if needed
- K = core_lib:literal_value(Ck),
- case dict:find(K,Kset) of
- {ok,processed} ->
- pattern_alias_map_pairs(Pairs,Kdb,Kset,St);
- _ ->
+ 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 = pattern_alias_map_pair_patterns(Cvs),
- Kset1 = dict:store(K, processed, Kset),
- [Pair#c_map_pair{val=Cv}|pattern_alias_map_pairs(Pairs,Kdb,Kset1,St)]
+ 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.
-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) ->
- 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)
- 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]).
+
+pattern_map_pair({map_field_exact,L,K,V}, St0) ->
+ {Ck,EpsK,St1} = safe_pattern_expr(K,St0),
+ {Cv,EpsV,St2} = pattern(V, St1),
+ {#c_map_pair{anno=lineno_anno(L,St2),
+ op=#c_literal{val=exact},
+ key=Ck,
+ val=Cv},EpsK++EpsV,St2}.
%% pat_bin([BinElement], State) -> [BinSeg].
pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps].
-pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}, St) ->
- #c_bitstr{val=pattern(Term, St),size=pattern(Size, St),
+pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) ->
+ {Pval,[],St1} = pattern(Val,St),
+ {Psize,[],_St2} = pattern(Size,St1),
+ #c_bitstr{val=Pval,size=Psize,
unit=#c_literal{val=Unit},
type=#c_literal{val=Type},
flags=#c_literal{val=Flags}}.
@@ -1634,6 +1716,8 @@ pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}, St) ->
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}));
@@ -1642,6 +1726,8 @@ pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) ->
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));
@@ -1650,6 +1736,12 @@ pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(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)};
@@ -1672,9 +1764,15 @@ pat_alias_list([A1|A1s], [A2|A2s]) ->
pat_alias_list([], []) -> [];
pat_alias_list(_, _) -> throw(nomatch).
-%% pattern_list([P], State) -> [P].
+%% pattern_list([P], State) -> {[P],Exprs,St}
+
+pattern_list([P0|Ps0], St0) ->
+ {P1,Eps,St1} = pattern(P0, St0),
+ {Ps1,Epsl,St2} = pattern_list(Ps0, St1),
+ {[P1|Ps1], Eps ++ Epsl, St2};
+pattern_list([], St) ->
+ {[],[],St}.
-pattern_list(Ps, St) -> [pattern(P, St) || P <- Ps].
%% make_vars([Name]) -> [{Var,Name}].
@@ -1974,9 +2072,14 @@ upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) ->
upattern(#c_map{es=Es0}=Map, Ks, St0) ->
{Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0),
{Map#c_map{es=Es1},Esg,Esv,Eus,St1};
-upattern(#c_map_pair{op=#c_literal{val=exact},val=V0}=MapPair, Ks, St0) ->
- {V,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0),
- {MapPair#c_map_pair{val=V},Vg,Vv,Vu,St1};
+upattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,Ks,St0) ->
+ {V,Vg,Vn,Vu,St1} = upattern(V0, Ks, St0),
+ % A variable key must be considered used here
+ Ku = case K0 of
+ #c_var{name=Name} -> [Name];
+ _ -> []
+ end,
+ {Pair#c_map_pair{val=V},Vg,Vn,union(Ku,Vu),St1};
upattern(#c_binary{segments=Es0}=Bin, Ks, St0) ->
{Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0),
{Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1};
@@ -2347,8 +2450,6 @@ format_error(nomatch) ->
"pattern cannot possibly match";
format_error(bad_binary) ->
"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".
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 40d2f72b4c..6504351c02 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -527,9 +527,9 @@ map_split_pairs(A, Var, Ces, Sub, St0) ->
Pairs0 = [{Op,K,V} || #c_map_pair{op=#c_literal{val=Op},key=K,val=V} <- Ces],
{Pairs,Esp,St1} = foldr(fun
({Op,K0,V0}, {Ops,Espi,Sti0}) when Op =:= assoc; Op =:= exact ->
- {K,[],Sti1} = expr(K0, Sub, Sti0),
- {V,Ep,Sti2} = atomic(V0, Sub, Sti1),
- {[{Op,K,V}|Ops],Ep ++ Espi,Sti2}
+ {K,Eps1,Sti1} = atomic(K0, Sub, Sti0),
+ {V,Eps2,Sti2} = atomic(V0, Sub, Sti1),
+ {[{Op,K,V}|Ops],Eps1 ++ Eps2 ++ Espi,Sti2}
end, {[],[],St0}, Pairs0),
case map_group_pairs(Pairs) of
@@ -577,11 +577,12 @@ map_key_is_used(K,Used) ->
dict:find(map_key_clean(K),Used).
%% Be explicit instead of using set_kanno(K,[])
-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}) -> {var,V};
+map_key_clean(#k_literal{val=V}) -> {lit,V};
+map_key_clean(#k_int{val=V}) -> {lit,V};
+map_key_clean(#k_float{val=V}) -> {lit,V};
+map_key_clean(#k_atom{val=V}) -> {lit,V};
+map_key_clean(#k_nil{}) -> {lit,[]}.
%% call_type(Module, Function, Arity) -> call | bif | apply | error.
@@ -757,23 +758,22 @@ flatten_alias(#c_alias{var=V,pat=P}) ->
flatten_alias(Pat) -> {[],Pat}.
pattern_map_pairs(Ces0, Isub, Osub0, St0) ->
- %% It is assumed that all core keys are literals
- %% It is later assumed that these keys are term sorted
- %% so we need to sort them here
- Ces1 = lists:sort(fun
- (#c_map_pair{key=CkA},#c_map_pair{key=CkB}) ->
- A = core_lib:literal_value(CkA),
- B = core_lib:literal_value(CkB),
- erts_internal:cmp_term(A,B) < 0
- end, Ces0),
%% pattern the pair keys and values as normal
{Kes,{Osub1,St1}} = lists:mapfoldl(fun
(#c_map_pair{anno=A,key=Ck,val=Cv},{Osubi0,Sti0}) ->
- {Kk,Osubi1,Sti1} = pattern(Ck, Isub, Osubi0, Sti0),
- {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi1, Sti1),
+ {Kk,[],Sti1} = expr(Ck, Isub, Sti0),
+ {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi0, Sti1),
{#k_map_pair{anno=A,key=Kk,val=Kv},{Osubi2,Sti2}}
- end, {Osub0, St0}, Ces1),
- {Kes,Osub1,St1}.
+ end, {Osub0, St0}, Ces0),
+ %% It is later assumed that these keys are term sorted
+ %% so we need to sort them here
+ Kes1 = lists:sort(fun
+ (#k_map_pair{key=KkA},#k_map_pair{key=KkB}) ->
+ A = map_key_clean(KkA),
+ B = map_key_clean(KkB),
+ erts_internal:cmp_term(A,B) < 0
+ end, Kes),
+ {Kes1,Osub1,St1}.
pattern_bin(Es, Isub, Osub0, St0) ->
{Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0),
@@ -1550,13 +1550,11 @@ arg_val(Arg, C) ->
{set_kanno(S, []),U,T,Fs}
end;
#k_map{op=exact,es=Es} ->
- Keys = [begin
- #k_map_pair{key=#k_literal{val=Key}} = Pair,
- Key
- end || Pair <- Es],
- %% multiple keys may have the same name
- %% do not use ordsets
- lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Keys)
+ lists:sort(fun(A,B) ->
+ %% on the form K :: {'lit' | 'var', term()}
+ %% lit < var as intended
+ erts_internal:cmp_term(A,B) < 0
+ end, [map_key_clean(Key) || #k_map_pair{key=Key} <- Es])
end.
%% ubody_used_vars(Expr, State) -> [UsedVar]
@@ -1943,6 +1941,7 @@ lit_list_vars(Ps) ->
%% pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}.
%% Return variables in a pattern. All variables are new variables
%% except those in the size field of binary segments.
+%% and map_pair keys
pat_vars(#k_var{name=N}) -> {[],[N]};
%%pat_vars(#k_char{}) -> {[],[]};
@@ -1967,8 +1966,10 @@ pat_vars(#k_tuple{es=Es}) ->
pat_list_vars(Es);
pat_vars(#k_map{es=Es}) ->
pat_list_vars(Es);
-pat_vars(#k_map_pair{val=V}) ->
- pat_vars(V).
+pat_vars(#k_map_pair{key=K,val=V}) ->
+ {U1,New} = pat_vars(V),
+ {[], U2} = pat_vars(K),
+ {union(U1,U2),New}.
pat_list_vars(Ps) ->
foldl(fun (P, {Used0,New0}) ->
diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl
index ab66445f73..b008285d9f 100644
--- a/lib/compiler/src/v3_kernel.hrl
+++ b/lib/compiler/src/v3_kernel.hrl
@@ -38,7 +38,7 @@
-record(k_nil, {anno=[]}).
-record(k_tuple, {anno=[],es}).
--record(k_map, {anno=[],var,op,es}).
+-record(k_map, {anno=[],var=#k_literal{val=#{}},op,es}).
-record(k_map_pair, {anno=[],key,val}).
-record(k_cons, {anno=[],hd,tl}).
-record(k_binary, {anno=[],segs}).
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-11 10:23:09 +0000