diff options
Diffstat (limited to 'lib/compiler/src')
-rw-r--r-- | lib/compiler/src/beam_block.erl | 3 | ||||
-rw-r--r-- | lib/compiler/src/beam_flatten.erl | 3 | ||||
-rw-r--r-- | lib/compiler/src/beam_split.erl | 3 | ||||
-rw-r--r-- | lib/compiler/src/beam_utils.erl | 14 | ||||
-rw-r--r-- | lib/compiler/src/beam_validator.erl | 4 | ||||
-rw-r--r-- | lib/compiler/src/cerl.erl | 4 | ||||
-rw-r--r-- | lib/compiler/src/cerl_inline.erl | 36 | ||||
-rw-r--r-- | lib/compiler/src/cerl_trees.erl | 4 | ||||
-rw-r--r-- | lib/compiler/src/compile.erl | 5 | ||||
-rw-r--r-- | lib/compiler/src/core_lint.erl | 102 | ||||
-rw-r--r-- | lib/compiler/src/core_pp.erl | 4 | ||||
-rw-r--r-- | lib/compiler/src/sys_pre_expand.erl | 53 | ||||
-rw-r--r-- | lib/compiler/src/v3_codegen.erl | 73 | ||||
-rw-r--r-- | lib/compiler/src/v3_core.erl | 432 | ||||
-rw-r--r-- | lib/compiler/src/v3_kernel.erl | 61 | ||||
-rw-r--r-- | lib/compiler/src/v3_kernel.hrl | 2 |
16 files changed, 498 insertions, 305 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_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_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..3d9fc3a609 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), @@ -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. @@ -1181,7 +1220,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 +1241,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 +1288,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 +1513,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 +1599,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 +1711,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 +1721,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 +1731,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 +1759,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 +2067,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 +2445,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}). |