diff options
Diffstat (limited to 'lib/compiler')
50 files changed, 2350 insertions, 827 deletions
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 7a30c68593..7d65dc983a 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -155,7 +155,8 @@ collect(remove_message) -> {set,[],[],remove_message}; collect({put_map,F,Op,S,D,R,{list,Puts}}) -> {set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}; collect({get_map_elements,F,S,{list,Gets}}) -> - {set,Gets,[S],{get_map_elements,F}}; + {Ss,Ds} = beam_utils:split_even(Gets), + {set,Ds,[S|Ss],{get_map_elements,F}}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; collect(fclearerror) -> {set,[],[],fclearerror}; collect({fcheckerror,{f,0}}) -> {set,[],[],fcheckerror}; diff --git a/lib/compiler/src/beam_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 b15adfa889..7cd07dc3be 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -21,112 +21,10 @@ -export([module/2]). -%%% The following optimisations are done: -%%% -%%% (1) In this code -%%% -%%% move DeadValue {x,0} -%%% jump L2 -%%% . -%%% . -%%% . -%%% L2: move Anything {x,0} -%%% . -%%% . -%%% . -%%% -%%% the first assignment to {x,0} has no effect (is dead), -%%% so it can be removed. Besides removing a move instruction, -%%% if the move was preceeded by a label, the resulting code -%%% will look this -%%% -%%% L1: jump L2 -%%% . -%%% . -%%% . -%%% L2: move Anything {x,0} -%%% . -%%% . -%%% . -%%% -%%% which can be further optimized by the jump optimizer (beam_jump). -%%% -%%% (2) In this code -%%% -%%% L1: move AtomLiteral {x,0} -%%% jump L2 -%%% . -%%% . -%%% . -%%% L2: test is_atom FailLabel {x,0} -%%% select_val {x,0}, FailLabel [... AtomLiteral => L3...] -%%% . -%%% . -%%% . -%%% L3: ... -%%% -%%% FailLabel: ... -%%% -%%% the first code fragment can be changed to -%%% -%%% L1: move AtomLiteral {x,0} -%%% jump L3 -%%% -%%% If the literal is not included in the table of literals in the -%%% select_val instruction, the first code fragment will instead be -%%% rewritten as: -%%% -%%% L1: move AtomLiteral {x,0} -%%% jump FailLabel -%%% -%%% The move instruction will be removed by optimization (1) above, -%%% if the code following the L3 label overwrites {x,0}. -%%% -%%% The code following the L2 label will be kept, but it will be removed later -%%% by the jump optimizer. -%%% -%%% (3) In this code -%%% -%%% test is_eq_exact ALabel Src Dst -%%% move Src Dst -%%% -%%% the move instruction can be removed. -%%% Same thing for -%%% -%%% test is_nil ALabel Dst -%%% move [] Dst -%%% -%%% -%%% (4) In this code -%%% -%%% select_val {x,Reg}, ALabel [... Literal => L1...] -%%% . -%%% . -%%% . -%%% L1: move Literal {x,Reg} -%%% -%%% we can remove the move instruction. -%%% -%%% (5) In the following code -%%% -%%% bif '=:=' Fail Src1 Src2 {x,0} -%%% jump L1 -%%% . -%%% . -%%% . -%%% L1: select_val {x,0}, ALabel [... true => L2..., ...false => L3...] -%%% . -%%% . -%%% . -%%% L2: .... L3: .... -%%% -%%% the first two instructions can be replaced with -%%% -%%% test is_eq_exact L3 Src1 Src2 -%%% jump L2 -%%% -%%% provided that {x,0} is killed at both L2 and L3. -%%% +%%% Dead code is code that is executed but has no effect. This +%%% optimization pass either removes dead code or jumps around it, +%%% potentially making it unreachable and a target for the +%%% the beam_jump pass. -import(lists, [mapfoldl/3,reverse/1]). @@ -173,7 +71,28 @@ move_move_into_block([I|Is], Acc) -> move_move_into_block([], Acc) -> reverse(Acc). %%% -%%% Scan instructions in execution order and remove dead code. +%%% Scan instructions in execution order and remove redundant 'move' +%%% instructions. 'move' instructions are redundant if we know that +%%% the register already contains the value being assigned, as in the +%%% following code: +%%% +%%% test is_eq_exact SomeLabel Src Dst +%%% move Src Dst +%%% +%%% or in: +%%% +%%% test is_nil SomeLabel Dst +%%% move nil Dst +%%% +%%% or in: +%%% +%%% select_val Register FailLabel [... Literal => L1...] +%%% . +%%% . +%%% . +%%% L1: move Literal Register +%%% +%%% Also add extra labels to help the second backward pass. %%% forward(Is, Lc) -> @@ -215,15 +134,13 @@ forward([{test,is_eq_exact,_,[Dst,Src]}=I,{move,Src,Dst}|Is], D, Lc, Acc) -> forward([I|Is], D, Lc, Acc); forward([{test,is_nil,_,[Dst]}=I,{move,nil,Dst}|Is], D, Lc, Acc) -> forward([I|Is], D, Lc, Acc); -forward([{test,is_eq_exact,_,_}=I|Is], D, Lc, Acc) -> - case Is of - [{label,_}|_] -> forward(Is, D, Lc, [I|Acc]); - _ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc]) - end; -forward([{test,is_ne_exact,_,_}=I|Is], D, Lc, Acc) -> - case Is of - [{label,_}|_] -> forward(Is, D, Lc, [I|Acc]); - _ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc]) +forward([{test,_,_,_}=I|Is]=Is0, D, Lc, Acc) -> + %% Help the second, backward pass to by inserting labels after + %% relational operators so that they can be skipped if they are + %% known to be true. + case useful_to_insert_label(Is0) of + false -> forward(Is, D, Lc, [I|Acc]); + true -> forward(Is, D, Lc+1, [{label,Lc},I|Acc]) end; forward([I|Is], D, Lc, Acc) -> forward(Is, D, Lc, [I|Acc]); @@ -239,9 +156,49 @@ update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> update_value_dict(T, Reg, D); update_value_dict([], _, D) -> D. +useful_to_insert_label([_,{label,_}|_]) -> + false; +useful_to_insert_label([{test,Op,_,_}|_]) -> + case Op of + is_lt -> true; + is_ge -> true; + is_eq_exact -> true; + is_ne_exact -> true; + _ -> false + end. + +%%% +%%% Scan instructions in reverse execution order and try to +%%% shortcut branch instructions. +%%% +%%% For example, in this code: +%%% +%%% move Literal Register +%%% jump L1 +%%% . +%%% . +%%% . +%%% L1: test is_{integer,atom} FailLabel Register +%%% select_val {x,0} FailLabel [... Literal => L2...] +%%% . +%%% . +%%% . +%%% L2: ... %%% -%%% Scan instructions in reverse execution order and remove dead code. +%%% the 'selectval' instruction will always transfer control to L2, +%%% so we can just as well jump to L2 directly by rewriting the +%%% first part of the sequence like this: %%% +%%% move Literal Register +%%% jump L2 +%%% +%%% If register Register is killed at label L2, we can remove the +%%% 'move' instruction, leaving just the 'jump' instruction: +%%% +%%% jump L2 +%%% +%%% These transformations may leave parts of the code unreachable. +%%% The beam_jump pass will remove the unreachable code. backward(Is, D) -> backward(Is, D, []). @@ -277,15 +234,10 @@ 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,Src,Reg}=Move0|Is], D, Acc) -> - {To,Move} = case Src of - {atom,Val0} -> - To1 = shortcut_select_label(To0, Reg, Val0, D), - {To2,Val} = shortcut_boolean_label(To1, Reg, Val0, D), - {To2,{move,{atom,Val},Reg}}; - _ -> - {shortcut_label(To0, D),Move0} - end, +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}, Jump = {jump,{f,To}}, case beam_utils:is_killed_at(Reg, To, D) of false -> backward([Move|Is], D, [Jump|Acc]); @@ -301,28 +253,25 @@ backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) -> To = shortcut_bs_start_match(To0, Src, D), I = {test,bs_start_match2,{f,To},Live,Info,Dst}, backward(Is, D, [I|Acc]); -backward([{test,is_eq_exact,{f,To0},[Reg,{atom,Val}]=Ops}|Is], D, Acc) -> - To1 = shortcut_bs_test(To0, Is, D), - To = shortcut_fail_label(To1, Reg, Val, D), - I = combine_eqs(To, Ops, D, Acc), - backward(Is, D, [I|Acc]); backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) -> To1 = shortcut_bs_test(To0, Is, D), To2 = shortcut_label(To1, D), + To3 = shortcut_rel_op(To2, Op, Ops0, D), + %% Try to shortcut a repeated test: %% %% test Op {f,Fail1} Operands test Op {f,Fail2} Operands %% . . . ==> ... %% Fail1: test Op {f,Fail2} Operands Fail1: test Op {f,Fail2} Operands %% - To = case beam_utils:code_at(To2, D) of - [{test,Op,{f,To3},Ops}|_] -> + To = case beam_utils:code_at(To3, D) of + [{test,Op,{f,To4},Ops}|_] -> case equal_ops(Ops0, Ops) of - true -> To3; - false -> To2 + true -> To4; + false -> To3 end; _Code -> - To2 + To3 end, I = case Op of is_eq_exact -> combine_eqs(To, Ops0, D, Acc); @@ -367,8 +316,8 @@ equal_ops([Op|T0], [Op|T1]) -> equal_ops([], []) -> true; equal_ops(_, _) -> false. -shortcut_select_list([{_,Val}=Lit,{f,To0}|T], Reg, D, Acc) -> - To = shortcut_select_label(To0, Reg, Val, D), +shortcut_select_list([Lit,{f,To0}|T], Reg, D, Acc) -> + To = shortcut_select_label(To0, Reg, Lit, D), shortcut_select_list(T, Reg, D, [{f,To},Lit|Acc]); shortcut_select_list([], _, _, Acc) -> reverse(Acc). @@ -378,58 +327,39 @@ shortcut_label(To0, D) -> _ -> To0 end. -shortcut_select_label(To0, Reg, Val, D) -> - case beam_utils:code_at(To0, D) of - [{jump,{f,To}}|_] -> - shortcut_select_label(To, Reg, Val, D); - [{test,is_atom,_,[Reg]},{select,select_val,Reg,{f,Fail},Map}|_] -> - To = find_select_val(Map, Val, Fail), - shortcut_select_label(To, Reg, Val, D); - [{test,is_eq_exact,{f,_},[Reg,{atom,Val}]},{label,To}|_] when is_atom(Val) -> - shortcut_select_label(To, Reg, Val, D); - [{test,is_eq_exact,{f,_},[Reg,{atom,Val}]},{jump,{f,To}}|_] when is_atom(Val) -> - shortcut_select_label(To, Reg, Val, D); - [{test,is_eq_exact,{f,To},[Reg,{atom,AnotherVal}]}|_] - when is_atom(Val), Val =/= AnotherVal -> - shortcut_select_label(To, Reg, Val, D); - [{test,is_ne_exact,{f,To},[Reg,{atom,Val}]}|_] when is_atom(Val) -> - shortcut_select_label(To, Reg, Val, D); - [{test,is_ne_exact,{f,_},[Reg,{atom,_}]},{label,To}|_] when is_atom(Val) -> - shortcut_select_label(To, Reg, Val, D); - [{test,is_tuple,{f,To},[Reg]}|_] when is_atom(Val) -> - shortcut_select_label(To, Reg, Val, D); - _ -> - To0 - end. +shortcut_select_label(To, Reg, Lit, D) -> + shortcut_rel_op(To, is_ne_exact, [Reg,Lit], D). -shortcut_fail_label(To0, Reg, Val, D) -> - case beam_utils:code_at(To0, D) of - [{jump,{f,To}}|_] -> - shortcut_fail_label(To, Reg, Val, D); - [{test,is_eq_exact,{f,To},[Reg,{atom,Val}]}|_] when is_atom(Val) -> - shortcut_fail_label(To, Reg, Val, D); - _ -> - To0 - end. - -shortcut_boolean_label(To0, Reg, Bool0, D) when is_boolean(Bool0) -> +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 = not Bool0, + Bool = {atom,not Bool0}, {shortcut_select_label(To, Reg, Bool, D),Bool}; _ -> - {To0,Bool0} + {To0,Lit} end; shortcut_boolean_label(To, _, Bool, _) -> {To,Bool}. -find_select_val([{_,Val},{f,To}|_], Val, _) -> To; -find_select_val([{_,_}, {f,_}|T], Val, Fail) -> - find_select_val(T, Val, Fail); -find_select_val([], _, Fail) -> Fail. +%% Replace a comparison operator with a test instruction and a jump. +%% For example, if we have this code: +%% +%% bif '=:=' Fail Src1 Src2 {x,0} +%% jump L1 +%% . +%% . +%% . +%% L1: select_val {x,0} FailLabel [... true => L2..., ...false => L3...] +%% +%% the first two instructions can be replaced with +%% +%% test is_eq_exact L3 Src1 Src2 +%% jump L2 +%% +%% provided that {x,0} is killed at both L2 and L3. replace_comp_op(To, Reg, Op, Ops, D) -> - False = comp_op_find_shortcut(To, Reg, false, D), - True = comp_op_find_shortcut(To, Reg, true, D), + False = comp_op_find_shortcut(To, Reg, {atom,false}, D), + True = comp_op_find_shortcut(To, Reg, {atom,true}, D), [bif_to_test(Op, Ops, False),{jump,{f,True}}]. comp_op_find_shortcut(To0, Reg, Val, D) -> @@ -461,9 +391,9 @@ not_possible() -> throw(not_possible). %% %% is_eq_exact F1 Reg Lit1 select_val Reg F2 [ Lit1 L1 %% L1: . Lit2 L2 ] -%% . -%% . ==> -%% . +%% . +%% . ==> +%% . %% F1: is_eq_exact F2 Reg Lit2 F1: is_eq_exact F2 Reg Lit2 %% L2: .... L2: %% @@ -488,31 +418,26 @@ remove_from_list(Lit, [Val,{f,_}=Fail|T]) -> [Val,Fail|remove_from_list(Lit, T)]; remove_from_list(_, []) -> []. -%% shortcut_bs_test(TargetLabel, [Instruction], D) -> TargetLabel' -%% Try to shortcut the failure label for a bit syntax matching. -%% We know that the binary contains at least Bits bits after -%% the latest save point. +%% shortcut_bs_test(TargetLabel, ReversedInstructions, D) -> TargetLabel' +%% Try to shortcut the failure label for bit syntax matching. shortcut_bs_test(To, Is, D) -> shortcut_bs_test_1(beam_utils:code_at(To, D), Is, To, D). -shortcut_bs_test_1([{bs_restore2,Reg,SavePoint}|Is], PrevIs, To, D) -> - shortcut_bs_test_2(Is, {Reg,SavePoint}, PrevIs, To, D); -shortcut_bs_test_1([_|_], _, To, _) -> To. - -shortcut_bs_test_2([{label,_}|Is], Save, PrevIs, To, D) -> - shortcut_bs_test_2(Is, Save, PrevIs, To, D); -shortcut_bs_test_2([{test,bs_test_tail2,{f,To},[_,TailBits]}|_], - {Reg,_Point} = RP, PrevIs, To0, D) -> - case count_bits_matched(PrevIs, RP, 0) of +shortcut_bs_test_1([{bs_restore2,Reg,SavePoint}, + {label,_}, + {test,bs_test_tail2,{f,To},[_,TailBits]}|_], + PrevIs, To0, D) -> + case count_bits_matched(PrevIs, {Reg,SavePoint}, 0) of Bits when Bits > TailBits -> %% This instruction will fail. We know because a restore has been - %% done from the previous point SavePoint in the binary, and we also know - %% that the binary contains at least Bits bits from SavePoint. + %% done from the previous point SavePoint in the binary, and we + %% also know that the binary contains at least Bits bits from + %% SavePoint. %% %% Since we will skip a bs_restore2 if we shortcut to label To, - %% we must now make sure that code at To does not depend on the position - %% in the context in any way. + %% we must now make sure that code at To does not depend on + %% the position in the context in any way. case shortcut_bs_pos_used(To, Reg, D) of false -> To; true -> To0 @@ -520,8 +445,19 @@ shortcut_bs_test_2([{test,bs_test_tail2,{f,To},[_,TailBits]}|_], _Bits -> To0 end; -shortcut_bs_test_2([_|_], _, _, To, _) -> To. +shortcut_bs_test_1([_|_], _, To, _) -> To. +%% counts_bits_matched(ReversedInstructions, SavePoint, Bits) -> Bits' +%% Given a reversed instruction stream, determine the minimum number +%% of bits that will be matched by bit syntax instructions up to the +%% given save point. + +count_bits_matched([{test,bs_get_utf8,{f,_},_,_,_}|Is], SavePoint, Bits) -> + count_bits_matched(Is, SavePoint, Bits+8); +count_bits_matched([{test,bs_get_utf16,{f,_},_,_,_}|Is], SavePoint, Bits) -> + count_bits_matched(Is, SavePoint, Bits+16); +count_bits_matched([{test,bs_get_utf32,{f,_},_,_,_}|Is], SavePoint, Bits) -> + count_bits_matched(Is, SavePoint, Bits+32); count_bits_matched([{test,_,_,_,[_,Sz,U,{field_flags,_}],_}|Is], SavePoint, Bits) -> case Sz of {integer,N} -> count_bits_matched(Is, SavePoint, Bits+N*U); @@ -545,20 +481,332 @@ shortcut_bs_pos_used_1(Is, Reg, D) -> not beam_utils:is_killed(Reg, Is, D). %% shortcut_bs_start_match(TargetLabel, Reg) -> TargetLabel -%% A failing bs_start_match2 instruction means that the source -%% cannot be a binary, so there is no need to jump bs_context_to_binary/1 -%% or another bs_start_match2 instruction. +%% A failing bs_start_match2 instruction means that the source (Reg) +%% cannot be a binary. That means that it is safe to skip +%% bs_context_to_binary instructions operating on Reg, and +%% bs_start_match2 instructions operating on Reg. shortcut_bs_start_match(To, Reg, D) -> - shortcut_bs_start_match_1(beam_utils:code_at(To, D), Reg, To). + shortcut_bs_start_match_1(beam_utils:code_at(To, D), Reg, To, D). + +shortcut_bs_start_match_1([{bs_context_to_binary,Reg}|Is], Reg, To, D) -> + shortcut_bs_start_match_1(Is, Reg, To, D); +shortcut_bs_start_match_1([{jump,{f,To}}|_], Reg, _, D) -> + Code = beam_utils:code_at(To, D), + shortcut_bs_start_match_1(Code, Reg, To, D); +shortcut_bs_start_match_1([{test,bs_start_match2,{f,To},_,[Reg|_],_}|_], + Reg, _, D) -> + Code = beam_utils:code_at(To, D), + shortcut_bs_start_match_1(Code, Reg, To, D); +shortcut_bs_start_match_1(_, _, To, _) -> + To. -shortcut_bs_start_match_1([{bs_context_to_binary,Reg}|Is], Reg, To) -> - shortcut_bs_start_match_2(Is, Reg, To); -shortcut_bs_start_match_1(_, _, To) -> To. +%% shortcut_rel_op(FailLabel, Operator, [Operand], D) -> FailLabel' +%% Try to shortcut the given test instruction. Example: +%% +%% is_ge L1 {x,0} 48 +%% . +%% . +%% . +%% L1: is_ge L2 {x,0} 65 +%% +%% The first test instruction can be rewritten to "is_ge L2 {x,0} 48" +%% since the instruction at L1 will also fail. +%% +%% If there are instructions between L1 and the other test instruction +%% it may still be possible to do the shortcut. For example: +%% +%% L1: is_eq_exact L3 {x,0} 92 +%% is_ge L2 {x,0} 65 +%% +%% Since the first test instruction failed, we know that {x,0} must +%% be less than 48; therefore, we know that {x,0} cannot be equal to +%% 92 and the jump to L3 cannot happen. + +shortcut_rel_op(To, Op, Ops, D) -> + case normalize_op({test,Op,{f,To},Ops}) of + {{NormOp,A,B},_} -> + Normalized = {negate_op(NormOp),A,B}, + shortcut_rel_op_fp(To, Normalized, D); + {_,_} -> + To; + error -> + To + end. -shortcut_bs_start_match_2([{jump,{f,To}}|_], _, _) -> - To; -shortcut_bs_start_match_2([{test,bs_start_match2,{f,To},_,[Reg|_],_}|_], Reg, _) -> - To; -shortcut_bs_start_match_2(_Is, _Reg, To) -> - To. +shortcut_rel_op_fp(To0, Normalized, D) -> + Code = beam_utils:code_at(To0, D), + case shortcut_any_label(Code, Normalized) of + error -> + To0; + To -> + shortcut_rel_op_fp(To, Normalized, D) + end. + +%% shortcut_any_label([Instruction], PrevCondition) -> FailLabel | error +%% Using PrevCondition (a previous condition known to be true), +%% try to shortcut to another failure label. + +shortcut_any_label([{jump,{f,Lbl}}|_], _Prev) -> + Lbl; +shortcut_any_label([{label,Lbl}|_], _Prev) -> + Lbl; +shortcut_any_label([{select,select_val,R,{f,Fail},L}|_], Prev) -> + shortcut_selectval(L, R, Fail, Prev); +shortcut_any_label([I|Is], Prev) -> + case normalize_op(I) of + error -> + error; + {Normalized,Fail} -> + %% We have a relational operator. + case will_succeed(Prev, Normalized) of + no -> + %% This test instruction will always branch + %% to Fail. + Fail; + yes -> + %% This test instruction will never branch, + %% so we will look at the next instruction. + shortcut_any_label(Is, Prev); + maybe -> + %% May or may not branch. From now on, we can only + %% shortcut to the this specific failure label + %% Fail. + shortcut_specific_label(Is, Fail, Prev) + end + end. + +%% shortcut_specific_label([Instruction], FailLabel, PrevCondition) -> +%% FailLabel | error +%% We have previously encountered a test instruction that may or +%% may not branch to FailLabel. Therefore we are only allowed +%% to do the shortcut to the same fail label (FailLabel). + +shortcut_specific_label([{label,_}|Is], Fail, Prev) -> + shortcut_specific_label(Is, Fail, Prev); +shortcut_specific_label([{select,select_val,R,{f,F},L}|_], Fail, Prev) -> + case shortcut_selectval(L, R, F, Prev) of + Fail -> Fail; + _ -> error + end; +shortcut_specific_label([I|Is], Fail, Prev) -> + case normalize_op(I) of + error -> + error; + {Normalized,Fail} -> + case will_succeed(Prev, Normalized) of + no -> + %% Will branch to FailLabel. + Fail; + yes -> + %% Will definitely never branch. + shortcut_specific_label(Is, Fail, Prev); + maybe -> + %% May branch, but still OK since it will branch + %% to FailLabel. + shortcut_specific_label(Is, Fail, Prev) + end; + {Normalized,_} -> + %% This test instruction will branch to a different + %% fail label, if it branches at all. + case will_succeed(Prev, Normalized) of + yes -> + %% Still OK, since the branch will never be + %% taken. + shortcut_specific_label(Is, Fail, Prev); + no -> + %% Give up. The branch will definitely be taken + %% to a different fail label. + error; + maybe -> + %% Give up. If the branch is taken, it will be + %% to a different fail label. + error + end + end. + + +%% shortcut_selectval(List, Reg, Fail, PrevCond) -> FailLabel | error +%% Try to shortcut a selectval instruction. A selectval instruction +%% is equivalent to the following instruction sequence: +%% +%% is_ne_exact L1 Reg Value1 +%% . +%% . +%% . +%% is_ne_exact LN Reg ValueN +%% jump DefaultFailLabel +%% +shortcut_selectval([Val,{f,Lbl}|T], R, Fail, Prev) -> + case will_succeed(Prev, {'=/=',R,get_literal(Val)}) of + yes -> shortcut_selectval(T, R, Fail, Prev); + no -> Lbl; + maybe -> error + end; +shortcut_selectval([], _, Fail, _) -> Fail. + +%% will_succeed(PrevCondition, Condition) -> yes | no | maybe +%% PrevCondition is a condition known to be true. This function +%% will tell whether Condition will succeed. + +will_succeed({Op1,Reg,A}, {Op2,Reg,B}) -> + will_succeed_1(Op1, A, Op2, B); +will_succeed({'=:=',Reg,{literal,A}}, {TypeTest,Reg}) -> + case erlang:TypeTest(A) of + false -> no; + true -> yes + end; +will_succeed({_,_,_}, maybe) -> + maybe; +will_succeed({_,_,_}, Test) when is_tuple(Test) -> + maybe. + +will_succeed_1('=:=', A, '<', B) -> + if + B =< A -> no; + true -> yes + end; +will_succeed_1('=:=', A, '=<', B) -> + if + B < A -> no; + true -> yes + end; +will_succeed_1('=:=', A, '=:=', B) -> + if + A =:= B -> yes; + true -> no + end; +will_succeed_1('=:=', A, '=/=', B) -> + if + A =:= B -> no; + true -> yes + end; +will_succeed_1('=:=', A, '>=', B) -> + if + B > A -> no; + true -> yes + end; +will_succeed_1('=:=', A, '>', B) -> + if + B >= A -> no; + true -> yes + end; + +will_succeed_1('=/=', A, '=/=', B) when A =:= B -> yes; +will_succeed_1('=/=', A, '=:=', B) when A =:= B -> no; + +will_succeed_1('<', A, '=:=', B) when B >= A -> no; +will_succeed_1('<', A, '=/=', B) when B >= A -> yes; +will_succeed_1('<', A, '<', B) when B >= A -> yes; +will_succeed_1('<', A, '=<', B) when B > A -> yes; +will_succeed_1('<', A, '>=', B) when B > A -> no; +will_succeed_1('<', A, '>', B) when B >= A -> no; + +will_succeed_1('=<', A, '=:=', B) when B > A -> no; +will_succeed_1('=<', A, '=/=', B) when B > A -> yes; +will_succeed_1('=<', A, '<', B) when B > A -> yes; +will_succeed_1('=<', A, '=<', B) when B >= A -> yes; +will_succeed_1('=<', A, '>=', B) when B > A -> no; +will_succeed_1('=<', A, '>', B) when B >= A -> no; + +will_succeed_1('>=', A, '=:=', B) when B < A -> no; +will_succeed_1('>=', A, '=/=', B) when B < A -> yes; +will_succeed_1('>=', A, '<', B) when B =< A -> no; +will_succeed_1('>=', A, '=<', B) when B < A -> no; +will_succeed_1('>=', A, '>=', B) when B =< A -> yes; +will_succeed_1('>=', A, '>', B) when B < A -> yes; + +will_succeed_1('>', A, '=:=', B) when B =< A -> no; +will_succeed_1('>', A, '=/=', B) when B =< A -> yes; +will_succeed_1('>', A, '<', B) when B =< A -> no; +will_succeed_1('>', A, '=<', B) when B < A -> no; +will_succeed_1('>', A, '>=', B) when B =< A -> yes; +will_succeed_1('>', A, '>', B) when B < A -> yes; + +will_succeed_1(_, _, _, _) -> maybe. + +%% normalize_op(Instruction) -> {Normalized,FailLabel} | error +%% Normalized = {Operator,Register,Literal} | +%% {TypeTest,Register} | +%% maybe +%% Operation = '<' | '=<' | '=:=' | '=/=' | '>=' | '>' +%% TypeTest = is_atom | is_integer ... +%% Literal = {literal,Term} +%% +%% Normalize a relational operator to facilitate further +%% comparisons between operators. Always make the register +%% operand the first operand. Thus the following instruction: +%% +%% {test,is_ge,{f,99},{integer,13},{x,0}} +%% +%% will be normalized to: +%% +%% {'=<',{x,0},{literal,13}} +%% +%% NOTE: Bit syntax test instructions are scary. They may change the +%% state of match contexts and update registers, so we don't dare +%% mess with them. + +normalize_op({test,is_ge,{f,Fail},Ops}) -> + normalize_op_1('>=', Ops, Fail); +normalize_op({test,is_lt,{f,Fail},Ops}) -> + normalize_op_1('<', Ops, Fail); +normalize_op({test,is_eq_exact,{f,Fail},Ops}) -> + normalize_op_1('=:=', Ops, Fail); +normalize_op({test,is_ne_exact,{f,Fail},Ops}) -> + normalize_op_1('=/=', Ops, Fail); +normalize_op({test,is_nil,{f,Fail},[R]}) -> + normalize_op_1('=:=', [R,nil], Fail); +normalize_op({test,Op,{f,Fail},[R]}) -> + case erl_internal:new_type_test(Op, 1) of + true -> {{Op,R},Fail}; + false -> {maybe,Fail} + end; +normalize_op({test,_,{f,Fail},_}=I) -> + case beam_utils:is_pure_test(I) of + true -> {maybe,Fail}; + false -> error + end; +normalize_op(_) -> + error. + +normalize_op_1(Op, [Op1,Op2], Fail) -> + case {get_literal(Op1),get_literal(Op2)} of + {error,error} -> + %% Both operands are registers. + {maybe,Fail}; + {error,Lit} -> + {{Op,Op1,Lit},Fail}; + {Lit,error} -> + {{turn_op(Op),Op2,Lit},Fail}; + {_,_} -> + %% Both operands are literals. Can probably only + %% happen if the Core Erlang optimizations passes were + %% turned off, so don't bother trying to do something + %% smart here. + {maybe,Fail} + end. + +turn_op('<') -> '>'; +turn_op('>=') -> '=<'; +turn_op('=:='=Op) -> Op; +turn_op('=/='=Op) -> Op. + +negate_op('>=') -> '<'; +negate_op('<') -> '>='; +negate_op('=<') -> '>'; +negate_op('>') -> '=<'; +negate_op('=:=') -> '=/='; +negate_op('=/=') -> '=:='. + +get_literal({atom,Val}) -> + {literal,Val}; +get_literal({integer,Val}) -> + {literal,Val}; +get_literal({float,Val}) -> + {literal,Val}; +get_literal(nil) -> + {literal,[]}; +get_literal({literal,_}=Lit) -> + Lit; +get_literal({_,_}) -> error. diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 46835bece1..54e06df995 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -63,8 +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,Gets,[S],{get_map_elements,F}}) -> - {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..4e699c4fbf 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -435,14 +435,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 +452,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_split.erl b/lib/compiler/src/beam_split.erl index 688bba9a94..0c62b0bf3d 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -53,8 +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,Gets,[S],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc) - when Lbl =/= 0 -> +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 58c0f765ae..d9713cef0d 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -106,6 +106,20 @@ simplify_basic_1([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Acc) -> Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]) end; +simplify_basic_1([{test,is_map,_,[R]}=I|Is], Ts0, Acc) -> + case tdb_find(R, Ts0) of + map -> simplify_basic_1(Is, Ts0, Acc); + _Other -> + Ts = update(I, Ts0), + simplify_basic_1(Is, Ts, [I|Acc]) + end; +simplify_basic_1([{test,is_nonempty_list,_,[R]}=I|Is], Ts0, Acc) -> + case tdb_find(R, Ts0) of + nonempty_list -> simplify_basic_1(Is, Ts0, Acc); + _Other -> + Ts = update(I, Ts0), + simplify_basic_1(Is, Ts, [I|Acc]) + end; simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) -> Acc = case tdb_find(R, Ts0) of {atom,_}=Atom -> Acc0; @@ -402,6 +416,10 @@ update({test,is_float,_Fail,[Src]}, Ts0) -> tdb_update([{Src,float}], Ts0); update({test,test_arity,_Fail,[Src,Arity]}, Ts0) -> tdb_update([{Src,{tuple,Arity,[]}}], Ts0); +update({test,is_map,_Fail,[Src]}, Ts0) -> + tdb_update([{Src,map}], Ts0); +update({test,is_nonempty_list,_Fail,[Src]}, Ts0) -> + tdb_update([{Src,nonempty_list}], Ts0); update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) -> case tdb_find(Reg, Ts) of error -> @@ -451,6 +469,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; @@ -710,6 +729,8 @@ merge_type_info(NewType, _) -> verify_type(NewType), NewType. +verify_type(map) -> ok; +verify_type(nonempty_list) -> ok; verify_type({tuple,Sz,[]}) when is_integer(Sz) -> ok; verify_type({tuple,Sz,[_]}) when is_integer(Sz) -> ok; verify_type({tuple_element,_,_}) -> ok; diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 8ca368c167..26020e1d29 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -26,6 +26,8 @@ code_at/2,bif_to_test/3,is_pure_test/1, live_opt/1,delete_live_annos/1,combine_heap_needs/2]). +-export([join_even/2,split_even/1]). + -import(lists, [member/2,sort/1,reverse/1,splitwith/2]). -record(live, @@ -756,13 +758,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) -> @@ -832,3 +830,15 @@ x_live([_|Rs], Regs) -> x_live(Rs, Regs); x_live([], Regs) -> Regs. is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1. + +%% split_even/1 +%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]} +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]). + +%% join_even/1 +%% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6] +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 9d5563d13b..c156cf79fe 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1123,7 +1123,9 @@ assert_freg_set(Fr, _) -> error({bad_source,Fr}). %%% Maps %% ensure that a list of literals has a strict -%% ascending term order (also meaning unique literals) +%% ascending term order (also meaning unique literals). +%% Single item lists may have registers. +assert_strict_literal_termorder([_]) -> ok; assert_strict_literal_termorder(Ls) -> Vs = lists:map(fun (L) -> get_literal(L) end, Ls), case check_strict_value_termorder(Vs) of @@ -1816,6 +1818,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,[]}; 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 9d6768b157..1a2957ee31 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -123,11 +123,13 @@ bitstr_flags/1, %% keep map exports here for now + c_map_pattern/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, @@ -1590,7 +1592,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 +1610,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 +1644,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. @@ -3063,10 +3063,12 @@ pat_vars(Node, Vs) -> map -> pat_list_vars(map_es(Node), Vs); map_pair -> - pat_list_vars([map_pair_op(Node),map_pair_key(Node),map_pair_val(Node)],Vs); + %% map_pair_key is not a pattern var, excluded + pat_list_vars([map_pair_op(Node),map_pair_val(Node)],Vs); binary -> pat_list_vars(binary_segments(Node), Vs); bitstr -> + %% bitstr_size is not a pattern var, excluded pat_vars(bitstr_val(Node), Vs); alias -> pat_vars(alias_pat(Node), [alias_var(Node) | Vs]) diff --git a/lib/compiler/src/cerl_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_inline.erl b/lib/compiler/src/cerl_inline.erl index 75740e8b9d..f8489a800b 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -1341,23 +1341,23 @@ i_bitstr(E, Ren, Env, S) -> S3 = count_size(weight(bitstr), S2), {update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}. -i_map(E, Ctx, Ren, Env, S) -> +i_map(E, Ctx, Ren, Env, S0) -> %% Visit the segments for value. - {M1, S1} = i(map_arg(E), value, Ren, Env, S), + {M1, S1} = i(map_arg(E), value, Ren, Env, S0), {Es, S2} = mapfoldl(fun (E, S) -> i_map_pair(E, Ctx, Ren, Env, S) end, S1, map_es(E)), S3 = count_size(weight(map), S2), {update_c_map(E, M1,Es), S3}. -i_map_pair(E, Ctx, Ren, Env, S) -> - %% It is not necessary to visit the Op and Key fields, - %% since these are always literals. - {Val, S1} = i(map_pair_val(E), Ctx, Ren, Env, S), +i_map_pair(E, Ctx, Ren, Env, S0) -> + %% It is not necessary to visit the Op field + %% since it is always a literal. + {Key, S1} = i(map_pair_key(E), value, Ren, Env, S0), + {Val, S2} = i(map_pair_val(E), Ctx, Ren, Env, S1), Op = map_pair_op(E), - Key = map_pair_key(E), - S2 = count_size(weight(map_pair), S1), - {update_c_map_pair(E, Op, Key, Val), S2}. + S3 = count_size(weight(map_pair), S2), + {update_c_map_pair(E, Op, Key, Val), S3}. %% This is a simplified version of `i_pattern', for lists of parameter @@ -1420,15 +1420,11 @@ i_pattern(E, Ren, Env, Ren0, Env0, S) -> S2 = count_size(weight(binary), S1), {update_c_binary(E, Es), S2}; map -> - %% map patterns should not have args - M = map_arg(E), - {Es, S1} = mapfoldl(fun (E, S) -> i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) - end, - S, map_es(E)), + end, S, map_es(E)), S2 = count_size(weight(map), S1), - {update_c_map(E, M, Es), S2}; + {update_c_map(E, map_arg(E), Es), S2}; _ -> case is_literal(E) of true -> @@ -1464,12 +1460,12 @@ i_bitstr_pattern(E, Ren, Env, Ren0, Env0, S) -> i_map_pair_pattern(E, Ren, Env, Ren0, Env0, S) -> %% It is not necessary to visit the Op it is always a literal. - %% Same goes for Key - {Val, S1} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S), + %% Key is an expression + {Key, S1} = i(map_pair_key(E), value, Ren0, Env0, S), + {Val, S2} = i_pattern(map_pair_val(E), Ren, Env, Ren0, Env0, S1), Op = map_pair_op(E), %% should be 'exact' literal - Key = map_pair_key(E), - S2 = count_size(weight(map_pair), S1), - {update_c_map_pair(E, Op, Key, Val), S2}. + S3 = count_size(weight(map_pair), S2), + {update_c_map_pair(E, Op, Key, Val), S3}. %% --------------------------------------------------------------------- diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index e53bdd4efb..b93da8e97f 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -520,9 +520,9 @@ variables(T, S) -> tuple -> vars_in_list(tuple_es(T), S); map -> - vars_in_list(map_es(T), S); + vars_in_list([map_arg(T)|map_es(T)], S); map_pair -> - vars_in_list([map_pair_op(T),map_pair_key(T), map_pair_val(T)], S); + vars_in_list([map_pair_op(T),map_pair_key(T),map_pair_val(T)], S); 'let' -> Vs = variables(let_body(T), S), Vs1 = var_list_names(let_vars(T)), diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index c7d91070f6..f347438509 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -431,11 +431,6 @@ pass(from_core) -> {".core",[?pass(parse_core)|core_passes()]}; pass(from_asm) -> {".S",[?pass(beam_consult_asm)|asm_passes()]}; -pass(asm) -> - %% TODO: remove 'asm' in 18.0 - io:format("compile:file/2 option 'asm' has been deprecated and will be~n" - "removed in the 18.0 release. Use 'from_asm' instead.~n"), - pass(from_asm); pass(from_beam) -> {".beam",[?pass(read_beam_file)|binary_passes()]}; pass(_) -> none. diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index 0d95971f91..730e3a5317 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -236,10 +236,15 @@ vu_pat_seg_list(V, Ss, St) -> end end, St, Ss). -vu_map_pairs(V, [#c_map_pair{val=Pat}|T], St0) -> - case vu_pattern(V, Pat, St0) of - {true,_}=St -> St; - St -> vu_map_pairs(V, T, St) +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. diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index 25df33a287..c0e2bdaba0 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -33,9 +33,6 @@ %% Values only as multiple values/variables/patterns. %% Return same number of values as requested %% Correct number of arguments -%% -%% Checks to add: -%% %% Consistency of values/variables %% Consistency of function return values/calls. %% @@ -211,7 +208,7 @@ functions(Fs, Def, St0) -> function({#c_var{name={_,_}},B}, Def, St) -> %% Body must be a fun! case B of - #c_fun{} -> expr(B, Def, any, St); + #c_fun{} -> expr(B, Def, 1, St); _ -> add_error({illegal_expr,St#lint.func}, St) end. @@ -247,40 +244,42 @@ gbody(E, Def, Rt, St0) -> false -> St1 end. -gexpr(#c_var{name=N}, Def, _Rt, St) when is_atom(N); is_integer(N) -> - expr_var(N, Def, St); -gexpr(#c_literal{}, _Def, _Rt, St) -> St; -gexpr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> - gexpr_list([H,T], Def, St); -gexpr(#c_tuple{es=Es}, Def, _Rt, St) -> - gexpr_list(Es, Def, St); -gexpr(#c_map{es=Es}, Def, _Rt, St) -> - gexpr_list(Es, Def, St); -gexpr(#c_map_pair{key=K,val=V}, Def, _Rt, St) -> - gexpr_list([K,V], Def, St); -gexpr(#c_binary{segments=Ss}, Def, _Rt, St) -> - gbitstr_list(Ss, Def, St); +gexpr(#c_var{name=N}, Def, Rt, St) when is_atom(N); is_integer(N) -> + return_match(Rt, 1, expr_var(N, Def, St)); +gexpr(#c_literal{}, _Def, Rt, St) -> + return_match(Rt, 1, St); +gexpr(#c_cons{hd=H,tl=T}, Def, Rt, St) -> + return_match(Rt, 1, gexpr_list([H,T], Def, St)); +gexpr(#c_tuple{es=Es}, Def, Rt, St) -> + return_match(Rt, 1, gexpr_list(Es, Def, St)); +gexpr(#c_map{es=Es}, Def, Rt, St) -> + return_match(Rt, 1, gexpr_list(Es, Def, St)); +gexpr(#c_map_pair{key=K,val=V}, Def, Rt, St) -> + return_match(Rt, 1, gexpr_list([K,V], Def, St)); +gexpr(#c_binary{segments=Ss}, Def, Rt, St) -> + return_match(Rt, 1, gbitstr_list(Ss, Def, St)); gexpr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) -> - St1 = gexpr(Arg, Def, any, St0), %Ignore values - gbody(B, Def, Rt, St1); + St1 = gexpr(Arg, Def, 1, St0), + return_match(Rt, 1, gbody(B, Def, Rt, St1)); gexpr(#c_let{vars=Vs,arg=Arg,body=B}, Def, Rt, St0) -> St1 = gbody(Arg, Def, let_varcount(Vs), St0), %This is a guard body {Lvs,St2} = variable_list(Vs, St1), gbody(B, union(Lvs, Def), Rt, St2); gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}, args=[Arg,#c_literal{val=Tag},#c_literal{val=Size}]}, - Def, 1, St) when is_atom(Tag), is_integer(Size) -> - gexpr(Arg, Def, 1, St); + Def, Rt, St) when is_atom(Tag), is_integer(Size) -> + return_match(Rt, 1, gexpr(Arg, Def, 1, St)); gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=is_record}}, - _Def, 1, St) -> - add_error({illegal_guard,St#lint.func}, St); + _Def, Rt, St) -> + return_match(Rt, 1, add_error({illegal_guard,St#lint.func}, St)); gexpr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As}, - Def, 1, St) when is_atom(Name) -> + Def, Rt, St0) when is_atom(Name) -> + St1 = return_match(Rt, 1, St0), case is_guard_bif(Name, length(As)) of true -> - gexpr_list(As, Def, St); + gexpr_list(As, Def, St1); false -> - add_error({illegal_guard,St#lint.func}, St) + add_error({illegal_guard,St1#lint.func}, St1) end; gexpr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) -> gexpr_list(As, Def, St0); @@ -319,23 +318,25 @@ is_guard_bif(Name, Arity) -> %% expr(Expr, Defined, RetCount, State) -> State. -expr(#c_var{name={_,_}=FA}, Def, _Rt, St) -> - expr_fname(FA, Def, St); -expr(#c_var{name=N}, Def, _Rt, St) -> expr_var(N, Def, St); -expr(#c_literal{}, _Def, _Rt, St) -> St; -expr(#c_cons{hd=H,tl=T}, Def, _Rt, St) -> - expr_list([H,T], Def, St); -expr(#c_tuple{es=Es}, Def, _Rt, St) -> - expr_list(Es, Def, St); -expr(#c_map{es=Es}, Def, _Rt, St) -> - expr_list(Es, Def, St); -expr(#c_map_pair{key=K,val=V},Def,_Rt,St) -> - expr_list([K,V],Def,St); -expr(#c_binary{segments=Ss}, Def, _Rt, St) -> - bitstr_list(Ss, Def, St); +expr(#c_var{name={_,_}=FA}, Def, Rt, St) -> + return_match(Rt, 1, expr_fname(FA, Def, St)); +expr(#c_var{name=N}, Def, Rt, St) -> + return_match(Rt, 1, expr_var(N, Def, St)); +expr(#c_literal{}, _Def, Rt, St) -> + return_match(Rt, 1, St); +expr(#c_cons{hd=H,tl=T}, Def, Rt, St) -> + return_match(Rt, 1, expr_list([H,T], Def, St)); +expr(#c_tuple{es=Es}, Def, Rt, St) -> + return_match(Rt, 1, expr_list(Es, Def, St)); +expr(#c_map{es=Es}, Def, Rt, St) -> + return_match(Rt, 1, expr_list(Es, Def, St)); +expr(#c_map_pair{key=K,val=V}, Def, Rt, St) -> + return_match(Rt, 1, expr_list([K,V], Def, St)); +expr(#c_binary{segments=Ss}, Def, Rt, St) -> + return_match(Rt, 1, bitstr_list(Ss, Def, St)); expr(#c_fun{vars=Vs,body=B}, Def, Rt, St0) -> {Vvs,St1} = variable_list(Vs, St0), - return_match(Rt, 1, body(B, union(Vvs, Def), any, St1)); + return_match(Rt, 1, body(B, union(Vvs, Def), 1, St1)); expr(#c_seq{arg=Arg,body=B}, Def, Rt, St0) -> St1 = expr(Arg, Def, 1, St0), body(B, Def, Rt, St1); @@ -361,15 +362,26 @@ expr(#c_receive{clauses=Cs,timeout=T,action=A}, Def, Rt, St0) -> St1 = expr(T, Def, 1, St0), St2 = body(A, Def, Rt, St1), clauses(Cs, Def, 1, Rt, St2); -expr(#c_apply{op=Op,args=As}, Def, _Rt, St0) -> +expr(#c_apply{op=Op,args=As}, Def, Rt, St0) -> St1 = apply_op(Op, Def, length(As), St0), - expr_list(As, Def, St1); + return_match(Rt, 1, expr_list(As, Def, St1)); +expr(#c_call{module=#c_literal{val=erlang},name=#c_literal{val=Name},args=As}, + Def, Rt, St0) when is_atom(Name) -> + St1 = expr_list(As, Def, St0), + case erl_bifs:is_exit_bif(erlang, Name, length(As)) of + true -> St1; + false -> return_match(Rt, 1, St1) + end; expr(#c_call{module=M,name=N,args=As}, Def, _Rt, St0) -> St1 = expr(M, Def, 1, St0), St2 = expr(N, Def, 1, St1), expr_list(As, Def, St2); -expr(#c_primop{name=#c_literal{val=A},args=As}, Def, _Rt, St0) when is_atom(A) -> - expr_list(As, Def, St0); +expr(#c_primop{name=#c_literal{val=A},args=As}, Def, Rt, St0) when is_atom(A) -> + St1 = expr_list(As, Def, St0), + case A of + match_fail -> St1; + _ -> return_match(Rt, 1, St1) + end; expr(#c_catch{body=B}, Def, Rt, St) -> return_match(Rt, 1, body(B, Def, 1, St)); expr(#c_try{arg=A,vars=Vs,body=B,evars=Evs,handler=H}, Def, Rt, St0) -> diff --git a/lib/compiler/src/core_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..849f801a11 100644 --- a/lib/compiler/src/core_parse.yrl +++ b/lib/compiler/src/core_parse.yrl @@ -182,23 +182,23 @@ 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 '>' : +map_pair_pattern -> '~' '<' anno_expression ',' anno_pattern '>' : #c_map_pair{op=#c_literal{val=exact},key='$3',val='$5'}. 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 +206,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}; @@ -279,15 +279,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']. @@ -307,7 +307,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']. @@ -410,9 +410,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 83412ecdd7..01922c3fdf 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -125,8 +125,8 @@ format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) -> _ -> assoc end, Cpairs = [#c_map_pair{op=#c_literal{val=Op}, - key=#c_literal{val=V}, - val=#c_literal{val=K}} || {K,V} <- Pairs], + key=#c_literal{val=K}, + val=#c_literal{val=V}} || {K,V} <- Pairs], format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt); format_1(#c_var{name={I,A}}, _) -> [core_atom(I),$/,integer_to_list(A)]; @@ -184,12 +184,12 @@ 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) -> @@ -448,6 +448,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(K, V, Ctxt0) -> + Ctxt1 = add_indent(Ctxt0, 1), + Txt = format(K, set_class(Ctxt1, expr)), + Ctxt2 = add_indent(Ctxt0, width(Txt, Ctxt1)), + [Txt,",",format(V, Ctxt2)]. + indent(Ctxt) -> indent(Ctxt#ctxt.indent, Ctxt). indent(N, _) when N =< 0 -> ""; 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..ba46adfbc6 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -313,7 +313,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 @@ -607,14 +607,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). @@ -1378,7 +1370,6 @@ eval_is_record(Call, _, _, _, _) -> Call. is_not_integer(#c_literal{val=Val}) when not is_integer(Val) -> true; is_not_integer(#c_tuple{}) -> true; is_not_integer(#c_cons{}) -> true; -is_not_integer(#c_map{}) -> true; is_not_integer(_) -> false. %% is_not_tuple(Core) -> true | false. @@ -1386,7 +1377,6 @@ is_not_integer(_) -> false. is_not_tuple(#c_literal{val=Val}) when not is_tuple(Val) -> true; is_not_tuple(#c_cons{}) -> true; -is_not_tuple(#c_map{}) -> true; is_not_tuple(_) -> false. %% eval_setelement(Call, Pos, Tuple, NewVal) -> Core. diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 761ae8409c..f99307c865 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2012. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -33,12 +33,15 @@ -include("../include/erl_bits.hrl"). +-type fa() :: {atom(), arity()}. + -record(expand, {module=[], %Module name exports=[], %Exports imports=[], %Imports compile=[], %Compile flags attributes=[], %Attributes callbacks=[], %Callbacks + optional_callbacks=[] :: [fa()], %Optional callbacks defined, %Defined functions (gb_set) vcount=0, %Variable counter func=[], %Current function @@ -99,7 +102,21 @@ define_functions(Forms, #expand{defined=Predef}=St) -> module_attrs(#expand{attributes=Attributes}=St) -> Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes], Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs], - {Attrs,St#expand{callbacks=Callbacks}}. + OptionalCallbacks = get_optional_callbacks(Attrs), + {Attrs,St#expand{callbacks=Callbacks, + optional_callbacks=OptionalCallbacks}}. + +get_optional_callbacks(Attrs) -> + L = [O || + {attribute, _, optional_callbacks, O} <- Attrs, + is_fa_list(O)], + lists:append(L). + +is_fa_list([{FuncName, Arity}|L]) + when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> + is_fa_list(L); +is_fa_list([]) -> true; +is_fa_list(_) -> false. module_predef_funcs(St) -> {Mpf1,St1}=module_predef_func_beh_info(St), @@ -108,19 +125,24 @@ module_predef_funcs(St) -> module_predef_func_beh_info(#expand{callbacks=[]}=St) -> {[], St}; -module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined, +module_predef_func_beh_info(#expand{callbacks=Callbacks, + optional_callbacks=OptionalCallbacks, + defined=Defined, exports=Exports}=St) -> PreDef=[{behaviour_info,1}], PreExp=PreDef, - {[gen_beh_info(Callbacks)], + {[gen_beh_info(Callbacks, OptionalCallbacks)], St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined), exports=union(from_list(PreExp), Exports)}}. -gen_beh_info(Callbacks) -> +gen_beh_info(Callbacks, OptionalCallbacks) -> List = make_list(Callbacks), + OptionalList = make_optional_list(OptionalCallbacks), {function,0,behaviour_info,1, [{clause,0,[{atom,0,callbacks}],[], - [List]}]}. + [List]}, + {clause,0,[{atom,0,optional_callbacks}],[], + [OptionalList]}]}. make_list([]) -> {nil,0}; make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> @@ -130,6 +152,14 @@ make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) -> {integer,0,Arity}]}, make_list(Rest)}. +make_optional_list([]) -> {nil,0}; +make_optional_list([{Name,Arity}|Rest]) -> + {cons,0, + {tuple,0, + [{atom,0,Name}, + {integer,0,Arity}]}, + make_optional_list(Rest)}. + module_predef_funcs_mod_info(St) -> PreDef = [{module_info,0},{module_info,1}], PreExp = PreDef, @@ -232,9 +262,18 @@ pattern({map,Line,Ps}, St0) -> {TPs,St1} = pattern_list(Ps, St0), {{map,Line,TPs},St1}; pattern({map_field_exact,Line,K0,V0}, St0) -> - {K,St1} = expr(K0, St0), + %% Key should be treated as an expression + %% but since expressions are not allowed yet, + %% process it through pattern .. and handle assoc + %% (normalise unary op integer -> integer) + {K,St1} = pattern(K0, St0), {V,St2} = pattern(V0, St1), {{map_field_exact,Line,K,V},St2}; +pattern({map_field_assoc,Line,K0,V0}, St0) -> + %% when keys are Maps + {K,St1} = pattern(K0, St0), + {V,St2} = pattern(V0, St1), + {{map_field_assoc,Line,K,V},St2}; %%pattern({struct,Line,Tag,Ps}, St0) -> %% {TPs,TPsvs,St1} = pattern_list(Ps, St0), %% {{tuple,Line,[{atom,Line,Tag}|TPs]},TPsvs,St1}; diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 47a357c23d..8c1a0c08ac 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -210,7 +210,7 @@ need_heap_0([], H, Acc) -> need_heap_1(#l{ke={set,_,{binary,_}},i=I}, H) -> {need_heap_need(I, H),0}; -need_heap_1(#l{ke={set,_,{map,_,_}},i=I}, H) -> +need_heap_1(#l{ke={set,_,{map,_,_,_}},i=I}, H) -> {need_heap_need(I, H),0}; need_heap_1(#l{ke={set,_,Val}}, H) -> %% Just pass through adding to needed heap. @@ -643,10 +643,6 @@ select_val_cg(tuple, R, [Arity,{f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> [{test,is_tuple,{f,Tf},[R]},{test,test_arity,{f,Vf},[R,Arity]}|Sis]; select_val_cg(tuple, R, Vls, Tf, Vf, Sis) -> [{test,is_tuple,{f,Tf},[R]},{select_tuple_arity,R,{f,Vf},{list,Vls}}|Sis]; -select_val_cg(map, R, [_Val,{f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> - [{test,is_map,{f,Fail},[R]}|Sis]; -select_val_cg(map, R, [_Val,{f,Lbl}|_], Tf, _Vf, [{label,Lbl}|Sis]) -> - [{test,is_map,{f,Tf},[R]}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Fail, Fail, [{label,Lbl}|Sis]) -> [{test,is_eq_exact,{f,Fail},[R,{Type,Val}]}|Sis]; select_val_cg(Type, R, [Val, {f,Lbl}], Tf, Vf, [{label,Lbl}|Sis]) -> @@ -947,27 +943,34 @@ select_extract_map(Src, Vs, Fail, I, Vdb, Bef, St) -> %% Assume keys are term-sorted Rsrc = fetch_var(Src, Bef), - {{HasKs,GetVs},Aft} = lists:foldr(fun - ({map_pair,Key,{var,V}},{{HasKsi,GetVsi},Int0}) -> + {{HasKs,GetVs,HasVarKs,GetVarVs},Aft} = lists:foldr(fun + ({map_pair,{var,K},{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> case vdb_find(V, Vdb) of {V,_,L} when L =< I -> - {{[Key|HasKsi],GetVsi},Int0}; + RK = fetch_var(K,Int0), + {{HasKsi,GetVsi,[RK|HasVarVsi],GetVarVsi},Int0}; _Other -> Reg1 = put_reg(V, Int0#sr.reg), Int1 = Int0#sr{reg=Reg1}, - {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi]},Int1} + RK = fetch_var(K,Int0), + RV = fetch_reg(V,Reg1), + {{HasKsi,GetVsi,HasVarVsi,[[RK,RV]|GetVarVsi]},Int1} + end; + ({map_pair,Key,{var,V}},{{HasKsi,GetVsi,HasVarVsi,GetVarVsi},Int0}) -> + case vdb_find(V, Vdb) of + {V,_,L} when L =< I -> + {{[Key|HasKsi],GetVsi,HasVarVsi,GetVarVsi},Int0}; + _Other -> + Reg1 = put_reg(V, Int0#sr.reg), + Int1 = Int0#sr{reg=Reg1}, + {{HasKsi,[Key,fetch_reg(V, Reg1)|GetVsi],HasVarVsi,GetVarVsi},Int1} end - end, {{[],[]},Bef}, Vs), - - Code = case {HasKs,GetVs} of - {HasKs,[]} -> - [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}]; - {[],GetVs} -> - [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}}]; - {HasKs,GetVs} -> - [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}}, - {get_map_elements, {f,Fail},Rsrc,{list,GetVs}}] - end, + end, {{[],[],[],[]},Bef}, Vs), + + Code = [{test,has_map_fields,{f,Fail},Rsrc,{list,HasKs}} || HasKs =/= []] ++ + [{test,has_map_fields,{f,Fail},Rsrc,{list,[K]}} || K <- HasVarKs] ++ + [{get_map_elements, {f,Fail},Rsrc,{list,GetVs}} || GetVs =/= []] ++ + [{get_map_elements, {f,Fail},Rsrc,{list,[K,V]}} || [K,V] <- GetVarVs], {Code, Aft, St}. @@ -1504,9 +1507,39 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, %% Now generate the complete code for constructing the binary. Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a), {Sis++Code,Aft,St}; +% Map single variable key +set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, + #cg{in_catch=InCatch,bfail=Bfail}=St) -> + + Fail = {f,Bfail}, + {Sis,Int0} = + case InCatch of + true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); + false -> {[],Bef} + end, + SrcReg = cg_reg_arg(Map,Int0), + Line = line(Le#l.a), + + List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)], + + Live = max_reg(Bef#sr.reg), + Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, + Aft = clear_dead(Int1, Le#l.i, Vdb), + Target = fetch_reg(R, Int1#sr.reg), + + I = case Op of + assoc -> put_map_assoc; + exact -> put_map_exact + end, + {Sis++[Line]++[{I,Fail,SrcReg,Target,Live,{list,List}}],Aft,St}; + +% Map (possibly) multiple literal keys set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, #cg{in_catch=InCatch,bfail=Bfail}=St) -> + %% assert key literals + [] = [Var||{map_pair,{var,_}=Var,_} <- Es], + Fail = {f,Bfail}, {Sis,Int0} = case InCatch of diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 59ec0d4199..a9b54005d1 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -78,7 +78,7 @@ -import(ordsets, [add_element/2,del_element/2,is_element/2, union/1,union/2,intersection/2,subtract/2]). -import(cerl, [ann_c_cons/3,ann_c_cons_skel/3,ann_c_tuple/2,c_tuple/1, - ann_c_map/2, ann_c_map/3]). + ann_c_map/3]). -include("core_parse.hrl"). @@ -105,7 +105,8 @@ -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}). -type iapply() :: #iapply{}. -type ibinary() :: #ibinary{}. @@ -169,60 +170,81 @@ form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) -> attribute({attribute,Line,Name,Val}) -> {#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}. +%% function_dump(module_info,_,_,_) -> ok; +%% function_dump(Name,Arity,Format,Terms) -> +%% io:format("~w/~w " ++ Format,[Name,Arity]++Terms), +%% ok. + function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) -> - %%ok = io:fwrite("~p - ", [{Name,Arity}]), St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]}, {B0,St1} = body(Cs0, Name, Arity, St0), - %%ok = io:fwrite("1", []), - %%ok = io:fwrite("~w:~p~n", [?LINE,B0]), + %% ok = function_dump(Name,Arity,"body:~n~p~n",[B0]), {B1,St2} = ubody(B0, St1), - %%ok = io:fwrite("2", []), - %%ok = io:fwrite("~w:~p~n", [?LINE,B1]), + %% ok = function_dump(Name,Arity,"ubody:~n~p~n",[B1]), {B2,#core{ws=Ws}} = cbody(B1, St2), - %%ok = io:fwrite("3~n", []), - %%ok = io:fwrite("~w:~p~n", [?LINE,B2]), + %% ok = function_dump(Name,Arity,"cbody:~n~p~n",[B2]), {{#c_var{name={Name,Arity}},B2},Ws}. body(Cs0, Name, Arity, St0) -> Anno = lineno_anno(element(2, hd(Cs0)), St0), {Args,St1} = new_vars(Anno, Arity, St0), - {Cs1,St2} = clauses(Cs0, St1), - {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = function_clause(Ps, Anno, {Name,Arity}), - {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}. + case clauses(Cs0, St1) of + {Cs1,[],St2} -> + {Ps,St3} = new_vars(Arity, St2), %Need new variables here + Fc = function_clause(Ps, Anno, {Name,Arity}), + {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}; + {Cs1,Eps,St2} -> + %% We have pre-expressions from patterns and + %% these needs to be letified before matching + %% since only bound variables are allowed + AnnoGen = #a{anno=[compiler_generated]}, + {Ps1,St3} = new_vars(Arity, St2), %Need new variables here + Fc1 = function_clause(Ps1, Anno, {Name,Arity}), + {Ps2,St4} = new_vars(Arity, St3), %Need new variables here + Fc2 = function_clause(Ps2, Anno, {Name,Arity}), + Case = #icase{anno=AnnoGen,args=Args, + clauses=Cs1, + fc=Fc2}, + {#ifun{anno=#a{anno=Anno},id=[],vars=Args, + clauses=[#iclause{anno=AnnoGen,pats=Ps1, + guard=[#c_literal{val=true}], + body=Eps ++ [Case]}], + fc=Fc1},St4} + end. %% clause(Clause, State) -> {Cclause,State} | noclause. %% clauses([Clause], State) -> {[Cclause],State}. %% Convert clauses. Trap bad pattern aliases and remove clause from %% clause list. -clauses([C0|Cs0], St0) -> +clauses([C0|Cs0],St0) -> case clause(C0, St0) of - {noclause,St} -> clauses(Cs0, St); - {C,St1} -> - {Cs,St2} = clauses(Cs0, St1), - {[C|Cs],St2} + {noclause,_,St} -> clauses(Cs0,St); + {C,Eps1,St1} -> + {Cs,Eps2,St2} = clauses(Cs0, St1), + {[C|Cs],Eps1++Eps2,St2} end; -clauses([], St) -> {[],St}. +clauses([],St) -> {[],[],St}. clause({clause,Lc,H0,G0,B0}, St0) -> try head(H0, St0) of - H1 -> - {G1,St1} = guard(G0, St0), - {B1,St2} = exprs(B0, St1), - Anno = lineno_anno(Lc, St2), - {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},St2} + {H1,Eps,St1} -> + {G1,St2} = guard(G0, St1), + {B1,St3} = exprs(B0, St2), + Anno = lineno_anno(Lc, St3), + {#iclause{anno=#a{anno=Anno},pats=H1,guard=G1,body=B1},Eps,St3} catch throw:nomatch -> St = add_warning(Lc, nomatch, St0), - {noclause,St} %Bad pattern + {noclause,[],St} %Bad pattern end. clause_arity({clause,_,H0,_,_}) -> length(H0). -%% head([P], State) -> [P]. +%% head([P], State) -> {[P],[Cexpr],State}. -head(Ps, St) -> pattern_list(Ps, St). +head(Ps, St) -> + pattern_list(Ps, St). %% guard([Expr], State) -> {[Cexpr],State}. %% Build an explict and/or tree of guard alternatives, then traverse @@ -514,22 +536,7 @@ expr({tuple,L,Es0}, St0) -> A = record_anno(L, St1), {annotate_tuple(A, Es1, St1),Eps,St1}; expr({map,L,Es0}, St0) -> - % erl_lint should make sure only #{ K => V } are allowed - % in map construction. - try map_pair_list(Es0, St0) of - {Es1,Eps,St1} -> - A = lineno_anno(L, St1), - {ann_c_map(A,Es1),Eps,St1} - catch - throw:{bad_map,Warning} -> - St = add_warning(L, Warning, St0), - LineAnno = lineno_anno(L, St), - As = [#c_literal{anno=LineAnno,val=badarg}], - {#icall{anno=#a{anno=LineAnno}, %Must have an #a{} - module=#c_literal{anno=LineAnno,val=erlang}, - name=#c_literal{anno=LineAnno,val=error}, - args=As},[],St} - end; + map_build_pairs(#c_literal{val=#{}}, Es0, lineno_anno(L, St0), St0); expr({map,L,M0,Es0}, St0) -> try expr_map(M0,Es0,lineno_anno(L, St0),St0) of {_,_,_}=Res -> Res @@ -562,26 +569,26 @@ expr({block,_,Es0}, St0) -> {E1,Eps,St2} = expr(last(Es0), St1), {E1,Es1 ++ Eps,St2}; expr({'if',L,Cs0}, St0) -> - {Cs1,St1} = clauses(Cs0, St0), + {Cs1,Ceps,St1} = clauses(Cs0, St0), Lanno = lineno_anno(L, St1), Fc = fail_clause([], Lanno, #c_literal{val=if_clause}), - {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1}; + {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},Ceps,St1}; expr({'case',L,E0,Cs0}, St0) -> {E1,Eps,St1} = novars(E0, St0), - {Cs1,St2} = clauses(Cs0, St1), + {Cs1,Ceps,St2} = clauses(Cs0, St1), {Fpat,St3} = new_var(St2), Lanno = lineno_anno(L, St2), Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])), - {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3}; + {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps++Ceps,St3}; expr({'receive',L,Cs0}, St0) -> - {Cs1,St1} = clauses(Cs0, St0), - {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1}, [], St1}; + {Cs1,Ceps,St1} = clauses(Cs0, St0), + {#ireceive1{anno=#a{anno=lineno_anno(L, St1)},clauses=Cs1},Ceps, St1}; expr({'receive',L,Cs0,Te0,Tes0}, St0) -> {Te1,Teps,St1} = novars(Te0, St0), {Tes1,St2} = exprs(Tes0, St1), - {Cs1,St3} = clauses(Cs0, St2), + {Cs1,Ceps,St3} = clauses(Cs0, St2), {#ireceive2{anno=#a{anno=lineno_anno(L, St3)}, - clauses=Cs1,timeout=Te1,action=Tes1},Teps,St3}; + clauses=Cs1,timeout=Te1,action=Tes1},Teps++Ceps,St3}; expr({'try',L,Es0,[],Ecs,[]}, St0) -> %% 'try ... catch ... end' {Es1,St1} = exprs(Es0, St0), @@ -595,7 +602,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> %% 'try ... of ... catch ... end' {Es1,St1} = exprs(Es0, St0), {V,St2} = new_var(St1), %This name should be arbitrary - {Cs1,St3} = clauses(Cs0, St2), + {Cs1,Ceps,St3} = clauses(Cs0, St2), {Fpat,St4} = new_var(St3), Lanno = lineno_anno(L, St4), Fc = fail_clause([Fpat], Lanno, @@ -604,7 +611,7 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> {#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1, vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}], evars=Evs,handler=Hs}, - [],St5}; + Ceps,St5}; expr({'try',L,Es0,[],[],As0}, St0) -> %% 'try ... after ... end' {Es1,St1} = exprs(Es0, St0), @@ -673,24 +680,24 @@ expr({match,L,P0,E0}, St0) -> {var,_,'_'} -> St0#core{wanted=false}; _ -> St0 end, - {E2,Eps,St2} = novars(E1, St1), + {E2,Eps1,St2} = novars(E1, St1), St3 = St2#core{wanted=St0#core.wanted}, - P2 = try - pattern(P1, St3) + {P2,Eps2,St4} = try + pattern(P1, St3) catch throw:Thrown -> - Thrown + {Thrown,[],St3} end, - {Fpat,St4} = new_var(St3), - Lanno = lineno_anno(L, St4), + {Fpat,St5} = new_var(St4), + Lanno = lineno_anno(L, St5), Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])), case P2 of nomatch -> - St = add_warning(L, nomatch, St4), + St = add_warning(L, nomatch, St5), {#icase{anno=#a{anno=Lanno}, - args=[E2],clauses=[],fc=Fc},Eps,St}; + args=[E2],clauses=[],fc=Fc},Eps1++Eps2,St}; Other when not is_atom(Other) -> - {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4} + {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5} end; expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> %% Optimise '++' here because of the list comprehension algorithm. @@ -772,63 +779,46 @@ expr_map(M0,Es0,A,St0) -> Fc = fail_clause([Fpat], A, #c_literal{val=badarg}), {#icase{anno=#a{anno=A},args=[M1],clauses=Cs,fc=Fc},Mps,St3}; {_,_} -> - {Es1,Eps,St2} = map_pair_list(Es0, St1), - {ann_c_map(A,M1,Es1),Mps++Eps,St2} + {M2,Eps,St2} = map_build_pairs(M1, Es0, A, St1), + {M2,Mps++Eps,St2} end; false -> throw({bad_map,bad_map}) end. +map_build_pairs(Map0, Es0, Ann, St0) -> + {Es,Pre,St1} = map_build_pairs_1(Es0, St0), + case ann_c_map(Ann, Map0, Es) of + #c_literal{}=Map -> + {Map,[],St1}; + #c_map{}=Map -> + {Var,St2} = new_var(St1), + {Var,Pre++[#iset{var=Var,arg=Map}],St2} + end. + +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(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_map{}) -> true; is_valid_map_src(#c_var{}) -> true; is_valid_map_src(_) -> false. -map_pair_list(Es, St) -> - foldr(fun - ({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) -> - {K1,Ep0,St1} = safe(K0, St0), - K = ensure_valid_map_key(K1), - {V,Ep1,St2} = safe(V0, St1), - A = lineno_anno(L, St2), - Pair = #c_map_pair{op=#c_literal{val=assoc},anno=A,key=K,val=V}, - {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2}; - ({map_field_exact,L,K0,V0}, {Ces,Esp,St0}) -> - {K1,Ep0,St1} = safe(K0, St0), - K = ensure_valid_map_key(K1), - {V,Ep1,St2} = safe(V0, St1), - A = lineno_anno(L, St2), - Pair = #c_map_pair{op=#c_literal{val=exact},anno=A,key=K,val=V}, - {[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2} - end, {[],[],St}, Es). - -ensure_valid_map_key(K0) -> - case coalesced_map_key(K0) of - {ok,K1} -> K1; - error -> throw({bad_map,bad_map_key}) - end. - -coalesced_map_key(#c_literal{}=K) -> {ok,K}; -%% Dialyzer hack redux -%% DO coalesce tuples and list in maps for dialyzer -%% Dialyzer tries to break this apart, don't let it -coalesced_map_key(#c_tuple{}=K) -> - case core_lib:is_literal(K) of - true -> {ok,cerl:fold_literal(K)}; - false -> error - end; -coalesced_map_key(#c_cons{}=K) -> - case core_lib:is_literal(K) of - true -> {ok,cerl:fold_literal(K)}; - false -> error - end; -coalesced_map_key(_) -> error. - %% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}. try_exception(Ecs0, St0) -> %% Note that Tag is not needed for rethrow - it is already in Info. {Evs,St1} = new_vars(3, St0), % Tag, Value, Info - {Ecs1,St2} = clauses(Ecs0, St1), + {Ecs1,Ceps,St2} = clauses(Ecs0, St1), [_,Value,Info] = Evs, Ec = #iclause{anno=#a{anno=[compiler_generated]}, pats=[c_tuple(Evs)],guard=[#c_literal{val=true}], @@ -836,15 +826,15 @@ try_exception(Ecs0, St0) -> name=#c_literal{val=raise}, args=[Info,Value]}]}, Hs = [#icase{anno=#a{},args=[c_tuple(Evs)],clauses=Ecs1,fc=Ec}], - {Evs,Hs,St2}. + {Evs,Ceps++Hs,St2}. try_after(As, St0) -> %% See above. - {Evs,St1} = new_vars(3, St0), % Tag, Value, Info + {Evs,St1} = new_vars(3, St0), % Tag, Value, Info [_,Value,Info] = Evs, - B = As ++ [#iprimop{anno=#a{}, %Must have an #a{} - name=#c_literal{val=raise}, - args=[Info,Value]}], + B = As ++ [#iprimop{anno=#a{}, % Must have an #a{} + name=#c_literal{val=raise}, + args=[Info,Value]}], Ec = #iclause{anno=#a{anno=[compiler_generated]}, pats=[c_tuple(Evs)],guard=[#c_literal{val=true}], body=B}, @@ -978,7 +968,7 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> Arity = clause_arity(hd(Cs0)), - {Cs1,St1} = clauses(Cs0, St0), + {Cs1,Ceps,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here Anno = lineno_anno(L, St3), @@ -986,12 +976,13 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! vars=Args,clauses=Cs1,fc=Fc,name=NameInfo}, - {Fun,[],St3}. + {Fun,Ceps,St3}. %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. %% This TQ from Simon PJ pp 127-138. -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), @@ -1026,7 +1017,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) -> @@ -1051,7 +1042,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), @@ -1089,7 +1081,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) -> @@ -1153,7 +1145,7 @@ preprocess_quals(Line, [Q|Qs0], St0, Acc) -> {Gen,St} = generator(Line, Q, Gs, St0), preprocess_quals(Line, Qs, St, [Gen|Acc]); false -> - LAnno = #a{anno=lineno_anno(get_anno(Q), St0)}, + LAnno = #a{anno=lineno_anno(get_qual_anno(Q), St0)}, case is_guard_test(Q) of true -> %% When a filter is a guard test, its argument in the @@ -1178,6 +1170,11 @@ is_generator({generate,_,_,_}) -> true; is_generator({b_generate,_,_,_}) -> true; is_generator(_) -> false. +%% Retrieve the annotation from an Erlang AST form. +%% (Use get_anno/1 to retrieve the annotation from Core Erlang forms). + +get_qual_anno(Abstract) -> element(2, Abstract). + %% %% Generators are abstracted as sextuplets: %% - acc_pat is the accumulator pattern, e.g. [Pat|Tail] for Pat <- Expr. @@ -1200,7 +1197,7 @@ is_generator(_) -> false. generator(Line, {generate,Lg,P0,E}, Gs, St0) -> LA = lineno_anno(Line, St0), GA = lineno_anno(Lg, St0), - {Head,St1} = list_gen_pattern(P0, Line, St0), + {Head,Ceps,St1} = list_gen_pattern(P0, Line, St0), {[Tail,Skip],St2} = new_vars(2, St1), {Cg,St3} = lc_guard_tests(Gs, St2), {AccPat,SkipPat} = case Head of @@ -1220,25 +1217,27 @@ 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, + 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), GA = lineno_anno(Lg, St0), - Cp = #c_binary{segments=Segs} = pattern(P, St0), + {Cp = #c_binary{segments=Segs},[],St1} = pattern(P, St0), + %% The function append_tail_segment/2 keeps variable patterns as-is, making %% it possible to have the same skip clause removal as with list generators. - {AccSegs,Tail,TailSeg,St1} = append_tail_segment(Segs, St0), + {AccSegs,Tail,TailSeg,St2} = append_tail_segment(Segs, St1), AccPat = Cp#c_binary{segments=AccSegs}, - {Cg,St2} = lc_guard_tests(Gs, St1), - {SkipSegs,St3} = emasculate_segments(AccSegs, St2), + {Cg,St3} = lc_guard_tests(Gs, St2), + {SkipSegs,St4} = emasculate_segments(AccSegs, St3), SkipPat = Cp#c_binary{segments=SkipSegs}, - {Ce,Pre,St4} = safe(E, St3), + {Ce,Pre,St5} = safe(E, St4), Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, tail=Tail,tail_pat=#c_binary{anno=LA,segments=[TailSeg]}, arg={Pre,Ce}}, - {Gen,St4}. + {Gen,St5}. append_tail_segment(Segs, St0) -> {Var,St} = new_var(St0), @@ -1267,9 +1266,9 @@ lc_guard_tests(Gs0, St0) -> list_gen_pattern(P0, Line, St) -> try - {pattern(P0, St),St} + pattern(P0,St) catch - nomatch -> {nomatch,add_warning(Line, nomatch, St)} + nomatch -> {nomatch,[],add_warning(Line, nomatch, St)} end. %%% @@ -1492,6 +1491,18 @@ force_novars(#ibinary{}=Bin, St) -> {Bin,[],St}; force_novars(Ce, St) -> force_safe(Ce, St). + +%% safe_pattern_expr(Expr, State) -> {Cexpr,[PreExpr],State}. +%% only literals and variables are safe expressions in patterns +safe_pattern_expr(E,St0) -> + case safe(E,St0) of + {#c_var{},_,_}=Safe -> Safe; + {#c_literal{},_,_}=Safe -> Safe; + {Ce,Eps,St1} -> + {V,St2} = new_var(St1), + {V,Eps++[#iset{var=V,arg=Ce}],St2} + end. + %% safe(Expr, State) -> {Safe,[PreExpr],State}. %% Generate an internal safe expression. These are simples without %% binaries which can fail. At this level we do not need to do a @@ -1566,90 +1577,109 @@ fold_match({match,L,P0,E0}, P) -> {{match,L,P0,P1},E1}; fold_match(E, P) -> {P,E}. -%% pattern(Pattern, State) -> CorePat. +%% pattern(Pattern, State) -> {CorePat,[PreExp],State}. %% Transform a pattern by removing line numbers. We also normalise %% aliases in patterns to standard form, {alias,Pat,[Var]}. - -pattern({var,L,V}, St) -> #c_var{anno=lineno_anno(L, St),name=V}; -pattern({char,L,C}, St) -> #c_literal{anno=lineno_anno(L, St),val=C}; -pattern({integer,L,I}, St) -> #c_literal{anno=lineno_anno(L, St),val=I}; -pattern({float,L,F}, St) -> #c_literal{anno=lineno_anno(L, St),val=F}; -pattern({atom,L,A}, St) -> #c_literal{anno=lineno_anno(L, St),val=A}; -pattern({string,L,S}, St) -> #c_literal{anno=lineno_anno(L, St),val=S}; -pattern({nil,L}, St) -> #c_literal{anno=lineno_anno(L, St),val=[]}; +%% +%% In patterns we may have expressions +%% 1) Binaries -> #c_bitstr{size=Expr} +%% 2) Maps -> #c_map_pair{key=Expr} +%% +%% Both of these may generate pre-expressions since only bound variables +%% or literals are allowed for these in core patterns. +%% +%% Therefor, we need to drag both the state and the collection of pre-expression +%% around in the whole pattern transformation tree. + +pattern({var,L,V}, St) -> {#c_var{anno=lineno_anno(L, St),name=V},[],St}; +pattern({char,L,C}, St) -> {#c_literal{anno=lineno_anno(L, St),val=C},[],St}; +pattern({integer,L,I}, St) -> {#c_literal{anno=lineno_anno(L, St),val=I},[],St}; +pattern({float,L,F}, St) -> {#c_literal{anno=lineno_anno(L, St),val=F},[],St}; +pattern({atom,L,A}, St) -> {#c_literal{anno=lineno_anno(L, St),val=A},[],St}; +pattern({string,L,S}, St) -> {#c_literal{anno=lineno_anno(L, St),val=S},[],St}; +pattern({nil,L}, St) -> {#c_literal{anno=lineno_anno(L, St),val=[]},[],St}; pattern({cons,L,H,T}, St) -> - annotate_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St), St); + {Ph,Eps1,St1} = pattern(H, St), + {Pt,Eps2,St2} = pattern(T, St1), + {annotate_cons(lineno_anno(L, St), Ph, Pt, St2),Eps1++Eps2,St2}; pattern({tuple,L,Ps}, St) -> - annotate_tuple(record_anno(L, St), pattern_list(Ps, St), St); -pattern({map,L,Ps}, St) -> - #c_map{anno=lineno_anno(L, St), es=pattern_map_pairs(Ps, St)}; + {Ps1,Eps,St1} = pattern_list(Ps,St), + {annotate_tuple(record_anno(L, St), Ps1, St),Eps,St1}; +pattern({map,L,Pairs}, St0) -> + {Ps,Eps,St1} = pattern_map_pairs(Pairs, St0), + {#c_map{anno=lineno_anno(L, St1),es=Ps,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. - #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)}; + {#c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)},[],St}; pattern({match,_,P1,P2}, St) -> - pat_alias(pattern(P1, St), pattern(P2, St)). + {Cp1,Eps1,St1} = pattern(P1,St), + {Cp2,Eps2,St2} = pattern(P2,St1), + {pat_alias(Cp1,Cp2),Eps1++Eps2,St2}. %% pattern_map_pairs([MapFieldExact],State) -> [#c_map_pairs{}] pattern_map_pairs(Ps, St) -> - %% check literal key uniqueness (dict is needed) - %% pattern all pairs - {CMapPairs, Kdb} = lists:mapfoldl(fun - (P,Kdbi) -> - #c_map_pair{key=Ck,val=Cv} = CMapPair = pattern_map_pair(P,St), - K = core_lib:literal_value(Ck), - case dict:find(K,Kdbi) of - {ok, Vs} -> - {CMapPair, dict:store(K,[Cv|Vs],Kdbi)}; - _ -> - {CMapPair, dict:store(K,[Cv],Kdbi)} + %% check literal key uniqueness + %% - guaranteed via aliasing map pairs + %% pattern all pairs in two steps + %% 1) Construct Core Pattern + %% 2) Alias Keys in Core Pattern + {CMapPairs, {Eps,St1}} = lists:mapfoldl(fun + (P,{EpsM,Sti0}) -> + {CMapPair,EpsP,Sti1} = pattern_map_pair(P,Sti0), + {CMapPair, {EpsM++EpsP,Sti1}} + end, {[],St}, Ps), + {pat_alias_map_pairs(CMapPairs,[]),Eps,St1}. + +%% remove cluddering annotations +pattern_map_clean_key(#c_literal{val=V}) -> {literal,V}; +pattern_map_clean_key(#c_var{name=V}) -> {var,V}. + +pat_alias_map_pairs(Ps1,Ps2) -> + Ps = Ps1 ++ Ps2, + F = fun(#c_map_pair{key=Ck,val=Cv},Dbi) -> + K = pattern_map_clean_key(Ck), + case dict:find(K,Dbi) of + {ok,Cvs} -> dict:store(K,[Cv|Cvs],Dbi); + _ -> dict:store(K,[Cv],Dbi) end - end, dict:new(), Ps), - pattern_alias_map_pairs(CMapPairs,Kdb,dict:new(),St). - -pattern_alias_map_pairs([],_,_,_) -> []; -pattern_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Kset,St) -> - %% alias same keys if needed - K = core_lib:literal_value(Ck), - case dict:find(K,Kset) of - {ok,processed} -> - pattern_alias_map_pairs(Pairs,Kdb,Kset,St); - _ -> + end, + Kdb = lists:foldl(F,dict:new(),Ps), + pat_alias_map_pairs(Ps,Kdb,sets:new()). + +pat_alias_map_pairs([],_,_) -> []; +pat_alias_map_pairs([#c_map_pair{key=Ck}=Pair|Pairs],Kdb,Set) -> + K = pattern_map_clean_key(Ck), + case sets:is_element(K,Set) of + true -> + pat_alias_map_pairs(Pairs,Kdb,Set); + false -> Cvs = dict:fetch(K,Kdb), - Cv = pattern_alias_map_pair_patterns(Cvs), - Kset1 = dict:store(K, processed, Kset), - [Pair#c_map_pair{val=Cv}|pattern_alias_map_pairs(Pairs,Kdb,Kset1,St)] + Cv = pat_alias_map_pair_values(Cvs), + Set1 = sets:add_element(K,Set), + [Pair#c_map_pair{val=Cv}|pat_alias_map_pairs(Pairs,Kdb,Set1)] end. -pattern_alias_map_pair_patterns([Cv]) -> Cv; -pattern_alias_map_pair_patterns([Cv1,Cv2|Cvs]) -> - pattern_alias_map_pair_patterns([pat_alias(Cv1,Cv2)|Cvs]). - -pattern_map_pair({map_field_exact,L,K,V},St) -> - #c_map_pair{anno=lineno_anno(L, St), - op=#c_literal{val=exact}, - key=pattern_map_key(K,St), - val=pattern(V, St)}. - -pattern_map_key(K,St) -> - %% Throws 'nomatch' if the key can't be a literal - %% this will be a cryptic error message but it is better than nothing - case expr(K,St) of - {Key0,[],_} -> - %% Dialyzer hack redux - case coalesced_map_key(Key0) of - {ok,Key1} -> Key1; - error -> throw(nomatch) - end; - _ -> throw(nomatch) - end. +pat_alias_map_pair_values([Cv]) -> Cv; +pat_alias_map_pair_values([Cv1,Cv2|Cvs]) -> + pat_alias_map_pair_values([pat_alias(Cv1,Cv2)|Cvs]). + +pattern_map_pair({map_field_exact,L,K,V}, St0) -> + {Ck,EpsK,St1} = safe_pattern_expr(K,St0), + {Cv,EpsV,St2} = pattern(V, St1), + {#c_map_pair{anno=lineno_anno(L,St2), + op=#c_literal{val=exact}, + key=Ck, + val=Cv},EpsK++EpsV,St2}. %% pat_bin([BinElement], State) -> [BinSeg]. pat_bin(Ps, St) -> [pat_segment(P, St) || P <- Ps]. -pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}, St) -> - #c_bitstr{val=pattern(Term, St),size=pattern(Size, St), +pat_segment({bin_element,_,Val,Size,[Type,{unit,Unit}|Flags]}, St) -> + {Pval,[],St1} = pattern(Val,St), + {Psize,[],_St2} = pattern(Size,St1), + #c_bitstr{val=Pval,size=Psize, unit=#c_literal{val=Unit}, type=#c_literal{val=Type}, flags=#c_literal{val=Flags}}. @@ -1659,6 +1689,8 @@ pat_segment({bin_element,_,Term,Size,[Type,{unit,Unit}|Flags]}, St) -> pat_alias(#c_var{name=V1}, P2) -> #c_alias{var=#c_var{name=V1},pat=P2}; pat_alias(P1, #c_var{name=V2}) -> #c_alias{var=#c_var{name=V2},pat=P1}; + +%% alias cons pat_alias(#c_cons{}=Cons, #c_literal{anno=A,val=[H|T]}=S) -> pat_alias(Cons, ann_c_cons_skel(A, #c_literal{anno=A,val=H}, S#c_literal{val=T})); @@ -1667,6 +1699,8 @@ pat_alias(#c_literal{anno=A,val=[H|T]}=S, #c_cons{}=Cons) -> S#c_literal{val=T}), Cons); pat_alias(#c_cons{anno=Anno,hd=H1,tl=T1}, #c_cons{hd=H2,tl=T2}) -> ann_c_cons(Anno, pat_alias(H1, H2), pat_alias(T1, T2)); + +%% alias tuples pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_literal{val=T}) when is_tuple(T) -> Es2 = [#c_literal{val=E} || E <- tuple_to_list(T)], ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); @@ -1675,6 +1709,12 @@ pat_alias(#c_literal{anno=Anno,val=T}, #c_tuple{es=Es2}) when is_tuple(T) -> ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); pat_alias(#c_tuple{anno=Anno,es=Es1}, #c_tuple{es=Es2}) -> ann_c_tuple(Anno, pat_alias_list(Es1, Es2)); + +%% alias maps +%% There are no literals in maps patterns (patterns are always abstract) +pat_alias(#c_map{es=Es1}=M,#c_map{es=Es2}) -> + M#c_map{es=pat_alias_map_pairs(Es1,Es2)}; + pat_alias(#c_alias{var=V1,pat=P1}, #c_alias{var=V2,pat=P2}) -> if V1 =:= V2 -> #c_alias{var=V1,pat=pat_alias(P1, P2)}; @@ -1697,9 +1737,15 @@ pat_alias_list([A1|A1s], [A2|A2s]) -> pat_alias_list([], []) -> []; pat_alias_list(_, _) -> throw(nomatch). -%% pattern_list([P], State) -> [P]. +%% pattern_list([P], State) -> {[P],Exprs,St} + +pattern_list([P0|Ps0], St0) -> + {P1,Eps,St1} = pattern(P0, St0), + {Ps1,Epsl,St2} = pattern_list(Ps0, St1), + {[P1|Ps1], Eps ++ Epsl, St2}; +pattern_list([], St) -> + {[],[],St}. -pattern_list(Ps, St) -> [pattern(P, St) || P <- Ps]. %% make_vars([Name]) -> [{Var,Name}]. @@ -1999,9 +2045,14 @@ upattern(#c_tuple{es=Es0}=Tuple, Ks, St0) -> upattern(#c_map{es=Es0}=Map, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upattern_list(Es0, Ks, St0), {Map#c_map{es=Es1},Esg,Esv,Eus,St1}; -upattern(#c_map_pair{op=#c_literal{val=exact},val=V0}=MapPair, Ks, St0) -> - {V,Vg,Vv,Vu,St1} = upattern(V0, Ks, St0), - {MapPair#c_map_pair{val=V},Vg,Vv,Vu,St1}; +upattern(#c_map_pair{op=#c_literal{val=exact},key=K0,val=V0}=Pair,Ks,St0) -> + {V,Vg,Vn,Vu,St1} = upattern(V0, Ks, St0), + % A variable key must be considered used here + Ku = case K0 of + #c_var{name=Name} -> [Name]; + _ -> [] + end, + {Pair#c_map_pair{val=V},Vg,Vn,union(Ku,Vu),St1}; upattern(#c_binary{segments=Es0}=Bin, Ks, St0) -> {Es1,Esg,Esv,Eus,St1} = upat_bin(Es0, Ks, St0), {Bin#c_binary{segments=Es1},Esg,Esv,Eus,St1}; @@ -2372,8 +2423,6 @@ format_error(nomatch) -> "pattern cannot possibly match"; format_error(bad_binary) -> "binary construction will fail because of a type mismatch"; -format_error(bad_map_key) -> - "map construction will fail because of none literal key (large binaries are not literals)"; format_error(bad_map) -> "map construction will fail because of a type mismatch". diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 40d2f72b4c..72e7a39333 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -521,67 +521,82 @@ is_valid_map_src(#k_var{}) -> true; is_valid_map_src(_) -> false. map_split_pairs(A, Var, Ces, Sub, St0) -> - %% two steps - %% 1. force variables - %% 2. remove multiples - Pairs0 = [{Op,K,V} || #c_map_pair{op=#c_literal{val=Op},key=K,val=V} <- Ces], + %% 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,[],Sti1} = expr(K0, Sub, Sti0), - {V,Ep,Sti2} = atomic(V0, Sub, Sti1), - {[{Op,K,V}|Ops],Ep ++ Espi,Sti2} + {K,Eps1,Sti1} = atomic(K0, Sub, Sti0), + {V,Eps2,Sti2} = atomic(V0, Sub, Sti1), + {[{Op,K,V}|Ops],Eps1 ++ Eps2 ++ Espi,Sti2} end, {[],[],St0}, Pairs0), - - case map_group_pairs(Pairs) of - {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_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_remove_dup_keys(Es) -> + dict:to_list(map_remove_dup_keys(Es, dict:new())). -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,[]) -map_key_clean(#k_literal{val=V}) -> {k_literal,V}; -map_key_clean(#k_int{val=V}) -> {k_int,V}; -map_key_clean(#k_float{val=V}) -> {k_float,V}; -map_key_clean(#k_atom{val=V}) -> {k_atom,V}; -map_key_clean(#k_nil{}) -> k_nil. +%% 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}; +map_key_clean(#k_float{val=V}) -> {lit,V}; +map_key_clean(#k_atom{val=V}) -> {lit,V}; +map_key_clean(#k_nil{}) -> {lit,[]}. %% call_type(Module, Function, Arity) -> call | bif | apply | error. @@ -757,23 +772,22 @@ flatten_alias(#c_alias{var=V,pat=P}) -> flatten_alias(Pat) -> {[],Pat}. pattern_map_pairs(Ces0, Isub, Osub0, St0) -> - %% It is assumed that all core keys are literals - %% It is later assumed that these keys are term sorted - %% so we need to sort them here - Ces1 = lists:sort(fun - (#c_map_pair{key=CkA},#c_map_pair{key=CkB}) -> - A = core_lib:literal_value(CkA), - B = core_lib:literal_value(CkB), - erts_internal:cmp_term(A,B) < 0 - end, Ces0), %% pattern the pair keys and values as normal {Kes,{Osub1,St1}} = lists:mapfoldl(fun (#c_map_pair{anno=A,key=Ck,val=Cv},{Osubi0,Sti0}) -> - {Kk,Osubi1,Sti1} = pattern(Ck, Isub, Osubi0, Sti0), - {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi1, Sti1), + {Kk,[],Sti1} = expr(Ck, Isub, Sti0), + {Kv,Osubi2,Sti2} = pattern(Cv, Isub, Osubi0, Sti1), {#k_map_pair{anno=A,key=Kk,val=Kv},{Osubi2,Sti2}} - end, {Osub0, St0}, Ces1), - {Kes,Osub1,St1}. + end, {Osub0, St0}, Ces0), + %% It is later assumed that these keys are term sorted + %% so we need to sort them here + Kes1 = lists:sort(fun + (#k_map_pair{key=KkA},#k_map_pair{key=KkB}) -> + A = map_key_clean(KkA), + B = map_key_clean(KkB), + erts_internal:cmp_term(A,B) < 0 + end, Kes), + {Kes1,Osub1,St1}. pattern_bin(Es, Isub, Osub0, St0) -> {Kbin,{_,Osub},St} = pattern_bin_1(Es, Isub, Osub0, St0), @@ -1550,13 +1564,11 @@ arg_val(Arg, C) -> {set_kanno(S, []),U,T,Fs} end; #k_map{op=exact,es=Es} -> - Keys = [begin - #k_map_pair{key=#k_literal{val=Key}} = Pair, - Key - end || Pair <- Es], - %% multiple keys may have the same name - %% do not use ordsets - lists:sort(fun(A,B) -> erts_internal:cmp_term(A,B) < 0 end, Keys) + lists:sort(fun(A,B) -> + %% on the form K :: {'lit' | 'var', term()} + %% lit < var as intended + erts_internal:cmp_term(A,B) < 0 + end, [map_key_clean(Key) || #k_map_pair{key=Key} <- Es]) end. %% ubody_used_vars(Expr, State) -> [UsedVar] @@ -1943,6 +1955,7 @@ lit_list_vars(Ps) -> %% pat_vars(Pattern) -> {[UsedVarName],[NewVarName]}. %% Return variables in a pattern. All variables are new variables %% except those in the size field of binary segments. +%% and map_pair keys pat_vars(#k_var{name=N}) -> {[],[N]}; %%pat_vars(#k_char{}) -> {[],[]}; @@ -1967,8 +1980,10 @@ pat_vars(#k_tuple{es=Es}) -> pat_list_vars(Es); pat_vars(#k_map{es=Es}) -> pat_list_vars(Es); -pat_vars(#k_map_pair{val=V}) -> - pat_vars(V). +pat_vars(#k_map_pair{key=K,val=V}) -> + {U1,New} = pat_vars(V), + {[], U2} = pat_vars(K), + {union(U1,U2),New}. pat_list_vars(Ps) -> foldl(fun (P, {Used0,New0}) -> diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index ab66445f73..b008285d9f 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -38,7 +38,7 @@ -record(k_nil, {anno=[]}). -record(k_tuple, {anno=[],es}). --record(k_map, {anno=[],var,op,es}). +-record(k_map, {anno=[],var=#k_literal{val=#{}},op,es}). -record(k_map_pair, {anno=[],key,val}). -record(k_cons, {anno=[],hd,tl}). -record(k_binary, {anno=[],segs}). diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 0b56a49cd6..73d52a48bc 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -11,6 +11,7 @@ MODULES= \ beam_validator_SUITE \ beam_disasm_SUITE \ beam_except_SUITE \ + beam_utils_SUITE \ bs_bincomp_SUITE \ bs_bit_binaries_SUITE \ bs_construct_SUITE \ @@ -40,6 +41,7 @@ NO_OPT= \ andor \ apply \ beam_except \ + beam_utils \ bs_construct \ bs_match \ bs_utf \ @@ -59,6 +61,7 @@ NO_OPT= \ INLINE= \ andor \ apply \ + beam_utils \ bs_bincomp \ bs_bit_binaries \ bs_construct \ @@ -108,7 +111,7 @@ RELSYSDIR = $(RELEASE_PATH)/compiler_test # ---------------------------------------------------- ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include +clint +clint0 EBIN = . diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index b5408ecd8f..22aa19522d 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -33,7 +33,7 @@ all() -> [{group,p}]. groups() -> - [{p,test_lib:parallel(), + [{p,[parallel], [t_case,t_and_or,t_andalso,t_orelse,inside,overlap, combined,in_case,before_and_inside_if]}]. diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl new file mode 100644 index 0000000000..d2e24cb5ae --- /dev/null +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -0,0 +1,236 @@ +%% +%% %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% +%% +-module(beam_utils_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + apply_fun/1,apply_mf/1,bs_init/1,bs_save/1, + is_not_killed/1,is_not_used_at/1, + select/1,y_catch/1]). +-export([id/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [apply_fun, + apply_mf, + bs_init, + bs_save, + is_not_killed, + is_not_used_at, + select, + y_catch + ]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +apply_fun(_Config) -> + 3 = do_apply_fun(false, false), + 3 = do_apply_fun(false, true), + 3 = do_apply_fun(true, false), + 2 = do_apply_fun(true, true), + ok. + +do_apply_fun(X, Y) -> + F = fun(I) -> I+1 end, + Arg = case X andalso id(Y) of + true -> 1; + false -> 2 + end, + F(Arg). + +apply_mf(_Config) -> + ok = do_apply_mf_used({a,b}, ?MODULE, id), + error = do_apply_mf_used([a], ?MODULE, id), + {'EXIT',{{case_clause,{[],b}},_}} = (catch do_apply_mf_used({[],b}, ?MODULE, id)), + + error = do_apply_mf_killed({error,[a]}, ?MODULE, id), + ok = do_apply_mf_killed([b], ?MODULE, id), + {'EXIT',{{case_clause,{a,[b]}},_}} = (catch do_apply_mf_killed({a,[b]}, ?MODULE, id)), + {'EXIT',{{case_clause,{error,[]}},_}} = (catch do_apply_mf_killed({error,[]}, ?MODULE, id)), + + ok. + +do_apply_mf_used(Arg, Mod, Func) -> + Res = case id(Arg) of + {Decoded,_} when Decoded =/= [] -> + ok; + List when is_list(List) -> + error + end, + Mod:Func(Res). + +do_apply_mf_killed(Arg, Mod, Func) -> + Res = case id(Arg) of + {Tag,Decoded} when Decoded =/= [], Tag =:= error -> + error; + List when is_list(List) -> + ok + end, + Mod:Func(Res). + +bs_init(_Config) -> + <<7>> = do_bs_init_1([?MODULE], 7), + error = do_bs_init_1([?MODULE], 0.0), + error = do_bs_init_1([?MODULE], -43), + error = do_bs_init_1([?MODULE], 42), + + <<>> = do_bs_init_2([]), + <<0:32,((1 bsl 32)-1):32>> = do_bs_init_2([0,(1 bsl 32)-1]), + {'EXIT',{badarg,_}} = (catch do_bs_init_2([0.5])), + {'EXIT',{badarg,_}} = (catch do_bs_init_2([-1])), + {'EXIT',{badarg,_}} = (catch do_bs_init_2([1 bsl 32])), + ok. + +do_bs_init_1([?MODULE], Sz) -> + if + is_integer(Sz), Sz >= -42, Sz < 42 -> + id(<<Sz:8>>); + true -> + error + end. + +do_bs_init_2(SigNos) -> + << <<SigNo:32>> || + SigNo <- SigNos, + (is_integer(SigNo) andalso SigNo >= 0 andalso SigNo < (1 bsl 32)) orelse + erlang:error(badarg) + >>. + + +bs_save(_Config) -> + {a,30,<<>>} = do_bs_save(<<1:1,30:5>>), + {b,127,<<>>} = do_bs_save(<<1:1,31:5,0:1,127:7>>), + {c,127,<<>>} = do_bs_save(<<1:1,31:5,1:1,127:7>>), + {c,127,<<>>} = do_bs_save(<<0:1,31:5,1:1,127:7>>), + {d,1024,<<>>} = do_bs_save(<<0:1,31:5>>), + ok. + +do_bs_save(<<_:1, Tag:5, T/binary>>) when Tag < 31 -> + {a,Tag,T}; +do_bs_save(<<1:1, 31:5, 0:1, Tag:7, T/binary>>) -> + {b,Tag,T}; +do_bs_save(<<_:1, 31:5, 1:1, Tag:7, T/binary>>) -> + {c,Tag,T}; +do_bs_save(<<_:1, 31:5, T/binary>>) -> + {d,1024,T}. + +is_not_killed(_Config) -> + {Pid,Ref} = spawn_monitor(fun() -> exit(banan) end), + receive + {'DOWN', Ref, process, Pid, banan} -> + ok + end, + receive after 0 -> ok end. + +is_not_used_at(_Config) -> + {a,b} = do_is_not_used_at(a, [{a,b}]), + {a,b} = do_is_not_used_at(a, [x,{a,b}]), + {a,b} = do_is_not_used_at(a, [{x,y},{a,b}]), + none = do_is_not_used_at(z, [{a,b}]), + none = do_is_not_used_at(a, [x]), + none = do_is_not_used_at(a, [{x,y}]), + ok. + +do_is_not_used_at(Key, [P|Ps]) -> + if + tuple_size(P) >= 1, element(1, P) =:= Key -> + P; + true -> + do_is_not_used_at(Key, Ps) + end; +do_is_not_used_at(_Key, []) -> none. + +-record(select, {fixed=false}). + +select(_Config) -> + a = do_select(#select{}, 0, 0), + b = do_select(#select{}, 0, 1), + c = do_select(#select{fixed=true}, 0, 0), + c = do_select(#select{fixed=true}, 0, 1), + ok. + +do_select(Head, OldSize, BSize) -> + Overwrite0 = + if + OldSize =:= BSize -> same; + true -> true + end, + Overwrite = + if + Head#select.fixed =/= false -> + false; + true -> + Overwrite0 + end, + if + Overwrite =:= same -> + a; + Overwrite -> + b; + true -> + c + end. + +y_catch(_Config) -> + ok = try + do_y_catch(<<"<?xmlX">>, {state}), + failed + catch + throw:{<<"<?xmlX">>,{state}} -> + ok + end. + +do_y_catch(<<"<?xml",Rest0/binary>> = Bytes, State0) -> + {Rest1,State1} = + case do_y_catch_1(Rest0, State0) of + false -> + {Bytes,State0}; + true -> + {_XmlAttributes, R, S} = do_y_catch_2(Rest0), + {R,S} + end, + case catch id({Rest1,State1}) of + Other -> + throw(Other) + end. + +do_y_catch_1(<<_,_/binary>>, _) -> + false. + +do_y_catch_2(_) -> {a,b,c}. + + +%% The identity function. +id(I) -> I. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 626f89ba7a..27979647c6 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -96,9 +96,16 @@ do_beam_file(F) -> compiler_bug(Config) when is_list(Config) -> %% Check that the compiler returns an error if we try to %% assemble one of the bad '.S' files. - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "stack"), - ?line error = compile:file(File, [asm,report_errors,binary,time]), + Data = ?config(data_dir, Config), + File = filename:join(Data, "compiler_bug"), + error = compile:file(File, [from_asm,report_errors,time]), + + %% Make sure that the error was reported by + %% the beam_validator module. + {error, + [{"compiler_bug", + [{beam_validator,_}]}], + []} = compile:file(File, [from_asm,return_errors,time]), ok. %% The following code is stupid but it should compile. diff --git a/lib/compiler/test/beam_validator_SUITE_data/compiler_bug.S b/lib/compiler/test/beam_validator_SUITE_data/compiler_bug.S new file mode 100644 index 0000000000..ba27bf5c47 --- /dev/null +++ b/lib/compiler/test/beam_validator_SUITE_data/compiler_bug.S @@ -0,0 +1,38 @@ +{module, compiler_bug}. %% version = 0 + +{exports, [{module_info,0},{module_info,1},{sum,2}]}. + +{attributes, []}. + +{labels, 7}. + + +{function, sum, 2, 2}. + {label,1}. + {line,[{location,"compiler_bug.erl",4}]}. + {func_info,{atom,compiler_bug},{atom,sum},2}. + {label,2}. + {line,[{location,"compiler_bug.erl",5}]}. + {gc_bif,'+',{f,0},2,[{y,0},{y,1}],{x,0}}. + return. + + +{function, module_info, 0, 4}. + {label,3}. + {line,[]}. + {func_info,{atom,compiler_bug},{atom,module_info},0}. + {label,4}. + {move,{atom,compiler_bug},{x,0}}. + {line,[]}. + {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. + + +{function, module_info, 1, 6}. + {label,5}. + {line,[]}. + {func_info,{atom,compiler_bug},{atom,module_info},1}. + {label,6}. + {move,{x,0},{x,1}}. + {move,{atom,compiler_bug},{x,0}}. + {line,[]}. + {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl index 8609a490f5..2433e7621e 100644 --- a/lib/compiler/test/bs_bit_binaries_SUITE.erl +++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl @@ -37,7 +37,7 @@ all() -> [{group,p}]. groups() -> - [{p,test_lib:parallel(), + [{p,[parallel], [misc,horrid_match,test_bitstr,test_bit_size, asymmetric_tests,big_asymmetric_tests, binary_to_and_from_list,big_binary_to_and_from_list, diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index ce39de2a82..9df874c387 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -39,7 +39,7 @@ all() -> [{group,p}]. groups() -> - [{p,test_lib:parallel(), + [{p,[parallel], [two,test1,fail,float_bin,in_guard,in_catch, nasty_literals,side_effect,opt,otp_7556,float_arith, otp_8054]}]. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 10e3451e8f..f7af56afcc 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -48,7 +48,7 @@ all() -> [{group,p}]. groups() -> - [{p,test_lib:parallel(), + [{p,[parallel], [fun_shadow,int_float,otp_5269,null_fields,wiger, bin_tail,save_restore,shadowed_size_var, partitioned_bs_match,function_clause,unit, @@ -368,11 +368,20 @@ partitioned_bs_match_3(Var, <<_>>) -> Var; partitioned_bs_match_3(1, 2) -> ok. function_clause(Config) when is_list(Config) -> - ?line ok = function_clause_1(<<0,7,0,7,42>>), - ?line fc(function_clause_1, [<<0,1,2,3>>], - catch function_clause_1(<<0,1,2,3>>)), - ?line fc(function_clause_1, [<<0,1,2,3>>], - catch function_clause_1(<<0,7,0,1,2,3>>)), + ok = function_clause_1(<<0,7,0,7,42>>), + fc(function_clause_1, [<<0,1,2,3>>], + catch function_clause_1(<<0,1,2,3>>)), + fc(function_clause_1, [<<0,1,2,3>>], + catch function_clause_1(<<0,7,0,1,2,3>>)), + + ok = function_clause_2(<<0,7,0,7,42>>), + ok = function_clause_2(<<255>>), + ok = function_clause_2(<<13:4>>), + fc(function_clause_2, [<<0,1,2,3>>], + catch function_clause_2(<<0,1,2,3>>)), + fc(function_clause_2, [<<0,1,2,3>>], + catch function_clause_2(<<0,7,0,1,2,3>>)), + ok. function_clause_1(<<0:8,7:8,T/binary>>) -> @@ -380,6 +389,13 @@ function_clause_1(<<0:8,7:8,T/binary>>) -> function_clause_1(<<_:8>>) -> ok. +function_clause_2(<<0:8,7:8,T/binary>>) -> + function_clause_2(T); +function_clause_2(<<_:8>>) -> + ok; +function_clause_2(<<_:4>>) -> + ok. + unit(Config) when is_list(Config) -> ?line 42 = peek1(<<42>>), ?line 43 = peek1(<<43,1,2>>), diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index f7b1dbdddf..8711f35e8e 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -436,7 +436,7 @@ self_compile_1(Config, Prefix, Opts) -> %% Compile the compiler. (In this node to get better coverage.) ?line CompA = make_compiler_dir(Priv, Prefix++"compiler_a"), ?line VsnA = Version ++ ".0", - ?line compile_compiler(compiler_src(), CompA, VsnA, [clint|Opts]), + compile_compiler(compiler_src(), CompA, VsnA, [clint0,clint|Opts]), %% Compile the compiler again using the newly compiled compiler. %% (In another node because reloading the compiler would disturb cover.) diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 8cb7d1b55b..1c96abe017 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -30,7 +30,7 @@ other_output/1, encrypted_abstr/1, bad_record_use1/1, bad_record_use2/1, strict_record/1, missing_testheap/1, cover/1, env/1, core/1, asm/1, - sys_pre_attributes/1]). + sys_pre_attributes/1, dialyzer/1]). -export([init/3]). @@ -47,7 +47,7 @@ all() -> other_output, encrypted_abstr, {group, bad_record_use}, strict_record, missing_testheap, cover, env, core, asm, - sys_pre_attributes]. + sys_pre_attributes, dialyzer]. groups() -> [{bad_record_use, [], @@ -365,7 +365,7 @@ listings_big(Config) when is_list(Config) -> ?line do_listing(Big, TargetDir, dkern, ".kernel"), ?line Target = filename:join(TargetDir, big), - ?line {ok,big} = compile:file(Target, [asm,{outdir,TargetDir}]), + {ok,big} = compile:file(Target, [from_asm,{outdir,TargetDir}]), %% Cleanup. ?line ok = file:delete(Target ++ ".beam"), @@ -748,42 +748,65 @@ env_1(Simple, Target) -> %% compile the generated Core Erlang files. core(Config) when is_list(Config) -> - ?line Dog = test_server:timetrap(test_server:minutes(5)), - ?line PrivDir = ?config(priv_dir, Config), - ?line Outdir = filename:join(PrivDir, "core"), - ?line ok = file:make_dir(Outdir), + PrivDir = ?config(priv_dir, Config), + Outdir = filename:join(PrivDir, "core"), + ok = file:make_dir(Outdir), - ?line Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"), - ?line TestBeams = filelib:wildcard(Wc), - ?line Abstr = [begin {ok,{Mod,[{abstract_code, + Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"), + TestBeams = filelib:wildcard(Wc), + Abstr = [begin {ok,{Mod,[{abstract_code, {raw_abstract_v1,Abstr}}]}} = beam_lib:chunks(Beam, [abstract_code]), {Mod,Abstr} end || Beam <- TestBeams], - ?line Res = test_lib:p_run(fun(F) -> do_core(F, Outdir) end, Abstr), - ?line test_server:timetrap_cancel(Dog), - Res. - + test_lib:p_run(fun(F) -> do_core(F, Outdir) end, Abstr). do_core({M,A}, Outdir) -> try - {ok,M,Core} = compile:forms(A, [to_core,report]), - CoreFile = filename:join(Outdir, atom_to_list(M)++".core"), - CorePP = core_pp:format(Core), - ok = file:write_file(CoreFile, CorePP), - case compile:file(CoreFile, [clint,from_core,binary]) of - {ok,M,_} -> - ok = file:delete(CoreFile); - Other -> - io:format("*** core_lint failure '~p' for ~s\n", - [Other,CoreFile]), - error - end - catch Class:Error -> + do_core_1(M, A, Outdir) + catch + throw:{error,Error} -> + io:format("*** compilation failure '~p' for module ~s\n", + [Error,M]), + error; + Class:Error -> io:format("~p: ~p ~p\n~p\n", [M,Class,Error,erlang:get_stacktrace()]), error end. +do_core_1(M, A, Outdir) -> + {ok,M,Core0} = compile:forms(A, [to_core]), + CoreFile = filename:join(Outdir, atom_to_list(M)++".core"), + CorePP = core_pp:format(Core0), + ok = file:write_file(CoreFile, CorePP), + + %% Parse the .core file and return the result as Core Erlang Terms. + Core = case compile:file(CoreFile, [report_errors,from_core,no_copt,to_core,binary]) of + {ok,M,Core1} -> Core1; + Other -> throw({error,Other}) + end, + ok = file:delete(CoreFile), + + %% Compile as usual (including optimizations). + compile_forms(Core, [clint,from_core,binary]), + + %% Don't optimize to test that we are not dependent + %% on the Core Erlang optmimization passes. + %% (Example of a previous bug: The core_parse pass + %% would not turn map literals into #c_literal{} + %% records; if sys_core_fold was run it would fix + %% that; if sys_core_fold was not run v3_kernel would + %% crash.) + compile_forms(Core, [clint,from_core,no_copt,binary]), + + ok. + +compile_forms(Forms, Opts) -> + case compile:forms(Forms, [report_errors|Opts]) of + {ok,[],_} -> ok; + Other -> throw({error,Other}) + end. + %% Compile to Beam assembly language (.S) and then try to %% run .S through the compiler again. @@ -854,6 +877,20 @@ sys_pre_attributes(Config) -> [report,verbose]), ok. +%% Test the dialyzer option to cover more code. +dialyzer(Config) -> + Priv = ?config(priv_dir, Config), + file:set_cwd(?config(data_dir, Config)), + Opts = [{outdir,Priv},report_errors], + M = dialyzer_test, + {ok,M} = c:c(M, [dialyzer|Opts]), + [{a,b,c}] = M:M(), + + %% Cover huge line numbers without the 'dialyzer' option. + {ok,M} = c:c(M, Opts), + [{a,b,c}] = M:M(), + ok. + %%% %%% Utilities. %%% diff --git a/lib/compiler/test/compile_SUITE_data/dialyzer_test.erl b/lib/compiler/test/compile_SUITE_data/dialyzer_test.erl new file mode 100644 index 0000000000..ed65ff9c43 --- /dev/null +++ b/lib/compiler/test/compile_SUITE_data/dialyzer_test.erl @@ -0,0 +1,39 @@ +%% +%% %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% +%% + +-module(dialyzer_test). +-export([?MODULE/0,turtle/0,test/1,huge/1]). + +-record(turtle, {a,b,c}). +-record(tortoise, {a,b,c}). + +?MODULE() -> + [{a,b,c}]. + +turtle() -> + #turtle{a=1,b=2,c=3}. + +test(T) -> + {T#tortoise.a,T#tortoise.b}. + +-file("dialyzer_test", 100000000). + +huge(X) -> + #turtle{a=42,b=100,c=511}, + X#tortoise.a. diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 6a7036d728..6e839f4c6e 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -36,7 +36,7 @@ all() -> [{group,p}]. groups() -> - [{p,test_lib:parallel(), + [{p,[parallel], [t_element,setelement,t_length,append,t_apply,bifs, eq,nested_call_in_case,guard_try_catch,coverage, unused_multiple_values_error,unused_multiple_values, diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index bd877bb528..0d23f12fb5 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -23,7 +23,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, head_mismatch_line/1,warnings_as_errors/1, bif_clashes/1, - transforms/1,forbidden_maps/1,bad_utf8/1]). + transforms/1,maps_warnings/1,bad_utf8/1]). %% Used by transforms/1 test case. -export([parse_transform/2]). @@ -37,7 +37,7 @@ all() -> groups() -> [{p,test_lib:parallel(), [head_mismatch_line,warnings_as_errors,bif_clashes, - transforms,forbidden_maps,bad_utf8]}]. + transforms,maps_warnings,bad_utf8]}]. init_per_suite(Config) -> Config. @@ -241,17 +241,30 @@ parse_transform(_, _) -> error(too_bad). -forbidden_maps(Config) when is_list(Config) -> - Ts1 = [{map_illegal_use_of_pattern, +maps_warnings(Config) when is_list(Config) -> + Ts1 = [{map_ok_use_of_pattern, <<" - -export([t/0]). + -export([t/1]). + t(K) -> + #{K := 1 = V} = id(#{<<\"hi all\">> => 1}), + V. + id(I) -> I. + ">>, + [return], + []}, + {map_illegal_use_of_pattern, + <<" + -export([t/0,t/2]). + t(K,#{ K := V }) -> V. t() -> V = 32, #{<<\"hi\",V,\"all\">> := 1} = id(#{<<\"hi all\">> => 1}). id(I) -> I. ">>, [return], - {error,[{5,erl_lint,{illegal_map_key_variable,'V'}}], []}}], + {error,[{3,erl_lint,{unbound_var,'K'}}, + {6,erl_lint,illegal_map_key}],[]}} + ], [] = run2(Config, Ts1), ok. diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl index afc04fd440..fb8da37f4f 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -118,6 +118,7 @@ math_functions(Config) when is_list(Config) -> ?line 0.0 = math:sinh(0), ?line 1.0 = math:cosh(0), ?line 0.0 = math:tanh(0), + 1.0 = math:log2(2), ?line 1.0 = math:log10(10), ?line -1.0 = math:cos(math:pi()), ?line 1.0 = math:exp(0), @@ -136,6 +137,7 @@ math_functions(Config) when is_list(Config) -> ?line 0.0 = math:sinh(id(0)), ?line 1.0 = math:cosh(id(0)), ?line 0.0 = math:tanh(id(0)), + 1.0 = math:log2(id(2)), ?line 1.0 = math:log10(id(10)), ?line 1.0 = math:exp(id(0)), ?line 0.0 = math:log(id(1)), diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 34bfdeb1e5..8db47ffa40 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -30,7 +30,7 @@ old_guard_tests/1, build_in_guard/1,gbif/1, t_is_boolean/1,is_function_2/1, - tricky/1,rel_ops/1,literal_type_tests/1, + tricky/1,rel_ops/1,rel_op_combinations/1,literal_type_tests/1, basic_andalso_orelse/1,traverse_dcd/1, check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, bad_constants/1,bad_guards/1]). @@ -42,12 +42,13 @@ all() -> [{group,p}]. groups() -> - [{p,test_lib:parallel(), + [{p,[parallel], [misc,const_cond,basic_not,complex_not,nested_nots, semicolon,complex_semicolon,comma,or_guard, more_or_guards,complex_or_guards,and_guard,xor_guard, more_xor_guards,build_in_guard,old_guard_tests,gbif, - t_is_boolean,is_function_2,tricky,rel_ops, + t_is_boolean,is_function_2,tricky, + rel_ops,rel_op_combinations, literal_type_tests,basic_andalso_orelse,traverse_dcd, check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, bad_constants,bad_guards]}]. @@ -330,7 +331,15 @@ complex_semicolon(Config) when is_list(Config) -> ?line ok = csemi6({a,b}, 0), ?line ok = csemi6({}, 3), ?line ok = csemi6({a,b,c}, 3), - + + %% 7 + error = csemi7(#{a=>1}, 1, 0), + error = csemi7(<<>>, 1, 0), + ok = csemi7(#{a=>1}, 3, 0), + ok = csemi7(#{a=>1}, 0, 3), + ok = csemi7(#{a=>1}, 3, 3), + ok = csemi7(#{a=>1, b=>3}, 0, 0), + ok. csemi1(Type, Val) when is_list(Val), Type == float; @@ -442,6 +451,9 @@ csemi5(_, _) -> error. csemi6(A, B) when hd([tuple_size(A)]) > 1; abs(B) > 2 -> ok; csemi6(_, _) -> error. +csemi7(A, B, C) when A#{a:=B} > #{a=>1}; abs(C) > 2 -> ok; +csemi7(_, _, _) -> error. + comma(Config) when is_list(Config) -> %% ',' combinations of literal true/false. @@ -1122,6 +1134,231 @@ rel_ops(Config) when is_list(Config) -> -undef(TestOp). +rel_op_combinations(Config) when is_list(Config) -> + Digits0 = lists:seq(16#0030, 16#0039) ++ + lists:seq(16#0660, 16#0669) ++ + lists:seq(16#06F0, 16#06F9), + Digits = gb_sets:from_list(Digits0), + rel_op_combinations_1(16#0700, Digits), + + BrokenRange0 = lists:seq(3, 5) ++ + lists:seq(10, 12) ++ lists:seq(14, 20), + BrokenRange = gb_sets:from_list(BrokenRange0), + rel_op_combinations_2(30, BrokenRange), + + Red0 = [{I,2*I} || I <- lists:seq(0, 50)] ++ + [{I,5*I} || I <- lists:seq(51, 80)], + Red = gb_trees:from_orddict(Red0), + rel_op_combinations_3(100, Red). + +rel_op_combinations_1(0, _) -> + ok; +rel_op_combinations_1(N, Digits) -> + Bool = gb_sets:is_member(N, Digits), + Bool = is_digit_1(N), + Bool = is_digit_2(N), + Bool = is_digit_3(N), + Bool = is_digit_4(N), + Bool = is_digit_5(N), + Bool = is_digit_6(N), + Bool = is_digit_7(N), + Bool = is_digit_8(N), + rel_op_combinations_1(N-1, Digits). + +is_digit_1(X) when 16#0660 =< X, X =< 16#0669 -> true; +is_digit_1(X) when 16#0030 =< X, X =< 16#0039 -> true; +is_digit_1(X) when 16#06F0 =< X, X =< 16#06F9 -> true; +is_digit_1(_) -> false. + +is_digit_2(X) when (16#0030-1) < X, X =< 16#0039 -> true; +is_digit_2(X) when (16#0660-1) < X, X =< 16#0669 -> true; +is_digit_2(X) when (16#06F0-1) < X, X =< 16#06F9 -> true; +is_digit_2(_) -> false. + +is_digit_3(X) when 16#0660 =< X, X < (16#0669+1) -> true; +is_digit_3(X) when 16#0030 =< X, X < (16#0039+1) -> true; +is_digit_3(X) when 16#06F0 =< X, X < (16#06F9+1) -> true; +is_digit_3(_) -> false. + +is_digit_4(X) when (16#0660-1) < X, X < (16#0669+1) -> true; +is_digit_4(X) when (16#0030-1) < X, X < (16#0039+1) -> true; +is_digit_4(X) when (16#06F0-1) < X, X < (16#06F9+1) -> true; +is_digit_4(_) -> false. + +is_digit_5(X) when X >= 16#0660, X =< 16#0669 -> true; +is_digit_5(X) when X >= 16#0030, X =< 16#0039 -> true; +is_digit_5(X) when X >= 16#06F0, X =< 16#06F9 -> true; +is_digit_5(_) -> false. + +is_digit_6(X) when X > (16#0660-1), X =< 16#0669 -> true; +is_digit_6(X) when X > (16#0030-1), X =< 16#0039 -> true; +is_digit_6(X) when X > (16#06F0-1), X =< 16#06F9 -> true; +is_digit_6(_) -> false. + +is_digit_7(X) when 16#0660 =< X, X =< 16#0669 -> true; +is_digit_7(X) when 16#0030 =< X, X =< 16#003A, X =/= 16#003A -> true; +is_digit_7(X) when 16#06F0 =< X, X =< 16#06F9 -> true; +is_digit_7(_) -> false. + +is_digit_8(X) when X =< 16#0039, X > (16#0030-1) -> true; +is_digit_8(X) when X =< 16#06F9, X > (16#06F0-1) -> true; +is_digit_8(X) when X =< 16#0669, X > (16#0660-1) -> true; +is_digit_8(16#0670) -> false; +is_digit_8(_) -> false. + +rel_op_combinations_2(0, _) -> + ok; +rel_op_combinations_2(N, Range) -> + Bool = gb_sets:is_member(N, Range), + Bool = broken_range_1(N), + Bool = broken_range_2(N), + Bool = broken_range_3(N), + Bool = broken_range_4(N), + Bool = broken_range_5(N), + Bool = broken_range_6(N), + Bool = broken_range_7(N), + Bool = broken_range_8(N), + Bool = broken_range_9(N), + Bool = broken_range_10(N), + Bool = broken_range_11(N), + Bool = broken_range_12(N), + Bool = broken_range_13(N), + rel_op_combinations_2(N-1, Range). + +broken_range_1(X) when X >= 10, X =< 20, X =/= 13 -> true; +broken_range_1(X) when X >= 3, X =< 5 -> true; +broken_range_1(_) -> false. + +broken_range_2(X) when X >= 10, X =< 12 -> true; +broken_range_2(X) when X >= 14, X =< 20 -> true; +broken_range_2(X) when X >= 3, X =< 5 -> true; +broken_range_2(_) -> false. + +broken_range_3(X) when X >= 10, X =< 12 -> true; +broken_range_3(X) when X >= 14, X < 21 -> true; +broken_range_3(3) -> true; +broken_range_3(4) -> true; +broken_range_3(5) -> true; +broken_range_3(_) -> false. + +broken_range_4(X) when X =< 5, X >= 3 -> true; +broken_range_4(X) when X >= 10, X =< 20, X =/= 13 -> true; +broken_range_4(X) when X =< 100 -> false; +broken_range_4(_) -> false. + +broken_range_5(X) when X >= 10, X =< 20, X =/= 13 -> true; +broken_range_5(X) when X > 2, X =< 5 -> true; +broken_range_5(_) -> false. + +broken_range_6(X) when X >= 10, X =< 20, X =/= 13 -> true; +broken_range_6(X) when X > 2, X < 6 -> true; +broken_range_6(_) -> false. + +broken_range_7(X) when X > 2, X < 6 -> true; +broken_range_7(X) when X >= 10, X =< 20, X =/= 13 -> true; +broken_range_7(X) when X > 30 -> false; +broken_range_7(_) -> false. + +broken_range_8(X) when X >= 10, X =< 20, X =/= 13 -> true; +broken_range_8(X) when X =:= 3 -> true; +broken_range_8(X) when X >= 3, X =< 5 -> true; +broken_range_8(_) -> false. + +broken_range_9(X) when X >= 10, X =< 20, X =/= 13 -> true; +broken_range_9(X) when X =:= 13 -> false; +broken_range_9(X) when X >= 3, X =< 5 -> true; +broken_range_9(_) -> false. + +broken_range_10(X) when X >= 3, X =< 5 -> true; +broken_range_10(X) when X >= 10, X =< 20, X =/= 13 -> true; +broken_range_10(X) when X =/= 13 -> false; +broken_range_10(_) -> false. + +broken_range_11(X) when X >= 10, X =< 20, X =/= 13 -> true; +broken_range_11(X) when is_tuple(X), X =:= 10 -> true; +broken_range_11(X) when X >= 3, X =< 5 -> true; +broken_range_11(_) -> false. + +broken_range_12(X) when X >= 3, X =< 5 -> true; +broken_range_12(X) when X >= 10, X =< 20, X =/= 13 -> true; +broken_range_12(X) when X < 30, X > 20 -> false; +broken_range_12(_) -> false. + +broken_range_13(X) when X >= 10, X =< 20, 13 =/= X -> true; +broken_range_13(X) when X >= 3, X =< 5 -> true; +broken_range_13(_) -> false. + +rel_op_combinations_3(0, _) -> + ok; +rel_op_combinations_3(N, Red) -> + Val = case gb_trees:lookup(N, Red) of + none -> none; + {value,V} -> V + end, + Val = redundant_1(N), + Val = redundant_2(N), + Val = redundant_3(N), + Val = redundant_4(N), + Val = redundant_5(N), + Val = redundant_6(N), + Val = redundant_7(N), + Val = redundant_8(N), + Val = redundant_9(N), + Val = redundant_10(N), + Val = redundant_11(N), + rel_op_combinations_3(N-1, Red). + +redundant_1(X) when X >= 51, X =< 80 -> 5*X; +redundant_1(X) when X < 51 -> 2*X; +redundant_1(_) -> none. + +redundant_2(X) when X < 51 -> 2*X; +redundant_2(X) when X >= 51, X =< 80 -> 5*X; +redundant_2(_) -> none. + +redundant_3(X) when X < 51 -> 2*X; +redundant_3(X) when X =< 80, X >= 51 -> 5*X; +redundant_3(X) when X =/= 100 -> none; +redundant_3(_) -> none. + +redundant_4(X) when X < 51 -> 2*X; +redundant_4(X) when X =< 80, X > 50 -> 5*X; +redundant_4(X) when X =/= 100 -> none; +redundant_4(_) -> none. + +redundant_5(X) when X < 51 -> 2*X; +redundant_5(X) when X > 50, X < 81 -> 5*X; +redundant_5(X) when X =< 10 -> none; +redundant_5(_) -> none. + +redundant_6(X) when X > 50, X =< 80 -> 5*X; +redundant_6(X) when X < 51 -> 2*X; +redundant_6(_) -> none. + +redundant_7(X) when is_integer(X), X >= 51, X =< 80 -> 5*X; +redundant_7(X) when is_integer(X), X < 51 -> 2*X; +redundant_7(_) -> none. + +redundant_8(X) when X >= 51, X =< 80 -> 5*X; +redundant_8(X) when X < 51 -> 2*X; +redundant_8(_) -> none. + +redundant_9(X) when X >= 51, X =< 80 -> 5*X; +redundant_9(X) when X < 51 -> 2*X; +redundant_9(90) -> none; +redundant_9(X) when X =/= 90 -> none; +redundant_9(_) -> none. + +redundant_10(X) when X >= 51, X =< 80 -> 5*X; +redundant_10(X) when X < 51 -> 2*X; +redundant_10(90) -> none; +redundant_10(X) when X =:= 90 -> none; +redundant_10(_) -> none. + +redundant_11(X) when X < 51 -> 2*X; +redundant_11(X) when X =:= 10 -> 2*X; +redundant_11(X) when X >= 51, X =< 80 -> 5*X; +redundant_11(_) -> none. %% Test type tests on literal values. (From emulator test suites.) literal_type_tests(Config) when is_list(Config) -> diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index 398398a397..6c5b34498b 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -18,12 +18,12 @@ %% -module(lc_SUITE). --author('[email protected]'). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, basic/1,deeply_nested/1,no_generator/1, - empty_generator/1,no_export/1]). + empty_generator/1,no_export/1,shadow/1, + effect/1]). -include_lib("test_server/include/test_server.hrl"). @@ -31,10 +31,18 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [basic, deeply_nested, no_generator, empty_generator, no_export]. + [{group,p}]. groups() -> - []. + [{p,test_lib:parallel(), + [basic, + deeply_nested, + no_generator, + empty_generator, + no_export, + shadow, + effect + ]}]. init_per_suite(Config) -> Config. @@ -59,34 +67,34 @@ end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> ok. basic(Config) when is_list(Config) -> - ?line L0 = lists:seq(1, 10), - ?line L1 = my_map(fun(X) -> {x,X} end, L0), - ?line L1 = [{x,X} || X <- L0], - ?line L0 = my_map(fun({x,X}) -> X end, L1), - ?line [1,2,3,4,5] = [X || X <- L0, X < 6], - ?line [4,5,6] = [X || X <- L0, X > 3, X < 7], - ?line [] = [X || X <- L0, X > 32, X < 7], - ?line [1,3,5,7,9] = [X || X <- L0, odd(X)], - ?line [2,4,6,8,10] = [X || X <- L0, not odd(X)], - ?line [1,3,5,9] = [X || X <- L0, odd(X), X =/= 7], - ?line [2,4,8,10] = [X || X <- L0, not odd(X), X =/= 6], + L0 = lists:seq(1, 10), + L1 = my_map(fun(X) -> {x,X} end, L0), + L1 = [{x,X} || X <- L0], + L0 = my_map(fun({x,X}) -> X end, L1), + [1,2,3,4,5] = [X || X <- L0, X < 6], + [4,5,6] = [X || X <- L0, X > 3, X < 7], + [] = [X || X <- L0, X > 32, X < 7], + [1,3,5,7,9] = [X || X <- L0, odd(X)], + [2,4,6,8,10] = [X || X <- L0, not odd(X)], + [1,3,5,9] = [X || X <- L0, odd(X), X =/= 7], + [2,4,8,10] = [X || X <- L0, not odd(X), X =/= 6], %% Append is specially handled. - ?line [1,3,5,9,2,4,8,10] = [X || X <- L0, odd(X), X =/= 7] ++ + [1,3,5,9,2,4,8,10] = [X || X <- L0, odd(X), X =/= 7] ++ [X || X <- L0, not odd(X), X =/= 6], %% Guards BIFs are evaluated in guard context. Weird, but true. - ?line [{a,b,true},{x,y,true,true}] = [X || X <- tuple_list(), element(3, X)], + [{a,b,true},{x,y,true,true}] = [X || X <- tuple_list(), element(3, X)], %% Filter expressions with andalso/orelse. - ?line "abc123" = alphanum("?abc123.;"), + "abc123" = alphanum("?abc123.;"), %% Error cases. - ?line [] = [{xx,X} || X <- L0, element(2, X) == no_no_no], - ?line {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]), - ?line [] = [X || X <- L1, X+1 < 2], - ?line {'EXIT',_} = (catch [X || X <- L1, odd(X)]), - ?line fc([x], catch [E || E <- id(x)]), + [] = [{xx,X} || X <- L0, element(2, X) == no_no_no], + {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]), + [] = [X || X <- L1, X+1 < 2], + {'EXIT',_} = (catch [X || X <- L1, odd(X)]), + fc([x], catch [E || E <- id(x)]), ok. tuple_list() -> @@ -116,12 +124,12 @@ deeply_nested_1() -> X16 <- [4],X17 <- [3],X18 <- [fun() -> X16+X17 end],X19 <- [2],X20 <- [1]]. no_generator(Config) when is_list(Config) -> - ?line Seq = lists:seq(-10, 17), - ?line [no_gen_verify(no_gen(A, B), A, B) || A <- Seq, B <- Seq], + Seq = lists:seq(-10, 17), + [no_gen_verify(no_gen(A, B), A, B) || A <- Seq, B <- Seq], %% Literal expression, for coverage. - ?line [a] = [a || true], - ?line [a,b,c] = [a || true] ++ [b,c], + [a] = [a || true], + [a,b,c] = [a || true] ++ [b,c], ok. no_gen(A, B) -> @@ -174,13 +182,40 @@ no_gen_eval(Fun, Res) -> no_gen_one_more(A, B) -> A + 1 =:= B. empty_generator(Config) when is_list(Config) -> - ?line [] = [X || {X} <- [], (false or (X/0 > 3))], + [] = [X || {X} <- [], (false or (X/0 > 3))], ok. no_export(Config) when is_list(Config) -> [] = [ _X = a || false ] ++ [ _X = a || false ], ok. +%% Test that variables in list comprehensions are +%% correctly shadowed. + +shadow(Config) when is_list(Config) -> + Shadowed = nomatch, + _ = id(Shadowed), %Eliminate warning. + L = [{Shadowed,Shadowed+1} || Shadowed <- lists:seq(7, 9)], + [{7,8},{8,9},{9,10}] = id(L), + [8,9] = id([Shadowed || {_,Shadowed} <- id(L), + Shadowed < 10]), + ok. + +effect(Config) when is_list(Config) -> + [{42,{a,b,c}}] = + do_effect(fun(F, L) -> + [F({V1,V2}) || + #{<<1:500>>:=V1,<<2:301>>:=V2} <- L], + ok + end, id([#{},x,#{<<1:500>>=>42,<<2:301>>=>{a,b,c}}])), + ok. + +do_effect(Lc, L) -> + put(?MODULE, []), + F = fun(V) -> put(?MODULE, [V|get(?MODULE)]) end, + ok = Lc(F, L), + lists:reverse(erase(?MODULE)). + id(I) -> I. fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok; diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 403b7e8405..bc5ae803c6 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -21,6 +21,7 @@ ]). -export([ + %% literals t_build_and_match_literals/1, t_update_literals/1,t_match_and_update_literals/1, t_update_map_expressions/1, @@ -32,6 +33,15 @@ t_map_size/1, t_build_and_match_aliasing/1, + %% variables + t_build_and_match_variables/1, + t_update_assoc_variables/1,t_update_exact_variables/1, + t_nested_pattern_expressions/1, + t_guard_update_variables/1, + t_guard_sequence_variables/1, + t_guard_sequence_mixed/1, + t_frequency_table/1, + %% warnings t_warn_useless_build/1, t_warn_pair_key_overloaded/1, @@ -51,7 +61,10 @@ suite() -> []. -all() -> [ +all() -> + test_lib:recompile(?MODULE), + [ + %% literals t_build_and_match_literals, t_update_literals, t_match_and_update_literals, t_update_map_expressions, @@ -62,6 +75,15 @@ all() -> [ t_map_size, t_build_and_match_aliasing, + %% variables + t_build_and_match_variables, + t_update_assoc_variables,t_update_exact_variables, + t_nested_pattern_expressions, + t_guard_update_variables, + t_guard_sequence_variables, + t_guard_sequence_mixed, + t_frequency_table, + %% warnings t_warn_useless_build, t_warn_pair_key_overloaded, @@ -73,6 +95,7 @@ all() -> [ t_build_and_match_nil, t_build_and_match_structure, + %% errors in 17.0-rc1 t_update_values, t_expand_map_update, @@ -119,6 +142,11 @@ t_build_and_match_literals(Config) when is_list(Config) -> %% nil key #{[]:=ok,1:=2} = id(#{[]=>ok,1=>2}), + #{1:=2,[]:=ok,1:=2} = id(#{[]=>ok,1=>2}), + + %% pseudo literals + #{ -3 := yep } = id(#{ -3 => yep }), + #{ <<0:358>> := "three" } = id(#{<<0:358>> =>"three"}), %% error case {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))), @@ -126,10 +154,10 @@ t_build_and_match_literals(Config) when is_list(Config) -> {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))), {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), - {'EXIT',{badarg,_}} = (catch id(#{<<0:258>> =>"three"})), {'EXIT',{{badmatch,_},_}} = (catch (#{#{"a"=>42} := 3}=id(#{#{"a"=>3}=>42}))), ok. + t_build_and_match_aliasing(Config) when is_list(Config) -> M1 = id(#{a=>1,b=>2,c=>3,d=>4}), #{c:=C1=_=_=C2} = M1, @@ -143,6 +171,19 @@ t_build_and_match_aliasing(Config) when is_list(Config) -> M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}), #{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2, #{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2, + + #{a:=A1,a:=A1,a:=A1,b:=B1,b:=B1} = #{a:=A1,a:=A1,a:=A1,b:=B1,b:=B1,b:=2} = M1, + #{"a":=A3,"b":=B3} = #{"a":=A3,"a":=A3} = #{"b":=B3,"b":=2} = M2, + + #{"a":=1,"b":=2,"c":=3,"d":=4} = #{"a":=A4,"b":=B4} = #{"a":=A4,"a":=A4} = #{"b":=B4,"d":=4} = M2, + #{"a":=A5,"b":=B5} = #{"a":=A5,"a":=A5} = #{"b":=B5,"d":=4} = #{"a":=1,"b":=2,"c":=3,"d":=4} = M2, + #{"a":=_,"b":=_} = #{"a":=_,"a":=_} = #{"b":=_,"d":=4} = #{"a":=1,"b":=2,"c":=3,"d":=4} = M2, + + M3 = id(#{<<12:300>>=>1,<<13:300>>=>2}), + #{<<12:300>> := V1, <<13:300>> := V2} = #{<<13:300>> := V2, <<12:300>> := V1} = M3, + #{<<12:300>> := 1, <<13:300>> := 2} = #{<<13:300>> := _, <<12:300>> := _} = M3, + #{<<13:300>> := _, <<12:300>> := _} = #{<<12:300>> := 1, <<13:300>> := 2} = M3, + ok. t_map_size(Config) when is_list(Config) -> @@ -241,11 +282,14 @@ t_update_assoc(Config) when is_list(Config) -> #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, M2 = M0#{3.0:=wrong,3.0=>new}, + % Can't handle directly yet + Bin = <<0:257>>, + #{ Bin := val } = id(M0#{<<0:257>> => val}), %% binary limitation + %% Errors cases. BadMap = id(badmap), {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}), - {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> => val}), %% limitation ok. t_update_exact(Config) when is_list(Config) -> @@ -275,14 +319,22 @@ t_update_exact(Config) when is_list(Config) -> {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting:=val}), {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation + + %% A workaround for a bug allowed an empty map to be updated. + {'EXIT',{badarg,_}} = (catch (id(#{}))#{a:=1}), + {'EXIT',{badarg,_}} = (catch #{}#{a:=1}), + Empty = #{}, + {'EXIT',{badarg,_}} = (catch Empty#{a:=1}), ok. t_update_values(Config) when is_list(Config) -> V0 = id(1337), M0 = #{ a => 1, val => V0}, V1 = get_val(M0), - M1 = M0#{ val := [V0,V1], "wazzup" => 42 }, + M1 = id(M0#{ val := [V0,V1], "wazzup" => 42 }), [1337, {some_val, 1337}] = get_val(M1), + M2 = id(M1#{ <<42:333>> => 1337 }), + {bin_key,1337} = get_val(M2), N = 110, List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)], @@ -308,6 +360,7 @@ t_export(Config) when is_list(Config) -> check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok. +get_val(#{ <<42:333>> := V }) -> {bin_key, V}; get_val(#{ "wazzup" := _, val := V}) -> V; get_val(#{ val := V }) -> {some_val, V}. @@ -437,7 +490,10 @@ guard_receive_loop() -> t_list_comprehension(Config) when is_list(Config) -> - [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + [#{k:=1},#{k:=2},#{k:=3}] = id([#{k=>I} || I <- [1,2,3]]), + Ls = id([#{<<2:301>> => I, "wat" => I + 1} || I <- [1,2,3]]), + [#{<<2:301>>:=1,"wat":=2},#{<<2:301>>:=2,"wat":=3},#{<<2:301>>:=3,"wat":=4}] = Ls, + [{1,2},{2,3},{3,4}] = id([{I2,I1} || #{"wat" := I1, <<2:301>> := I2} <- Ls]), ok. t_guard_fun(Config) when is_list(Config) -> @@ -601,5 +657,325 @@ t_build_and_match_structure(Config) when is_list(Config) -> end, ok. +%% simple build and match variables +t_build_and_match_variables(Config) when is_list(Config) -> + K0 = id(#{}), + K1 = id(1), V1 = id(a), + K2 = id(2), V2 = id(b), + K3 = id(3), V3 = id("c"), + K4 = id("4"), V4 = id("d"), + K5 = id(<<"5">>), V5 = id(<<"e">>), + K6 = id({"6",7}), V6 = id("f"), + K7 = id(#{ "a" => 3 }), + #{K1:=V1} = id(#{K1=>V1}), + #{K1:=V1,K2:=V2} = id(#{K1=>V1,K2=>V2}), + #{K1:=V1,K2:=V2,K3:=V3} = id(#{K1=>V1,K2=>V2,K3=>V3}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5}), + #{K1:=V1,K2:=V2,K3:=V3,K4:=V4,K5:=V5,K6:=V6} = id(#{K1=>V1,K2=>V2,K3=>V3,K4=>V4,K5=>V5,K6=>V6}), + + #{K5:=X,K5:=X=3,K4:=4} = id(#{K5=>3,K4=>4}), + #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{K5=>3,K4=>4}), + #{K5:=X,<<"5">>:=X=3,K4:=4} = id(#{<<"5">>=>3,K4=>4}), + + #{ K4:=#{ K3:=#{K1:=V1, K2:=V2}}, K5:=V5} = + id(#{ K5=>V5, K4=>#{ K3=>#{K2 => V2, K1 => V1}}}), + #{ K4 := #{ K5 := Res }, K6 := Res} = id(#{K4=>#{K5 => 99}, K6 => 99}), + + %% has keys + #{a :=_,b :=_,K1:=_,K2:=_,K3:=V3,K4:=ResKey,K4:=ResKey,"4":=ResKey,"4":="ok"} = + id(#{ a=>1, b=>1, K1=>V1, K2=>V2, K3=>V3, K4=>"nope", "4"=>"ok" }), + + %% function + ok = match_function_map_neg_keys(#{ -1 => a, -2 => b, -3 => c }), + + %% map key + #{ K0 := 42 } = id(#{ K0 => 42 }), + #{ K7 := 42 } = id(#{ K7 => 42 }), + + %% nil key + KNIL = id([]), + #{KNIL:=ok,1:=2} = id(#{KNIL=>ok,1=>2}), + + Bin = <<0:258>>, + #{ Bin := "three" } = id(#{<<0:258>> =>"three"}), + + %% error case + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3,x:=2} = id(#{K5=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=2} = id(#{K5=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id({a,b,c}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(#{K6=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K5:=3} = id(K7))), + {'EXIT',{{badmatch,_},_}} = (catch (#{K7:=3} = id(#{K7=>42}))), + ok. + + +match_function_map_neg_keys(#{ -1 := a, -2 := b, -3 := c }) -> ok. + +t_update_assoc_variables(Config) when is_list(Config) -> + K1 = id(1), + K2 = id(2), + K3 = id(3.0), + K4 = id(4), + K5 = id(5), + K6 = id(2.0), + + M0 = #{K1=>a,K2=>b,K3=>c,K4=>d,K5=>e}, + + M1 = M0#{K1=>42,K2=>100,K4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,K3:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,K6=>100,4.0=>[a,b,c]}, + + M2 = M0#{K3=>new}, + #{1:=a,2:=b,K3:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,K3=>new}, + + #{ <<0:258>> := val } = id(M0#{<<0:258>> => val}), %% binary limitation + + %% Errors cases. + BadMap = id(badmap), + {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}), + {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}), + ok. + +t_update_exact_variables(Config) when is_list(Config) -> + K1 = id(1), + K2 = id(2), + K3 = id(3.0), + K4 = id(4), + + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{K1:=42,K2:=100,K4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,K4:=[a,b,c],5:=e} = M1, + M1 = M0#{K1:=wrong,1:=also_wrong,K1=>42,2=>wrong,K2:=100,4:=[a,b,c]}, + + M2 = M0#{K3:=new}, + #{1:=a,K2:=b,3.0:=new,K4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,K3:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,K3:=new}, + + M3 = id(#{ 1 => val}), + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, K1 := update, K1=> update3, + K1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, + + #{ "wat" := 3, 2 := a } = id(#{ "wat" => 1, K2 => 2 }#{ K2 := a, "wat" := 3 }), + + %% Errors cases. + {'EXIT',{badarg,_}} = (catch ((id(nil))#{ a := b })), + {'EXIT',{badarg,_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting:=val}), + {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation + ok. + +t_nested_pattern_expressions(Config) when is_list(Config) -> + K1 = id("hello"), + %K2 = id({ok}), + [_,_,#{ <<"hi">> := wat, K1 := 42 }|_] = id([k,k,#{<<"hi">> => wat, K1 => 42}]), + [_,_,#{ -1 := wat, K1 := 42 }|_] = id([k,k,#{-1 => wat, K1 => 42}]), + [_,_,{#{ -1 := #{ {-3,<<0:300>>} := V1 }, K1 := 42 },3}|_] = id([k,k,{#{-1 => #{{-3,<<0:300>>}=>"hi"}, K1 => 42},3}]), + "hi" = V1, + %[k,#{ {-1,K1,[]} := {wat,K1}, K2 := 42 }|_] = id([k,#{{-1,K1,[]} => {wat,K1}, K2 => 42}]), + %[k,#{ [-1,K2,[]] := {wat,K1}, K1 := 42 }|_] = id([k,#{[-1,K2,[]] => {wat,K1}, K1 => 42}]), + + M0 = id(#{ <<33:333>> => 1, <<332:333>> => ok, a => ok, wat => yep, watzor => ok }), + F0 = map_nested_pattern_funs(M0), + F1 = F0(wat), + F2 = F1(watzor), + {yep,ok} = F2(M0), + ok. + +map_nested_pattern_funs(M) -> + K0 = id(a), + fun(K1) -> + case M of + #{ K0 := ok, K1 := yep, <<33:333>> := 1 } -> + fun(K2) -> + case M of + #{ K2 := ok, K1 := yep, <<33:333>> := 1 } -> + fun + (#{ <<332:333>> := ok, K1 := V1, K2 := V2 }) -> + {V1,V2} + end + end + end + end + end. + +t_guard_update_variables(Config) when is_list(Config) -> + error = map_guard_update_variables(n,#{},#{}), + first = map_guard_update_variables(x,#{}, #{x=>first}), + second = map_guard_update_variables(x,#{y=>old}, #{x=>second,y=>old}), + third = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>third,y=>old}), + fourth = map_guard_update_variables(x,#{x=>old,y=>old}, #{x=>4,y=>new}), + ok. + +map_guard_update_variables(K,M1,M2) when M1#{K=>first} =:= M2 -> first; +map_guard_update_variables(K,M1,M2) when M1#{K=>second} =:= M2 -> second; +map_guard_update_variables(K,M1,M2) when M1#{K:=third} =:= M2 -> third; +map_guard_update_variables(K,M1,M2) when M1#{K:=4,y=>new} =:= M2 -> fourth; +map_guard_update_variables(_,_,_) -> error. + +t_guard_sequence_variables(Config) when is_list(Config) -> + {1,"a"} = map_guard_sequence_var_1(a,#{seq=>1,a=>id("a"),b=>no}), + {2,"b"} = map_guard_sequence_var_1(b,#{seq=>2,b=>id("b"),a=>no}), + {3,"c"} = map_guard_sequence_var_1(a,#{seq=>3,a=>id("c"),b=>no}), + {4,"d"} = map_guard_sequence_var_1(b,#{seq=>4,b=>id("d"),a=>no}), + {4,4} = map_guard_sequence_var_1(seq,#{seq=>4}), + {4,4,y} = map_guard_sequence_var_1(seq,#{seq=>4,b=>id("d"),a=>y}), + {5,"d"} = map_guard_sequence_var_1(b,#{seq=>5,b=>id("d"),a=>y}), + + %% error case + {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_var_1("a",#{seq=>4,val=>id("e")})), + ok. + + +map_guard_sequence_var_1(K,M) -> + case M of + #{seq:=1=Seq, K:=Val} -> {Seq,Val}; + #{seq:=2=Seq, K:=Val} -> {Seq,Val}; + #{seq:=3=Seq, K:=Val} -> {Seq,Val}; + #{K:=4=Seq, K:=Val1,a:=Val2} -> {Seq,Val1,Val2}; + #{seq:=4=Seq, K:=Val} -> {Seq,Val}; + #{K:=4=Seq, K:=Val} -> {Seq,Val}; + #{seq:=5=Seq, K:=Val} -> {Seq,Val} + end. + + +t_guard_sequence_mixed(Config) when is_list(Config) -> + M0 = id(#{ a=>1, b=>1, c=>1, d=>1, e=>1, f=>1, g=>1, h=>1 }), + M1 = id(M0#{ d := 3 }), + 1 = map_guard_sequence_mixed(a,d,M1), + M2 = id(M1#{ b := 2, d := 4, h := 2 }), + 2 = map_guard_sequence_mixed(a,d,M2), + M3 = id(M2#{ b := 3, e := 5, g := 3 }), + 3 = map_guard_sequence_mixed(a,e,M3), + M4 = id(M3#{ c := 4, e := 6, h := 1 }), + 4 = map_guard_sequence_mixed(a,e,M4), + M5 = id(M4#{ c := 5, f := 7, g := 2 }), + 5 = map_guard_sequence_mixed(a,f,M5), + M6 = id(M5#{ c := 6, f := 8, h := 3 }), + 6 = map_guard_sequence_mixed(a,f,M6), + + %% error case + {'EXIT',{{case_clause,_},_}} = (catch map_guard_sequence_mixed(a,b,M0)), + ok. + +map_guard_sequence_mixed(K1,K2,M) -> + case M of + #{ K1 := 1, b := 1, K2 := 3, g := 1} -> 1; + #{ K1 := 1, b := 2, K2 := 4, h := 2} -> 2; + #{ K1 := 1, b := 3, K2 := 5, g := 3} -> 3; + #{ K1 := 1, c := 4, K2 := 6, h := 1} -> 4; + #{ K1 := 1, c := 5, K2 := 7, g := 2} -> 5; + #{ K1 := 1, c := 6, K2 := 8, h := 3} -> 6 + end. + + + +t_frequency_table(Config) when is_list(Config) -> + random:seed({13,1337,54}), % pseudo random + N = 100000, + Ts = rand_terms(N), + #{ n:=N, tf := Tf } = frequency_table(Ts,#{ n=>0, tf => #{}}), + ok = check_frequency(Ts,Tf), + ok. + + +frequency_table([T|Ts], M) -> + case M of + #{ n := N, tf := #{ T := C } = F } -> + frequency_table(Ts,M#{ n := N + 1, tf := F#{ T := C + 1 }}); + #{ n := N, tf := F } -> + frequency_table(Ts,M#{ n := N + 1, tf := F#{ T => 1 }}) + end; +frequency_table([], M) -> M. + + +check_frequency(Ts,Tf) -> + check_frequency(Ts,Tf,dict:new()). + +check_frequency([T|Ts],Tf,D) -> + case dict:find(T,D) of + error -> check_frequency(Ts,Tf,dict:store(T,1,D)); + {ok,C} -> check_frequency(Ts,Tf,dict:store(T,C+1,D)) + end; +check_frequency([],Tf,D) -> + validate_frequency(dict:to_list(D),Tf). + +validate_frequency([{T,C}|Fs],Tf) -> + case Tf of + #{ T := C } -> validate_frequency(Fs,Tf); + _ -> error + end; +validate_frequency([], _) -> ok. + + +%% aux + +rand_terms(0) -> []; +rand_terms(N) -> [rand_term()|rand_terms(N-1)]. + +rand_term() -> + case random:uniform(6) of + 1 -> rand_binary(); + 2 -> rand_number(); + 3 -> rand_atom(); + 4 -> rand_tuple(); + 5 -> rand_list(); + 6 -> rand_map() + end. + +rand_binary() -> + case random:uniform(3) of + 1 -> <<>>; + 2 -> <<"hi">>; + 3 -> <<"message text larger than 64 bytes. yep, message text larger than 64 bytes.">> + end. + +rand_number() -> + case random:uniform(3) of + 1 -> random:uniform(5); + 2 -> float(random:uniform(5)); + 3 -> 1 bsl (63 + random:uniform(3)) + end. + +rand_atom() -> + case random:uniform(3) of + 1 -> hi; + 2 -> some_atom; + 3 -> some_other_atom + end. + + +rand_tuple() -> + case random:uniform(3) of + 1 -> {ok, rand_term()}; % careful + 2 -> {1, 2, 3}; + 3 -> {<<"yep">>, 1337} + end. + +rand_list() -> + case random:uniform(3) of + 1 -> "hi"; + 2 -> [1,rand_term()]; % careful + 3 -> [improper|list] + end. + +rand_map() -> + case random:uniform(3) of + 1 -> #{ hi => 3 }; + 2 -> #{ wat => rand_term(), other => 3 }; % careful + 3 -> #{ hi => 42, other => 42, yet_anoter => 1337 } + end. + + + %% Use this function to avoid compile-time evaluation of an expression. id(I) -> I. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index e5aaf49d6f..74efed7588 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -22,7 +22,8 @@ init_per_group/2,end_per_group/2, pmatch/1,mixed/1,aliases/1,match_in_call/1, untuplify/1,shortcut_boolean/1,letify_guard/1, - selectify/1,underscore/1,match_map/1,coverage/1]). + selectify/1,underscore/1,match_map/1,map_vars_used/1, + coverage/1]). -include_lib("test_server/include/test_server.hrl"). @@ -33,10 +34,10 @@ all() -> [{group,p}]. groups() -> - [{p,test_lib:parallel(), + [{p,[parallel], [pmatch,mixed,aliases,match_in_call,untuplify, shortcut_boolean,letify_guard,selectify, - underscore,match_map,coverage]}]. + underscore,match_map,map_vars_used,coverage]}]. init_per_suite(Config) -> @@ -412,6 +413,19 @@ do_match_map(#s{map=#{key:=Val}}=S) -> %% Would crash with a 'badarg' exception. S#s{t=Val}. +map_vars_used(Config) when is_list(Config) -> + {some,value} = do_map_vars_used(a, b, #{{a,b}=>42,v=>{some,value}}), + ok. + +do_map_vars_used(X, Y, Map) -> + case {X,Y} of + T -> + %% core_lib:is_var_used/2 would not consider T used. + #{T:=42,v:=Val} = Map, + Val + end. + + coverage(Config) when is_list(Config) -> %% Cover beam_dead. ok = coverage_1(x, a), diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 44c7161530..d721a86f5a 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -60,7 +60,7 @@ all() -> [{group,p}]. groups() -> - [{p,[],%%test_lib:parallel(), + [{p,[], [tobias,empty_string,md5,silly_coverage, confused_literals,integer_encoding,override_bif]}]. @@ -225,14 +225,15 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, ?line expect_error(fun() -> beam_bool:module(BoolInput, []) end), - %% beam_dead + %% beam_dead. This is tricky. Our function must look OK to + %% beam_utils:clean_labels/1, but must crash beam_dead. DeadInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, [{label,1}, {func_info,{atom,?MODULE},{atom,foo},0}, {label,2}, - {jump,bad}]}],99}, - ?line expect_error(fun() -> beam_block:module(DeadInput, []) end), + {test,is_eq_exact,{f,1},[bad,operands]}]}],99}, + expect_error(fun() -> beam_dead:module(DeadInput, []) end), %% beam_clean CleanInput = {?MODULE,[{foo,0}],[], diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 00a6e900d4..fb82bf6101 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -187,12 +187,13 @@ ref_opt(Config) when is_list(Config) -> end. ref_opt_1(Config) -> - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), Sources = filelib:wildcard(filename:join([DataDir,"ref_opt","*.{erl,S}"])), - ?line test_lib:p_run(fun(Src) -> - do_ref_opt(Src, PrivDir) - end, Sources), + test_lib:p_run(fun(Src) -> + do_ref_opt(Src, PrivDir) + end, Sources), + cover_recv_instructions(), ok. do_ref_opt(Source, PrivDir) -> @@ -202,9 +203,9 @@ do_ref_opt(Source, PrivDir) -> {outdir,PrivDir}] ++ [from_asm || Ext =:= ".S" ]), Base = filename:rootname(filename:basename(Source), Ext), - code:purge(list_to_atom(Base)), - BeamFile = filename:join(PrivDir, Base), - code:load_abs(BeamFile), + code:purge(list_to_atom(Base)), + BeamFile = filename:join(PrivDir, Base), + code:load_abs(BeamFile), ok = Mod:Mod(), {beam_file,Mod,_,_,_,Code} = beam_disasm:file(BeamFile), case Base of @@ -232,6 +233,27 @@ collect_recv_opt_instrs(Code) -> end] || {function,_,_,_,Is} <- Code], lists:append(L). +cover_recv_instructions() -> + %% We want to cover the handling of recv_mark and recv_set in beam_utils. + %% Since those instructions are introduced in a late optimization pass, + %% beam_utils:live_opt() will not see them unless the compilation is + %% started from a .S file. The compile_SUITE:asm/1 test case will + %% compile all test suite files to .S and then run them through the + %% compiler again. + %% + %% Here will we will ensure that this modules contains recv_mark + %% and recv_set instructions. + Pid = spawn_link(fun() -> + receive {Parent,Ref} -> + Parent ! Ref + end + end), + Ref = make_ref(), + Pid ! {self(),Ref}, + receive + Ref -> ok + end. + export(Config) when is_list(Config) -> Ref = make_ref(), ?line self() ! {result,Ref,42}, diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index a8befbecd9..e06e42276a 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -44,6 +44,10 @@ smoke_disasm(File) when is_list(File) -> Res = beam_disasm:file(File), {beam_file,_Mod} = {element(1, Res),element(2, Res)}. +%% If we are running cover, we don't want to run test cases that +%% invokes the compiler in parallel, as doing so would probably +%% be slower than running them sequentially. + parallel() -> case ?t:is_cover() orelse erlang:system_info(schedulers) =:= 1 of true -> []; @@ -90,13 +94,18 @@ get_data_dir(Config) -> %% Will fail the test case if there were any errors. p_run(Test, List) -> + S = erlang:system_info(schedulers), N = case ?t:is_cover() of false -> - erlang:system_info(schedulers); + S + 1; true -> - %% Cover is running. Using more than one process - %% will probably only slow down compilation. - 1 + %% Cover is running. Using too many processes + %% could slow us down. Measurements on my computer + %% showed that using 4 parallel processes was + %% slightly faster than using 3. Using more than + %% 4 would not buy us much and could actually be + %% slower. + max(S, 4) end, p_run_loop(Test, List, N, [], 0, 0). diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 4530d08c77..b490257a6e 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -35,7 +35,7 @@ all() -> [{group,p}]. groups() -> - [{p,test_lib:parallel(), + [{p,[parallel], [basic,lean_throw,try_of,try_after,catch_oops, after_oops,eclectic,rethrow,nested_of,nested_catch, nested_after,nested_horrid,last_call_optimization, diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index 0637041873..6e5a7d35e9 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -601,7 +601,7 @@ maps(Config) when is_list(Config) -> ">>, [], {warnings,[{3,v3_core,bad_map}]}}, - {bad_map_literal_key, + {ok_map_literal_key, <<" t() -> V = id(1), @@ -614,7 +614,7 @@ maps(Config) when is_list(Config) -> id(I) -> I. ">>, [], - {warnings,[{6,v3_core,nomatch}]}}], + []}], run(Config, Ts), ok. @@ -699,10 +699,10 @@ run(Config, Tests) -> %% Compiles a test module and returns the list of errors and warnings. run_test(Conf, Test0, Warnings) -> - Mod = "warnings_"++test_lib:uniq(), - Filename = Mod ++ ".erl", + Module = "warnings_"++test_lib:uniq(), + Filename = Module ++ ".erl", ?line DataDir = ?privdir, - Test = ["-module(", Mod, "). ", Test0], + Test = ["-module(", Module, "). ", Test0], ?line File = filename:join(DataDir, Filename), ?line Opts = [binary,export_all,return|Warnings], ?line ok = file:write_file(File, Test), |