diff options
Diffstat (limited to 'lib/compiler/src')
37 files changed, 1248 insertions, 686 deletions
diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index 3dfa67a771..fe4f473846 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -92,6 +92,8 @@ rename_instr({put_map_assoc,Fail,S,D,R,L}) -> {put_map,Fail,assoc,S,D,R,L}; rename_instr({put_map_exact,Fail,S,D,R,L}) -> {put_map,Fail,exact,S,D,R,L}; +rename_instr({test,has_map_fields,Fail,Src,{list,List}}) -> + {test,has_map_fields,Fail,[Src|List]}; rename_instr({select_val=I,Reg,Fail,{list,List}}) -> {select,I,Reg,Fail,List}; rename_instr({select_tuple_arity=I,Reg,Fail,{list,List}}) -> diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 112b087f3c..f8cf178d2e 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -324,6 +324,8 @@ make_op({gc_bif,Bif,Fail,Live,Args,Dest}, Dict) -> encode_op(BifOp, [Fail,Live,{extfunc,erlang,Bif,Arity}|Args++[Dest]],Dict); make_op({bs_add=Op,Fail,[Src1,Src2,Unit],Dest}, Dict) -> encode_op(Op, [Fail,Src1,Src2,Unit,Dest], Dict); +make_op({test,Cond,Fail,Src,{list,_}=Ops}, Dict) -> + encode_op(Cond, [Fail,Src,Ops], Dict); make_op({test,Cond,Fail,Ops}, Dict) when is_list(Ops) -> encode_op(Cond, [Fail|Ops], Dict); make_op({test,Cond,Fail,Live,[Op|Ops],Dst}, Dict) when is_list(Ops) -> diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 3723cc19e1..7a30c68593 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -154,8 +154,8 @@ collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list}; 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_element,F,S,K,D}) -> - {set,[D],[S],{get_map_element,K,F}}; +collect({get_map_elements,F,S,{list,Gets}}) -> + {set,Gets,[S],{get_map_elements,F}}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; collect(fclearerror) -> {set,[],[],fclearerror}; collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror}; @@ -240,7 +240,7 @@ move_allocates_2(Alloc, [], Acc) -> alloc_may_pass({set,_,_,{alloc,_,_}}) -> false; alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false; -alloc_may_pass({set,_,_,{get_map_element,_,_}}) -> false; +alloc_may_pass({set,_,_,{get_map_elements,_}}) -> false; alloc_may_pass({set,_,_,put_list}) -> false; alloc_may_pass({set,_,_,put}) -> false; alloc_may_pass({set,_,_,_}) -> true. @@ -291,7 +291,11 @@ opt_moves([X0,Y0], Is0) -> not_possible -> {[X,Y0],Is2}; {X,_} -> {[X,Y0],Is2}; {Y,Is} -> {[X,Y],Is} - end. + end; +opt_moves(Ds, Is) -> + %% multiple destinations -> pass through + {Ds,Is}. + %% opt_move(Dest, [Instruction]) -> {UpdatedDest,[Instruction]} | not_possible %% If there is a {move,Dest,FinalDest} instruction diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 124abd13c1..5a4621dc37 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -318,6 +318,8 @@ split_block_label_used([{set,[_],_,{bif,_,{f,Fail}}}|_], Fail) -> true; split_block_label_used([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}|_], Fail) -> true; +split_block_label_used([{set,[_],_,{alloc,_,{put_map,_,{f,Fail}}}}|_], Fail) -> + true; split_block_label_used([_|Is], Fail) -> split_block_label_used(Is, Fail); split_block_label_used([], _) -> false. @@ -391,10 +393,14 @@ bopt_tree([{set,_,_,{bif,'xor',_}}|_], _, _) -> throw('xor'); bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) -> ProtForest0 = gb_trees:from_orddict([P || {_,any}=P <- gb_trees:to_list(Forest0)]), - {ProtPre,[{_,ProtTree}]} = bopt_tree(Code, ProtForest0, []), - Prot = {prot,ProtPre,ProtTree}, - Forest = gb_trees:enter(Dst, Prot, Forest0), - bopt_tree(Is, Forest, Pre); + case bopt_tree(Code, ProtForest0, []) of + {ProtPre,[{_,ProtTree}]} -> + Prot = {prot,ProtPre,ProtTree}, + Forest = gb_trees:enter(Dst, Prot, Forest0), + bopt_tree(Is, Forest, Pre); + _Res -> + throw(not_boolean_expr) + end; bopt_tree([{set,[Dst],[Src],move}=Move|Is], Forest, Pre) -> case {Src,Dst} of {{tmp,_},_} -> throw(move); @@ -432,9 +438,10 @@ bopt_bool_args(As, Forest) -> mapfoldl(fun bopt_bool_arg/2, Forest, As). bopt_bool_arg({T,_}=R, Forest) when T =:= x; T =:= y; T =:= tmp -> - Val = case gb_trees:get(R, Forest) of - any -> {test,is_eq_exact,fail,[R,{atom,true}]}; - Val0 -> Val0 + Val = case gb_trees:lookup(R, Forest) of + {value,any} -> {test,is_eq_exact,fail,[R,{atom,true}]}; + {value,Val0} -> Val0; + none -> throw(mixed) end, {Val,gb_trees:delete(R, Forest)}; bopt_bool_arg(Term, Forest) -> @@ -525,7 +532,9 @@ bopt_cg({prot,Pre0,Tree}, Fail, Rs0, Acc, St0) -> bopt_cg({atom,true}, _Fail, _Rs, Acc, St) -> {Acc,St}; bopt_cg({atom,false}, Fail, _Rs, Acc, St) -> - {[{jump,{f,Fail}}|Acc],St}. + {[{jump,{f,Fail}}|Acc],St}; +bopt_cg(_, _, _, _, _) -> + throw(not_boolean_expr). bopt_cg_not({'and',As0}) -> As = [bopt_cg_not(A) || A <- As0], @@ -538,7 +547,9 @@ bopt_cg_not({'not',Arg}) -> bopt_cg_not({test,Test,Fail,As}) -> {inverted_test,Test,Fail,As}; bopt_cg_not({atom,Bool}) when is_boolean(Bool) -> - {atom,not Bool}. + {atom,not Bool}; +bopt_cg_not(_) -> + throw(not_boolean_expr). bopt_cg_not_not({'and',As}) -> {'and',[bopt_cg_not_not(A) || A <- As]}; diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index fdfcb08125..d54c2a9fde 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -209,6 +209,7 @@ btb_reaches_match_2([{call,Arity,{f,Lbl}}|Is], Regs, D) -> btb_reaches_match_2([{apply,Arity}|Is], Regs, D) -> btb_call(Arity+2, apply, Regs, Is, D); btb_reaches_match_2([{call_fun,Live}=I|Is], Regs, D) -> + btb_ensure_not_used([{x,Live}], I, Regs), btb_call(Live, I, Regs, Is, D); btb_reaches_match_2([{make_fun2,_,_,_,Live}|Is], Regs, D) -> btb_call(Live, make_fun2, Regs, Is, D); diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 55f985ad0e..b653998252 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -262,8 +262,8 @@ replace([{bs_utf16_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D) when Lbl =/= 0 -> replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D); -replace([{get_map_element=I,{f,Lbl},Src,Key,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Src,Key,Dst}|Acc], D); +replace([{get_map_elements=I,{f,Lbl},Src,List}|Is], Acc, D) when Lbl =/= 0 -> + replace(Is, [{I,{f,label(Lbl, D)},Src,List}|Acc], D); replace([I|Is], Acc, D) -> replace(Is, [I|Acc], D); replace([], Acc, _) -> Acc. diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index 212b9fb03a..ea51673fa3 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-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 @@ -29,16 +29,24 @@ -type label() :: non_neg_integer(). +-type index() :: non_neg_integer(). + +-type atom_tab() :: gb_trees:tree(atom(), index()). +-type import_tab() :: gb_trees:tree(mfa(), index()). +-type fname_tab() :: gb_trees:tree(Name :: term(), index()). +-type line_tab() :: gb_trees:tree({Fname :: index(), Line :: term()}, index()). +-type literal_tab() :: dict:dict(Literal :: term(), index()). + -record(asm, - {atoms = gb_trees:empty() :: gb_tree(), %{Atom,Index} + {atoms = gb_trees:empty() :: atom_tab(), exports = [] :: [{label(), arity(), label()}], locals = [] :: [{label(), arity(), label()}], - imports = gb_trees:empty() :: gb_tree(), %{{M,F,A},Index} + imports = gb_trees:empty() :: import_tab(), strings = <<>> :: binary(), %String pool lambdas = [], %[{...}] - literals = dict:new() :: dict(), %Format: {Literal,Number} - fnames = gb_trees:empty() :: gb_tree(), %{Name,Index} - lines = gb_trees:empty() :: gb_tree(), %{{Fname,Line},Index} + literals = dict:new() :: literal_tab(), + fnames = gb_trees:empty() :: fname_tab(), + lines = gb_trees:empty() :: line_tab(), num_lines = 0 :: non_neg_integer(), %Number of line instructions next_import = 0 :: non_neg_integer(), string_offset = 0 :: non_neg_integer(), diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index e0d0d0fd1d..4bdfe4e0c2 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2013. All Rights Reserved. +%% Copyright Ericsson AB 2000-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 @@ -37,7 +37,8 @@ %%----------------------------------------------------------------------- --type literals() :: 'none' | gb_tree(). +-type index() :: non_neg_integer(). +-type literals() :: 'none' | gb_trees:tree(index(), term()). -type symbolic_tag() :: 'a' | 'f' | 'h' | 'i' | 'u' | 'x' | 'y' | 'z'. -type disasm_tag() :: symbolic_tag() | 'fr' | 'atom' | 'float' | 'literal'. -type disasm_term() :: 'nil' | {disasm_tag(), _}. @@ -216,7 +217,8 @@ optional_chunk(F, ChunkTag) -> %%----------------------------------------------------------------------- -type l_info() :: {non_neg_integer(), {_,_,_,_,_,_}}. --spec beam_disasm_lambdas('none' | binary(), gb_tree()) -> 'none' | [l_info()]. +-spec beam_disasm_lambdas('none' | binary(), gb_trees:tree(index(), _)) -> + 'none' | [l_info()]. beam_disasm_lambdas(none, _) -> none; beam_disasm_lambdas(<<_:32,Tab/binary>>, Atoms) -> @@ -366,9 +368,13 @@ disasm_instr(B, Bs, Atoms, Literals) -> select_tuple_arity -> disasm_select_inst(select_tuple_arity, Bs, Atoms, Literals); put_map_assoc -> - disasm_map_inst(put_map_assoc, Bs, Atoms, Literals); + disasm_map_inst(put_map_assoc, Arity, Bs, Atoms, Literals); put_map_exact -> - disasm_map_inst(put_map_exact, Bs, Atoms, Literals); + disasm_map_inst(put_map_exact, Arity, Bs, Atoms, Literals); + get_map_elements -> + disasm_map_inst(get_map_elements, Arity, Bs, Atoms, Literals); + has_map_fields -> + disasm_map_inst(has_map_fields, Arity, Bs, Atoms, Literals); _ -> try decode_n_args(Arity, Bs, Atoms, Literals) of {Args, RestBs} -> @@ -399,16 +405,15 @@ disasm_select_inst(Inst, Bs, Atoms, Literals) -> {List, RestBs} = decode_n_args(Len, Bs4, Atoms, Literals), {{Inst, [X,F,{Z,U,List}]}, RestBs}. -disasm_map_inst(Inst, Bs0, Atoms, Literals) -> - {F, Bs1} = decode_arg(Bs0, Atoms, Literals), - {S, Bs2} = decode_arg(Bs1, Atoms, Literals), - {X, Bs3} = decode_arg(Bs2, Atoms, Literals), - {N, Bs4} = decode_arg(Bs3, Atoms, Literals), - {Z, Bs5} = decode_arg(Bs4, Atoms, Literals), - {U, Bs6} = decode_arg(Bs5, Atoms, Literals), - {u, Len} = U, - {List, RestBs} = decode_n_args(Len, Bs6, Atoms, Literals), - {{Inst, [F,S,X,N,{Z,U,List}]}, RestBs}. +disasm_map_inst(Inst, Arity, Bs0, Atoms, Literals) -> + {Args0,Bs1} = decode_n_args(Arity, Bs0, Atoms, Literals), + %% no droplast .. + [Z|Args1] = lists:reverse(Args0), + Args = lists:reverse(Args1), + {U, Bs2} = decode_arg(Bs1, Atoms, Literals), + {u, Len} = U, + {List, RestBs} = decode_n_args(Len, Bs2, Atoms, Literals), + {{Inst, Args ++ [{Z,U,List}]}, RestBs}. %%----------------------------------------------------------------------- %% decode_arg([Byte]) -> {Arg, [Byte]} @@ -432,7 +437,8 @@ decode_arg([B|Bs]) -> decode_int(Tag, B, Bs) end. --spec decode_arg([byte(),...], gb_tree(), literals()) -> {disasm_term(), [byte()]}. +-spec decode_arg([byte(),...], gb_trees:tree(index(), _), literals()) -> + {disasm_term(), [byte()]}. decode_arg([B|Bs0], Atoms, Literals) -> Tag = decode_tag(B band 2#111), @@ -1134,7 +1140,7 @@ resolve_inst({line,[Index]},_,_,_) -> {line,resolve_arg(Index)}; %% -%% R17A. +%% 17.0 %% resolve_inst({put_map_assoc,Args},_,_,_) -> [FLbl,Src,Dst,{u,N},{{z,1},{u,_Len},List0}] = Args, @@ -1150,9 +1156,15 @@ resolve_inst({is_map,Args0},_,_,_) -> [FLbl|Args] = resolve_args(Args0), {test, is_map, FLbl, Args}; -resolve_inst({get_map_element,Args},_,_,_) -> - [FLbl,Src,Key,Dst] = resolve_args(Args), - {get_map_element,FLbl,Src,Key,Dst}; +resolve_inst({has_map_fields,Args0},_,_,_) -> + [FLbl,Src,{{z,1},{u,_Len},List0}] = Args0, + List = resolve_args(List0), + {test,has_map_fields,FLbl,Src,{list,List}}; + +resolve_inst({get_map_elements,Args0},_,_,_) -> + [FLbl,Src,{{z,1},{u,_Len},List0}] = Args0, + List = resolve_args(List0), + {get_map_elements,FLbl,Src,{list,List}}; %% %% Catches instructions that are not yet handled. diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 534bc6d954..46835bece1 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -63,8 +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,[D],[S],{get_map_element,K,F}}) -> - {get_map_element,F,S,K,D}; +norm({set,Gets,[S],{get_map_elements,F}}) -> + {get_map_elements,F,S,{list,Gets}}; norm({set,[],[],remove_message}) -> remove_message; norm({set,[],[],fclearerror}) -> fclearerror; norm({set,[],[],fcheckerror}) -> {fcheckerror,{f,0}}. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 1f720b94c3..b952139f2c 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -446,11 +446,13 @@ is_label_used_in_2({set,_,_,Info}, Lbl) -> case Info of {bif,_,{f,F}} -> F =:= Lbl; {alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl; + {alloc,_,{put_map,_,{f,F}}} -> F =:= Lbl; {'catch',{f,F}} -> F =:= Lbl; {alloc,_,_} -> false; {put_tuple,_} -> false; {get_tuple_element,_} -> false; {set_tuple_element,_} -> false; + {get_map_elements,{f,F}} -> F =:= Lbl; {line,_} -> false; _ when is_atom(Info) -> false end. @@ -529,7 +531,7 @@ ulbl({bs_put,Lbl,_,_}, Used) -> mark_used(Lbl, Used); ulbl({put_map,Lbl,_Op,_Src,_Dst,_Live,_List}, Used) -> mark_used(Lbl, Used); -ulbl({get_map_element,Lbl,_Src,_Key,_Dst}, Used) -> +ulbl({get_map_elements,Lbl,_Src,_List}, Used) -> mark_used(Lbl, Used); ulbl(_, Used) -> Used. diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index 638a4826ea..688bba9a94 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -53,9 +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,[D],[S],{get_map_element,K,{f,Lbl}=Fail}}|Is], Bl, Acc) +split_block([{set,Gets,[S],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc) when Lbl =/= 0 -> - split_block(Is, [], [{get_map_element,Fail,S,K,D}|make_block(Bl, Acc)]); + 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)]); split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) -> diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index a3f16cfa8f..8ca368c167 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -185,6 +185,7 @@ is_pure_test({test,is_lt,_,[_,_]}) -> true; is_pure_test({test,is_nil,_,[_]}) -> true; is_pure_test({test,is_nonempty_list,_,[_]}) -> true; is_pure_test({test,test_arity,_,[_,_]}) -> true; +is_pure_test({test,has_map_fields,_,[_,{list,_}]}) -> true; is_pure_test({test,Op,_,Ops}) -> erl_internal:new_type_test(Op, length(Ops)). @@ -747,6 +748,8 @@ live_opt([{try_end,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{loop_rec_end,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); +live_opt([{wait_timeout,_,nil}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{line,_}=I|Is], Regs, D, Acc) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 97f84da08f..9d5563d13b 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-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 @@ -213,9 +213,12 @@ validate_error_1(Error, Module, Name, Ar) -> {{Module,Name,Ar}, {internal_error,'_',{Error,erlang:get_stacktrace()}}}. +-type index() :: non_neg_integer(). +-type reg_tab() :: gb_trees:tree(index(), 'none' | {'value', _}). + -record(st, %Emulation state - {x=init_regs(0, term) :: gb_tree(), %x register info. - y=init_regs(0, initialized) :: gb_tree(), %y register info. + {x=init_regs(0, term) :: reg_tab(),%x register info. + y=init_regs(0, initialized) :: reg_tab(),%y register info. f=init_fregs(), % numy=none, %Number of y registers. h=0, %Available heap size. @@ -227,11 +230,16 @@ validate_error_1(Error, Module, Name, Ar) -> setelem=false %Previous instruction was setelement/3. }). +-type label() :: integer(). +-type label_set() :: gb_sets:set(label()). +-type branched_tab() :: gb_trees:tree(label(), #st{}). +-type ft_tab() :: gb_trees:tree(). + -record(vst, %Validator state {current=none :: #st{} | 'none', %Current state - branched=gb_trees:empty() :: gb_tree(), %States at jumps - labels=gb_sets:empty() :: gb_set(), %All defined labels - ft=gb_trees:empty() :: gb_tree() %Some other functions + branched=gb_trees:empty() :: branched_tab(), %States at jumps + labels=gb_sets:empty() :: label_set(), %All defined labels + ft=gb_trees:empty() :: ft_tab() %Some other functions % in the module (those that start with bs_start_match2). }). @@ -574,6 +582,7 @@ valfun_4({apply,Live}, Vst) -> valfun_4({apply_last,Live,_}, Vst) -> tail_call(apply, Live+2, Vst); valfun_4({call_fun,Live}, Vst) -> + validate_src([{x,Live}], Vst), call('fun', Live+1, Vst); valfun_4({call,Live,Func}, Vst) -> call(Func, Live, Vst); @@ -769,6 +778,10 @@ valfun_4({test,is_nonempty_list,{f,Lbl},[Cons]}, Vst) -> valfun_4({test,test_arity,{f,Lbl},[Tuple,Sz]}, Vst) when is_integer(Sz) -> assert_type(tuple, Tuple, Vst), set_type_reg({tuple,Sz}, Tuple, branch_state(Lbl, Vst)); +valfun_4({test,has_map_fields,{f,Lbl},Src,{list,List}}, Vst) -> + validate_src([Src], Vst), + assert_strict_literal_termorder(List), + branch_state(Lbl, Vst); valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> validate_src(Src, Vst), branch_state(Lbl, Vst); @@ -870,18 +883,27 @@ valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> verify_put_map(Fail, Src, Dst, Live, List, Vst); valfun_4({put_map_exact,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> verify_put_map(Fail, Src, Dst, Live, List, Vst); -valfun_4({get_map_element,{f,Fail},Src,Key,Dst}, Vst0) -> - assert_term(Src, Vst0), - assert_term(Key, Vst0), - Vst = branch_state(Fail, Vst0), - set_type_reg(term, Dst, Vst); +valfun_4({get_map_elements,{f,Fail},Src,{list,List}}, Vst) -> + verify_get_map(Fail, Src, List, Vst); valfun_4(_, _) -> error(unknown_instruction). +verify_get_map(Fail, Src, List, Vst0) -> + assert_term(Src, Vst0), + Vst1 = branch_state(Fail, Vst0), + Lits = mmap(fun(L,_R) -> [L] end, List), + assert_strict_literal_termorder(Lits), + verify_get_map_pair(List,Vst0,Vst1). + +verify_get_map_pair([],_,Vst) -> Vst; +verify_get_map_pair([Src,Dst|Vs],Vst0,Vsti) -> + assert_term(Src, Vst0), + verify_get_map_pair(Vs,Vst0,set_type_reg(term,Dst,Vsti)). + verify_put_map(Fail, Src, Dst, Live, List, Vst0) -> verify_live(Live, Vst0), verify_y_init(Vst0), - [assert_term(Term, Vst0) || Term <- List], + foreach(fun (Term) -> assert_term(Term, Vst0) end, List), assert_term(Src, Vst0), Vst1 = heap_alloc(0, Vst0), Vst2 = branch_state(Fail, Vst1), @@ -908,7 +930,7 @@ validate_bs_skip_utf(Fail, Ctx, Live, Vst0) -> branch_state(Fail, Vst). %% -%% Special state handling for setelement/3 and the set_tuple_element/3 instruction. +%% Special state handling for setelement/3 and set_tuple_element/3 instructions. %% A possibility for garbage collection must not occur between setelement/3 and %% set_tuple_element/3. %% @@ -1098,6 +1120,39 @@ assert_freg_set({fr,Fr}=Freg, #vst{current=#st{f=Fregs}}) end; 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) +assert_strict_literal_termorder(Ls) -> + Vs = lists:map(fun (L) -> get_literal(L) end, Ls), + case check_strict_value_termorder(Vs) of + true -> ok; + false -> error({not_strict_order, Ls}) + end. + +%% usage: +%% mmap(fun(A,B) -> [{A,B}] end, [1,2,3,4]), +%% [{1,2},{3,4}] + +mmap(F,List) -> + {arity,Ar} = erlang:fun_info(F,arity), + mmap(F,Ar,List). +mmap(_F,_,[]) -> []; +mmap(F,Ar,List) -> + {Hd,Tl} = lists:split(Ar,List), + apply(F,Hd) ++ mmap(F,Ar,Tl). + +check_strict_value_termorder([]) -> true; +check_strict_value_termorder([_]) -> true; +check_strict_value_termorder([V1,V2]) -> + erts_internal:cmp_term(V1,V2) < 0; +check_strict_value_termorder([V1,V2|Vs]) -> + case erts_internal:cmp_term(V1,V2) < 0 of + true -> check_strict_value_termorder([V2|Vs]); + false -> false + end. + %%% %%% Binary matching. %%% @@ -1333,6 +1388,7 @@ assert_term(Src, Vst) -> %% number Integer or Float of unknown value %% + assert_type(WantedType, Term, Vst) -> assert_type(WantedType, get_term_type(Term, Vst)). @@ -1348,7 +1404,6 @@ assert_type({tuple_element,I}, {tuple,Sz}) assert_type(Needed, Actual) -> error({bad_type,{needed,Needed},{actual,Actual}}). - %% upgrade_tuple_type(NewTupleType, OldType) -> TupleType. %% upgrade_tuple_type/2 is used when linear code finds out more and %% more information about a tuple type, so that the type gets more @@ -1429,6 +1484,15 @@ get_term_type_1({y,Y}=Reg, #vst{current=#st{y=Ys}}) when is_integer(Y) -> get_term_type_1(Src, _) -> error({bad_source,Src}). +%% get_literal(Src) -> literal_value(). +get_literal(nil) -> []; +get_literal({atom,A}) when is_atom(A) -> A; +get_literal({float,F}) when is_float(F) -> F; +get_literal({integer,I}) when is_integer(I) -> I; +get_literal({literal,L}) -> L; +get_literal(T) -> error({not_literal,T}). + + branch_arities([], _, #vst{}=Vst) -> Vst; branch_arities([Sz,{f,L}|T], Tuple, #vst{current=St}=Vst0) when is_integer(Sz) -> diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index 9953a48710..c2a6ef604e 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -78,6 +78,18 @@ undo_rename({put_map,Fail,assoc,S,D,R,L}) -> {put_map_assoc,Fail,S,D,R,L}; undo_rename({put_map,Fail,exact,S,D,R,L}) -> {put_map_exact,Fail,S,D,R,L}; +undo_rename({test,has_map_fields,Fail,[Src|List]}) -> + {test,has_map_fields,Fail,Src,{list,[to_typed_literal(V)||V<-List]}}; +undo_rename({get_map_elements,Fail,Src,{list, List}}) -> + {get_map_elements,Fail,Src,{list,[to_typed_literal(V)||V<-List]}}; undo_rename({select,I,Reg,Fail,List}) -> {I,Reg,Fail,{list,List}}; undo_rename(I) -> I. + +%% to_typed_literal(Arg) +%% transform Arg to specific literal i.e. float | integer | atom if applicable +to_typed_literal({literal, V}) when is_float(V) -> {float, V}; +to_typed_literal({literal, V}) when is_atom(V) -> {atom, V}; +to_typed_literal({literal, V}) when is_integer(V) -> {integer, V}; +to_typed_literal({literal, []}) -> nil; +to_typed_literal(V) -> V. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 60a8559950..e400e4f185 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -124,20 +124,21 @@ %% keep map exports here for now map_es/1, - update_c_map/2, - ann_c_map/2, + map_arg/1, + update_c_map/3, + ann_c_map/2, ann_c_map/3, map_pair_op/1,map_pair_key/1,map_pair_val/1, update_c_map_pair/4, ann_c_map_pair/4 ]). --export_type([c_binary/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, c_literal/0, - c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]). +-export_type([c_binary/0, c_bitstr/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, + c_literal/0, c_map_pair/0, c_module/0, c_tuple/0, + c_values/0, c_var/0, cerl/0, var_name/0]). -%% -%% needed by the include file below -- do not move -%% --type var_name() :: integer() | atom() | {atom(), integer()}. +%% HiPE does not understand Maps +%% (guard functions is_map/1 and map_size/1 in ann_c_map/3) +-compile(no_native). -include("core_parse.hrl"). @@ -172,6 +173,8 @@ | c_module() | c_primop() | c_receive() | c_seq() | c_try() | c_tuple() | c_values() | c_var(). +-type var_name() :: integer() | atom() | {atom(), integer()}. + %% ===================================================================== %% Representation (general) %% @@ -203,13 +206,15 @@ %% <td>call</td> %% <td>case</td> %% <td>catch</td> -%% </tr><tr> %% <td>clause</td> +%% </tr><tr> %% <td>cons</td> %% <td>fun</td> %% <td>let</td> %% <td>letrec</td> %% <td>literal</td> +%% <td>map</td> +%% <td>map_pair</td> %% <td>module</td> %% </tr><tr> %% <td>primop</td> @@ -260,10 +265,10 @@ %% @see subtrees/1 %% @see meta/1 --type ctype() :: 'alias' | 'apply' | 'binary' | 'bitrst' | 'call' | 'case' - | 'catch' | 'clause' | 'cons' | 'fun' | 'let' | 'letrec' - | 'literal' | 'map' | 'module' | 'primop' | 'receive' | 'seq' - | 'try' | 'tuple' | 'values' | 'var'. +-type ctype() :: 'alias' | 'apply' | 'binary' | 'bitrst' | 'call' | 'case' + | 'catch' | 'clause' | 'cons' | 'fun' | 'let' | 'letrec' + | 'literal' | 'map' | 'map_pair' | 'module' | 'primop' + | 'receive' | 'seq' | 'try' | 'tuple' | 'values' | 'var'. -spec type(cerl()) -> ctype(). @@ -1574,16 +1579,70 @@ ann_make_list(_, [], Node) -> %% --------------------------------------------------------------------- %% maps --spec map_es(c_map()) -> [cerl()]. +-spec map_es(c_map()) -> [c_map_pair()]. map_es(#c_map{es = Es}) -> Es. -ann_c_map(As, Es) -> - #c_map{es = Es, anno = As }. +-spec map_arg(c_map()) -> c_map() | c_literal(). + +map_arg(#c_map{arg = M}) -> + M. + +-spec ann_c_map([term()], [cerl()]) -> c_map() | c_literal(). + +ann_c_map(As,Es) -> + ann_c_map(As, #c_literal{val=#{}}, Es). + +-spec ann_c_map([term()], c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal(). + +ann_c_map(As,#c_literal{val=Mval}=M,Es) when is_map(Mval), map_size(Mval) =:= 0 -> + Pairs = [[Ck,Cv]||#c_map_pair{key=Ck,val=Cv}<-Es], + IsLit = lists:foldl(fun(Pair,Res) -> + Res andalso is_lit_list(Pair) + end, true, Pairs), + Fun = fun(Pair) -> [K,V] = lit_list_vals(Pair), {K,V} end, + case IsLit of + false -> + #c_map{arg=M, es=Es, anno=As }; + true -> + #c_literal{anno=As, val=maps:from_list(lists:map(Fun, Pairs))} + end; +ann_c_map(As,#c_literal{val=M},Es) when is_map(M) -> + fold_map_pairs(As,Es,M); +ann_c_map(As,M,Es) -> + #c_map{arg=M, es=Es, anno=As }. + +fold_map_pairs(As,[],M) -> #c_literal{anno=As,val=M}; +%% M#{ K => V} +fold_map_pairs(As,[#c_map_pair{op=#c_literal{val=assoc},key=Ck,val=Cv}=E|Es],M) -> + case is_lit_list([Ck,Cv]) of + true -> + [K,V] = lit_list_vals([Ck,Cv]), + fold_map_pairs(As,Es,maps:put(K,V,M)); + false -> + #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As } + end; +%% M#{ K := V} +fold_map_pairs(As,[#c_map_pair{op=#c_literal{val=exact},key=Ck,val=Cv}=E|Es],M) -> + case is_lit_list([Ck,Cv]) of + true -> + [K,V] = lit_list_vals([Ck,Cv]), + case maps:is_key(K,M) of + true -> fold_map_pairs(As,Es,maps:put(K,V,M)); + false -> + #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As } + end; + false -> + #c_map{arg=#c_literal{val=M,anno=As}, es=[E|Es], anno=As } + end; +fold_map_pairs(As,Es,M) -> + #c_map{arg=#c_literal{val=M,anno=As}, es=Es, anno=As }. + +%-spec update_c_map(c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal(). -update_c_map(Old, Es) -> - #c_map{es = Es, anno = get_ann(Old)}. +update_c_map(Old,M,Es) -> + #c_map{arg=M, es = Es, anno = get_ann(Old)}. map_pair_key(#c_map_pair{key=K}) -> K. map_pair_val(#c_map_pair{val=V}) -> V. @@ -4319,12 +4378,8 @@ meta_1(cons, Node) -> %% we get exactly one element, we generate a 'c_cons' call %% instead of 'make_list' to reconstruct the node. case split_list(Node) of - {[H], none} -> - meta_call(c_cons, [meta(H), meta(c_nil())]); {[H], Node1} -> meta_call(c_cons, [meta(H), meta(Node1)]); - {L, none} -> - meta_call(make_list, [make_list(meta_list(L))]); {L, Node1} -> meta_call(make_list, [make_list(meta_list(L)), meta(Node1)]) @@ -4411,8 +4466,6 @@ split_list(Node, L) -> case type(Node) of cons when A =:= [] -> split_list(cons_tl(Node), [cons_hd(Node) | L]); - nil when A =:= [] -> - {lists:reverse(L), none}; _ -> {lists:reverse(L), Node} end. diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl index 99fa8dd9d5..87bd47c08b 100644 --- a/lib/compiler/src/cerl_clauses.erl +++ b/lib/compiler/src/cerl_clauses.erl @@ -354,6 +354,29 @@ match(P, E, Bs) -> {false, Bs} end end; + map -> + %% The most we can do is to say "definitely no match" if a + %% map pattern is matched against non-map data. + case E of + any -> + {false, Bs}; + _ -> + case type(E) of + literal -> + case is_map(concrete(E)) of + false -> + none; + true -> + {false, Bs} + end; + cons -> + none; + tuple -> + none; + _ -> + {false, Bs} + end + end; _ -> match_1(P, E, Bs) end. diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index 3837b57750..75740e8b9d 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -42,7 +42,7 @@ bitstr_flags/1, binary_segments/1, update_c_alias/3, update_c_apply/3, update_c_binary/2, update_c_bitstr/6, update_c_call/4, update_c_case/3, update_c_catch/2, - update_c_clause/4, c_fun/2, c_int/1, c_let/3, + update_c_clause/4, c_fun/2, c_int/1, c_let/3, ann_c_let/4, update_c_let/4, update_c_letrec/3, update_c_module/5, update_c_primop/3, update_c_receive/4, update_c_seq/3, c_seq/2, update_c_try/6, c_tuple/1, update_c_values/2, @@ -51,7 +51,7 @@ catch_body/1, clause_body/1, clause_guard/1, clause_pats/1, clause_vars/1, concrete/1, cons_hd/1, cons_tl/1, data_arity/1, data_es/1, data_type/1, - fun_body/1, fun_vars/1, get_ann/1, int_val/1, + fname_arity/1, fun_body/1, fun_vars/1, get_ann/1, int_val/1, is_c_atom/1, is_c_cons/1, is_c_fname/1, is_c_int/1, is_c_list/1, is_c_seq/1, is_c_tuple/1, is_c_var/1, is_data/1, is_literal/1, is_literal_term/1, let_arg/1, @@ -64,7 +64,7 @@ seq_body/1, set_ann/2, try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, tuple_es/1, tuple_arity/1, type/1, values_es/1, var_name/1, - map_es/1, update_c_map/2, + map_arg/1, map_es/1, update_c_map/3, update_c_map_pair/4, map_pair_op/1, map_pair_key/1, map_pair_val/1 ]). @@ -1030,8 +1030,17 @@ i_apply(E, Ctxt, Ren, Env, S) -> visit_and_count_size(Opnd, S) end, S3, Opnds), - N = apply_size(length(Es)), - {update_c_apply(E, E1, Es), count_size(N, S4)} + Arity = length(Es), + E2 = case is_c_fname(E1) andalso length(Es) =/= fname_arity(E1) of + true -> + V = new_var(Env), + ann_c_let(get_ann(E), [V], E1, + update_c_apply(E, V, Es)); + false -> + update_c_apply(E, E1, Es) + end, + N = apply_size(Arity), + {E2, count_size(N, S4)} end. apply_size(A) -> @@ -1334,12 +1343,12 @@ i_bitstr(E, Ren, Env, S) -> i_map(E, Ctx, Ren, Env, S) -> %% Visit the segments for value. - {Es, S1} = mapfoldl(fun (E, S) -> - i_map_pair(E, Ctx, Ren, Env, S) - end, - S, map_es(E)), - S2 = count_size(weight(map), S1), - {update_c_map(E, Es), S2}. + {M1, S1} = i(map_arg(E), value, Ren, Env, S), + {Es, S2} = mapfoldl(fun (E, S) -> + i_map_pair(E, Ctx, Ren, Env, S) + end, S1, map_es(E)), + 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, @@ -1411,13 +1420,15 @@ 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)), + i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) + end, + S, map_es(E)), S2 = count_size(weight(map), S1), - {update_c_map(E, Es), S2}; + {update_c_map(E, M, Es), S2}; _ -> case is_literal(E) of true -> diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index 2542841eef..e53bdd4efb 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -57,9 +57,9 @@ update_c_try/6, update_c_tuple/2, update_c_tuple_skel/2, update_c_values/2, values_es/1, var_name/1, - map_es/1, - ann_c_map/2, - update_c_map/2, + map_arg/1, map_es/1, + ann_c_map/3, + update_c_map/3, map_pair_key/1,map_pair_val/1,map_pair_op/1, ann_c_map_pair/4, update_c_map_pair/4 @@ -138,7 +138,7 @@ map_1(F, T) -> tuple -> update_c_tuple_skel(T, map_list(F, tuple_es(T))); map -> - update_c_map(T, map_list(F, map_es(T))); + update_c_map(T, map(F, map_arg(T)), map_list(F, map_es(T))); map_pair -> update_c_map_pair(T, map(F, map_pair_op(T)), map(F, map_pair_key(T)), @@ -372,8 +372,9 @@ mapfold(F, S0, T) -> {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), F(update_c_tuple_skel(T, Ts), S1); map -> - {Ts, S1} = mapfold_list(F, S0, map_es(T)), - F(update_c_map(T, Ts), S1); + {M , S1} = mapfold(F, S0, map_arg(T)), + {Ts, S2} = mapfold_list(F, S1, map_es(T)), + F(update_c_map(T, M, Ts), S2); map_pair -> {Op, S1} = mapfold(F, S0, map_pair_op(T)), {Key, S2} = mapfold(F, S1, map_pair_key(T)), @@ -723,9 +724,10 @@ label(T, N, Env) -> {As, N2} = label_ann(T, N1), {ann_c_tuple_skel(As, Ts), N2}; map -> - {Ts, N1} = label_list(map_es(T), N, Env), - {As, N2} = label_ann(T, N1), - {ann_c_map(As, Ts), N2}; + {M, N1} = label(map_arg(T), N, Env), + {Ts, N2} = label_list(map_es(T), N1, Env), + {As, N3} = label_ann(T, N2), + {ann_c_map(As, M, Ts), N3}; map_pair -> {Op, N1} = label(map_pair_op(T), N, Env), {Val, N2} = label(map_pair_key(T), N1, Env), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 0bb4de6f17..c7d91070f6 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -234,7 +234,9 @@ format_error({crash,Pass,Reason}) -> format_error({bad_return,Pass,Reason}) -> io_lib:format("internal error in ~p;\nbad return value: ~ts", [Pass,format_error_reason(Reason)]); format_error({module_name,Mod,Filename}) -> - io_lib:format("Module name '~s' does not match file name '~ts'", [Mod,Filename]). + io_lib:format("Module name '~s' does not match file name '~ts'", [Mod,Filename]); +format_error(reparsing_invalid_unicode) -> + "Non-UTF-8 character(s) detected, but no encoding declared. Encode the file in UTF-8 or add \"%% coding: latin-1\" at the beginning of the file. Retrying with latin-1 encoding.". format_error_reason({Reason, Stack}) when is_list(Stack) -> StackFun = fun @@ -246,7 +248,7 @@ format_error_reason({Reason, Stack}) when is_list(Stack) -> end, FormatFun = fun (Term, _) -> io_lib:format("~tp", [Term]) end, [io_lib:format("~tp", [Reason]),"\n\n", - lib:format_stacktrace(1, erlang:get_stacktrace(), StackFun, FormatFun)]; + lib:format_stacktrace(1, Stack, StackFun, FormatFun)]; format_error_reason(Reason) -> io_lib:format("~tp", [Reason]). @@ -430,10 +432,9 @@ pass(from_core) -> pass(from_asm) -> {".S",[?pass(beam_consult_asm)|asm_passes()]}; pass(asm) -> - %% TODO: remove 'asm' in R18 - io:format("compile:file/2 option 'asm' has been deprecated and will be " - "removed in R18.~n" - "Use 'from_asm' instead.~n"), + %% 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()]}; @@ -623,9 +624,11 @@ core_passes() -> [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1}, {iff,doldinline,{listing,"oldinline"}}, ?pass(core_fold_module), + {iff,dcorefold,{listing,"corefold"}}, {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1}, {iff,dinline,{listing,"inline"}}, - {core_fold_after_inlining,fun test_core_inliner/1,fun core_fold_module_after_inlining/1}, + {core_fold_after_inlining,fun test_any_inliner/1, + fun core_fold_module_after_inlining/1}, ?pass(core_transforms)]}, {iff,dcopt,{listing,"copt"}}, {iff,'to_core',{done,"core"}}]} @@ -791,20 +794,59 @@ no_native_compilation(BeamFile, #compile{options=Opts0}) -> _ -> false end. -parse_module(St) -> - Opts = St#compile.options, - Cwd = ".", - IncludePath = [Cwd, St#compile.dir|inc_paths(Opts)], - R = epp:parse_file(St#compile.ifile, IncludePath, pre_defs(Opts)), +parse_module(St0) -> + case do_parse_module(utf8, St0) of + {ok,_}=Ret -> + Ret; + {error,_}=Ret -> + Ret; + {invalid_unicode,File,Line} -> + case do_parse_module(latin1, St0) of + {ok,St} -> + Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}], + {ok,St#compile{warnings=Es++St#compile.warnings}}; + {error,St} -> + Es = [{File,[{Line,?MODULE,reparsing_invalid_unicode}]}], + {error,St#compile{errors=Es++St#compile.errors}} + end + end. + +do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) -> + R = epp:parse_file(File, + [{includes,[".",Dir|inc_paths(Opts)]}, + {macros,pre_defs(Opts)}, + {default_encoding,DefEncoding}, + extra]), case R of - {ok,Forms} -> - Encoding = epp:read_encoding(St#compile.ifile), - {ok,St#compile{code=Forms,encoding=Encoding}}; + {ok,Forms,Extra} -> + Encoding = proplists:get_value(encoding, Extra), + case find_invalid_unicode(Forms, File) of + none -> + {ok,St#compile{code=Forms,encoding=Encoding}}; + {invalid_unicode,_,_}=Ret -> + case Encoding of + none -> + Ret; + _ -> + {ok,St#compile{code=Forms,encoding=Encoding}} + end + end; {error,E} -> Es = [{St#compile.ifile,[{none,?MODULE,{epp,E}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} end. +find_invalid_unicode([H|T], File0) -> + case H of + {attribute,_,file,{File,_}} -> + find_invalid_unicode(T, File); + {error,{Line,file_io_server,invalid_unicode}} -> + {invalid_unicode,File0,Line}; + _Other -> + find_invalid_unicode(T, File0) + end; +find_invalid_unicode([], _) -> none. + parse_core(St) -> case file:read_file(St#compile.ifile) of {ok,Bin} -> @@ -1171,6 +1213,9 @@ test_core_inliner(#compile{options=Opts}) -> end, Opts) end. +test_any_inliner(St) -> + test_old_inliner(St) orelse test_core_inliner(St). + core_old_inliner(#compile{code=Code0,options=Opts}=St) -> {ok,Code} = sys_core_inline:module(Code0, Opts), {ok,St#compile{code=Code}}. diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 8775c84698..8f68915f8e 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -67,4 +67,6 @@ ]}, {registered, []}, {applications, [kernel, stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0", + "crypto-3.3"]}]}. diff --git a/lib/compiler/src/compiler.appup.src b/lib/compiler/src/compiler.appup.src index 54a63833e6..fe273b269c 100644 --- a/lib/compiler/src/compiler.appup.src +++ b/lib/compiler/src/compiler.appup.src @@ -1 +1,21 @@ -{"%VSN%",[],[]}. +%% -*- erlang -*- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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 +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +{"%VSN%", + [{<<".*">>,[{restart_application, compiler}]}], + [{<<".*">>,[{restart_application, compiler}]}] +}. diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index f506901099..93ec3bbad5 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -105,8 +105,8 @@ vu_expr(V, #c_cons{hd=H,tl=T}) -> vu_expr(V, H) orelse vu_expr(V, T); vu_expr(V, #c_tuple{es=Es}) -> vu_expr_list(V, Es); -vu_expr(V, #c_map{es=Es}) -> - vu_expr_list(V, Es); +vu_expr(V, #c_map{arg=M,es=Es}) -> + vu_expr(V, M) orelse vu_expr_list(V, Es); vu_expr(V, #c_map_pair{key=Key,val=Val}) -> vu_expr_list(V, [Key,Val]); vu_expr(V, #c_binary{segments=Ss}) -> diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 36165245a6..25df33a287 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -267,10 +267,21 @@ gexpr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) -> St1 = gbody(Arg, Def, let_varcount(Vs), St0), %This is a guard body {Lvs,St2} = variable_list(Vs, St1), gbody(B, union(Lvs, Def), Rt, St2); -gexpr(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{}, - args=As}, Def, 1, St) -> - gexpr_list(As, Def, St); +gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}, + args=[Arg,#c_literal{val=Tag},#c_literal{val=Size}]}, + Def, 1, St) when is_atom(Tag), is_integer(Size) -> + gexpr(Arg, Def, 1, St); +gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}}, + _Def, 1, St) -> + add_error({illegal_guard,St#lint.func}, St); +gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As}, + Def, 1, St) when is_atom(Name) -> + case is_guard_bif(Name, length(As)) of + true -> + gexpr_list(As, Def, St); + false -> + add_error({illegal_guard,St#lint.func}, St) + end; gexpr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) -> gexpr_list(As, Def, St0); gexpr(#c_try{arg=E,vars=[#c_var{name=X}],body=#c_var{name=X}, @@ -298,6 +309,14 @@ gbitstr_list(Es, Def, St0) -> gbitstr(#c_bitstr{val=V,size=S}, Def, St) -> gexpr_list([V,S], Def, St). +%% is_guard_bif(Name, Arity) -> Boolean. + +is_guard_bif(Name, Arity) -> + erl_internal:guard_bif(Name, Arity) + orelse erl_internal:arith_op(Name, Arity) + orelse erl_internal:bool_op(Name, Arity) + orelse erl_internal:comp_op(Name, Arity). + %% expr(Expr, Defined, RetCount, State) -> State. expr(#c_var{name={_,_}=FA}, Def, _Rt, St) -> diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl index d54715ef59..4a00535360 100644 --- a/lib/compiler/src/core_parse.hrl +++ b/lib/compiler/src/core_parse.hrl @@ -34,7 +34,7 @@ -record(c_apply, {anno=[], op, % op :: Tree, args}). % args :: [Tree] --record(c_binary, {anno=[], segments}). % segments :: [#c_bitstr{}] +-record(c_binary, {anno=[], segments :: [cerl:c_bitstr()]}). -record(c_bitstr, {anno=[], val, % val :: Tree, size, % size :: Tree, @@ -70,6 +70,15 @@ -record(c_literal, {anno=[], val}). % val :: literal() +-record(c_map, {anno=[], + arg=#c_literal{val=#{}} :: cerl:c_var() | cerl:c_literal(), + es :: [cerl:c_map_pair()]}). + +-record(c_map_pair, {anno=[], + op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}, + key, + val}). + -record(c_module, {anno=[], name, % name :: Tree, exports, % exports :: [Tree], attrs, % attrs :: [#c_def{}], @@ -96,12 +105,3 @@ -record(c_values, {anno=[], es}). % es :: [Tree] -record(c_var, {anno=[], name :: cerl:var_name()}). - --record(c_map_pair, {anno=[], - op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}, - key, - val}). - --record(c_map, {anno=[], - var=#c_literal{val=[]} :: #c_var{} | #c_literal{}, - es :: [#c_map_pair{}]}). diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl index b8db0f683a..a66ad4235f 100644 --- a/lib/compiler/src/core_parse.yrl +++ b/lib/compiler/src/core_parse.yrl @@ -21,7 +21,7 @@ %% Have explicit productions for annotated phrases named anno_XXX. %% This just does an XXX and adds the annotation. -Expect 1. +Expect 0. Nonterminals @@ -285,9 +285,9 @@ tuple -> '{' '}' : c_tuple([]). tuple -> '{' anno_expressions '}' : c_tuple('$2'). map_expr -> '~' '{' '}' '~' : #c_map{es=[]}. -map_expr -> '~' '{' map_pairs '}' '~' : #c_map{es='$3'}. -map_expr -> variable '~' '{' '}' '~' : #c_map{var='$1',es=[]}. -map_expr -> variable '~' '{' map_pairs '}' '~' : #c_map{var='$1',es='$4'}. +map_expr -> '~' '{' map_pairs '}' '~' : #c_map{es='$3'}. +map_expr -> '~' '{' map_pairs '|' variable '}' '~' : #c_map{arg='$5',es='$3'}. +map_expr -> '~' '{' map_pairs '|' map_expr '}' '~' : #c_map{arg='$5',es='$3'}. map_pairs -> map_pair : ['$1']. map_pairs -> map_pair ',' map_pairs : ['$1' | '$3']. diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index faa26ec6df..a76327457d 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -118,6 +118,12 @@ format_1(#c_literal{val=Tuple}, Ctxt) when is_tuple(Tuple) -> format_1(#c_literal{anno=A,val=Bitstring}, Ctxt) when is_bitstring(Bitstring) -> Segs = segs_from_bitstring(Bitstring), format_1(#c_binary{anno=A,segments=Segs}, Ctxt); +format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) -> + Pairs = maps:to_list(M), + Cpairs = [#c_map_pair{op=#c_literal{val=assoc}, + key=#c_literal{val=V}, + val=#c_literal{val=K}} || {K,V} <- Pairs], + format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt); format_1(#c_var{name={I,A}}, _) -> [core_atom(I),$/,integer_to_list(A)]; format_1(#c_var{name=V}, _) -> @@ -161,15 +167,15 @@ format_1(#c_tuple{es=Es}, Ctxt) -> format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), $} ]; -format_1(#c_map{var=#c_var{}=Var,es=Es}, Ctxt) -> - [format_1(Var, Ctxt), - "~{", +format_1(#c_map{arg=#c_literal{val=M},es=Es}, Ctxt) when is_map(M),map_size(M)=:=0 -> + ["~{", format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), "}~" ]; -format_1(#c_map{es=Es}, Ctxt) -> +format_1(#c_map{arg=Var,es=Es}, Ctxt) -> ["~{", format_hseq(Es, ",", add_indent(Ctxt, 1), fun format/2), + "|",format(Var, add_indent(Ctxt, 1)), "}~" ]; format_1(#c_map_pair{op=#c_literal{val=assoc},key=K,val=V}, Ctxt) -> diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 3ad3c8c690..6c75538194 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -91,6 +91,7 @@ is_pure(erlang, is_float, 1) -> true; is_pure(erlang, is_function, 1) -> true; is_pure(erlang, is_integer, 1) -> true; is_pure(erlang, is_list, 1) -> true; +is_pure(erlang, is_map, 1) -> true; is_pure(erlang, is_number, 1) -> true; is_pure(erlang, is_pid, 1) -> true; is_pure(erlang, is_port, 1) -> true; diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 79b467f949..7d6bf56ccb 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -529,10 +529,10 @@ BEAM_FORMAT_NUMBER=0 153: line/1 -# R16 +# R17 154: put_map_assoc/5 155: put_map_exact/5 156: is_map/2 -157: has_map_field/3 -158: get_map_element/4 +157: has_map_fields/3 +158: get_map_elements/3 diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl index 31a1f8b0b7..555a331bd7 100644 --- a/lib/compiler/src/rec_env.erl +++ b/lib/compiler/src/rec_env.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-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 @@ -72,6 +72,7 @@ test_1({custom, F} = Type, N, Env) when is_integer(N), N > 0 -> test_1(_,0, Env) -> Env. -endif. +%%@clear %% Representation: @@ -95,7 +96,7 @@ test_1(_,0, Env) -> %% ===================================================================== %% @type environment(). An abstract environment. --type mapping() :: {'map', dict()} | {'rec', dict(), dict()}. +-type mapping() :: {'map', dict:dict()} | {'rec', dict:dict(), dict:dict()}. -type environment() :: [mapping(),...]. %% ===================================================================== diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 1cdbac5693..52d6dfe184 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -72,7 +72,7 @@ -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2, reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]). --import(cerl, [ann_c_cons/3,ann_c_tuple/2]). +-import(cerl, [ann_c_cons/3,ann_c_map/3,ann_c_tuple/2]). -include("core_parse.hrl"). @@ -246,7 +246,7 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) -> value -> ann_c_tuple(Anno, Es) end; -expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) -> +expr(#c_map{anno=Anno,arg=V0,es=Es0}=Map, Ctxt, Sub) -> Es = pair_list(Es0, Ctxt, Sub), case Ctxt of effect -> @@ -254,7 +254,7 @@ expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) -> expr(make_effect_seq(Es, Sub), Ctxt, Sub); value -> V = expr(V0, Ctxt, Sub), - Map#c_map{var=V,es=Es} + ann_c_map(Anno,V,Es) end; expr(#c_binary{segments=Ss}=Bin0, Ctxt, Sub) -> %% Warn for useless building, but always build the binary @@ -305,6 +305,10 @@ expr(#c_let{}=Let, Ctxt, Sub) -> %% Now recursively re-process the new expression. expr(Expr, Ctxt, sub_new_preserve_types(Sub)) end; +expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) -> + %% This is named fun in an 'effect' context. Warn and ignore. + add_warning(Letrec, useless_building), + void(); expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) -> Fs1 = map(fun ({Name,Fb}) -> {Name,expr(Fb, {letrec,Ctxt}, Sub)} @@ -349,7 +353,12 @@ expr(#c_case{}=Case0, Ctxt, Sub) -> Case = Case1#c_case{arg=Arg2,clauses=Cs2}, warn_no_clause_match(Case1, Case), Expr = eval_case(Case, Sub), - bsm_an(Expr); + case move_case_into_arg(Case, Sub) of + impossible -> + bsm_an(Expr); + Other -> + expr(Other, Ctxt, sub_new_preserve_types(Sub)) + end; Other -> expr(Other, Ctxt, Sub) end; @@ -598,6 +607,14 @@ eval_binary_1([#c_bitstr{val=#c_literal{val=Val},size=#c_literal{val=Sz}, error:_ -> throw(impossible) end; +eval_binary_1([#c_bitstr{val=#c_literal{},size=#c_literal{}, + unit=#c_literal{},type=#c_literal{}, + flags=#c_cons{}=Flags}=Bitstr|Ss], Acc0) -> + case cerl:fold_literal(Flags) of + #c_literal{} = Flags1 -> + eval_binary_1([Bitstr#c_bitstr{flags=Flags1}|Ss], Acc0); + _ -> throw(impossible) + end; eval_binary_1([], Acc) -> Acc; eval_binary_1(_, _) -> throw(impossible). @@ -1361,6 +1378,7 @@ eval_is_record(Call, _, _, _, _) -> Call. is_not_integer(#c_literal{val=Val}) when not is_integer(Val) -> true; is_not_integer(#c_tuple{}) -> true; is_not_integer(#c_cons{}) -> true; +is_not_integer(#c_map{}) -> true; is_not_integer(_) -> false. %% is_not_tuple(Core) -> true | false. @@ -1368,6 +1386,7 @@ is_not_integer(_) -> false. is_not_tuple(#c_literal{val=Val}) when not is_tuple(Val) -> true; is_not_tuple(#c_cons{}) -> true; +is_not_tuple(#c_map{}) -> true; is_not_tuple(_) -> false. %% eval_setelement(Call, Pos, Tuple, NewVal) -> Core. @@ -1536,9 +1555,17 @@ map_pair_pattern_list(Ps0, Isub, Osub0) -> {Ps,{_,Osub}} = mapfoldl(fun map_pair_pattern/2, {Isub,Osub0}, Ps0), {Ps,Osub}. -map_pair_pattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair, {Isub,Osub0}) -> - {K,Osub1} = pattern(K0, Isub, Osub0), - {V,Osub} = pattern(V0, Isub, Osub1), +map_pair_pattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,{Isub,Osub0}) -> + {K,Osub1} = case cerl:type(K0) of + binary -> + K1 = eval_binary(K0), + case cerl:type(K1) of + literal -> {K1,Osub0}; + _ -> pattern(K0,Isub,Osub0) + end; + _ -> pattern(K0,Isub,Osub0) + end, + {V,Osub} = pattern(V0,Isub,Osub1), {Pair#c_map_pair{key=K,val=V},{Isub,Osub}}. bin_pattern_list(Ps0, Isub, Osub0) -> @@ -1785,9 +1812,14 @@ opt_bool_clauses([#c_clause{pats=[#c_literal{val=Lit}], true -> %% This clause will match. C = C0#c_clause{body=opt_bool_case(B)}, - case Lit of - false -> [C|opt_bool_clauses(Cs, SeenT, true)]; - true -> [C|opt_bool_clauses(Cs, true, SeenF)] + case {Lit,SeenT,SeenF} of + {false,_,false} -> + [C|opt_bool_clauses(Cs, SeenT, true)]; + {true,false,_} -> + [C|opt_bool_clauses(Cs, true, SeenF)]; + _ -> + add_warning(C, nomatch_shadow), + opt_bool_clauses(Cs, SeenT, SeenF) end end; opt_bool_clauses([#c_clause{pats=Ps,guard=#c_literal{val=true}}=C|Cs], SeenT, SeenF) -> @@ -1920,14 +1952,45 @@ opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=false}]}=Fc,Tc]) -> %% last clause is guaranteed to match so if there is only one clause %% with a pattern containing only variables then rewrite to a let. -eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) -> +eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0, + guard=#c_literal{val=true}, + body=B}]}=Case, Sub) -> Es = case cerl:is_c_values(E) of true -> cerl:values_es(E); false -> [E] end, - {true,Bs} = cerl_clauses:match_list(Ps0, Es), - {Ps,As} = unzip(Bs), - expr(#c_let{vars=Ps,arg=core_lib:make_values(As),body=B}, sub_new(Sub)); + %% Consider: + %% + %% case SomeSideEffect() of + %% X=Y -> ... + %% end + %% + %% We must not rewrite it to: + %% + %% let <X,Y> = <SomeSideEffect(),SomeSideEffect()> in ... + %% + %% because SomeSideEffect() would be evaluated twice. + %% + %% Instead we must evaluate the case expression in an outer let + %% like this: + %% + %% let NewVar = SomeSideEffect() in + %% let <X,Y> = <NewVar,NewVar> in ... + %% + Vs = make_vars([], length(Es)), + case cerl_clauses:match_list(Ps0, Vs) of + {false,_} -> + %% This can only happen if the Core Erlang code is + %% handwritten or generated by another code generator + %% than v3_core. Assuming that the Core Erlang program + %% is correct, the clause will always match at run-time. + Case; + {true,Bs} -> + {Ps,As} = unzip(Bs), + InnerLet = cerl:c_let(Ps, core_lib:make_values(As), B), + Let = cerl:c_let(Vs, E, InnerLet), + expr(Let, sub_new(Sub)) + end; eval_case(Case, _) -> Case. %% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}. @@ -2290,16 +2353,31 @@ is_safe_bool_expr(Core, Sub) -> is_safe_bool_expr_1(Core, Sub, gb_sets:empty()). is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_record}, - args=[_,_]}, - _Sub, _BoolVars) -> + name=#c_literal{val=is_record}, + args=[A,#c_literal{val=Tag},#c_literal{val=Size}]}, + Sub, _BoolVars) when is_atom(Tag), is_integer(Size) -> + is_safe_simple(A, Sub); +is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_record}}, + _Sub, _BoolVars) -> %% The is_record/2 BIF is NOT allowed in guards. + %% The is_record/3 BIF where its second argument is not an atom or its third + %% is not an integer is NOT allowed in guards. %% %% NOTE: Calls like is_record(Expr, LiteralTag), where LiteralTag %% is a literal atom referring to a defined record, have already %% been rewritten to is_record(Expr, LiteralTag, TupleSize). false; is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[A,#c_literal{val=Arity}]}, + Sub, _BoolVars) when is_integer(Arity), Arity >= 0 -> + is_safe_simple(A, Sub); +is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}}, + _Sub, _BoolVars) -> + false; +is_safe_bool_expr_1(#c_call{module=#c_literal{val=erlang}, name=#c_literal{val=Name},args=Args}, Sub, BoolVars) -> NumArgs = length(Args), @@ -2555,6 +2633,77 @@ opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> value, Sub) end. +move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg, + body=InnerArg0}=Outer, + clauses=InnerClauses}=Inner, Sub) -> + %% + %% case let <OuterVars> = <OuterArg> in <InnerArg> of + %% <InnerClauses> + %% end + %% + %% ==> + %% + %% let <OuterVars> = <OuterArg> + %% in case <InnerArg> of <InnerClauses> end + %% + ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}), + {OuterVars,ScopeSub} = pattern_list(OuterVars0, ScopeSub0), + InnerArg = body(InnerArg0, ScopeSub), + Outer#c_let{vars=OuterVars,arg=OuterArg, + body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}}; +move_case_into_arg(#c_case{arg=#c_case{arg=OuterArg, + clauses=[OuterCa0,OuterCb]}=Outer, + clauses=InnerClauses}=Inner0, Sub) -> + case is_failing_clause(OuterCb) of + true -> + #c_clause{pats=OuterPats0,guard=OuterGuard0, + body=InnerArg0} = OuterCa0, + %% + %% case case <OuterArg> of + %% <OuterPats> when <OuterGuard> -> <InnerArg> + %% <OuterCb> + %% ... + %% end of + %% <InnerClauses> + %% end + %% + %% ==> + %% + %% case <OuterArg> of + %% <OuterPats> when <OuterGuard> -> + %% case <InnerArg> of <InnerClauses> end + %% <OuterCb> + %% end + %% + ScopeSub0 = sub_subst_scope(Sub#sub{t=[]}), + {OuterPats,ScopeSub} = pattern_list(OuterPats0, ScopeSub0), + OuterGuard = guard(OuterGuard0, ScopeSub), + InnerArg = body(InnerArg0, ScopeSub), + Inner = Inner0#c_case{arg=InnerArg,clauses=InnerClauses}, + OuterCa = OuterCa0#c_clause{pats=OuterPats,guard=OuterGuard, + body=Inner}, + Outer#c_case{arg=OuterArg, + clauses=[OuterCa,OuterCb]}; + false -> + impossible + end; +move_case_into_arg(#c_case{arg=#c_seq{arg=OuterArg,body=InnerArg}=Outer, + clauses=InnerClauses}=Inner, _Sub) -> + %% + %% case do <OuterArg> <InnerArg> of + %% <InnerClauses> + %% end + %% + %% ==> + %% + %% do <OuterArg> + %% case <InnerArg> of <InerClauses> end + %% + Outer#c_seq{arg=OuterArg, + body=Inner#c_case{arg=InnerArg,clauses=InnerClauses}}; +move_case_into_arg(_, _) -> + impossible. + %% In guards only, rewrite a case in a let argument like %% %% let <Var> = case <> of @@ -3019,9 +3168,6 @@ format_error(result_ignored) -> "(suppress the warning by assigning the expression to the _ variable)"; format_error(useless_building) -> "a term is constructed, but never used"; -format_error({map_pair_key_overloaded,K}) -> - M = io_lib:format("the key ~p is used multiple times in map value association",[K]), - flatten(M); format_error(bin_opt_alias) -> "INFO: the '=' operator will prevent delayed sub binary optimization"; format_error(bin_partition) -> diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 9998043013..91a46a20fe 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -331,9 +331,10 @@ expr({tuple,Line,Es0}, St0) -> expr({map,Line,Es0}, St0) -> {Es1,St1} = expr_list(Es0, St0), {{map,Line,Es1},St1}; -expr({map,Line,Var,Es0}, St0) -> - {Es1,St1} = expr_list(Es0, St0), - {{map,Line,Var,Es1},St1}; +expr({map,Line,E0,Es0}, St0) -> + {E1,St1} = expr(E0, St0), + {Es1,St2} = expr_list(Es0, St1), + {{map,Line,E1,Es1},St2}; expr({map_field_assoc,Line,K0,V0}, St0) -> {K,St1} = expr(K0, St0), {V,St2} = expr(V0, St1), diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index c8735a76e8..f1331d1fe7 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -459,7 +459,7 @@ basic_block([Le|Les], Acc) -> %% sets that may garbage collect are not allowed in basic blocks. collect_block({set,_,{binary,_}}) -> no_block; -collect_block({set,_,{map,_,_}}) -> no_block; +collect_block({set,_,{map,_,_,_}}) -> no_block; collect_block({set,_,_}) -> include; collect_block({call,{var,_}=Var,As,_Rs}) -> {block_end,As++[Var]}; collect_block({call,Func,As,_Rs}) -> {block_end,As++func_vars(Func)}; @@ -928,7 +928,7 @@ select_extract_tuple(Src, Vs, I, Vdb, Bef, St) -> select_map(Scs, V, Tf, Vf, Bef, St0) -> Reg = fetch_var(V, Bef), {Is,Aft,St1} = - match_fmf(fun(#l{ke={val_clause,{map,Es},B},i=I,vdb=Vdb}, Fail, St1) -> + match_fmf(fun(#l{ke={val_clause,{map,_,Es},B},i=I,vdb=Vdb}, Fail, St1) -> select_map_val(V, Es, B, Fail, I, Vdb, Bef, St1) end, Vf, St0, Scs), {[{test,is_map,{f,Tf},[Reg]}|Is],Aft,St1}. @@ -938,22 +938,39 @@ select_map_val(V, Es, B, Fail, I, Vdb, Bef, St0) -> {Bis,Aft,St2} = match_cg(B, Fail, Int, St1), {Eis++Bis,Aft,St2}. +select_extract_map(_, [], _, _, _, Bef, St) -> {[],Bef,St}; select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> - F = fun ({map_pair,Key,{var,V}}, Int0) -> - Rsrc = fetch_var(Src, Int0), + %% First split the instruction flow + %% We want one set of each + %% 1) has_map_fields (no target registers) + %% 2) get_map_elements (with target registers) + %% Assume keys are term-sorted + Rsrc = fetch_var(Src, Bef), + + {{HasKs,GetVs},Aft} = lists:foldr(fun + ({map_pair,Key,{var,V}},{{HasKsi,GetVsi},Int0}) -> case vdb_find(V, Vdb) of {V,_,L} when L =< I -> - {[{test,has_map_field,{f,Fail},[Rsrc,Key]}],Int0}; + {{[Key|HasKsi],GetVsi},Int0}; _Other -> Reg1 = put_reg(V, Int0#sr.reg), Int1 = Int0#sr{reg=Reg1}, - {[{get_map_element,{f,Fail}, - Rsrc,Key,fetch_reg(V, Reg1)}], - Int1} + {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi]},Int1} end - end, - {Es,Aft} = flatmapfoldl(F, Bef, Vs), - {Es,Aft,St}. + end, {{[],[]},Bef}, Vs), + + Code = case {HasKs,GetVs} of + {[],[]} -> {[],Aft,St}; + {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, + {Code, Aft, St}. + select_extract_cons(Src, [{var,Hd}, {var,Tl}], I, Vdb, Bef, St) -> {Es,Aft} = case {vdb_find(Hd, Vdb), vdb_find(Tl, Vdb)} of @@ -1488,55 +1505,35 @@ 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}; -set_cg([{var,R}], {map,SrcMap,Es0}, Le, Vdb, Bef, +set_cg([{var,R}], {map,Op,Map,Es}, 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), - SrcReg = case SrcMap of - {var,SrcVar} -> fetch_var(SrcVar, Int0); - _ -> SrcMap - end, - {Assoc,Exact} = - try - cg_map_pairs(Es0) - catch - throw:badarg -> - {[],[{{float,0.0},{atom,badarg}}, - {{integer,0},{atom,badarg}}]} - end, - F = fun ({K,{var,V}}) -> [K,fetch_var(V, Int0)]; - ({K,E}) -> [K,E] - end, - AssocList = flatmap(F, Assoc), - ExactList = flatmap(F, Exact), - Live0 = max_reg(Bef#sr.reg), - Int1 = clear_dead(Int0, Le#l.i, Vdb), - Aft = Bef#sr{reg=put_reg(R, Int1#sr.reg)}, - Target = fetch_reg(R, Aft#sr.reg), - Code = [Line] ++ - case {AssocList,ExactList} of - {[_|_],[]} -> - [{put_map_assoc,Fail,SrcReg,Target,Live0,{list,AssocList}}]; - {[_|_],[_|_]} -> - Live = case Target of - {x,TargetX} when TargetX =:= Live0 -> - Live0 + 1; - _ -> - Live0 - end, - [{put_map_assoc,Fail,SrcReg,Target,Live0,{list,AssocList}}, - {put_map_exact,Fail,Target,Target,Live,{list,ExactList}}]; - {[],[_|_]} -> - [{put_map_exact,Fail,SrcReg,Target,Live0,{list,ExactList}}]; - {[],[]} -> - [{put_map_assoc,Fail,SrcReg,Target,Live0,{list,[]}}] - end, - {Sis++Code,Aft,St}; + + %% The instruction needs to store keys in term sorted order + %% All keys has to be unique here + Pairs = map_pair_strip_and_termsort(Es), + + %% fetch registers for values to be put into the map + List = flatmap(fun({K,V}) -> [K,cg_reg_arg(V,Int0)] end, Pairs), + + 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}; set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> %% Find a place for the return register first. Int = Bef#sr{reg=put_reg(R, Bef#sr.reg)}, @@ -1549,70 +1546,16 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> end, {Ais,clear_dead(Int, Le#l.i, Vdb),St}. -%% cg_map_pairs(MapPairs) -> {Assoc,Exact} -%% Assoc = Exact = [{K,V}] -%% -%% Remove multiple assignments to the same key, and return -%% one list key-value list with all keys that may or may not exist -%% (Assoc), and one with keys that must exist (Exact). -%% - -cg_map_pairs(Es0) -> - Es = cg_map_pairs_1(Es0, 0), - R0 = sofs:relation(Es), - R1 = sofs:relation_to_family(R0), - R2 = sofs:to_external(R1), - - %% R2 is now [{KeyValue,[{Order,Op,OriginalKey,Value}]}] - R3 = [begin - %% The value for the last pair determines the value. - {_,_,_,V} = lists:last(Vs), - {Op,{_,SortOrder}=K} = map_pair_op_and_key(Vs), - {Op,{SortOrder,K,V}} - end || {_,Vs} <- R2], - - %% R3 is now [{Op,{Key,Value}}] - R = termsort(R3), - - %% R4 is now sorted with all alloc first in the list, followed by - %% all exact. - {Assoc,Exact} = lists:partition(fun({Op,_}) -> Op =:= assoc end, R), - {[{K,V} || {_,{_,K,V}} <- Assoc], - [{K,V} || {_,{_,K,V}} <- Exact]}. - -cg_map_pairs_1([{map_pair_assoc,{_,Kv}=K,V}|T], Order) -> - [{Kv,{Order,assoc,K,V}}|cg_map_pairs_1(T, Order+1)]; -cg_map_pairs_1([{map_pair_exact,{_,Kv}=K,V}|T], Order) -> - [{Kv,{Order,exact,K,V}}|cg_map_pairs_1(T, Order+1)]; -cg_map_pairs_1([], _) -> []. - -%% map_pair_op_and_key({_,Op,K,_}) -> {Operator,Key} -%% Determine the operator and key to use. Throw a 'badarg' -%% exception if there are contradictory exact updates. - -map_pair_op_and_key(L) -> - case [K || {_,exact,K,_} <- L] of - [K] -> - %% There is a single ':=' operator. Use that key. - {exact,K}; - [K|T] -> - %% There is more than one ':=' operator. All of them - %% must have the same key. - case lists:all(fun(E) -> E =:= K end, T) of - true -> - {exact,K}; - false -> - %% Some keys are different, e.g. 1 and 1.0. - throw(badarg) - end; - [] -> - %% Only '=>' operators. Use the first key in the list. - [{_,assoc,K,_}|_] = L, - {assoc,K} - end. - -termsort(Ls) -> - lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Ls). +map_pair_strip_and_termsort(Es) -> + %% format in + %% [{map_pair,K,V}] + %% where K is for example {integer, 1} and we want to sort on 1. + Ls = [{K,V}||{_,K,V}<-Es], + lists:sort(fun ({{_,A},_}, {{_,B},_}) -> erts_internal:cmp_term(A,B) =< 0; + ({nil,_}, {{_,B},_}) -> [] =< B; + ({{_,A},_}, {nil,_}) -> A =< []; + ({nil,_}, {nil,_}) -> true + end, Ls). %%% %%% Code generation for constructing binaries. @@ -2085,7 +2028,7 @@ load_vars(Vs, Regs) -> foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). %% put_reg(Val, Regs) -> Regs. -%% find_reg(Val, Regs) -> ok{r{R}} | error. +%% find_reg(Val, Regs) -> {ok,r{R}} | error. %% fetch_reg(Val, Regs) -> r{R}. %% Functions to interface the registers. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index e30bfa729c..04210ae243 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -74,10 +74,11 @@ -export([module/2,format_error/1]). -import(lists, [reverse/1,reverse/2,map/2,member/2,foldl/3,foldr/3,mapfoldl/3, - splitwith/2,keyfind/3,sort/1,foreach/2]). + splitwith/2,keyfind/3,sort/1,foreach/2,droplast/1,last/1]). -import(ordsets, [add_element/2,del_element/2,is_element/2, union/1,union/2,intersection/2,subtract/2]). --import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1]). +-import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1, + ann_c_map/2, ann_c_map/3]). -include("core_parse.hrl"). @@ -101,6 +102,8 @@ -record(ireceive2, {anno=#a{},clauses,timeout,action}). -record(iset, {anno=#a{},var,arg}). -record(itry, {anno=#a{},args,vars,body,evars,handler}). +-record(ifilter, {anno=#a{},arg}). +-record(igen, {anno=#a{},acc_pat,acc_guard,skip_pat,tail,tail_pat,arg}). -type iapply() :: #iapply{}. -type ibinary() :: #ibinary{}. @@ -117,10 +120,13 @@ -type ireceive2() :: #ireceive2{}. -type iset() :: #iset{}. -type itry() :: #itry{}. +-type ifilter() :: #ifilter{}. +-type igen() :: #igen{}. -type i() :: iapply() | ibinary() | icall() | icase() | icatch() | iclause() | ifun() | iletrec() | imatch() | iprimop() - | iprotect() | ireceive1() | ireceive2() | iset() | itry(). + | iprotect() | ireceive1() | ireceive2() | iset() | itry() + | ifilter() | igen(). -type warning() :: {file:filename(), [{integer(), module(), term()}]}. @@ -226,13 +232,13 @@ guard(Gs0, St0) -> Gt1 = guard_tests(Gt0), L = element(2, Gt1), {op,L,'or',Gt1,Rhs} - end, guard_tests(last(Gs0)), first(Gs0)), + end, guard_tests(last(Gs0)), droplast(Gs0)), {Gs,St} = gexpr_top(Gs1, St0#core{in_guard=true}), {Gs,St#core{in_guard=false}}. guard_tests(Gs) -> L = element(2, hd(Gs)), - {protect,L,foldr(fun (G, Rhs) -> {op,L,'and',G,Rhs} end, last(Gs), first(Gs))}. + {protect,L,foldr(fun (G, Rhs) -> {op,L,'and',G,Rhs} end, last(Gs), droplast(Gs))}. %% gexpr_top(Expr, State) -> {Cexpr,State}. %% Generate an internal core expression of a guard test. Explicitly @@ -269,51 +275,67 @@ gexpr({op,L,'orelse',E1,E2}, Bools, St0) -> True = {atom,L,true}, E = make_bool_switch_guard(L, E1, V, True, E2), gexpr(E, Bools, St); -gexpr({op,Line,Op,L,R}=Call, Bools0, St0) -> +gexpr({op,Line,Op,L,R}=E, Bools, St) -> case erl_internal:bool_op(Op, 2) of - true -> - {Le,Lps,Bools1,St1} = gexpr(L, Bools0, St0), - {Ll,Llps,St2} = force_safe(Le, St1), - {Re,Rps,Bools,St3} = gexpr(R, Bools1, St2), - {Rl,Rlps,St4} = force_safe(Re, St3), - Anno = lineno_anno(Line, St4), - {#icall{anno=#a{anno=Anno}, %Must have an #a{} - module=#c_literal{anno=Anno,val=erlang}, - name=#c_literal{anno=Anno,val=Op}, - args=[Ll,Rl]},Lps ++ Llps ++ Rps ++ Rlps,Bools,St4}; - false -> - gexpr_test(Call, Bools0, St0) + true -> + gexpr_bool(Op, L, R, Bools, St, Line); + false -> + gexpr_test(E, Bools, St) end; -gexpr({op,Line,Op,A}=Call, Bools0, St0) -> - case Op of - 'not' -> - {Ae0,Aps,Bools,St1} = gexpr(A, Bools0, St0), - case Ae0 of - #icall{module=#c_literal{val=erlang}, - name=#c_literal{val='=:='}, - args=[E,#c_literal{val=true}]}=EqCall -> - %% - %% Doing the following transformation - %% not(Expr =:= true) ==> Expr =:= false - %% will help eliminating redundant is_boolean/1 tests. - %% - Ae = EqCall#icall{args=[E,#c_literal{val=false}]}, - {Al,Alps,St2} = force_safe(Ae, St1), - {Al,Aps ++ Alps,Bools,St2}; - Ae -> - {Al,Alps,St2} = force_safe(Ae, St1), - Anno = lineno_anno(Line, St2), - {#icall{anno=#a{anno=Anno}, %Must have an #a{} - module=#c_literal{anno=Anno,val=erlang}, - name=#c_literal{anno=Anno,val=Op}, - args=[Al]},Aps ++ Alps,Bools,St2} - end; - _ -> - gexpr_test(Call, Bools0, St0) +gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,Op}},[L,R]}=E, Bools, St) -> + case erl_internal:bool_op(Op, 2) of + true -> + gexpr_bool(Op, L, R, Bools, St, Line); + false -> + gexpr_test(E, Bools, St) end; +gexpr({op,Line,'not',A}, Bools, St) -> + gexpr_not(A, Bools, St, Line); +gexpr({call,Line,{remote,_,{atom,_,erlang},{atom,_,'not'}},[A]}, Bools, St) -> + gexpr_not(A, Bools, St, Line); gexpr(E0, Bools, St0) -> gexpr_test(E0, Bools, St0). +%% gexpr_not(L, R, Bools, State) -> {Cexpr,[PreExp],Bools,State}. +%% Generate a guard for boolean operators + +gexpr_bool(Op, L, R, Bools0, St0, Line) -> + {Le,Lps,Bools1,St1} = gexpr(L, Bools0, St0), + {Ll,Llps,St2} = force_safe(Le, St1), + {Re,Rps,Bools,St3} = gexpr(R, Bools1, St2), + {Rl,Rlps,St4} = force_safe(Re, St3), + Anno = lineno_anno(Line, St4), + {#icall{anno=#a{anno=Anno}, %Must have an #a{} + module=#c_literal{anno=Anno,val=erlang}, + name=#c_literal{anno=Anno,val=Op}, + args=[Ll,Rl]},Lps ++ Llps ++ Rps ++ Rlps,Bools,St4}. + +%% gexpr_not(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}. +%% Generate an erlang:'not'/1 guard test. + +gexpr_not(A, Bools0, St0, Line) -> + {Ae0,Aps,Bools,St1} = gexpr(A, Bools0, St0), + case Ae0 of + #icall{module=#c_literal{val=erlang}, + name=#c_literal{val='=:='}, + args=[E,#c_literal{val=true}]}=EqCall -> + %% + %% Doing the following transformation + %% not(Expr =:= true) ==> Expr =:= false + %% will help eliminating redundant is_boolean/1 tests. + %% + Ae = EqCall#icall{args=[E,#c_literal{val=false}]}, + {Al,Alps,St2} = force_safe(Ae, St1), + {Al,Aps ++ Alps,Bools,St2}; + Ae -> + {Al,Alps,St2} = force_safe(Ae, St1), + Anno = lineno_anno(Line, St2), + {#icall{anno=#a{anno=Anno}, %Must have an #a{} + module=#c_literal{anno=Anno,val=erlang}, + name=#c_literal{anno=Anno,val='not'}, + args=[Al]},Aps ++ Alps,Bools,St2} + end. + %% gexpr_test(Expr, Bools, State) -> {Cexpr,[PreExp],Bools,State}. %% Generate a guard test. At this stage we must be sure that we have %% a proper boolean value here so wrap things with an true test if we @@ -330,7 +352,8 @@ gexpr_test(E0, Bools0, St0) -> #icall{anno=Anno,module=#c_literal{val=erlang},name=#c_literal{val=N},args=As} -> Ar = length(As), case erl_internal:type_test(N, Ar) orelse - erl_internal:comp_op(N, Ar) of + erl_internal:comp_op(N, Ar) orelse + erl_internal:bool_op(N, Ar) of true -> {E1,Eps0,Bools0,St1}; false -> Lanno = Anno#a.anno, @@ -479,8 +502,9 @@ expr({cons,L,H0,T0}, St0) -> {T1,Tps,St2} = safe(T0, St1), A = lineno_anno(L, St2), {ann_c_cons(A, H1, T1),Hps ++ Tps,St2}; -expr({lc,L,E,Qs}, St) -> - lc_tq(L, E, Qs, #c_literal{anno=lineno_anno(L, St),val=[]}, St); +expr({lc,L,E,Qs0}, St0) -> + {Qs1,St1} = preprocess_quals(L, Qs0, St0), + lc_tq(L, E, Qs1, #c_literal{anno=lineno_anno(L, St1),val=[]}, St1); expr({bc,L,E,Qs}, St) -> bc_tq(L, E, Qs, {nil,L}, St); expr({tuple,L,Es0}, St0) -> @@ -492,12 +516,20 @@ expr({map,L,Es0}, St0) -> % in map construction. {Es1,Eps,St1} = map_pair_list(Es0, St0), A = lineno_anno(L, St1), - {#c_map{anno=A,es=Es1},Eps,St1}; + {ann_c_map(A,Es1),Eps,St1}; expr({map,L,M0,Es0}, St0) -> - {M1,Mps,St1} = safe(M0, St0), - {Es1,Eps,St2} = map_pair_list(Es0, St1), - A = lineno_anno(L, St2), - {#c_map{anno=A,var=M1,es=Es1},Mps++Eps,St2}; + try expr_map(M0,Es0,lineno_anno(L, St0),St0) of + {_,_,_}=Res -> Res + catch + throw:bad_map -> + St = add_warning(L, bad_map, St0), + LineAnno = lineno_anno(L, St), + As = [#c_literal{anno=LineAnno,val=badarg}], + {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} + module=#c_literal{anno=LineAnno,val=erlang}, + name=#c_literal{anno=LineAnno,val=error}, + args=As},[],St} + end; expr({bin,L,Es0}, St0) -> try expr_bin(Es0, lineno_anno(L, St0), St0) of {_,_,_}=Res -> Res @@ -513,7 +545,7 @@ expr({bin,L,Es0}, St0) -> end; expr({block,_,Es0}, St0) -> %% Inline the block directly. - {Es1,St1} = exprs(first(Es0), St0), + {Es1,St1} = exprs(droplast(Es0), St0), {E1,Eps,St2} = expr(last(Es0), St1), {E1,Es1 ++ Eps,St2}; expr({'if',L,Cs0}, St0) -> @@ -617,7 +649,7 @@ expr({call,Lc,{atom,Lf,F},As0}, St0) -> Op = #c_var{anno=lineno_anno(Lf, St1),name={F,length(As1)}}, {#iapply{anno=#a{anno=lineno_anno(Lc, St1)},op=Op,args=As1},Aps,St1}; expr({call,L,FunExp,As0}, St0) -> - {Fun,Fps,St1} = safe(FunExp, St0), + {Fun,Fps,St1} = safe_fun(length(As0), FunExp, St0), {As1,Aps,St2} = safe_list(As0, St1), Lanno = lineno_anno(L, St2), {#iapply{anno=#a{anno=Lanno},op=Fun,args=As1},Fps ++ Aps,St2}; @@ -647,7 +679,7 @@ expr({match,L,P0,E0}, St0) -> Other when not is_atom(Other) -> {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4} end; -expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) -> +expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> %% Optimise '++' here because of the list comprehension algorithm. %% %% To avoid achieving quadratic complexity if there is a chain of @@ -655,7 +687,8 @@ expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) -> %% evaluation of More now. Evaluating More here could also reduce the %% number variables in the environment for letrec. {Mc,Mps,St1} = safe(More, St0), - {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St1), + {Qs,St2} = preprocess_quals(Llc, Qs0, St1), + {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St2), {Y,Mps++Yps,St}; expr({op,L,'andalso',E1,E2}, St0) -> {#c_var{name=V0},St} = new_var(L, St0), @@ -706,6 +739,37 @@ make_bool_switch_guard(L, E, V, T, F) -> {clause,NegL,[V],[],[V]} ]}. +expr_map(M0,Es0,A,St0) -> + {M1,Mps,St1} = safe(M0, St0), + case is_valid_map_src(M1) of + true -> + case {M1,Es0} of + {#c_var{}, []} -> + %% transform M#{} to is_map(M) + {Vpat,St2} = new_var(St1), + {Fpat,St3} = new_var(St2), + Cs = [#iclause{ + anno=A, + pats=[Vpat], + guard=[#icall{anno=#a{anno=A}, + module=#c_literal{anno=A,val=erlang}, + name=#c_literal{anno=A,val=is_map}, + args=[Vpat]}], + body=[Vpat]}], + Fc = fail_clause([Fpat], A, #c_literal{val=badarg}), + {#icase{anno=#a{anno=A},args=[M1],clauses=Cs,fc=Fc},Mps,St3}; + {_,_} -> + {Es1,Eps,St2} = map_pair_list(Es0, St1), + {ann_c_map(A,M1,Es1),Mps++Eps,St2} + end; + false -> throw(bad_map) + end. + +is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true; +is_valid_map_src(#c_map{}) -> true; +is_valid_map_src(#c_var{}) -> true; +is_valid_map_src(_) -> false. + map_pair_list(Es, St) -> foldr(fun ({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) -> @@ -889,133 +953,45 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. %% This TQ from Simon PJ pp 127-138. -%% This gets a bit messy as we must transform all directly here. We -%% recognise guard tests and try to fold them together and join to a -%% preceding generators, this should give us better and more compact -%% code. -lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), +lc_tq(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard, + skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, + arg={Pre,Arg}}|Qs], Mc, St0) -> {Name,St1} = new_fun_name("lc", St0), - {Head,St2} = new_var(St1), - {Tname,St3} = new_var_name(St2), - LA = lineno_anno(Line, St3), - LAnno = #a{anno=LA}, - Tail = #c_var{anno=LA,name=Tname}, - {Arg,St4} = new_var(St3), - {Nc,[],St5} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St4), - {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat! - {Lc,Lps,St7} = lc_tq(Line, E, Qs1, Nc, St6), - {Pc,St8} = list_gen_pattern(P, Line, St7), - {Gc,Gps,St9} = safe(G, St8), %Will be a function argument! - Fc = function_clause([Arg], LA, {Name,1}), - - %% Avoid constructing a default clause if the list comprehension - %% only has a variable as generator and there are no guard - %% tests. In other words, if the comprehension is equivalent to - %% lists:map/2. - Cs0 = case {Guardc, Pc} of - {[], #c_var{}} -> - [#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]}],guard=[], - body=[Mc]}]; - _ -> - [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[ann_c_cons(LA, Head, Tail)], - guard=[], - body=[Nc]}, - #iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]}],guard=[], - body=[Mc]}] - end, - Cs = case Pc of - nomatch -> Cs0; - _ -> - [#iclause{anno=LAnno, - pats=[ann_c_cons(LA, Pc, Tail)], - guard=Guardc, - body=Lps ++ [Lc]}|Cs0] - end, - Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc}, - {#iletrec{anno=LAnno,defs=[{{Name,1},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,1}}, - args=[Gc]}]}, - [],St9}; -lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Name,St1} = new_fun_name("blc", St0), LA = lineno_anno(Line, St1), LAnno = #a{anno=LA}, - HeadBinPattern = pattern(P, St1), - #c_binary{segments=Ps0} = HeadBinPattern, - {Ps,Tail,St2} = append_tail_segment(Ps0, St1), - {EPs,St3} = emasculate_segments(Ps, St2), - Pattern = HeadBinPattern#c_binary{segments=Ps}, - EPattern = HeadBinPattern#c_binary{segments=EPs}, - {Arg,St4} = new_var(St3), - {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat! - Tname = Tail#c_var.name, - {Nc,[],St6} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St5), - {Bc,Bps,St7} = lc_tq(Line, E, Qs1, Nc, St6), - {Gc,Gps,St10} = safe(G, St7), %Will be a function argument! - Fc = function_clause([Arg], LA, {Name,1}), - {TailSegList,_,St} = append_tail_segment([], St10), - Cs = [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[Pattern], - guard=Guardc, - body=Bps ++ [Bc]}, - #iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[EPattern], - guard=[], - body=[#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,1}}, - args=[Tail]}]}, - #iclause{anno=LAnno, - pats=[#c_binary{anno=LA,segments=TailSegList}],guard=[], - body=[Mc]}], - Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc}, - {#iletrec{anno=LAnno,defs=[{{Name,1},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,1}}, - args=[Gc]}]}, - [],St}; -lc_tq(Line, E, [Fil0|Qs0], Mc, St0) -> - %% Special case sequences guard tests. - LA = lineno_anno(element(2, Fil0), St0), - LAnno = #a{anno=LA}, - case is_guard_test(Fil0) of - true -> - {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Lc,Lps,St1} = lc_tq(Line, E, Qs1, Mc, St0), - {Gs,St2} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat! - {#icase{anno=LAnno, - args=[], - clauses=[#iclause{anno=LAnno,pats=[], - guard=Gs,body=Lps ++ [Lc]}], - fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[],guard=[],body=[Mc]}}, - [],St2}; - false -> - {Lc,Lps,St1} = lc_tq(Line, E, Qs0, Mc, St0), - {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], LA, - c_tuple([#c_literal{val=case_clause},Fpat])), - %% Do a novars little optimisation here. - {Filc,Fps,St3} = novars(Fil0, St2), - {#icase{anno=LAnno, - args=[Filc], - clauses=[#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=true}], - guard=[], - body=Lps ++ [Lc]}, - #iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[#c_literal{anno=LA,val=false}], - guard=[], - body=[Mc]}], - fc=Fc}, - Fps,St3} - end; + F = #c_var{anno=LA,name={Name,1}}, + Nc = #iapply{anno=GAnno,op=F,args=[Tail]}, + {Var,St2} = new_var(St1), + Fc = function_clause([Var], LA, {Name,1}), + TailClause = #iclause{anno=LAnno,pats=[TailPat],guard=[],body=[Mc]}, + Cs0 = case {AccPat,AccGuard} of + {SkipPat,[]} -> + %% Skip and accumulator patterns are the same and there is + %% no guard, no need to generate a skip clause. + [TailClause]; + _ -> + [#iclause{anno=#a{anno=[compiler_generated|LA]}, + pats=[SkipPat],guard=[],body=[Nc]}, + TailClause] + end, + {Cs,St4} = case AccPat of + nomatch -> + %% The accumulator pattern never matches, no need + %% for an accumulator clause. + {Cs0,St2}; + _ -> + {Lc,Lps,St3} = lc_tq(Line, E, Qs, Nc, St2), + {[#iclause{anno=LAnno,pats=[AccPat],guard=AccGuard, + body=Lps ++ [Lc]}|Cs0], + St3} + end, + Fun = #ifun{anno=LAnno,id=[],vars=[Var],clauses=Cs,fc=Fc}, + {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,1},Fun}], + body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg]}]}, + [],St4}; +lc_tq(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> + filter_tq(Line, E, Filter, Mc, St, Qs, fun lc_tq/5); lc_tq(Line, E0, [], Mc0, St0) -> {H1,Hps,St1} = safe(E0, St0), {T1,Tps,St} = force_safe(Mc0, St1), @@ -1025,143 +1001,60 @@ lc_tq(Line, E0, [], Mc0, St0) -> %% bc_tq(Line, Exp, [Qualifier], More, State) -> {LetRec,[PreExp],State}. %% This TQ from Gustafsson ERLANG'05. -%% This gets a bit messy as we must transform all directly here. We -%% recognise guard tests and try to fold them together and join to a -%% preceding generators, this should give us better and more compact -%% code. %% More could be transformed before calling bc_tq. -bc_tq(Line, Exp, Qualifiers, _, St0) -> +bc_tq(Line, Exp, Qs0, _, St0) -> {BinVar,St1} = new_var(St0), - {Sz,SzPre,St2} = bc_initial_size(Exp, Qualifiers, St1), - {E,BcPre,St} = bc_tq1(Line, Exp, Qualifiers, BinVar, St2), + {Sz,SzPre,St2} = bc_initial_size(Exp, Qs0, St1), + {Qs,St3} = preprocess_quals(Line, Qs0, St2), + {E,BcPre,St} = bc_tq1(Line, Exp, Qs, BinVar, St3), Pre = SzPre ++ [#iset{var=BinVar, arg=#iprimop{name=#c_literal{val=bs_init_writable}, args=[Sz]}}] ++ BcPre, {E,Pre,St}. -bc_tq1(Line, E, [{generate,Lg,P,G}|Qs0], AccExpr, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), +bc_tq1(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard, + skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, + arg={Pre,Arg}}|Qs], Mc, St0) -> {Name,St1} = new_fun_name("lbc", St0), LA = lineno_anno(Line, St1), - {[Head,Tail,AccVar],St2} = new_vars(LA, 3, St1), LAnno = #a{anno=LA}, - {Arg,St3} = new_var(St2), - NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name}, - {var,Lg,AccVar#c_var.name}]}, - {Guardc,St4} = lc_guard_tests(Gs, St3), %These are always flat! - {Lc,Lps,St5} = bc_tq1(Line, E, Qs1, AccVar, St4), - {Nc,Nps,St6} = expr(NewMore, St5), - {Pc,St7} = list_gen_pattern(P, Line, St6), - {Gc,Gps,St8} = safe(G, St7), %Will be a function argument! - Fc = function_clause([Arg,AccVar], LA, {Name,2}), - Cs0 = case {Guardc, Pc} of - {[], #c_var{}} -> - [#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[], - body=[AccVar]}]; - _ -> - [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[ann_c_cons(LA, Head, Tail),AccVar], - guard=[], - body=Nps ++ [Nc]}, - #iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[], - body=[AccVar]}] - end, - Cs = case Pc of - nomatch -> Cs0; - _ -> - Body = Lps ++ Nps ++ [#iset{var=AccVar,arg=Lc},Nc], - [#iclause{anno=LAnno, - pats=[ann_c_cons(LA,Pc,Tail),AccVar], - guard=Guardc, - body=Body}|Cs0] - end, - Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc}, - {#iletrec{anno=LAnno,defs=[{{Name,2},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,2}}, - args=[Gc,AccExpr]}]}, - [],St8}; -bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Name,St1} = new_fun_name("lbc", St0), - LA = lineno_anno(Line, St1), - {AccVar,St2} = new_var(LA, St1), - LAnno = #a{anno=LA}, - HeadBinPattern = pattern(P, St2), - #c_binary{segments=Ps0} = HeadBinPattern, - {Ps,Tail,St3} = append_tail_segment(Ps0, St2), - {EPs,St4} = emasculate_segments(Ps, St3), - Pattern = HeadBinPattern#c_binary{segments=Ps}, - EPattern = HeadBinPattern#c_binary{segments=EPs}, - {Arg,St5} = new_var(St4), - NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name}, - {var,Lg,AccVar#c_var.name}]}, - {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat! - {Bc,Bps,St7} = bc_tq1(Line, E, Qs1, AccVar, St6), - {Nc,Nps,St8} = expr(NewMore, St7), - {Gc,Gps,St9} = safe(G, St8), %Will be a function argument! - Fc = function_clause([Arg,AccVar], LA, {Name,2}), - Body = Bps ++ Nps ++ [#iset{var=AccVar,arg=Bc},Nc], - {TailSegList,_,St} = append_tail_segment([], St9), - Cs = [#iclause{anno=LAnno, - pats=[Pattern,AccVar], - guard=Guardc, - body=Body}, - #iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[EPattern,AccVar], - guard=[], - body=Nps ++ [Nc]}, - #iclause{anno=LAnno, - pats=[#c_binary{anno=LA,segments=TailSegList},AccVar], - guard=[], - body=[AccVar]}], - Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc}, - {#iletrec{anno=LAnno,defs=[{{Name,2},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,2}}, - args=[Gc,AccExpr]}]}, - [],St}; -bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) -> - %% Special case sequences guard tests. - LA = lineno_anno(element(2, Fil0), St0), - LAnno = #a{anno=LA}, - case is_guard_test(Fil0) of - true -> - {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Bc,Bps,St1} = bc_tq1(Line, E, Qs1, AccVar, St0), - {Gs,St} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat! - {#icase{anno=LAnno, - args=[], - clauses=[#iclause{anno=LAnno, - pats=[], - guard=Gs,body=Bps ++ [Bc]}], - fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[],guard=[],body=[AccVar]}}, - [],St}; - false -> - {Bc,Bps,St1} = bc_tq1(Line, E, Qs0, AccVar, St0), - {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], LA, - c_tuple([#c_literal{val=case_clause},Fpat])), - %% Do a novars little optimisation here. - {Filc,Fps,St} = novars(Fil0, St2), - {#icase{anno=LAnno, - args=[Filc], - clauses=[#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=true}], - guard=[], - body=Bps ++ [Bc]}, - #iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[#c_literal{anno=LA,val=false}], - guard=[], - body=[AccVar]}], - fc=Fc}, - Fps,St} - end; + {Vars=[_,AccVar],St2} = new_vars(LA, 2, St1), + F = #c_var{anno=LA,name={Name,2}}, + Nc = #iapply{anno=GAnno,op=F,args=[Tail,AccVar]}, + Fc = function_clause(Vars, LA, {Name,2}), + TailClause = #iclause{anno=LAnno,pats=[TailPat,AccVar],guard=[], + body=[AccVar]}, + Cs0 = case {AccPat,AccGuard} of + {SkipPat,[]} -> + %% Skip and accumulator patterns are the same and there is + %% no guard, no need to generate a skip clause. + [TailClause]; + _ -> + [#iclause{anno=#a{anno=[compiler_generated|LA]}, + pats=[SkipPat,AccVar],guard=[],body=[Nc]}, + TailClause] + end, + {Cs,St4} = case AccPat of + nomatch -> + %% The accumulator pattern never matches, no need + %% for an accumulator clause. + {Cs0,St2}; + _ -> + {Bc,Bps,St3} = bc_tq1(Line, E, Qs, AccVar, St2), + Body = Bps ++ [#iset{var=AccVar,arg=Bc},Nc], + {[#iclause{anno=LAnno, + pats=[AccPat,AccVar],guard=AccGuard, + body=Body}|Cs0], + St3} + end, + Fun = #ifun{anno=LAnno,id=[],vars=Vars,clauses=Cs,fc=Fc}, + {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,2},Fun}], + body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg,Mc]}]}, + [],St4}; +bc_tq1(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> + filter_tq(Line, E, Filter, Mc, St, Qs, fun bc_tq1/5); bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) -> {E,Pre,St} = expr({bin,Bl,[{bin_element,Bl, {var,Bl,AccVar#c_var.name}, @@ -1169,16 +1062,154 @@ bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) -> [binary,{unit,1}]}|Elements]}, St0), #a{anno=A} = Anno0 = get_anno(E), Anno = Anno0#a{anno=[compiler_generated,single_use|A]}, - %%Anno = Anno0#a{anno=[compiler_generated|A]}, {set_anno(E, Anno),Pre,St}. +%% filter_tq(Line, Expr, Filter, Mc, State, [Qualifier], TqFun) -> +%% {Case,[PreExpr],State}. +%% Transform an intermediate comprehension filter to its intermediate case +%% representation. + +filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg={Pre,Arg}}, + Mc, St0, Qs, TqFun) -> + %% The filter is an expression, it is compiled to a case of degree 1 with + %% 3 clauses, one accumulating, one skipping and the final one throwing + %% {case_clause,Value} where Value is the result of the filter and is not a + %% boolean. + {Lc,Lps,St1} = TqFun(Line, E, Qs, Mc, St0), + {FailPat,St2} = new_var(St1), + Fc = fail_clause([FailPat], LA, + c_tuple([#c_literal{val=case_clause},FailPat])), + {#icase{anno=LAnno#a{anno=[list_comprehension|LA]},args=[Arg], + clauses=[#iclause{anno=LAnno, + pats=[#c_literal{val=true}],guard=[], + body=Lps ++ [Lc]}, + #iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, + pats=[#c_literal{val=false}],guard=[], + body=[Mc]}], + fc=Fc}, + Pre,St2}; +filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg=Guard}, + Mc, St0, Qs, TqFun) when is_list(Guard) -> + %% Otherwise it is a guard, compiled to a case of degree 0 with 2 clauses, + %% the first matches if the guard succeeds and the comprehension continues + %% or the second one is selected and the current element is skipped. + {Lc,Lps,St1} = TqFun(Line, E, Qs, Mc, St0), + {#icase{anno=LAnno#a{anno=[list_comprehension|LA]},args=[], + clauses=[#iclause{anno=LAnno,pats=[],guard=Guard,body=Lps ++ [Lc]}], + fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, + pats=[],guard=[],body=[Mc]}}, + [],St1}. + +%% preprocess_quals(Line, [Qualifier], State) -> {[Qualifier'],State}. +%% Preprocess a list of Erlang qualifiers into its intermediate representation, +%% represented as a list of #igen{} and #ifilter{} records. We recognise guard +%% tests and try to fold them together and join to a preceding generators, this +%% should give us better and more compact code. + +preprocess_quals(Line, Qs, St) -> + preprocess_quals(Line, Qs, St, []). + +preprocess_quals(Line, [Q|Qs0], St0, Acc) -> + case is_generator(Q) of + true -> + {Gs,Qs} = splitwith(fun is_guard_test/1, Qs0), + {Gen,St} = generator(Line, Q, Gs, St0), + preprocess_quals(Line, Qs, St, [Gen|Acc]); + false -> + LAnno = #a{anno=lineno_anno(get_anno(Q), St0)}, + case is_guard_test(Q) of + true -> + %% When a filter is a guard test, its argument in the + %% #ifilter{} record is a list as returned by + %% lc_guard_tests/2. + {Gs,Qs} = splitwith(fun is_guard_test/1, Qs0), + {Cg,St} = lc_guard_tests([Q|Gs], St0), + Filter = #ifilter{anno=LAnno,arg=Cg}, + preprocess_quals(Line, Qs, St, [Filter|Acc]); + false -> + %% Otherwise, it is a pair {Pre,Arg} as in a generator + %% input. + {Ce,Pre,St} = novars(Q, St0), + Filter = #ifilter{anno=LAnno,arg={Pre,Ce}}, + preprocess_quals(Line, Qs0, St, [Filter|Acc]) + end + end; +preprocess_quals(_, [], St, Acc) -> + {reverse(Acc),St}. + +is_generator({generate,_,_,_}) -> true; +is_generator({b_generate,_,_,_}) -> true; +is_generator(_) -> false. + +%% +%% Generators are abstracted as sextuplets: +%% - acc_pat is the accumulator pattern, e.g. [Pat|Tail] for Pat <- Expr. +%% - acc_guard is the list of guards immediately following the current +%% generator in the qualifier list input. +%% - skip_pat is the skip pattern, e.g. <<X,_:X,Tail/bitstring>> for +%% <<X,1:X>> <= Expr. +%% - tail is the variable used in AccPat and SkipPat bound to the rest of the +%% generator input. +%% - tail_pat is the tail pattern, respectively [] and <<_/bitstring>> for list +%% and bit string generators. +%% - arg is a pair {Pre,Arg} where Pre is the list of expressions to be +%% inserted before the comprehension function and Arg is the expression +%% that it should be passed. +%% + +%% generator(Line, Generator, Guard, State) -> {Generator',State}. +%% Transform a given generator into its #igen{} representation. + +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), + {[Tail,Skip],St2} = new_vars(2, St1), + {Cg,St3} = lc_guard_tests(Gs, St2), + {AccPat,SkipPat} = case Head of + #c_var{} -> + %% If the generator pattern is a variable, the + %% pattern from the accumulator clause can be + %% reused in the skip one. lc_tq and bc_tq1 takes + %% care of dismissing the latter in that case. + Cons = ann_c_cons(LA, Head, Tail), + {Cons,Cons}; + nomatch -> + %% If it never matches, there is no need for + %% an accumulator clause. + {nomatch,ann_c_cons(LA, Skip, Tail)}; + _ -> + {ann_c_cons(LA, Head, Tail), + ann_c_cons(LA, Skip, Tail)} + 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}}, + {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), + %% 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), + AccPat = Cp#c_binary{segments=AccSegs}, + {Cg,St2} = lc_guard_tests(Gs, St1), + {SkipSegs,St3} = emasculate_segments(AccSegs, St2), + SkipPat = Cp#c_binary{segments=SkipSegs}, + {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_binary{anno=LA,segments=[TailSeg]}, + arg={Pre,Ce}}, + {Gen,St4}. + append_tail_segment(Segs, St0) -> {Var,St} = new_var(St0), Tail = #c_bitstr{val=Var,size=#c_literal{val=all}, unit=#c_literal{val=1}, type=#c_literal{val=binary}, flags=#c_literal{val=[unsigned,big]}}, - {Segs++[Tail],Var,St}. + {Segs++[Tail],Var,Tail,St}. emasculate_segments(Segs, St) -> emasculate_segments(Segs, St, []). @@ -1189,7 +1220,7 @@ emasculate_segments([B|Rest], St0, Acc) -> {Var,St1} = new_var(St0), emasculate_segments(Rest, St1, [B#c_bitstr{val=Var}|Acc]); emasculate_segments([], St, Acc) -> - {lists:reverse(Acc),St}. + {reverse(Acc),St}. lc_guard_tests([], St) -> {[],St}; lc_guard_tests(Gs0, St0) -> @@ -1434,6 +1465,15 @@ safe(E0, St0) -> {Se,Sps,St2} = force_safe(E1, St1), {Se,Eps ++ Sps,St2}. +safe_fun(A0, E0, St0) -> + case safe(E0, St0) of + {#c_var{name={_,A1}}=E1,Eps,St1} when A1 =/= A0 -> + {V,St2} = new_var(St1), + {V,Eps ++ [#iset{var=V,arg=E1}],St2}; + Result -> + Result + end. + safe_list(Es, St) -> foldr(fun (E, {Ces,Esp,St0}) -> {Ce,Ep,St1} = safe(E, St0), @@ -1505,8 +1545,50 @@ pattern({cons,L,H,T}, St) -> pattern({tuple,L,Ps}, St) -> ann_c_tuple(lineno_anno(L, St), pattern_list(Ps, St)); pattern({map,L,Ps}, St) -> - #c_map{anno=lineno_anno(L, St), es=sort(pattern_list(Ps, St))}; -pattern({map_field_exact,L,K,V}, St) -> + #c_map{anno=lineno_anno(L, St), es=pattern_map_pairs(Ps, St)}; +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)}; +pattern({match,_,P1,P2}, St) -> + pat_alias(pattern(P1, St), pattern(P2, St)). + +%% 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)} + 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); + _ -> + 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)] + 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) -> %% FIXME: Better way to construct literals? or missing case %% {Key,_,_} = expr(K, St), Key = case K of @@ -1523,13 +1605,8 @@ pattern({map_field_exact,L,K,V}, St) -> #c_map_pair{anno=lineno_anno(L, St), op=#c_literal{val=exact}, key=Key, - val=pattern(V, St)}; -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)}; -pattern({match,_,P1,P2}, St) -> - pat_alias(pattern(P1, St), pattern(P2, St)). + val=pattern(V, St)}. + %% pat_bin([BinElement], State) -> [BinSeg]. @@ -1588,15 +1665,6 @@ pat_alias_list(_, _) -> throw(nomatch). pattern_list(Ps, St) -> [pattern(P, St) || P <- Ps]. -%% first([A]) -> [A]. -%% last([A]) -> A. - -first([_]) -> []; -first([H|T]) -> [H|first(T)]. - -last([L]) -> L; -last([_|T]) -> last(T). - %% make_vars([Name]) -> [{Var,Name}]. make_vars(Vs) -> [ #c_var{name=V} || V <- Vs ]. @@ -1679,13 +1747,13 @@ uclause(#iclause{anno=Anno,pats=Ps0,guard=G0,body=B0}, Pks, Ks0, St0) -> uguard([], [], _, St) -> {[],St}; uguard(Pg, [], Ks, St) -> %% No guard, so fold together equality tests. - uguard(first(Pg), [last(Pg)], Ks, St); + uguard(droplast(Pg), [last(Pg)], Ks, St); uguard(Pg, Gs0, Ks, St0) -> %% Gs0 must contain at least one element here. {Gs3,St5} = foldr(fun (T, {Gs1,St1}) -> {L,St2} = new_var(St1), {R,St3} = new_var(St2), - {[#iset{var=L,arg=T}] ++ first(Gs1) ++ + {[#iset{var=L,arg=T}] ++ droplast(Gs1) ++ [#iset{var=R,arg=last(Gs1)}, #icall{anno=#a{}, %Must have an #a{} module=#c_literal{val=erlang}, @@ -1754,13 +1822,16 @@ uexpr(#iletrec{anno=A,defs=Fs0,body=B0}, Ks, St0) -> {B1,St2} = uexprs(B0, Ks, St1), Used = used_in_any(map(fun ({_,F}) -> F end, Fs1) ++ B1), {#iletrec{anno=A#a{us=Used,ns=[]},defs=Fs1,body=B1},St2}; -uexpr(#icase{anno=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> +uexpr(#icase{anno=#a{anno=Anno}=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> %% As0 will never generate new variables. {As1,St1} = uexpr_list(As0, Ks, St0), {Cs1,St2} = uclauses(Cs0, Ks, St1), {Fc1,St3} = uclause(Fc0, Ks, St2), Used = union(used_in_any(As1), used_in_any(Cs1)), - New = new_in_all(Cs1), + New = case member(list_comprehension, Anno) of + true -> []; + false -> new_in_all(Cs1) + end, {#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3}; uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}, Ks0, St0) -> Avs = lit_list_vars(As), @@ -2088,7 +2159,8 @@ cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0, RecVar = #c_var{name={Name,length(Ps)}}, Let = #c_let{vars=[#c_var{name=Name}],arg=RecVar,body=Body}, CFun1 = CFun0#c_fun{body=Let}, - Letrec = #c_letrec{defs=[{RecVar,CFun1}], + Letrec = #c_letrec{anno=A0#a.anno, + defs=[{RecVar,CFun1}], body=RecVar}, {Letrec,[],Us1,St1} end; @@ -2134,6 +2206,8 @@ lit_vars(Lit) -> lit_vars(Lit, []). lit_vars(#c_cons{hd=H,tl=T}, Vs) -> lit_vars(H, lit_vars(T, Vs)); lit_vars(#c_tuple{es=Es}, Vs) -> lit_list_vars(Es, Vs); +lit_vars(#c_map{arg=V,es=Es}, Vs) -> lit_vars(V, lit_list_vars(Es, Vs)); +lit_vars(#c_map_pair{key=K,val=V}, Vs) -> lit_vars(K, lit_vars(V, Vs)); lit_vars(#c_var{name=V}, Vs) -> add_element(V, Vs); lit_vars(_, Vs) -> Vs. %These are atomic @@ -2224,7 +2298,9 @@ is_simple_list(Es) -> lists:all(fun is_simple/1, Es). format_error(nomatch) -> "pattern cannot possibly match"; format_error(bad_binary) -> - "binary construction will fail because of a type mismatch". + "binary construction will fail because of a type mismatch"; +format_error(bad_map) -> + "map construction will fail because of a type mismatch". add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 -> St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]}; diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 9a2b1605ad..d3b785aa14 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -81,7 +81,7 @@ -export([module/2,format_error/1]). -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, - keymember/3,keyfind/3,partition/2]). + keymember/3,keyfind/3,partition/2,droplast/1,last/1]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). -import(cerl, [c_tuple/1]). @@ -272,10 +272,18 @@ expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) -> expr(#c_tuple{anno=A,es=Ces}, Sub, St0) -> {Kes,Ep,St1} = atomic_list(Ces, Sub, St0), {#k_tuple{anno=A,es=Kes},Ep,St1}; -expr(#c_map{anno=A,var=Var0,es=Ces}, Sub, St0) -> - {Var,[],St1} = expr(Var0, Sub, St0), - {Kes,Ep,St2} = map_pairs(Ces, Sub, St1), - {#k_map{anno=A,var=Var,es=Kes},Ep,St2}; +expr(#c_map{anno=A,arg=Var,es=Ces}, Sub, St0) -> + try expr_map(A,Var,Ces,Sub,St0) of + {_,_,_}=Res -> Res + catch + throw:bad_map -> + St1 = add_warning(get_line(A), bad_map, A, St0), + Erl = #c_literal{val=erlang}, + Name = #c_literal{val=error}, + Args = [#c_literal{val=badarg}], + Error = #c_call{anno=A,module=Erl,name=Name,args=Args}, + expr(Error, Sub, St1) + end; expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> try atomic_bin(Cv, Sub, St0) of {Kv,Ep,St1} -> @@ -351,7 +359,7 @@ expr(#c_case{arg=Ca,clauses=Ccs}, Sub, St0) -> {Kvs,Pv,St2} = match_vars(Ka, St1), %Must have variables here! {Km,St3} = kmatch(Kvs, Ccs, Sub, St2), Match = flatten_seq(build_match(Kvs, Km)), - {last(Match),Pa ++ Pv ++ first(Match),St3}; + {last(Match),Pa ++ Pv ++ droplast(Match),St3}; expr(#c_receive{anno=A,clauses=Ccs0,timeout=Ce,action=Ca}, Sub, St0) -> {Ke,Pe,St1} = atomic(Ce, Sub, St0), %Force this to be atomic! {Rvar,St2} = new_var(St1), @@ -497,15 +505,85 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) -> translate_fc(Args) -> [#c_literal{val=function_clause},make_list(Args)]. -%% FIXME: Not completed -map_pairs(Es, Sub, St) -> - foldr(fun - (#c_map_pair{op=#c_literal{val=Op},key=K0,val=V0}, {Kes,Esp,St0}) when - Op =:= assoc; Op =:= exact -> %% assert Op - {K,[],St1} = expr(K0, Sub, St0), - {V,Ep,St2} = atomic(V0, Sub, St1), - {[#k_map_pair{op=Op,key=K,val=V}|Kes],Ep ++ Esp,St2} - end, {[],[],St}, Es). +expr_map(A,Var0,Ces,Sub,St0) -> + %% An extra pass of validation of Map src because of inlining + {Var,Mps,St1} = expr(Var0, Sub, St0), + case is_valid_map_src(Var) of + true -> + {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1), + {Km,Eps++Mps,St2}; + false -> throw(bad_map) + end. + +is_valid_map_src(#k_map{}) -> true; +is_valid_map_src(#k_literal{val=M}) when is_map(M) -> true; +is_valid_map_src(#k_var{}) -> true; +is_valid_map_src(_) -> false. + +map_split_pairs(A, Var, Ces, Sub, St0) -> + %% two steps + %% 1. force variables + %% 2. remove multiples + 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} + end, {[],[],St0}, Pairs0), + + case map_group_pairs(Pairs) of + {Assoc,[]} -> + Kes = [#k_map_pair{key=K,val=V}||{_,{assoc,K,V}} <- Assoc], + {#k_map{anno=A,op=assoc,var=Var,es=Kes},Esp,St1}; + {[],Exact} -> + Kes = [#k_map_pair{key=K,val=V}||{_,{exact,K,V}} <- Exact], + {#k_map{anno=A,op=exact,var=Var,es=Kes},Esp,St1}; + {Assoc,Exact} -> + Kes1 = [#k_map_pair{key=K,val=V}||{_,{assoc,K,V}} <- Assoc], + {Mvar,Em,St2} = force_atomic(#k_map{anno=A,op=assoc,var=Var,es=Kes1},St1), + Kes2 = [#k_map_pair{key=K,val=V}||{_,{exact,K,V}} <- Exact], + {#k_map{anno=A,op=exact,var=Mvar,es=Kes2},Esp ++ Em,St2} + + end. + +%% Group map by Assoc operations and Exact operations + +map_group_pairs(Es) -> + Groups = dict:to_list(map_group_pairs(Es,dict:new())), + partition(fun({_,{Op,_,_}}) -> Op =:= assoc end, Groups). + +map_group_pairs([{assoc,K,V}|Es0],Used0) -> + Used1 = case map_key_is_used(K,Used0) of + {ok, {assoc,_,_}} -> map_key_set_used(K,{assoc,K,V},Used0); + {ok, {exact,_,_}} -> map_key_set_used(K,{exact,K,V},Used0); + _ -> map_key_set_used(K,{assoc,K,V},Used0) + end, + map_group_pairs(Es0,Used1); +map_group_pairs([{exact,K,V}|Es0],Used0) -> + Used1 = case map_key_is_used(K,Used0) of + {ok, {assoc,_,_}} -> map_key_set_used(K,{assoc,K,V},Used0); + {ok, {exact,_,_}} -> map_key_set_used(K,{exact,K,V},Used0); + _ -> map_key_set_used(K,{exact,K,V},Used0) + end, + map_group_pairs(Es0,Used1); +map_group_pairs([],Used) -> + Used. + +map_key_set_used(K,How,Used) -> + dict:store(map_key_clean(K),How,Used). + +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}) -> {k_var,V}. + %% call_type(Module, Function, Arity) -> call | bif | apply | error. %% Classify the call. @@ -663,12 +741,8 @@ pattern(#c_tuple{anno=A,es=Ces}, Isub, Osub0, St0) -> {Kes,Osub1,St1} = pattern_list(Ces, Isub, Osub0, St0), {#k_tuple{anno=A,es=Kes},Osub1,St1}; pattern(#c_map{anno=A,es=Ces}, Isub, Osub0, St0) -> - {Kes,Osub1,St1} = pattern_list(Ces, Isub, Osub0, St0), - {#k_map{anno=A,es=Kes},Osub1,St1}; -pattern(#c_map_pair{op=#c_literal{val=exact},anno=A,key=Ck,val=Cv},Isub, Osub0, St0) -> - {Kk,Osub1,St1} = pattern(Ck, Isub, Osub0, St0), - {Kv,Osub2,St2} = pattern(Cv, Isub, Osub1, St1), - {#k_map_pair{anno=A,op=exact,key=Kk,val=Kv},Osub2,St2}; + {Kes,Osub1,St1} = pattern_map_pairs(Ces, Isub, Osub0, St0), + {#k_map{anno=A,op=exact,es=Kes},Osub1,St1}; pattern(#c_binary{anno=A,segments=Cv}, Isub, Osub0, St0) -> {Kv,Osub1,St1} = pattern_bin(Cv, Isub, Osub0, St0), {#k_binary{anno=A,segs=Kv},Osub1,St1}; @@ -683,6 +757,25 @@ flatten_alias(#c_alias{var=V,pat=P}) -> {[V|Vs],Pat}; 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), + {#k_map_pair{anno=A,key=Kk,val=Kv},{Osubi2,Sti2}} + end, {Osub0, St0}, Ces1), + {Kes,Osub1,St1}. + pattern_bin(Es, Isub, Osub0, St0) -> {Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0), {Kbin,Osub,St}. @@ -847,15 +940,6 @@ foldr2(Fun, Acc0, [E1|L1], [E2|L2]) -> foldr2(Fun, Acc1, L1, L2); foldr2(_, Acc, [], []) -> Acc. -%% first([A]) -> [A]. -%% last([A]) -> A. - -last([L]) -> L; -last([_|T]) -> last(T). - -first([_]) -> []; -first([H|T]) -> [H|first(T)]. - %% This code implements the algorithm for an optimizing compiler for %% pattern matching given "The Implementation of Functional %% Programming Languages" by Simon Peyton Jones. The code is much @@ -1342,13 +1426,13 @@ get_match(#k_bin_int{}=BinInt, St0) -> get_match(#k_tuple{es=Es}, St0) -> {Mes,St1} = new_vars(length(Es), St0), {#k_tuple{es=Mes},Mes,St1}; -get_match(#k_map{es=Es0}, St0) -> +get_match(#k_map{op=exact,es=Es0}, St0) -> {Mes,St1} = new_vars(length(Es0), St0), {Es,_} = mapfoldl(fun (#k_map_pair{}=Pair, [V|Vs]) -> {Pair#k_map_pair{val=V},Vs} end, Mes, Es0), - {#k_map{es=Es},Mes,St1}; + {#k_map{op=exact,es=Es},Mes,St1}; get_match(M, St) -> {M,[],St}. @@ -1365,9 +1449,8 @@ new_clauses(Cs0, U, St) -> [S,N|As]; #k_bin_int{next=N} -> [N|As]; - #k_map{es=Es} -> - Vals = [V || - #k_map_pair{op=exact,val=V} <- Es], + #k_map{op=exact,es=Es} -> + Vals = [V || #k_map_pair{val=V} <- Es], Vals ++ As; _Other -> As @@ -1467,14 +1550,14 @@ arg_val(Arg, C) -> _ -> {set_kanno(S, []),U,T,Fs} end; - #k_map{es=Es} -> + #k_map{op=exact,es=Es} -> Keys = [begin - #k_map_pair{op=exact,key=#k_literal{val=Key}} = Pair, + #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(Keys) + lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Keys) end. %% ubody_used_vars(Expr, State) -> [UsedVar] @@ -1885,7 +1968,7 @@ 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{op=exact,val=V}) -> +pat_vars(#k_map_pair{val=V}) -> pat_vars(V). pat_list_vars(Ps) -> @@ -1927,7 +2010,9 @@ format_error(nomatch_shadow) -> format_error(bad_call) -> "invalid module and/or function name; this call will always fail"; format_error(bad_segment_size) -> - "binary construction will fail because of a type mismatch". + "binary construction will fail because of a type mismatch"; +format_error(bad_map) -> + "map construction will fail because of a type mismatch". add_warning(none, Term, Anno, #kern{ws=Ws}=St) -> File = get_file(Anno), diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index c7886a070d..ab66445f73 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -38,8 +38,8 @@ -record(k_nil, {anno=[]}). -record(k_tuple, {anno=[],es}). --record(k_map, {anno=[],var,es}). --record(k_map_pair, {anno=[],op,key,val}). +-record(k_map, {anno=[],var,op,es}). +-record(k_map_pair, {anno=[],key,val}). -record(k_cons, {anno=[],hd,tl}). -record(k_binary, {anno=[],segs}). -record(k_bin_seg, {anno=[],size,unit,type,flags,seg,next}). diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl index edbd3f74f8..b33eba50eb 100644 --- a/lib/compiler/src/v3_kernel_pp.erl +++ b/lib/compiler/src/v3_kernel_pp.erl @@ -104,21 +104,30 @@ format_1(#k_tuple{es=Es}, Ctxt) -> format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), $} ]; -format_1(#k_map{var=#k_var{}=Var,es=Es}, Ctxt) -> - [$~,${, +format_1(#k_map{var=#k_literal{val=M},op=assoc,es=Es}, Ctxt) when is_map(M), map_size(M) =:= 0 -> + ["~{", + format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), + "}~" + ]; +format_1(#k_map{var=#k_literal{val=M},op=exact,es=Es}, Ctxt) when is_map(M), map_size(M) =:= 0 -> + ["::{", + format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), + "}::" + ]; +format_1(#k_map{var=Var,op=assoc,es=Es}, Ctxt) -> + ["~{", format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), " | ",format_1(Var, Ctxt), - $},$~ + "}~" ]; -format_1(#k_map{es=Es}, Ctxt) -> - [$~,${, +format_1(#k_map{var=Var,op=exact,es=Es}, Ctxt) -> + ["::{", format_hseq(Es, ",", ctxt_bump_indent(Ctxt, 1), fun format/2), - $},$~ + " | ",format_1(Var, Ctxt), + "}::" ]; -format_1(#k_map_pair{op=assoc,key=K,val=V}, Ctxt) -> - ["~<",format(K, Ctxt),",",format(V, Ctxt),">"]; -format_1(#k_map_pair{op=exact,key=K,val=V}, Ctxt) -> - ["::<",format(K, Ctxt),",",format(V, Ctxt),">"]; +format_1(#k_map_pair{key=K,val=V}, Ctxt) -> + ["<",format(K, Ctxt),",",format(V, Ctxt),">"]; format_1(#k_binary{segs=S}, Ctxt) -> ["#<",format(S, ctxt_bump_indent(Ctxt, 2)),">#"]; format_1(#k_bin_seg{next=Next}=S, Ctxt) -> diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index ae928e955c..c4f54a7970 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -367,12 +367,10 @@ literal(#k_bin_end{}, Ctxt) -> {bin_end,Ctxt}; literal(#k_tuple{es=Es}, Ctxt) -> {tuple,literal_list(Es, Ctxt)}; -literal(#k_map{var=Var,es=Es}, Ctxt) -> - {map,literal(Var, Ctxt),literal_list(Es, Ctxt)}; -literal(#k_map_pair{op=assoc,key=K,val=V}, Ctxt) -> - {map_pair_assoc,literal(K, Ctxt),literal(V, Ctxt)}; -literal(#k_map_pair{op=exact,key=K,val=V}, Ctxt) -> - {map_pair_exact,literal(K, Ctxt),literal(V, Ctxt)}; +literal(#k_map{op=Op,var=Var,es=Es}, Ctxt) -> + {map,Op,literal(Var, Ctxt),literal_list(Es, Ctxt)}; +literal(#k_map_pair{key=K,val=V}, Ctxt) -> + {map_pair,literal(K, Ctxt),literal(V, Ctxt)}; literal(#k_literal{val=V}, _Ctxt) -> {literal,V}. @@ -402,8 +400,8 @@ literal2(#k_bin_end{}, Ctxt) -> {bin_end,Ctxt}; literal2(#k_tuple{es=Es}, Ctxt) -> {tuple,literal_list2(Es, Ctxt)}; -literal2(#k_map{es=Es}, Ctxt) -> - {map,literal_list2(Es, Ctxt)}; +literal2(#k_map{op=Op,es=Es}, Ctxt) -> + {map,Op,literal_list2(Es, Ctxt)}; literal2(#k_map_pair{key=K,val=V}, Ctxt) -> {map_pair,literal2(K, Ctxt),literal2(V, Ctxt)}. |