diff options
Diffstat (limited to 'lib/compiler')
-rw-r--r-- | lib/compiler/src/cerl.erl | 42 | ||||
-rw-r--r-- | lib/compiler/src/cerl_clauses.erl | 46 | ||||
-rw-r--r-- | lib/compiler/src/core_lib.erl | 13 | ||||
-rw-r--r-- | lib/compiler/src/core_parse.hrl | 3 | ||||
-rw-r--r-- | lib/compiler/src/core_parse.yrl | 72 | ||||
-rw-r--r-- | lib/compiler/src/core_pp.erl | 10 | ||||
-rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 10 | ||||
-rw-r--r-- | lib/compiler/src/v3_core.erl | 95 | ||||
-rw-r--r-- | lib/compiler/src/v3_kernel.erl | 106 | ||||
-rw-r--r-- | lib/compiler/test/compile_SUITE.erl | 71 | ||||
-rw-r--r-- | lib/compiler/test/lc_SUITE.erl | 91 | ||||
-rw-r--r-- | lib/compiler/test/map_SUITE.erl | 6 | ||||
-rw-r--r-- | lib/compiler/test/match_SUITE.erl | 18 | ||||
-rw-r--r-- | lib/compiler/test/warnings_SUITE.erl | 6 |
14 files changed, 352 insertions, 237 deletions
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 7a2c3d70de..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. 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/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_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 03801a9b6d..01922c3fdf 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -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/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index f3e90f8eb2..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). diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 612660c2d6..a9b54005d1 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -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{}. @@ -535,7 +536,7 @@ expr({tuple,L,Es0}, St0) -> A = record_anno(L, St1), {annotate_tuple(A, Es1, St1),Eps,St1}; expr({map,L,Es0}, St0) -> - map_build_pair_chain(#c_literal{val=#{}},Es0,lineno_anno(L,St0),St0); + map_build_pairs(#c_literal{val=#{}}, Es0, lineno_anno(L, St0), St0); expr({map,L,M0,Es0}, St0) -> try expr_map(M0,Es0,lineno_anno(L, St0),St0) of {_,_,_}=Res -> Res @@ -778,66 +779,35 @@ 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}; {_,_} -> - {M2,Eps,St2} = map_build_pair_chain(M1,Es0,A,St1), + {M2,Eps,St2} = map_build_pairs(M1, Es0, A, St1), {M2,Mps++Eps,St2} end; false -> throw({bad_map,bad_map}) end. -%% Group continuous literal blocks and single variables, i.e. -%% M0#{ a := 1, b := V1, K1 := V2, K2 := 42} -%% becomes equivalent to -%% M1 = M0#{ a := 1, b := V1 }, -%% M2 = M1#{ K1 := V1 }, -%% M3 = M2#{ K2 := 42 } - -map_build_pair_chain(M,Es,A,St) -> - %% hack, remove iset if only literal - case map_build_pair_chain(M,Es,A,St,[]) of - {_,[#iset{arg=#c_literal{}=Val}],St1} -> {Val,[],St1}; - Normal -> Normal +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_pair_chain(M0,[],_,St,Mps) -> - {M0,Mps,St}; -map_build_pair_chain(M0,Es0,A,St0,Mps) -> - % group continuous literal blocks - % Anno = #a{anno=[compiler_generated]}, - % order is important, we need to reverse the literals - case map_pair_block(Es0,[],[],St0) of - {{CesL,EspL},{[],[]},Es1,St1} -> - {MVar,St2} = new_var(St1), - Pre = [#iset{var=MVar, arg=ann_c_map(A,M0,reverse(CesL))}], - map_build_pair_chain(MVar,Es1,A,St2,Mps++EspL++Pre); - {{[],[]},{CesV,EspV},Es1,St1} -> - {MVar,St2} = new_var(St1), - Pre = [#iset{var=MVar, arg=#c_map{arg=M0,es=CesV, anno=A}}], - map_build_pair_chain(MVar,Es1,A,St2,Mps ++ EspV++Pre); - {{CesL,EspL},{CesV,EspV},Es1,St1} -> - {MVarL,St2} = new_var(St1), - {MVarV,St3} = new_var(St2), - Pre = [#iset{var=MVarL, arg=ann_c_map(A,M0,reverse(CesL))}, - #iset{var=MVarV, arg=#c_map{arg=MVarL,es=CesV,anno=A}}], - map_build_pair_chain(MVarV,Es1,A,St3,Mps++EspL++EspV++Pre) - end. - -map_pair_block([{Op,L,K0,V0}|Es],Ces,Esp,St0) -> - {K,Ep0,St1} = safe(K0, St0), - {V,Ep1,St2} = safe(V0, St1), - A = lineno_anno(L, St2), - Pair0 = map_op_to_c_map_pair(Op), - Pair1 = Pair0#c_map_pair{anno=A,key=K,val=V}, - case cerl:is_literal(K) of - true -> - map_pair_block(Es,[Pair1|Ces],Ep0 ++ Ep1 ++ Esp,St2); - false -> - {{Ces,Esp},{[Pair1],Ep0++Ep1},Es,St2} - end; -map_pair_block([],Ces,Esp,St) -> - {{Ces,Esp},{[],[]},[],St}. +map_build_pairs_1([{Op0,L,K0,V0}|Es], St0) -> + {K,Pre0,St1} = safe(K0, St0), + {V,Pre1,St2} = safe(V0, St1), + {Pairs,Pre2,St3} = map_build_pairs_1(Es, St2), + As = lineno_anno(L, St3), + Op = map_op(Op0), + Pair = cerl:ann_c_map_pair(As, Op, K, V), + {[Pair|Pairs],Pre0++Pre1++Pre2,St3}; +map_build_pairs_1([], St) -> + {[],[],St}. -map_op_to_c_map_pair(map_field_assoc) -> #c_map_pair{op=#c_literal{val=assoc}}; -map_op_to_c_map_pair(map_field_exact) -> #c_map_pair{op=#c_literal{val=exact}}. +map_op(map_field_assoc) -> #c_literal{val=assoc}; +map_op(map_field_exact) -> #c_literal{val=exact}. is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true; is_valid_map_src(#c_var{}) -> true; @@ -1011,7 +981,8 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. %% This TQ from Simon PJ pp 127-138. -lc_tq(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard, +lc_tq(Line, E, [#igen{anno=GAnno,ceps=Ceps, + acc_pat=AccPat,acc_guard=AccGuard, skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, arg={Pre,Arg}}|Qs], Mc, St0) -> {Name,St1} = new_fun_name("lc", St0), @@ -1046,7 +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) -> @@ -1071,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), @@ -1109,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) -> @@ -1245,8 +1217,9 @@ generator(Line, {generate,Lg,P0,E}, Gs, St0) -> ann_c_cons(LA, Skip, Tail)} end, {Ce,Pre,St4} = safe(E, St3), - Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, - tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Ceps++Pre,Ce}}, + Gen = #igen{anno=#a{anno=GA},ceps=Ceps, + acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, + tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Pre,Ce}}, {Gen,St4}; generator(Line, {b_generate,Lg,P,E}, Gs, St0) -> LA = lineno_anno(Line, St0), @@ -1634,7 +1607,7 @@ pattern({tuple,L,Ps}, St) -> {annotate_tuple(record_anno(L, St), Ps1, St),Eps,St1}; pattern({map,L,Pairs}, St0) -> {Ps,Eps,St1} = pattern_map_pairs(Pairs, St0), - {#c_map{anno=lineno_anno(L, St1), es=Ps},Eps,St1}; + {#c_map{anno=lineno_anno(L, St1),es=Ps,is_pat=true},Eps,St1}; pattern({bin,L,Ps}, St) -> %% We don't create a #ibinary record here, since there is %% no need to hold any used/new annotations in a pattern. diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 6504351c02..72e7a39333 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -521,62 +521,76 @@ 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,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_remove_dup_keys(Es) -> + dict:to_list(map_remove_dup_keys(Es, dict:new())). -map_key_set_used(K,How,Used) -> - dict:store(map_key_clean(K),How,Used). - -map_key_is_used(K,Used) -> - dict:find(map_key_clean(K),Used). +map_remove_dup_keys([{assoc,K0,V}|Es0],Used0) -> + K = map_key_clean(K0), + Op = case dict:find(K, Used0) of + {ok,{exact,_,_}} -> exact; + _ -> assoc + end, + Used1 = dict:store(K, {Op,K0,V}, Used0), + map_remove_dup_keys(Es0, Used1); +map_remove_dup_keys([{exact,K0,V}|Es0],Used0) -> + K = map_key_clean(K0), + Op = case dict:find(K, Used0) of + {ok,{assoc,_,_}} -> assoc; + _ -> exact + end, + Used1 = dict:store(K, {Op,K0,V}, Used0), + map_remove_dup_keys(Es0, Used1); +map_remove_dup_keys([], Used) -> Used. -%% Be explicit instead of using set_kanno(K,[]) +%% Be explicit instead of using set_kanno(K, []). map_key_clean(#k_var{name=V}) -> {var,V}; map_key_clean(#k_literal{val=V}) -> {lit,V}; map_key_clean(#k_int{val=V}) -> {lit,V}; diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 0ff03c4295..1c96abe017 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -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. 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 dbac61765b..bc5ae803c6 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -319,6 +319,12 @@ 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) -> diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 033988e4c8..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"). @@ -36,7 +37,7 @@ groups() -> [{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/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index be0348a92d..6e5a7d35e9 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -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), |