diff options
Diffstat (limited to 'lib/compiler/src')
33 files changed, 1836 insertions, 1705 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index c6d09d85eb..7c4cebdc28 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -81,6 +81,7 @@ MODULES = \ rec_env \ sys_core_dsetel \ sys_core_fold \ + sys_core_fold_lists \ sys_core_inline \ sys_pre_attributes \ sys_pre_expand \ @@ -158,6 +159,10 @@ $(EBIN)/beam_asm.beam: $(ESRC)/beam_asm.erl $(EGEN)/beam_opcodes.hrl $(EBIN)/cerl_inline.beam: $(ESRC)/cerl_inline.erl $(V_ERLC) $(ERL_COMPILE_FLAGS) +nowarn_shadow_vars -o$(EBIN) $< +# Inlining core_parse is slow and has no benefit. +$(EBIN)/core_parse.beam: $(EGEN)/core_parse.erl + $(V_ERLC) $(subst +inline,,$(ERL_COMPILE_FLAGS)) -o$(EBIN) $< + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -187,6 +192,7 @@ $(EBIN)/core_parse.beam: core_parse.hrl $(EGEN)/core_parse.erl $(EBIN)/core_pp.beam: core_parse.hrl $(EBIN)/sys_core_dsetel.beam: core_parse.hrl $(EBIN)/sys_core_fold.beam: core_parse.hrl +$(EBIN)/sys_core_fold_lists.beam: core_parse.hrl $(EBIN)/sys_core_inline.beam: core_parse.hrl $(EBIN)/sys_pre_expand.beam: ../../stdlib/include/erl_bits.hrl $(EBIN)/v3_codegen.beam: v3_life.hrl diff --git a/lib/compiler/src/beam_a.erl b/lib/compiler/src/beam_a.erl index fe4f473846..dd7e03dd28 100644 --- a/lib/compiler/src/beam_a.erl +++ b/lib/compiler/src/beam_a.erl @@ -54,6 +54,9 @@ rename_instrs([{call_only,A,F}|Is]) -> [{call,A,F},return|rename_instrs(Is)]; rename_instrs([{call_ext_only,A,F}|Is]) -> [{call_ext,A,F},return|rename_instrs(Is)]; +rename_instrs([{'%live',_}|Is]) -> + %% When compiling from old .S files. + rename_instrs(Is); rename_instrs([I|Is]) -> [rename_instr(I)|rename_instrs(Is)]; rename_instrs([]) -> []. diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 5626aa34ab..5216f39296 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -155,7 +155,7 @@ collect(remove_message) -> {set,[],[],remove_message}; collect({put_map,F,Op,S,D,R,{list,Puts}}) -> {set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}; collect({get_map_elements,F,S,{list,Gets}}) -> - {Ss,Ds} = beam_utils:spliteven(Gets), + {Ss,Ds} = beam_utils:split_even(Gets), {set,Ds,[S|Ss],{get_map_elements,F}}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; collect(fclearerror) -> {set,[],[],fclearerror}; @@ -184,7 +184,7 @@ embed_lines([], Acc) -> Acc. opt_blocks([{block,Bl0}|Is]) -> %% The live annotation at the beginning is not useful. - [{'%live',_}|Bl] = Bl0, + [{'%live',_,_}|Bl] = Bl0, [{block,opt_block(Bl)}|opt_blocks(Is)]; opt_blocks([I|Is]) -> [I|opt_blocks(Is)]; @@ -252,13 +252,6 @@ combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) -> %% opt([Instruction]) -> [Instruction] %% Optimize the instruction stream inside a basic block. -opt([{set,[Dst],As,{bif,Bif,Fail}}=I1, - {set,[Dst],[Dst],{bif,'not',Fail}}=I2|Is]) -> - %% Get rid of the 'not' if the operation can be inverted. - case inverse_comp_op(Bif) of - none -> [I1,I2|opt(Is)]; - RevBif -> [{set,[Dst],As,{bif,RevBif,Fail}}|opt(Is)] - end; opt([{set,[X],[X],move}|Is]) -> opt(Is); opt([{set,_,_,{line,_}}=Line1, {set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, @@ -269,7 +262,7 @@ opt([{set,_,_,{line,_}}=Line1, opt([{set,Ds0,Ss,Op}|Is0]) -> {Ds,Is} = opt_moves(Ds0, Is0), [{set,Ds,Ss,Op}|opt(Is)]; -opt([{'%live',_}=I|Is]) -> +opt([{'%live',_,_}=I|Is]) -> [I|opt(Is)]; opt([]) -> []. @@ -428,18 +421,6 @@ x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N)); x_live([_|Rs], Regs) -> x_live(Rs, Regs); x_live([], Regs) -> Regs. -%% inverse_comp_op(Op) -> none|RevOp - -inverse_comp_op('=:=') -> '=/='; -inverse_comp_op('=/=') -> '=:='; -inverse_comp_op('==') -> '/='; -inverse_comp_op('/=') -> '=='; -inverse_comp_op('>') -> '=<'; -inverse_comp_op('<') -> '>='; -inverse_comp_op('>=') -> '<'; -inverse_comp_op('=<') -> '>'; -inverse_comp_op(_) -> none. - %%% %%% Evaluation of constant bit fields. %%% diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index a452d30b61..5ed9c16d61 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -787,6 +787,9 @@ is_not_used(R, Is, Label, #st{ll=Ll}) -> initialized_regs(Is) -> initialized_regs(Is, ordsets:new()). +initialized_regs([{set,Dst,_Src,{alloc,Live,_}}|_], Regs0) -> + Regs = add_init_regs(free_vars_regs(Live), Regs0), + add_init_regs(Dst, Regs); initialized_regs([{set,Dst,Src,_}|Is], Regs) -> initialized_regs(Is, add_init_regs(Dst, add_init_regs(Src, Regs))); initialized_regs([{test,_,_,Src}|Is], Regs) -> diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index b653998252..b68b8702e0 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -234,31 +234,6 @@ replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 -> replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D); replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 -> replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D); -replace([{bs_init2,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_init2,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D); -replace([{bs_init_bits,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_init_bits,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D); -replace([{bs_put_integer,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put_integer,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); -replace([{bs_put_utf8=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); -replace([{bs_put_utf16=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); -replace([{bs_put_utf32=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); -replace([{bs_put_binary,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put_binary,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); -replace([{bs_put_float,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put_float,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); -replace([{bs_add,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_add,{f,label(Lbl, D)},Src,Dst}|Acc], D); -replace([{bs_append,{f,Lbl},_,_,_,_,_,_,_}=I0|Is], Acc, D) when Lbl =/= 0 -> - I = setelement(2, I0, {f,label(Lbl, D)}), - replace(Is, [I|Acc], D); -replace([{bs_utf8_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D); -replace([{bs_utf16_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D); 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); diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 7cd07dc3be..f4515ba2a7 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -98,6 +98,12 @@ move_move_into_block([], Acc) -> reverse(Acc). forward(Is, Lc) -> forward(Is, gb_trees:empty(), Lc, []). +forward([{move,_,_}=Move|[{label,L}|_]=Is], D, Lc, Acc) -> + %% move/2 followed by jump/1 is optimized by backward/3. + forward([Move,{jump,{f,L}}|Is], D, Lc, Acc); +forward([{bif,_,_,_,_}=Bif|[{label,L}|_]=Is], D, Lc, Acc) -> + %% bif/4 followed by jump/1 is optimized by backward/3. + forward([Bif,{jump,{f,L}}|Is], D, Lc, Acc); forward([{block,[]}|Is], D, Lc, Acc) -> %% Empty blocks can prevent optimizations. forward(Is, D, Lc, Acc); @@ -124,6 +130,8 @@ forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) -> _ -> Is0 %Keep move instruction. end, forward(Is, D, Lc, [LblI|Acc]); +forward([{test,is_eq_exact,_,[Same,Same]}|Is], D, Lc, Acc) -> + forward(Is, D, Lc, Acc); forward([{test,is_eq_exact,_,[Dst,Src]}=I, {block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) -> forward([I,{block,Bl}|Is], D, Lc, Acc); @@ -234,10 +242,8 @@ backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> Fail = shortcut_bs_test(Fail1, Is, D), Sel = {select,select_val,Reg,{f,Fail},List}, backward(Is, D, [Sel|Acc]); -backward([{jump,{f,To0}},{move,Src0,Reg}|Is], D, Acc) -> - To1 = shortcut_select_label(To0, Reg, Src0, D), - {To,Src} = shortcut_boolean_label(To1, Reg, Src0, D), - Move = {move,Src,Reg}, +backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> + To = shortcut_select_label(To0, Reg, Src, D), Jump = {jump,{f,To}}, case beam_utils:is_killed_at(Reg, To, D) of false -> backward([Move|Is], D, [Jump|Acc]); @@ -330,16 +336,6 @@ shortcut_label(To0, D) -> shortcut_select_label(To, Reg, Lit, D) -> shortcut_rel_op(To, is_ne_exact, [Reg,Lit], D). -shortcut_boolean_label(To0, Reg, {atom,Bool0}=Lit, D) when is_boolean(Bool0) -> - case beam_utils:code_at(To0, D) of - [{line,_},{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] -> - Bool = {atom,not Bool0}, - {shortcut_select_label(To, Reg, Bool, D),Bool}; - _ -> - {To0,Lit} - end; -shortcut_boolean_label(To, _, Bool, _) -> {To,Bool}. - %% Replace a comparison operator with a test instruction and a jump. %% For example, if we have this code: %% diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 05d067dc48..54e06df995 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -63,9 +63,7 @@ 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,Ds,[S|Ss],{get_map_elements,F}}) -> - Gets = beam_utils:joineven(Ss,Ds), - {get_map_elements,F,S,{list,Gets}}; +%% get_map_elements is always handled in beam_split (moved out of block) 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 b952139f2c..ba71d4efae 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -166,6 +166,12 @@ share_1([{label,L}=Lbl|Is], Dict0, Seq, Acc) -> end; share_1([{func_info,_,_,_}=I|Is], _, [], Acc) -> reverse(Is, [I|Acc]); +share_1([{'try',_,_}=I|Is], Dict0, Seq, Acc) -> + Dict = clean_non_sharable(Dict0), + share_1(Is, Dict, [I|Seq], Acc); +share_1([{try_case,_}=I|Is], Dict0, Seq, Acc) -> + Dict = clean_non_sharable(Dict0), + share_1(Is, Dict, [I|Seq], Acc); share_1([I|Is], Dict, Seq, Acc) -> case is_unreachable_after(I) of false -> @@ -174,6 +180,24 @@ share_1([I|Is], Dict, Seq, Acc) -> share_1(Is, Dict, [I], Acc) end. +clean_non_sharable(Dict) -> + %% We are passing in or out of a 'try' block. Remove + %% sequences that should not shared over the boundaries + %% of a 'try' block. Since the end of the sequence must match, + %% the only possible match between a sequence outside and + %% a sequence inside the 'try' block is a sequence that ends + %% with an instruction that causes an exception. Any sequence + %% that causes an exception must contain a line/1 instruction. + dict:filter(fun(K, _V) -> sharable_with_try(K) end, Dict). + +sharable_with_try([{line,_}|_]) -> + %% This sequence may cause an exception and may potentially + %% match a sequence on the other side of the 'try' block + %% boundary. + false; +sharable_with_try([_|Is]) -> + sharable_with_try(Is); +sharable_with_try([]) -> true. %% Eliminate all fallthroughs. Return the result reversed. @@ -295,12 +319,6 @@ opt([{test,_,{f,_}=Lbl,_,_,_}=I|Is], Acc, St) -> opt(Is, [I|Acc], label_used(Lbl, St)); opt([{select,_,_R,Fail,Vls}=I|Is], Acc, St) -> skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St)); -opt([{label,L}=I|Is], Acc, #st{entry=L}=St) -> - %% NEVER move the entry label. - opt(Is, [I|Acc], St); -opt([{label,L1},{jump,{f,L2}}=I|Is], [Prev|Acc], St0) -> - St = St0#st{mlbl=dict:append(L2, L1, St0#st.mlbl)}, - opt([Prev,I|Is], Acc, label_used({f,L2}, St)); opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) -> case dict:find(Lbl, Mlbl) of {ok,Lbls} -> @@ -310,9 +328,20 @@ opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) -> insert_labels([Lbl|Lbls], Is, Acc, St); error -> opt(Is, [I|Acc], St0) end; -opt([{jump,{f,Lbl}},{label,Lbl}=I|Is], Acc, St) -> - opt([I|Is], Acc, St); -opt([{jump,Lbl}=I|Is], Acc, St) -> +opt([{jump,{f,_}=X}|[{label,_},{jump,X}|_]=Is], Acc, St) -> + opt(Is, Acc, St); +opt([{jump,{f,Lbl}}|[{label,Lbl}|_]=Is], Acc, St) -> + opt(Is, Acc, St); +opt([{jump,{f,L}=Lbl}=I|Is], Acc0, #st{mlbl=Mlbl0}=St0) -> + %% All labels before this jump instruction should now be + %% moved to the location of the jump's target. + {Lbls,Acc} = collect_labels(Acc0, St0), + St = case Lbls of + [] -> St0; + [_|_] -> + Mlbl = dict:append_list(L, Lbls, Mlbl0), + St0#st{mlbl=Mlbl} + end, skip_unreachable(Is, [I|Acc], label_used(Lbl, St)); %% Optimization: quickly handle some common instructions that don't %% have any failure labels and where is_unreachable_after(I) =:= false. @@ -349,6 +378,17 @@ insert_fc_labels([L|Ls], Mlbl, Acc0) -> end; insert_fc_labels([], _, Acc) -> Acc. +collect_labels(Is, #st{entry=Entry}) -> + collect_labels_1(Is, Entry, []). + +collect_labels_1([{label,Entry}|_]=Is, Entry, Acc) -> + %% Never move the entry label. + {Acc,Is}; +collect_labels_1([{label,L}|Is], Entry, Acc) -> + collect_labels_1(Is, Entry, [L|Acc]); +collect_labels_1(Is, _Entry, Acc) -> + {Acc,Is}. + %% label_defined(Is, Label) -> true | false. %% Test whether the label Label is defined at the start of the instruction %% sequence, possibly preceeded by other label definitions. @@ -435,14 +475,14 @@ is_label_used_in(Lbl, Is) -> is_label_used_in_1(Is, Lbl, gb_sets:empty()). is_label_used_in_1([{block,Block}|Is], Lbl, Empty) -> - lists:any(fun(I) -> is_label_used_in_2(I, Lbl) end, Block) + lists:any(fun(I) -> is_label_used_in_block(I, Lbl) end, Block) orelse is_label_used_in_1(Is, Lbl, Empty); is_label_used_in_1([I|Is], Lbl, Empty) -> Used = ulbl(I, Empty), gb_sets:is_member(Lbl, Used) orelse is_label_used_in_1(Is, Lbl, Empty); is_label_used_in_1([], _, _) -> false. -is_label_used_in_2({set,_,_,Info}, Lbl) -> +is_label_used_in_block({set,_,_,Info}, Lbl) -> case Info of {bif,_,{f,F}} -> F =:= Lbl; {alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl; @@ -452,7 +492,6 @@ is_label_used_in_2({set,_,_,Info}, Lbl) -> {put_tuple,_} -> false; {get_tuple_element,_} -> false; {set_tuple_element,_} -> false; - {get_map_elements,{f,F}} -> F =:= Lbl; {line,_} -> false; _ when is_atom(Info) -> false end. diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 97a8c7ba70..5abacc8d5d 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -108,14 +108,14 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) -> %% has succeeded. peep(Is, gb_sets:empty(), [I|Acc]); true -> - Test = {Op,Ops}, - case gb_sets:is_element(Test, SeenTests0) of + case is_test_redundant(Op, Ops, SeenTests0) of true -> - %% This test has already succeeded and + %% This test or a similar test has already succeeded and %% is therefore redundant. peep(Is, SeenTests0, Acc); false -> %% Remember that we have seen this test. + Test = {Op,Ops}, SeenTests = gb_sets:insert(Test, SeenTests0), peep(Is, SeenTests, [I|Acc]) end @@ -136,6 +136,15 @@ peep([I|Is], _, Acc) -> peep(Is, gb_sets:empty(), [I|Acc]); peep([], _, Acc) -> reverse(Acc). +is_test_redundant(Op, Ops, Seen) -> + gb_sets:is_element({Op,Ops}, Seen) orelse + is_test_redundant_1(Op, Ops, Seen). + +is_test_redundant_1(is_boolean, [R], Seen) -> + gb_sets:is_element({is_eq_exact,[R,{atom,false}]}, Seen) orelse + gb_sets:is_element({is_eq_exact,[R,{atom,true}]}, Seen); +is_test_redundant_1(_, _, _) -> false. + kill_seen(Dst, Seen0) -> gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)). diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index f5dba314ae..0c62b0bf3d 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -53,9 +53,8 @@ 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,Ds,[S|Ss],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc) - when Lbl =/= 0 -> - Gets = beam_utils:joineven(Ss,Ds), +split_block([{set,Ds,[S|Ss],{get_map_elements,Fail}}|Is], Bl, Acc) -> + Gets = beam_utils:join_even(Ss,Ds), split_block(Is, [], [{get_map_elements,Fail,S,{list,Gets}}|make_block(Bl, Acc)]); split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index cdddad4153..26c933481a 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -244,7 +244,7 @@ clearerror([], OrigIs) -> [{set,[],[],fclearerror}|OrigIs]. %% Combine two blocks and eliminate any move instructions that assign %% to registers that are killed later in the block. %% -merge_blocks(B1, [{'%live',_}|B2]) -> +merge_blocks(B1, [{'%live',_,_}|B2]) -> merge_blocks_1(B1++[{set,[],[],stop_here}|B2]). merge_blocks_1([{set,[],_,stop_here}|Is]) -> Is; @@ -329,27 +329,27 @@ build_alloc(Words, Floats) -> {alloc,[{words,Words},{floats,Floats}]}. %% flt_liveness([Instruction]) -> [Instruction] %% (Re)calculate the number of live registers for each heap allocation -%% function. We base liveness of the number of live registers at -%% entry to the instruction sequence. +%% function. We base liveness of the number of register map at the +%% beginning of the instruction sequence. %% %% A 'not_possible' term will be thrown if the set of live registers %% is not continous at an allocation function (e.g. if {x,0} and {x,2} %% are live, but not {x,1}). -flt_liveness([{'%live',Live}=LiveInstr|Is]) -> - flt_liveness_1(Is, init_regs(Live), [LiveInstr]). +flt_liveness([{'%live',_Live,Regs}=LiveInstr|Is]) -> + flt_liveness_1(Is, Regs, [LiveInstr]). -flt_liveness_1([{set,Ds,Ss,{alloc,_,Alloc}}|Is], Regs0, Acc) -> - Live = live_regs(Regs0), +flt_liveness_1([{set,Ds,Ss,{alloc,Live0,Alloc}}|Is], Regs0, Acc) -> + Live = min(Live0, live_regs(Regs0)), I = {set,Ds,Ss,{alloc,Live,Alloc}}, - Regs = foldl(fun(R, A) -> set_live(R, A) end, Regs0, Ds), + Regs1 = init_regs(Live), + Regs = x_live(Ds, Regs1), flt_liveness_1(Is, Regs, [I|Acc]); flt_liveness_1([{set,Ds,_,_}=I|Is], Regs0, Acc) -> - Regs = foldl(fun(R, A) -> set_live(R, A) end, Regs0, Ds), + Regs = x_live(Ds, Regs0), flt_liveness_1(Is, Regs, [I|Acc]); -flt_liveness_1([{'%live',_}=I|Is], Regs, Acc) -> - flt_liveness_1(Is, Regs, [I|Acc]); -flt_liveness_1([], _Regs, Acc) -> reverse(Acc). +flt_liveness_1([{'%live',_,_}], _Regs, Acc) -> + reverse(Acc). init_regs(Live) -> (1 bsl Live) - 1. @@ -364,14 +364,15 @@ live_regs_1(R, N) -> 1 -> live_regs_1(R bsr 1, N+1) end. -set_live({x,X}, Regs) -> Regs bor (1 bsl X); -set_live(_, Regs) -> Regs. +x_live([{x,N}|Rs], Regs) -> x_live(Rs, Regs bor (1 bsl N)); +x_live([_|Rs], Regs) -> x_live(Rs, Regs); +x_live([], Regs) -> Regs. %% update(Instruction, TypeDb) -> NewTypeDb %% Update the type database to account for executing an instruction. %% %% First the cases for instructions inside basic blocks. -update({'%live',_}, Ts) -> Ts; +update({'%live',_,_}, Ts) -> Ts; update({set,[D],[S],move}, Ts) -> tdb_copy(S, D, Ts); update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) -> @@ -469,6 +470,7 @@ is_math_bif(erf, 1) -> true; is_math_bif(erfc, 1) -> true; is_math_bif(exp, 1) -> true; is_math_bif(log, 1) -> true; +is_math_bif(log2, 1) -> true; is_math_bif(log10, 1) -> true; is_math_bif(sqrt, 1) -> true; is_math_bif(atan2, 2) -> true; diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index e82ba82d38..7704690f86 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -26,7 +26,7 @@ code_at/2,bif_to_test/3,is_pure_test/1, live_opt/1,delete_live_annos/1,combine_heap_needs/2]). --export([joineven/2,spliteven/1]). +-export([join_even/2,split_even/1]). -import(lists, [member/2,sort/1,reverse/1,splitwith/2]). @@ -187,7 +187,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,has_map_fields,_,[_|_]}) -> true; is_pure_test({test,Op,_,Ops}) -> erl_internal:new_type_test(Op, length(Ops)). @@ -196,7 +196,7 @@ is_pure_test({test,Op,_,Ops}) -> %% Go through the instruction sequence in reverse execution %% order, keep track of liveness and remove 'move' instructions %% whose destination is a register that will not be used. -%% Also insert {'%live',Live} annotations at the beginning +%% Also insert {'%live',Live,Regs} annotations at the beginning %% and end of each block. %% live_opt(Is0) -> @@ -217,7 +217,7 @@ delete_live_annos([{block,Bl0}|Is]) -> [] -> delete_live_annos(Is); [_|_]=Bl -> [{block,Bl}|delete_live_annos(Is)] end; -delete_live_annos([{'%live',_}|Is]) -> +delete_live_annos([{'%live',_,_}|Is]) -> delete_live_annos(Is); delete_live_annos([I|Is]) -> [I|delete_live_annos(Is)]; @@ -366,11 +366,6 @@ check_liveness(R, [{apply,Args}|Is], St) -> {x,_} -> {killed,St}; {y,_} -> check_liveness(R, Is, St) end; -check_liveness({x,R}, [{'%live',Live}|Is], St) -> - if - R < Live -> check_liveness(R, Is, St); - true -> {killed,St} - end; check_liveness(R, [{bif,Op,{f,Fail},Ss,D}|Is], St0) -> case check_liveness_fail(R, Op, Ss, Fail, St0) of {killed,St} = Killed -> @@ -554,7 +549,7 @@ check_killed_block(R, [{set,Ds,Ss,_Op}|Is]) -> false -> check_killed_block(R, Is) end end; -check_killed_block(R, [{'%live',Live}|Is]) -> +check_killed_block(R, [{'%live',Live,_}|Is]) -> case R of {x,X} when X >= Live -> killed; _ -> check_killed_block(R, Is) @@ -577,7 +572,7 @@ check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) -> end; check_used_block(R, [{set,Ds,Ss,Op}|Is], St) -> check_used_block_1(R, Ss, Ds, Op, Is, St); -check_used_block(R, [{'%live',Live}|Is], St) -> +check_used_block(R, [{'%live',Live,_}|Is], St) -> case R of {x,X} when X >= Live -> {killed,St}; _ -> check_used_block(R, Is, St) @@ -678,9 +673,9 @@ live_opt([{test,bs_start_match2,Fail,Live,[Src,_],_}=I|Is], _, D, Acc) -> %% Other instructions. live_opt([{block,Bl0}|Is], Regs0, D, Acc) -> - Live0 = {'%live',live_regs(Regs0)}, + Live0 = {'%live',live_regs(Regs0),Regs0}, {Bl,Regs} = live_opt_block(reverse(Bl0), Regs0, D, [Live0]), - Live = {'%live',live_regs(Regs)}, + Live = {'%live',live_regs(Regs),Regs}, live_opt(Is, Regs, D, [{block,[Live|Bl]}|Acc]); live_opt([{label,L}=I|Is], Regs, D0, Acc) -> D = gb_trees:insert(L, Regs, D0), @@ -758,13 +753,9 @@ live_opt([{line,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); %% The following instructions can occur if the "compilation" has been -%% started from a .S file using the 'asm' option. +%% started from a .S file using the 'from_asm' option. live_opt([{trim,_,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); -live_opt([{allocate,_,Live}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Live), D, [I|Acc]); -live_opt([{allocate_heap,_,_,Live}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Live), D, [I|Acc]); live_opt([{'%',_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{recv_set,_}=I|Is], Regs, D, Acc) -> @@ -835,14 +826,14 @@ x_live([], Regs) -> Regs. is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1. -%% spliteven/1 +%% split_even/1 %% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]} -spliteven(Rs) -> spliteven(Rs,[],[]). -spliteven([],Ss,Ds) -> {reverse(Ss),reverse(Ds)}; -spliteven([S,D|Rs],Ss,Ds) -> - spliteven(Rs,[S|Ss],[D|Ds]). +split_even(Rs) -> split_even(Rs,[],[]). +split_even([],Ss,Ds) -> {reverse(Ss),reverse(Ds)}; +split_even([S,D|Rs],Ss,Ds) -> + split_even(Rs,[S|Ss],[D|Ds]). -%% joineven/1 +%% join_even/1 %% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6] -joineven([],[]) -> []; -joineven([S|Ss],[D|Ds]) -> [S,D|joineven(Ss,Ds)]. +join_even([],[]) -> []; +join_even([S|Ss],[D|Ds]) -> [S,D|join_even(Ss,Ds)]. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 0acc7a227f..4d4536b79c 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -22,7 +22,6 @@ %% Avoid warning for local function error/1 clashing with autoimported BIF. -compile({no_auto_import,[error/1]}). --export([file/1, files/1]). %% Interface for compiler. -export([module/2, format_error/1]). @@ -40,38 +39,12 @@ -define(DBG_FORMAT(F, D), ok). -endif. -%%% -%%% API functions. -%%% - --spec file(file:filename()) -> 'ok' | {'error', term()}. - -file(Name) when is_list(Name) -> - case case filename:extension(Name) of - ".S" -> s_file(Name); - ".beam" -> beam_file(Name) - end of - [] -> ok; - Es -> {error,Es} - end. - --spec files([file:filename()]) -> 'ok'. - -files([F|Fs]) -> - ?DBG_FORMAT("# Verifying: ~p~n", [F]), - case file(F) of - ok -> ok; - {error,Es} -> - io:format("~tp:~n~ts~n", [F,format_error(Es)]) - end, - files(Fs); -files([]) -> ok. - %% To be called by the compiler. module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) -> case validate(Mod, Fs) of - [] -> {ok,Code}; + [] -> + {ok,Code}; Es0 -> Es = [{?MODULE,E} || E <- Es0], {error,[{atom_to_list(Mod),Es}]} @@ -79,12 +52,6 @@ module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) -spec format_error(term()) -> iolist(). -format_error([]) -> []; -format_error([{{M,F,A},{I,Off,Desc}}|Es]) -> - [io_lib:format(" ~p:~p/~p+~p:~n ~p - ~p~n", - [M,F,A,Off,I,Desc])|format_error(Es)]; -format_error([Error|Es]) -> - [format_error(Error)|format_error(Es)]; format_error({{_M,F,A},{I,Off,limit}}) -> io_lib:format( "function ~p/~p+~p:~n" @@ -103,8 +70,6 @@ format_error({{_M,F,A},{I,Off,Desc}}) -> " Internal consistency check failed - please report this bug.~n" " Instruction: ~p~n" " Error: ~p:~n", [F,A,Off,I,Desc]); -format_error({Module,Error}) -> - [Module:format_error(Error)]; format_error(Error) -> io_lib:format("~p~n", [Error]). @@ -112,36 +77,6 @@ format_error(Error) -> %%% Local functions follow. %%% -s_file(Name) -> - {ok,Is} = file:consult(Name), - {module,Module} = lists:keyfind(module, 1, Is), - Fs = find_functions(Is), - validate(Module, Fs). - -find_functions(Fs) -> - find_functions_1(Fs, none, [], []). - -find_functions_1([{function,Name,Arity,Entry}|Is], Func, FuncAcc, Acc0) -> - Acc = add_func(Func, FuncAcc, Acc0), - find_functions_1(Is, {Name,Arity,Entry}, [], Acc); -find_functions_1([I|Is], Func, FuncAcc, Acc) -> - find_functions_1(Is, Func, [I|FuncAcc], Acc); -find_functions_1([], Func, FuncAcc, Acc) -> - reverse(add_func(Func, FuncAcc, Acc)). - -add_func(none, _, Acc) -> Acc; -add_func({Name,Arity,Entry}, Is, Acc) -> - [{function,Name,Arity,Entry,reverse(Is)}|Acc]. - -beam_file(Name) -> - try beam_disasm:file(Name) of - {error,beam_lib,Reason} -> [{beam_lib,Reason}]; - #beam_file{module=Module, code=Code0} -> - Code = normalize_disassembled_code(Code0), - validate(Module, Code) - catch _:_ -> [disassembly_failed] - end. - %%% %%% The validator follows. %%% @@ -196,23 +131,16 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> try validate_1(Code, Name, Ar, Entry, Ft) of _ -> validate_0(Module, Fs, Ft) catch - Error -> + throw:Error -> + %% Controlled error. [Error|validate_0(Module, Fs, Ft)]; - error:Error -> - [validate_error(Error, Module, Name, Ar)|validate_0(Module, Fs, Ft)] + Class:Error -> + %% Crash. + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Ar]), + erlang:raise(Class, Error, Stack) end. --ifdef(DEBUG). -validate_error(Error, Module, Name, Ar) -> - exit(validate_error_1(Error, Module, Name, Ar)). --else. -validate_error(Error, Module, Name, Ar) -> - validate_error_1(Error, Module, Name, Ar). --endif. -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', _}). @@ -225,7 +153,6 @@ validate_error_1(Error, Module, Name, Ar) -> hf=0, %Available heap size for floats. fls=undefined, %Floating point state. ct=[], %List of hot catch/try labels - bsm=undefined, %Bit syntax matching state. bits=undefined, %Number of bits in bit syntax binary. setelem=false %Previous instruction was setelement/3. }). @@ -308,7 +235,7 @@ labels_1([{label,L}|Is], R) -> labels_1([{line,_}|Is], R) -> labels_1(Is, R); labels_1(Is, R) -> - {lists:reverse(R),Is}. + {reverse(R),Is}. init_state(Arity) -> Xs = init_regs(Arity, term), @@ -403,10 +330,6 @@ valfun_1({init,{y,_}=Reg}, Vst) -> set_type_y(initialized, Reg, Vst); valfun_1({test_heap,Heap,Live}, Vst) -> test_heap(Heap, Live, Vst); -valfun_1({bif,_Op,nofail,Src,Dst}, Vst) -> - %% The 'nofail' atom only occurs in disassembled code. - validate_src(Src, Vst), - set_type_reg(term, Dst, Vst); valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> case is_bif_safe(Op, length(Src)) of false -> @@ -432,18 +355,12 @@ valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> valfun_1({put,Src}, Vst) -> assert_term(Src, Vst), eat_heap(1, Vst); -valfun_1({put_string,Sz,_,Dst}, Vst0) when is_integer(Sz) -> - Vst = eat_heap(2*Sz, Vst0), - set_type_reg(cons, Dst, Vst); %% Instructions for optimization of selective receives. valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) -> Vst; valfun_1({recv_set,{f,Fail}}, Vst) when is_integer(Fail) -> Vst; %% Misc. -valfun_1({'%live',Live}, Vst) -> - verify_live(Live, Vst), - Vst; valfun_1(remove_message, Vst) -> Vst; valfun_1({'%',_}, Vst) -> @@ -602,8 +519,6 @@ valfun_4({call_ext_last,Live,Func,StkSize}, tail_call(Func, Live, Vst); valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) -> error({allocated,NumY}); -valfun_4({make_fun,_,_,Live}, Vst) -> - call('fun', Live, Vst); valfun_4({make_fun2,_,_,_,Live}, Vst) -> call(make_fun, Live, Vst); %% Other BIFs @@ -620,8 +535,6 @@ valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0), Vst = set_type(TupleType, Tuple, Vst1), set_type_reg(term, Dst, Vst); -valfun_4({raise,{f,_}=Fail,Src,Dst}, Vst) -> - valfun_4({bif,raise,Fail,Src,Dst}, Vst); valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) -> validate_src(Src, Vst0), Vst = branch_state(Fail, Vst0), @@ -738,32 +651,6 @@ valfun_4({bs_save2,Ctx,SavePoint}, Vst) -> valfun_4({bs_restore2,Ctx,SavePoint}, Vst) -> bsm_restore(Ctx, SavePoint, Vst); -%% Bit syntax instructions. -valfun_4({bs_start_match,{f,_Fail}=F,Src}, Vst) -> - valfun_4({test,bs_start_match,F,[Src]}, Vst); -valfun_4({test,bs_start_match,{f,Fail},[Src]}, Vst) -> - assert_term(Src, Vst), - bs_start_match(branch_state(Fail, Vst)); - -valfun_4({bs_save,SavePoint}, Vst) -> - bs_assert_state(Vst), - bs_save(SavePoint, Vst); -valfun_4({bs_restore,SavePoint}, Vst) -> - bs_assert_state(Vst), - bs_assert_savepoint(SavePoint, Vst), - Vst; -valfun_4({test,bs_skip_bits,{f,Fail},[Src,_,_]}, Vst) -> - bs_assert_state(Vst), - assert_term(Src, Vst), - branch_state(Fail, Vst); -valfun_4({test,bs_test_tail,{f,Fail},_}, Vst) -> - bs_assert_state(Vst), - branch_state(Fail, Vst); -valfun_4({test,_,{f,Fail},[_,_,_,Dst]}, Vst0) -> - bs_assert_state(Vst0), - Vst = branch_state(Fail, Vst0), - set_type_reg({integer,[]}, Dst, Vst); - %% Other test instructions. valfun_4({test,is_float,{f,Lbl},[Float]}, Vst) -> assert_term(Float, Vst), @@ -779,9 +666,17 @@ 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_type(map, Src, Vst), assert_strict_literal_termorder(List), branch_state(Lbl, Vst); +valfun_4({test,is_map,{f,Lbl},[Src]}, Vst0) -> + Vst = branch_state(Lbl, Vst0), + case Src of + {Tag,_} when Tag =:= x; Tag =:= y -> + set_type_reg(map, Src, Vst); + _ -> + Vst + end; valfun_4({test,_Op,{f,Lbl},Src}, Vst) -> validate_src(Src, Vst), branch_state(Lbl, Vst); @@ -795,9 +690,6 @@ valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); -valfun_4({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst) -> - assert_term(Src, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), if @@ -868,16 +760,6 @@ valfun_4({bs_put_utf32,{f,Fail},_,Src}=I, Vst0) -> assert_term(Src, Vst0), Vst = bs_align_check(I, Vst0), branch_state(Fail, Vst); -%% Old bit syntax construction (before R10B). -valfun_4({bs_init,_,_}, Vst) -> - bs_zero_bits(Vst); -valfun_4({bs_need_buf,_}, Vst) -> Vst; -valfun_4({bs_final,{f,Fail},Dst}, Vst0) -> - Vst = branch_state(Fail, Vst0), - set_type_reg(binary, Dst, Vst); -valfun_4({bs_final2,Src,Dst}, Vst0) -> - assert_term(Src, Vst0), - set_type_reg(binary, Dst, Vst0); %% Map instructions. valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> verify_put_map(Fail, Src, Dst, Live, List, Vst); @@ -889,26 +771,30 @@ valfun_4(_, _) -> error(unknown_instruction). verify_get_map(Fail, Src, List, Vst0) -> - assert_term(Src, Vst0), + assert_type(map, Src, Vst0), Vst1 = branch_state(Fail, Vst0), - Lits = mmap(fun(L,_R) -> [L] end, List), - assert_strict_literal_termorder(Lits), + Keys = extract_map_keys(List), + assert_strict_literal_termorder(Keys), verify_get_map_pair(List,Vst0,Vst1). +extract_map_keys([Key,_Val|T]) -> + [Key|extract_map_keys(T)]; +extract_map_keys([]) -> []. + 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) -> + assert_type(map, Src, Vst0), verify_live(Live, Vst0), verify_y_init(Vst0), foreach(fun (Term) -> assert_term(Term, Vst0) end, List), - assert_term(Src, Vst0), Vst1 = heap_alloc(0, Vst0), Vst2 = branch_state(Fail, Vst1), Vst = prune_x_regs(Live, Vst2), - set_type_reg(term, Dst, Vst). + set_type_reg(map, Dst, Vst). %% %% Common code for validating bs_get* instructions. @@ -936,9 +822,6 @@ validate_bs_skip_utf(Fail, Ctx, Live, Vst0) -> %% val_dsetel({move,_,_}, Vst) -> Vst; -val_dsetel({put_string,0,{string,""},_}, Vst) -> - %% An empty string is OK since it doesn't build anything. - Vst; val_dsetel({call_ext,3,{extfunc,erlang,setelement,3}}, #vst{current=St}=Vst) -> Vst#vst{current=St#st{setelem=true}}; val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) -> @@ -972,7 +855,7 @@ call(Name, Live, #vst{current=St}=Vst) -> Type when Type =/= exception -> %% Type is never 'exception' because it has been handled earlier. Xs = gb_trees_from_list([{0,Type}]), - Vst#vst{current=St#st{x=Xs,f=init_fregs(),bsm=undefined}} + Vst#vst{current=St#st{x=Xs,f=init_fregs()}} end. %% Tail call. @@ -1030,7 +913,7 @@ allocate(_, _, _, _, #vst{current=#st{numy=Numy}}) -> error({existing_stack_frame,{size,Numy}}). deallocate(#vst{current=St}=Vst) -> - Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none,bsm=undefined}}. + Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none}}. test_heap(Heap, Live, Vst0) -> verify_live(Live, Vst0), @@ -1038,7 +921,7 @@ test_heap(Heap, Live, Vst0) -> heap_alloc(Heap, Vst). heap_alloc(Heap, #vst{current=St0}=Vst) -> - St1 = kill_heap_allocation(St0#st{bsm=undefined}), + St1 = kill_heap_allocation(St0), St = heap_alloc_1(Heap, St1), Vst#vst{current=St}. @@ -1122,74 +1005,30 @@ 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). -%% Single item lists may have registers. -assert_strict_literal_termorder([_]) -> ok; -assert_strict_literal_termorder(Ls) -> - Vs = lists:map(fun (L) -> get_literal(L) end, Ls), +%% A single item list may be either a list or a register. +%% +%% A list with more than item must contain literals in +%% ascending term order. +%% +%% An empty list is not allowed. + +assert_strict_literal_termorder([]) -> + %% There is no reason to use the get_map_elements and + %% has_map_fields instructions with empty lists. + error(empty_field_list); +assert_strict_literal_termorder([_]) -> + ok; +assert_strict_literal_termorder([_,_|_]=Ls) -> + Vs = [get_literal(L) || L <- Ls], case check_strict_value_termorder(Vs) of true -> ok; - false -> error({not_strict_order, Ls}) + false -> error(not_strict_order) 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. -%%% -%%% Possible values for the bsm field (=bit syntax matching state). -%%% -%%% undefined - Undefined (initial state). No matching instructions allowed. -%%% -%%% (gb set) - The gb set contains the defined save points. -%%% -%%% The bsm field is reset to 'undefined' by instructions that may cause a -%%% a garbage collection (might move the binary) and/or context switch -%%% (may invalidate the save points). - -bs_start_match(#vst{current=#st{bsm=undefined}=St}=Vst) -> - Vst#vst{current=St#st{bsm=gb_sets:empty()}}; -bs_start_match(Vst) -> - %% Must retain save points here - it is possible to restore back - %% to a previous binary. - Vst. - -bs_save(Reg, #vst{current=#st{bsm=Saved}=St}=Vst) - when is_integer(Reg), Reg < ?MAXREG -> - Vst#vst{current=St#st{bsm=gb_sets:add(Reg, Saved)}}; -bs_save(_, _) -> error(limit). - -bs_assert_savepoint(Reg, #vst{current=#st{bsm=Saved}}) -> - case gb_sets:is_member(Reg, Saved) of - false -> error({no_save_point,Reg}); - true -> ok - end. - -bs_assert_state(#vst{current=#st{bsm=undefined}}) -> - error(no_bs_match_state); -bs_assert_state(_) -> ok. - +check_strict_value_termorder([V1|[V2|_]=Vs]) -> + erts_internal:cmp_term(V1, V2) < 0 andalso + check_strict_value_termorder(Vs); +check_strict_value_termorder([_]) -> true. %%% %%% New binary matching instructions. @@ -1389,7 +1228,8 @@ assert_term(Src, Vst) -> %% %% number Integer or Float of unknown value %% - +%% map Map. +%% assert_type(WantedType, Term, Vst) -> assert_type(WantedType, get_term_type(Term, Vst)). @@ -1471,6 +1311,7 @@ get_term_type_1(nil=T, _) -> T; get_term_type_1({atom,A}=T, _) when is_atom(A) -> T; get_term_type_1({float,F}=T, _) when is_float(F) -> T; get_term_type_1({integer,I}=T, _) when is_integer(I) -> T; +get_term_type_1({literal,Map}, _) when is_map(Map) -> map; get_term_type_1({literal,_}=T, _) -> T; get_term_type_1({x,X}=Reg, #vst{current=#st{x=Xs}}) when is_integer(X) -> case gb_trees:lookup(X, Xs) of @@ -1525,14 +1366,13 @@ merge_states(L, St, Branched) when L =/= 0 -> {value,OtherSt} -> merge_states_1(St, OtherSt) end. -merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0,bsm=Bsm0}=St, - #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1,bsm=Bsm1}) -> +merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}=St, + #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1}) -> NumY = merge_stk(NumY0, NumY1), Xs = merge_regs(Xs0, Xs1), Ys = merge_y_regs(Ys0, Ys1), Ct = merge_ct(Ct0, Ct1), - Bsm = merge_bsm(Bsm0, Bsm1), - St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct,bsm=Bsm}. + St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. merge_stk(S, S) -> S; merge_stk(_, _) -> undecided. @@ -1615,10 +1455,6 @@ merge_types(T1, T2) when T1 =/= T2 -> %% Too different. All we know is that the type is a 'term'. term. -merge_bsm(undefined, _) -> undefined; -merge_bsm(_, undefined) -> undefined; -merge_bsm(Bsm0, Bsm1) -> gb_sets:intersection(Bsm0, Bsm1). - tuple_sz([Sz]) -> Sz; tuple_sz(Sz) -> Sz. @@ -1725,6 +1561,7 @@ bif_type(is_float, [_], _) -> bool; bif_type(is_function, [_], _) -> bool; bif_type(is_integer, [_], _) -> bool; bif_type(is_list, [_], _) -> bool; +bif_type(is_map, [_], _) -> bool; bif_type(is_number, [_], _) -> bool; bif_type(is_pid, [_], _) -> bool; bif_type(is_port, [_], _) -> bool; @@ -1754,6 +1591,7 @@ is_bif_safe(is_float, 1) -> true; is_bif_safe(is_function, 1) -> true; is_bif_safe(is_integer, 1) -> true; is_bif_safe(is_list, 1) -> true; +is_bif_safe(is_map, 1) -> true; is_bif_safe(is_number, 1) -> true; is_bif_safe(is_pid, 1) -> true; is_bif_safe(is_port, 1) -> true; @@ -1818,6 +1656,7 @@ return_type_math(erf, 1) -> {float,[]}; return_type_math(erfc, 1) -> {float,[]}; return_type_math(exp, 1) -> {float,[]}; return_type_math(log, 1) -> {float,[]}; +return_type_math(log2, 1) -> {float,[]}; return_type_math(log10, 1) -> {float,[]}; return_type_math(sqrt, 1) -> {float,[]}; return_type_math(atan2, 2) -> {float,[]}; @@ -1839,52 +1678,3 @@ error(Error) -> exit(Error). -else. error(Error) -> throw(Error). -endif. - - -%%% -%%% Rewrite disassembled code to the same format as we used internally -%%% to not have to worry later. -%%% - -normalize_disassembled_code(Fs) -> - Index = ndc_index(Fs, []), - ndc(Fs, Index, []). - -ndc_index([{function,Name,Arity,Entry,_Code}|Fs], Acc) -> - ndc_index(Fs, [{{Name,Arity},Entry}|Acc]); -ndc_index([], Acc) -> - gb_trees:from_orddict(lists:sort(Acc)). - -ndc([{function,Name,Arity,Entry,Code0}|Fs], D, Acc) -> - Code = ndc_1(Code0, D, []), - ndc(Fs, D, [{function,Name,Arity,Entry,Code}|Acc]); -ndc([], _, Acc) -> reverse(Acc). - -ndc_1([{call=Op,A,{_,F,A}}|Is], D, Acc) -> - ndc_1(Is, D, [{Op,A,{f,gb_trees:get({F,A}, D)}}|Acc]); -ndc_1([{call_only=Op,A,{_,F,A}}|Is], D, Acc) -> - ndc_1(Is, D, [{Op,A,{f,gb_trees:get({F,A}, D)}}|Acc]); -ndc_1([{call_last=Op,A,{_,F,A},Sz}|Is], D, Acc) -> - ndc_1(Is, D, [{Op,A,{f,gb_trees:get({F,A}, D)},Sz}|Acc]); -ndc_1([{arithbif,Op,F,Src,Dst}|Is], D, Acc) -> - ndc_1(Is, D, [{bif,Op,F,Src,Dst}|Acc]); -ndc_1([{arithfbif,Op,F,Src,Dst}|Is], D, Acc) -> - ndc_1(Is, D, [{bif,Op,F,Src,Dst}|Acc]); -ndc_1([{test,bs_start_match2=Op,F,[A1,Live,A3,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3],Dst}|Acc]); -ndc_1([{test,bs_get_binary2=Op,F,[A1,Live,A3,A4,A5,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3,A4,A5],Dst}|Acc]); -ndc_1([{test,bs_get_float2=Op,F,[A1,Live,A3,A4,A5,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3,A4,A5],Dst}|Acc]); -ndc_1([{test,bs_get_integer2=Op,F,[A1,Live,A3,A4,A5,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3,A4,A5],Dst}|Acc]); -ndc_1([{test,bs_get_utf8=Op,F,[A1,Live,A3,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3],Dst}|Acc]); -ndc_1([{test,bs_get_utf16=Op,F,[A1,Live,A3,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3],Dst}|Acc]); -ndc_1([{test,bs_get_utf32=Op,F,[A1,Live,A3,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3],Dst}|Acc]); -ndc_1([I|Is], D, Acc) -> - ndc_1(Is, D, [I|Acc]); -ndc_1([], _, Acc) -> - reverse(Acc). diff --git a/lib/compiler/src/beam_z.erl b/lib/compiler/src/beam_z.erl index c2a6ef604e..0c7bef9183 100644 --- a/lib/compiler/src/beam_z.erl +++ b/lib/compiler/src/beam_z.erl @@ -79,17 +79,9 @@ undo_rename({put_map,Fail,assoc,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]}}; + {test,has_map_fields,Fail,Src,{list,List}}; +undo_rename({get_map_elements,Fail,Src,{list,List}}) -> + {get_map_elements,Fail,Src,{list,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 7a2c3d70de..ea960abc1a 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -123,11 +123,14 @@ bitstr_flags/1, %% keep map exports here for now + c_map_pattern/1, + is_c_map/1, map_es/1, map_arg/1, update_c_map/3, c_map/1, is_c_map_empty/1, ann_c_map/2, ann_c_map/3, + ann_c_map_pattern/2, map_pair_op/1,map_pair_key/1,map_pair_val/1, update_c_map_pair/4, c_map_pair/2, @@ -135,7 +138,8 @@ ]). -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/0, c_map_pair/0, c_module/0, c_tuple/0, + c_let/0, c_literal/0, c_map/0, c_map_pair/0, + c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]). -include("core_parse.hrl"). @@ -252,7 +256,7 @@ %% @see c_primop/2 %% @see c_receive/1 %% @see c_seq/2 -%% @see c_try/3 +%% @see c_try/5 %% @see c_tuple/1 %% @see c_values/1 %% @see c_var/1 @@ -431,6 +435,8 @@ is_literal_term([H | T]) -> is_literal_term(T) when is_tuple(T) -> is_literal_term_list(tuple_to_list(T)); is_literal_term(B) when is_bitstring(B) -> true; +is_literal_term(M) when is_map(M) -> + is_literal_term_list(maps:to_list(M)); is_literal_term(_) -> false. @@ -1450,7 +1456,7 @@ is_proper_list(_) -> %% X4]</code>. %% %% @see c_cons/2 -%% @see c_nil/1 +%% @see c_nil/0 %% @see is_c_list/1 %% @see list_length/1 %% @see make_list/2 @@ -1481,7 +1487,7 @@ abstract_list([]) -> %% efficient.</p> %% %% @see c_cons/2 -%% @see c_nil/1 +%% @see c_nil/0 %% @see is_c_list/1 %% @see list_elements/1 @@ -1577,6 +1583,20 @@ ann_make_list(_, [], Node) -> %% --------------------------------------------------------------------- %% maps +%% @spec is_c_map(Node::cerl()) -> boolean() +%% +%% @doc Returns <code>true</code> if <code>Node</code> is an abstract +%% map constructor, otherwise <code>false</code>. + +-spec is_c_map(cerl()) -> boolean(). + +is_c_map(#c_map{}) -> + true; +is_c_map(#c_literal{val = V}) when is_map(V) -> + true; +is_c_map(_) -> + false. + -spec map_es(c_map()) -> [c_map_pair()]. map_es(#c_map{es = Es}) -> @@ -1590,7 +1610,17 @@ map_arg(#c_map{arg=M}) -> -spec c_map([c_map_pair()]) -> c_map(). c_map(Pairs) -> - #c_map{es=Pairs}. + ann_c_map([], Pairs). + +-spec c_map_pattern([c_map_pair()]) -> c_map(). + +c_map_pattern(Pairs) -> + #c_map{es=Pairs, is_pat=true}. + +-spec ann_c_map_pattern([term()], [c_map_pair()]) -> c_map(). + +ann_c_map_pattern(As, Pairs) -> + #c_map{anno=As, es=Pairs, is_pat=true}. -spec is_c_map_empty(c_map() | c_literal()) -> boolean(). @@ -1598,25 +1628,13 @@ is_c_map_empty(#c_map{ es=[] }) -> true; is_c_map_empty(#c_literal{val=M}) when is_map(M),map_size(M) =:= 0 -> true; is_c_map_empty(_) -> false. --spec ann_c_map([term()], [cerl()]) -> c_map() | c_literal(). +-spec ann_c_map([term()], [c_map_pair()]) -> c_map() | c_literal(). -ann_c_map(As,Es) -> +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) -> @@ -1644,14 +1662,14 @@ fold_map_pairs(As,[#c_map_pair{op=#c_literal{val=exact},key=Ck,val=Cv}=E|Es],M) 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 }. + end. -%-spec update_c_map(c_map() | c_literal(), [c_map_pair()]) -> c_map() | c_literal(). +-spec update_c_map(c_map(), cerl(), [cerl()]) -> c_map() | c_literal(). -update_c_map(Old,M,Es) -> - #c_map{arg=M, es = Es, anno = get_ann(Old)}. +update_c_map(#c_map{is_pat=true}=Old, M, Es) -> + Old#c_map{arg=M, es=Es}; +update_c_map(#c_map{is_pat=false}=Old, M, Es) -> + ann_c_map(get_ann(Old), M, Es). map_pair_key(#c_map_pair{key=K}) -> K. map_pair_val(#c_map_pair{val=V}) -> V. @@ -1974,7 +1992,7 @@ update_c_fname(Node, Atom, Arity) -> %% %% @see c_fname/2 %% @see c_var/1 -%% @see c_var_name/1 +%% @see var_name/1 -spec is_c_fname(cerl()) -> boolean(). @@ -3652,7 +3670,7 @@ c_try(Expr, Vs, Body, Evs, Handler) -> %% @spec ann_c_try(As::[term()], Expression::cerl(), %% Variables::[cerl()], Body::cerl(), %% EVars::[cerl()], Handler::cerl()) -> cerl() -%% @see c_try/3 +%% @see c_try/5 -spec ann_c_try([term()], cerl(), [cerl()], cerl(), [cerl()], cerl()) -> c_try(). @@ -3665,7 +3683,7 @@ ann_c_try(As, Expr, Vs, Body, Evs, Handler) -> %% @spec update_c_try(Old::cerl(), Expression::cerl(), %% Variables::[cerl()], Body::cerl(), %% EVars::[cerl()], Handler::cerl()) -> cerl() -%% @see c_try/3 +%% @see c_try/5 -spec update_c_try(c_try(), cerl(), [cerl()], cerl(), [cerl()], cerl()) -> c_try(). @@ -3680,7 +3698,7 @@ update_c_try(Node, Expr, Vs, Body, Evs, Handler) -> %% @doc Returns <code>true</code> if <code>Node</code> is an abstract %% try-expression, otherwise <code>false</code>. %% -%% @see c_try/3 +%% @see c_try/5 -spec is_c_try(cerl()) -> boolean(). @@ -3694,7 +3712,7 @@ is_c_try(_) -> %% %% @doc Returns the expression subtree of an abstract try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_arg(c_try()) -> cerl(). @@ -3707,7 +3725,7 @@ try_arg(Node) -> %% @doc Returns the list of success variable subtrees of an abstract %% try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_vars(c_try()) -> [cerl()]. @@ -3719,7 +3737,7 @@ try_vars(Node) -> %% %% @doc Returns the success body subtree of an abstract try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_body(c_try()) -> cerl(). @@ -3732,7 +3750,7 @@ try_body(Node) -> %% @doc Returns the list of exception variable subtrees of an abstract %% try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_evars(c_try()) -> [cerl()]. @@ -3745,7 +3763,7 @@ try_evars(Node) -> %% @doc Returns the exception body subtree of an abstract %% try-expression. %% -%% @see c_try/3 +%% @see c_try/5 -spec try_handler(c_try()) -> cerl(). @@ -3767,7 +3785,7 @@ try_handler(Node) -> %% @see update_c_catch/2 %% @see is_c_catch/1 %% @see catch_body/1 -%% @see c_try/3 +%% @see c_try/5 -spec c_catch(cerl()) -> c_catch(). diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl index 87bd47c08b..ef74c5b76f 100644 --- a/lib/compiler/src/cerl_clauses.erl +++ b/lib/compiler/src/cerl_clauses.erl @@ -354,29 +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; + 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_trees.erl b/lib/compiler/src/cerl_trees.erl index b93da8e97f..f1bf0e02e7 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -19,7 +19,7 @@ %% @doc Basic functions on Core Erlang abstract syntax trees. %% %% <p>Syntax trees are defined in the module <a -%% href=""><code>cerl</code></a>.</p> +%% href="cerl"><code>cerl</code></a>.</p> %% %% @type cerl() = cerl:cerl() diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index f347438509..c45c9a1a29 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1295,8 +1295,9 @@ encrypt({des3_cbc=Type,Key,IVec,BlockSize}, Bin0) -> list_to_binary([0,length(TypeString),TypeString,Bin]). random_bytes(N) -> - {A,B,C} = now(), - _ = random:seed(A, B, C), + _ = random:seed(erlang:time_offset(), + erlang:monotonic_time(), + erlang:unique_integer()), random_bytes_1(N, []). random_bytes_1(0, Acc) -> Acc; diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 8f68915f8e..2a40c1c379 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -56,6 +56,7 @@ rec_env, sys_core_dsetel, sys_core_fold, + sys_core_fold_lists, sys_core_inline, sys_pre_attributes, sys_pre_expand, @@ -68,5 +69,5 @@ {registered, []}, {applications, [kernel, stdlib]}, {env, []}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-6.0", + {runtime_dependencies, ["stdlib-2.0","kernel-3.0","hipe-3.10.3","erts-7.0", "crypto-3.3"]}]}. diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index 2792fd8fa5..66319dbd36 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -20,6 +20,12 @@ -module(core_lib). +-deprecated({get_anno,1,next_major_release}). +-deprecated({set_anno,2,next_major_release}). +-deprecated({is_literal,1,next_major_release}). +-deprecated({is_literal_list,1,next_major_release}). +-deprecated({literal_value,1,next_major_release}). + -export([get_anno/1,set_anno/2]). -export([is_literal/1,is_literal_list/1]). -export([literal_value/1]). @@ -33,59 +39,27 @@ %% -spec get_anno(cerl:cerl()) -> term(). -get_anno(C) -> element(2, C). +get_anno(C) -> cerl:get_ann(C). -spec set_anno(cerl:cerl(), term()) -> cerl:cerl(). -set_anno(C, A) -> setelement(2, C, A). +set_anno(C, A) -> cerl:set_ann(C, A). -spec is_literal(cerl:cerl()) -> boolean(). -is_literal(#c_literal{}) -> true; -is_literal(#c_cons{hd=H,tl=T}) -> - is_literal(H) andalso is_literal(T); -is_literal(#c_tuple{es=Es}) -> is_literal_list(Es); -is_literal(#c_binary{segments=Es}) -> is_lit_bin(Es); -is_literal(_) -> false. +is_literal(Cerl) -> + cerl:is_literal(cerl:fold_literal(Cerl)). -spec is_literal_list([cerl:cerl()]) -> boolean(). is_literal_list(Es) -> lists:all(fun is_literal/1, Es). -is_lit_bin(Es) -> - lists:all(fun (#c_bitstr{val=E,size=S}) -> - is_literal(E) andalso is_literal(S) - end, Es). - %% Return the value of LitExpr. -spec literal_value(cerl:c_literal() | cerl:c_binary() | cerl:c_map() | cerl:c_cons() | cerl:c_tuple()) -> term(). -literal_value(#c_literal{val=V}) -> V; -literal_value(#c_binary{segments=Es}) -> - list_to_binary([literal_value_bin(Bit) || Bit <- Es]); -literal_value(#c_cons{hd=H,tl=T}) -> - [literal_value(H)|literal_value(T)]; -literal_value(#c_tuple{es=Es}) -> - list_to_tuple(literal_value_list(Es)); -literal_value(#c_map{arg=Cm,es=Cmps}) -> - M = literal_value(Cm), - lists:foldl(fun(#c_map_pair{ key=Ck, val=Cv },Mi) -> - K = literal_value(Ck), - V = literal_value(Cv), - maps:put(K,V,Mi) - end, M, Cmps). - -literal_value_list(Vals) -> [literal_value(V) || V <- Vals]. - -literal_value_bin(#c_bitstr{val=Val,size=Sz,unit=U,type=T,flags=Fs}) -> - %% We will only handle literals constructed by make_literal/1. - %% Could be made more general in the future if the need arises. - 8 = literal_value(Sz), - 1 = literal_value(U), - integer = literal_value(T), - [unsigned,big] = literal_value(Fs), - literal_value(Val). +literal_value(Cerl) -> + cerl:concrete(cerl:fold_literal(Cerl)). %% Make a suitable values structure, expr or values, depending on Expr. -spec make_values([cerl:cerl()] | cerl:cerl()) -> cerl:cerl(). @@ -212,6 +186,8 @@ vu_pattern(V, #c_tuple{es=Es}, St) -> vu_pattern_list(V, Es, St); vu_pattern(V, #c_binary{segments=Ss}, St) -> vu_pat_seg_list(V, Ss, St); +vu_pattern(V, #c_map{es=Es}, St) -> + vu_map_pairs(V, Es, St); vu_pattern(V, #c_alias{var=Var,pat=P}, St0) -> case vu_pattern(V, Var, St0) of {true,_}=St1 -> St1; @@ -234,6 +210,18 @@ vu_pat_seg_list(V, Ss, St) -> end end, St, Ss). +vu_map_pairs(V, [#c_map_pair{key=Key,val=Pat}|T], St0) -> + case vu_expr(V, Key) of + true -> + {true,false}; + false -> + case vu_pattern(V, Pat, St0) of + {true,_}=St -> St; + St -> vu_map_pairs(V, T, St) + end + end; +vu_map_pairs(_, [], St) -> St. + -spec vu_var_list(cerl:var_name(), [cerl:c_var()]) -> boolean(). vu_var_list(V, Vs) -> diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index c0e2bdaba0..f62b2bb0ba 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -173,7 +173,7 @@ check_exports(Es, St) -> end. check_attrs(As, St) -> - case all(fun ({#c_literal{},V}) -> core_lib:is_literal(V); + case all(fun ({#c_literal{},#c_literal{}}) -> true; (_) -> false end, As) of true -> St; diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl index 4a00535360..7fd4a82e4e 100644 --- a/lib/compiler/src/core_parse.hrl +++ b/lib/compiler/src/core_parse.hrl @@ -72,7 +72,8 @@ -record(c_map, {anno=[], arg=#c_literal{val=#{}} :: cerl:c_var() | cerl:c_literal(), - es :: [cerl:c_map_pair()]}). + es :: [cerl:c_map_pair()], + is_pat=false :: boolean()}). -record(c_map_pair, {anno=[], op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'}, diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl index a66ad4235f..eeb9f5dba7 100644 --- a/lib/compiler/src/core_parse.yrl +++ b/lib/compiler/src/core_parse.yrl @@ -58,7 +58,8 @@ Terminals %% Separators -'(' ')' '{' '}' '[' ']' '|' ',' '->' '=' '/' '<' '>' ':' '-|' '#' '~' '::' +'(' ')' '{' '}' '[' ']' '|' ',' '->' '=' '/' '<' '>' ':' '-|' '#' +'~' '=>' ':=' %% Keywords (atoms are assumed to always be single-quoted). @@ -123,7 +124,7 @@ function_definition -> {'$1','$3'}. anno_fun -> '(' fun_expr '-|' annotation ')' : - core_lib:set_anno('$2', '$4'). + cerl:set_ann('$2', '$4'). anno_fun -> fun_expr : '$1'. %% Constant terms for annotations and attributes. @@ -162,7 +163,7 @@ tail_constant -> ',' constant tail_constant : ['$2'|'$3']. %% ( ( V -| <anno> ) = ( {a} -| <anno> ) -| <anno> ) anno_pattern -> '(' other_pattern '-|' annotation ')' : - core_lib:set_anno('$2', '$4'). + cerl:set_ann('$2', '$4'). anno_pattern -> other_pattern : '$1'. anno_pattern -> anno_variable : '$1'. @@ -182,23 +183,24 @@ atomic_pattern -> atomic_literal : '$1'. tuple_pattern -> '{' '}' : c_tuple([]). tuple_pattern -> '{' anno_patterns '}' : c_tuple('$2'). -map_pattern -> '~' '{' '}' '~' : #c_map{es=[]}. +map_pattern -> '~' '{' '}' '~' : c_map_pattern([]). map_pattern -> '~' '{' map_pair_patterns '}' '~' : - #c_map{es=lists:sort('$3')}. + c_map_pattern(lists:sort('$3')). map_pair_patterns -> map_pair_pattern : ['$1']. map_pair_patterns -> map_pair_pattern ',' map_pair_patterns : ['$1' | '$3']. -map_pair_pattern -> '~' '<' anno_pattern ',' anno_pattern '>' : - #c_map_pair{op=#c_literal{val=exact},key='$3',val='$5'}. +map_pair_pattern -> anno_expression ':=' anno_pattern : + #c_map_pair{op=#c_literal{val=exact}, + key='$1',val='$3'}. cons_pattern -> '[' anno_pattern tail_pattern : - #c_cons{hd='$2',tl='$3'}. + c_cons('$2', '$3'). tail_pattern -> ']' : #c_literal{val=[]}. tail_pattern -> '|' anno_pattern ']' : '$2'. tail_pattern -> ',' anno_pattern tail_pattern : - #c_cons{hd='$2',tl='$3'}. + c_cons('$2', '$3'). binary_pattern -> '#' '{' '}' '#' : #c_binary{segments=[]}. binary_pattern -> '#' '{' segment_patterns '}' '#' : #c_binary{segments='$3'}. @@ -206,7 +208,7 @@ binary_pattern -> '#' '{' segment_patterns '}' '#' : #c_binary{segments='$3'}. segment_patterns -> segment_pattern ',' segment_patterns : ['$1' | '$3']. segment_patterns -> segment_pattern : ['$1']. -segment_pattern -> '#' '<' anno_pattern '>' '(' anno_patterns ')': +segment_pattern -> '#' '<' anno_pattern '>' '(' anno_expressions ')': case '$6' of [S,U,T,Fs] -> #c_bitstr{val='$3',size=S,unit=U,type=T,flags=Fs}; @@ -222,7 +224,7 @@ anno_variables -> anno_variable : ['$1']. anno_variable -> variable : '$1'. anno_variable -> '(' variable '-|' annotation ')' : - core_lib:set_anno('$2', '$4'). + cerl:set_ann('$2', '$4'). %% Expressions %% Must split expressions into two levels as nested value expressions @@ -230,7 +232,7 @@ anno_variable -> '(' variable '-|' annotation ')' : anno_expression -> expression : '$1'. anno_expression -> '(' expression '-|' annotation ')' : - core_lib:set_anno('$2', '$4'). + cerl:set_ann('$2', '$4'). anno_expressions -> anno_expression ',' anno_expressions : ['$1' | '$3']. anno_expressions -> anno_expression : ['$1']. @@ -279,15 +281,15 @@ cons_literal -> '[' literal tail_literal : c_cons('$2', '$3'). tail_literal -> ']' : #c_literal{val=[]}. tail_literal -> '|' literal ']' : '$2'. -tail_literal -> ',' literal tail_literal : #c_cons{hd='$2',tl='$3'}. +tail_literal -> ',' literal tail_literal : c_cons('$2', '$3'). tuple -> '{' '}' : c_tuple([]). tuple -> '{' anno_expressions '}' : c_tuple('$2'). -map_expr -> '~' '{' '}' '~' : #c_map{es=[]}. -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_expr -> '~' '{' '}' '~' : c_map([]). +map_expr -> '~' '{' map_pairs '}' '~' : c_map('$3'). +map_expr -> '~' '{' map_pairs '|' variable '}' '~' : ann_c_map([], '$5', '$3'). +map_expr -> '~' '{' map_pairs '|' map_expr '}' '~' : ann_c_map([], '$5', '$3'). map_pairs -> map_pair : ['$1']. map_pairs -> map_pair ',' map_pairs : ['$1' | '$3']. @@ -295,10 +297,10 @@ map_pairs -> map_pair ',' map_pairs : ['$1' | '$3']. map_pair -> map_pair_assoc : '$1'. map_pair -> map_pair_exact : '$1'. -map_pair_assoc -> '::' '<' anno_expression ',' anno_expression'>' : - #c_map_pair{op=#c_literal{val=assoc},key='$3',val='$5'}. -map_pair_exact -> '~' '<' anno_expression ',' anno_expression'>' : - #c_map_pair{op=#c_literal{val=exact},key='$3',val='$5'}. +map_pair_assoc -> anno_expression '=>' anno_expression : + #c_map_pair{op=#c_literal{val=assoc},key='$1',val='$3'}. +map_pair_exact -> anno_expression ':=' anno_expression : + #c_map_pair{op=#c_literal{val=exact},key='$1',val='$3'}. cons -> '[' anno_expression tail : c_cons('$2', '$3'). @@ -307,7 +309,7 @@ tail -> '|' anno_expression ']' : '$2'. tail -> ',' anno_expression tail : c_cons('$2', '$3'). binary -> '#' '{' '}' '#' : #c_literal{val = <<>>}. -binary -> '#' '{' segments '}' '#' : #c_binary{segments='$3'}. +binary -> '#' '{' segments '}' '#' : make_binary('$3'). segments -> segment ',' segments : ['$1' | '$3']. segments -> segment : ['$1']. @@ -326,7 +328,7 @@ function_name -> atom '/' integer : anno_function_name -> function_name : '$1'. anno_function_name -> '(' function_name '-|' annotation ')' : - core_lib:set_anno('$2', '$4'). + cerl:set_ann('$2', '$4'). let_vars -> anno_variable : ['$1']. let_vars -> '<' '>' : []. @@ -354,7 +356,7 @@ anno_clauses -> anno_clause : ['$1']. anno_clause -> clause : '$1'. anno_clause -> '(' clause '-|' annotation ')' : - core_lib:set_anno('$2', '$4'). + cerl:set_ann('$2', '$4'). clause -> clause_pattern 'when' anno_expression '->' anno_expression : #c_clause{pats='$1',guard='$3',body='$5'}. @@ -410,9 +412,55 @@ Erlang code. -include("core_parse.hrl"). --import(cerl, [c_cons/2,c_tuple/1]). +-import(cerl, [ann_c_map/3,c_cons/2,c_map/1,c_map_pattern/1,c_tuple/1]). tok_val(T) -> element(3, T). tok_line(T) -> element(2, T). +%% make_binary([#c_bitstr{}]) -> #c_binary{} | #c_literal{} +%% Create either #c_binary{} or #c_literal{} from the binary segments. +%% In certain contexts, such as keys for maps, only literals and +%% variables are allowed, so we must not create a #c_binary{} +%% record in those situation. +%% +%% To keep this function simple, we use a crude heuristic. We will +%% assume that Core Erlang has been produced by core_pp. If the +%% segments *could* have been output from a literal binary by +%% core_pp, we will create a #c_literal{}. Otherwise we will create a +%% #c_binary{} record. + +make_binary(Segs) -> + try make_lit_bin(<<>>, Segs) of + Bs when is_bitstring(Bs) -> + #c_literal{val=Bs} + catch + throw:impossible -> + #c_binary{segments=Segs} + end. + +make_lit_bin(Acc, [#c_bitstr{val=I0,size=Sz0,unit=U0,type=Type0,flags=F0}|T]) -> + I = get_lit_val(I0), + Sz = get_lit_val(Sz0), + U = get_lit_val(U0), + Type = get_lit_val(Type0), + F = get_lit_val(F0), + if + is_integer(I), U =:= 1, Type =:= integer, F =:= [unsigned,big] -> + ok; + true -> + throw(impossible) + end, + if + Sz =< 8, T =:= [] -> + <<Acc/binary,I:Sz>>; + Sz =:= 8 -> + make_lit_bin(<<Acc/binary,I:8>>, T); + true -> + throw(impossible) + end; +make_lit_bin(Acc, []) -> Acc. + +get_lit_val(#c_literal{val=Val}) -> Val; +get_lit_val(_) -> throw(impossible). + %% vim: syntax=erlang diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index 03801a9b6d..9cfca88e8c 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -45,7 +45,7 @@ format(Node) -> format(Node, #ctxt{}). maybe_anno(Node, Fun, Ctxt) -> - As = core_lib:get_anno(Node), + As = cerl:get_ann(Node), case get_line(As) of none -> maybe_anno(Node, Fun, Ctxt, As); @@ -183,15 +183,9 @@ format_1(#c_map{arg=Var,es=Es}, Ctxt) -> "}~" ]; format_1(#c_map_pair{op=#c_literal{val=assoc},key=K,val=V}, Ctxt) -> - ["::<", - format_hseq([K,V], ",", add_indent(Ctxt, 1), fun format/2), - ">" - ]; + format_map_pair("=>", K, V, Ctxt); format_1(#c_map_pair{op=#c_literal{val=exact},key=K,val=V}, Ctxt) -> - ["~<", - format_hseq([K,V], ",", add_indent(Ctxt, 1), fun format/2), - ">" - ]; + format_map_pair(":=", K, V, Ctxt); format_1(#c_cons{hd=H,tl=T}, Ctxt) -> Txt = ["["|format(H, add_indent(Ctxt, 1))], [Txt|format_list_tail(T, add_indent(Ctxt, width(Txt, Ctxt)))]; @@ -201,7 +195,7 @@ format_1(#c_alias{var=V,pat=P}, Ctxt) -> Txt = [format(V, Ctxt)|" = "], [Txt|format(P, add_indent(Ctxt, width(Txt, Ctxt)))]; format_1(#c_let{vars=Vs0,arg=A,body=B}, Ctxt) -> - Vs = [core_lib:set_anno(V, []) || V <- Vs0], + Vs = [cerl:set_ann(V, []) || V <- Vs0], case is_simple_term(A) of false -> Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent), @@ -219,7 +213,7 @@ format_1(#c_let{vars=Vs0,arg=A,body=B}, Ctxt) -> ["let ", format_values(Vs, add_indent(Ctxt, 4)), " = ", - format(core_lib:set_anno(A, []), Ctxt1), + format(cerl:set_ann(A, []), Ctxt1), nl_indent(Ctxt), "in " | format(B, add_indent(Ctxt, 4)) @@ -448,6 +442,12 @@ format_list_tail(#c_cons{anno=[],hd=H,tl=T}, Ctxt) -> format_list_tail(Tail, Ctxt) -> ["|",format(Tail, add_indent(Ctxt, 1)),"]"]. +format_map_pair(Op, K, V, Ctxt0) -> + Ctxt1 = add_indent(Ctxt0, 1), + Txt = format(K, set_class(Ctxt1, expr)), + Ctxt2 = add_indent(Ctxt0, width(Txt, Ctxt1)), + [Txt,Op,format(V, Ctxt2)]. + indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt). indent(N, _) when N =< 0 -> ""; diff --git a/lib/compiler/src/core_scan.erl b/lib/compiler/src/core_scan.erl index b7799b373a..8ab20b1982 100644 --- a/lib/compiler/src/core_scan.erl +++ b/lib/compiler/src/core_scan.erl @@ -271,8 +271,10 @@ scan1("->" ++ Cs, Toks, Pos) -> scan1(Cs, [{'->',Pos}|Toks], Pos); scan1("-|" ++ Cs, Toks, Pos) -> scan1(Cs, [{'-|',Pos}|Toks], Pos); -scan1("::" ++ Cs, Toks, Pos) -> - scan1(Cs, [{'::',Pos}|Toks], Pos); +scan1(":=" ++ Cs, Toks, Pos) -> + scan1(Cs, [{':=',Pos}|Toks], Pos); +scan1("=>" ++ Cs, Toks, Pos) -> + scan1(Cs, [{'=>',Pos}|Toks], Pos); scan1([C|Cs], Toks, Pos) -> %Punctuation character P = list_to_atom([C]), scan1(Cs, [{P,Pos}|Toks], Pos); diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 6c75538194..bcc2297250 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -134,6 +134,7 @@ is_pure(math, erf, 1) -> true; is_pure(math, erfc, 1) -> true; is_pure(math, exp, 1) -> true; is_pure(math, log, 1) -> true; +is_pure(math, log2, 1) -> true; is_pure(math, log10, 1) -> true; is_pure(math, pow, 2) -> true; is_pure(math, sin, 1) -> true; diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 09716d0866..0d020578f5 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -96,6 +96,10 @@ t=[], %Types in_guard=false}). %In guard or not. +-type type_info() :: cerl:cerl() | 'bool' | 'integer'. +-type yes_no_maybe() :: 'yes' | 'no' | 'maybe'. +-type sub() :: #sub{}. + -spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module(), [_]}. @@ -293,7 +297,8 @@ expr(#c_seq{arg=Arg0,body=B0}=Seq0, Ctxt, Sub) -> false -> Seq0#c_seq{arg=Arg,body=B1} end end; -expr(#c_let{}=Let, Ctxt, Sub) -> +expr(#c_let{}=Let0, Ctxt, Sub) -> + Let = opt_case_in_let(Let0), case simplify_let(Let, Sub) of impossible -> %% The argument for the let is "simple", i.e. has no @@ -313,7 +318,7 @@ expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) -> Fs1 = map(fun ({Name,Fb}) -> {Name,expr(Fb, {letrec,Ctxt}, Sub)} end, Fs0), - B1 = body(B0, value, Sub), + B1 = body(B0, Ctxt, Sub), Letrec#c_letrec{defs=Fs1,body=B1}; expr(#c_case{}=Case0, Ctxt, Sub) -> %% Ideally, the compiler should only emit warnings when there is @@ -462,10 +467,7 @@ is_safe_simple(#c_call{module=#c_literal{val=erlang}, case erl_internal:bool_op(Name, NumArgs) of true -> %% Boolean operators are safe if the arguments are boolean. - all(fun(#c_var{name=V}) -> is_boolean_type(V, Sub); - (#c_literal{val=Lit}) -> is_boolean(Lit); - (_) -> false - end, Args); + all(fun(C) -> is_boolean_type(C, Sub) =:= yes end, Args); false -> %% We need a rather complicated test to ensure that %% we only allow safe calls that are allowed in a guard. @@ -607,14 +609,6 @@ 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). @@ -688,23 +682,15 @@ count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64). %% a rewritten expression consisting of a sequence of %% the arguments only is returned. -useless_call(effect, #c_call{anno=Anno, - module=#c_literal{val=Mod}, +useless_call(effect, #c_call{module=#c_literal{val=Mod}, name=#c_literal{val=Name}, args=Args}=Call) -> A = length(Args), case erl_bifs:is_safe(Mod, Name, A) of false -> case erl_bifs:is_pure(Mod, Name, A) of - true -> - case member(result_not_wanted, Anno) of - false -> - add_warning(Call, result_ignored); - true -> - ok - end; - false -> - ok + true -> add_warning(Call, result_ignored); + false -> ok end, no; true -> @@ -730,385 +716,23 @@ make_effect_seq([], _) -> void(). call(#c_call{args=As}=Call, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) -> case get(no_inline_list_funcs) of true -> - call_0(Call, M0, N0, As, Sub); + call_1(Call, M0, N0, As, Sub); false -> - call_1(Call, M, N, As, Sub) + case sys_core_fold_lists:call(Call, M, N, As) of + none -> + call_1(Call, M, N, As, Sub); + Core -> + expr(Core, Sub) + end + end; call(#c_call{args=As}=Call, M, N, Sub) -> - call_0(Call, M, N, As, Sub). + call_1(Call, M, N, As, Sub). -call_0(Call, M, N, As0, Sub) -> +call_1(Call, M, N, As0, Sub) -> As1 = expr_list(As0, value, Sub), fold_call(Call#c_call{args=As1}, M, N, As1, Sub). -%% We inline some very common higher order list operations. -%% We use the same evaluation order as the library function. - -call_1(#c_call{anno=Anno}, lists, all, [Arg1,Arg2], Sub) -> - Loop = #c_var{name={'lists^all',1}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, - CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, - body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, - CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, - body=#c_literal{val=false}}, - CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=match_fail(Anno, Err1)}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, - clauses = [CC1, CC2, CC3]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=1}]}, - body=#c_literal{val=true}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)}, - Fun = #c_fun{vars=[Xs], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, any, [Arg1,Arg2], Sub) -> - Loop = #c_var{name={'lists^any',1}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, - CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, - body=#c_literal{val=true}}, - CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, - body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, - CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=match_fail(Anno, Err1)}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, - clauses = [CC1, CC2, CC3]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=1}]}, - body=#c_literal{val=false}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^any',1}}|Anno], Err2)}, - Fun = #c_fun{vars=[Xs], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2], Sub) -> - Loop = #c_var{name={'lists^foreach',1}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]}, - body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=1}]}, - body=#c_literal{val=ok}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, map, [Arg1,Arg2], Sub) -> - Loop = #c_var{name={'lists^map',1}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - H = #c_var{name='H'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_let{vars=[H], arg=#c_apply{anno=Anno, - op=F, - args=[X]}, - body=#c_cons{hd=H, - anno=[compiler_generated], - tl=#c_apply{anno=Anno, - op=Loop, - args=[Xs]}}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=1}]}, - body=#c_literal{val=[]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^map',1}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2], Sub) -> - Loop = #c_var{name={'lists^flatmap',1}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - H = #c_var{name='H'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_let{vars=[H], - arg=#c_apply{anno=Anno, op=F, args=[X]}, - body=#c_call{anno=[compiler_generated|Anno], - module=#c_literal{val=erlang}, - name=#c_literal{val='++'}, - args=[H, - #c_apply{anno=Anno, - op=Loop, - args=[Xs]}]}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=1}]}, - body=#c_literal{val=[]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2], Sub) -> - Loop = #c_var{name={'lists^filter',1}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - B = #c_var{name='B'}, - Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, - CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, - body=#c_cons{anno=[compiler_generated], hd=X, tl=Xs}}, - CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, - body=Xs}, - CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=match_fail(Anno, Err1)}, - Case = #c_case{arg=B, clauses = [CC1, CC2, CC3]}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_let{vars=[B], - arg=#c_apply{anno=Anno, op=F, args=[X]}, - body=#c_let{vars=[Xs], - arg=#c_apply{anno=Anno, - op=Loop, - args=[Xs]}, - body=Case}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=1}]}, - body=#c_literal{val=[]}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)}, - Fun = #c_fun{vars=[Xs], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3], Sub) -> - Loop = #c_var{name={'lists^foldl',2}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - A = #c_var{name='A'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_apply{anno=Anno, - op=Loop, - args=[Xs, #c_apply{anno=Anno, - op=F, - args=[X, A]}]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=2}]}, - body=A}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs, A], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3], Sub) -> - Loop = #c_var{name={'lists^foldr',2}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - A = #c_var{name='A'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_apply{anno=Anno, - op=F, - args=[X, #c_apply{anno=Anno, - op=Loop, - args=[Xs, A]}]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=2}]}, - body=A}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs, A], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) -> - Loop = #c_var{name={'lists^mapfoldl',2}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - Avar = #c_var{name='A'}, - Match = - fun (A, P, E) -> - C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, - Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, - C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=match_fail(Anno, Err)}, - #c_case{arg=A, clauses=[C1, C2]} - end, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, - #c_tuple{es=[X, Avar]}, -%%% Tuple passing version - Match(#c_apply{anno=Anno, - op=Loop, - args=[Xs, Avar]}, - #c_tuple{es=[Xs, Avar]}, - #c_tuple{anno=[compiler_generated], - es=[#c_cons{anno=[compiler_generated], - hd=X, tl=Xs}, - Avar]}) -%%% Multiple-value version -%%% #c_let{vars=[Xs,A], -%%% %% The tuple here will be optimised -%%% %% away later; no worries. -%%% arg=#c_apply{op=Loop, args=[Xs, A]}, -%%% body=#c_values{es=[#c_cons{hd=X, tl=Xs}, -%%% A]}} - )}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=2}]}, -%%% Tuple passing version - body=#c_tuple{anno=[compiler_generated], - es=[#c_literal{val=[]}, Avar]}}, -%%% Multiple-value version -%%% body=#c_values{es=[#c_literal{val=[]}, A]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs, Avar], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, - body=#c_letrec{defs=[{Loop,Fun}], -%%% Tuple passing version - body=#c_apply{anno=Anno, - op=Loop, - args=[L, Avar]}}}, -%%% Multiple-value version -%%% body=#c_let{vars=[Xs, A], -%%% arg=#c_apply{op=Loop, -%%% args=[L, A]}, -%%% body=#c_tuple{es=[Xs, A]}}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) -> - Loop = #c_var{name={'lists^mapfoldr',2}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - Avar = #c_var{name='A'}, - Match = - fun (A, P, E) -> - C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, - Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, - C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=match_fail(Anno, Err)}, - #c_case{arg=A, clauses=[C1, C2]} - end, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, -%%% Tuple passing version - body=Match(#c_apply{anno=Anno, - op=Loop, - args=[Xs, Avar]}, - #c_tuple{es=[Xs, Avar]}, - Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, - #c_tuple{es=[X, Avar]}, - #c_tuple{anno=[compiler_generated], - es=[#c_cons{anno=[compiler_generated], - hd=X, tl=Xs}, Avar]})) -%%% Multiple-value version -%%% body=#c_let{vars=[Xs,A], -%%% %% The tuple will be optimised away -%%% arg=#c_apply{op=Loop, args=[Xs, A]}, -%%% body=Match(#c_apply{op=F, args=[X, A]}, -%%% #c_tuple{es=[X, A]}, -%%% #c_values{es=[#c_cons{hd=X, tl=Xs}, -%%% A]})} - }, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=2}]}, -%%% Tuple passing version - body=#c_tuple{anno=[compiler_generated], - es=[#c_literal{val=[]}, Avar]}}, -%%% Multiple-value version -%%% body=#c_values{es=[#c_literal{val=[]}, A]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs, Avar], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, - body=#c_letrec{defs=[{Loop,Fun}], -%%% Tuple passing version - body=#c_apply{anno=Anno, - op=Loop, - args=[L, Avar]}}}, -%%% Multiple-value version -%%% body=#c_let{vars=[Xs, A], -%%% arg=#c_apply{op=Loop, -%%% args=[L, A]}, -%%% body=#c_tuple{es=[Xs, A]}}}}, - Sub); -call_1(#c_call{module=M, name=N}=Call, _, _, As, Sub) -> - call_0(Call, M, N, As, Sub). - -match_fail(Anno, Arg) -> - #c_primop{anno=Anno, - name=#c_literal{val='match_fail'}, - args=[Arg]}. - %% fold_call(Call, Mod, Name, Args, Sub) -> Expr. %% Try to safely evaluate the call. Just try to evaluate arguments, %% do the call and convert return values to literals. If this @@ -1133,29 +757,33 @@ fold_call_1(Call, Mod, Name, Args, Sub) -> true -> fold_call_2(Call, Mod, Name, Args, Sub) end. -fold_call_2(Call, Module, Name, Args0, Sub) -> - try - Args = [core_lib:literal_value(A) || A <- Args0], - try apply(Module, Name, Args) of - Val -> - case cerl:is_literal_term(Val) of - true -> - #c_literal{val=Val}; - false -> - %% Successful evaluation, but it was not - %% possible to express the computed value as a literal. - Call - end - catch - error:Reason -> - %% Evaluation of the function failed. Warn and replace - %% the call with a call to erlang:error/1. - eval_failure(Call, Reason) - end +fold_call_2(Call, Module, Name, Args, Sub) -> + case all(fun cerl:is_literal/1, Args) of + true -> + %% All arguments are literals. + fold_lit_args(Call, Module, Name, Args); + false -> + %% At least one non-literal argument. + fold_non_lit_args(Call, Module, Name, Args, Sub) + end. + +fold_lit_args(Call, Module, Name, Args0) -> + Args = [cerl:concrete(A) || A <- Args0], + try apply(Module, Name, Args) of + Val -> + case cerl:is_literal_term(Val) of + true -> + cerl:abstract(Val); + false -> + %% Successful evaluation, but it was not possible + %% to express the computed value as a literal. + Call + end catch - error:_ -> - %% There was at least one non-literal argument. - fold_non_lit_args(Call, Module, Name, Args0, Sub) + error:Reason -> + %% Evaluation of the function failed. Warn and replace + %% the call with a call to erlang:error/1. + eval_failure(Call, Reason) end. %% fold_non_lit_args(Call, Module, Name, Args, Sub) -> Expr. @@ -1194,41 +822,53 @@ fold_non_lit_args(Call, _, _, _, _) -> Call. %% Evaluate a relational operation using type information. eval_rel_op(Call, Op, [#c_var{name=V},#c_var{name=V}], _) -> Bool = erlang:Op(same, same), - #c_literal{anno=core_lib:get_anno(Call),val=Bool}; -eval_rel_op(Call, '=:=', [#c_var{name=V}=Var,#c_literal{val=true}], Sub) -> + #c_literal{anno=cerl:get_ann(Call),val=Bool}; +eval_rel_op(Call, '=:=', [Term,#c_literal{val=true}], Sub) -> %% BoolVar =:= true ==> BoolVar - case is_boolean_type(V, Sub) of - true -> Var; - false -> Call + case is_boolean_type(Term, Sub) of + yes -> Term; + maybe -> Call; + no -> #c_literal{val=false} end; -eval_rel_op(Call, '==', Ops, _Sub) -> - case is_exact_eq_ok(Ops) of +eval_rel_op(Call, '==', Ops, Sub) -> + case is_exact_eq_ok(Ops, Sub) of true -> - Name = #c_literal{anno=core_lib:get_anno(Call),val='=:='}, + Name = #c_literal{anno=cerl:get_ann(Call),val='=:='}, Call#c_call{name=Name}; false -> Call end; -eval_rel_op(Call, '/=', Ops, _Sub) -> - case is_exact_eq_ok(Ops) of +eval_rel_op(Call, '/=', Ops, Sub) -> + case is_exact_eq_ok(Ops, Sub) of true -> - Name = #c_literal{anno=core_lib:get_anno(Call),val='=/='}, + Name = #c_literal{anno=cerl:get_ann(Call),val='=/='}, Call#c_call{name=Name}; false -> Call end; eval_rel_op(Call, _, _, _) -> Call. -is_exact_eq_ok([#c_literal{val=Lit}|_]) -> +is_exact_eq_ok([A,B]=L, Sub) -> + case is_int_type(A, Sub) =:= yes andalso is_int_type(B, Sub) =:= yes of + true -> true; + false -> is_exact_eq_ok_1(L) + end. + +is_exact_eq_ok_1([#c_literal{val=Lit}|_]) -> is_non_numeric(Lit); -is_exact_eq_ok([_|T]) -> - is_exact_eq_ok(T); -is_exact_eq_ok([]) -> false. +is_exact_eq_ok_1([_|T]) -> + is_exact_eq_ok_1(T); +is_exact_eq_ok_1([]) -> false. is_non_numeric([H|T]) -> is_non_numeric(H) andalso is_non_numeric(T); is_non_numeric(Tuple) when is_tuple(Tuple) -> is_non_numeric_tuple(Tuple, tuple_size(Tuple)); +is_non_numeric(Map) when is_map(Map) -> + %% Note that 17.x and 18.x compare keys in different ways. + %% Be very conservative -- require that both keys and values + %% are non-numeric. + is_non_numeric(maps:to_list(Map)); is_non_numeric(Num) when is_number(Num) -> false; is_non_numeric(_) -> true. @@ -1242,40 +882,31 @@ is_non_numeric_tuple(_Tuple, 0) -> true. %% there must be at least one non-literal argument (i.e. %% there is no need to handle the case that all argments %% are literal). -eval_bool_op(Call, 'and', [#c_literal{val=true},#c_var{name=V}=Res], Sub) -> - case is_boolean_type(V, Sub) of - true -> Res; - false-> Call - end; -eval_bool_op(Call, 'and', [#c_var{name=V}=Res,#c_literal{val=true}], Sub) -> - case is_boolean_type(V, Sub) of - true -> Res; - false-> Call - end; -eval_bool_op(Call, 'and', [#c_literal{val=false}=Res,#c_var{name=V}], Sub) -> - case is_boolean_type(V, Sub) of - true -> Res; - false-> Call - end; -eval_bool_op(Call, 'and', [#c_var{name=V},#c_literal{val=false}=Res], Sub) -> - case is_boolean_type(V, Sub) of - true -> Res; - false-> Call - end; + +eval_bool_op(Call, 'and', [#c_literal{val=true},Term], Sub) -> + eval_bool_op_1(Call, Term, Term, Sub); +eval_bool_op(Call, 'and', [Term,#c_literal{val=true}], Sub) -> + eval_bool_op_1(Call, Term, Term, Sub); +eval_bool_op(Call, 'and', [#c_literal{val=false}=Res,Term], Sub) -> + eval_bool_op_1(Call, Res, Term, Sub); +eval_bool_op(Call, 'and', [Term,#c_literal{val=false}=Res], Sub) -> + eval_bool_op_1(Call, Res, Term, Sub); eval_bool_op(Call, _, _, _) -> Call. +eval_bool_op_1(Call, Res, Term, Sub) -> + case is_boolean_type(Term, Sub) of + yes -> Res; + no -> eval_failure(Call, badarg); + maybe -> Call + end. + %% Evaluate is_boolean/1 using type information. -eval_is_boolean(Call, #c_var{name=V}, Sub) -> - case is_boolean_type(V, Sub) of - true -> #c_literal{val=true}; - false -> Call - end; -eval_is_boolean(_, #c_cons{}, _) -> - #c_literal{val=false}; -eval_is_boolean(_, #c_tuple{}, _) -> - #c_literal{val=false}; -eval_is_boolean(Call, _, _) -> - Call. +eval_is_boolean(Call, Term, Sub) -> + case is_boolean_type(Term, Sub) of + no -> #c_literal{val=false}; + yes -> #c_literal{val=true}; + maybe -> Call + end. %% eval_length(Call, List) -> Val. %% Evaluates the length for the prefix of List which has a known @@ -1325,33 +956,33 @@ eval_append(Call, X, Y) -> %% Evaluates element/2 if the position Pos is a literal and %% the shape of the tuple Tuple is known. %% -eval_element(Call, #c_literal{val=Pos}, #c_tuple{es=Es}, _Types) when is_integer(Pos) -> - if - 1 =< Pos, Pos =< length(Es) -> - lists:nth(Pos, Es); - true -> - eval_failure(Call, badarg) - end; -eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types) +eval_element(Call, #c_literal{val=Pos}, Tuple, Types) when is_integer(Pos) -> - case orddict:find(V, Types#sub.t) of - {ok,#c_tuple{es=Elements}} -> + case get_type(Tuple, Types) of + none -> + Call; + Type -> + Es = case cerl:is_c_tuple(Type) of + false -> []; + true -> cerl:tuple_es(Type) + end, if - 1 =< Pos, Pos =< length(Elements) -> - case lists:nth(Pos, Elements) of - #c_alias{var=Alias} -> Alias; - Res -> Res + 1 =< Pos, Pos =< length(Es) -> + El = lists:nth(Pos, Es), + try + cerl:set_ann(pat_to_expr(El), [compiler_generated]) + catch + throw:impossible -> + Call end; true -> + %% Index outside tuple or not a tuple. eval_failure(Call, badarg) - end; - {ok,_} -> - eval_failure(Call, badarg); - error -> - Call + end end; -eval_element(Call, Pos, Tuple, _Types) -> - case is_not_integer(Pos) orelse is_not_tuple(Tuple) of +eval_element(Call, Pos, Tuple, Sub) -> + case is_int_type(Pos, Sub) =:= no orelse + is_tuple_type(Tuple, Sub) =:= no of true -> eval_failure(Call, badarg); false -> @@ -1361,58 +992,55 @@ eval_element(Call, Pos, Tuple, _Types) -> %% eval_is_record(Call, Var, Tag, Size, Types) -> Val. %% Evaluates is_record/3 using type information. %% -eval_is_record(Call, #c_var{name=V}, #c_literal{val=NeededTag}=Lit, +eval_is_record(Call, Term, #c_literal{val=NeededTag}, #c_literal{val=Size}, Types) -> - case orddict:find(V, Types#sub.t) of - {ok,#c_tuple{es=[#c_literal{val=Tag}|_]=Es}} -> - Lit#c_literal{val=Tag =:= NeededTag andalso - length(Es) =:= Size}; - _ -> - Call + case get_type(Term, Types) of + none -> + Call; + Type -> + Es = case cerl:is_c_tuple(Type) of + false -> []; + true -> cerl:tuple_es(Type) + end, + case Es of + [#c_literal{val=Tag}|_] -> + Bool = Tag =:= NeededTag andalso + length(Es) =:= Size, + #c_literal{val=Bool}; + _ -> + #c_literal{val=false} + end end; eval_is_record(Call, _, _, _, _) -> Call. -%% is_not_integer(Core) -> true | false. -%% Returns true if Core is definitely not an integer. - -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. -%% Returns true if Core is definitely not a tuple. - -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. %% Evaluates setelement/3 if position Pos is an integer -%% the shape of the tuple Tuple is known. +%% and the shape of the tuple Tuple is known. %% -eval_setelement(Call, Pos, Tuple, NewVal) -> - try - eval_setelement_1(Pos, Tuple, NewVal) - catch - error:_ -> - Call - end. - -eval_setelement_1(#c_literal{val=Pos}, #c_tuple{anno=A,es=Es}, NewVal) +eval_setelement(Call, #c_literal{val=Pos}, Tuple, NewVal) when is_integer(Pos) -> - ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal)); -eval_setelement_1(#c_literal{val=Pos}, #c_literal{anno=A,val=Es0}, NewVal) - when is_integer(Pos) -> - Es = [#c_literal{anno=A,val=E} || E <- tuple_to_list(Es0)], - ann_c_tuple(A, eval_setelement_2(Pos, Es, NewVal)). + case cerl:is_data(Tuple) of + false -> + Call; + true -> + Es0 = case cerl:is_c_tuple(Tuple) of + false -> []; + true -> cerl:tuple_es(Tuple) + end, + if + 1 =< Pos, Pos =< length(Es0) -> + Es = eval_setelement_1(Pos, Es0, NewVal), + cerl:update_c_tuple(Tuple, Es); + true -> + eval_failure(Call, badarg) + end + end; +eval_setelement(Call, _, _, _) -> Call. -eval_setelement_2(1, [_|T], NewVal) -> +eval_setelement_1(1, [_|T], NewVal) -> [NewVal|T]; -eval_setelement_2(Pos, [H|T], NewVal) when Pos > 1 -> - [H|eval_setelement_2(Pos-1, T, NewVal)]. +eval_setelement_1(Pos, [H|T], NewVal) when Pos > 1 -> + [H|eval_setelement_1(Pos-1, T, NewVal)]. %% eval_failure(Call, Reason) -> Core. %% Warn for a call that will fail and replace the call with @@ -1492,7 +1120,7 @@ clause(#c_clause{pats=Ps0,guard=G0,body=B0}=Cl, Cexpr, Ctxt, Sub0) -> let_substs(Vs0, As0, Sub0) -> {Vs1,Sub1} = pattern_list(Vs0, Sub0), {Vs2,As1,Ss} = let_substs_1(Vs1, As0, Sub1), - Sub2 = scope_add([V || #c_var{name=V} <- Vs2], Sub1), + Sub2 = sub_add_scope([V || #c_var{name=V} <- Vs2], Sub1), {Vs2,As1, foldl(fun ({V,S}, Sub) -> sub_set_name(V, S, Sub) end, Sub2, Ss)}. @@ -1527,7 +1155,7 @@ pattern(#c_var{}=Pat, Isub, Osub) -> true -> V1 = make_var_name(), Pat1 = #c_var{name=V1}, - {Pat1,sub_set_var(Pat, Pat1, scope_add([V1], Osub))}; + {Pat1,sub_set_var(Pat, Pat1, sub_add_scope([V1], Osub))}; false -> {Pat,sub_del_var(Pat, Osub)} end; @@ -1597,6 +1225,7 @@ is_subst(_) -> false. %% sub_del_var(Var, #sub{}) -> #sub{}. %% sub_subst_var(Var, Value, #sub{}) -> [{Name,Value}]. %% sub_is_val(Var, #sub{}) -> boolean(). +%% sub_add_scope(#sub{}) -> #sub{} %% sub_subst_scope(#sub{}) -> #sub{} %% %% We use the variable name as key so as not have problems with @@ -1607,9 +1236,10 @@ is_subst(_) -> false. %% In addition to the list of substitutions, we also keep track of %% all variable currently live (the scope). %% -%% sub_subst_scope/1 adds dummy substitutions for all variables -%% in the scope in order to force renaming if variables in the -%% scope occurs as pattern variables. +%% sub_add_scope/2 adds variables to the scope. sub_subst_scope/1 +%% adds dummy substitutions for all variables in the scope in order +%% to force renaming if variables in the scope occurs as pattern +%% variables. sub_new() -> #sub{v=orddict:new(),s=gb_trees:empty(),t=[]}. @@ -1649,6 +1279,12 @@ sub_subst_var(#c_var{name=V}, Val, #sub{v=S0}) -> %% Fold chained substitutions. [{V,Val}] ++ [ {K,Val} || {K,#c_var{name=V1}} <- S0, V1 =:= V]. +sub_add_scope(Vs, #sub{s=Scope0}=Sub) -> + Scope = foldl(fun(V, S) when is_integer(V); is_atom(V) -> + gb_sets:add(V, S) + end, Scope0, Vs), + Sub#sub{s=Scope}. + sub_subst_scope(#sub{v=S0,s=Scope}=Sub) -> S = [{-1,#c_var{name=Sv}} || Sv <- gb_sets:to_list(Scope)]++S0, Sub#sub{v=S}. @@ -1696,7 +1332,7 @@ clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) -> {yes,yes} -> case LitExpr of false -> - Line = get_line(core_lib:get_anno(C1)), + Line = get_line(cerl:get_ann(C1)), shadow_warning(Cs, Line); true -> %% If the case expression is a literal, @@ -1930,7 +1566,7 @@ opt_bool_case_guard(#c_case{arg=Arg,clauses=Cs0}=Case) -> Case; true -> Cs = opt_bool_case_guard(Arg, Cs0), - Case#c_case{arg=#c_values{anno=core_lib:get_anno(Arg),es=[]}, + Case#c_case{arg=#c_values{anno=cerl:get_ann(Arg),es=[]}, clauses=Cs} end. @@ -1978,6 +1614,7 @@ eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0, %% is correct, the clause will always match at run-time. Case; {true,Bs} -> + eval_case_warn(B), {Ps,As} = unzip(Bs), InnerLet = cerl:c_let(Ps, core_lib:make_values(As), B), Let = cerl:c_let(Vs, E, InnerLet), @@ -1985,6 +1622,19 @@ eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0, end; eval_case(Case, _) -> Case. +eval_case_warn(#c_primop{anno=Anno, + name=#c_literal{val=match_fail}, + args=[#c_literal{val=Reason}]}=Core) + when is_atom(Reason) -> + case member(eval_failure, Anno) of + false -> + ok; + true -> + %% Example: M = not_map, M#{k:=v} + add_warning(Core, {eval_failure,Reason}) + end; +eval_case_warn(_) -> ok. + %% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}. %% Try and optimise a case by avoid building tuples or lists %% in the case expression. Instead combine the variable parts @@ -2041,31 +1691,75 @@ case_opt_args([], Cs, _Sub, _LitExpr, Acc) -> %% or to remove a literal argument. %% case_opt_arg(E0, Sub, Cs, LitExpr) -> - E = maybe_replace_var(E0, Sub), - case cerl:is_data(E) of + case cerl:is_c_var(E0) of + false -> + case_opt_arg_1(E0, Cs, LitExpr); + true -> + case case_will_var_match(Cs) of + true -> + %% All clauses will match a variable in the + %% current position. Don't expand this variable + %% (that can only make the code worse). + {error,Cs}; + false -> + %% If possible, expand this variable to a previously + %% matched term. + E = case_expand_var(E0, Sub), + case_opt_arg_1(E, Cs, LitExpr) + end + end. + +case_opt_arg_1(E0, Cs0, LitExpr) -> + case cerl:is_data(E0) of false -> - {error,Cs}; + {error,Cs0}; true -> + E = case_opt_compiler_generated(E0), + Cs = case_opt_nomatch(E, Cs0, LitExpr), case cerl:data_type(E) of {atomic,_} -> - case_opt_lit(E, Cs, LitExpr); + case_opt_lit(E, Cs); _ -> - case_opt_data(E, Cs, LitExpr) + case_opt_data(E, Cs) end end. -%% maybe_replace_var(Expr0, Sub) -> Expr +%% case_will_var_match([Clause]) -> true | false. +%% Return if all clauses will match a variable in the +%% current position. +%% +case_will_var_match(Cs) -> + all(fun({[P|_],_,_,_}) -> + case cerl_clauses:match(P, any) of + {true,_} -> true; + _ -> false + end + end, Cs). + + +%% case_opt_compiler_generated(Core) -> Core' +%% Mark Core expressions as compiler generated to ensure that +%% no warnings are generated if they turn out to be unused. +%% To pretty-printed Core Erlang easier to read, don't mark +%% constructs that can't cause warnings to be emitted. +%% +case_opt_compiler_generated(Core) -> + F = fun(C) -> + case cerl:type(C) of + alias -> C; + var -> C; + _ -> cerl:set_ann(C, [compiler_generated]) + end + end, + cerl_trees:map(F, Core). + + +%% case_expand_var(Expr0, Sub) -> Expr %% If Expr0 is a variable that has been previously matched and %% is known to be a tuple, return the tuple instead. Otherwise %% return Expr0 unchanged. %% -maybe_replace_var(E, Sub) -> - case cerl:is_c_var(E) of - false -> E; - true -> maybe_replace_var_1(E, Sub) - end. - -maybe_replace_var_1(E, #sub{t=Tdb}) -> +case_expand_var(E, #sub{t=Tdb}) -> case orddict:find(cerl:var_name(E), Tdb) of {ok,T0} -> case cerl:is_c_tuple(T0) of @@ -2082,9 +1776,8 @@ maybe_replace_var_1(E, #sub{t=Tdb}) -> %% operator will fail when used in map %% construction (only the '=>' operator is allowed %% when constructing a map from scratch). - ToData = fun coerce_to_data/1, try - cerl_trees:map(ToData, T0) + cerl_trees:map(fun coerce_to_data/1, T0) catch throw:impossible -> %% Something unsuitable was found (map or @@ -2113,140 +1806,144 @@ coerce_to_data(C) -> coerce_to_data(cerl:alias_pat(C)) end. -%% case_opt_lit(Literal, Clauses0, LitExpr) -> -%% {ok,[],Clauses} | error +%% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses' +%% Remove all clauses that cannot possibly match. + +case_opt_nomatch(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) -> + case cerl_clauses:match(P, E) of + none -> + %% The pattern will not match the case expression. Remove + %% the clause. Unless the entire case expression is a + %% literal, also emit a warning. + case LitExpr of + false -> add_warning(C, nomatch_clause_type); + true -> ok + end, + case_opt_nomatch(E, Cs, LitExpr); + _ -> + [Current|case_opt_nomatch(E, Cs, LitExpr)] + end; +case_opt_nomatch(_, [], _) -> []. + +%% case_opt_lit(Literal, Clauses0) -> {ok,[],Clauses} | error %% The current part of the case expression is a literal. That %% means that we will know at compile-time whether a clause %% will match, and we can remove the corresponding pattern from %% each clause. %% -%% The only complication is if the literal is a binary. Binary -%% pattern matching is tricky, so we will give up in that case. +%% The only complication is if the literal is a binary or map. +%% In general, it is difficult to know whether a binary or +%% map pattern will match, so we give up in that case. -case_opt_lit(Lit, Cs0, LitExpr) -> - Cs1 = case_opt_lit_1(Lit, Cs0, LitExpr), - try case_opt_lit_2(Lit, Cs1) of +case_opt_lit(Lit, Cs0) -> + try case_opt_lit_1(Lit, Cs0) of Cs -> {ok,[],Cs} catch throw:impossible -> - {error,Cs1} + {error,Cs0} end. -case_opt_lit_1(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) -> - case cerl_clauses:match(P, E) of - none -> - %% The pattern will not match the literal. Remove the clause. - %% Unless the entire case expression is a literal, also - %% emit a warning. - case LitExpr of - false -> add_warning(C, nomatch_clause_type); - true -> ok - end, - case_opt_lit_1(E, Cs, LitExpr); - _ -> - [Current|case_opt_lit_1(E, Cs, LitExpr)] - end; -case_opt_lit_1(_, [], _) -> []. - -case_opt_lit_2(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) -> - %% Non-matching clauses have already been removed in case_opt_lit_1/3. +case_opt_lit_1(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) -> + %% Non-matching clauses have already been removed + %% in case_opt_nomatch/3. case cerl_clauses:match(P, E) of {true,Bs} -> %% The pattern matches the literal. Remove the pattern %% and update the bindings. - [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_2(E, Cs)]; + [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(E, Cs)]; {false,_} -> %% Binary literal and pattern. We are not sure whether %% the pattern will match. throw(impossible) end; -case_opt_lit_2(_, []) -> []. +case_opt_lit_1(_, []) -> []. %% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses} +%% The case expression is a non-atomic data constructor (cons +%% or tuple). We can know at compile time whether each clause +%% will match, and we can delay the building of the data to +%% the clauses where it is actually needed. -case_opt_data(E, Cs0, LitExpr) -> +case_opt_data(E, Cs0) -> Es = cerl:data_es(E), - Cs = case_opt_data_1(Cs0, Es, - {cerl:data_type(E),cerl:data_arity(E)}, - LitExpr), - {ok,Es,Cs}. - -case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig, LitExpr) -> - case case_data_pat(P, TypeSig) of - {ok,Ps1,Bs1} -> - [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}| - case_opt_data_1(Cs, Es, TypeSig,LitExpr)]; - error -> - case LitExpr of - false -> add_warning(C, nomatch_clause_type); - true -> ok - end, - case_opt_data_1(Cs, Es, TypeSig, LitExpr) - end; -case_opt_data_1([], _, _, _) -> []. - -%% case_data_pat(Pattern, Type, Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error. - -case_data_pat(P, TypeSig) -> - case cerl:is_data(P) of - false -> - case_data_pat_var(P, TypeSig); - true -> - case {cerl:data_type(P),cerl:data_arity(P)} of - TypeSig -> - {ok,cerl:data_es(P),[]}; - {_,_} -> - error - end + TypeSig = {cerl:data_type(E),cerl:data_arity(E)}, + try case_opt_data_1(Cs0, Es, TypeSig) of + Cs -> + {ok,Es,Cs} + catch + throw:impossible -> + %% The pattern contained a binary or map. + {error,Cs0} end. -%% case_data_pat_var(Pattern, {DataType,ArityType}) -> -%% {ok,[Pattern],[{AliasVar,Pat}]} +case_opt_data_1([{[P0|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) -> + P = case_opt_compiler_generated(P0), + BindTo = #c_var{name=dummy}, + {Ps1,[{BindTo,_}|Bs1]} = case_data_pat_alias(P, BindTo, TypeSig, []), + [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}|case_opt_data_1(Cs, Es, TypeSig)]; +case_opt_data_1([], _, _) -> []. -case_data_pat_var(P, {Type,Arity}=TypeSig) -> - %% If the entire case statement is evaluated in an effect - %% context (e.g. "case {A,B} of ... end, ok"), there will - %% be a warning that a term is constructed but never used. - %% To avoid that warning, we must annotate the data - %% constructor as compiler generated. - Ann = [compiler_generated|cerl:get_ann(P)], +case_data_pat_alias(P, BindTo0, TypeSig, Bs0) -> case cerl:type(P) of - var -> - Vars = make_vars(cerl:get_ann(P), Arity), - {ok,Vars,[{P,cerl:ann_make_data(Ann, Type, Vars)}]}; alias -> - V = cerl:alias_var(P), - Apat = cerl:alias_pat(P), - case case_data_pat(Apat, TypeSig) of - {ok,Ps,Bs} -> - {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, unalias_pat_list(Ps))}|Bs]}; - error -> - error - end; + %% Recursively handle the pattern and bind to + %% the alias variable. + BindTo = cerl:alias_var(P), + Apat0 = cerl:alias_pat(P), + Ann = [compiler_generated], + Apat = cerl:set_ann(Apat0, Ann), + {Ps,Bs} = case_data_pat_alias(Apat, BindTo, TypeSig, Bs0), + {Ps,[{BindTo0,BindTo}|Bs]}; + var -> + %% Here we will need to actually build the data and bind + %% it to the variable. + {Type,Arity} = TypeSig, + Vars = make_vars([], Arity), + Ann = [compiler_generated], + Data = cerl:ann_make_data(Ann, Type, Vars), + Bs = [{BindTo0,P},{P,Data}|Bs0], + {Vars,Bs}; _ -> - error + %% Since case_opt_nomatch/3 has removed all clauses that + %% cannot match, we KNOW that this clause must match and + %% that the pattern must be a data constructor. + %% Here we must build the data and bind it to the variable. + {Type,_} = TypeSig, + DataEs = cerl:data_es(P), + Vars = pat_to_expr_list(DataEs), + Ann = [compiler_generated], + Data = cerl:ann_make_data(Ann, Type, Vars), + {DataEs,[{BindTo0,Data}]} end. -%% unalias_pat(Pattern) -> Pattern. -%% Remove all the aliases in a pattern but using the alias variables -%% instead of the values. We KNOW they will be bound. +%% pat_to_expr(Pattern) -> Expression. +%% Convert a pattern to an expression if possible. We KNOW that +%% all variables in the pattern will be bound. +%% +%% Throw an 'impossible' exception if a map or (non-literal) +%% binary is encountered. Trying to use a map pattern as an +%% expression is incorrect, while rebuilding a potentially +%% huge binary in an expression would be wasteful. -unalias_pat(P) -> - case cerl:is_c_alias(P) of - true -> +pat_to_expr(P) -> + case cerl:type(P) of + alias -> cerl:alias_var(P); - false -> + var -> + P; + _ -> case cerl:is_data(P) of false -> - P; + %% Map or binary. + throw(impossible); true -> - Es = unalias_pat_list(cerl:data_es(P)), + Es = pat_to_expr_list(cerl:data_es(P)), cerl:update_data(P, cerl:data_type(P), Es) end end. -unalias_pat_list(Ps) -> [unalias_pat(P) || P <- Ps]. +pat_to_expr_list(Ps) -> [pat_to_expr(P) || P <- Ps]. make_vars(A, Max) -> make_vars(A, 1, Max). @@ -2264,58 +1961,130 @@ make_var_name() -> list_to_atom("fol"++integer_to_list(N)). letify(Bs, Body) -> + Ann = cerl:get_ann(Body), foldr(fun({V,Val}, B) -> - letify(V, Val, B) + cerl:ann_c_let(Ann, [V], Val, B) end, Body, Bs). -letify(#c_var{name=Vname}=Var, Val, Body) -> - case core_lib:is_var_used(Vname, Body) of - true -> - A = element(2, Body), - #c_let{anno=A,vars=[Var],arg=Val,body=Body}; - false -> Body - end. +%% opt_not_in_let(Let) -> Cerl +%% Try to optimize away a 'not' operator in a 'let'. -%% opt_case_in_let(LetExpr) -> LetExpr' +-spec opt_not_in_let(cerl:c_let()) -> cerl:cerl(). -opt_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> - opt_case_in_let_0(Vs, Arg, B, Let, Sub). - -opt_case_in_let_0([#c_var{name=V}], Arg, - #c_case{arg=#c_var{name=V},clauses=Cs}=Case, Let, Sub) -> - case opt_case_in_let_1(V, Arg, Cs) of - impossible -> - case is_simple_case_arg(Arg) andalso - not core_lib:is_var_used(V, Case#c_case{arg=#c_literal{val=nil}}) of - true -> - expr(opt_bool_case(Case#c_case{arg=Arg,clauses=Cs}), sub_new(Sub)); - false -> - Let +opt_not_in_let(#c_let{vars=[_]=Vs0,arg=Arg0,body=Body0}=Let) -> + case opt_not_in_let(Vs0, Arg0, Body0) of + {[],#c_values{es=[]},Body} -> + Body; + {Vs,Arg,Body} -> + Let#c_let{vars=Vs,arg=Arg,body=Body} + end; +opt_not_in_let(Let) -> Let. + +%% opt_not_in_let(Vs, Arg, Body) -> {Vs',Arg',Body'} +%% Try to optimize away a 'not' operator in a 'let'. + +-spec opt_not_in_let([cerl:c_var()], cerl:cerl(), cerl:cerl()) -> + {[cerl:c_var()],cerl:cerl(),cerl:cerl()}. + +opt_not_in_let([#c_var{name=V}]=Vs0, Arg0, Body0) -> + case cerl:type(Body0) of + call -> + %% let <V> = Expr in not V ==> + %% let <> = <> in notExpr + case opt_not_in_let_1(V, Body0, Arg0) of + no -> + {Vs0,Arg0,Body0}; + {yes,Body} -> + {[],#c_values{es=[]},Body} + end; + 'let' -> + %% let <V> = Expr in let <Var> = not V in Body ==> + %% let <Var> = notExpr in Body + %% V must not be used in Body. + LetArg = cerl:let_arg(Body0), + case opt_not_in_let_1(V, LetArg, Arg0) of + no -> + {Vs0,Arg0,Body0}; + {yes,Arg} -> + LetBody = cerl:let_body(Body0), + case core_lib:is_var_used(V, LetBody) of + true -> + {Vs0,Arg0,Body0}; + false -> + LetVars = cerl:let_vars(Body0), + {LetVars,Arg,LetBody} + end end; - Expr -> Expr + _ -> + {Vs0,Arg0,Body0} end; -opt_case_in_let_0(_, _, _, Let, _) -> Let. +opt_not_in_let(Vs, Arg, Body) -> + {Vs,Arg,Body}. -opt_case_in_let_1(V, Arg, Cs) -> - try - opt_case_in_let_2(V, Arg, Cs) - catch - _:_ -> impossible +opt_not_in_let_1(V, Call, Body) -> + case Call of + #c_call{module=#c_literal{val=erlang}, + name=#c_literal{val='not'}, + args=[#c_var{name=V}]} -> + opt_not_in_let_2(Body); + _ -> + no end. -opt_case_in_let_2(V, Arg0, - [#c_clause{pats=[#c_tuple{es=Es}], - guard=#c_literal{val=true},body=B}|_]) -> - - %% In {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end. - %% avoid building tuples, by converting tuples to multiple values. - %% (The optimisation is not done if the built tuple is used or returned.) - - true = all(fun (#c_var{}) -> true; - (_) -> false end, Es), %Only variables in tuple - false = core_lib:is_var_used(V, B), %Built tuple must not be used. - Arg1 = tuple_to_values(Arg0, length(Es)), %Might fail. - #c_let{vars=Es,arg=Arg1,body=B}. +opt_not_in_let_2(#c_case{clauses=Cs0}=Case) -> + Vars = make_vars([], 1), + Body = #c_call{module=#c_literal{val=erlang}, + name=#c_literal{val='not'}, + args=Vars}, + Cs = [begin + Let = #c_let{vars=Vars,arg=B,body=Body}, + C#c_clause{body=opt_not_in_let(Let)} + end || #c_clause{body=B}=C <- Cs0], + {yes,Case#c_case{clauses=Cs}}; +opt_not_in_let_2(#c_call{}=Call0) -> + invert_call(Call0); +opt_not_in_let_2(_) -> no. + +invert_call(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=Name0}, + args=[_,_]}=Call) -> + case inverse_rel_op(Name0) of + no -> no; + Name -> {yes,Call#c_call{name=#c_literal{val=Name}}} + end; +invert_call(#c_call{}) -> no. + +%% inverse_rel_op(Op) -> no | RevOp + +inverse_rel_op('=:=') -> '=/='; +inverse_rel_op('=/=') -> '=:='; +inverse_rel_op('==') -> '/='; +inverse_rel_op('/=') -> '=='; +inverse_rel_op('>') -> '=<'; +inverse_rel_op('<') -> '>='; +inverse_rel_op('>=') -> '<'; +inverse_rel_op('=<') -> '>'; +inverse_rel_op(_) -> no. + + +%% opt_bool_case_in_let(LetExpr, Sub) -> Core + +opt_bool_case_in_let(#c_let{vars=Vs,arg=Arg,body=B}=Let, Sub) -> + opt_case_in_let_1(Vs, Arg, B, Let, Sub). + +opt_case_in_let_1([#c_var{name=V}], Arg, + #c_case{arg=#c_var{name=V}}=Case0, Let, Sub) -> + case is_simple_case_arg(Arg) of + true -> + Case = opt_bool_case(Case0#c_case{arg=Arg}), + case core_lib:is_var_used(V, Case) of + false -> expr(Case, sub_new(Sub)); + true -> Let + end; + false -> + Let + end; +opt_case_in_let_1(_, _, _, Let, _) -> Let. %% is_simple_case_arg(Expr) -> true|false %% Determine whether the Expr is simple enough to be worth @@ -2357,18 +2126,15 @@ is_bool_expr(#c_clause{body=B}, Sub) -> is_bool_expr(B, Sub); is_bool_expr(#c_let{vars=[V],arg=Arg,body=B}, Sub0) -> Sub = case is_bool_expr(Arg, Sub0) of - true -> update_types(V, [#c_literal{val=true}], Sub0); + true -> update_types(V, [bool], Sub0); false -> Sub0 end, is_bool_expr(B, Sub); is_bool_expr(#c_let{body=B}, Sub) -> %% Binding of multiple variables. is_bool_expr(B, Sub); -is_bool_expr(#c_literal{val=Bool}, _) when is_boolean(Bool) -> - true; -is_bool_expr(#c_var{name=V}, Sub) -> - is_boolean_type(V, Sub); -is_bool_expr(_, _) -> false. +is_bool_expr(C, Sub) -> + is_boolean_type(C, Sub) =:= yes. is_bool_expr_list([C|Cs], Sub) -> is_bool_expr(C, Sub) andalso is_bool_expr_list(Cs, Sub); @@ -2446,38 +2212,6 @@ is_safe_bool_expr_list([C|Cs], Sub, BoolVars) -> end; is_safe_bool_expr_list([], _, _) -> true. -%% tuple_to_values(Expr, TupleArity) -> Expr' -%% Convert tuples in return position of arity TupleArity to values. -%% Throws an exception for constructs that are not handled. - -tuple_to_values(#c_tuple{es=Es}, Arity) when length(Es) =:= Arity -> - core_lib:make_values(Es); -tuple_to_values(#c_literal{val=Tuple}=Lit, Arity) when tuple_size(Tuple) =:= Arity -> - Es = [Lit#c_literal{val=E} || E <- tuple_to_list(Tuple)], - core_lib:make_values(Es); -tuple_to_values(#c_case{clauses=Cs0}=Case, Arity) -> - Cs1 = [tuple_to_values(E, Arity) || E <- Cs0], - Case#c_case{clauses=Cs1}; -tuple_to_values(#c_seq{body=B0}=Seq, Arity) -> - Seq#c_seq{body=tuple_to_values(B0, Arity)}; -tuple_to_values(#c_let{body=B0}=Let, Arity) -> - Let#c_let{body=tuple_to_values(B0, Arity)}; -tuple_to_values(#c_receive{clauses=Cs0,timeout=Timeout,action=A0}=Rec, Arity) -> - Cs = [tuple_to_values(E, Arity) || E <- Cs0], - A = case Timeout of - #c_literal{val=infinity} -> A0; - _ -> tuple_to_values(A0, Arity) - end, - Rec#c_receive{clauses=Cs,action=A}; -tuple_to_values(#c_clause{body=B0}=Clause, Arity) -> - B = tuple_to_values(B0, Arity), - Clause#c_clause{body=B}; -tuple_to_values(Expr, _) -> - case will_fail(Expr) of - true -> Expr; - false -> erlang:error({not_handled,Expr}) - end. - %% simplify_let(Let, Sub) -> Expr | impossible %% If the argument part of an let contains a complex expression, such %% as a let or a sequence, move the original let body into the complex @@ -2504,7 +2238,7 @@ move_let_into_expr(#c_let{vars=InnerVs0,body=InnerBody0}=Inner, Arg = body(Arg0, Sub0), ScopeSub0 = sub_subst_scope(Sub0#sub{t=[]}), {OuterVs,ScopeSub} = pattern_list(OuterVs0, ScopeSub0), - + OuterBody = body(OuterBody0, ScopeSub), {InnerVs,Sub} = pattern_list(InnerVs0, Sub0), @@ -2582,86 +2316,232 @@ move_let_into_expr(_Let, _Expr, _Sub) -> impossible. is_failing_clause(#c_clause{body=B}) -> will_fail(B). -scope_add(Vs, #sub{s=Scope0}=Sub) -> - Scope = foldl(fun(V, S) when is_integer(V); is_atom(V) -> - gb_sets:add(V, S) - end, Scope0, Vs), - Sub#sub{s=Scope}. +%% opt_case_in_let(Let) -> Let' +%% Try to avoid building tuples that are immediately matched. +%% A common pattern is: +%% +%% {V1,V2,...} = case E of P -> ... {Val1,Val2,...}; ... end +%% +%% In Core Erlang the pattern would look like this: +%% +%% let <V> = case E of +%% ... -> ... {Val1,Val2} +%% ... +%% end, +%% in case V of +%% {A,B} -> ... <use A and B> ... +%% end +%% +%% Rewrite this to: +%% +%% let <V1,V2> = case E of +%% ... -> ... <Val1,Val2> +%% ... +%% end, +%% in +%% let <V> = {V1,V2} +%% in case V of +%% {A,B} -> ... <use A and B> ... +%% end +%% +%% Note that the second 'case' is unchanged. The other optimizations +%% in this module will eliminate the building of the tuple and +%% rewrite the second case to: +%% +%% case <V1,V2> of +%% <A,B> -> ... <use A and B> ... +%% end +%% + +opt_case_in_let(#c_let{vars=Vs,arg=Arg0,body=B}=Let0) -> + case matches_data(Vs, B) of + {yes,TypeSig} -> + case delay_build(Arg0, TypeSig) of + no -> + Let0; + {yes,Vars,Arg,Data} -> + InnerLet = Let0#c_let{arg=Data}, + Let0#c_let{vars=Vars,arg=Arg,body=InnerLet} + end; + no -> + Let0 + end. + +matches_data([#c_var{name=V}], #c_case{arg=#c_var{name=V}, + clauses=[#c_clause{pats=[P]}|_]}) -> + case cerl:is_data(P) of + false -> + no; + true -> + case cerl:data_type(P) of + {atomic,_} -> + no; + Type -> + {yes,{Type,cerl:data_arity(P)}} + end + end; +matches_data(_, _) -> no. + +delay_build(Core, TypeSig) -> + case cerl:is_data(Core) of + true -> no; + false -> delay_build_1(Core, TypeSig) + end. + +delay_build_1(Core0, TypeSig) -> + try delay_build_expr(Core0, TypeSig) of + Core -> + {Type,Arity} = TypeSig, + Vars = make_vars([], Arity), + Data = cerl:ann_make_data([compiler_generated], Type, Vars), + {yes,Vars,Core,Data} + catch + throw:impossible -> + no + end. + +delay_build_cs([#c_clause{body=B0}=C0|Cs], TypeSig) -> + B = delay_build_expr(B0, TypeSig), + C = C0#c_clause{body=B}, + [C|delay_build_cs(Cs, TypeSig)]; +delay_build_cs([], _) -> []. + +delay_build_expr(Core, {Type,Arity}=TypeSig) -> + case cerl:is_data(Core) of + false -> + delay_build_expr_1(Core, TypeSig); + true -> + case {cerl:data_type(Core),cerl:data_arity(Core)} of + {Type,Arity} -> + core_lib:make_values(cerl:data_es(Core)); + {_,_} -> + throw(impossible) + end + end. + +delay_build_expr_1(#c_case{clauses=Cs0}=Case, TypeSig) -> + Cs = delay_build_cs(Cs0, TypeSig), + Case#c_case{clauses=Cs}; +delay_build_expr_1(#c_let{body=B0}=Let, TypeSig) -> + B = delay_build_expr(B0, TypeSig), + Let#c_let{body=B}; +delay_build_expr_1(#c_receive{clauses=Cs0, + timeout=Timeout, + action=A0}=Rec, TypeSig) -> + Cs = delay_build_cs(Cs0, TypeSig), + A = case Timeout of + #c_literal{val=infinity} -> A0; + _ -> delay_build_expr(A0, TypeSig) + end, + Rec#c_receive{clauses=Cs,action=A}; +delay_build_expr_1(#c_seq{body=B0}=Seq, TypeSig) -> + B = delay_build_expr(B0, TypeSig), + Seq#c_seq{body=B}; +delay_build_expr_1(Core, _TypeSig) -> + case will_fail(Core) of + true -> Core; + false -> throw(impossible) + end. %% opt_simple_let(#c_let{}, Context, Sub) -> CoreTerm %% Optimize a let construct that does not contain any lets in %% in its argument. -opt_simple_let(#c_let{arg=Arg0}=Let, Ctxt, Sub0) -> - Arg = body(Arg0, value, Sub0), %This is a body +opt_simple_let(Let0, Ctxt, Sub) -> + case opt_not_in_let(Let0) of + #c_let{}=Let -> + opt_simple_let_0(Let, Ctxt, Sub); + Expr -> + expr(Expr, Ctxt, Sub) + end. + +opt_simple_let_0(#c_let{arg=Arg0}=Let, Ctxt, Sub) -> + Arg = body(Arg0, value, Sub), %This is a body case will_fail(Arg) of true -> Arg; - false -> opt_simple_let_1(Let, Arg, Ctxt, Sub0) + false -> opt_simple_let_1(Let, Arg, Ctxt, Sub) end. opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) -> %% Optimise let and add new substitutions. - {Vs,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), - BodySub = case {Vs,Args} of - {[V],[A]} -> - case is_bool_expr(A, Sub0) of - true -> - update_types(V, [#c_literal{val=true}], Sub1); - false -> - Sub1 - end; - {_,_} -> Sub1 - end, - B = body(B0, Ctxt, BodySub), - Arg = core_lib:make_values(Args), - opt_simple_let_2(Let, Vs, Arg, B, Ctxt, Sub1). - -opt_simple_let_2(Let0, Vs0, Arg0, Body0, effect, Sub) -> - case {Vs0,Arg0,Body0} of - {[],#c_values{es=[]},Body} -> - %% No variables left (because of substitutions). - Body; - {[_|_],Arg,#c_literal{}} -> - %% The body is a literal. That means that we can ignore - %% it and that the return value is Arg revisited in - %% effect context. - body(Arg, effect, sub_new_preserve_types(Sub)); - {Vs,Arg,Body} -> - %% Since we are in effect context, there is a chance - %% that the body no longer references the variables. - %% In that case we can construct a sequence and visit - %% that in effect context: - %% let <Var> = Arg in BodyWithoutVar ==> seq Arg BodyWithoutVar - case is_any_var_used(Vs, Body) of - false -> - expr(#c_seq{arg=Arg,body=Body}, effect, sub_new_preserve_types(Sub)); - true -> - Let = Let0#c_let{vars=Vs,arg=Arg,body=Body}, - opt_case_in_let_arg(opt_case_in_let(Let, Sub), effect, Sub) - end - end; -opt_simple_let_2(Let, Vs0, Arg0, Body, value, Sub) -> + {Vs1,Args,Sub1} = let_substs(Vs0, Arg0, Sub0), + BodySub = update_let_types(Vs1, Args, Sub1), + B1 = body(B0, Ctxt, BodySub), + Arg1 = core_lib:make_values(Args), + {Vs,Arg,B} = opt_not_in_let(Vs1, Arg1, B1), + opt_simple_let_2(Let, Vs, Arg, B, B0, Ctxt, Sub1). + +opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Ctxt, Sub) -> case {Vs0,Arg0,Body} of - {[#c_var{name=N1}],Arg,#c_var{name=N2}} -> + {[#c_var{name=N1}],Arg1,#c_var{name=N2}} -> case N1 =:= N2 of true -> %% let <Var> = Arg in <Var> ==> Arg - Arg; + Arg1; false -> %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar - expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub)) + Arg = maybe_suppress_warnings(Arg1, Vs0, PrevBody, Ctxt), + expr(#c_seq{arg=Arg,body=Body}, Ctxt, + sub_new_preserve_types(Sub)) end; {[],#c_values{es=[]},_} -> %% No variables left. Body; - {_,Arg,#c_literal{}} -> - %% The variable is not used in the body. The argument - %% can be evaluated in effect context to simplify it. - expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub)); - {Vs,Arg,Body} -> - opt_case_in_let_arg( - opt_case_in_let(Let#c_let{vars=Vs,arg=Arg,body=Body}, Sub), - value, Sub) + {Vs,Arg1,#c_literal{}} -> + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), + E = case Ctxt of + effect -> + %% Throw away the literal body. + Arg; + value -> + %% Since the variable is not used in the body, we + %% can rewrite the let to a sequence. + %% let <Var> = Arg in Literal ==> seq Arg Literal + #c_seq{arg=Arg,body=Body} + end, + expr(E, Ctxt, sub_new_preserve_types(Sub)); + {Vs,Arg1,Body} -> + %% If none of the variables are used in the body, we can + %% rewrite the let to a sequence: + %% let <Var> = Arg in BodyWithoutVar ==> + %% seq Arg BodyWithoutVar + case is_any_var_used(Vs, Body) of + false -> + Arg = maybe_suppress_warnings(Arg1, Vs, PrevBody, Ctxt), + expr(#c_seq{arg=Arg,body=Body}, Ctxt, + sub_new_preserve_types(Sub)); + true -> + Let1 = Let0#c_let{vars=Vs,arg=Arg1,body=Body}, + Let2 = opt_bool_case_in_let(Let1, Sub), + opt_case_in_let_arg(Let2, Ctxt, Sub) + end + end. + +%% maybe_suppress_warnings(Arg, [#c_var{}], PreviousBody, Context) -> Arg' +%% Try to suppress false warnings when a variable is not used. +%% For instance, we don't expect a warning for useless building in: +%% +%% R = #r{}, %No warning expected. +%% R#r.f %Optimization would remove the reference to R. +%% +%% To avoid false warnings, we will check whether the variables were +%% referenced in the original unoptimized code. If they were, we will +%% consider the warning false and suppress it. + +maybe_suppress_warnings(Arg, _, _, effect) -> + %% Don't suppress any warnings in effect context. + Arg; +maybe_suppress_warnings(Arg, Vs, PrevBody, value) -> + case suppress_warning(Arg) of + true -> + Arg; %Already suppressed. + false -> + case is_any_var_used(Vs, PrevBody) of + true -> + cerl:set_ann(Arg, [compiler_generated]); + false -> + Arg + end end. move_case_into_arg(#c_case{arg=#c_let{vars=OuterVars0,arg=OuterArg, @@ -2751,7 +2631,7 @@ move_case_into_arg(_, _) -> %% <> when 'true' -> %% let <Var> = Literal2 in LetBody %% end -%% +%% %% In the worst case, the size of the code could increase. %% In practice, though, substituting the literals into %% LetBody and doing constant folding will decrease the code @@ -2784,14 +2664,114 @@ is_any_var_used([#c_var{name=V}|Vs], Expr) -> end; is_any_var_used([], _) -> false. -is_boolean_type(V, #sub{t=Tdb}) -> +%%% +%%% Retrieving information about types. +%%% + +-spec get_type(cerl:cerl(), #sub{}) -> type_info() | 'none'. + +get_type(#c_var{name=V}, #sub{t=Tdb}) -> case orddict:find(V, Tdb) of - {ok,bool} -> true; - _ -> false + {ok,Type} -> Type; + error -> none + end; +get_type(C, _) -> + case cerl:type(C) of + binary -> C; + map -> C; + _ -> + case cerl:is_data(C) of + true -> C; + false -> none + end + end. + +-spec is_boolean_type(cerl:cerl(), sub()) -> yes_no_maybe(). + +is_boolean_type(Var, Sub) -> + case get_type(Var, Sub) of + none -> + maybe; + bool -> + yes; + C -> + B = cerl:is_c_atom(C) andalso + is_boolean(cerl:atom_val(C)), + yes_no(B) + end. + +-spec is_int_type(cerl:cerl(), sub()) -> yes_no_maybe(). + +is_int_type(Var, Sub) -> + case get_type(Var, Sub) of + none -> maybe; + integer -> yes; + C -> yes_no(cerl:is_c_int(C)) + end. + +-spec is_tuple_type(cerl:cerl(), sub()) -> yes_no_maybe(). + +is_tuple_type(Var, Sub) -> + case get_type(Var, Sub) of + none -> maybe; + C -> yes_no(cerl:is_c_tuple(C)) end. +yes_no(true) -> yes; +yes_no(false) -> no. + +%%% +%%% Update type information. +%%% + +update_let_types(Vs, Args, Sub) when is_list(Args) -> + update_let_types_1(Vs, Args, Sub); +update_let_types(_Vs, _Arg, Sub) -> + %% The argument is a complex expression (such as a 'case') + %% that returns multiple values. + Sub. + +update_let_types_1([#c_var{}=V|Vs], [A|As], Sub0) -> + Sub = update_types_from_expr(V, A, Sub0), + update_let_types_1(Vs, As, Sub); +update_let_types_1([], [], Sub) -> Sub. + +update_types_from_expr(V, Expr, Sub) -> + Type = extract_type(Expr, Sub), + update_types(V, [Type], Sub). + +extract_type(#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=Name}, + args=Args}=Call, Sub) -> + case returns_integer(Name, Args) of + true -> integer; + false -> extract_type_1(Call, Sub) + end; +extract_type(Expr, Sub) -> + extract_type_1(Expr, Sub). + +extract_type_1(Expr, Sub) -> + case is_bool_expr(Expr, Sub) of + false -> Expr; + true -> bool + end. + +returns_integer(bit_size, [_]) -> true; +returns_integer('bsl', [_,_]) -> true; +returns_integer('bsr', [_,_]) -> true; +returns_integer(byte_size, [_]) -> true; +returns_integer(length, [_]) -> true; +returns_integer('rem', [_,_]) -> true; +returns_integer(size, [_]) -> true; +returns_integer(tuple_size, [_]) -> true; +returns_integer(trunc, [_]) -> true; +returns_integer(_, _) -> false. + %% update_types(Expr, Pattern, Sub) -> Sub' %% Update the type database. + +-spec update_types(cerl:cerl(), [type_info()], sub()) -> sub(). + update_types(Expr, Pat, #sub{t=Tdb0}=Sub) -> Tdb = update_types_1(Expr, Pat, Tdb0), Sub#sub{t=Tdb}. @@ -2811,6 +2791,8 @@ update_types_2(V, [#c_tuple{}=P], Types) -> orddict:store(V, P, Types); update_types_2(V, [#c_literal{val=Bool}], Types) when is_boolean(Bool) -> orddict:store(V, bool, Types); +update_types_2(V, [Type], Types) when is_atom(Type) -> + orddict:store(V, Type, Types); update_types_2(_, _, Types) -> Types. %% kill_types(V, Tdb) -> Tdb' @@ -3077,7 +3059,7 @@ bsm_ensure_no_partition_after([#c_clause{pats=Ps}|Cs], Pos) -> bsm_problem(P, bin_partition) end; bsm_ensure_no_partition_after([], _) -> ok. - + bsm_could_match_binary(#c_alias{pat=P}) -> bsm_could_match_binary(P); bsm_could_match_binary(#c_cons{}) -> false; bsm_could_match_binary(#c_tuple{}) -> false; @@ -3111,11 +3093,11 @@ add_bin_opt_info(Core, Term) -> end. add_warning(Core, Term) -> - case is_compiler_generated(Core) of + case suppress_warning(Core) of true -> ok; false -> - Anno = core_lib:get_anno(Core), + Anno = cerl:get_ann(Core), Line = get_line(Anno), File = get_file(Anno), Key = {?MODULE,warnings}, @@ -3136,9 +3118,17 @@ get_file([{file,File}|_]) -> File; get_file([_|T]) -> get_file(T); get_file([]) -> "no_file". % should not happen +suppress_warning(Core) -> + is_compiler_generated(Core) orelse + is_result_unwanted(Core). + is_compiler_generated(Core) -> - Anno = core_lib:get_anno(Core), - member(compiler_generated, Anno). + Ann = cerl:get_ann(Core), + member(compiler_generated, Ann). + +is_result_unwanted(Core) -> + Ann = cerl:get_ann(Core), + member(result_not_wanted, Ann). get_warnings() -> ordsets:from_list((erase({?MODULE,warnings}))). diff --git a/lib/compiler/src/sys_core_fold_lists.erl b/lib/compiler/src/sys_core_fold_lists.erl new file mode 100644 index 0000000000..49dc59052a --- /dev/null +++ b/lib/compiler/src/sys_core_fold_lists.erl @@ -0,0 +1,386 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. 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% +%% +%% Purpose : Inline high order lists functions from the lists module. + +-module(sys_core_fold_lists). + +-export([call/4]). + +-include("core_parse.hrl"). + +%% We inline some very common higher order list operations. +%% We use the same evaluation order as the library function. + +-spec call(cerl:c_call(), atom(), atom(), [cerl:cerl()]) -> + 'none' | cerl:cerl(). + +call(#c_call{anno=Anno}, lists, all, [Arg1,Arg2]) -> + Loop = #c_var{name={'lists^all',1}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, + CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, + body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, + CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, + body=#c_literal{val=false}}, + CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, + body=match_fail(Anno, Err1)}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, + clauses = [CC1, CC2, CC3]}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, + body=#c_literal{val=true}}, + Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)}, + Fun = #c_fun{vars=[Xs], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}; +call(#c_call{anno=Anno}, lists, any, [Arg1,Arg2]) -> + Loop = #c_var{name={'lists^any',1}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, + CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, + body=#c_literal{val=true}}, + CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, + body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, + CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, + body=match_fail(Anno, Err1)}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, + clauses = [CC1, CC2, CC3]}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, + body=#c_literal{val=false}}, + Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^any',1}}|Anno], Err2)}, + Fun = #c_fun{vars=[Xs], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}; +call(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2]) -> + Loop = #c_var{name={'lists^foreach',1}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]}, + body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, + body=#c_literal{val=ok}}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}; +call(#c_call{anno=Anno}, lists, map, [Arg1,Arg2]) -> + Loop = #c_var{name={'lists^map',1}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + H = #c_var{name='H'}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_let{vars=[H], arg=#c_apply{anno=Anno, + op=F, + args=[X]}, + body=#c_cons{hd=H, + anno=[compiler_generated], + tl=#c_apply{anno=Anno, + op=Loop, + args=[Xs]}}}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, + body=#c_literal{val=[]}}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^map',1}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}; +call(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2]) -> + Loop = #c_var{name={'lists^flatmap',1}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + H = #c_var{name='H'}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_let{vars=[H], + arg=#c_apply{anno=Anno, op=F, args=[X]}, + body=#c_call{anno=[compiler_generated|Anno], + module=#c_literal{val=erlang}, + name=#c_literal{val='++'}, + args=[H, + #c_apply{anno=Anno, + op=Loop, + args=[Xs]}]}}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, + body=#c_literal{val=[]}}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}; +call(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2]) -> + Loop = #c_var{name={'lists^filter',1}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + B = #c_var{name='B'}, + Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, + CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, + body=#c_cons{anno=[compiler_generated], hd=X, tl=Xs}}, + CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, + body=Xs}, + CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, + body=match_fail(Anno, Err1)}, + Case = #c_case{arg=B, clauses = [CC1, CC2, CC3]}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_let{vars=[B], + arg=#c_apply{anno=Anno, op=F, args=[X]}, + body=#c_let{vars=[Xs], + arg=#c_apply{anno=Anno, + op=Loop, + args=[Xs]}, + body=Case}}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, + body=#c_literal{val=[]}}, + Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)}, + Fun = #c_fun{vars=[Xs], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}; +call(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3]) -> + Loop = #c_var{name={'lists^foldl',2}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + A = #c_var{name='A'}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_apply{anno=Anno, + op=Loop, + args=[Xs, #c_apply{anno=Anno, + op=F, + args=[X, A]}]}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=2}]}, + body=A}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs, A], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}}; +call(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3]) -> + Loop = #c_var{name={'lists^foldr',2}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + A = #c_var{name='A'}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_apply{anno=Anno, + op=F, + args=[X, #c_apply{anno=Anno, + op=Loop, + args=[Xs, A]}]}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=2}]}, + body=A}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs, A], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}}; +call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) -> + Loop = #c_var{name={'lists^mapfoldl',2}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + Avar = #c_var{name='A'}, + Match = + fun (A, P, E) -> + C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, + Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, + C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, + body=match_fail(Anno, Err)}, + #c_case{arg=A, clauses=[C1, C2]} + end, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, + #c_tuple{es=[X, Avar]}, +%%% Tuple passing version + Match(#c_apply{anno=Anno, + op=Loop, + args=[Xs, Avar]}, + #c_tuple{es=[Xs, Avar]}, + #c_tuple{anno=[compiler_generated], + es=[#c_cons{anno=[compiler_generated], + hd=X, tl=Xs}, + Avar]}) +%%% Multiple-value version +%%% #c_let{vars=[Xs,A], +%%% %% The tuple here will be optimised +%%% %% away later; no worries. +%%% arg=#c_apply{op=Loop, args=[Xs, A]}, +%%% body=#c_values{es=[#c_cons{hd=X, tl=Xs}, +%%% A]}} + )}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=2}]}, +%%% Tuple passing version + body=#c_tuple{anno=[compiler_generated], + es=[#c_literal{val=[]}, Avar]}}, +%%% Multiple-value version +%%% body=#c_values{es=[#c_literal{val=[]}, A]}}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs, Avar], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, + body=#c_letrec{defs=[{Loop,Fun}], +%%% Tuple passing version + body=#c_apply{anno=Anno, + op=Loop, + args=[L, Avar]}}}; +%%% Multiple-value version +%%% body=#c_let{vars=[Xs, A], +%%% arg=#c_apply{op=Loop, +%%% args=[L, A]}, +%%% body=#c_tuple{es=[Xs, A]}}}}; +call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) -> + Loop = #c_var{name={'lists^mapfoldr',2}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + Avar = #c_var{name='A'}, + Match = + fun (A, P, E) -> + C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, + Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, + C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, + body=match_fail(Anno, Err)}, + #c_case{arg=A, clauses=[C1, C2]} + end, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, +%%% Tuple passing version + body=Match(#c_apply{anno=Anno, + op=Loop, + args=[Xs, Avar]}, + #c_tuple{es=[Xs, Avar]}, + Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, + #c_tuple{es=[X, Avar]}, + #c_tuple{anno=[compiler_generated], + es=[#c_cons{anno=[compiler_generated], + hd=X, tl=Xs}, Avar]})) +%%% Multiple-value version +%%% body=#c_let{vars=[Xs,A], +%%% %% The tuple will be optimised away +%%% arg=#c_apply{op=Loop, args=[Xs, A]}, +%%% body=Match(#c_apply{op=F, args=[X, A]}, +%%% #c_tuple{es=[X, A]}, +%%% #c_values{es=[#c_cons{hd=X, tl=Xs}, +%%% A]})} + }, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=2}]}, +%%% Tuple passing version + body=#c_tuple{anno=[compiler_generated], + es=[#c_literal{val=[]}, Avar]}}, +%%% Multiple-value version +%%% body=#c_values{es=[#c_literal{val=[]}, A]}}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs, Avar], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, + body=#c_letrec{defs=[{Loop,Fun}], +%%% Tuple passing version + body=#c_apply{anno=Anno, + op=Loop, + args=[L, Avar]}}}; +%%% Multiple-value version +%%% body=#c_let{vars=[Xs, A], +%%% arg=#c_apply{op=Loop, +%%% args=[L, A]}, +%%% body=#c_tuple{es=[Xs, A]}}}}; +call(_, _, _, _) -> + none. + +match_fail(Ann, Arg) -> + Name = cerl:abstract(match_fail), + Args = [Arg], + cerl:ann_c_primop(Ann, Name, Args). diff --git a/lib/compiler/src/sys_core_inline.erl b/lib/compiler/src/sys_core_inline.erl index 9f93acb666..1e3a735e9b 100644 --- a/lib/compiler/src/sys_core_inline.erl +++ b/lib/compiler/src/sys_core_inline.erl @@ -195,10 +195,10 @@ kill_id_anns(Body) -> A = kill_id_anns_1(A0), CFun#c_fun{anno=A}; (Expr) -> - %% Mark everything as compiler generated to suppress - %% bogus warnings. - A = compiler_generated(core_lib:get_anno(Expr)), - core_lib:set_anno(Expr, A) + %% Mark everything as compiler generated to + %% suppress bogus warnings. + A = compiler_generated(cerl:get_ann(Expr)), + cerl:set_ann(Expr, A) end, Body). kill_id_anns_1([{'id',_}|As]) -> diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 8c1a0c08ac..7eec9dd62b 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -69,10 +69,8 @@ stk=[], %Stack table res=[]}). %Reserved regs: [{reserved,I,V}] -module({Mod,Exp,Attr,Forms}, Options) -> - put(?MODULE, Options), +module({Mod,Exp,Attr,Forms}, _Options) -> {Fs,St} = functions(Forms, {atom,Mod}), - erase(?MODULE), {ok,{Mod,Exp,Attr,Fs,St#cg.lcount}}. functions(Forms, AtomMod) -> @@ -924,7 +922,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,exact,_,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}. @@ -1523,9 +1521,11 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)], Live = max_reg(Bef#sr.reg), - Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, - Aft = clear_dead(Int1, Le#l.i, Vdb), - Target = fetch_reg(R, Int1#sr.reg), + + %% The target register can reuse one of the source registers. + Aft0 = clear_dead(Int0, Le#l.i, Vdb), + Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)}, + Target = fetch_reg(R, Aft#sr.reg), I = case Op of assoc -> put_map_assoc; @@ -1557,9 +1557,11 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, 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), + + %% The target register can reuse one of the source registers. + Aft0 = clear_dead(Int0, Le#l.i, Vdb), + Aft = Aft0#sr{reg=put_reg(R, Aft0#sr.reg)}, + Target = fetch_reg(R, Aft#sr.reg), I = case Op of assoc -> put_map_assoc; diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 612660c2d6..c954d21e59 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -66,6 +66,7 @@ %% match arguments are novars %% case arguments are novars %% receive timeouts are novars +%% binaries and maps are novars %% let/set arguments are expressions %% fun is not a safe @@ -77,7 +78,7 @@ 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_tuple/2,c_tuple/1, ann_c_map/3]). -include("core_parse.hrl"). @@ -105,7 +106,9 @@ -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}). +-record(igen, {anno=#a{},ceps=[],acc_pat,acc_guard, + skip_pat,tail,tail_pat,arg}). +-record(isimple, {anno=#a{},term :: cerl:cerl()}). -type iapply() :: #iapply{}. -type ibinary() :: #ibinary{}. @@ -124,11 +127,12 @@ -type itry() :: #itry{}. -type ifilter() :: #ifilter{}. -type igen() :: #igen{}. +-type isimple() :: #isimple{}. -type i() :: iapply() | ibinary() | icall() | icase() | icatch() | iclause() | ifun() | iletrec() | imatch() | iprimop() | iprotect() | ireceive1() | ireceive2() | iset() | itry() - | ifilter() | igen(). + | ifilter() | igen() | isimple(). -type warning() :: {file:filename(), [{integer(), module(), term()}]}. @@ -287,13 +291,15 @@ gexpr({protect,Line,Arg}, Bools0, St0) -> {#iprotect{anno=#a{anno=Anno},body=Eps++[E]},[],Bools0,St} end; gexpr({op,L,'andalso',E1,E2}, Bools, St0) -> - {#c_var{name=V0},St} = new_var(L, St0), + Anno = lineno_anno(L, St0), + {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, False = {atom,L,false}, E = make_bool_switch_guard(L, E1, V, E2, False), gexpr(E, Bools, St); gexpr({op,L,'orelse',E1,E2}, Bools, St0) -> - {#c_var{name=V0},St} = new_var(L, St0), + Anno = lineno_anno(L, St0), + {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, True = {atom,L,true}, E = make_bool_switch_guard(L, E1, V, True, E2), @@ -382,33 +388,30 @@ gexpr_test(E0, Bools0, St0) -> Lanno = Anno#a.anno, {New,St2} = new_var(Lanno, St1), Bools = [New|Bools0], - {#icall{anno=Anno, %Must have an #a{} - module=#c_literal{anno=Lanno,val=erlang}, - name=#c_literal{anno=Lanno,val='=:='}, - args=[New,#c_literal{anno=Lanno,val=true}]}, + {icall_eq_true(New), Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools,St2} end; _ -> - Anno = get_ianno(E1), Lanno = get_lineno_anno(E1), + ACompGen = #a{anno=[compiler_generated]}, case is_simple(E1) of true -> Bools = [E1|Bools0], - {#icall{anno=Anno, %Must have an #a{} - module=#c_literal{anno=Lanno,val=erlang}, - name=#c_literal{anno=Lanno,val='=:='}, - args=[E1,#c_literal{anno=Lanno,val=true}]},Eps0,Bools,St1}; + {icall_eq_true(E1),Eps0,Bools,St1}; false -> {New,St2} = new_var(Lanno, St1), Bools = [New|Bools0], - {#icall{anno=Anno, %Must have an #a{} - module=#c_literal{anno=Lanno,val=erlang}, - name=#c_literal{anno=Lanno,val='=:='}, - args=[New,#c_literal{anno=Lanno,val=true}]}, - Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools,St2} + {icall_eq_true(New), + Eps0 ++ [#iset{anno=ACompGen,var=New,arg=E1}],Bools,St2} end end. +icall_eq_true(Arg) -> + #icall{anno=#a{anno=[compiler_generated]}, + module=#c_literal{val=erlang}, + name=#c_literal{val='=:='}, + args=[Arg,#c_literal{val=true}]}. + force_booleans(Vs0, E, Eps, St) -> Vs1 = [set_anno(V, []) || V <- Vs0], Vs = unforce(E, Eps, Vs1), @@ -418,16 +421,15 @@ force_booleans_1([], E, Eps, St) -> {E,Eps,St}; force_booleans_1([V|Vs], E0, Eps0, St0) -> {E1,Eps1,St1} = force_safe(E0, St0), - Lanno = element(2, V), - Anno = #a{anno=Lanno}, - Call = #icall{anno=Anno,module=#c_literal{anno=Lanno,val=erlang}, - name=#c_literal{anno=Lanno,val=is_boolean}, + ACompGen = #a{anno=[compiler_generated]}, + Call = #icall{anno=ACompGen,module=#c_literal{val=erlang}, + name=#c_literal{val=is_boolean}, args=[V]}, - {New,St} = new_var(Lanno, St1), - Iset = #iset{anno=Anno,var=New,arg=Call}, + {New,St} = new_var([], St1), + Iset = #iset{var=New,arg=Call}, Eps = Eps0 ++ Eps1 ++ [Iset], - E = #icall{anno=Anno, - module=#c_literal{anno=Lanno,val=erlang},name=#c_literal{anno=Lanno,val='and'}, + E = #icall{anno=ACompGen, + module=#c_literal{val=erlang},name=#c_literal{val='and'}, args=[E1,New]}, force_booleans_1(Vs, E, Eps, St). @@ -514,28 +516,28 @@ exprs([], St) -> {[],St}. %% Generate an internal core expression. expr({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},[],St}; -expr({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},[],St}; -expr({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},[],St}; -expr({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},[],St}; -expr({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},[],St}; -expr({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},[],St}; -expr({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},[],St}; +expr({char,L,C}, St) -> {#c_literal{anno=full_anno(L, St),val=C},[],St}; +expr({integer,L,I}, St) -> {#c_literal{anno=full_anno(L, St),val=I},[],St}; +expr({float,L,F}, St) -> {#c_literal{anno=full_anno(L, St),val=F},[],St}; +expr({atom,L,A}, St) -> {#c_literal{anno=full_anno(L, St),val=A},[],St}; +expr({nil,L}, St) -> {#c_literal{anno=full_anno(L, St),val=[]},[],St}; +expr({string,L,S}, St) -> {#c_literal{anno=full_anno(L, St),val=S},[],St}; expr({cons,L,H0,T0}, St0) -> {H1,Hps,St1} = safe(H0, St0), {T1,Tps,St2} = safe(T0, St1), - A = lineno_anno(L, St2), + A = full_anno(L, St2), {annotate_cons(A, H1, T1, St2),Hps ++ Tps,St2}; expr({lc,L,E,Qs0}, St0) -> {Qs1,St1} = preprocess_quals(L, Qs0, St0), lc_tq(L, E, Qs1, #c_literal{anno=lineno_anno(L, St1),val=[]}, St1); expr({bc,L,E,Qs}, St) -> - bc_tq(L, E, Qs, {nil,L}, St); + bc_tq(L, E, Qs, St); expr({tuple,L,Es0}, St0) -> {Es1,Eps,St1} = safe_list(Es0, St0), A = record_anno(L, St1), {annotate_tuple(A, Es1, St1),Eps,St1}; expr({map,L,Es0}, St0) -> - map_build_pair_chain(#c_literal{val=#{}},Es0,lineno_anno(L,St0),St0); + map_build_pairs(#c_literal{val=#{}}, Es0, full_anno(L, St0), St0); expr({map,L,M0,Es0}, St0) -> try expr_map(M0,Es0,lineno_anno(L, St0),St0) of {_,_,_}=Res -> Res @@ -550,7 +552,7 @@ expr({map,L,M0,Es0}, St0) -> args=As},[],St} end; expr({bin,L,Es0}, St0) -> - try expr_bin(Es0, lineno_anno(L, St0), St0) of + try expr_bin(Es0, full_anno(L, St0), St0) of {_,_,_}=Res -> Res catch throw:bad_binary -> @@ -640,11 +642,11 @@ expr({'catch',L,E0}, St0) -> Lanno = lineno_anno(L, St1), {#icatch{anno=#a{anno=Lanno},body=Eps ++ [E1]},[],St1}; expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) -> - Lanno = lineno_anno(L, St), + Lanno = full_anno(L, St), {#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St}; expr({'fun',L,{function,M,F,A}}, St0) -> {As,Aps,St1} = safe_list([M,F,A], St0), - Lanno = lineno_anno(L, St1), + Lanno = full_anno(L, St1), {#icall{anno=#a{anno=Lanno}, module=#c_literal{val=erlang}, name=#c_literal{val=make_fun}, @@ -655,13 +657,9 @@ expr({named_fun,L,'_',Cs,Id}, St) -> fun_tq(Id, Cs, L, St, unnamed); expr({named_fun,L,Name,Cs,Id}, St) -> fun_tq(Id, Cs, L, St, {named,Name}); -expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) -> +expr({call,L,{remote,_,M,F},As0}, St0) -> {[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0), - Lanno = lineno_anno(L, St1), - Anno = case Wanted of - false -> [result_not_wanted|Lanno]; - true -> Lanno - end, + Anno = full_anno(L, St1), {#icall{anno=#a{anno=Anno},module=M1,name=F1,args=As1},Aps,St1}; expr({call,Lc,{atom,Lf,F},As0}, St0) -> {As1,Aps,St1} = safe_list(As0, St0), @@ -710,26 +708,28 @@ expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> {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), + Anno = lineno_anno(L, St0), + {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, False = {atom,L,false}, E = make_bool_switch(L, E1, V, E2, False, St0), expr(E, St); expr({op,L,'orelse',E1,E2}, St0) -> - {#c_var{name=V0},St} = new_var(L, St0), + Anno = lineno_anno(L, St0), + {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, True = {atom,L,true}, E = make_bool_switch(L, E1, V, True, E2, St0), expr(E, St); expr({op,L,Op,A0}, St0) -> {A1,Aps,St1} = safe(A0, St0), - LineAnno = lineno_anno(L, St1), + LineAnno = full_anno(L, St1), {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} module=#c_literal{anno=LineAnno,val=erlang}, name=#c_literal{anno=LineAnno,val=Op},args=[A1]},Aps,St1}; expr({op,L,Op,L0,R0}, St0) -> {As,Aps,St1} = safe_list([L0,R0], St0), - LineAnno = lineno_anno(L, St1), + LineAnno = full_anno(L, St1), {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} module=#c_literal{anno=LineAnno,val=erlang}, name=#c_literal{anno=LineAnno,val=Op},args=As},Aps,St1}. @@ -758,86 +758,47 @@ 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), +expr_map(M0, Es0, A, St0) -> + {M1,Eps0,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}, + {M2,Eps1,St2} = map_build_pairs(M1, Es0, A, St1), + M3 = case Es0 of + [] -> M1; + [_|_] -> M2 + end, + Cs = [#iclause{ + anno=#a{anno=[compiler_generated|A]}, + pats=[], + 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}; - {_,_} -> - {M2,Eps,St2} = map_build_pair_chain(M1,Es0,A,St1), - {M2,Mps++Eps,St2} - end; - false -> throw({bad_map,bad_map}) - end. - -%% Group continuous literal blocks and single variables, i.e. -%% M0#{ a := 1, b := V1, K1 := V2, K2 := 42} -%% becomes equivalent to -%% M1 = M0#{ a := 1, b := V1 }, -%% M2 = M1#{ K1 := V1 }, -%% M3 = M2#{ K2 := 42 } - -map_build_pair_chain(M,Es,A,St) -> - %% hack, remove iset if only literal - case map_build_pair_chain(M,Es,A,St,[]) of - {_,[#iset{arg=#c_literal{}=Val}],St1} -> {Val,[],St1}; - Normal -> Normal - end. - -map_build_pair_chain(M0,[],_,St,Mps) -> - {M0,Mps,St}; -map_build_pair_chain(M0,Es0,A,St0,Mps) -> - % group continuous literal blocks - % Anno = #a{anno=[compiler_generated]}, - % order is important, we need to reverse the literals - case map_pair_block(Es0,[],[],St0) of - {{CesL,EspL},{[],[]},Es1,St1} -> - {MVar,St2} = new_var(St1), - Pre = [#iset{var=MVar, arg=ann_c_map(A,M0,reverse(CesL))}], - map_build_pair_chain(MVar,Es1,A,St2,Mps++EspL++Pre); - {{[],[]},{CesV,EspV},Es1,St1} -> - {MVar,St2} = new_var(St1), - Pre = [#iset{var=MVar, arg=#c_map{arg=M0,es=CesV, anno=A}}], - map_build_pair_chain(MVar,Es1,A,St2,Mps ++ EspV++Pre); - {{CesL,EspL},{CesV,EspV},Es1,St1} -> - {MVarL,St2} = new_var(St1), - {MVarV,St3} = new_var(St2), - Pre = [#iset{var=MVarL, arg=ann_c_map(A,M0,reverse(CesL))}, - #iset{var=MVarV, arg=#c_map{arg=MVarL,es=CesV,anno=A}}], - map_build_pair_chain(MVarV,Es1,A,St3,Mps++EspL++EspV++Pre) + args=[M1]}], + body=[M3]}], + Fc = fail_clause([], [eval_failure|A], #c_literal{val=badarg}), + Eps = Eps0 ++ Eps1, + {#icase{anno=#a{anno=A},args=[],clauses=Cs,fc=Fc},Eps,St2}; + false -> + throw({bad_map,bad_map}) end. -map_pair_block([{Op,L,K0,V0}|Es],Ces,Esp,St0) -> - {K,Ep0,St1} = safe(K0, St0), - {V,Ep1,St2} = safe(V0, St1), - A = lineno_anno(L, St2), - Pair0 = map_op_to_c_map_pair(Op), - Pair1 = Pair0#c_map_pair{anno=A,key=K,val=V}, - case cerl:is_literal(K) of - true -> - map_pair_block(Es,[Pair1|Ces],Ep0 ++ Ep1 ++ Esp,St2); - false -> - {{Ces,Esp},{[Pair1],Ep0++Ep1},Es,St2} - end; -map_pair_block([],Ces,Esp,St) -> - {{Ces,Esp},{[],[]},[],St}. +map_build_pairs(Map, Es0, Ann, St0) -> + {Es,Pre,St1} = map_build_pairs_1(Es0, St0), + {ann_c_map(Ann, Map, Es),Pre,St1}. + +map_build_pairs_1([{Op0,L,K0,V0}|Es], St0) -> + {K,Pre0,St1} = safe(K0, St0), + {V,Pre1,St2} = safe(V0, St1), + {Pairs,Pre2,St3} = map_build_pairs_1(Es, St2), + As = lineno_anno(L, St3), + Op = map_op(Op0), + Pair = cerl:ann_c_map_pair(As, Op, K, V), + {[Pair|Pairs],Pre0++Pre1++Pre2,St3}; +map_build_pairs_1([], St) -> + {[],[],St}. -map_op_to_c_map_pair(map_field_assoc) -> #c_map_pair{op=#c_literal{val=assoc}}; -map_op_to_c_map_pair(map_field_exact) -> #c_map_pair{op=#c_literal{val=exact}}. +map_op(map_field_assoc) -> #c_literal{val=assoc}; +map_op(map_field_exact) -> #c_literal{val=exact}. is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true; is_valid_map_src(#c_var{}) -> true; @@ -1001,7 +962,7 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> {Cs1,Ceps,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Anno = lineno_anno(L, St3), + Anno = full_anno(L, St3), Fc = function_clause(Ps, Anno, {Name,Arity}), Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! @@ -1011,7 +972,8 @@ 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. -lc_tq(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard, +lc_tq(Line, E, [#igen{anno=GAnno,ceps=Ceps, + 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), @@ -1046,7 +1008,7 @@ lc_tq(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard, 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}; + Ceps,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) -> @@ -1060,7 +1022,7 @@ lc_tq(Line, E0, [], Mc0, St0) -> %% This TQ from Gustafsson ERLANG'05. %% More could be transformed before calling bc_tq. -bc_tq(Line, Exp, Qs0, _, St0) -> +bc_tq(Line, Exp, Qs0, St0) -> {BinVar,St1} = new_var(St0), {Sz,SzPre,St2} = bc_initial_size(Exp, Qs0, St1), {Qs,St3} = preprocess_quals(Line, Qs0, St2), @@ -1071,7 +1033,8 @@ bc_tq(Line, Exp, Qs0, _, St0) -> args=[Sz]}}] ++ BcPre, {E,Pre,St}. -bc_tq1(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard, +bc_tq1(Line, E, [#igen{anno=GAnno,ceps=Ceps, + 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), @@ -1109,7 +1072,7 @@ bc_tq1(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard, 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}; + Ceps,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) -> @@ -1245,8 +1208,9 @@ generator(Line, {generate,Lg,P0,E}, Gs, St0) -> 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={Ceps++Pre,Ce}}, + Gen = #igen{anno=#a{anno=GA},ceps=Ceps, + 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), @@ -1515,6 +1479,7 @@ force_novars(#iapply{}=App, St) -> {App,[],St}; force_novars(#icall{}=Call, St) -> {Call,[],St}; force_novars(#ifun{}=Fun, St) -> {Fun,[],St}; %These are novars too force_novars(#ibinary{}=Bin, St) -> {Bin,[],St}; +force_novars(#c_map{}=Bin, St) -> {Bin,[],St}; force_novars(Ce, St) -> force_safe(Ce, St). @@ -1634,7 +1599,7 @@ pattern({tuple,L,Ps}, St) -> {annotate_tuple(record_anno(L, St), Ps1, St),Eps,St1}; pattern({map,L,Pairs}, St0) -> {Ps,Eps,St1} = pattern_map_pairs(Pairs, St0), - {#c_map{anno=lineno_anno(L, St1), es=Ps},Eps,St1}; + {#c_map{anno=lineno_anno(L, St1),es=Ps,is_pat=true},Eps,St1}; pattern({bin,L,Ps}, St) -> %% We don't create a #ibinary record here, since there is %% no need to hold any used/new annotations in a pattern. @@ -1656,49 +1621,30 @@ pattern_map_pairs(Ps, St) -> {CMapPair,EpsP,Sti1} = pattern_map_pair(P,Sti0), {CMapPair, {EpsM++EpsP,Sti1}} end, {[],St}, Ps), - {pat_alias_map_pairs(CMapPairs,[]),Eps,St1}. - -%% remove cluddering annotations -pattern_map_clean_key(#c_literal{val=V}) -> {literal,V}; -pattern_map_clean_key(#c_var{name=V}) -> {var,V}. - -pat_alias_map_pairs(Ps1,Ps2) -> - Ps = Ps1 ++ Ps2, - F = fun(#c_map_pair{key=Ck,val=Cv},Dbi) -> - K = pattern_map_clean_key(Ck), - case dict:find(K,Dbi) of - {ok,Cvs} -> dict:store(K,[Cv|Cvs],Dbi); - _ -> dict:store(K,[Cv],Dbi) - end - end, - Kdb = lists:foldl(F,dict:new(),Ps), - pat_alias_map_pairs(Ps,Kdb,sets:new()). - -pat_alias_map_pairs([],_,_) -> []; -pat_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Set) -> - K = pattern_map_clean_key(Ck), - case sets:is_element(K,Set) of - true -> - pat_alias_map_pairs(Pairs,Kdb,Set); - false -> - Cvs = dict:fetch(K,Kdb), - Cv = pat_alias_map_pair_values(Cvs), - Set1 = sets:add_element(K,Set), - [Pair#c_map_pair{val=Cv}|pat_alias_map_pairs(Pairs,Kdb,Set1)] - end. - -pat_alias_map_pair_values([Cv]) -> Cv; -pat_alias_map_pair_values([Cv1,Cv2|Cvs]) -> - pat_alias_map_pair_values([pat_alias(Cv1,Cv2)|Cvs]). + {pat_alias_map_pairs(CMapPairs),Eps,St1}. pattern_map_pair({map_field_exact,L,K,V}, St0) -> - {Ck,EpsK,St1} = safe_pattern_expr(K,St0), + {Ck,EpsK,St1} = safe_pattern_expr(K, St0), {Cv,EpsV,St2} = pattern(V, St1), - {#c_map_pair{anno=lineno_anno(L,St2), + {#c_map_pair{anno=lineno_anno(L, St2), op=#c_literal{val=exact}, key=Ck, val=Cv},EpsK++EpsV,St2}. +pat_alias_map_pairs(Ps) -> + D = foldl(fun(#c_map_pair{key=K0}=Pair, D0) -> + K = cerl:set_ann(K0, []), + dict:append(K, Pair, D0) + end, dict:new(), Ps), + pat_alias_map_pairs_1(dict:to_list(D)). + +pat_alias_map_pairs_1([{_,[#c_map_pair{val=V0}=Pair|Vs]}|T]) -> + V = foldl(fun(#c_map_pair{val=V}, Pat) -> + pat_alias(V, Pat) + end, V0, Vs), + [Pair#c_map_pair{val=V}|pat_alias_map_pairs_1(T)]; +pat_alias_map_pairs_1([]) -> []. + %% pat_bin([BinElement], State) -> [BinSeg]. pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps]. @@ -1714,48 +1660,55 @@ pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) -> %% pat_alias(CorePat, CorePat) -> AliasPat. %% Normalise aliases. Trap bad aliases by throwing 'nomatch'. -pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2}; -pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1}; - -%% alias cons -pat_alias(#c_cons{}=Cons, #c_literal{anno=A,val=[H|T]}=S) -> - pat_alias(Cons, ann_c_cons_skel(A, #c_literal{anno=A,val=H}, - S#c_literal{val=T})); -pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) -> - pat_alias(ann_c_cons_skel(A, #c_literal{anno=A,val=H}, - S#c_literal{val=T}), Cons); -pat_alias(#c_cons{anno=Anno,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) -> - ann_c_cons(Anno, pat_alias(H1, H2), pat_alias(T1, T2)); - -%% alias tuples -pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_literal{val=T}) when is_tuple(T) -> - Es2 = [#c_literal{val=E} || E <- tuple_to_list(T)], - ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); -pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(T) -> - Es1 = [#c_literal{val=E} || E <- tuple_to_list(T)], - ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); -pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_tuple{es=Es2}) -> - ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); - -%% alias maps -%% There are no literals in maps patterns (patterns are always abstract) -pat_alias(#c_map{es=Es1}=M,#c_map{es=Es2}) -> - M#c_map{es=pat_alias_map_pairs(Es1,Es2)}; - -pat_alias(#c_alias{var=V1,pat=P1}, - #c_alias{var=V2,pat=P2}) -> - if V1 =:= V2 -> #c_alias{var=V1,pat=pat_alias(P1, P2)}; - true -> #c_alias{var=V1,pat=#c_alias{var=V2,pat=pat_alias(P1, P2)}} +pat_alias(#c_var{name=V1}=P, #c_var{name=V1}) -> P; +pat_alias(#c_var{name=V1}=Var, + #c_alias{var=#c_var{name=V2},pat=Pat}=Alias) -> + if + V1 =:= V2 -> + Alias; + true -> + Alias#c_alias{pat=pat_alias(Var, Pat)} + end; +pat_alias(#c_var{}=P1, P2) -> #c_alias{var=P1,pat=P2}; + +pat_alias(#c_alias{var=#c_var{name=V1}}=Alias, #c_var{name=V1}) -> + Alias; +pat_alias(#c_alias{var=#c_var{name=V1}=Var1,pat=P1}, + #c_alias{var=#c_var{name=V2}=Var2,pat=P2}) -> + Pat = pat_alias(P1, P2), + if + V1 =:= V2 -> + #c_alias{var=Var1,pat=Pat}; + true -> + pat_alias(Var1, pat_alias(Var2, Pat)) end; -pat_alias(#c_alias{var=V1,pat=P1}, P2) -> - #c_alias{var=V1,pat=pat_alias(P1, P2)}; -pat_alias(P1, #c_alias{var=V2,pat=P2}) -> - #c_alias{var=V2,pat=pat_alias(P1, P2)}; +pat_alias(#c_alias{var=#c_var{}=Var,pat=P1}, P2) -> + #c_alias{var=Var,pat=pat_alias(P1, P2)}; + +pat_alias(#c_map{es=Es1}=M, #c_map{es=Es2}) -> + M#c_map{es=pat_alias_map_pairs(Es1 ++ Es2)}; + +pat_alias(P1, #c_var{}=Var) -> + #c_alias{var=Var,pat=P1}; +pat_alias(P1, #c_alias{pat=P2}=Alias) -> + Alias#c_alias{pat=pat_alias(P1, P2)}; + pat_alias(P1, P2) -> - case {set_anno(P1, []),set_anno(P2, [])} of - {P,P} -> P; + %% Aliases between binaries are not allowed, so the only + %% legal patterns that remain are data patterns. + case cerl:is_data(P1) andalso cerl:is_data(P2) of + false -> throw(nomatch); + true -> ok + end, + Type = cerl:data_type(P1), + case cerl:data_type(P2) of + Type -> ok; _ -> throw(nomatch) - end. + end, + Es1 = cerl:data_es(P1), + Es2 = cerl:data_es(P2), + Es = pat_alias_list(Es1, Es2), + cerl:make_data(Type, Es). %% pat_alias_list([A1], [A2]) -> [A]. @@ -1794,7 +1747,7 @@ new_var_name(#core{vcount=C}=St) -> new_var(St) -> new_var([], St). -new_var(Anno, St0) -> +new_var(Anno, St0) when is_list(Anno) -> {New,St} = new_var_name(St0), {#c_var{anno=Anno,name=New},St}. @@ -1852,7 +1805,7 @@ uclauses(Lcs, Ks, St0) -> uclause(Cl0, Ks, St0) -> {Cl1,_Pvs,Used,New,St1} = uclause(Cl0, Ks, Ks, St0), - A0 = get_ianno(Cl1), + A0 = get_anno(Cl1), A = A0#a{us=Used,ns=New}, {Cl1#iclause{anno=A},St1}. @@ -2021,11 +1974,11 @@ uexpr(#ibinary{anno=A,segments=Ss}, _, St) -> uexpr(#c_literal{}=Lit, _, St) -> Anno = get_anno(Lit), {set_anno(Lit, #a{us=[],anno=Anno}),St}; -uexpr(Lit, _, St) -> - true = is_simple(Lit), %Sanity check! - Vs = lit_vars(Lit), - Anno = get_anno(Lit), - {set_anno(Lit, #a{us=Vs,anno=Anno}),St}. +uexpr(Simple, _, St) -> + true = is_simple(Simple), %Sanity check! + Vs = lit_vars(Simple), + Anno = get_anno(Simple), + {#isimple{anno=#a{us=Vs,anno=Anno},term=Simple},St}. uexpr_list(Les0, Ks, St0) -> mapfoldl(fun (Le, St) -> uexpr(Le, Ks, St) end, St0, Les0). @@ -2039,7 +1992,7 @@ ufun_clauses(Lcs, Ks, St0) -> ufun_clause(Cl0, Ks, St0) -> {Cl1,Pvs,Used,_,St1} = uclause(Cl0, [], Ks, St0), - A0 = get_ianno(Cl1), + A0 = get_anno(Cl1), A = A0#a{us=subtract(intersection(Used, Ks), Pvs),ns=[]}, {Cl1#iclause{anno=A},St1}. @@ -2202,7 +2155,8 @@ cguard(Gs, St0) -> cexprs([#iset{var=#c_var{name=Name}=Var}=Iset], As, St) -> %% Make return value explicit, and make Var true top level. - cexprs([Iset,Var#c_var{anno=#a{us=[Name]}}], As, St); + Isimple = #isimple{anno=#a{us=[Name]},term=Var}, + cexprs([Iset,Isimple], As, St); cexprs([Le], As, St0) -> {Ce,Es,Us,St1} = cexpr(Le, As, St0), Exp = make_vars(As), %The export variables @@ -2317,12 +2271,9 @@ cexpr(#c_literal{}=Lit, _As, St) -> Anno = get_anno(Lit), Vs = Anno#a.us, {set_anno(Lit, Anno#a.anno),[],Vs,St}; -cexpr(Lit, _As, St) -> - true = is_simple(Lit), %Sanity check! - Anno = get_anno(Lit), - Vs = Anno#a.us, - %%Vs = lit_vars(Lit), - {set_anno(Lit, Anno#a.anno),[],Vs,St}. +cexpr(#isimple{anno=#a{us=Vs},term=Simple}, _As, St) -> + true = is_simple(Simple), %Sanity check! + {Simple,[],Vs,St}. cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export! @@ -2345,11 +2296,6 @@ 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 -% lit_bin_vars(Segs, Vs) -> -% foldl(fun (#c_bitstr{val=V,size=S}, Vs0) -> -% lit_vars(V, lit_vars(S, Vs0)) -% end, Vs, Segs). - lit_list_vars(Ls) -> lit_list_vars(Ls, []). lit_list_vars(Ls, Vs) -> @@ -2368,16 +2314,21 @@ record_anno(L, St) when L >= ?REC_OFFSET -> true -> [record | lineno_anno(L - ?REC_OFFSET, St)]; false -> - lineno_anno(L, St) + full_anno(L, St) end; record_anno(L, St) when L < -?REC_OFFSET -> case member(dialyzer, St#core.opts) of true -> [record | lineno_anno(L + ?REC_OFFSET, St)]; false -> - lineno_anno(L, St) + full_anno(L, St) end; record_anno(L, St) -> + full_anno(L, St). + +full_anno(L, #core{wanted=false}=St) -> + [result_not_wanted|lineno_anno(L, St)]; +full_anno(L, #core{wanted=true}=St) -> lineno_anno(L, St). lineno_anno(L, St) -> @@ -2389,12 +2340,6 @@ lineno_anno(L, St) -> [Line] ++ St#core.file end. -get_ianno(Ce) -> - case get_anno(Ce) of - #a{}=A -> A; - A when is_list(A) -> #a{anno=A} - end. - get_lineno_anno(Ce) -> case get_anno(Ce) of #a{anno=A} -> A; diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 6504351c02..0ac1aaf158 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -131,12 +131,12 @@ module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) -> {ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas, body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}. -attributes([{#c_literal{val=Name},Val}|As]) -> +attributes([{#c_literal{val=Name},#c_literal{val=Val}}|As]) -> case include_attribute(Name) of false -> attributes(As); true -> - [{Name,core_lib:literal_value(Val)}|attributes(As)] + [{Name,Val}|attributes(As)] end; attributes([]) -> []. @@ -273,17 +273,7 @@ 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,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_map(A, Var, Ces, Sub, St0); expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> try atomic_bin(Cv, Sub, St0) of {Kv,Ep,St1} -> @@ -506,77 +496,81 @@ translate_fc(Args) -> [#c_literal{val=function_clause},make_list(Args)]. expr_map(A,Var0,Ces,Sub,St0) -> - %% An extra pass of validation of Map src because of inlining {Var,Mps,St1} = expr(Var0, Sub, St0), - case is_valid_map_src(Var) of - true -> - {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1), - {Km,Eps++Mps,St2}; - false -> throw(bad_map) - end. - -is_valid_map_src(#k_map{}) -> true; -is_valid_map_src(#k_literal{val=M}) when is_map(M) -> true; -is_valid_map_src(#k_var{}) -> true; -is_valid_map_src(_) -> false. + {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1), + {Km,Eps++Mps,St2}. 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], + %% 1. Force variables. + %% 2. Group adjacent pairs with literal keys. + %% 3. Within each such group, remove multiple assignments to the same key. + %% 4. Partition each group according to operator ('=>' and ':='). + 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,Eps1,Sti1} = atomic(K0, Sub, Sti0), {V,Eps2,Sti2} = atomic(V0, Sub, Sti1), {[{Op,K,V}|Ops],Eps1 ++ Eps2 ++ Espi,Sti2} end, {[],[],St0}, Pairs0), - - case map_group_pairs(Pairs) of - {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} - + map_split_pairs_1(A, Var, Pairs, Esp, St1). + +map_split_pairs_1(A, Map0, [{Op,Key,Val}|Pairs1]=Pairs0, Esp0, St0) -> + {Map1,Em,St1} = force_atomic(Map0, St0), + case Key of + #k_var{} -> + %% Don't combine variable keys with other keys. + Kes = [#k_map_pair{key=Key,val=Val}], + Map = #k_map{anno=A,op=Op,var=Map1,es=Kes}, + map_split_pairs_1(A, Map, Pairs1, Esp0 ++ Em, St1); + _ -> + %% Literal key. Split off all literal keys. + {L,Pairs} = splitwith(fun({_,#k_var{},_}) -> false; + ({_,_,_}) -> true + end, Pairs0), + {Map,Esp,St2} = map_group_pairs(A, Map1, L, Esp0 ++ Em, St1), + map_split_pairs_1(A, Map, Pairs, Esp, St2) + end; +map_split_pairs_1(_, Map, [], Esp, St0) -> + {Map,Esp,St0}. + +map_group_pairs(A, Var, Pairs0, Esp, St0) -> + Pairs = map_remove_dup_keys(Pairs0), + Assoc = [#k_map_pair{key=K,val=V} || {_,{assoc,K,V}} <- Pairs], + Exact = [#k_map_pair{key=K,val=V} || {_,{exact,K,V}} <- Pairs], + case {Assoc,Exact} of + {[_|_],[]} -> + {#k_map{anno=A,op=assoc,var=Var,es=Assoc},Esp,St0}; + {[],[_|_]} -> + {#k_map{anno=A,op=exact,var=Var,es=Exact},Esp,St0}; + {[_|_],[_|_]} -> + Map = #k_map{anno=A,op=assoc,var=Var,es=Assoc}, + {Mvar,Em,St1} = force_atomic(Map, St0), + {#k_map{anno=A,op=exact,var=Mvar,es=Exact},Esp ++ Em,St1} end. -%% Group map by Assoc operations and Exact operations +map_remove_dup_keys(Es) -> + dict:to_list(map_remove_dup_keys(Es, dict:new())). -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). +map_remove_dup_keys([{assoc,K0,V}|Es0],Used0) -> + K = map_key_clean(K0), + Op = case dict:find(K, Used0) of + {ok,{exact,_,_}} -> exact; + _ -> assoc + end, + Used1 = dict:store(K, {Op,K0,V}, Used0), + map_remove_dup_keys(Es0, Used1); +map_remove_dup_keys([{exact,K0,V}|Es0],Used0) -> + K = map_key_clean(K0), + Op = case dict:find(K, Used0) of + {ok,{assoc,_,_}} -> assoc; + _ -> exact + end, + Used1 = dict:store(K, {Op,K0,V}, Used0), + map_remove_dup_keys(Es0, Used1); +map_remove_dup_keys([], Used) -> Used. -%% Be explicit instead of using set_kanno(K,[]) +%% Be explicit instead of using set_kanno(K, []). map_key_clean(#k_var{name=V}) -> {var,V}; map_key_clean(#k_literal{val=V}) -> {lit,V}; map_key_clean(#k_int{val=V}) -> {lit,V}; @@ -661,12 +655,12 @@ atomic_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U0,type=T,flags=Fs0}|Es0], {E,Ap1,St1} = atomic(E0, Sub, St0), {S1,Ap2,St2} = atomic(S0, Sub, St1), validate_bin_element_size(S1), - U1 = core_lib:literal_value(U0), - Fs1 = core_lib:literal_value(Fs0), + U1 = cerl:concrete(U0), + Fs1 = cerl:concrete(Fs0), {Es,Ap3,St3} = atomic_bin(Es0, Sub, St2), {#k_bin_seg{anno=A,size=S1, unit=U1, - type=core_lib:literal_value(T), + type=cerl:concrete(T), flags=Fs1, seg=E,next=Es}, Ap1++Ap2++Ap3,St3}; @@ -793,8 +787,8 @@ pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0], %% problems. #k_atom{val=bad_size} end, - U0 = core_lib:literal_value(U), - Fs0 = core_lib:literal_value(Fs), + U0 = cerl:concrete(U), + Fs0 = cerl:concrete(Fs), %%ok= io:fwrite("~w: ~p~n", [?LINE,{B0,S,U0,Fs0}]), {E,Osub1,St2} = pattern(E0, Isub0, Osub0, St1), Isub1 = case E0 of @@ -805,7 +799,7 @@ pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0], {Es,{Isub,Osub},St3} = pattern_bin_1(Es0, Isub1, Osub1, St2), {#k_bin_seg{anno=A,size=S, unit=U0, - type=core_lib:literal_value(T), + type=cerl:concrete(T), flags=Fs0, seg=E,next=Es}, {Isub,Osub},St3}; @@ -2010,9 +2004,7 @@ 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"; -format_error(bad_map) -> - "map construction will fail because of a type mismatch". + "binary 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_life.erl b/lib/compiler/src/v3_life.erl index cd4b5fd674..75bd188479 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -270,7 +270,7 @@ match(#k_select{anno=A,var=V,types=Kts}, Ls0, I, Ctxt, Vdb0) -> end, Vdb1 = use_vars(union(A#k.us, Ls1), I, Vdb0), Ts = [type_clause(Tc, Ls1, I+1, Ctxt, Vdb1) || Tc <- Kts], - #l{ke={select,literal2(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno}; + #l{ke={select,literal(V, Ctxt),Ts},i=I,vdb=Vdb1,a=Anno}; match(#k_guard{anno=A,clauses=Kcs}, Ls, I, Ctxt, Vdb0) -> Vdb1 = use_vars(union(A#k.us, Ls), I, Vdb0), Cs = [guard_clause(G, Ls, I+1, Ctxt, Vdb1) || G <- Kcs], @@ -297,7 +297,7 @@ val_clause(#k_val_clause{anno=A,val=V,body=Kb}, Ls0, I, Ctxt0, Vdb0) -> _ -> Ctxt0 end, B = match(Kb, Ls1, I+1, Ctxt, Vdb1), - #l{ke={val_clause,literal2(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}. + #l{ke={val_clause,literal(V, Ctxt),B},i=I,vdb=use_vars(Bus, I+1, Vdb1),a=A#k.a}. guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) -> Vdb1 = use_vars(union(A#k.us, Ls), I+2, Vdb0), @@ -350,6 +350,7 @@ atomic_list(Ks) -> [atomic(K) || K <- Ks]. %% literal_list([Klit]) -> [Lit]. literal(#k_var{name=N}, _) -> {var,N}; +literal(#k_literal{val=I}, _) -> {literal,I}; literal(#k_int{val=I}, _) -> {integer,I}; literal(#k_float{val=F}, _) -> {float,F}; literal(#k_atom{val=N}, _) -> {atom,N}; @@ -358,58 +359,29 @@ literal(#k_nil{}, _) -> nil; literal(#k_cons{hd=H,tl=T}, Ctxt) -> {cons,[literal(H, Ctxt),literal(T, Ctxt)]}; literal(#k_binary{segs=V}, Ctxt) -> - {binary,literal(V, Ctxt)}; + {binary,literal(V, Ctxt)}; +literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) -> + %% Only occurs in patterns. + {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs,[literal(Seg, Ctxt)]}; literal(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) -> {bin_seg,Ctxt,literal(S, Ctxt),U,T,Fs, [literal(Seg, Ctxt),literal(N, Ctxt)]}; +literal(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) -> + %% Only occurs in patterns. + {bin_int,Ctxt,literal(S, Ctxt),U,Fs,Int, + [literal(N, Ctxt)]}; literal(#k_bin_end{}, Ctxt) -> {bin_end,Ctxt}; literal(#k_tuple{es=Es}, Ctxt) -> {tuple,literal_list(Es, Ctxt)}; -literal(#k_map{op=Op,var=Var,es=Es}, Ctxt) -> - {map,Op,literal(Var, Ctxt),literal_list(Es, Ctxt)}; +literal(#k_map{op=Op,var=Var,es=Es0}, Ctxt) -> + {map,Op,literal(Var, Ctxt),literal_list(Es0, 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}. + {map_pair,literal(K, Ctxt),literal(V, Ctxt)}. literal_list(Ks, Ctxt) -> [literal(K, Ctxt) || K <- Ks]. -literal2(#k_var{name=N}, _) -> {var,N}; -literal2(#k_literal{val=I}, _) -> {literal,I}; -literal2(#k_int{val=I}, _) -> {integer,I}; -literal2(#k_float{val=F}, _) -> {float,F}; -literal2(#k_atom{val=N}, _) -> {atom,N}; -%%literal2(#k_char{val=C}, _) -> {char,C}; -literal2(#k_nil{}, _) -> nil; -literal2(#k_cons{hd=H,tl=T}, Ctxt) -> - {cons,[literal2(H, Ctxt),literal2(T, Ctxt)]}; -literal2(#k_binary{segs=V}, Ctxt) -> - {binary,literal2(V, Ctxt)}; -literal2(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=[]}, Ctxt) -> - {bin_seg,Ctxt,literal2(S, Ctxt),U,T,Fs,[literal2(Seg, Ctxt)]}; -literal2(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}, Ctxt) -> - {bin_seg,Ctxt,literal2(S, Ctxt),U,T,Fs, - [literal2(Seg, Ctxt),literal2(N, Ctxt)]}; -literal2(#k_bin_int{size=S,unit=U,flags=Fs,val=Int,next=N}, Ctxt) -> - {bin_int,Ctxt,literal2(S, Ctxt),U,Fs,Int, - [literal2(N, Ctxt)]}; -literal2(#k_bin_end{}, Ctxt) -> - {bin_end,Ctxt}; -literal2(#k_tuple{es=Es}, Ctxt) -> - {tuple,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)}. - -literal_list2(Ks, Ctxt) -> - [literal2(K, Ctxt) || K <- Ks]. - -%% literal_bin(#k_bin_seg{size=S,unit=U,type=T,flags=Fs,seg=Seg,next=N}) -> -%% {bin_seg,literal(S),U,T,Fs,[literal(Seg),literal(N)]} - %% is_gc_bif(Name, Arity) -> true|false %% Determines whether the BIF Name/Arity might do a GC. |