diff --git a/erts/doc/guides/absform.md b/erts/doc/guides/absform.md index 6f15630dd98b..82161c754d44 100644 --- a/erts/doc/guides/absform.md +++ b/erts/doc/guides/absform.md @@ -292,6 +292,9 @@ An expression E is one of the following: A qualifier Q is one of the following: - If Q is a filter `E`, where `E` is an expression, then Rep(Q) = `Rep(E)`. +- If Q is a zip generator `Q_1 && ...&& Q_k]`, where each `Q_i` is + a non-zip generator, then Rep(E) = `{zip,ANNO,[Rep(Q_1), ..., Rep(Q_k)]}`. + For Rep(Q), see below. - If Q is a list generator `P <- E`, where `P` is a pattern and `E` is an expression, then Rep(Q) = `{generate,ANNO,Rep(P),Rep(E)}`. - If Q is a bitstring generator `P <= E`, where `P` is a pattern and `E` is an diff --git a/erts/preloaded/ebin/erts_internal.beam b/erts/preloaded/ebin/erts_internal.beam index c96be4c25dfb..4b406587168d 100644 Binary files a/erts/preloaded/ebin/erts_internal.beam and b/erts/preloaded/ebin/erts_internal.beam differ diff --git a/erts/preloaded/src/erts_internal.erl b/erts/preloaded/src/erts_internal.erl index e0aaf5ee6af8..c5ee8e01aa74 100644 --- a/erts/preloaded/src/erts_internal.erl +++ b/erts/preloaded/src/erts_internal.erl @@ -504,7 +504,9 @@ is_map_iter(Iter) -> NI :: term(). mc_refill([Path | Map]) -> - erts_internal:map_next(Path, Map, iterator). + erts_internal:map_next(Path, Map, iterator); +mc_refill(NoRefillNeeded) when is_tuple(NoRefillNeeded) -> + NoRefillNeeded. -spec erts_internal:flush_monitor_messages(Ref, Multi, Res) -> term() when Ref :: reference(), diff --git a/lib/compiler/src/sys_coverage.erl b/lib/compiler/src/sys_coverage.erl index 2c0539a37c34..abb755a8190b 100644 --- a/lib/compiler/src/sys_coverage.erl +++ b/lib/compiler/src/sys_coverage.erl @@ -561,6 +561,12 @@ munge_qs([{m_generate,Anno,Pattern,Expr}|Qs], Vars0, MQs) -> A = element(2, Expr), {MExpr, Vars1} = munge_expr(Expr, Vars0), munge_qs1(Qs, A, {m_generate,Anno,Pattern,MExpr}, Vars0, Vars1, MQs); +munge_qs([{zip,Anno,Gs0}|Qs], Vars0, MQs) -> + {Gs1, Vars1} = munge_qualifiers(Gs0, Vars0), + %% Get rid of dummy filters inserted by munge_qualifiers/2 -- + %% they are not allowed in the zip construct. + Gs = [G || G <- Gs1, element(1, G) =/= block], + munge_qs1(Qs, Anno, {zip,Anno,Gs}, Vars0, Vars1, MQs); munge_qs([Expr|Qs], Vars0, MQs) -> A = element(2, Expr), {MungedExpr, Vars1} = munge_expr(Expr, Vars0), diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 5a6ec26b1b8d..dcaeff727fbb 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -82,9 +82,12 @@ -export([module/2,format_error/1]). --import(lists, [any/2,reverse/1,reverse/2,map/2,member/2,foldl/3,foldr/3,mapfoldl/3, - splitwith/2,keydelete/3,keyfind/3,keymember/3,sort/1,droplast/1,last/1, - duplicate/2]). +-import(lists, [all/2,any/2,append/1,droplast/1,duplicate/2, + foldl/3,foldr/3, + keydelete/3,keyfind/3,keymember/3, + last/1,map/2,member/2,mapfoldl/3, + reverse/1,reverse/2, + splitwith/2,sort/1, zip/2]). -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_tuple/2,c_tuple/1, @@ -123,6 +126,9 @@ -record(igen, {anno=#a{},acc_pat,acc_guard, skip_pat,tail,tail_pat,arg, refill={nomatch,ignore}}). +-record(izip, {anno=#a{},acc_pats,acc_guard, + skip_pats,tails,tail_pats,pres,args, + refill_pats,refill_as}). -record(isimple, {anno=#a{},term :: cerl:cerl()}). -type iapply() :: #iapply{}. @@ -143,13 +149,14 @@ -type itry() :: #itry{}. -type ifilter() :: #ifilter{}. -type igen() :: #igen{}. +-type izip() :: #izip{}. -type isimple() :: #isimple{}. -type i() :: iapply() | ibinary() | icall() | icase() | icatch() | iclause() | ifun() | iletrec() | imatch() | imap() | iprimop() | iprotect() | ireceive1() | ireceive2() | iset() | itry() | ifilter() - | igen() | isimple(). + | igen() | izip() | isimple(). -type warning() :: {file:filename(), [{integer(), module(), term()}]}. @@ -1601,7 +1608,20 @@ fun_tq(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=#a{anno=GA}=GAnno, +lc_tq(Line, E, [#igen{}|_T] = Qs, Mc, St) -> + lc_tq1(Line, E, Qs, Mc, St); +lc_tq(Line, E, [#izip{}=Zip|Qs], Mc, St) -> + zip_tq(Line, E, Zip, Mc, St, Qs); +lc_tq(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> + filter_tq(Line, E, Filter, Mc, St, Qs, fun lc_tq/5); +lc_tq(Line, E0, [], Mc0, St0) -> + {H1,Hps,St1} = safe(E0, St0), + {T1,Tps,St} = force_safe(Mc0, St1), + Anno = lineno_anno(Line, St), + E = ann_c_cons(Anno, H1, T1), + {set_anno(E, [compiler_generated|Anno]),Hps ++ Tps,St}. + +lc_tq1(Line, E, [#igen{anno=#a{anno=GA}=GAnno, acc_pat=AccPat,acc_guard=AccGuard, skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, refill={RefillPat,RefillAction}, @@ -1623,15 +1643,54 @@ lc_tq(Line, E, [#igen{anno=#a{anno=GA}=GAnno, Fun = #ifun{anno=GAnno,id=[],vars=[Var],clauses=Cs,fc=Fc}, {#iletrec{anno=GAnno#a{anno=[list_comprehension|GA]},defs=[{{Name,1},Fun}], body=Pre ++ [#iapply{anno=GAnno,op=F,args=[Arg]}]}, - [],St3}; -lc_tq(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> - filter_tq(Line, E, Filter, Mc, St, Qs, fun lc_tq/5); -lc_tq(Line, E0, [], Mc0, St0) -> - {H1,Hps,St1} = safe(E0, St0), - {T1,Tps,St} = force_safe(Mc0, St1), - Anno = lineno_anno(Line, St), - E = ann_c_cons(Anno, H1, T1), - {set_anno(E, [compiler_generated|Anno]),Hps ++ Tps,St}. + [],St3}. + +%% zip_tq(Line, Exp, [Qualifier], Mc, State, TqFun) -> {LetRec,[PreExp],State}. + +zip_tq(Line, E, #izip{anno=#a{anno=GA}=GAnno, + acc_pats=AccPats,acc_guard=AccGuard, + tails=TailVars,tail_pats=TailPats, + skip_pats=SkipPats,refill_pats=RefillPats0, + refill_as=RefillAs,pres=Pres,args=Args}, Mc, St0, Qs) -> + {Name,St1} = new_fun_name("zlc", St0), + LA = lineno_anno(Line, St1), + NumGenerators = length(AccPats), + + %% Generate new vars for each generator, 1 for the regular call, and 1 for + %% the bad generator case. + {CallVars,St2} = new_vars(NumGenerators, St1), + {FcVars, St3} = new_vars(NumGenerators, St2), + + %% Generate the name for the letrec. + F = #c_var{anno=LA,name={Name,NumGenerators}}, + + %% Generate the clauses for the letrec. + Nc = #iapply{anno=GAnno,op=F,args=TailVars}, + {Lc,Lps,St4} = lc_tq(Line, E, Qs, Nc, St3), + + AccClause = make_clause(LA, AccPats, AccGuard, Lps++[Lc]), + SkipClause = make_clause([skip_clause,compiler_generated|LA], SkipPats, [], [Nc]), + TailClause = make_clause(LA, TailPats, [], [Mc]), + RefillClause = + case all(fun(X) -> X =:= nomatch end, RefillPats0) of + true -> + %% There are no map generators. + nomatch; + false -> + RefillPats = make_ignored(RefillPats0, TailVars), + RefillBody = [C || C <- RefillAs, C =/= ignore], + make_clause(LA, RefillPats, [], RefillBody++[Nc]) + end, + + Cs0 = [AccClause, SkipClause, TailClause, RefillClause], + Cs = [C || C <- Cs0, C =/= nomatch], + + Fc = bad_generators(FcVars, hd(Args), lc), + Fun = #ifun{anno=GAnno,id=[],vars=CallVars,clauses=Cs,fc=Fc}, + {#iletrec{anno=GAnno#a{anno=[list_comprehension|GA]}, + defs=[{{Name,NumGenerators},Fun}], + body=append(Pres) ++ + [#iapply{anno=GAnno,op=F,args=Args}]},[],St4}. %% bc_tq(Line, Exp, [Qualifier], More, State) -> {LetRec,[PreExp],State}. %% This TQ from Gustafsson ERLANG'05. @@ -1686,6 +1745,8 @@ bc_tq1(Line, E, [#igen{anno=GAnno, defs=[{{Name,2},Fun}], body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg,Mc]}]}, [],St5}; +bc_tq1(Line, E, [#izip{}=Zip|Qs], Mc, St) -> + bzip_tq1(Line, E, Zip, Mc, St, Qs); 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) -> @@ -1722,6 +1783,56 @@ bc_tq_build(Line, Pre0, #c_var{name=AccVar}, Elements0, St0) -> Anno = Anno0#a{anno=[compiler_generated,single_use|A]}, {set_anno(E, Anno),Pre0++Pre,St}. +bzip_tq1(Line, E, #izip{anno=GAnno, + acc_pats=AccPats,acc_guard=AccGuard, + tails=TailVars,tail_pats=TailPats, + skip_pats=SkipPats,refill_pats=RefillPats0, + refill_as=RefillAs,pres=Pres,args=Args}, Mc, St0, Qs) -> + {Name,St1} = new_fun_name("bzip", St0), + LA = lineno_anno(Line, St1), + LAnno = #a{anno=LA}, + Arity = length(AccPats) + 1, + + %% Generate new vars for each generator, 1 for the regular call, and 1 for + %% the bad generator case. last(CallVars) is used as the accumulator var + %% when constructing the new binary. + {CallVars, St2} = new_vars(LA, Arity, St1), + {FcVars, St3} = new_vars(LA, Arity, St2), + + %% Generate the name for the letrec. + F = #c_var{anno=LA,name={Name,Arity}}, + + %% Generate the clauses for the letrec. + BinAccVar = last(CallVars), + Nc = #iapply{anno=GAnno,op=F,args=TailVars++[BinAccVar]}, + {Bc,Bps,St4} = bc_tq1(Line, E, Qs, BinAccVar, St3), + Body = Bps++[#iset{var=hd(CallVars), arg=Bc}, Nc], + AccClause = make_clause(LA, AccPats++[Mc], AccGuard, Body), + TailClause = make_clause(LA, TailPats++[Mc], [], [Mc]), + SkipClause = make_clause([skip_clause,compiler_generated|LA], SkipPats++[Mc], [], [Nc]), + RefillClause = + case all(fun(X) -> X =:= nomatch end, RefillPats0) of + true -> + %% There are no map generators. + nomatch; + false -> + RefillPats = make_ignored(RefillPats0, TailVars), + RefillBody = [C || C <- RefillAs, C =/= ignore], + make_clause(LA, RefillPats++[Mc], [], RefillBody++[Nc]) + end, + + Cs0 = [AccClause, SkipClause, TailClause, RefillClause], + Cs = [C || C <- Cs0, C =/= nomatch], + + Fc = bad_generators(FcVars, hd(Args), bc), + Fun = #ifun{anno=GAnno,id=[],vars=CallVars,clauses=Cs,fc=Fc}, + %% Inlining would disable the size calculation optimization for + %% bs_init_writable. + {#iletrec{anno=LAnno#a{anno=[list_comprehension,no_inline|LA]}, + defs=[{{Name,Arity},Fun}], + body=append(Pres) ++ + [#iapply{anno=LAnno,op=F,args=Args++[Mc]}]},[],St4}. + mc_tq(Line, {map_field_assoc,Lf,K,V}, Qs, Mc, St0) -> E = {tuple,Lf,[K,V]}, {Lc,Pre0,St1} = lc_tq(Line, E, Qs, Mc, St0), @@ -1732,6 +1843,15 @@ mc_tq(Line, {map_field_assoc,Lf,K,V}, Qs, Mc, St0) -> args=[LcVar]}, {Call,Pre,St2}. +make_ignored(Ps, Vs) -> + [case P of + nomatch -> V; + _ -> P + end || {P, V} <- zip(Ps, Vs)]. + +make_clause(Anno, [Pat|PatExtra], Guard, Body) -> + make_clause(Anno, Pat, PatExtra, Guard, Body). + make_clause(_Anno, nomatch, _PatExtra, _Guard, _Body) -> nomatch; make_clause(Anno, Pat, PatExtra, Guard, Body) -> @@ -1782,6 +1902,23 @@ filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg=Guard}, preprocess_quals(Line, Qs, St) -> preprocess_quals(Line, Qs, St, []). +preprocess_quals(Line, [{zip,Anno,Gens}|Qs], St, Acc) -> + LAnno = #a{anno=lineno_anno(Anno, St)}, + {Gens1, St1} = preprocess_quals(Line, Gens, St, []), + {AccPats, TailVars, TailPats, SkipPats, RefillPats, RefillAs, Pres, Args} + = preprocess_zip_1(Gens1), + [#igen{acc_guard=AccGuard}|_] = Gens1, + Zip = #izip{anno=LAnno, + acc_pats=AccPats, + acc_guard=AccGuard, + skip_pats=SkipPats, + tails=TailVars, + tail_pats=TailPats, + pres=Pres, + args=Args, + refill_pats=RefillPats, + refill_as=RefillAs}, + preprocess_quals(Line, Qs, St1, [Zip|Acc]); preprocess_quals(Line, [Q|Qs0], St0, Acc) -> case is_generator(Q) of true -> @@ -1810,6 +1947,25 @@ preprocess_quals(Line, [Q|Qs0], St0, Acc) -> preprocess_quals(_, [], St, Acc) -> {reverse(Acc),St}. +preprocess_zip_1([#igen{arg={Pre,Arg}, + tail=Tail, + acc_pat=AccPat, + tail_pat=TailPat, + refill={RefillPat, RefillArg}, + skip_pat=SkipPat} | Rest]) -> + {AccPats, TailVars, TailPats, SkipPats, RefillPats, RefillAs, Pres, Args} + = preprocess_zip_1(Rest), + {[AccPat | AccPats], + [Tail | TailVars], + [TailPat | TailPats], + [SkipPat | SkipPats], + [RefillPat | RefillPats], + [RefillArg | RefillAs], + [Pre | Pres], + [Arg | Args]}; +preprocess_zip_1([]) -> + {[], [], [], [], [], [], [], []}. + is_generator({generate,_,_,_}) -> true; is_generator({b_generate,_,_,_}) -> true; is_generator({m_generate,_,_,_}) -> true; @@ -2406,8 +2562,21 @@ new_vars_1(N, Anno, St0, Vs) when N > 0 -> new_vars_1(0, _, St, Vs) -> {Vs,St}. bad_generator(Ps, Generator, Arg) -> + L = [#c_literal{val=bad_generator}, Generator], + bad_generator_common(L, Ps, Arg). + +bad_generators(Ps, Arg, bc) -> + T1 = #c_tuple{es=droplast(Ps)}, + L = [#c_literal{val=bad_generators}, T1], + bad_generator_common(L, Ps, Arg); +bad_generators(Ps, Arg, lc) -> + T = #c_tuple{es=Ps}, + L = [#c_literal{val=bad_generators}, T], + bad_generator_common(L, Ps, Arg). + +bad_generator_common(L, Ps, Arg) -> Anno = get_anno(Arg), - Tuple = ann_c_tuple(Anno, [#c_literal{val=bad_generator},Generator]), + Tuple = ann_c_tuple(Anno, L), Call = #icall{anno=#a{anno=Anno}, %Must have an #a{} module=#c_literal{anno=Anno,val=erlang}, name=#c_literal{anno=Anno,val=error}, diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 2fb46dba279c..a879f51a457e 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -52,6 +52,7 @@ MODULES= \ trycatch_SUITE \ warnings_SUITE \ z_SUITE \ + zlc_SUITE \ test_lib NO_BOOL_OPT= \ @@ -87,7 +88,8 @@ NO_OPT= \ overridden_bif \ receive \ record \ - trycatch + trycatch \ + zlc INLINE= \ andor \ diff --git a/lib/compiler/test/zlc_SUITE.erl b/lib/compiler/test/zlc_SUITE.erl new file mode 100644 index 000000000000..ac1c3bde1d40 --- /dev/null +++ b/lib/compiler/test/zlc_SUITE.erl @@ -0,0 +1,273 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2024. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(zlc_SUITE). + +-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,mixed_zlc/1,zmc/1,filter_guard/1, + filter_pattern/1,cartesian/1,nomatch/1,bad_generators/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. + +all() -> + [{group,p}]. + +groups() -> + [{p,test_lib:parallel(), + [basic, + mixed_zlc, + zmc, + filter_guard, + filter_pattern, + cartesian, + nomatch, + bad_generators + ]}]. + +init_per_suite(Config) -> + test_lib:recompile(?MODULE), + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + Config. + +end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + ok. + +basic(Config) when is_list(Config) -> + [6, 7, 8] = [X + Y + Z || X <- [1, 2, 3] && Y <- [2, 2, 2] && Z <- [3,3,3]], + [{1, 2, 3}, {2, 2, 3}, {3, 2, 3}] = + [{X, Y, Z} || X <- [1, 2, 3] && Y <- [2, 2, 2] && Z <- [3,3,3]], + [6, 24] = zipwith4(fun(A, B, C, D) -> (A + B + C) * D end, + [1, 5], [2, 2], [0, 1], [2, 3]), + 96 = dot([1, 2, 3, 4], [24, 12, 8, 6]), + + [1, 4, 5] = ifelse([true, false, true], [1, 3, 5], [2, 4, 6]), + + [8, 14, 20] = [X + Y + Z || <> <= <<5, 10, 15>> && <> <= <<1, 2, 3>> + && <> <= <<2, 2, 2>>]. + + +zipwith4(F, As, Bs, Cs, Ds) -> + [F(A,B,C,D) || A <- As && B <- Bs && C <- Cs && D <- Ds]. + +dot(Xs, Ys) -> + lists:sum([X*Y || X <- Xs && Y <- Ys]). + +ifelse(Tests, Xs, Ys) -> % Simulate R's ifelse(,,) + [ case T of true -> X ; false -> Y end + || T <- Tests && X <- Xs && Y <- Ys + ]. + +mixed_zlc(Config) when is_list(Config) -> + [{a, 2}, {b, 4}, {c, 6}] = [{X,Y} || X <- [a,b,c] && <> <= <<2,4,6>>], + [{a, 2}, {b, 4}, {c, 6}] = [{X,Y} || <> <= <<2,4,6>> && X <- [a,b,c]], + [{a,c,1,3}, {b,d,2,4}] = [{K1,K2,V1,V2}|| + K1 := V1 <- maps:iterator(#{a=>1, b=>2}, ordered) && + K2 := V2 <- maps:iterator(#{c=>3, d=>4}, ordered)], + [{a,1,2}, {b,2,4}] = + [{K1,V1,Y} || K1 := V1 <- maps:iterator(#{a=>1, b=>2}, ordered) && + <> <= <<2,4>>], + [{a,1,2}, {b,2,4}] = [{K1,V1,Y} || + K1 := V1 <- maps:iterator(#{a=>1, b=>2}, ordered) && + <> <= <<2,4>>], + <<3,4,5>> = << <<(X+Y)/integer>> || X <- [1,2,3] && Y <- [2,2,2]>>, + <<3,4,5>> = << <<(X+V1)/integer>> || + X <- [1,2,3] && + _K1 := V1 <- maps:iterator(#{a=>2, b=>2, c=>2}, ordered)>>, + <<3,4,5>> = << <<(X+V1)/integer>> || + <> <= <<1,2,3>> && + _K1 := V1 <- maps:iterator(#{a=>2, b=>2, c=>2}, ordered)>>, + <<3,4,5>> = << <<(V1+V2)/integer>> || + _K1 := V1 <- maps:iterator(#{a=>1, b=>2, c=>3}, ordered) && + _K2 := V2 <- maps:iterator(#{a=>2, b=>2, c=>2}, ordered)>>, + #{c := 3,b := 2,a := 1} = #{X => Y || X <- [a,b,c] && Y <- [1,2,3]}, + #{c := 3,b := 2,a := 1} = #{X => Y || X <- [a,b,c] && <> <= <<1,2,3>>}, + ok. + +zmc(Config) when is_list(Config) -> + [{a,b,1,3}] = [{K1, K2, V1, V2} || K1 := V1 <- #{a=>1} && K2 := V2 <- #{b=>3}], + Seq = lists:seq(1, 50), + M1 = maps:iterator(#{X=>X || X <- Seq}, ordered), + M2 = maps:iterator(#{X=>X || X <- lists:seq(1,50)}, ordered), + true = [A * 4 || A <- Seq] =:= + [X+Y+Z+W || X := Y <- M1 && Z := W <- M2], + true = << <<(A * 4):64>> || A <- Seq>> =:= + << <<(X+Y+Z+W):64>> || X := Y <- M1 && Z := W <- M2>>, + + M3 = maps:iterator(#{X=>X*3 || X <- Seq}, ordered), + M4 = maps:iterator(#{X*2=>X*4 || X <- Seq}, ordered), + true = [{A, A*3, A*2, A*4} || A <- Seq] =:= + [{X, Y, Z, W} || X := Y <- M3 && Z := W <- M4], + true = [A * 3 || A <- Seq] =:= [X+Y+Z || X := Y <- M1 && Z <- Seq], + true = << <> || A <- Seq>> =:= + << <> || X := Y <- M3 && Z := W <- M4>>, + true = << <<(A*3):64>> || A <- Seq>> =:= + << <<(X+Y+Z):64>> || X := Y <- M1 && Z <- Seq>>, + + M5 = maps:iterator(#{X => + case X rem 2 of + 0 -> {ok,X}; + 1 -> {error,X} + end || X <- Seq}, ordered), + M6 = maps:iterator(#{X*2 => X*4 || X <- Seq}, ordered), + [] = [X || {{X,{ok,X}}, {_,X}} <- lists:zip(maps:to_list(M5), maps:to_list(M6))], + [] = [X || X := {ok,X} <- M5 && _ := X <- M6], + [] = [X || X := {e,X} <- M5 && X := {ok,X} <- M5], + ok. + +filter_guard(Config) when is_list(Config) -> + [[1,2,1]] = [X++Y || X <- [[1,2], [2,-3]] && Y <- [[1], [2]], lists:sum(X)>0], + [{a,2}, {b,4}, {c,6}] = [{X,Y} || X <- [a,b,c] && <> <= <<2,4,6>>, + Y rem 2 == 0], + [{b,4}, {c,6}] = [{X, Y} || X <- [a,b,c] && <> <= <<2,4,6>>, Y =/= 2], + [] = [{X,Y} || X <- [a, b, c] && <> <= <<2,4,6>>, Y rem 2 == 1], + [{b,4}] = [{X,Y} || <> <= <<2,4,6>> && X <- [a,b,c], X>a, X1, b=>2}, ordered) && + K2 := V2 <- maps:iterator(#{c=>3, d=>4}, ordered), + V2 rem 2 == 0], + <<5>> = << <<(X+Y)/integer>> || X <- [1,2,3] && Y <- [2,2,2], X rem 2 == 1, X+Y>4>>, + #{c := 3,a := 1} = #{X => Y || X <- [a,b,c] && Y <- [1,2,3], Y rem 2 == 1}, + #{c := 3} = #{X => Y || X <- [a,b,c] && Y <- [1,2,3], Y rem 2 == 1, Y > 1}, + #{c := 3,a := 1} = #{X => Y || X <- [a,b,c] && <> <= <<1,2,3>>, Y rem 2 == 1}. + +filter_pattern(Config) when is_list(Config) -> + [] = do_filter_pat_1([], []), + [] = do_filter_pat_1([a], [a]), + [] = do_filter_pat_1([{ok,a}], [{error,e}]), + [] = do_filter_pat_2([], []), + [] = do_filter_pat_2([a], [b]), + [] = do_filter_pat_2([{a,1}], [{b,1}]), + [{1,7}] = do_filter_pat_2([{a,1}], [{a,7}]), + [{1,7},{10,20}] = do_filter_pat_2([{a,1},{b,9},{x,10}], + [{a,7},{wrong,8},{x,20}]), + ok. +do_filter_pat_1(L1, L2) -> + Res = [{A,B} || {ok,A} <- L1 && {ok,B} <- L2], + Res = [{A,B} || {{ok,A},{ok,B}} <- lists:zip(L1,L2)], + Res. +do_filter_pat_2(L1, L2) -> + Res = [{A,B} || {Same,A} <- L1 && {Same,B} <- L2], + Res = [{A,B} || {{Same,A},{Same,B}} <- lists:zip(L1,L2)], + Res. + +cartesian(Config) when is_list(Config) -> + [{a,3}, {b,5}, {c,7}, {a,4}, {b,6}, {c,8}] = + [{X, W+Y} || W <- [1,2], + X <- [a,b,c] && <> <= <<2,4,6>>], + [{a,3}, {a,4}, {b,5}, {b,6}, {c,7}, {c,8}] = + [{X, W+Y} || X <- [a,b,c] && + <> <= <<2,4,6>>, W <- [1,2]], + [{a,4}, {b,6}, {c,8}] = + [{X, W+Y} || X <- [a,b,c] && + <> <= <<2,4,6>>, W <- [1,2], (W + Y) rem 2 == 0], + <<4,2,5,3,6,4>> = << <<(X+V1+Y)/integer>> || + X <- [1,2,3] && + _K1 := V1 <- maps:iterator(#{a=>2, b=>2, c=>2}, ordered), + <> <= <<1,-1>> >>, + ok. + +nomatch(Config) when is_list(Config) -> + [] = do_nomatch_1([], []), + [] = do_nomatch_1([1], [a]), + [] = do_nomatch_1([1,2], [a,b]), + {'EXIT',{{bad_generators,{[1,2,3],[]}},_}} = do_nomatch_1([1,2,3], []), + {'EXIT',{{bad_generators,{[3],[]}},_}} = do_nomatch_1([1,2,3], [a,b]), + + <<>> = do_nomatch_2([], <<>>), + <<>> = do_nomatch_2([a], <<1>>), + {'EXIT',{{bad_generators,{[2],<<>>}},_}} = do_nomatch_2([1,2], <<3>>), + ok. + +do_nomatch_1(L1, L2) -> + catch [{X, Y} || a=b=X <- L1 && Y <- L2]. + +do_nomatch_2(L, Bin) -> + catch << <<(X+Y)/integer>> || a=b=X <- L && <> <= Bin >>. + +bad_generators(Config) when is_list(Config) -> + {'EXIT',{{bad_generators,{x,[1,2]}},_}} = + catch [{X,Y} || X <- x && Y <- [1,2]], + {'EXIT',{{bad_generators,{[],[4]}},_}} = + catch [{X,Y} || X <- [1,2,3] && Y <- [1,2,3,4]], + {'EXIT',{{bad_generators,{[3,4],[]}},_}} = + catch [{X,Y} || X <- [1,2,3,4] && Y <- [1,2], X < 3], + {'EXIT',{{bad_generators,{[3,4],[]}},_}} = + catch << <<(X+Y)/integer>> || X <- [1,2,3,4] && Y <- [1,2], X < 3>>, + {'EXIT',{{bad_generators,{<<1,2>>,a}},_}} = + catch << <> || <> <= <<1:8,2:8>> && <> <= a>>, + {'EXIT',{{bad_generator,a},_}} = catch [X || X := X <- a && _Y <- [1]], + {'EXIT',{{bad_generators,{[d],[]}},_}} = + catch #{X => Y || X <- [a,b,c,d] && Y <- [1,2,3], Y > 1}, + + %% Make sure that line numbers point out the generator. + case ?MODULE of + zlc_inline_SUITE -> + %% No inline suite for now. Just a guard in case we add it later. + ok; + _ -> + {'EXIT',{{bad_generators,{[],[4]}}, + [{?MODULE,_,_, + [{file,"bad_zlc.erl"},{line,4}]}|_]}} = + catch bad_generators([1,2,3],[1,2,3,4]), + + {'EXIT',{{bad_generators,{a,[2,3]}}, + [{?MODULE,_,_, + [{file,"bad_zlc.erl"},{line,7}]}|_]}} = + catch bad_generators_bc(a,[2,3]), + + {'EXIT',{{bad_generators,{[2],[]}}, + [{?MODULE,_,_, + [{file,"bad_zlc.erl"},{line,10}]}|_]}} = + catch bad_generators_mc([1,2],[1]), + + %% List comprehensions with improper lists. + {'EXIT',{{bad_generators,{d,[d]}}, + [{?MODULE,_,_, + [{file,"bad_zlc.erl"},{line,4}]}|_]}} = + catch bad_generators([a,b,c|d],[a,b,c,d]) + end, + ok. + +-file("bad_zlc.erl", 1). +bad_generators(L1,L2) -> %Line 2 + [{I1, I2} || %Line 3 + I1 <- L1 && I2 <- L2]. %Line 4 +bad_generators_bc(L1,L2) -> %Line 5 + << <> || %Line 6 + I1 <- L1 && I2 <- L2>>. %Line 7 +bad_generators_mc(L1,L2) -> %Line 8 + #{I1 => I2 || %Line 9 + I1 <- L1 && I2 <- L2}. %Line 10 diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 60a3dc85c8a5..d4ca7c5b4241 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -1112,6 +1112,9 @@ eval_named_fun(As, RF, {Info,Bs,Cs,FName}) -> eval_lc(E, Qs, Bs, Ieval) -> {value,eval_lc1(E, Qs, Bs, Ieval),Bs}. +eval_lc1(E, [{zip, Anno, Gens}|Qs], Bs0, Ieval) -> + {VarList, Bs1} = convert_gen_values(Gens, [], Bs0, Ieval), + eval_zip(E, [{zip, Anno, VarList}|Qs], Bs1, fun eval_lc1/4, Ieval); eval_lc1(E, [{generator,G}|Qs], Bs, Ieval) -> CompFun = fun(NewBs) -> eval_lc1(E, Qs, NewBs, Ieval) end, eval_generator(G, Bs, CompFun, Ieval); @@ -1130,6 +1133,165 @@ eval_lc1(E, [], Bs, Ieval) -> {value,V,_} = expr(E, Bs, Ieval#ieval{top=false}), [V]. +%% convert values for generator vars from abstract form to flattened lists +convert_gen_values([{generator,{generate, Line, P, L0}}|Qs], Acc, Bs0, Ieval0) -> + Ieval = Ieval0#ieval{line=Line}, + {value,L1,_Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), + convert_gen_values(Qs, [{generate, Line, P, L1}|Acc], Bs0, Ieval); +convert_gen_values([{generator,{b_generate, Line, P, L0}}|Qs], Acc, Bs0, Ieval0) -> + Ieval = Ieval0#ieval{line=Line}, + {value,L1,_Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), + convert_gen_values(Qs, [{b_generate, Line, P, L1}|Acc], Bs0, Ieval); +convert_gen_values([{generator,{m_generate, Line, P, Map0}}|Qs], Acc, Bs0, Ieval0) -> + Ieval = Ieval0#ieval{line=Line}, + {map_field_exact,_,K,V} = P, + {value,Map,_Bs1} = expr(Map0, Bs0, Ieval#ieval{top=false}), + Iter = case is_map(Map) of + true -> + maps:iterator(Map); + false -> + %% Validate iterator. + try maps:foreach(fun(_, _) -> ok end, Map) of + _ -> + Map + catch + _:_ -> + exception(error,{bad_generator,Map}, Bs0, Ieval) + end + end, + convert_gen_values(Qs, [{m_generate, Line, {tuple, Line, [K, V]}, Iter}|Acc], Bs0, Ieval); +convert_gen_values([], Acc, Bs0, _Ieval) -> + {lists:reverse(Acc), Bs0}. + +bind_all_generators(Gens, Bs0, Ieval) -> + bind_all_generators1(Gens, [], erl_eval:new_bindings(Bs0), Ieval, continue). + +bind_all_generators1([{b_generate, Anno, P, <<_/bitstring>>=Bin}|Qs], + Acc, Bs0, Ieval, continue) -> + Mfun = match_fun(Bs0), + Efun = fun(Exp, Bs) -> expr(Exp, Bs, #ieval{}) end, + case eval_bits:bin_gen(P, Bin, erl_eval:new_bindings(Bs0), Bs0, Mfun, Efun) of + {match, Rest, Bs1} -> + Bs2 = zip_add_bindings(Bs1, Bs0), + case Bs2 of + nomatch -> + bind_all_generators1(Qs, [{b_generate, Anno, P, Rest}|Acc], + Bs0, Ieval, skip); + _ -> + bind_all_generators1(Qs, [{b_generate, Anno, P, Rest}|Acc], + Bs2, Ieval, continue) + end; + {nomatch, Rest} -> + bind_all_generators1(Qs, [{b_generate, Anno, P, Rest}|Acc], Bs0, Ieval, skip); + done -> + {[], done} + end; +bind_all_generators1([{b_generate, Anno, P, <<_/bitstring>>=Bin}|Qs], Acc, Bs0, Ieval, skip) -> + Mfun = match_fun(Bs0), + Efun = fun(Exp, Bs) -> expr(Exp, Bs, #ieval{}) end, + case eval_bits:bin_gen(P, Bin, erl_eval:new_bindings(Bs0), Bs0, Mfun, Efun) of + {match, Rest, _} -> + bind_all_generators1(Qs, [{b_generate, Anno, P, Rest}|Acc], Bs0, Ieval, skip); + {nomatch, Rest} -> + bind_all_generators1(Qs, [{b_generate, Anno, P, Rest}|Acc], Bs0, Ieval, skip); + done -> + {[], skip} + end; +bind_all_generators1([{generate, Anno, P, [H|T]}|Qs], Acc, Bs0, Ieval, continue) -> + case catch match1(P, H, erl_eval:new_bindings(Bs0), Bs0) of + {match,Bsn} -> + Bs2 = zip_add_bindings(Bsn, Bs0), + case Bs2 of + nomatch -> + bind_all_generators1(Qs,[{generate, Anno, P, T}|Acc], Bs0, Ieval, skip); + _ -> + bind_all_generators1(Qs,[{generate, Anno, P, T}|Acc], Bs2, Ieval, continue) + end; + nomatch -> + %% match/6 returns nomatch. Skip this value + bind_all_generators1(Qs,[{generate, Anno, P, T}|Acc], Bs0, Ieval, skip) + end; +bind_all_generators1([{generate, Anno, P, [_H|T]}|Qs], Acc, Bs0, Ieval, skip) -> + bind_all_generators1(Qs,[{generate, Anno, P, T}|Acc], Bs0, Ieval, skip); +bind_all_generators1([{m_generate, Anno, P, Iter0}|Qs], Acc, Bs0, Ieval, continue) -> + case maps:next(Iter0) of + {K,V,Iter} -> + case catch match1(P, {K,V}, erl_eval:new_bindings(Bs0), Bs0) of + {match,Bsn} -> + Bs2 = zip_add_bindings(Bsn, Bs0), + case Bs2 of + nomatch -> + bind_all_generators1(Qs,[{m_generate, Anno, P, Iter}|Acc], + Bs0, Ieval, skip); + _ -> + bind_all_generators1(Qs,[{m_generate, Anno, P, Iter}|Acc], + Bs2, Ieval, continue) + end; + nomatch -> + bind_all_generators1(Qs, [{m_generate, Anno, P, Iter}|Acc], + Bs0, Ieval, skip) + end; + none -> + {[], done} + end; +bind_all_generators1([{m_generate, Anno, P, Iter0}|Qs], Acc, Bs0, Ieval, skip) -> + case maps:next(Iter0) of + {_K,_V,Iter} -> + bind_all_generators1(Qs, [{m_generate, Anno, P, Iter}|Acc], + Bs0, Ieval, skip); + none -> + {[], skip} + end; +bind_all_generators1([{generate,_,_,[]}|_], _, _, _, _) -> + %% no more values left for a var, time to return + {[],done}; +bind_all_generators1([{b_generate, _Anno, _P, _Term}|_Qs], Acc, _Bs0, _Ieval,_) -> + {Acc, error}; +bind_all_generators1([{generate, _Anno, _P, _Term}|_Qs], Acc, _Bs0, _Ieval,_) -> + {Acc, error}; +bind_all_generators1([], [_H|_T] = Acc, Bs0, _Ieval, continue) -> + %% all vars are bind for this round + {Acc, Bs0}; +bind_all_generators1([], [_H|_T] = Acc, _Bs0, _Ieval, skip) -> + {Acc, skip}. + +check_bad_generators([{generate,_,_,V}|T], Env, Acc) -> + check_bad_generators(T, Env, [V|Acc]); +check_bad_generators([{m_generate,_,_,Iter0}|T], Env, Acc) -> + case maps:next(Iter0) of + none -> check_bad_generators(T, Env, [#{}|Acc]); + _ -> check_bad_generators(T, Env, [#{K => V || K := V <- Iter0}|Acc]) + end; +check_bad_generators([{b_generate,_,P,<<_/bitstring>>=Bin}|T], Bs0, Acc) -> + Mfun = match_fun(Bs0), + Efun = fun(Exp, Bs) -> expr(Exp, Bs, #ieval{}) end, + case eval_bits:bin_gen(P, Bin, erl_eval:new_bindings(Bs0), Bs0, Mfun, Efun) of + done -> + check_bad_generators(T, Bs0, [<<>>|Acc]); + _ -> + check_bad_generators(T, Bs0, [Bin|Acc]) + end; +check_bad_generators([{b_generate,_,_,Term}|T], Env, Acc) -> + check_bad_generators(T, Env, [Term|Acc]); +check_bad_generators([], _, Acc)-> + case lists:any(fun is_generator_end/1, Acc) of + false -> + %% None of the generators has reached its end. + {ok, list_to_tuple(lists:reverse(Acc))}; + true -> + case lists:all(fun(V) -> is_generator_end(V) end, Acc) of + true -> + %% All generators have reached their end. + {ok, list_to_tuple(lists:reverse(Acc))}; + false -> + {error, {bad_generators,list_to_tuple(lists:reverse(Acc))}} + end + end. + +is_generator_end([]) -> true; +is_generator_end(<<>>) -> true; +is_generator_end(Other) -> Other =:= #{}. + %% eval_bc(Expr,[Qualifier],Bindings,IevalState) -> %% {value,Value,Bindings}. %% This is evaluating list comprehensions "straight out of the book". @@ -1138,6 +1300,9 @@ eval_bc(E, Qs, Bs, Ieval) -> Val = erlang:list_to_bitstring(eval_bc1(E, Qs, Bs, Ieval)), {value,Val,Bs}. +eval_bc1(E, [{zip, Anno, Gens}|Qs], Bs0, Ieval) -> + {VarList, Bs1} = convert_gen_values(Gens, [], Bs0, Ieval), + eval_zip(E, [{zip, Anno, VarList}|Qs], Bs1, fun eval_bc1/4, Ieval); eval_bc1(E, [{generator,G}|Qs], Bs, Ieval) -> CompFun = fun(NewBs) -> eval_bc1(E, Qs, NewBs, Ieval) end, eval_generator(G, Bs, CompFun, Ieval); @@ -1160,6 +1325,9 @@ eval_mc(E, Qs, Bs, Ieval) -> Map = eval_mc1(E, Qs, Bs, Ieval), {value,maps:from_list(Map),Bs}. +eval_mc1(E, [{zip, Anno, Gens}|Qs], Bs0, Ieval) -> + {VarList, Bs1} = convert_gen_values(Gens, [], Bs0, Ieval), + eval_zip(E, [{zip, Anno, VarList}|Qs], Bs1, fun eval_mc1/4, Ieval); eval_mc1(E, [{generator,G}|Qs], Bs, Ieval) -> CompFun = fun(NewBs) -> eval_mc1(E, Qs, NewBs, Ieval) end, eval_generator(G, Bs, CompFun, Ieval); @@ -1179,6 +1347,25 @@ eval_mc1({map_field_assoc,_,K0,V0}, [], Bs, Ieval) -> {value,V,_} = expr(V0, Bs, Ieval#ieval{top=false}), [{K,V}]. +eval_zip(E, [{zip, Anno, VarList}|Qs], Bs0, Fun, Ieval) -> + Gens = case check_bad_generators(VarList, Bs0, []) of + {ok, Acc} -> Acc; + {error, Reason} -> + exception(error, Reason, Bs0, Ieval) + end, + {Rest, Bs1} = bind_all_generators(VarList, Bs0, Ieval), + case {Rest, Qs, Bs1} of + {_, _, error} -> exception(error,{bad_generators,Gens}, Bs0, Ieval); + {[], [], _} -> []; + {[], _, _} -> []; + {_,_,done} -> []; + {_, _, skip} -> + eval_zip(E, [{zip, Anno, lists:reverse(Rest)}|Qs], Bs0, Fun, Ieval); + {_, _, _} -> + Fun(E, Qs, add_bindings(Bs1, Bs0), Ieval) ++ + eval_zip(E, [{zip, Anno, lists:reverse(Rest)}|Qs], Bs0, Fun, Ieval) + end. + eval_generator({generate,Line,P,L0}, Bs0, CompFun, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), @@ -1807,6 +1994,31 @@ merge_bindings([{Name,V}|B1s], B2s, Ieval) -> merge_bindings([], B2s, _Ieval) -> B2s. +zip_add_bindings(Bs1, Bs2) when is_map(Bs1), is_map(Bs2) -> + zip_add_bindings_map(maps:keys(Bs1), Bs1, Bs2); +zip_add_bindings(Bs1, Bs2) when is_list(Bs1), is_list(Bs2) -> + zip_add_bindings1(orddict:to_list(Bs1), Bs2). + +zip_add_bindings_map([Key | Keys], Bs1, Bs2) -> + case {Bs1, Bs2} of + {#{Key := Same}, #{Key := Same}} -> zip_add_bindings_map(Keys, Bs1, Bs2); + {_, #{Key := _}} -> nomatch; + {#{Key := Value},_} -> zip_add_bindings_map(Keys, Bs1, Bs2#{Key => Value}) + end; +zip_add_bindings_map([], _, Bs2) -> + Bs2. + +zip_add_bindings1([{Name,Val}|Bs1], Bs2) -> + case orddict:find(Name, Bs2) of + {ok, Val} -> + zip_add_bindings1(Bs1, Bs2); + {ok, _Value} -> nomatch; + error -> + zip_add_bindings1(Bs1, orddict:store(Name, Val, Bs2)) + end; +zip_add_bindings1([], Bs2) -> + Bs2. + %% add_bindings(Bindings1,Bindings2) %% Add Bindings1 to Bindings2. Bindings in %% Bindings1 hides bindings in Bindings2. diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index abb3529f5b36..4bd61d4aba80 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -691,13 +691,25 @@ expr_comprehension({Tag,Anno,E0,Gs0}, St) -> {generator,{b_generate,L,pattern(P0, St),expr(Qs, false, St)}}; ({m_generate,L,P0,Qs}) -> %OTP 26 {generator,{m_generate,L,mc_pattern(P0, St),expr(Qs, false, St)}}; + ({zip,L,Gens}) -> + expr_comprehension({zip,L,Gens}, St); (Expr) -> case is_guard_test(Expr, St) of true -> {guard,guard([[Expr]], St)}; false -> expr(Expr, false, St) end end || G <- Gs0], - {Tag,ln(Anno),expr(E0, false, St),Gs}. + {Tag,ln(Anno),expr(E0, false, St),Gs}; +expr_comprehension({zip,Anno,Gens}, St) -> + Gs = [case G of + ({generate,L,P0,Qs}) -> + {generator,{generate,L,pattern(P0, St),expr(Qs, false, St)}}; + ({b_generate,L,P0,Qs}) -> %R12. + {generator,{b_generate,L,pattern(P0, St),expr(Qs, false, St)}}; + ({m_generate,L,P0,Qs}) -> %OTP 26 + {generator,{m_generate,L,mc_pattern(P0, St),expr(Qs, false, St)}} + end || G <- Gens], + {zip,ln(Anno),Gs}. mc_pattern({map_field_exact,L,KeyP0,ValP0}, St) -> KeyP1 = pattern(KeyP0, St), diff --git a/lib/debugger/src/debugger.app.src b/lib/debugger/src/debugger.app.src index 981e91f73b91..56b80b6c8438 100644 --- a/lib/debugger/src/debugger.app.src +++ b/lib/debugger/src/debugger.app.src @@ -49,5 +49,5 @@ {registered, [dbg_iserver, dbg_wx_mon, dbg_wx_winman]}, {applications, [kernel, stdlib, compiler]}, {optional_applications, [compiler, wx]}, - {runtime_dependencies, ["wx-2.0","stdlib-3.15","kernel-10.0","erts-15.0", + {runtime_dependencies, ["wx-2.0","stdlib-@OTP-19184@","kernel-10.0","erts-15.0", "compiler-8.0"]}]}. diff --git a/lib/debugger/test/Makefile b/lib/debugger/test/Makefile index bf464f8d76d7..2e68d2971678 100644 --- a/lib/debugger/test/Makefile +++ b/lib/debugger/test/Makefile @@ -53,6 +53,7 @@ MODULES= \ record_SUITE \ trycatch_SUITE \ test_lib \ + zlc_SUITE\ cleanup ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/debugger/test/erl_eval_SUITE.erl b/lib/debugger/test/erl_eval_SUITE.erl index 8907856583fe..5cde774d69da 100644 --- a/lib/debugger/test/erl_eval_SUITE.erl +++ b/lib/debugger/test/erl_eval_SUITE.erl @@ -29,6 +29,9 @@ pattern_expr/1, guard_3/1, guard_4/1, lc/1, + zlc/1, + zbc/1, + zmc/1, simple_cases/1, unary_plus/1, apply_atom/1, @@ -64,7 +67,8 @@ suite() -> all() -> [guard_1, guard_2, match_pattern, string_plusplus, - pattern_expr, match_bin, guard_3, guard_4, lc, + pattern_expr, match_bin, guard_3, guard_4, + lc, zlc, zbc, zmc, simple_cases, unary_plus, apply_atom, otp_5269, otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, otp_8133, funs, try_catch, eval_expr_5, eep37]. @@ -238,6 +242,160 @@ lc(Config) when is_list(Config) -> "[X || X <- [true,false], X].", [true]), ok. +zlc(Config) when is_list(Config) -> + check(fun() -> + X = 32, Y = 32, [{X, Y} || X <- [1,2,3] && Y <- [4,5,6]] + end, + "begin X = 32, Y = 32, [{X, Y} || X <- [1,2,3] && Y <- [4,5,6]] end.", + [{1,4},{2,5},{3,6}]), + check(fun() -> + S1 = [x, y, z], S2 = [5, 10, 15], X = 32, Y = 32, + [{X, Y} || X <- S1 && Y <- S2] + end, + "begin + S1 = [x, y, z], S2 = [5, 10, 15], X = 32, Y = 32, + [{X, Y} || X <- S1 && Y <- S2] + end.", + [{x,5}, {y,10}, {z,15}]), + check(fun() -> + [{X, Y, K} || X <- [1,2,3] && Y:=K <- #{1=>a, 2=>b, 3=>c}] + end, + "begin [{X, Y, K} || X <- [1,2,3] && Y:=K <- #{1=>a, 2=>b, 3=>c}] end.", + [{1,1,a},{2,2,b},{3,3,c}]), + check(fun() -> + [{X, W+Y} || X <- [a, b, c] && <> <= <<2, 4, 6>>, W <- [1,2]] + end, + "begin [{X, W+Y} || X <- [a, b, c] && <> <= <<2, 4, 6>>, W <- [1,2]] end.", + [{a,3}, {a,4}, {b,5}, {b,6}, {c,7}, {c,8}]), + check(fun() -> + [{X, W+Y} || W <- [0], X <- [a, b, c] && <> <= <<2, 4, 6>>, Y<4] + end, + "begin [{X, W+Y} || W <- [0], X <- [a, b, c] && <> <= <<2, 4, 6>>, Y<4] end.", + [{a,2}]), + check(fun() -> + [{X,Y}|| a=b=X <- [1,2] && Y <-[1,2]] end, + "begin [{X,Y}|| a=b=X <- [1,2] && Y <-[1,2]] end.", + []), + check(fun() -> + [{A,B,W} || {Same,W} <- [{a,1}], + {Same,A} <- [{a,1},{b,9},{x,10}] && {Same,B} <- [{a,7},{wrong,8},{x,20}]] + end, + "begin [{A,B,W} || {Same,W} <- [{a,1}], + {Same,A} <- [{a,1},{b,9},{x,10}] && {Same,B} <- [{a,7},{wrong,8},{x,20}]] + end.", + [{1,7,1},{10,20,1}]), + error_check("[X || X <- a && Y <- [1]].",{bad_generators,{a,[1]}}), + error_check("[{X,Y} || X <- a && <> <= <<1,2>>].",{bad_generators,{a,<<1,2>>}}), + error_check("[{X,V} || X <- a && _K := V <- #{b=>3}].",{bad_generators,{a,#{b=>3}}}), + error_check("begin + X = 32, Y = 32, [{X, Y} || X <- [1,2,3] && Y <- [4]] end.", + {bad_generators,{[2,3],[]}}), + error_check("begin + X = 32, Y = 32, [{X, Y} || X <- [1,2,3] && Y:=_V <- #{1=>1}] end.", + {bad_generators,{[2,3],#{}}}), + ok. + +zbc(Config) when is_list(Config) -> + check(fun() -> + <<3, 4, 5>> + end, + "begin + X = 32, Y = 32, + << <<(X+Y)/integer>> || <> <= <<1,2,3>> && <> <= <<2,2,2>> >> + end.", + <<3, 4, 5>>), + check(fun() -> + <<4,5,6,5,6,7,6,7,8>> + end, + "begin + X = 32, Y = 32, Z = 32, + << <<(X+Y+Z)/integer>> || <> <= <<1,2,3>> && <> <= <<2,2,2>>, Z<-[1,2,3] >> + end.", + <<4,5,6,5,6,7,6,7,8>>), + check(fun() -> + <<4, 5, 6>> + end, + "begin + L1 = <<1, 2, 3>>, L2 = <<1, 1, 1>>, L3 = <<2, 2, 2>>, + << <<(X+Y+Z)/integer>> || <> <= L1 && <> <= L2 && <> <= L3 >> + end.", + <<4, 5, 6>>), + check(fun() -> + << <<(X+Y):64>>|| a=b=X <- [1,2] && Y <- [1,2] >> end, + "begin << <<(X+Y):64>>|| a=b=X <- [1,2] && Y <- [1,2] >> end.", + <<>>), + check(fun() -> + << <<(X+Y):64>>|| a=b=X <- [1,2] && <> <= <<1,2>> >> end, + "begin << <<(X+Y):64>>|| a=b=X <- [1,2] && <> <= <<1,2>> >> end.", + <<>>), + check(fun() -> + << <<(X+V):64>>|| a=b=X <- [1,2] && _K:=V <- #{a=>1,b=>2}>> end, + "begin << <<(X+V):64>>|| a=b=X <- [1,2] && _K:=V <- #{a=>1,b=>2}>> end.", + <<>>), + error_check("begin << <<(X+Y):8>> || <> <= <<1,2>> && <> <= <<1,2>> >> end.", + {bad_generators,{<<>>,<<1,2>>}}), + error_check("begin << <> || <> <= a && Y <- [1]>> end.",{bad_generators,{a,[1]}}), + error_check("begin + X = 32, Y = 32, + << <<(X+Y)/integer>> || X <- [1,2] && Y <- [1,2,3,4]>> + end.", + {bad_generators,{[],[3,4]}}), + error_check("begin << <> || X <- [1] && Y <- a && <> <= <<2>> >> end.", + {bad_generators,{[1], a, <<2>>}}), + ok. + +zmc(Config) when is_list(Config) -> + check(fun() -> + [{a,b,1,3}] + end, + "begin + M1 = #{a=>1}, M2 = #{b=>3}, + [{K1, K2, V1, V2} || K1 := V1 <- M1 && K2 := V2 <- M2] + end.", + [{a,b,1,3}]), + check(fun() -> + [A * 4 || A <- lists:seq(1, 50)] + end, + "begin + Seq = lists:seq(1, 50), + M1 = maps:iterator(#{X=>X || X <- Seq}, ordered), + M2 = maps:iterator(#{X=>X || X <- lists:seq(1,50)}, ordered), + [X+Y+Z+W || X := Y <- M1 && Z := W <- M2] + end.", + [A * 4 || A <- lists:seq(1, 50)]), + check(fun() -> + [{A, A*3, A*2, A*4} || A <- lists:seq(1, 50)] + end, + "begin + Seq = lists:seq(1, 50), + M3 = maps:iterator(#{X=>X*3 || X <- Seq}, ordered), + M4 = maps:iterator(#{X*2=>X*4 || X <- Seq}, ordered), + [{X, Y, Z, W} || X := Y <- M3 && Z := W <- M4] + end.", + [{A, A*3, A*2, A*4} || A <- lists:seq(1, 50)]), + check(fun() -> + #{K1 => V1+V2 || K1:=V1 <- #{a=>1} && _K2:=V2 <- #{b=>3}} + end, + "begin + #{K1 => V1+V2 || K1:=V1 <- #{a=>1} && _K2:=V2 <- #{b=>3}} + end.", + #{a=>4}), + check(fun() -> + #{K=>V || a := b <- #{x => y} && K := V <- #{x => y}} + end, + "begin + #{K=>V || a := b <- #{x => y} && K := V <- #{x => y}} + end.", + #{}), + error_check("begin + #{K1 => V1+V2 || K1:=V1 <- #{a=>1} && + _K2:=V2 <- maps:iterator(#{b=>3,c=>4}, ordered)} + end.", + {bad_generators,{#{},#{c=>4}}}), + error_check("begin #{X=>Y || X <- [1] && Y <- a && K1:=V1 <- #{b=>3}} end.", + {bad_generators,{[1], a, #{b=>3}}}), + ok. + %% Simple cases, just to cover some code. simple_cases(Config) when is_list(Config) -> check(fun() -> A = $C end, "A = $C.", $C), diff --git a/lib/debugger/test/zlc_SUITE.erl b/lib/debugger/test/zlc_SUITE.erl new file mode 100644 index 000000000000..875271d432f4 --- /dev/null +++ b/lib/debugger/test/zlc_SUITE.erl @@ -0,0 +1,267 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2024. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(zlc_SUITE). + +-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,mixed_zlc/1,zmc/1,filter_guard/1, + filter_pattern/1,cartesian/1,nomatch/1,bad_generators/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap,{minutes,1}}]. + +all() -> + [basic, + mixed_zlc, + zmc, + filter_guard, + filter_pattern, + cartesian, + nomatch, + bad_generators]. + +groups() -> + []. + +init_per_suite(Config) when is_list(Config) -> + test_lib:interpret(?MODULE), + true = lists:member(?MODULE, int:interpreted()), + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + + +init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + Config. + +end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + ok. + +basic(Config) when is_list(Config) -> + [6, 7, 8] = [X + Y + Z || X <- [1, 2, 3] && Y <- [2, 2, 2] && Z <- [3,3,3]], + [{1, 2, 3}, {2, 2, 3}, {3, 2, 3}] = + [{X, Y, Z} || X <- [1, 2, 3] && Y <- [2, 2, 2] && Z <- [3,3,3]], + [6, 24] = zipwith4(fun(A, B, C, D) -> (A + B + C) * D end, + [1, 5], [2, 2], [0, 1], [2, 3]), + 96 = dot([1, 2, 3, 4], [24, 12, 8, 6]), + + [1, 4, 5] = ifelse([true, false, true], [1, 3, 5], [2, 4, 6]), + + [8, 14, 20] = [X + Y + Z || <> <= <<5, 10, 15>> && <> <= <<1, 2, 3>> + && <> <= <<2, 2, 2>>]. + + +zipwith4(F, As, Bs, Cs, Ds) -> + [F(A,B,C,D) || A <- As && B <- Bs && C <- Cs && D <- Ds]. + +dot(Xs, Ys) -> + lists:sum([X*Y || X <- Xs && Y <- Ys]). + +ifelse(Tests, Xs, Ys) -> % Simulate R's ifelse(,,) + [ case T of true -> X ; false -> Y end + || T <- Tests && X <- Xs && Y <- Ys + ]. + +mixed_zlc(Config) when is_list(Config) -> + [{a, 2}, {b, 4}, {c, 6}] = [{X,Y} || X <- [a,b,c] && <> <= <<2,4,6>>], + [{a, 2}, {b, 4}, {c, 6}] = [{X,Y} || <> <= <<2,4,6>> && X <- [a,b,c]], + [{a,c,1,3}, {b,d,2,4}] = [{K1,K2,V1,V2}|| + K1 := V1 <- maps:iterator(#{a=>1, b=>2}, ordered) && + K2 := V2 <- maps:iterator(#{c=>3, d=>4}, ordered)], + [{a,1,2}, {b,2,4}] = + [{K1,V1,Y} || K1 := V1 <- maps:iterator(#{a=>1, b=>2}, ordered) && + <> <= <<2,4>>], + [{a,1,2}, {b,2,4}] = [{K1,V1,Y} || + K1 := V1 <- maps:iterator(#{a=>1, b=>2}, ordered) && + <> <= <<2,4>>], + <<3,4,5>> = << <<(X+Y)/integer>> || X <- [1,2,3] && Y <- [2,2,2]>>, + <<3,4,5>> = << <<(X+V1)/integer>> || + X <- [1,2,3] && + _K1 := V1 <- maps:iterator(#{a=>2, b=>2, c=>2}, ordered)>>, + <<3,4,5>> = << <<(X+V1)/integer>> || + <> <= <<1,2,3>> && + _K1 := V1 <- maps:iterator(#{a=>2, b=>2, c=>2}, ordered)>>, + <<3,4,5>> = << <<(V1+V2)/integer>> || + _K1 := V1 <- maps:iterator(#{a=>1, b=>2, c=>3}, ordered) && + _K2 := V2 <- maps:iterator(#{a=>2, b=>2, c=>2}, ordered)>>, + #{c := 3,b := 2,a := 1} = #{X => Y || X <- [a,b,c] && Y <- [1,2,3]}, + #{c := 3,b := 2,a := 1} = #{X => Y || X <- [a,b,c] && <> <= <<1,2,3>>}, + ok. + +zmc(Config) when is_list(Config) -> + [{a,b,1,3}] = [{K1, K2, V1, V2} || K1 := V1 <- #{a=>1} && K2 := V2 <- #{b=>3}], + Seq = lists:seq(1, 50), + M1 = maps:iterator(#{X=>X || X <- Seq}, ordered), + M2 = maps:iterator(#{X=>X || X <- lists:seq(1,50)}, ordered), + true = [A * 4 || A <- Seq] =:= + [X+Y+Z+W || X := Y <- M1 && Z := W <- M2], + true = << <<(A * 4):64>> || A <- Seq>> =:= + << <<(X+Y+Z+W):64>> || X := Y <- M1 && Z := W <- M2>>, + + M3 = maps:iterator(#{X=>X*3 || X <- Seq}, ordered), + M4 = maps:iterator(#{X*2=>X*4 || X <- Seq}, ordered), + true = [{A, A*3, A*2, A*4} || A <- Seq] =:= + [{X, Y, Z, W} || X := Y <- M3 && Z := W <- M4], + true = [A * 3 || A <- Seq] =:= [X+Y+Z || X := Y <- M1 && Z <- Seq], + true = << <> || A <- Seq>> =:= + << <> || X := Y <- M3 && Z := W <- M4>>, + true = << <<(A*3):64>> || A <- Seq>> =:= + << <<(X+Y+Z):64>> || X := Y <- M1 && Z <- Seq>>, + + M5 = maps:iterator(#{X => + case X rem 2 of + 0 -> {ok,X}; + 1 -> {error,X} + end || X <- Seq}, ordered), + M6 = maps:iterator(#{X*2 => X*4 || X <- Seq}, ordered), + [] = [X || {{X,{ok,X}}, {_,X}} <- lists:zip(maps:to_list(M5), maps:to_list(M6))], + [] = [X || X := {ok,X} <- M5 && _ := X <- M6], + [] = [X || X := {e,X} <- M5 && X := {ok,X} <- M5], + + ok. + +filter_guard(Config) when is_list(Config) -> + [[1,2,1]] = [X++Y || X <- [[1,2], [2,-3]] && Y <- [[1], [2]], lists:sum(X)>0], + [{a,2}, {b,4}, {c,6}] = [{X,Y} || X <- [a,b,c] && <> <= <<2,4,6>>, + Y rem 2 == 0], + [{b,4}, {c,6}] = [{X, Y} || X <- [a,b,c] && <> <= <<2,4,6>>, Y =/= 2], + [] = [{X,Y} || X <- [a, b, c] && <> <= <<2,4,6>>, Y rem 2 == 1], + [{b,4}] = [{X,Y} || <> <= <<2,4,6>> && X <- [a,b,c], X>a, X1, b=>2}, ordered) && + K2 := V2 <- maps:iterator(#{c=>3, d=>4}, ordered), + V2 rem 2 == 0], + <<5>> = << <<(X+Y)/integer>> || X <- [1,2,3] && Y <- [2,2,2], X rem 2 == 1, X+Y>4>>, + #{c := 3,a := 1} = #{X => Y || X <- [a,b,c] && Y <- [1,2,3], Y rem 2 == 1}, + #{c := 3} = #{X => Y || X <- [a,b,c] && Y <- [1,2,3], Y rem 2 == 1, Y > 1}, + #{c := 3,a := 1} = #{X => Y || X <- [a,b,c] && <> <= <<1,2,3>>, Y rem 2 == 1}. + +filter_pattern(Config) when is_list(Config) -> + [] = do_filter_pat_1([], []), + [] = do_filter_pat_1([a], [a]), + [] = do_filter_pat_1([{ok,a}], [{error,e}]), + [] = do_filter_pat_2([], []), + [] = do_filter_pat_2([a], [b]), + [] = do_filter_pat_2([{a,1}], [{b,1}]), + [{1,7}] = do_filter_pat_2([{a,1}], [{a,7}]), + [{1,7},{10,20}] = do_filter_pat_2([{a,1},{b,9},{x,10}], + [{a,7},{wrong,8},{x,20}]), + ok. +do_filter_pat_1(L1, L2) -> + Res = [{A,B} || {ok,A} <- L1 && {ok,B} <- L2], + Res = [{A,B} || {{ok,A},{ok,B}} <- lists:zip(L1,L2)], + Res. +do_filter_pat_2(L1, L2) -> + Res = [{A,B} || {Same,A} <- L1 && {Same,B} <- L2], + Res = [{A,B} || {{Same,A},{Same,B}} <- lists:zip(L1,L2)], + Res. + +cartesian(Config) when is_list(Config) -> + [{a,3}, {b,5}, {c,7}, {a,4}, {b,6}, {c,8}] = + [{X, W+Y} || W <- [1,2], + X <- [a,b,c] && <> <= <<2,4,6>>], + [{a,3}, {a,4}, {b,5}, {b,6}, {c,7}, {c,8}] = + [{X, W+Y} || X <- [a,b,c] && + <> <= <<2,4,6>>, W <- [1,2]], + [{a,4}, {b,6}, {c,8}] = + [{X, W+Y} || X <- [a,b,c] && + <> <= <<2,4,6>>, W <- [1,2], (W + Y) rem 2 == 0], + <<4,2,5,3,6,4>> = << <<(X+V1+Y)/integer>> || + X <- [1,2,3] && + _K1 := V1 <- maps:iterator(#{a=>2, b=>2, c=>2}, ordered), + <> <= <<1,-1>> >>, + ok. + +nomatch(Config) when is_list(Config) -> + [] = do_nomatch_1([], []), + [] = do_nomatch_1([1], [a]), + [] = do_nomatch_1([1,2], [a,b]), + {'EXIT',{{bad_generators,{[1,2,3],[]}},_}} = do_nomatch_1([1,2,3], []), + {'EXIT',{{bad_generators,{[3],[]}},_}} = do_nomatch_1([1,2,3], [a,b]), + + <<>> = do_nomatch_2([], <<>>), + <<>> = do_nomatch_2([a], <<1>>), + {'EXIT',{{bad_generators,{[2],<<>>}},_}} = do_nomatch_2([1,2], <<3>>), + ok. + +do_nomatch_1(L1, L2) -> + catch [{X, Y} || a=b=X <- L1 && Y <- L2]. + +do_nomatch_2(L, Bin) -> + catch << <<(X+Y)/integer>> || a=b=X <- L && <> <= Bin >>. + +bad_generators(Config) when is_list(Config) -> + {'EXIT',{{bad_generators,{x,[1,2]}},_}} = + catch [{X,Y} || X <- x && Y <- [1,2]], + {'EXIT',{{bad_generators,{[],[4]}},_}} = + catch [{X,Y} || X <- [1,2,3] && Y <- [1,2,3,4]], + {'EXIT',{{bad_generators,{[3,4],[]}},_}} = + catch [{X,Y} || X <- [1,2,3,4] && Y <- [1,2], X < 3], + {'EXIT',{{bad_generators,{[3,4],[]}},_}} = + catch << <<(X+Y)/integer>> || X <- [1,2,3,4] && Y <- [1,2], X < 3>>, + {'EXIT',{{bad_generators,{<<>>,<<4>>}},_}} = + catch << <> || <> <= <<1:8,2:8>> && <> <= <<3:8,4:8>>>>, + {'EXIT',{{bad_generators,{<<1,2>>,a}},_}} = + catch << <> || <> <= <<1:8,2:8>> && <> <= a>>, + {'EXIT',{{bad_generator,a},_}} = catch [X || X := X <- a && _Y <- [1]], + {'EXIT',{{bad_generators,{[d],[]}},_}} = + catch #{X => Y || X <- [a,b,c,d] && Y <- [1,2,3], Y > 1}, + + %% Make sure that line numbers point out the generator. + + {'EXIT',{{bad_generators,{[],[4]}}, + [{?MODULE,_,_,_}|_]}} = + catch bad_generators([1,2,3],[1,2,3,4]), + + {'EXIT',{{bad_generators,{a,[2,3]}}, + [{?MODULE,_,_,_}|_]}} = + catch bad_generators_bc(a,[2,3]), + + {'EXIT',{{bad_generators,{[2],[]}}, + [{?MODULE,_,_,_}|_]}} = + catch bad_generators_mc([1,2],[1]), + + %% List comprehensions with improper lists. + {'EXIT',{{bad_generators,{d,[d]}}, + [{?MODULE,_,_,_}|_]}} = + catch bad_generators([a,b,c|d],[a,b,c,d]), + + ok. + +-file("bad_zlc.erl", 1). +bad_generators(L1,L2) -> %Line 2 + [{I1, I2} || %Line 3 + I1 <- L1 && I2 <- L2]. %Line 4 +bad_generators_bc(L1,L2) -> %Line 5 + << <> || %Line 6 + I1 <- L1 && I2 <- L2>>. %Line 7 +bad_generators_mc(L1,L2) -> %Line 8 + #{I1 => I2 || %Line 9 + I1 <- L1 && I2 <- L2}. %Line 10 diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl index c50a6ae75e3d..8204ff94e5b3 100644 --- a/lib/stdlib/examples/erl_id_trans.erl +++ b/lib/stdlib/examples/erl_id_trans.erl @@ -631,6 +631,9 @@ comprehension_quals([{m_generate,Anno,P0,E0}|Qs]) -> E1 = expr(E0), P1 = pattern(P0), [{m_generate,Anno,P1,E1}|comprehension_quals(Qs)]; +comprehension_quals([{zip,Anno,Gens0}|Qs]) -> + Gens1 = comprehension_quals(Gens0), + [{zip,Anno,Gens1}|comprehension_quals(Qs)]; comprehension_quals([E0|Qs]) -> E1 = expr(E0), [E1|comprehension_quals(Qs)]; diff --git a/lib/stdlib/src/erl_error.erl b/lib/stdlib/src/erl_error.erl index d5f1e550a394..c5ae309ce12d 100644 --- a/lib/stdlib/src/erl_error.erl +++ b/lib/stdlib/src/erl_error.erl @@ -397,6 +397,8 @@ explain_reason({bad_filter,V}, error=Cl, [], PF, S, _Enc, CL) -> format_value(V, <<"bad filter ">>, Cl, PF, S, CL); explain_reason({bad_generator,V}, error=Cl, [], PF, S, _Enc, CL) -> format_value(V, <<"bad generator ">>, Cl, PF, S, CL); +explain_reason({bad_generators,V}, error=Cl, [], PF, S, _Enc, CL) -> + format_value(V, <<"bad generators: ">>, Cl, PF, S, CL); explain_reason({unbound,V}, error, [], _PF, _S, _Enc, _CL) -> io_lib:fwrite(<<"variable ~w is unbound">>, [V]); %% Exit codes local to the shell module (restricted shell): diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 0989f43ed9c7..391cbdcb5db9 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -129,7 +129,7 @@ to be called. -export([exprs/2,exprs/3,exprs/4,expr/2,expr/3,expr/4,expr/5, expr_list/2,expr_list/3,expr_list/4]). --export([new_bindings/0,bindings/1,binding/2,add_binding/3,del_binding/2]). +-export([new_bindings/0,new_bindings/1,bindings/1,binding/2,add_binding/3,del_binding/2]). -export([extended_parse_exprs/1, extended_parse_term/1]). -export([is_constant_expr/1, partial_eval/1, eval_str/1]). @@ -139,7 +139,7 @@ to be called. -export([check_command/2, fun_data/1]). --import(lists, [reverse/1,foldl/3,member/2]). +-import(lists, [all/2,any/2,foldl/3,member/2,reverse/1]). -export_type([binding_struct/0]). @@ -916,6 +916,9 @@ do_apply(F, _Anno, FunOrModFun, Args) when is_function(F, 2) -> eval_lc(E, Qs, Bs, Lf, Ef, RBs, FUVs) -> ret_expr(lists:reverse(eval_lc1(E, Qs, Bs, Lf, Ef, FUVs, [])), Bs, RBs). +eval_lc1(E, [{zip, Anno, Gens}|Qs], Bs0, Lf, Ef, FUVs, Acc0) -> + {VarList, Bs1} = convert_gen_values(Gens, [], Bs0, Lf, Ef, FUVs), + eval_zip(E, [{zip, Anno, VarList}|Qs], Bs1, Lf, Ef, FUVs, Acc0, fun eval_lc1/7); eval_lc1(E, [Q|Qs], Bs0, Lf, Ef, FUVs, Acc0) -> case is_generator(Q) of true -> @@ -929,6 +932,171 @@ eval_lc1(E, [], Bs, Lf, Ef, FUVs, Acc) -> {value,V,_} = expr(E, Bs, Lf, Ef, none, FUVs), [V|Acc]. +%% convert values for generator vars from abstract form to flattened lists +convert_gen_values([{generate, Anno, P, L0}|Qs], Acc, Bs0, Lf, Ef,FUVs) -> + {value,L1,_Bs1} = expr(L0, Bs0, Lf, Ef, none, FUVs), + convert_gen_values(Qs, [{generate, Anno, P, L1}|Acc], Bs0, Lf, Ef, FUVs); +convert_gen_values([{b_generate, Anno, P, L0}|Qs], Acc, Bs0, Lf, Ef,FUVs) -> + {value,L1,_Bs1} = expr(L0, Bs0, Lf, Ef, none, FUVs), + convert_gen_values(Qs, [{b_generate, Anno, P, L1}|Acc], Bs0, Lf, Ef, FUVs); +convert_gen_values([{m_generate, Anno, P, Map0}|Qs], Acc, Bs0, Lf, Ef,FUVs) -> + {map_field_exact,_,K,V} = P, + {value,Map,_Bs1} = expr(Map0, Bs0, Lf, Ef, none, FUVs), + Iter = case is_map(Map) of + true -> + maps:iterator(Map); + false -> + %% Validate iterator. + try maps:foreach(fun(_, _) -> ok end, Map) of + _ -> + Map + catch + _:_ -> + apply_error({bad_generator,Map}, ?STACKTRACE, + Anno, Bs0, Ef, none) + end + end, + convert_gen_values(Qs, [{m_generate, Anno, {tuple, Anno, [K, V]}, Iter}|Acc], + Bs0, Lf, Ef, FUVs); +convert_gen_values([], Acc, Bs0, _Lf, _Ef, _FUVs) -> + {reverse(Acc), Bs0}. + +bind_all_generators(Gens, Bs0, Lf, Ef, FUVs) -> + bind_all_generators1(Gens, [], new_bindings(Bs0), Lf, Ef, FUVs, continue). + +bind_all_generators1([{b_generate, Anno, P, <<_/bitstring>>=Bin}|Qs], + Acc, Bs0, Lf, Ef, FUVs, continue) -> + Mfun = match_fun(Bs0, Ef), + Efun = fun(Exp, Bs) -> expr(Exp, Bs, Lf, Ef, none) end, + ErrorFun = fun(A, R, S) -> apply_error(R, S, A, Bs0, Ef, none) end, + case eval_bits:bin_gen(P, Bin, new_bindings(Bs0), Bs0, Mfun, Efun, ErrorFun) of + {match, Rest, Bs1} -> + Bs2 = zip_add_bindings(Bs1, Bs0), + case Bs2 of + nomatch -> + bind_all_generators1(Qs,[{b_generate, Anno, P, Rest}|Acc], + Bs0, Lf, Ef, FUVs, skip); + _ -> + bind_all_generators1(Qs,[{b_generate, Anno, P, Rest}|Acc], + Bs2, Lf, Ef, FUVs, continue) + end; + {nomatch, Rest} -> + bind_all_generators1(Qs, [{b_generate, Anno, P, Rest}|Acc], + Bs0, Lf, Ef, FUVs, skip); + done -> + {[], done} + end; +bind_all_generators1([{b_generate, Anno, P, <<_/bitstring>>=Bin}|Qs], + Acc, Bs0, Lf, Ef, FUVs, skip) -> + Mfun = match_fun(Bs0, Ef), + Efun = fun(Exp, Bs) -> expr(Exp, Bs, Lf, Ef, none) end, + ErrorFun = fun(A, R, S) -> apply_error(R, S, A, Bs0, Ef, none) end, + case eval_bits:bin_gen(P, Bin, new_bindings(Bs0), Bs0, Mfun, Efun, ErrorFun) of + {match, Rest, _} -> + bind_all_generators1(Qs, [{b_generate, Anno, P, Rest}|Acc], + Bs0, Lf, Ef, FUVs, skip); + {nomatch, Rest} -> + bind_all_generators1(Qs, [{b_generate, Anno, P, Rest}|Acc], + Bs0, Lf, Ef, FUVs, skip); + done -> + {[], skip} + end; +bind_all_generators1([{generate, Anno, P, [H|T]}|Qs], Acc, Bs0, Lf, Ef, FUVs, continue) -> + case match(P, H, Anno, new_bindings(Bs0), Bs0, Ef) of + {match,Bsn} -> + Bs2 = zip_add_bindings(Bsn, Bs0), + case Bs2 of + nomatch -> + bind_all_generators1(Qs,[{generate, Anno, P, T}|Acc], + Bs0, Lf, Ef, FUVs, skip); + _ -> bind_all_generators1(Qs,[{generate, Anno, P, T}|Acc], + Bs2, Lf, Ef, FUVs, continue) + end; + nomatch -> + %% match/6 returns nomatch. Skip this value + bind_all_generators1(Qs,[{generate, Anno, P, T}|Acc], Bs0, Lf, Ef, FUVs, skip) + end; +bind_all_generators1([{generate, Anno, P, [_H|T]}|Qs], Acc, Bs0, Lf, Ef, FUVs, skip) -> + bind_all_generators1(Qs,[{generate, Anno, P, T}|Acc], Bs0, Lf, Ef, FUVs, skip); +bind_all_generators1([{m_generate, Anno, P, Iter0}|Qs], Acc, Bs0, Lf, Ef, FUVs, continue) -> + case maps:next(Iter0) of + {K,V,Iter} -> + case match(P, {K,V}, Anno, new_bindings(Bs0), Bs0, Ef) of + {match,Bsn} -> + Bs2 = zip_add_bindings(Bsn, Bs0), + case Bs2 of + nomatch -> + bind_all_generators1(Qs,[{m_generate, Anno, P, Iter}|Acc], + Bs0, Lf, Ef, FUVs, skip); + _ -> bind_all_generators1(Qs,[{m_generate, Anno, P, Iter}|Acc], + Bs2, Lf, Ef, FUVs, continue) + end; + nomatch -> + bind_all_generators1(Qs, [{m_generate, Anno, P, Iter}|Acc], + Bs0, Lf, Ef, FUVs, skip) + end; + none -> + {[], done} + end; +bind_all_generators1([{m_generate, Anno, P, Iter0}|Qs], Acc, Bs0, Lf, Ef, FUVs, skip) -> + case maps:next(Iter0) of + {_K,_V,Iter} -> + bind_all_generators1(Qs, [{m_generate, Anno, P, Iter}|Acc], + Bs0, Lf, Ef, FUVs, skip); + none -> + {[], skip} + end; +bind_all_generators1([{generate,_,_,[]}|_], _, _, _, _, _,_) -> + %% no more values left for a var, time to return + {[],done}; +bind_all_generators1([{b_generate, _Anno, _P, _Term}|_Qs], Acc, _Bs0,_Lf, _Ef, _FUVs,_) -> + {Acc, error}; +bind_all_generators1([{generate, _Anno, _P, _Term}|_Qs], Acc, _Bs0, _Lf, _Ef, _FUVs,_) -> + {Acc, error}; +bind_all_generators1([], [_H|_T] = Acc, Bs0, _Lf, _Ef, _FUVs, continue) -> + %% all vars are bind for this round + {Acc, Bs0}; +bind_all_generators1([], [_H|_T] = Acc, _Bs0,_Lf, _Ef, _FUVs, skip) -> + {Acc, skip}. + +check_bad_generators([{generate,_,_,V}|T], Env, Acc) -> + check_bad_generators(T, Env, [V|Acc]); +check_bad_generators([{m_generate,_,_,Iter0}|T], Env, Acc) -> + case maps:next(Iter0) of + none -> check_bad_generators(T, Env, [#{}|Acc]); + _ -> check_bad_generators(T, Env, [#{K => V || K := V <- Iter0}|Acc]) + end; +check_bad_generators([{b_generate,_,P,<<_/bitstring>>=Bin}|T], {Bs0, Lf, Ef}, Acc) -> + Mfun = match_fun(Bs0, Ef), + Efun = fun(Exp, Bs) -> expr(Exp, Bs, Lf, Ef, none) end, + ErrorFun = fun(A, R, S) -> apply_error(R, S, A, Bs0, Ef, none) end, + case eval_bits:bin_gen(P, Bin, new_bindings(Bs0), Bs0, Mfun, Efun, ErrorFun) of + done -> + check_bad_generators(T, {Bs0, Lf, Ef}, [<<>>|Acc]); + _ -> + check_bad_generators(T, {Bs0, Lf, Ef}, [Bin|Acc]) + end; +check_bad_generators([{b_generate,_,_,Term}|T], Env, Acc) -> + check_bad_generators(T, Env, [Term|Acc]); +check_bad_generators([], _, Acc)-> + case any(fun is_generator_end/1, Acc) of + false -> + %% None of the generators has reached its end. + {ok, list_to_tuple(reverse(Acc))}; + true -> + case all(fun(V) -> is_generator_end(V) end, Acc) of + true -> + %% All generators have reached their end. + {ok, list_to_tuple(reverse(Acc))}; + false -> + {error, {bad_generators,list_to_tuple(reverse(Acc))}} + end + end. + +is_generator_end([]) -> true; +is_generator_end(<<>>) -> true; +is_generator_end(Other) -> Other =:= #{}. + %% eval_bc(Expr, [Qualifier], Bindings, LocalFunctionHandler, %% ExternalFuncHandler, RetBindings) -> %% {value,Value,Bindings} | Value @@ -936,6 +1104,9 @@ eval_lc1(E, [], Bs, Lf, Ef, FUVs, Acc) -> eval_bc(E, Qs, Bs, Lf, Ef, RBs, FUVs) -> ret_expr(eval_bc1(E, Qs, Bs, Lf, Ef, FUVs, <<>>), Bs, RBs). +eval_bc1(E, [{zip, Anno, Gens}|Qs], Bs0, Lf, Ef, FUVs, Acc0) -> + {VarList, Bs1} = convert_gen_values(Gens, [], Bs0, Lf, Ef, FUVs), + eval_zip(E, [{zip, Anno, VarList}|Qs], Bs1, Lf, Ef, FUVs, Acc0, fun eval_bc1/7); eval_bc1(E, [Q|Qs], Bs0, Lf, Ef, FUVs, Acc0) -> case is_generator(Q) of true -> @@ -958,6 +1129,9 @@ eval_mc(E, Qs, Bs, Lf, Ef, RBs, FUVs) -> Map = maps:from_list(L), ret_expr(Map, Bs, RBs). +eval_mc1(E, [{zip, Anno, Gens}|Qs], Bs0, Lf, Ef, FUVs, Acc0) -> + {VarList, Bs1} = convert_gen_values(Gens, [], Bs0, Lf, Ef, FUVs), + eval_zip(E, [{zip, Anno, VarList}|Qs], Bs1, Lf, Ef, FUVs, Acc0, fun eval_mc1/7); eval_mc1(E, [Q|Qs], Bs0, Lf, Ef, FUVs, Acc0) -> case is_generator(Q) of true -> @@ -971,6 +1145,26 @@ eval_mc1({map_field_assoc,Lfa,K0,V0}, [], Bs, Lf, Ef, FUVs, Acc) -> {value,KV,_} = expr({tuple,Lfa,[K0,V0]}, Bs, Lf, Ef, none, FUVs), [KV|Acc]. +eval_zip(E, [{zip, Anno, VarList}|Qs], Bs0, Lf, Ef, FUVs, Acc0, Fun) -> + Gens = case check_bad_generators(VarList, {Bs0, Lf, Ef}, []) of + {ok, Acc} -> Acc; + {error, Reason} -> + apply_error(Reason, ?STACKTRACE, Anno, Bs0, Ef, none) + end, + {Rest, Bs1} = bind_all_generators(VarList, Bs0, Lf, Ef, FUVs), + io:format("Rest~p~n", [Rest]), + case {Rest, Qs, Bs1} of + {_, _, error} -> apply_error({bad_generators,Gens}, ?STACKTRACE, Anno, Bs0, Ef, none); + {[], [], _} -> Acc0; + {[], _, _} -> Acc0; + {_,_,done} -> Acc0; + {_, _, skip} -> + eval_zip(E, [{zip, Anno, reverse(Rest)}|Qs], Bs0, Lf, Ef, FUVs, Acc0, Fun); + {_, _, _} -> + Acc1 = Fun(E, Qs, add_bindings(Bs1, Bs0), Lf, Ef, FUVs, Acc0), + eval_zip(E, [{zip, Anno, reverse(Rest)}|Qs], Bs0, Lf, Ef, FUVs, Acc1, Fun) + end. + eval_generator({generate,Anno,P,L0}, Bs0, Lf, Ef, FUVs, Acc0, CompFun) -> {value,L1,_Bs1} = expr(L0, Bs0, Lf, Ef, none, FUVs), eval_generate(L1, P, Anno, Bs0, Lf, Ef, CompFun, Acc0); @@ -1595,6 +1789,31 @@ structure. del_binding(Name, Bs) when is_map(Bs) -> maps:remove(Name, Bs); del_binding(Name, Bs) when is_list(Bs) -> orddict:erase(Name, Bs). +zip_add_bindings(Bs1, Bs2) when is_map(Bs1), is_map(Bs2) -> + zip_add_bindings_map(maps:keys(Bs1), Bs1, Bs2); +zip_add_bindings(Bs1, Bs2) when is_list(Bs1), is_list(Bs2) -> + zip_add_bindings1(orddict:to_list(Bs1), Bs2). + +zip_add_bindings_map([Key | Keys], Bs1, Bs2) -> + case {Bs1, Bs2} of + {#{Key := Same}, #{Key := Same}} -> zip_add_bindings_map(Keys, Bs1, Bs2); + {_, #{Key := _}} -> nomatch; + {#{Key := Value},_} -> zip_add_bindings_map(Keys, Bs1, Bs2#{Key => Value}) + end; +zip_add_bindings_map([], _, Bs2) -> + Bs2. + +zip_add_bindings1([{Name,Val}|Bs1], Bs2) -> + case orddict:find(Name, Bs2) of + {ok, Val} -> + zip_add_bindings1(Bs1, Bs2); + {ok, _Value} -> nomatch; + error -> + zip_add_bindings1(Bs1, orddict:store(Name, Val, Bs2)) + end; +zip_add_bindings1([], Bs2) -> + Bs2. + add_bindings(Bs1, Bs2) when is_map(Bs1), is_map(Bs2) -> maps:merge(Bs2, Bs1); add_bindings(Bs1, Bs2) -> @@ -1616,6 +1835,7 @@ merge_bindings(Bs1, Bs2, Anno, Ef) -> end end, Bs2, orddict:to_list(Bs1)). +-spec(new_bindings(binding_struct()) -> binding_struct()). new_bindings(Bs) when is_map(Bs) -> maps:new(); new_bindings(Bs) when is_list(Bs) -> orddict:new(). diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index 2b09006faf24..5a4f536becf0 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -558,6 +558,10 @@ lc_tq(Anno, [{m_generate,AnnoG,P0,G0} | Qs0], St0) -> {Qs1,St4} = lc_tq(Anno, Qs0, St3), P1 = {map_field_exact,AnnoMFE,KeyP1,ValP1}, {[{m_generate,AnnoG,P1,G1} | Qs1],St4}; +lc_tq(Anno, [{zip,AnnoG,G0} | Qs0], St0) -> + {G1,St1} = lc_tq(Anno, G0, St0), + {Qs1,St2} = lc_tq(Anno, Qs0, St1), + {[{zip,AnnoG,G1}|Qs1],St2}; lc_tq(Anno, [F0 | Qs0], #exprec{calltype=Calltype,raw_records=Records}=St0) -> %% Allow record/2 and expand out as guard test. IsOverriden = fun(FA) -> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 087461744b18..d6492727764f 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -403,6 +403,8 @@ format_error_1({too_many_arguments,Arity}) -> {~"too many arguments (~w) -- maximum allowed is ~w", [Arity,?MAX_ARGUMENTS]}; format_error_1(update_literal) -> ~"expression updates a literal"; +format_error_1(illegal_zip_generator) -> + ~"only generators are allowed in a zip generator."; %% --- patterns and guards --- format_error_1(illegal_map_assoc_in_pattern) -> ~"illegal pattern, did you mean to use `:=`?"; format_error_1(illegal_pattern) -> ~"illegal pattern"; @@ -3979,6 +3981,10 @@ lc_quals(Qs, Vt0, St0) -> {Vt,Uvt,St} = lc_quals(Qs, Vt0, [], St0#lint{recdef_top = false}), {Vt,Uvt,St#lint{recdef_top = OldRecDef}}. +lc_quals([{zip,_Anno,Gens} | Qs], Vt0, Uvt0, St0) -> + St1 = are_all_generators(Gens,St0), + {Vt,Uvt,St} = handle_generators(Gens,Vt0,Uvt0,St1), + lc_quals(Qs, Vt, Uvt, St); lc_quals([{generate,_Anno,P,E} | Qs], Vt0, Uvt0, St0) -> {Vt,Uvt,St} = handle_generator(P,E,Vt0,Uvt0,St0), lc_quals(Qs, Vt, Uvt, St); @@ -4005,6 +4011,33 @@ is_guard_test2_info(#lint{records=RDs,locals=Locals,imports=Imports}) -> is_imported_function(Imports, FA) end}. +are_all_generators([{generate,_,_,_}|Qs],St) -> are_all_generators(Qs,St); +are_all_generators([{b_generate,_,_,_}|Qs],St) -> are_all_generators(Qs,St); +are_all_generators([{m_generate,_,_,_}|Qs],St) -> are_all_generators(Qs,St); +are_all_generators([Q|_Qs],St) -> + Anno1 = element(2,Q), + add_error(Anno1, illegal_zip_generator, St); +are_all_generators([],St) -> St. + +handle_generators(Gens,Vt,Uvt,St0) -> + Ps = [P || {_,_,P,_} <- Gens], + Es = [E || {_,_,_,E} <- Gens], + {Evt,St1} = exprs(Es, Vt, St0), + %% Forget variables local to E immediately. + Vt1 = vtupdate(vtold(Evt, Vt), Vt), + {_, St2} = check_unused_vars(Evt, Vt, St1), + {Pvt,Pnew,St3} = comprehension_pattern(Ps, Vt1, St2), + %% Have to keep fresh variables separated from used variables somehow + %% in order to handle for example X = foo(), [X || <> <- bar()]. + %% 1 2 2 1 + Vt2 = vtupdate(Pvt, Vt1), + St4 = shadow_vars(Pnew, Vt1, generate, St3), + Svt = vtold(Vt2, Pnew), + {_, St5} = check_old_unused_vars(Svt, Uvt, St4), + NUvt = vtupdate(vtnew(Svt, Uvt), Uvt), + Vt3 = vtupdate(vtsubtract(Vt2, Pnew), Pnew), + {Vt3,NUvt,St5}. + handle_generator(P,E,Vt,Uvt,St0) -> {Evt,St1} = expr(E, Vt, St0), %% Forget variables local to E immediately. @@ -4022,6 +4055,10 @@ handle_generator(P,E,Vt,Uvt,St0) -> Vt3 = vtupdate(vtsubtract(Vt2, Pnew), Pnew), {Vt3,NUvt,St5}. +comprehension_pattern([_|_]=Ps, Vt, St) -> + Mps = [K || {map_field_exact,_,K,_} <- Ps] ++ [V || {map_field_exact,_,_,V} <- Ps], + Ps1 = [P || P <- Ps, element(1,P)=/=map_field_exact], + pattern_list(Ps1++Mps, Vt, [], St); comprehension_pattern({map_field_exact,_,K,V}, Vt, St) -> pattern_list([K,V], Vt, [], St); comprehension_pattern(P, Vt, St) -> diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 01540c00db94..b8ba3a104c64 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -31,6 +31,7 @@ pat_expr pat_expr_max map_pat_expr record_pat_expr pat_argument_list pat_exprs list tail list_comprehension lc_expr lc_exprs +zc_exprs map_comprehension binary_comprehension tuple @@ -79,7 +80,7 @@ ssa_check_when_clauses. Terminals char integer float atom sigil_prefix string sigil_suffix var -'(' ')' ',' '->' '{' '}' '[' ']' '|' '||' '<-' ';' ':' '#' '.' +'(' ')' ',' '->' '{' '}' '[' ']' '|' '||' '<-' ';' ':' '#' '.' '&&' 'after' 'begin' 'case' 'try' 'catch' 'end' 'fun' 'if' 'of' 'receive' 'when' 'maybe' 'else' 'andalso' 'orelse' @@ -362,6 +363,11 @@ binary_comprehension -> '<<' expr_max '||' lc_exprs '>>' : {bc,?anno('$1'),'$2','$4'}. lc_exprs -> lc_expr : ['$1']. lc_exprs -> lc_expr ',' lc_exprs : ['$1'|'$3']. +lc_exprs -> zc_exprs : [{zip, ?anno(hd('$1')), '$1'}]. +lc_exprs -> zc_exprs ',' lc_exprs : [{zip, ?anno('$2'), '$1'}|'$3']. + +zc_exprs -> lc_expr '&&' lc_expr : ['$1','$3']. +zc_exprs -> lc_expr '&&' zc_exprs : ['$1'|'$3']. lc_expr -> expr : '$1'. lc_expr -> map_field_exact '<-' expr : {m_generate,?anno('$2'),'$1','$3'}. @@ -782,7 +788,7 @@ processed (see section [Error Information](#module-error-information)). -export_type([abstract_clause/0, abstract_expr/0, abstract_form/0, abstract_type/0, form_info/0, error_info/0]). %% The following types are exported because they are used by syntax_tools --export_type([af_binelement/1, af_generator/0, af_remote_function/0]). +-export_type([af_binelement/1, af_generator/0, af_zip_generator/0, af_remote_function/0]). %% The following type is used by PropEr -export_type([af_field_decl/0]). @@ -938,6 +944,8 @@ processed (see section [Error Information](#module-error-information)). | {'m_generate', anno(), af_assoc_exact(af_pattern()), abstract_expr()} | {'b_generate', anno(), af_pattern(), abstract_expr()}. +-type af_zip_generator() :: [af_generator(), ...]. + -type af_filter() :: abstract_expr(). -type af_block() :: {'block', anno(), af_body()}. diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 8cc2c24781d7..ab97c71fed56 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1047,6 +1047,8 @@ clauses(Type, Opts, Cs) -> lc_quals(Qs, Opts) -> {prefer_nl,[$,],lexprs(Qs, fun lc_qual/2, Opts)}. +lc_qual({zip,_,Qs}, Opts) -> + {prefer_nl,["&&"],lexprs(Qs, fun lc_qual/2, Opts)}; lc_qual({m_generate,_,Pat,E}, Opts) -> Pl = map_field(Pat, Opts), {list,[{step,[Pl,leaf(" <-")],lexpr(E, 0, Opts)}]}; diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 313d89ee1103..0664a5cbdd6a 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -604,6 +604,12 @@ scan1(".."++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "..", '..', 2); scan1("."=Cs, St, Line, Col, Toks) -> {more,{Cs,St,Col,Toks,Line,[],fun scan/6}}; +scan1("&&"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "&&", '&&', 2); +scan1("&"=Cs, St, Line, Col, Toks) -> + {more,{Cs,St,Col,Toks,Line,[],fun scan/6}}; +scan1("&"++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "&", '&', 1); scan1([$.=C|Cs], St, Line, Col, Toks) -> scan_dot(Cs, St, Line, Col, Toks, [C]); scan1([$'|Cs], St, Line, Col, Toks) -> %' Emacs @@ -735,8 +741,6 @@ scan1([$`|Cs], St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "`", '`', 1); scan1([$~|Cs], St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "~", '~', 1); -scan1([$&|Cs], St, Line, Col, Toks) -> - tok2(Cs, St, Line, Col, Toks, "&", '&', 1); %% End of optimization. scan1([C|Cs], St, Line, Col, Toks) when ?UNI255(C) -> Str = [C], diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index e28dd788bb9b..2cac82f3acba 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -29,6 +29,9 @@ pattern_expr/1, guard_3/1, guard_4/1, guard_5/1, lc/1, + zlc/1, + zbc/1, + zmc/1, simple_cases/1, unary_plus/1, apply_atom/1, @@ -97,7 +100,7 @@ all() -> otp_8133, otp_10622, otp_13228, otp_14826, funs, custom_stacktrace, try_catch, eval_expr_5, zero_width, eep37, eep43, otp_15035, otp_16439, otp_14708, otp_16545, otp_16865, - eep49, binary_and_map_aliases, eep58]. + eep49, binary_and_map_aliases, eep58, zlc, zbc, zmc]. groups() -> []. @@ -278,6 +281,161 @@ lc(Config) when is_list(Config) -> "[X || X <- [true,false], X].", [true]), ok. +%% EEP-73 zip generator. +zlc(Config) when is_list(Config) -> + check(fun() -> + X = 32, Y = 32, [{X, Y} || X <- [1,2,3] && Y <- [4,5,6]] + end, + "begin X = 32, Y = 32, [{X, Y} || X <- [1,2,3] && Y <- [4,5,6]] end.", + [{1,4},{2,5},{3,6}]), + check(fun() -> + S1 = [x, y, z], S2 = [5, 10, 15], X = 32, Y = 32, + [{X, Y} || X <- S1 && Y <- S2] + end, + "begin + S1 = [x, y, z], S2 = [5, 10, 15], X = 32, Y = 32, + [{X, Y} || X <- S1 && Y <- S2] + end.", + [{x,5}, {y,10}, {z,15}]), + check(fun() -> + [{X, Y, K} || X <- [1,2,3] && Y:=K <- #{1=>a, 2=>b, 3=>c}] + end, + "begin [{X, Y, K} || X <- [1,2,3] && Y:=K <- #{1=>a, 2=>b, 3=>c}] end.", + [{1,1,a},{2,2,b},{3,3,c}]), + check(fun() -> + [{X, W+Y} || X <- [a, b, c] && <> <= <<2, 4, 6>>, W <- [1,2]] + end, + "begin [{X, W+Y} || X <- [a, b, c] && <> <= <<2, 4, 6>>, W <- [1,2]] end.", + [{a,3}, {a,4}, {b,5}, {b,6}, {c,7}, {c,8}]), + check(fun() -> + [{X, W+Y} || W <- [0], X <- [a, b, c] && <> <= <<2, 4, 6>>, Y<4] + end, + "begin [{X, W+Y} || W <- [0], X <- [a, b, c] && <> <= <<2, 4, 6>>, Y<4] end.", + [{a,2}]), + check(fun() -> + [{X,Y}|| a=b=X <- [1,2] && Y <-[1,2]] end, + "begin [{X,Y}|| a=b=X <- [1,2] && Y <-[1,2]] end.", + []), + check(fun() -> + [{A,B,W} || {Same,W} <- [{a,1}], + {Same,A} <- [{a,1},{b,9},{x,10}] && {Same,B} <- [{a,7},{wrong,8},{x,20}]] + end, + "begin [{A,B,W} || {Same,W} <- [{a,1}], + {Same,A} <- [{a,1},{b,9},{x,10}] && {Same,B} <- [{a,7},{wrong,8},{x,20}]] + end.", + [{1,7,1},{10,20,1}]), + error_check("[X || X <- a && Y <- [1]].",{bad_generators,{a,[1]}}), + error_check("[{X,Y} || X <- a && <> <= <<1,2>>].",{bad_generators,{a,<<1,2>>}}), + error_check("[{X,V} || X <- a && _K := V <- #{b=>3}].",{bad_generators,{a,#{b=>3}}}), + error_check("begin + X = 32, Y = 32, [{X, Y} || X <- [1,2,3] && Y <- [4]] end.", + {bad_generators,{[2,3],[]}}), + error_check("begin + X = 32, Y = 32, [{X, Y} || X <- [1,2,3] && Y:=_V <- #{1=>1}] end.", + {bad_generators,{[2,3],#{}}}), + ok. + +zbc(Config) when is_list(Config) -> + check(fun() -> + <<3, 4, 5>> + end, + "begin + X = 32, Y = 32, + << <<(X+Y)/integer>> || <> <= <<1,2,3>> && <> <= <<2,2,2>> >> + end.", + <<3, 4, 5>>), + check(fun() -> + <<4,5,6,5,6,7,6,7,8>> + end, + "begin + X = 32, Y = 32, Z = 32, + << <<(X+Y+Z)/integer>> || <> <= <<1,2,3>> && <> <= <<2,2,2>>, Z<-[1,2,3] >> + end.", + <<4,5,6,5,6,7,6,7,8>>), + check(fun() -> + <<4, 5, 6>> + end, + "begin + L1 = <<1, 2, 3>>, L2 = <<1, 1, 1>>, L3 = <<2, 2, 2>>, + << <<(X+Y+Z)/integer>> || <> <= L1 && <> <= L2 && <> <= L3 >> + end.", + <<4, 5, 6>>), + check(fun() -> + << <<(X+Y):64>>|| a=b=X <- [1,2] && Y <- [1,2] >> end, + "begin << <<(X+Y):64>>|| a=b=X <- [1,2] && Y <- [1,2] >> end.", + <<>>), + check(fun() -> + << <<(X+Y):64>>|| a=b=X <- [1,2] && <> <= <<1,2>> >> end, + "begin << <<(X+Y):64>>|| a=b=X <- [1,2] && <> <= <<1,2>> >> end.", + <<>>), + check(fun() -> + << <<(X+V):64>>|| a=b=X <- [1,2] && _K:=V <- #{a=>1,b=>2}>> end, + "begin << <<(X+V):64>>|| a=b=X <- [1,2] && _K:=V <- #{a=>1,b=>2}>> end.", + <<>>), + error_check("begin << <<(X+Y):8>> || <> <= <<1,2>> && <> <= <<1,2>> >> end.", + {bad_generators,{<<>>,<<1,2>>}}), + error_check("begin << <> || <> <= a && Y <- [1]>> end.",{bad_generators,{a,[1]}}), + error_check("begin + X = 32, Y = 32, + << <<(X+Y)/integer>> || X <- [1,2] && Y <- [1,2,3,4]>> + end.", + {bad_generators,{[],[3,4]}}), + error_check("begin << <> || X <- [1] && Y <- a && <> <= <<2>> >> end.", + {bad_generators,{[1], a, <<2>>}}), + ok. + +zmc(Config) when is_list(Config) -> + check(fun() -> + [{a,b,1,3}] + end, + "begin + M1 = #{a=>1}, M2 = #{b=>3}, + [{K1, K2, V1, V2} || K1 := V1 <- M1 && K2 := V2 <- M2] + end.", + [{a,b,1,3}]), + check(fun() -> + [A * 4 || A <- lists:seq(1, 50)] + end, + "begin + Seq = lists:seq(1, 50), + M1 = maps:iterator(#{X=>X || X <- Seq}, ordered), + M2 = maps:iterator(#{X=>X || X <- lists:seq(1,50)}, ordered), + [X+Y+Z+W || X := Y <- M1 && Z := W <- M2] + end.", + [A * 4 || A <- lists:seq(1, 50)]), + check(fun() -> + [{A, A*3, A*2, A*4} || A <- lists:seq(1, 50)] + end, + "begin + Seq = lists:seq(1, 50), + M3 = maps:iterator(#{X=>X*3 || X <- Seq}, ordered), + M4 = maps:iterator(#{X*2=>X*4 || X <- Seq}, ordered), + [{X, Y, Z, W} || X := Y <- M3 && Z := W <- M4] + end.", + [{A, A*3, A*2, A*4} || A <- lists:seq(1, 50)]), + check(fun() -> + #{K1 => V1+V2 || K1:=V1 <- #{a=>1} && _K2:=V2 <- #{b=>3}} + end, + "begin + #{K1 => V1+V2 || K1:=V1 <- #{a=>1} && _K2:=V2 <- #{b=>3}} + end.", + #{a=>4}), + check(fun() -> + #{K=>V || a := b <- #{x => y} && K := V <- #{x => y}} + end, + "begin + #{K=>V || a := b <- #{x => y} && K := V <- #{x => y}} + end.", + #{}), + error_check("begin + #{K1 => V1+V2 || K1:=V1 <- #{a=>1} && + _K2:=V2 <- maps:iterator(#{b=>3,c=>4}, ordered)} + end.", + {bad_generators,{#{},#{c=>4}}}), + error_check("begin #{X=>Y || X <- [1] && Y <- a && K1:=V1 <- #{b=>3}} end.", + {bad_generators,{[1], a, #{b=>3}}}), + ok. + %% Simple cases, just to cover some code. simple_cases(Config) when is_list(Config) -> check(fun() -> A = $C end, "A = $C.", $C), diff --git a/lib/stdlib/test/erl_expand_records_SUITE.erl b/lib/stdlib/test/erl_expand_records_SUITE.erl index fe055e03f773..e51044febf2d 100644 --- a/lib/stdlib/test/erl_expand_records_SUITE.erl +++ b/lib/stdlib/test/erl_expand_records_SUITE.erl @@ -39,7 +39,7 @@ -export([attributes/1, expr/1, guard/1, init/1, pattern/1, strict/1, update/1, otp_5915/1, otp_7931/1, otp_5990/1, - otp_7078/1, maps/1, + otp_7078/1, maps/1, zlc/1, side_effects/1]). init_per_testcase(_Case, Config) -> @@ -55,7 +55,7 @@ suite() -> all() -> [attributes, expr, guard, init, pattern, strict, update, maps, - side_effects, {group, tickets}]. + side_effects, zlc, {group, tickets}]. groups() -> [{tickets, [], @@ -459,6 +459,15 @@ maps(Config) when is_list(Config) -> run(Config, Ts, [strict_record_tests]), ok. +zlc(Config) when is_list(Config) -> + Ts = [<<"-record(rr, {a,b,c}). + t() -> R0 = id(#rr{a=[{X,Y}||X <- [1,2] && Y <- [a,b]]}), + ok. + id(X) -> X. + ">>], + run(Config, Ts, [strict_record_tests]), + ok. + %% Strict record tests in guards. otp_5915(Config) when is_list(Config) -> %% These tests are also run by the compiler's record_SUITE. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index b515191639fb..f6b143a83854 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -87,7 +87,8 @@ match_float_zero/1, undefined_module/1, update_literal/1, - messages_with_jaro_suggestions/1]). + messages_with_jaro_suggestions/1, + illegal_zip_generator/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -123,7 +124,8 @@ all() -> match_float_zero, undefined_module, update_literal, - messages_with_jaro_suggestions]. + messages_with_jaro_suggestions, + illegal_zip_generator]. groups() -> [{unused_vars_warn, [], @@ -5451,6 +5453,24 @@ messages_with_jaro_suggestions(Config) -> ok. +illegal_zip_generator(Config) -> + Ts = [{not_generator, + <<"-compile({nowarn_unused_function,[{foo,0}]}). + foo() -> [X + Y || X <- [1,2,3,4] && Y <- [5,6,7] && X > 1]. + ">>, + {[]}, + {errors,[{{2,68},erl_lint,illegal_zip_generator}],[]}}, + {not_generator, + <<"-compile({nowarn_unused_function,[{bar,0}]}). + bar() -> [X + Y || X <- [[1,2],[3,4]] && lists:sum(X) > 0 && Y <- [5,6,7]]. + ">>, + {[]}, + {errors,[{{2,67},erl_lint,illegal_zip_generator}],[]}} + ], + [] = run(Config,Ts), + + ok. + %%% %%% Common utilities. %%% diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index ff01d0f4e60a..184a35246b37 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -838,6 +838,12 @@ lay_2(Node, Ctxt) -> D2 = lay(erl_syntax:map_generator_body(Node), Ctxt1), par([D1, beside(text("<- "), D2)], Ctxt1#ctxt.break_indent); + zip_generator -> + Ctxt1 = reset_prec(Ctxt), + par(seq(erl_syntax:zip_generator_body(Node), + floating(text("&&")), Ctxt1, + fun lay/2)); + implicit_fun -> D = lay(erl_syntax:implicit_fun_name(Node), reset_prec(Ctxt)), diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index a6fd397fda07..9bd550451619 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -351,6 +351,8 @@ trees. variable_literal/1, warning_marker/1, warning_marker_info/1, + zip_generator/1, + zip_generator_body/1, tree/1, tree/2, @@ -458,6 +460,7 @@ trees. | erl_parse:form_info() | erl_parse:af_binelement(term()) | erl_parse:af_generator() + | erl_parse:af_zip_generator() | erl_parse:af_remote_function(). %% The representation built by the Erlang standard library parser @@ -549,6 +552,7 @@ reason `badarg`. Node types currently defined by this module are: * `user_type_application` * `variable` * `warning_marker` +* `zip_generator` The user may (for special purposes) create additional nodes with other type tags, using the `tree/2` function. @@ -573,7 +577,7 @@ _See also: _`annotated_type/2`, `application/3`, `arity_qualifier/2`, `atom/1`, `size_qualifier/2`, `string/1`, `text/1`, `tree/2`, `try_expr/3`, `tuple/1`, `tuple_type/0`, `tuple_type/1`, `type_application/2`, `type_union/1`, `typed_record_field/2`, `underscore/0`, `user_type_application/2`, `variable/1`, -`warning_marker/1`. +`warning_marker/1`,`zip_generator/1`. """. -spec type(syntaxTree()) -> atom(). @@ -623,6 +627,7 @@ type(Node) -> {b_generate, _, _, _} -> binary_generator; {generate, _, _, _} -> generator; {m_generate, _, _, _} -> map_generator; + {zip,_,_} -> zip_generator; {lc, _, _, _} -> list_comp; {bc, _, _, _} -> binary_comp; {mc, _, _, _} -> map_comp; @@ -5962,6 +5967,50 @@ map_generator_body(Node) -> %% ===================================================================== +-record(zip_generator, {body :: [syntaxTree()]}). + +-doc """ +Creates an abstract zip_generator. + +The result represents `G1 && ... Gn`, where each `G` is a generator. + +_See also: _`binary_comp/2`, `list_comp/2`, `map_comp/2`, `map_generator_body/1`, +`map_generator_pattern/1`. +""". +-spec zip_generator([syntaxTree()]) -> syntaxTree(). + +%% `erl_parse' representation: +%% +%% {zip, Pos, Body} +%% +%% Body = erl_parse() + +zip_generator(Body) -> + tree(zip_generator, #zip_generator{body = Body}). + +revert_zip_generator(Node) -> + Pos = get_pos(Node), + Body = zip_generator_body(Node), + {zip, Pos, Body}. + + +-doc """ +Returns the body subtree of a `zip_generator` node. + +_See also: _`zip_generator/1`. +""". +-spec zip_generator_body(syntaxTree()) -> syntaxTree(). + +zip_generator_body(Node) -> + case unwrap(Node) of + {zip, _, Body} -> + Body; + Node1 -> + (data(Node1))#zip_generator.body + end. + +%% ===================================================================== + -doc """ Creates an abstract block expression. @@ -7373,6 +7422,8 @@ revert_root(Node) -> revert_variable(Node); warning_marker -> revert_warning_marker(Node); + zip_generator -> + revert_zip_generator(Node); _ -> %% Non-revertible new-form node Node @@ -7721,7 +7772,9 @@ subtrees(T) -> [typed_record_field_type(T)]]; user_type_application -> [[user_type_application_name(T)], - user_type_application_arguments(T)] + user_type_application_arguments(T)]; + zip_generator -> + [zip_generator_body(T)] end end. @@ -7837,7 +7890,8 @@ make_tree(tuple_type, [Es]) -> tuple_type(Es); make_tree(type_application, [[N], Ts]) -> type_application(N, Ts); make_tree(type_union, [Es]) -> type_union(Es); make_tree(typed_record_field, [[F],[T]]) -> typed_record_field(F, T); -make_tree(user_type_application, [[N], Ts]) -> user_type_application(N, Ts). +make_tree(user_type_application, [[N], Ts]) -> user_type_application(N, Ts); +make_tree(zip_generator, [Ts]) -> zip_generator(Ts). -doc """ diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl index 2e0df3c46b25..1fa60e7583fc 100644 --- a/lib/syntax_tools/src/erl_syntax_lib.erl +++ b/lib/syntax_tools/src/erl_syntax_lib.erl @@ -494,6 +494,8 @@ vann(Tree, Env) -> vann_generator(Tree, Env); binary_generator -> vann_binary_generator(Tree, Env); + zip_generator -> + vann_zip_generator(Tree, Env); block_expr -> vann_block_expr(Tree, Env); macro -> @@ -630,6 +632,8 @@ vann_list_comp_body_join() -> vann_binary_generator(T,Env); generator -> vann_generator(T, Env); + zip_generator -> + vann_zip_generator(T,Env); _ -> %% Bindings in filters are not %% exported to the rest of the @@ -666,6 +670,8 @@ vann_binary_comp_body_join() -> vann_binary_generator(T, Env); generator -> vann_generator(T, Env); + zip_generator -> + vann_zip_generator(T,Env); _ -> %% Bindings in filters are not %% exported to the rest of the @@ -684,6 +690,25 @@ vann_binary_comp_body(Ts, Env) -> {Ts1, {_, Bound, Free}} = lists:mapfoldl(F, {Env, [], []}, Ts), {Ts1, {Bound, Free}}. +vann_zip_generator_body_join() -> + fun (T, {Env, Bound, Free}) -> + {T1, Bound1, Free1} = case erl_syntax:type(T) of + binary_generator -> + vann_binary_generator(T, Env); + generator -> + vann_generator(T, Env) + end, + Env1 = ordsets:union(Env, Bound1), + {T1, {Env1, ordsets:union(Bound, Bound1), + ordsets:union(Free, + ordsets:subtract(Free1, Bound))}} + end. + +vann_zip_generator_body(Ts, Env) -> + F = vann_zip_generator_body_join(), + {Ts1, {_, Bound, Free}} = lists:mapfoldl(F, {Env, [], []}, Ts), + {Ts1, {Bound, Free}}. + %% In list comprehension generators, the pattern variables are always %% viewed as new occurrences, shadowing whatever is in the input %% environment (thus, the pattern contains no variable uses, only @@ -705,6 +730,13 @@ vann_binary_generator(Tree, Env) -> Tree1 = rewrite(Tree, erl_syntax:binary_generator(P1, E1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. +vann_zip_generator(Tree, Env) -> + Es = erl_syntax:zip_generator_body(Tree), + {Es1, {Bound, Free}} = vann_zip_generator_body(Es, Env), + Env1 = ordsets:union(Env, Bound), + Tree1 = rewrite(Tree, erl_syntax:zip_generator(Es1)), + {ann_bindings(Tree1, Env1, Bound, Free), Bound, Free}. + vann_block_expr(Tree, Env) -> Es = erl_syntax:block_expr_body(Tree), {Es1, {Bound, Free}} = vann_body(Es, Env), diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index 0ed660121fae..0755b03eac95 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -333,8 +333,12 @@ t_erl_parse_type(Config) when is_list(Config) -> {"M#{ a=>1, b=>2 }", map_expr,false}, {"[V||V <- Vs]", list_comp,false}, {"[catch V||V <- Vs]", list_comp,false}, - {"<< <> || <> <= Bs>>", binary_comp,false}, + {"[V+W||V <- Vs && W <- Ws]", list_comp,false}, + {"[catch V+W||V <- Vs && W <- Ws]", list_comp,false}, + {"<< <> || <> <= Bs>>", binary_comp,false}, {"<< (catch <>) || <> <= Bs>>", binary_comp,false}, + {"<< <> || <> <= Bs && <> <= Cs>>", binary_comp,false}, + {"<< (catch <>) || <> <= Bs && <> <= Cs>>", binary_comp,false}, {"#state{ a = A, b = B}", record_expr,false}, {"#state{}", record_expr,false}, {"#s{ a = #def{ a=A }, b = B}", record_expr,false}, diff --git a/lib/syntax_tools/test/syntax_tools_SUITE_data/syntax_tools_SUITE_test_module.erl b/lib/syntax_tools/test/syntax_tools_SUITE_data/syntax_tools_SUITE_test_module.erl index daa95b6a259e..386e79ad8863 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE_data/syntax_tools_SUITE_test_module.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE_data/syntax_tools_SUITE_test_module.erl @@ -590,3 +590,10 @@ eep58() -> MapDouble = maps:from_list([{{key,I}, 2 * I} || I <- Seq]), ok. + +%% EEP-73: Zip generators. +eep73() -> + [{X,Y}||X <- [1,2,3] && Y <- [2,2,2]], + [{X,Y}||X <- [1,2,3] && <> <= <<2,2,2>>], + [{K1,K2,V1,V2}|| K1 := V1 <- #{a=>1} && K2 := V2 <- #{b=>3}], + ok. \ No newline at end of file diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 0d8af99dc5f2..3cf156fcf502 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -1186,7 +1186,7 @@ behaviour.") (defvar erlang-font-lock-keywords-lc (list - (list "\\(<-\\|<=\\|||\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face)) + (list "\\(<-\\|<=\\|||\\|&&\\)\\(\\s \\|$\\)" 1 'font-lock-keyword-face)) "Font lock keyword highlighting list comprehension operators.") (defvar erlang-font-lock-keywords-keywords @@ -1513,7 +1513,7 @@ Other commands: )) (add-to-list 'align-rules-list `(erlang-generator-arrows - (regexp . ,(concat space-group "\\(<-\\|<=\\)" space-group)) + (regexp . ,(concat space-group "\\(<-\\|<=\\|&&\\)" space-group)) (group . (1 3)) (separate . ,(concat "\\(||\\|" erl-sep-forms "\\|" erl-sep-symbols "\\)")) (repeat . t)