diff --git a/erts/doc/guides/absform.md b/erts/doc/guides/absform.md index 6f15630dd98b..716dd132ebf5 100644 --- a/erts/doc/guides/absform.md +++ b/erts/doc/guides/absform.md @@ -294,11 +294,18 @@ 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 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 list generator `P <:- E`, where `P` is a pattern and `E` is an + expression, then Rep(Q) = `{generate_strict,ANNO,Rep(P),Rep(E)}`. - If Q is a bitstring generator `P <= E`, where `P` is a pattern and `E` is an expression, then Rep(Q) = `{b_generate,ANNO,Rep(P),Rep(E)}`. +- If Q is a bitstring generator `P <:= E`, where `P` is a pattern and `E` is an + expression, then Rep(Q) = `{b_generate_strict,ANNO,Rep(P),Rep(E)}`. - If Q is a map generator `P <- E`, where `P` is an association pattern `P_1 := P_2` and `E` is an expression, then Rep(Q) = `{m_generate,ANNO,Rep(P),Rep(E)}`. For Rep(P), see below. +- If Q is a map generator `P <:- E`, where `P` is an association pattern + `P_1 := P_2` and `E` is an expression, then Rep(Q) = + `{m_generate_strict,ANNO,Rep(P),Rep(E)}`. ### Bitstring Element Type Specifiers diff --git a/lib/compiler/src/sys_coverage.erl b/lib/compiler/src/sys_coverage.erl index 2c0539a37c34..9ad989930424 100644 --- a/lib/compiler/src/sys_coverage.erl +++ b/lib/compiler/src/sys_coverage.erl @@ -553,14 +553,26 @@ munge_qs([{generate,Anno,Pattern,Expr}|Qs], Vars0, MQs) -> A = element(2, Expr), {MungedExpr, Vars1} = munge_expr(Expr, Vars0), munge_qs1(Qs, A, {generate,Anno,Pattern,MungedExpr}, Vars0, Vars1, MQs); +munge_qs([{generate_strict,Anno,Pattern,Expr}|Qs], Vars0, MQs) -> + A = element(2, Expr), + {MungedExpr, Vars1} = munge_expr(Expr, Vars0), + munge_qs1(Qs, A, {generate_strict,Anno,Pattern,MungedExpr}, Vars0, Vars1, MQs); munge_qs([{b_generate,Anno,Pattern,Expr}|Qs], Vars0, MQs) -> A = element(2, Expr), {MExpr, Vars1} = munge_expr(Expr, Vars0), munge_qs1(Qs, A, {b_generate,Anno,Pattern,MExpr}, Vars0, Vars1, MQs); +munge_qs([{b_generate_strict,Anno,Pattern,Expr}|Qs], Vars0, MQs) -> + A = element(2, Expr), + {MExpr, Vars1} = munge_expr(Expr, Vars0), + munge_qs1(Qs, A, {b_generate_strict,Anno,Pattern,MExpr}, Vars0, Vars1, MQs); 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([{m_generate_strict,Anno,Pattern,Expr}|Qs], Vars0, MQs) -> + A = element(2, Expr), + {MExpr, Vars1} = munge_expr(Expr, Vars0), + munge_qs1(Qs, A, {m_generate_strict,Anno,Pattern,MExpr}, 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..58eb36f8692a 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -64,7 +64,7 @@ %% atom 'compiler_generated', to indicate that the compiler has generated %% them and that no warning should be generated if they are optimized %% away. -%% +%% %% %% In this translation: %% @@ -121,7 +121,8 @@ -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, + nomatch_pat,nomatch_guard,nomatch_mode, + tail,tail_pat,arg, refill={nomatch,ignore}}). -record(isimple, {anno=#a{},term :: cerl:cerl()}). @@ -343,7 +344,7 @@ guard(Gs0, St0) -> end, guard_tests(last(Gs0)), droplast(Gs0)), {Gs,St} = gexpr_top(Gs1, St0#core{in_guard=true}), {Gs,St#core{in_guard=false}}. - + guard_tests(Gs) -> L = element(2, hd(Gs)), {protect,L,foldr(fun (G, Rhs) -> {op,L,'and',G,Rhs} end, last(Gs), droplast(Gs))}. @@ -1515,7 +1516,7 @@ constant_bin_1(Es) -> end. %% verify_suitable_fields([{bin_element,_,Sz,Opts}=E|Es]) -> - + verify_suitable_fields([{bin_element,_,Val,SzTerm,Opts}|Es]) -> case member(big, Opts) orelse member(little, Opts) of true -> ok; @@ -1603,22 +1604,39 @@ fun_tq(Cs0, L, St0, NameInfo) -> lc_tq(Line, E, [#igen{anno=#a{anno=GA}=GAnno, acc_pat=AccPat,acc_guard=AccGuard, - skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, + nomatch_pat=NomatchPat, + nomatch_guard=NomatchGuard, + nomatch_mode=NomatchMode, + tail=Tail,tail_pat=TailPat, refill={RefillPat,RefillAction}, arg={Pre,Arg}}|Qs], Mc, St0) -> {Name,St1} = new_fun_name("lc", St0), LA = lineno_anno(Line, St1), F = #c_var{anno=LA,name={Name,1}}, - Nc = #iapply{anno=GAnno,op=F,args=[Tail]}, + Sc = #iapply{anno=GAnno,op=F,args=[Tail]}, + Nc = case NomatchMode of + skip -> + Sc; + BM -> + #icall{anno=GAnno, + module=#c_literal{anno=GA,val=erlang}, + name=#c_literal{anno=GA,val=error}, + args=[ann_c_tuple(GA, [#c_literal{val=badmatch},BM])]} + end, {[FcVar,Var],St2} = new_vars(2, St1), Fc = bad_generator([FcVar], FcVar, Arg), - SkipClause = make_clause([skip_clause,compiler_generated|LA], - SkipPat, [], [], [Nc]), + NomatchClause = make_clause([nomatch_clause,compiler_generated|LA], + NomatchPat, [], NomatchGuard, [Nc]), TailClause = make_clause(LA, TailPat, [], [], [Mc]), - {Lc,Lps,St3} = lc_tq(Line, E, Qs, Nc, St2), + {Lc,Lps,St3} = lc_tq(Line, E, Qs, Sc, St2), AccClause = make_clause(LA, AccPat, [], AccGuard, Lps ++ [Lc]), - RefillClause = make_clause(LA, RefillPat, [], [], [RefillAction,Nc]), - Cs0 = [AccClause,SkipClause,TailClause,RefillClause], + AccClauseNoGuards = if AccGuard =:= [] -> nomatch; + NomatchMode =:= skip -> nomatch; + true -> make_clause([compiler_generated|LA], + AccPat, [], [], [Sc]) + end, + RefillClause = make_clause(LA, RefillPat, [], [], [RefillAction,Sc]), + Cs0 = [AccClause,AccClauseNoGuards,NomatchClause,TailClause,RefillClause], Cs = [C || C <- Cs0, C =/= nomatch], Fun = #ifun{anno=GAnno,id=[],vars=[Var],clauses=Cs,fc=Fc}, {#iletrec{anno=GAnno#a{anno=[list_comprehension|GA]},defs=[{{Name,1},Fun}], @@ -1634,7 +1652,7 @@ lc_tq(Line, E0, [], Mc0, St0) -> {set_anno(E, [compiler_generated|Anno]),Hps ++ Tps,St}. %% bc_tq(Line, Exp, [Qualifier], More, State) -> {LetRec,[PreExp],State}. -%% This TQ from Gustafsson ERLANG'05. +%% This TQ from Gustafsson ERLANG'05. %% More could be transformed before calling bc_tq. bc_tq(Line, Exp, Qs0, St0) -> @@ -1655,9 +1673,12 @@ bc_tq(Line, Exp, Qs0, St0) -> args=[InitialSize]}}] ++ BcPre, {E,Pre,St}. -bc_tq1(Line, E, [#igen{anno=GAnno, +bc_tq1(Line, E, [#igen{anno=#a{anno=GA}=GAnno, acc_pat=AccPat,acc_guard=AccGuard, - skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, + nomatch_pat=NomatchPat, + nomatch_guard=NomatchGuard, + nomatch_mode=NomatchMode, + tail=Tail,tail_pat=TailPat, refill={RefillPat,RefillAction}, arg={Pre,Arg}}|Qs], Mc, St0) -> {Name,St1} = new_fun_name("lbc", St0), @@ -1667,16 +1688,30 @@ bc_tq1(Line, E, [#igen{anno=GAnno, {[_,_]=FcVars,St3} = new_vars(LA, 2, St2), {IgnoreVar,St4} = new_var(LA, St3), F = #c_var{anno=LA,name={Name,2}}, - Nc = #iapply{anno=GAnno,op=F,args=[Tail,AccVar]}, + Sc = #iapply{anno=GAnno,op=F,args=[Tail,AccVar]}, + Nc = case NomatchMode of + skip -> + Sc; + BM -> + #icall{anno=GAnno, + module=#c_literal{anno=GA,val=erlang}, + name=#c_literal{anno=GA,val=error}, + args=[ann_c_tuple(GA, [#c_literal{val=badmatch},BM])]} + end, Fc = bad_generator(FcVars, hd(FcVars), Arg), - SkipClause = make_clause([compiler_generated,skip_clause|LA], - SkipPat, [IgnoreVar], [], [Nc]), + NomatchClause = make_clause([compiler_generated,nomatch_clause|LA], + NomatchPat, [IgnoreVar], NomatchGuard, [Nc]), TailClause = make_clause(LA, TailPat, [IgnoreVar], [], [AccVar]), {Bc,Bps,St5} = bc_tq1(Line, E, Qs, AccVar, St4), - Body = Bps ++ [#iset{var=AccVar,arg=Bc},Nc], + Body = Bps ++ [#iset{var=AccVar,arg=Bc},Sc], AccClause = make_clause(LA, AccPat, [IgnoreVar], AccGuard, Body), - RefillClause = make_clause(LA, RefillPat, [AccVar], [], [RefillAction,Nc]), - Cs0 = [AccClause,SkipClause,TailClause,RefillClause], + AccClauseNoGuards = if AccGuard =:= [] -> nomatch; + NomatchMode =:= skip -> nomatch; + true -> make_clause([compiler_generated|LA], + AccPat, [IgnoreVar], [], [Sc]) + end, + RefillClause = make_clause(LA, RefillPat, [AccVar], [], [RefillAction,Sc]), + Cs0 = [AccClause,AccClauseNoGuards,NomatchClause,TailClause,RefillClause], Cs = [C || C <- Cs0, C =/= nomatch], Fun = #ifun{anno=GAnno,id=[],vars=Vars,clauses=Cs,fc=Fc}, @@ -1811,8 +1846,11 @@ preprocess_quals(_, [], St, Acc) -> {reverse(Acc),St}. is_generator({generate,_,_,_}) -> true; +is_generator({generate_strict,_,_,_}) -> true; is_generator({b_generate,_,_,_}) -> true; +is_generator({b_generate_strict,_,_,_}) -> true; is_generator({m_generate,_,_,_}) -> true; +is_generator({m_generate_strict,_,_,_}) -> true; is_generator(_) -> false. %% Retrieve the annotation from an Erlang AST form. @@ -1825,10 +1863,15 @@ get_qual_anno(Abstract) -> element(2, Abstract). %% - acc_pat is the accumulator pattern, e.g. [Pat|Tail] for Pat <- Expr. %% - acc_guard is the list of guards immediately following the current %% generator in the qualifier list input. -%% - skip_pat is the skip pattern, e.g. <> for -%% <> <= Expr. -%% - tail is the variable used in AccPat and SkipPat bound to the rest of the -%% generator input. +%% - nomatch_pat is the no-match pattern, e.g. <> +%% for <> <= Expr. +%% - nomatch_guard is the list of guards to add to the no-match clause. +%% - nomatch_mode is either skip (not matching elements of the relaxed +%% generator have to be silently skipped by the comprehension) or a +%% value X (to be used in the {badmatch, X} error a strict generator +%% shall raise). +%% - tail is the variable used in AccPat and NomatchPat bound to the +%% rest of the generator input. %% - tail_pat is the tail pattern, respectively [] and <<_/bitstring>> for list %% and bit string generators. %% - refill is a pair {RefillPat,RefillAction}, used to refill the iterator @@ -1841,11 +1884,12 @@ get_qual_anno(Abstract) -> element(2, Abstract). %% generator(Line, Generator, Guard, State) -> {Generator',State}. %% Transform a given generator into its #igen{} representation. -generator(Line, {generate,Lg,P0,E}, Gs, St0) -> +generator(Line, {Generate,Lg,P0,E}, Gs, St0) when Generate =:= generate; + Generate =:= generate_strict -> LA = lineno_anno(Line, St0), GA = lineno_anno(Lg, St0), {Head,St1} = list_gen_pattern(P0, Line, St0), - {[Tail,Skip],St2} = new_vars(2, St1), + {[Tail,Nomatch],St2} = new_vars(2, St1), {Cg,St3} = lc_guard_tests(Gs, St2), AccPat = case Head of nomatch -> @@ -1853,17 +1897,56 @@ generator(Line, {generate,Lg,P0,E}, Gs, St0) -> _ -> ann_c_cons(LA, Head, Tail) end, - SkipPat = ann_c_cons(LA, Skip, Tail), + NomatchPat = ann_c_cons(LA, Nomatch, Tail), + NomatchMode = case Generate of + generate -> + skip; + generate_strict -> + Nomatch + end, {Ce,Pre,St4} = safe(E, St3), - Gen = #igen{anno=#a{anno=GA}, - acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, + Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg, + nomatch_pat=NomatchPat,nomatch_guard=[],nomatch_mode=NomatchMode, tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Pre,Ce}}, {Gen,St4}; -generator(Line, {b_generate,Lg,P,E}, Gs, St0) -> +generator(Line, {Generate,Lg,P,E}, Gs, St0) when Generate =:= b_generate; + Generate =:= b_generate_strict -> LA = lineno_anno(Line, St0), GA = lineno_anno(Lg, St0), + GAnno = #a{anno=GA}, + %% No-match patterns are very different between relaxed and strict + %% generators. Consider a relaxed generator like + %% <<0:1, X:15>> <= Expr. If the pattern doesn't match the beginning + %% of the bitstring Expr evaluates to, the non-matching part has to + %% be skipped. But, unlike in case of list or map generators, + %% bitstrings don't have a natural "first element" that can be + %% skipped (would it be 1 byte? or 1 bit?), so how many bits to + %% skip? + %% + %% In this example the pattern is always 16 bits long, so we will + %% skip 16 bits, unless the remaining bitstring is less than 16 bits + %% long, in which case no more elements are generated. + %% + %% However, patterns can be variable length too, like + %% <<0:1, X:15, Y:X>>. In this case we geenerate a skip pattern that + %% still attempts to parse the field lengths: + %% <<_:1, X:16, _:X, Tail/bitstring>>. If it matches, we can + %% continue the generator on the tail, otherwise we can stop. + %% + %% But for a strict generator there are only three possible + %% scenarios to consider depending on what kind of bitstring Expr + %% evaluates to: + %% - In case of an empty binary, we can stop. + %% - If the pattern matches the beginning of the bitstring, we can + %% continue. + %% - Otherwise the generator must fail. + %% + %% This means the skip pattern could be "any non-empty bitstring": + %% <<_:1, _/bitstring>>. However, to simplify raising the badmatch + %% exception, the code will instead use a variable for the pattern + %% and add the non-empty bitstring constraint as a guard. try pattern(P, St0) of - {#ibinary{segments=Segs}=Cp,St1} -> + {#ibinary{segments=Segs}=Cp,St1} when Generate =:= b_generate -> %% The function append_tail_segment/2 keeps variable %% patterns as-is, making it possible to have the same %% skip clause removal as with list generators. @@ -1871,26 +1954,64 @@ generator(Line, {b_generate,Lg,P,E}, Gs, St0) -> AccPat = Cp#ibinary{segments=AccSegs}, {Cg,St3} = lc_guard_tests(Gs, St2), {SkipSegs,St4} = skip_segments(AccSegs, St3, []), - SkipPat = Cp#ibinary{segments=SkipSegs}, + NomatchPat = Cp#ibinary{segments=SkipSegs}, {Ce,Pre,St5} = safe(E, St4), - Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg, - skip_pat=SkipPat,tail=Tail, - tail_pat=#ibinary{anno=#a{anno=LA},segments=[TailSeg]}, + Gen = #igen{anno=GAnno,acc_pat=AccPat,acc_guard=Cg, + nomatch_pat=NomatchPat,nomatch_guard=[],nomatch_mode=skip, + tail=Tail,tail_pat=#ibinary{anno=#a{anno=LA},segments=[TailSeg]}, + arg={Pre,Ce}}, + {Gen,St5}; + {#ibinary{segments=Segs}=Cp,St1} when Generate =:= b_generate_strict -> + {AccSegs,Tail,TailSeg,St2} = append_tail_segment(Segs, St1), + AccPat = Cp#ibinary{segments=AccSegs}, + {Cg,St3} = lc_guard_tests(Gs, St2), + {[BitStr,BitSize],St4} = new_vars(2, St3), + %% The non-empty bistring guard could be implemented either + %% as + %% + %% bit_size(BitStr) > 0 + %% + %% or as + %% + %% is_bitstring(BitStr), BitStr =/= <<>> + %% + %% However, in the second case the compiler incorrectly + %% decides the is_bitstring/1 call had no effect and optimises + %% it away. So we stick to the first option instead. + BitSizeCall = #icall{anno=GAnno, + module=#c_literal{anno=GA,val=erlang}, + name=#c_literal{anno=GA,val=bit_size}, + args=[BitStr]}, + CompCall = #icall{anno=GAnno, + module=#c_literal{anno=GA,val=erlang}, + name=#c_literal{anno=GA,val='>'}, + args=[BitSize,#c_literal{anno=GA,val=0}]}, + Guard = #iprotect{anno=GAnno, + body=[#iset{anno=GAnno,var=BitSize,arg=BitSizeCall}, + CompCall]}, + {Ce,Pre,St5} = safe(E, St4), + Gen = #igen{anno=GAnno,acc_pat=AccPat,acc_guard=Cg, + nomatch_pat=BitStr, + nomatch_guard=[Guard], + nomatch_mode=BitStr, + tail=Tail,tail_pat=#ibinary{anno=#a{anno=LA},segments=[TailSeg]}, arg={Pre,Ce}}, {Gen,St5} catch throw:nomatch -> {Ce,Pre,St1} = safe(E, St0), Gen = #igen{anno=#a{anno=GA},acc_pat=nomatch,acc_guard=[], - skip_pat=nomatch, + nomatch_pat=nomatch,nomatch_guard=[],nomatch_mode=skip, tail_pat=#c_var{name='_'}, arg={Pre,Ce}}, {Gen,St1} end; -generator(Line, {m_generate,Lg,{map_field_exact,_,K0,V0},E}, Gs, St0) -> +generator(Line, {Generate,Lg,{map_field_exact,_,K0,V0},E}, Gs, St0) when + Generate =:= m_generate; + Generate =:= m_generate_strict -> %% Consider this example: %% - %% [{K,V} || K := V <- L]. + %% [{K,V} || K := V <:- L, is_integer(K)]. %% %% The following Core Erlang code will be generated: %% @@ -1898,14 +2019,20 @@ generator(Line, {m_generate,Lg,{map_field_exact,_,K0,V0},E}, Gs, St0) -> %% 'lc$^0'/1 = %% fun (Iter0) -> %% case Iter0 of - %% <{K,V,NextIter}> when 'true' -> + %% <{K,V,NextIter}> when call 'erlang':'is_integer' (K) -> %% let = %% apply 'lc$^0'/1(NextIter) %% in [{K,V}|Tail] %% <{_K,_V,NextIter}> when 'true' -> - %% %% Skip clause; will be optimized away later - %% %% since there are no filters. + %% %% Match clause without guards; this is always + %% %% a skip, even for strict generators + %% %% (since the generator does match in this case, + %% %% the skip happens due to the subsequent guard). %% apply 'lc$^0'/1(NextIter) + %% <{K,V,_NextIter}> when 'true' -> + %% %% Nomatch clause; will be optimized away later + %% %% since the left hand side pattern always matches. + %% call 'erlang':'error'({'badmatch',{K,V}}) %% <'none'> when 'true' -> %% [] %% when 'true' -> @@ -1929,7 +2056,7 @@ generator(Line, {m_generate,Lg,{map_field_exact,_,K0,V0},E}, Gs, St0) -> LA = lineno_anno(Line, St0), GA = lineno_anno(Lg, St0), {Pat,St1} = list_gen_pattern({cons,Lg,K0,V0}, Line, St0), - {[SkipK,SkipV,IterVar,OuterIterVar,_BadGenVar],St2} = new_vars(5, St1), + {[NomatchK,NomatchV,IterVar,OuterIterVar,_BadGenVar],St2} = new_vars(5, St1), {Cg,St3} = lc_guard_tests(Gs, St2), {Ce,Pre0,St4} = safe(E, St3), AccPat = case Pat of @@ -1940,14 +2067,19 @@ generator(Line, {m_generate,Lg,{map_field_exact,_,K0,V0},E}, Gs, St0) -> V = cons_tl(Pat), #c_tuple{es=[K,V,IterVar]} end, - SkipPat = #c_tuple{es=[SkipK,SkipV,IterVar]}, - - Refill = {SkipK, + NomatchPat = #c_tuple{es=[NomatchK,NomatchV,IterVar]}, + NomatchMode = case Generate of + m_generate -> + skip; + m_generate_strict -> + #c_tuple{es=[NomatchK,NomatchV]} + end, + Refill = {NomatchK, #iset{var=IterVar, arg=#icall{anno=#a{anno=GA}, module=#c_literal{val=erts_internal}, name=#c_literal{val=mc_refill}, - args=[SkipK]}}}, + args=[NomatchK]}}}, InitIter = #icall{anno=#a{anno=GA}, module=#c_literal{val=erts_internal}, @@ -1967,7 +2099,10 @@ generator(Line, {m_generate,Lg,{map_field_exact,_,K0,V0},E}, Gs, St0) -> Pre = Pre0 ++ [Before], Gen = #igen{anno=#a{anno=GA}, - acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, + acc_pat=AccPat,acc_guard=Cg, + nomatch_pat=NomatchPat, + nomatch_guard=[], + nomatch_mode=NomatchMode, tail=IterVar,tail_pat=#c_literal{anno=LA,val=none}, refill=Refill, arg={Pre,OuterIterVar}}, @@ -2656,16 +2791,16 @@ uclause(Cl0, Ks, St0) -> do_uclause(#iclause{anno=A0,pats=Ps0,guard=G0,body=B0}, Ks0, St0) -> {Ps1,Pg0,Pvs,Pus,St1} = upattern_list(Ps0, Ks0, St0), Anno = A0#a.anno, - {Pg,A} = case member(skip_clause, Anno) of + {Pg,A} = case member(nomatch_clause, Anno) of true -> - %% This is the skip clause for a binary generator. + %% This is the no-match clause for a binary generator. %% To ensure that it will properly skip the nonmatching %% patterns in generators such as: %% %% <> <= Gen %% %% we must remove any generated pre guard. - {[],A0#a{anno=Anno -- [skip_clause]}}; + {[],A0#a{anno=Anno -- [nomatch_clause]}}; false -> {Pg0,A0} end, @@ -2993,7 +3128,7 @@ upattern_list([P0|Ps0], Ks, St0) -> {P1,Pg,Pv,Pu,St1} = upattern(P0, Ks, St0), {Ps1,Psg,Psv,Psu,St2} = upattern_list(Ps0, known_union(Ks, Pv), St1), {[P1|Ps1],Pg ++ Psg,union(Pv, Psv),union(Pu, Psu),St2}; -upattern_list([], _, St) -> {[],[],[],[],St}. +upattern_list([], _, St) -> {[],[],[],[],St}. %% upat_bin([Pat], [KnownVar], State) -> %% {[Pat],[GuardTest],[NewVar],[UsedVar],State}. @@ -3020,7 +3155,7 @@ upat_bin([P0|Ps0], Ks, Bs, St0) -> {P1,Pg,Pv,Pu,Bs1,St1} = upat_element(P0, Ks, Bs, St0), {Ps1,Psg,Psv,Psu,St2} = upat_bin(Ps0, known_union(Ks, Pv), Bs1, St1), {[P1|Ps1],Pg ++ Psg,union(Pv, Psv),union(Pu, Psu),St2}; -upat_bin([], _, _, St) -> {[],[],[],[],St}. +upat_bin([], _, _, St) -> {[],[],[],[],St}. %% upat_element(Segment, [KnownVar], [LocalVar], State) -> @@ -4024,7 +4159,7 @@ lit_vars(#c_cons{hd=H,tl=T}, Vs) -> lit_vars(H, lit_vars(T, Vs)); lit_vars(#c_tuple{es=Es}, Vs) -> lit_list_vars(Es, Vs); lit_vars(#c_map{arg=V,es=Es}, Vs) -> lit_vars(V, lit_list_vars(Es, Vs)); lit_vars(#c_map_pair{key=K,val=V}, Vs) -> lit_vars(K, lit_vars(V, Vs)); -lit_vars(#c_var{name=V}, Vs) -> add_element(V, Vs); +lit_vars(#c_var{name=V}, Vs) -> add_element(V, Vs); lit_vars(_, Vs) -> Vs. %These are atomic lit_list_vars(Ls) -> lit_list_vars(Ls, []). diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 2fb46dba279c..9ad903f0a243 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -278,7 +278,7 @@ docs: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl index d97209e2820d..f17d6aa55da0 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_SUITE.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 2006-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 @@ -14,7 +14,7 @@ %% 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% %% %% Originally based on Per Gustafsson's test suite. @@ -22,14 +22,14 @@ -module(bs_bincomp_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, verify_highest_opcode/1, byte_aligned/1,bit_aligned/1,extended_byte_aligned/1, extended_bit_aligned/1,mixed/1,filters/1,trim_coverage/1, nomatch/1,sizes/1,general_expressions/1, no_generator/1,zero_pattern/1,multiple_segments/1, - grab_bag/1]). + grab_bag/1, strict_generators/1]). -include_lib("common_test/include/ct.hrl"). @@ -41,7 +41,7 @@ all() -> extended_bit_aligned, mixed, filters, trim_coverage, nomatch, sizes, general_expressions, no_generator, zero_pattern, multiple_segments, - grab_bag]. + grab_bag, strict_generators]. groups() -> []. @@ -322,7 +322,7 @@ trim_coverage(Config) when is_list(Config) -> <<0,0,0,2,0,0,5,48,0,11,219,174,0,0,0,0>> = coverage_materialiv(a, b, {1328,777134}), <<67,40,0,0,66,152,0,0,69,66,64,0>> = coverage_trimmer([42,19,777]), <<0,0,2,43,0,0,3,9,0,0,0,3,64,8,0,0,0,0,0,0, - 64,68,0,0,0,0,0,0,192,171,198,0,0,0,0,0>> = + 64,68,0,0,0,0,0,0,192,171,198,0,0,0,0,0>> = coverage_lightfv(555, 777, {3.0,40.0,-3555.0}), <<"abcabc">> = coverage_strange(0, <<"abc">>), ok. @@ -680,6 +680,28 @@ grab_bag_gh_8617(Bin) -> [0 || <<_:0, _:(tuple_size({self()}))>> <= Bin, is_pid(id(self()))]. +strict_generators(_Config) -> + %% Basic strict generators (each generator type) + <<2,3,4>> = << <<(X+1)>> || X <:- [1,2,3]>>, + <<2,3,4>> = << <<(X+1)>> || <> <:= <<1,2,3>> >>, + <<2,12>> = << <<(X*Y)>> || X := Y <:- #{1 => 2, 3 => 4} >>, + + %% A failing guard following a strict generator is ok + <<3,4>> = << <<(X+1)>> || X <:- [1,2,3], X > 1>>, + <<3,4>> = << <<(X+1)>> || <> <:= <<1,2,3>>, X > 1 >>, + <<12>> = << <<(X*Y)>> || X := Y <:- #{1 => 2, 3 => 4}, X > 1 >>, + + %% Non-matching elements cause a badmatch error for strict generators + {'EXIT',{{badmatch,2},_}} = (catch << <> || {ok, X} <:- [{ok,1},2,{ok,3}] >>), + {'EXIT',{{badmatch,<<128,2>>},_}} = (catch << <> || <<0:1, X:7>> <:= <<1,128,2>> >>), + {'EXIT',{{badmatch,{2,error}},_}} = (catch << <> || X := ok <:- #{1 => ok, 2 => error, 3 => ok} >>), + + %% Extra bits cannot be skipped at the end of the binary either + {'EXIT',{{badmatch,<<0:2>>},_}} = (catch [X || <> <:= <<0>>]), + {'EXIT',{{badmatch,<<9,2>>},_}} = (catch [Y || <> <:= <<8,1,9,2>>]), + + ok. + cs_init() -> erts_debug:set_internal_state(available_internal_state, true), ok. @@ -717,7 +739,7 @@ cs(Bin) -> %% Verify that the allocated size of the binary is the default size. cs_default(Bin) -> ByteSize = byte_size(Bin), - {refc_binary,ByteSize,{binary,256},_} = + {refc_binary,ByteSize,{binary,256},_} = erts_debug:get_internal_state({binary_info,Bin}), Bin. diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index 5de383f92800..ea7232856e69 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -101,6 +101,16 @@ basic(Config) when is_list(Config) -> %% Not matching. [] = [3 || {3=4} <- []], + %% Strict generators (each generator type) + [2,3,4] = [X+1 || X <:- [1,2,3]], + [2,3,4] = [X+1 || <> <:= <<1,2,3>>], + [2,12] = [X*Y || X := Y <:- #{1 => 2, 3 => 4}], + + %% A failing guard following a strict generator is ok + [3,4] = [X+1 || X <:- [1,2,3], X > 1], + [3,4] = [X+1 || <> <:= <<1,2,3>>, X > 1], + [12] = [X*Y || X := Y <:- #{1 => 2, 3 => 4}, X > 1], + %% Error cases. [] = [{xx,X} || X <- L0, element(2, X) == no_no_no], {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]), @@ -109,6 +119,11 @@ basic(Config) when is_list(Config) -> {'EXIT',{{bad_generator,x},_}} = (catch [E || E <- id(x)]), {'EXIT',{{bad_filter,not_bool},_}} = (catch [E || E <- [1,2], id(not_bool)]), + %% Non-matching elements cause a badmatch error for strict generators + {'EXIT',{{badmatch,2},_}} = (catch [X || {ok, X} <:- [{ok,1},2,{ok,3}]]), + {'EXIT',{{badmatch,<<128,2>>},_}} = (catch [X || <<0:1, X:7>> <:= <<1,128,2>>]), + {'EXIT',{{badmatch,{2,error}},_}} = (catch [X || X := ok <:- #{1 => ok, 2 => error, 3 => ok}]), + %% Make sure that line numbers point out the generator. case ?MODULE of lc_inline_SUITE -> @@ -173,7 +188,7 @@ no_generator(Config) when is_list(Config) -> [a,b,c] = [a || true] ++ [b,c], ok. -no_gen(A, B) -> +no_gen(A, B) -> [{A,B} || A+B =:= 0] ++ [{A,B} || A*B =:= 0] ++ [{A,B} || A rem B =:= 3] ++ diff --git a/lib/compiler/test/mc_SUITE.erl b/lib/compiler/test/mc_SUITE.erl index 9f2628255723..296e8e51723f 100644 --- a/lib/compiler/test/mc_SUITE.erl +++ b/lib/compiler/test/mc_SUITE.erl @@ -122,6 +122,21 @@ basic(_Config) -> N rem 2 =:= 1]), Odd = lists:sort([V || #foo{a=N} := V <- RecordMap, N rem 2 =:= 1]), + %% Strict generators (each generator type) + #{1 := 2, 2 := 3, 3 := 4} = #{X => X+1 || X <:- [1,2,3]}, + #{1 := 2, 2 := 3, 3 := 4} = #{X => X+1 || <> <:= <<1,2,3>>}, + #{2 := 4, 4 := 8} = #{X+1 => Y*2 || X := Y <:- #{1 => 2, 3 => 4}}, + + %% A failing guard following a strict generator is ok + #{2 := 3, 3 := 4} = #{X => X+1 || X <:- [1,2,3], X > 1}, + #{2 := 3, 3 := 4} = #{X => X+1 || <> <:= <<1,2,3>>, X > 1}, + #{4 := 8} = #{X+1 => Y*2 || X := Y <:- #{1 => 2, 3 => 4}, X > 1}, + + %% Non-matching elements cause a badmatch error for strict generators + {'EXIT',{{badmatch,2},_}} = (catch #{X => X+1 || {ok, X} <:- [{ok,1},2,{ok,3}]}), + {'EXIT',{{badmatch,<<128,2>>},_}} = (catch #{X => X+1 || <<0:1, X:7>> <:= <<1,128,2>>}), + {'EXIT',{{badmatch,{2,error}},_}} = (catch #{X => X+1 || X := ok <:-#{1 => ok, 2 => error, 3 => ok}}), + ok. mc_double(Size) -> diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 60a3dc85c8a5..21fd1b027bb9 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 1998-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 @@ -14,7 +14,7 @@ %% 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(dbg_ieval). @@ -69,7 +69,7 @@ exit_info(Int, AttPid, OrigPid, Reason, ExitInfo) -> put(breakpoints, dbg_iserver:call(Int, all_breaks)), put(self, OrigPid), put(exit_info, ExitInfo), - + case ExitInfo of {{Mod,Line},Bs,S} -> dbg_istk:from_external(S), @@ -216,7 +216,7 @@ meta(Int, Debugged, M, F, As) -> {M, F, As} end, Status = dbg_iserver:call(Int, {new_process,Debugged,self(),Pargs}), - + %% Initiate process dictionary put(int, Int), % pid() dbg_iserver put(attached, undefined),% pid() attached process @@ -283,7 +283,7 @@ meta_loop(Debugged, Bs, #ieval{level=Le} = Ieval) -> dbg_istk:init(), put(stacktrace, []), put(exit_info, undefined), - + dbg_iserver:cast(get(int), {set_status,self(),running,{}}), dbg_icmd:tell_attached(running), @@ -357,7 +357,7 @@ format_trace(What, Args, P) -> call -> {Called, {Le,Li,M,F,As}} = Args, case Called of - extern -> + extern -> io_lib:format("++ (~w) <~w> ~w:~tw~ts~n", [Le,Li,M,F,format_args(As, P)]); local -> @@ -404,7 +404,7 @@ catch_value(throw, Reason) -> %%--Code interpretation----------------------------------------------- %%-------------------------------------------------------------------- -%% Top level function of meta evaluator. +%% Top level function of meta evaluator. %% Return message to be replied to the target process. %%-------------------------------------------------------------------- eval_mfa(Debugged, M, F, As, #ieval{level=Le}=Ieval0) -> @@ -483,11 +483,11 @@ do_eval_function(Mod, Name, As0, Bs0, Called, Ieval0) -> lambda(eval_fun, [Cs,As,Bs,{Mod,Name}=F]) -> %% Fun defined in interpreted code, called from outside - if + if length(element(3,hd(Cs))) =:= length(As) -> db_ref(Mod), %% Adds ref between module and process {Cs,Mod,Name,As,Bs}; - true -> + true -> {error,{badarity,{F,As}}} end; lambda(eval_named_fun, [Cs,As,Bs0,FName,RF,{Mod,Name}=F]) -> @@ -514,7 +514,7 @@ lambda(Fun, As) when is_function(Fun) -> {M,F,add_binding(FName, Fun, Bs0), Cs0} end, {arity, Arity} = erlang:fun_info(Fun, arity), - if + if length(As) =:= Arity -> db_ref(Mod), %% Adds ref between module and process {Cs,Mod,Name,As,Bs}; @@ -586,7 +586,7 @@ db_ref(Mod) -> cache(Key, Data) -> put(cache, lists:sublist([{Key,Data}|get(cache)], 5)). - + cached(Key) -> case lists:keyfind(Key, 1, get(cache)) of {Key,Data} -> Data; @@ -806,7 +806,7 @@ expr({maybe_match,Line,Lhs,Rhs0}, Bs0, Ieval0) -> expr({make_fun,Line,Name,Cs}, Bs, #ieval{module=Module}=Ieval) -> Arity = length(element(3,hd(Cs))), Info = {{Module,Name},Bs,Cs}, - Fun = + Fun = case Arity of 0 -> fun() -> eval_fun([], Info) end; 1 -> fun(A) -> eval_fun([A], Info) end; @@ -815,33 +815,33 @@ expr({make_fun,Line,Name,Cs}, Bs, #ieval{module=Module}=Ieval) -> 4 -> fun(A,B,C,D) -> eval_fun([A,B,C,D], Info) end; 5 -> fun(A,B,C,D,E) -> eval_fun([A,B,C,D,E], Info) end; 6 -> fun(A,B,C,D,E,F) -> eval_fun([A,B,C,D,E,F], Info) end; - 7 -> fun(A,B,C,D,E,F,G) -> + 7 -> fun(A,B,C,D,E,F,G) -> eval_fun([A,B,C,D,E,F,G], Info) end; - 8 -> fun(A,B,C,D,E,F,G,H) -> + 8 -> fun(A,B,C,D,E,F,G,H) -> eval_fun([A,B,C,D,E,F,G,H], Info) end; - 9 -> fun(A,B,C,D,E,F,G,H,I) -> + 9 -> fun(A,B,C,D,E,F,G,H,I) -> eval_fun([A,B,C,D,E,F,G,H,I], Info) end; - 10 -> fun(A,B,C,D,E,F,G,H,I,J) -> + 10 -> fun(A,B,C,D,E,F,G,H,I,J) -> eval_fun([A,B,C,D,E,F,G,H,I,J], Info) end; - 11 -> fun(A,B,C,D,E,F,G,H,I,J,K) -> + 11 -> fun(A,B,C,D,E,F,G,H,I,J,K) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K], Info) end; - 12 -> fun(A,B,C,D,E,F,G,H,I,J,K,L) -> + 12 -> fun(A,B,C,D,E,F,G,H,I,J,K,L) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K,L], Info) end; - 13 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M) -> + 13 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M], Info) end; - 14 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N) -> + 14 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N], Info) end; - 15 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> + 15 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O], Info) end; - 16 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P) -> + 16 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P], Info) end; - 17 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) -> + 17 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q], Info) end; - 18 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) -> + 18 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R], Info) end; - 19 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) -> + 19 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S],Info) end; - 20 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) -> + 20 -> fun(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) -> eval_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T],Info) end; _Other -> exception(error, {'argument_limit',{'fun',Cs}}, Bs, @@ -1049,7 +1049,7 @@ expr({apply,Line,As0,Lc}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, {[M,F,As],Bs} = eval_list(As0, Bs0, Ieval), eval_function(M, F, As, Bs, extern, Ieval, Lc); - + %% Receive statement expr({'receive',Line,Cs}, Bs0, #ieval{level=Le}=Ieval) -> trace(receivex, {Le,false}), @@ -1179,15 +1179,18 @@ eval_mc1({map_field_assoc,_,K0,V0}, [], Bs, Ieval) -> {value,V,_} = expr(V0, Bs, Ieval#ieval{top=false}), [{K,V}]. -eval_generator({generate,Line,P,L0}, Bs0, CompFun, Ieval0) -> +eval_generator({Generate,Line,P,L0}, Bs0, CompFun, Ieval0) when Generate =:= generate; + Generate =:= generate_strict -> Ieval = Ieval0#ieval{line=Line}, {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), - eval_generate(L1, P, Bs1, CompFun, Ieval); -eval_generator({b_generate,Line,P,Bin0}, Bs0, CompFun, Ieval0) -> + eval_generate(L1, P, Bs1, CompFun, Generate =:= generate, Ieval); +eval_generator({Generate,Line,P,Bin0}, Bs0, CompFun, Ieval0) when Generate =:= b_generate; + Generate =:= b_generate_strict -> Ieval = Ieval0#ieval{line=Line}, {value,Bin,Bs1} = expr(Bin0, Bs0, Ieval#ieval{top=false}), - eval_b_generate(Bin, P, Bs1, CompFun, Ieval); -eval_generator({m_generate,Line,P,Map0}, Bs0, CompFun, Ieval0) -> + eval_b_generate(Bin, P, Bs1, CompFun, Generate =:= b_generate, Ieval); +eval_generator({Generate,Line,P,Map0}, Bs0, CompFun, Ieval0) when Generate =:= m_generate; + Generate =:= m_generate_strict -> Ieval = Ieval0#ieval{line=Line}, {map_field_exact,_,K,V} = P, {value,Map,_Bs1} = expr(Map0, Bs0, Ieval), @@ -1204,45 +1207,53 @@ eval_generator({m_generate,Line,P,Map0}, Bs0, CompFun, Ieval0) -> exception(error, {bad_generator,Map}, Bs0, Ieval) end end, - eval_m_generate(Iter, {tuple,Line,[K,V]}, Bs0, CompFun, Ieval). + eval_m_generate(Iter, {tuple,Line,[K,V]}, Bs0, CompFun, Generate =:= m_generate, Ieval). -eval_generate([V|Rest], P, Bs0, CompFun, Ieval) -> +eval_generate([V|Rest], P, Bs0, CompFun, Relaxed, Ieval) -> case catch match1(P, V, erl_eval:new_bindings(), Bs0) of {match,Bsn} -> Bs2 = add_bindings(Bsn, Bs0), - CompFun(Bs2) ++ eval_generate(Rest, P, Bs0, CompFun, Ieval); - nomatch -> - eval_generate(Rest, P, Bs0, CompFun, Ieval) + CompFun(Bs2) ++ eval_generate(Rest, P, Bs0, CompFun, Relaxed, Ieval); + nomatch when Relaxed -> + eval_generate(Rest, P, Bs0, CompFun, Relaxed, Ieval); + nomatch -> + exception(error, {badmatch, V}, Bs0, Ieval) end; -eval_generate([], _P, _Bs0, _CompFun, _Ieval) -> +eval_generate([], _P, _Bs0, _CompFun, _Relaxed, _Ieval) -> []; -eval_generate(Term, _P, Bs, _CompFun, Ieval) -> +eval_generate(Term, _P, Bs, _CompFun, _Relaxed, Ieval) -> exception(error, {bad_generator,Term}, Bs, Ieval). -eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, CompFun, Ieval) -> +eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, CompFun, Relaxed, Ieval) -> 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, Mfun, Efun) of {match,Rest,Bs1} -> Bs2 = add_bindings(Bs1, Bs0), - CompFun(Bs2) ++ eval_b_generate(Rest, P, Bs0, CompFun, Ieval); - {nomatch,Rest} -> - eval_b_generate(Rest, P, Bs0, CompFun, Ieval); - done -> - [] + CompFun(Bs2) ++ eval_b_generate(Rest, P, Bs0, CompFun, Relaxed, Ieval); + {nomatch,Rest} when Relaxed -> + eval_b_generate(Rest, P, Bs0, CompFun, Relaxed, Ieval); + {nomatch,_Rest} -> + exception(error, {badmatch, Bin}, Bs0, Ieval); + done when not Relaxed, Bin =/= <<>> -> + exception(error, {badmatch, Bin}, Bs0, Ieval); + done -> + [] end; -eval_b_generate(Term, _P, Bs, _CompFun, Ieval) -> +eval_b_generate(Term, _P, Bs, _CompFun, _Relaxed, Ieval) -> exception(error, {bad_generator,Term}, Bs, Ieval). -eval_m_generate(Iter0, P, Bs0, CompFun, Ieval) -> +eval_m_generate(Iter0, P, Bs0, CompFun, Relaxed, Ieval) -> case maps:next(Iter0) of {K,V,Iter} -> case catch match1(P, {K,V}, erl_eval:new_bindings(), Bs0) of {match,Bsn} -> Bs2 = add_bindings(Bsn, Bs0), - CompFun(Bs2) ++ eval_m_generate(Iter, P, Bs0, CompFun, Ieval); + CompFun(Bs2) ++ eval_m_generate(Iter, P, Bs0, CompFun, Relaxed, Ieval); + nomatch when Relaxed -> + eval_m_generate(Iter, P, Bs0, CompFun, Relaxed, Ieval); nomatch -> - eval_m_generate(Iter, P, Bs0, CompFun, Ieval) + exception(error, {badmatch, {K,V}}, Bs0, Ieval) end; none -> [] @@ -1264,7 +1275,7 @@ safe_bif(M, F, As, Bs, Ieval0) -> eval_send(To, Msg, Bs, Ieval) -> try To ! Msg of - Msg -> + Msg -> trace(send, {To,Msg}), {value,Msg,Bs} catch @@ -1273,7 +1284,7 @@ eval_send(To, Msg, Bs, Ieval) -> end. %% Start tracing of messages before fetching current messages in -%% the queue to make sure that no messages are lost. +%% the queue to make sure that no messages are lost. eval_receive(Debugged, Cs, Bs0, #ieval{module=M,line=Line,level=Le}=Ieval) -> %% To avoid private message passing protocol between META @@ -1514,7 +1525,7 @@ rec_clauses([], _, _) -> %% Evaluate a list of guards. guard([], _) -> true; guard(Gs, Bs) -> or_guard(Gs, Bs). - + or_guard([G|Gs], Bs) -> %% Short-circuit OR. and_guard(G, Bs) orelse or_guard(Gs, Bs); @@ -1588,7 +1599,7 @@ guard_expr({map,_,E0,Fs0}, Bs) -> E, Fs), {value,Value}; guard_expr({bin,_,Flds}, Bs) -> - {value,V,_Bs} = + {value,V,_Bs} = eval_bits:expr_grp(Flds, Bs, fun(E,B) -> {value,V} = guard_expr(E,B), @@ -1678,7 +1689,7 @@ match1({match,_,Pat1,Pat2}, Term, Bs0, BBs) -> match1({cons,_,H,T}, [H1|T1], Bs0, BBs) -> {match,Bs} = match1(H, H1, Bs0, BBs), match1(T, T1, Bs, BBs); -match1({tuple,_,Elts}, Tuple, Bs, BBs) +match1({tuple,_,Elts}, Tuple, Bs, BBs) when length(Elts) =:= tuple_size(Tuple) -> match_tuple(Elts, Tuple, 1, Bs, BBs); match1({map,_,Fields}, Map, Bs, BBs) when is_map(Map) -> @@ -1724,7 +1735,7 @@ match_map([], _, Bs, _BBs) -> head_match([Par|Pars], [Arg|Args], Bs0, BBs) -> try match1(Par, Arg, Bs0, BBs) of {match,Bs} -> head_match(Pars, Args, Bs, BBs) - catch + catch Result -> Result end; head_match([],[],Bs,_) -> {match,Bs}. @@ -1787,7 +1798,7 @@ add_anon(Val,[]) -> [{'_',Val}]. %% merge_bindings(Bindings1, Bindings2, Ieval) -%% Merge bindings detecting bad matches. +%% Merge bindings detecting bad matches. %% Special case '_',save the new one !!! %% Bindings1 is the newest bindings. merge_bindings(Bs, Bs, _Ieval) -> diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index abb3529f5b36..7f8328f263b4 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -92,7 +92,7 @@ store_module(Mod, File, Binary, Db) -> erase(vcount), erase(funs), erase(fun_count), - + NewBinary = store_mod_line_no(Mod, Db, binary_to_list(Src)), dbg_idb:insert(Db, mod_bin, NewBinary), dbg_idb:insert(Db, mod_raw, <>). %% Add eos @@ -117,7 +117,7 @@ init_calltype_imports([_|T], Ctype) -> init_calltype_imports(T, Ctype); init_calltype_imports([], Ctype) -> Ctype. -%% Adjust line numbers using the file/2 attribute. +%% Adjust line numbers using the file/2 attribute. %% Also take the absolute value of line numbers. %% This simple fix will make the marker point at the correct line %% (assuming the file attributes are correct) in the source; it will @@ -669,7 +669,7 @@ expr({map_field_assoc,L,K0,V0}, _Lc, St) -> V = expr(V0, false, St), {map_field_assoc,L,K,V}. -consify([A|As]) -> +consify([A|As]) -> {cons,0,A,consify(As)}; consify([]) -> {value,0,[]}. @@ -687,10 +687,16 @@ expr_comprehension({Tag,Anno,E0,Gs0}, St) -> Gs = [case G of ({generate,L,P0,Qs}) -> {generator,{generate,L,pattern(P0, St),expr(Qs, false, St)}}; + ({generate_strict,L,P0,Qs}) -> + {generator,{generate_strict,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)}}; + ({b_generate_strict,L,P0,Qs}) -> %R12. + {generator,{b_generate_strict,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)}}; + ({m_generate_strict,L,P0,Qs}) -> %OTP 26 + {generator,{m_generate_strict,L,mc_pattern(P0, St),expr(Qs, false, St)}}; (Expr) -> case is_guard_test(Expr, St) of true -> {guard,guard([[Expr]], St)}; diff --git a/lib/debugger/test/bs_bincomp_SUITE.erl b/lib/debugger/test/bs_bincomp_SUITE.erl index 064e9567b356..d0cf17716c29 100644 --- a/lib/debugger/test/bs_bincomp_SUITE.erl +++ b/lib/debugger/test/bs_bincomp_SUITE.erl @@ -24,11 +24,11 @@ -module(bs_bincomp_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-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, byte_aligned/1,bit_aligned/1,extended_byte_aligned/1, - extended_bit_aligned/1,mixed/1]). + extended_bit_aligned/1,mixed/1,strict_generators/1]). -include_lib("common_test/include/ct.hrl"). @@ -43,11 +43,11 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. -all() -> +all() -> [byte_aligned, bit_aligned, extended_byte_aligned, - extended_bit_aligned, mixed]. + extended_bit_aligned, mixed, strict_generators]. -groups() -> +groups() -> []. init_per_suite(Config) -> @@ -125,3 +125,25 @@ mixed(Config) when is_list(Config) -> [2,3,3,4,4,5,5,6] = [(X+Y) || <> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2]], ok. + +strict_generators(Config) when is_list(Config) -> + %% Basic strict generators (each generator type) + <<2,3,4>> = << <<(X+1)>> || X <:- [1,2,3]>>, + <<2,3,4>> = << <<(X+1)>> || <> <:= <<1,2,3>> >>, + <<2,12>> = << <<(X*Y)>> || X := Y <:- #{1 => 2, 3 => 4} >>, + + %% A failing guard following a strict generator is ok + <<3,4>> = << <<(X+1)>> || X <:- [1,2,3], X > 1>>, + <<3,4>> = << <<(X+1)>> || <> <:= <<1,2,3>>, X > 1 >>, + <<12>> = << <<(X*Y)>> || X := Y <:- #{1 => 2, 3 => 4}, X > 1 >>, + + %% Non-matching elements cause a badmatch error for strict generators + {'EXIT',{{badmatch,2},_}} = (catch << <> || {ok, X} <:- [{ok,1},2,{ok,3}] >>), + {'EXIT',{{badmatch,<<128,2>>},_}} = (catch << <> || <<0:1, X:7>> <:= <<1,128,2>> >>), + {'EXIT',{{badmatch,{2,error}},_}} = (catch << <> || X := ok <:- #{1 => ok, 2 => error, 3 => ok} >>), + + %% Extra bits cannot be skipped at the end of the binary either + {'EXIT',{{badmatch,<<0:2>>},_}} = (catch [X || <> <:= <<0>>]), + {'EXIT',{{badmatch,<<9,2>>},_}} = (catch [Y || <> <:= <<8,1,9,2>>]), + + ok. diff --git a/lib/debugger/test/lc_SUITE.erl b/lib/debugger/test/lc_SUITE.erl index 28415b412bcd..5764095f1b77 100644 --- a/lib/debugger/test/lc_SUITE.erl +++ b/lib/debugger/test/lc_SUITE.erl @@ -34,10 +34,10 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. -all() -> +all() -> [basic, deeply_nested, no_generator, empty_generator]. -groups() -> +groups() -> []. init_per_group(_GroupName, Config) -> @@ -84,12 +84,27 @@ basic(Config) when is_list(Config) -> %% Filter expressions with andalso/orelse. "abc123" = alphanum("?abc123.;"), + %% Strict generators (each generator type) + [2,3,4] = [X+1 || X <:- [1,2,3]], + [2,3,4] = [X+1 || <> <:= <<1,2,3>>], + [2,12] = [X*Y || X := Y <:- #{1 => 2, 3 => 4}], + + %% A failing guard following a strict generator is ok + [3,4] = [X+1 || X <:- [1,2,3], X > 1], + [3,4] = [X+1 || <> <:= <<1,2,3>>, X > 1], + [12] = [X*Y || X := Y <:- #{1 => 2, 3 => 4}, X > 1], + %% Error cases. [] = [{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)]), + %% Non-matching elements cause a badmatch error for strict generators + {'EXIT',{{badmatch,2},_}} = (catch [X || {ok, X} <:- [{ok,1},2,{ok,3}]]), + {'EXIT',{{badmatch,<<128,2>>},_}} = (catch [X || <<0:1, X:7>> <:= <<1,128,2>>]), + {'EXIT',{{badmatch,{2,error}},_}} = (catch [X || X := ok <:- #{1 => ok, 2 => error, 3 => ok}]), + %% A bad generator has a different exception compared to BEAM. {'EXIT',{{bad_generator,x},_}} = (catch [E || E <- id(x)]), ok. diff --git a/lib/debugger/test/mc_SUITE.erl b/lib/debugger/test/mc_SUITE.erl index 0a374cb51ab7..8f304a75c989 100644 --- a/lib/debugger/test/mc_SUITE.erl +++ b/lib/debugger/test/mc_SUITE.erl @@ -125,6 +125,21 @@ basic(_Config) -> N rem 2 =:= 1]), Odd = lists:sort([V || #foo{a=N} := V <- RecordMap, N rem 2 =:= 1]), + %% Strict generators (each generator type) + #{1 := 2, 2 := 3, 3 := 4} = #{X => X+1 || X <:- [1,2,3]}, + #{1 := 2, 2 := 3, 3 := 4} = #{X => X+1 || <> <:= <<1,2,3>>}, + #{2 := 4, 4 := 8} = #{X+1 => Y*2 || X := Y <:- #{1 => 2, 3 => 4}}, + + %% A failing guard following a strict generator is ok + #{2 := 3, 3 := 4} = #{X => X+1 || X <:- [1,2,3], X > 1}, + #{2 := 3, 3 := 4} = #{X => X+1 || <> <:= <<1,2,3>>, X > 1}, + #{4 := 8} = #{X+1 => Y*2 || X := Y <:- #{1 => 2, 3 => 4}, X > 1}, + + %% Non-matching elements cause a badmatch error for strict generators + {'EXIT',{{badmatch,2},_}} = (catch #{X => X+1 || {ok, X} <:- [{ok,1},2,{ok,3}]}), + {'EXIT',{{badmatch,<<128,2>>},_}} = (catch #{X => X+1 || <<0:1, X:7>> <:= <<1,128,2>>}), + {'EXIT',{{badmatch,{2,error}},_}} = (catch #{X => X+1 || X := ok <:- #{1 => ok, 2 => error, 3 => ok}}), + ok. mc_double(Size) -> diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl index c50a6ae75e3d..0d54643659e6 100644 --- a/lib/stdlib/examples/erl_id_trans.erl +++ b/lib/stdlib/examples/erl_id_trans.erl @@ -9,11 +9,11 @@ %% 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. -%% +%% %% The Initial Developer of the Original Code is Ericsson Utvecklings AB. %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings %% AB. All Rights Reserved.'' -%% +%% %% $Id$ %% -module(erl_id_trans). @@ -321,7 +321,7 @@ guard0([]) -> []. guard_test(Expr={call,Anno,{atom,Aa,F},As0}) -> case erl_internal:type_test(F, length(As0)) of - true -> + true -> As1 = gexpr_list(As0), {call,Anno,{atom,Aa,F},As1}; _ -> @@ -381,7 +381,7 @@ gexpr({call,Anno,{atom,Aa,F},As0}) -> % Guard bif's can be remote, but only in the module erlang... gexpr({call,Anno,{remote,Aa,{atom,Ab,erlang},{atom,Ac,F}},As0}) -> case erl_internal:guard_bif(F, length(As0)) or - erl_internal:arith_op(F, length(As0)) or + erl_internal:arith_op(F, length(As0)) or erl_internal:comp_op(F, length(As0)) or erl_internal:bool_op(F, length(As0)) of true -> As1 = gexpr_list(As0), @@ -391,7 +391,7 @@ gexpr({bin,Anno,Fs}) -> Fs2 = pattern_grp(Fs), {bin,Anno,Fs2}; gexpr({op,Anno,Op,A0}) -> - case erl_internal:arith_op(Op, 1) or + case erl_internal:arith_op(Op, 1) or erl_internal:bool_op(Op, 1) of true -> A1 = gexpr(A0), {op,Anno,Op,A1} @@ -403,7 +403,7 @@ gexpr({op,Anno,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> {op,Anno,Op,L1,R1}; gexpr({op,Anno,Op,L0,R0}) -> case erl_internal:arith_op(Op, 2) or - erl_internal:bool_op(Op, 2) or + erl_internal:bool_op(Op, 2) or erl_internal:comp_op(Op, 2) of true -> L1 = gexpr(L0), @@ -623,14 +623,26 @@ comprehension_quals([{generate,Anno,P0,E0}|Qs]) -> E1 = expr(E0), P1 = pattern(P0), [{generate,Anno,P1,E1}|comprehension_quals(Qs)]; +comprehension_quals([{generate_strict,Anno,P0,E0}|Qs]) -> + E1 = expr(E0), + P1 = pattern(P0), + [{generate_strict,Anno,P1,E1}|comprehension_quals(Qs)]; comprehension_quals([{b_generate,Anno,P0,E0}|Qs]) -> E1 = expr(E0), P1 = pattern(P0), [{b_generate,Anno,P1,E1}|comprehension_quals(Qs)]; +comprehension_quals([{b_generate_strict,Anno,P0,E0}|Qs]) -> + E1 = expr(E0), + P1 = pattern(P0), + [{b_generate_strict,Anno,P1,E1}|comprehension_quals(Qs)]; comprehension_quals([{m_generate,Anno,P0,E0}|Qs]) -> E1 = expr(E0), P1 = pattern(P0), [{m_generate,Anno,P1,E1}|comprehension_quals(Qs)]; +comprehension_quals([{m_generate_strict,Anno,P0,E0}|Qs]) -> + E1 = expr(E0), + P1 = pattern(P0), + [{m_generate_strict,Anno,P1,E1}|comprehension_quals(Qs)]; comprehension_quals([E0|Qs]) -> E1 = expr(E0), [E1|comprehension_quals(Qs)]; diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 0989f43ed9c7..9b6ec11765c7 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 1996-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 @@ -14,7 +14,7 @@ %% 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(erl_eval). @@ -971,13 +971,16 @@ 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_generator({generate,Anno,P,L0}, Bs0, Lf, Ef, FUVs, Acc0, CompFun) -> +eval_generator({Generate,Anno,P,L0}, Bs0, Lf, Ef, FUVs, Acc0, CompFun) when Generate =:= generate; + Generate =:= generate_strict -> {value,L1,_Bs1} = expr(L0, Bs0, Lf, Ef, none, FUVs), - eval_generate(L1, P, Anno, Bs0, Lf, Ef, CompFun, Acc0); -eval_generator({b_generate,Anno,P,Bin0}, Bs0, Lf, Ef, FUVs, Acc0, CompFun) -> + eval_generate(L1, P, Anno, Bs0, Lf, Ef, CompFun, Generate =:= generate, Acc0); +eval_generator({Generate,Anno,P,Bin0}, Bs0, Lf, Ef, FUVs, Acc0, CompFun) when Generate =:= b_generate; + Generate =:= b_generate_strict -> {value,Bin,_Bs1} = expr(Bin0, Bs0, Lf, Ef, none, FUVs), - eval_b_generate(Bin, P, Anno, Bs0, Lf, Ef, CompFun, Acc0); -eval_generator({m_generate,Anno,P,Map0}, Bs0, Lf, Ef, FUVs, Acc0, CompFun) -> + eval_b_generate(Bin, P, Anno, Bs0, Lf, Ef, CompFun, Generate =:= b_generate, Acc0); +eval_generator({Generate,Anno,P,Map0}, Bs0, Lf, Ef, FUVs, Acc0, CompFun) when Generate =:= m_generate; + Generate =:= m_generate_strict -> {map_field_exact,_,K,V} = P, {value,Map,_Bs1} = expr(Map0, Bs0, Lf, Ef, none, FUVs), Iter = case is_map(Map) of @@ -994,23 +997,25 @@ eval_generator({m_generate,Anno,P,Map0}, Bs0, Lf, Ef, FUVs, Acc0, CompFun) -> Anno, Bs0, Ef, none) end end, - eval_m_generate(Iter, {tuple,Anno,[K,V]}, Anno, Bs0, Lf, Ef, CompFun, Acc0). + eval_m_generate(Iter, {tuple,Anno,[K,V]}, Anno, Bs0, Lf, Ef, CompFun, Generate =:= m_generate, Acc0). -eval_generate([V|Rest], P, Anno, Bs0, Lf, Ef, CompFun, Acc) -> +eval_generate([V|Rest], P, Anno, Bs0, Lf, Ef, CompFun, Relaxed, Acc) -> case match(P, V, Anno, new_bindings(Bs0), Bs0, Ef) of {match,Bsn} -> Bs2 = add_bindings(Bsn, Bs0), NewAcc = CompFun(Bs2, Acc), - eval_generate(Rest, P, Anno, Bs0, Lf, Ef, CompFun, NewAcc); - nomatch -> - eval_generate(Rest, P, Anno, Bs0, Lf, Ef, CompFun, Acc) + eval_generate(Rest, P, Anno, Bs0, Lf, Ef, CompFun, Relaxed, NewAcc); + nomatch when Relaxed -> + eval_generate(Rest, P, Anno, Bs0, Lf, Ef, CompFun, Relaxed, Acc); + nomatch -> + apply_error({badmatch, V}, ?STACKTRACE, Anno, Bs0, Ef, none) end; -eval_generate([], _P, _Anno, _Bs0, _Lf, _Ef, _CompFun, Acc) -> +eval_generate([], _P, _Anno, _Bs0, _Lf, _Ef, _CompFun, _Relaxed, Acc) -> Acc; -eval_generate(Term, _P, Anno, Bs0, _Lf, Ef, _CompFun, _Acc) -> +eval_generate(Term, _P, Anno, Bs0, _Lf, Ef, _CompFun, _Relaxed, _Acc) -> apply_error({bad_generator,Term}, ?STACKTRACE, Anno, Bs0, Ef, none). -eval_b_generate(<<_/bitstring>>=Bin, P, Anno, Bs0, Lf, Ef, CompFun, Acc) -> +eval_b_generate(<<_/bitstring>>=Bin, P, Anno, Bs0, Lf, Ef, CompFun, Relaxed, 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, @@ -1018,25 +1023,31 @@ eval_b_generate(<<_/bitstring>>=Bin, P, Anno, Bs0, Lf, Ef, CompFun, Acc) -> {match, Rest, Bs1} -> Bs2 = add_bindings(Bs1, Bs0), NewAcc = CompFun(Bs2, Acc), - eval_b_generate(Rest, P, Anno, Bs0, Lf, Ef, CompFun, NewAcc); - {nomatch, Rest} -> - eval_b_generate(Rest, P, Anno, Bs0, Lf, Ef, CompFun, Acc); - done -> + eval_b_generate(Rest, P, Anno, Bs0, Lf, Ef, CompFun, Relaxed, NewAcc); + {nomatch, Rest} when Relaxed -> + eval_b_generate(Rest, P, Anno, Bs0, Lf, Ef, CompFun, Relaxed, Acc); + {nomatch, _Rest} -> + apply_error({badmatch, Bin}, ?STACKTRACE, Anno, Bs0, Ef, none); + done when not Relaxed, Bin =/= <<>> -> + apply_error({badmatch, Bin}, ?STACKTRACE, Anno, Bs0, Ef, none); + done -> Acc end; -eval_b_generate(Term, _P, Anno, Bs0, _Lf, Ef, _CompFun, _Acc) -> +eval_b_generate(Term, _P, Anno, Bs0, _Lf, Ef, _CompFun, _Relaxed, _Acc) -> apply_error({bad_generator,Term}, ?STACKTRACE, Anno, Bs0, Ef, none). -eval_m_generate(Iter0, P, Anno, Bs0, Lf, Ef, CompFun, Acc0) -> +eval_m_generate(Iter0, P, Anno, Bs0, Lf, Ef, CompFun, Relaxed, Acc0) -> case maps:next(Iter0) of {K,V,Iter} -> case match(P, {K,V}, Anno, new_bindings(Bs0), Bs0, Ef) of {match,Bsn} -> Bs2 = add_bindings(Bsn, Bs0), Acc = CompFun(Bs2, Acc0), - eval_m_generate(Iter, P, Anno, Bs0, Lf, Ef, CompFun, Acc); + eval_m_generate(Iter, P, Anno, Bs0, Lf, Ef, CompFun, Relaxed, Acc); + nomatch when Relaxed -> + eval_m_generate(Iter, P, Anno, Bs0, Lf, Ef, CompFun, Relaxed, Acc0); nomatch -> - eval_m_generate(Iter, P, Anno, Bs0, Lf, Ef, CompFun, Acc0) + apply_error({badmatch, {K,V}}, ?STACKTRACE, Anno, Bs0, Ef, none) end; none -> Acc0 @@ -1059,8 +1070,11 @@ eval_filter(F, Bs0, Lf, Ef, CompFun, FUVs, Acc) -> end. is_generator({generate,_,_,_}) -> true; +is_generator({generate_strict,_,_,_}) -> true; is_generator({b_generate,_,_,_}) -> true; +is_generator({b_generate_strict,_,_,_}) -> true; is_generator({m_generate,_,_,_}) -> true; +is_generator({m_generate_strict,_,_,_}) -> true; is_generator(_) -> false. %% eval_map_fields([Field], Bindings, LocalFunctionHandler, @@ -1828,7 +1842,7 @@ normalise_list([]) -> %%---------------------------------------------------------------------------- %% %% Evaluate expressions: -%% constants and +%% constants and %% op A %% L op R %% Things that evaluate to constants are accepted diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index 2b09006faf24..7d314632dec5 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -203,8 +203,8 @@ normalise_test(function, 1) -> is_function; normalise_test(integer, 1) -> is_integer; normalise_test(list, 1) -> is_list; normalise_test(number, 1) -> is_number; -normalise_test(pid, 1) -> is_pid; -normalise_test(port, 1) -> is_port; +normalise_test(pid, 1) -> is_pid; +normalise_test(port, 1) -> is_port; normalise_test(record, 2) -> is_record; normalise_test(reference, 1) -> is_reference; normalise_test(tuple, 1) -> is_tuple; @@ -505,7 +505,7 @@ strict_record_access(E0, St0) -> St1 = St0#exprec{strict_ra = [], checked_ra = NC}, expr(E1, St1). -%% Make it look nice (?) when compiled with the 'E' flag +%% Make it look nice (?) when compiled with the 'E' flag %% ('and'/2 is left recursive). conj([], _E) -> empty; @@ -545,11 +545,21 @@ lc_tq(Anno, [{generate,AnnoG,P0,G0} | Qs0], St0) -> {P1,St2} = pattern(P0, St1), {Qs1,St3} = lc_tq(Anno, Qs0, St2), {[{generate,AnnoG,P1,G1} | Qs1],St3}; +lc_tq(Anno, [{generate_strict,AnnoG,P0,G0} | Qs0], St0) -> + {G1,St1} = expr(G0, St0), + {P1,St2} = pattern(P0, St1), + {Qs1,St3} = lc_tq(Anno, Qs0, St2), + {[{generate_strict,AnnoG,P1,G1} | Qs1],St3}; lc_tq(Anno, [{b_generate,AnnoG,P0,G0} | Qs0], St0) -> {G1,St1} = expr(G0, St0), {P1,St2} = pattern(P0, St1), {Qs1,St3} = lc_tq(Anno, Qs0, St2), {[{b_generate,AnnoG,P1,G1} | Qs1],St3}; +lc_tq(Anno, [{b_generate_strict,AnnoG,P0,G0} | Qs0], St0) -> + {G1,St1} = expr(G0, St0), + {P1,St2} = pattern(P0, St1), + {Qs1,St3} = lc_tq(Anno, Qs0, St2), + {[{b_generate_strict,AnnoG,P1,G1} | Qs1],St3}; lc_tq(Anno, [{m_generate,AnnoG,P0,G0} | Qs0], St0) -> {G1,St1} = expr(G0, St0), {map_field_exact,AnnoMFE,KeyP0,ValP0} = P0, @@ -558,6 +568,14 @@ 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, [{m_generate_strict,AnnoG,P0,G0} | Qs0], St0) -> + {G1,St1} = expr(G0, St0), + {map_field_exact,AnnoMFE,KeyP0,ValP0} = P0, + {KeyP1,St2} = pattern(KeyP0, St1), + {ValP1,St3} = pattern(ValP0, St2), + {Qs1,St4} = lc_tq(Anno, Qs0, St3), + P1 = {map_field_exact,AnnoMFE,KeyP1,ValP1}, + {[{m_generate_strict,AnnoG,P1,G1} | Qs1],St4}; lc_tq(Anno, [F0 | Qs0], #exprec{calltype=Calltype,raw_records=Records}=St0) -> %% Allow record/2 and expand out as guard test. IsOverriden = fun(FA) -> @@ -785,7 +803,7 @@ record_upd_fs([{record_field,Anno,{atom,_AnnoA,F},_Val} | Fs], Us, St0) -> record_upd_fs([], _, St) -> {[],[],St}. %% record_setel(Record, RecordName, [RecDefField], [Update]) -%% Build a nested chain of setelement calls to build the +%% Build a nested chain of setelement calls to build the %% updated record tuple. record_setel(R, Name, Fs, Us0) -> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 087461744b18..850191ca2216 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -1296,7 +1296,7 @@ behaviour_callbacks(Anno, B, St0) -> end. behaviour_deprecated([{{Anno, B}, Bfs, _OBfs} | T], Exports, St) -> - behaviour_deprecated(T, Exports, + behaviour_deprecated(T, Exports, behaviour_deprecated(Anno, B, Bfs, Exports, St)); behaviour_deprecated([], _Exports, St) -> St. @@ -1568,7 +1568,7 @@ most_possible_string(Name, PossibleNames) -> case PossibleNames of [] -> []; _ -> - %% kk and kl has a similarity of 0.66. Short names are common in + %% kk and kl has a similarity of 0.66. Short names are common in %% Erlang programs, therefore we choose a relatively low threshold %% here. SufficientlySimilar = 0.66, @@ -2767,7 +2767,7 @@ expr({call,Anno,{atom,Aa,F},As}, Vt, St0) -> AutoSuppressed = is_autoimport_suppressed(St2#lint.no_auto,{F,A}), Warn = is_warn_enabled(bif_clash, St2) and (not bif_clash_specifically_disabled(St2,{F,A})), Imported = imported(F, A, St2), - case ((not IsLocal) andalso (Imported =:= no) andalso + case ((not IsLocal) andalso (Imported =:= no) andalso IsAutoBif andalso (not AutoSuppressed)) of true -> St3 = deprecated_function(Anno, erlang, F, As, St2), @@ -3982,13 +3982,23 @@ lc_quals(Qs, Vt0, St0) -> 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); +lc_quals([{generate_strict,_Anno,P,E} | Qs], Vt0, Uvt0, St0) -> + {Vt,Uvt,St} = handle_generator(P,E,Vt0,Uvt0,St0), + lc_quals(Qs, Vt, Uvt, St); lc_quals([{b_generate,_Anno,P,E} | Qs], Vt0, Uvt0, St0) -> St1 = handle_bitstring_gen_pat(P,St0), {Vt,Uvt,St} = handle_generator(P,E,Vt0,Uvt0,St1), lc_quals(Qs, Vt, Uvt, St); +lc_quals([{b_generate_strict,_Anno,P,E} | Qs], Vt0, Uvt0, St0) -> + St1 = handle_bitstring_gen_pat(P,St0), + {Vt,Uvt,St} = handle_generator(P,E,Vt0,Uvt0,St1), + lc_quals(Qs, Vt, Uvt, St); lc_quals([{m_generate,_Anno,P,E} | Qs], Vt0, Uvt0, St0) -> {Vt,Uvt,St} = handle_generator(P,E,Vt0,Uvt0,St0), lc_quals(Qs, Vt, Uvt, St); +lc_quals([{m_generate_strict,_Anno,P,E} | Qs], Vt0, Uvt0, St0) -> + {Vt,Uvt,St} = handle_generator(P,E,Vt0,Uvt0,St0), + lc_quals(Qs, Vt, Uvt, St); lc_quals([F|Qs], Vt, Uvt, St0) -> Info = is_guard_test2_info(St0), {Fvt,St1} = case is_guard_test2(F, Info) of diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index dd99245d336a..18b43dd98c9e 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -79,7 +79,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' @@ -87,7 +87,7 @@ char integer float atom sigil_prefix string sigil_suffix var '*' '/' 'div' 'rem' 'band' 'and' '+' '-' 'bor' 'bxor' 'bsl' 'bsr' 'or' 'xor' '++' '--' -'==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' '=>' ':=' +'==' '/=' '=<' '<' '>=' '>' '=:=' '=/=' '<=' '<:=' '=>' ':=' '<<' '>>' '!' '=' '::' '..' '...' '?=' @@ -365,8 +365,11 @@ lc_exprs -> lc_expr ',' lc_exprs : ['$1'|'$3']. lc_expr -> expr : '$1'. lc_expr -> map_field_exact '<-' expr : {m_generate,?anno('$2'),'$1','$3'}. +lc_expr -> map_field_exact '<:-' expr : {m_generate_strict,?anno('$2'),'$1','$3'}. lc_expr -> expr '<-' expr : {generate,?anno('$2'),'$1','$3'}. +lc_expr -> expr '<:-' expr : {generate_strict,?anno('$2'),'$1','$3'}. lc_expr -> binary '<=' expr : {b_generate,?anno('$2'),'$1','$3'}. +lc_expr -> binary '<:=' expr : {b_generate_strict,?anno('$2'),'$1','$3'}. tuple -> '{' '}' : {tuple,?anno('$1'),[]}. tuple -> '{' exprs '}' : {tuple,?anno('$1'),'$2'}. @@ -935,8 +938,11 @@ processed (see section [Error Information](#module-error-information)). -doc "Abstract representation of a list, bitstring or map generator.". -type af_generator() :: {'generate', anno(), af_pattern(), abstract_expr()} + | {'generate_strict', anno(), af_pattern(), abstract_expr()} | {'m_generate', anno(), af_assoc_exact(af_pattern()), abstract_expr()} - | {'b_generate', anno(), af_pattern(), abstract_expr()}. + | {'m_generate_strict', anno(), af_assoc_exact(af_pattern()), abstract_expr()} + | {'b_generate', anno(), af_pattern(), abstract_expr()} + | {'b_generate_strict', anno(), af_pattern(), abstract_expr()}. -type af_filter() :: abstract_expr(). diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 8cc2c24781d7..401cd1100732 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -1050,12 +1050,21 @@ lc_quals(Qs, Opts) -> lc_qual({m_generate,_,Pat,E}, Opts) -> Pl = map_field(Pat, Opts), {list,[{step,[Pl,leaf(" <-")],lexpr(E, 0, Opts)}]}; +lc_qual({m_generate_strict,_,Pat,E}, Opts) -> + Pl = map_field(Pat, Opts), + {list,[{step,[Pl,leaf(" <:-")],lexpr(E, 0, Opts)}]}; lc_qual({b_generate,_,Pat,E}, Opts) -> Pl = lexpr(Pat, 0, Opts), {list,[{step,[Pl,leaf(" <=")],lexpr(E, 0, Opts)}]}; +lc_qual({b_generate_strict,_,Pat,E}, Opts) -> + Pl = lexpr(Pat, 0, Opts), + {list,[{step,[Pl,leaf(" <:=")],lexpr(E, 0, Opts)}]}; lc_qual({generate,_,Pat,E}, Opts) -> Pl = lexpr(Pat, 0, Opts), {list,[{step,[Pl,leaf(" <-")],lexpr(E, 0, Opts)}]}; +lc_qual({generate_strict,_,Pat,E}, Opts) -> + Pl = lexpr(Pat, 0, Opts), + {list,[{step,[Pl,leaf(" <:-")],lexpr(E, 0, Opts)}]}; lc_qual(Q, Opts) -> lexpr(Q, 0, Opts). diff --git a/lib/stdlib/src/erl_scan.erl b/lib/stdlib/src/erl_scan.erl index 313d89ee1103..5b4893b4313b 100644 --- a/lib/stdlib/src/erl_scan.erl +++ b/lib/stdlib/src/erl_scan.erl @@ -637,13 +637,19 @@ 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) -> + tok2(Cs, St, Line, Col, Toks, "<:-", '<:-', 3); scan1("<-"++Cs, St, Line, Col, Toks) -> tok2(Cs, St, Line, Col, Toks, "<-", '<-', 2); +scan1("<:="++Cs, St, Line, Col, Toks) -> + tok2(Cs, St, Line, Col, Toks, "<:=", '<:=', 3); 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) -> {more,{Cs,St,Col,Toks,Line,[],fun scan/6}}; %% >> >= diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index d34b139781ae..29a233a9ed74 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -226,7 +226,7 @@ integers(_, L) -> -define(ABST_NO_MORE, {nil, Anno}). -define(ABST_MORE(Obj, Cont), {cons, Anno, Obj, Cont}). -%% Qualifier identifier. +%% Qualifier identifier. %% The first one encountered in a QLC has no=1. -record(qid, {lcid,no}). @@ -249,7 +249,7 @@ no_duplicates(Forms, Errors, Warnings0, ExtraWarnings0, Options) -> ([{File,[{L,v3_core,nomatch}]} || {File,[{L,qlc,M}]} <- mforms(ExtraWarnings), lists:member(M, [nomatch_pattern,nomatch_filter])] - ++ + ++ [{File,[{L,sys_core_fold,nomatch_guard}]} || {File,[{L,qlc,M}]} <- mforms(ExtraWarnings), M =:= nomatch_filter]), @@ -292,13 +292,16 @@ record_attributes(Forms) -> %% transformation. %% compile_messages(Forms, FormsNoShadows, Options, State) -> - %% The qlc module can only handle list generators. - BGenF = fun(_QId,{b_generate,Anno,_P,_LE}=BGen, GA, A) -> + %% The qlc module can only handle relaxed list generators. + BGenF = fun(_QId,{Type,Anno,_P,_LE}=BGen, GA, A) when Type =:= b_generate; Type =:= b_generate_strict -> M = {loc(Anno),?APIMOD,binary_generator}, {BGen,[{get(?QLC_FILE),[M]}|GA],A}; - (_QId,{m_generate,Anno,_P,_LE}=BGen, GA, A) -> + (_QId,{Type,Anno,_P,_LE}=BGen, GA, A) when Type =:= m_generate; Type =:= m_generate_strict -> M = {loc(Anno),?APIMOD,map_generator}, {BGen,[{get(?QLC_FILE),[M]}|GA],A}; + (_QId,{generate_strict,Anno,_P,_LE}=BGen, GA, A) -> + M = {loc(Anno),?APIMOD,strict_generator}, + {BGen,[{get(?QLC_FILE),[M]}|GA],A}; (_QId, Q, GA, A) -> {Q,GA,A} end, @@ -320,7 +323,7 @@ compile_messages(Forms, FormsNoShadows, Options, State) -> badarg(Forms, State) -> F = fun(_Id, {lc,_A,_E,_Qs}=LC, Es) -> {LC,Es}; - (Id, A, Es) -> + (Id, A, Es) -> E = {get_lcid_line(Id),?APIMOD,not_a_query_list_comprehension}, {A,[{get(?QLC_FILE), [E]} | Es]} end, @@ -394,7 +397,7 @@ intro_variables(FormsNoShadows, State) -> {Filter,{GVs,[{QId,[]} | QIds]},Foo} end, Acc0 = {[],[]}, - {FForms,{GenVars,QIds}} = + {FForms,{GenVars,QIds}} = qual_fold(Fun, Acc0, [], FormsNoShadows, State), %% Note: the linter messages are the ones we are looking for. %% If there are no linter messages, the compiler will crash (ignored). @@ -444,11 +447,11 @@ compile_forms(Forms0, Options) -> end, Forms = ([F || F <- Forms0, not Exclude(element(1, F))] ++ [{eof,0}]), - try + try case compile:noenv_forms(Forms, compile_options(Options)) of {ok, _ModName, Ws0} -> {[], Ws0}; - {error, Es0, Ws0} -> + {error, Es0, Ws0} -> {Es0, Ws0} end catch _:_ -> @@ -472,11 +475,11 @@ skip_options(Skip, Options) -> [O || O <- Options, not lists:member(O, Skip)]. bitstr_options() -> - [binary_comprehension,bitlevel_binaries]. + [binary_comprehension,bitlevel_binaries]. %% In LCs it is possible to use variables introduced in filters and %% generator patterns in the right hand side of generators (ListExpr), -%% but in QLCs this is not allowed. +%% but in QLCs this is not allowed. %% %% A brand new function is returned such that there is one expression %% for each ListExpr. The expression mentions all introduced variables @@ -518,7 +521,7 @@ used_genvar_check(FormsNoShadows, State) -> UniqueFName = qlc:aux_name(used_genvar, 1, gb_sets:from_list(FunctionNames)), A = anno0(), {function,A,UniqueFName,0,[{clause,A,[],[],lists:reverse(Exprs)}]}. - + q_intro_vars(QId, [{QId, IVs} | QsIVs], IVsSoFar) -> {QsIVs, IVs ++ IVsSoFar}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -540,7 +543,7 @@ q_intro_vars(QId, [{QId, IVs} | QsIVs], IVsSoFar) -> {QsIVs, IVs ++ IVsSoFar}. %% fun). Join generators are ignored at runtime unless a fast join is %% possible, in which case they replace other generators. See also %% qlc.erl. -%% +%% %% For each QLC, every filter is given a state number and every %% generator two state numbers (one for initialization, one for %% looping over values). State 1 is reserved for the template and @@ -570,13 +573,13 @@ q_intro_vars(QId, [{QId, IVs} | QsIVs], IVsSoFar) -> {QsIVs, IVs ++ IVsSoFar}. %% Fun(, ..., Val, ...); % arguments are bound %% (3, ..., [_ | Val], ...) -> % pattern does not match %% Fun(3, ..., Val, ...); -%% (3, ..., [], ...) -> +%% (3, ..., [], ...) -> %% Fun(, ...); %% (3, ...., F, ...) -> % looping over values (using continuations) %% case F() of % get the next value by calling a continuation -%% [Pattern | Val] -> +%% [Pattern | Val] -> %% Fun(..., Val, ...); -%% [_ | Val] -> +%% [_ | Val] -> %% Fun(3, ..., Val, ...); %% [] -> %% Fun(, ...); @@ -589,11 +592,11 @@ q_intro_vars(QId, [{QId, IVs} | QsIVs], IVsSoFar) -> {QsIVs, IVs ++ IVsSoFar}. %% false -> Fun(, ...) %% end; %% (5, ...) -> % a filter so simple that it could be used as a guard -%% if +%% if %% Guard -> Fun(, ...); %% true -> Fun(, ...) %% end -%% +%% %% means state 0 if there is no last %% generator. is the evaluated list expression %% (evaluated once only). Among the arguments indicated by ellipses @@ -626,14 +629,14 @@ transform(FormsNoShadows, State) -> end, TemplS = qlc:template_state(), GoState = {TemplS + 1, TemplS + 1}, - {ModifiedForms1,_} = + {ModifiedForms1,_} = qual_fold(F1, [], GoState, FormsNoShadows, State), %% This is for info/2. QLCs in filters and the template are %% translated before the expression itself is translated. info/2 %% must not display the result of the translation, but the source %% code. - {_,Source0} = qual_fold(fun(_QId, {generate,_,_P,_E}=Q, Dict, Foo) -> + {_,Source0} = qual_fold(fun(_QId, {generate,_,_P,_E}=Q, Dict, Foo) -> {Q,Dict,Foo}; (QId, F, Dict, Foo) -> {F,maps:put(QId, F, Dict),Foo} @@ -647,7 +650,7 @@ transform(FormsNoShadows, State) -> F2 = fun(Id, {lc,_A,E,Qs}, {IntroVs0,XWarn0}) -> LcNo = get_lcid_no(Id), LcL = get_lcid_line(Id), - [RL,Fun,Go,NGV,S0,RL0,Go0,AT,Err] = + [RL,Fun,Go,NGV,S0,RL0,Go0,AT,Err] = aux_vars(['RL','Fun','Go','C','S0','RL0','Go0','AT','E'], LcNo, AllVars), ?DEBUG("RL = ~p, Fun = ~p, Go = ~p~n", [RL, Fun, Go]), @@ -669,12 +672,12 @@ transform(FormsNoShadows, State) -> {EqColumnConstants, EqualColumnConstants, ExtraConsts, SizeInfo} = constants_and_sizes(Qs, E, Dependencies, AllIVs, State), - {JoinInfo, XWarn} = + {JoinInfo, XWarn} = join_kind(Qs, LcL, AllIVs, Dependencies, State), - %% Not at all sure it is a good idea to try and find + %% Not at all sure it is a good idea to try and find %% failing qualifiers; Dialyzer does it so much better. %% But there are a few cases where qlc finds more... (r12b). - FWarn = warn_failing_qualifiers(Qs, AllIVs, Dependencies, + FWarn = warn_failing_qualifiers(Qs, AllIVs, Dependencies, State), JQs = join_quals(JoinInfo, QCs, Anno, LcNo, ExtraConsts, AllVars), XQCs = QCs ++ JQs, @@ -682,8 +685,8 @@ transform(FormsNoShadows, State) -> Template = template(E, RL, Fun, Go, AT, Anno, AllIVs, State), Fin = final(RL, AllIVs, Anno, State), FunC = {'fun',Anno,{clauses,Fin ++ Template ++ Cs0}}, - As0 = pack_args(abst_vars([S0, RL0, Fun, Go0 - | replace(AllIVs, AllIVs, nil)], + As0 = pack_args(abst_vars([S0, RL0, Fun, Go0 + | replace(AllIVs, AllIVs, nil)], Anno), Anno, State), AsW = abst_vars([S0, RL0, Go0], Anno), FunW = {'fun',Anno,{clauses,[{clause,Anno,AsW,[], @@ -693,13 +696,13 @@ transform(FormsNoShadows, State) -> OrigE = undo_no_shadows(OrigE0, State), QCode = qcode(OrigE, XQCs, Source, Anno, State), Qdata = qdata(XQCs, Anno), - TemplateInfo = + TemplateInfo = template_columns(Qs, E, AllIVs, Dependencies, State), %% ExtraConsts should be used by match_spec_quals. MSQs = match_spec_quals(E, Dependencies, Qs, State), Opt = opt_info(TemplateInfo, SizeInfo, JoinInfo, MSQs, Anno, EqColumnConstants, EqualColumnConstants), - LCTuple = + LCTuple = case qlc_kind(OrigE, Qs, State) of qlc -> {tuple,Anno,[?A(qlc_v1),FunW,QCode,Qdata,Opt]}; @@ -722,18 +725,18 @@ join_kind(Qs, LcL, AllIVs, Dependencies, State) -> Tables = lists:usort ([T || {C,_Skip} <- EqualCols2, {T,_} <- C] ++ [T || {C,_Skip} <- EqualCols2, T <- C, is_integer(T)]), - if - EqualColsN =/= []; MatchColsN =/= [] -> - {[], + if + EqualColsN =/= []; MatchColsN =/= [] -> + {[], [{get(?QLC_FILE),[{LcL,?APIMOD,too_complex_join}]}]}; EqualCols2 =:= [], MatchCols2 =:= [] -> {[], []}; - length(Tables) > 2 -> - {[], + length(Tables) > 2 -> + {[], [{get(?QLC_FILE),[{LcL,?APIMOD,too_many_joins}]}]}; EqualCols2 =:= MatchCols2 -> {EqualCols2, []}; - true -> + true -> {{EqualCols2, MatchCols2}, []} end. @@ -750,19 +753,19 @@ qlc_kind(OrigE, Qs, State) -> qlc end. -%% Finds filters and patterns that cannot match any values at all. +%% Finds filters and patterns that cannot match any values at all. %% Nothing but the patterns and the filters themselves is analyzed. %% A much weaker analysis than the one of Dialyzer's. warn_failing_qualifiers(Qualifiers, AllIVs, Dependencies, State) -> - {FilterData, GeneratorData} = qual_data(Qualifiers), + {FilterData, GeneratorData} = qual_data(Qualifiers), Anon = 1, BindFun = fun(_Op, Value) -> is_bindable(Value) end, - {PFrame, _PatternVars} = + {PFrame, _PatternVars} = pattern_frame(GeneratorData, BindFun, Anon, State), - {_, _, Imported} = + {_, _, Imported} = filter_info(FilterData, AllIVs, Dependencies, State), PFrames = frame2frames(PFrame), - {_, Warnings} = + {_, Warnings} = lists:foldl(fun({_QId,{fil,_Filter}}, {[]=Frames,Warnings}) -> {Frames,Warnings}; ({_QId,{fil,Filter}}, {Frames,Warnings}) -> @@ -773,12 +776,12 @@ warn_failing_qualifiers(Qualifiers, AllIVs, Dependencies, State) -> [{get(?QLC_FILE), [{loc(element(2, Filter)),?APIMOD, nomatch_filter}]} | Warnings]}; - Frames1 -> + Frames1 -> {Frames1,Warnings} end; ({_QId,{gen,Pattern,_}}, {Frames,Warnings}) -> case pattern(Pattern, Anon, [], BindFun, State) of - {failed, _, _} -> + {failed, _, _} -> {Frames, [{get(?QLC_FILE), [{loc(element(2, Pattern)),?APIMOD, @@ -819,7 +822,7 @@ opt_info(TemplateInfo, Sizes, JoinInfo, MSQs, Anno, C = [EqC | [EqualC || true <- [CCs =/= ECCs]]], %% Comparisons yield more constant columns than matchings. - ConstCols = [{IdNo,Col} || + ConstCols = [{IdNo,Col} || {{IdNo,Col},[_],_FilNs} <- EqualColumnConstants], ConstColsFamily = family_list(ConstCols), NSortedCols0 = [{IdNo,hd(lists:seq(1, length(Cols)+1)--Cols)} || @@ -830,7 +833,7 @@ opt_info(TemplateInfo, Sizes, JoinInfo, MSQs, Anno, N = [{n_leading_constant_columns,{'fun',Anno,{clauses,NCls}}}], ConstCls = [{clause,Anno,[?I(IdNo)],[],[abstr(Cols,Anno)]} || - {IdNo,Cols} <- ConstColsFamily] + {IdNo,Cols} <- ConstColsFamily] ++ [{clause,Anno,[?V('_')],[],[{nil,Anno}]}], CC = [{constant_columns,{'fun',Anno,{clauses,ConstCls}}}], @@ -860,10 +863,10 @@ abstr(Term, Anno) -> %% Extra generators are introduced for join. join_quals(JoinInfo, QCs, Anno, LcNo, ExtraConstants, AllVars) -> {LastGoI, LastSI} = - lists:foldl(fun({_QId,{_QIVs,{{fil,_},GoI,SI}}}, + lists:foldl(fun({_QId,{_QIVs,{{fil,_},GoI,SI}}}, {GoI0, _SI0}) when GoI >= GoI0 -> {GoI + 2, SI + 1}; - ({_QId,{_QIVs,{{gen,_,_,_},GoI,SI}}}, + ({_QId,{_QIVs,{{gen,_,_,_},GoI,SI}}}, {GoI0, _SI0}) when GoI >= GoI0 -> {GoI + 3, SI + 2}; (_, A) -> @@ -884,13 +887,13 @@ join_quals(JoinInfo, QCs, Anno, LcNo, ExtraConstants, AllVars) -> EqualCols -> [{Q1,Q2,'=='} || {Q1,Q2} <- join_qnums(EqualCols)] end, - LD = [begin - [{QId1,P1,GV1,QIVs1}] = - [{QId,P,GV,QIVs} || - {QId,{QIVs,{{gen,P,_,GV},_GoI,_SI}}} <- QCs, + LD = [begin + [{QId1,P1,GV1,QIVs1}] = + [{QId,P,GV,QIVs} || + {QId,{QIVs,{{gen,P,_,GV},_GoI,_SI}}} <- QCs, QId#qid.no =:= Q1], - [{QId2,P2,QIVs2}] = - [{QId,P,QIVs--[GV]} || + [{QId2,P2,QIVs2}] = + [{QId,P,QIVs--[GV]} || {QId,{QIVs,{{gen,P,_,GV},_,_}}} <- QCs, QId#qid.no =:= Q2], {QId1,Op,P1,GV1,QIVs1++QIVs2,QId2,P2} @@ -921,7 +924,7 @@ anon_pattern(P) -> MoreThanOnce = lists:usort(occ_vars(P) -- qlc:vars(P)), {AP, foo} = var_mapfold(fun({var, Anno, V}, A) -> case lists:member(V, MoreThanOnce) of - true -> + true -> {{var, Anno, V}, A}; false -> {{var, Anno, '_'}, A} @@ -933,7 +936,7 @@ anon_pattern(P) -> %% pattern. It is important that objects that do not pass the pattern %% are filtered out because the columns of the pattern are inspected %% in order to determine if key-sorting the operands can be avoided. -%% +%% %% No objects will be filtered out if the pattern is just a variable. join_handle(AP, Anno, [F, H, O, C], Constants) -> case {AP, Constants} of @@ -982,7 +985,7 @@ join_handle_constants(QId, ExtraConstants) -> column_fun(Columns, QualifierNumber, LcL) -> A = anno0(), - ColCls0 = + ColCls0 = [begin true = Vs0 =/= [], % at least one value to look up Vs1 = list2cons(Vs0), @@ -1024,23 +1027,23 @@ template_columns(Qs0, E0, AllIVs, Dependencies, State) -> Qs = [TemplateAsPattern | Qs0], EqualColumns = equal_columns2(Qs, AllIVs, Dependencies, State), MatchColumns = eq_columns2(Qs, AllIVs, Dependencies, State), - Equal = template_cols(EqualColumns), + Equal = template_cols(EqualColumns), Match = template_cols(MatchColumns), Anno = anno0(), - if - Match =:= Equal -> + if + Match =:= Equal -> [{?V('_'), Match}]; - true -> + true -> [{?A('=='), Equal}, {?A('=:='), Match}] end. equal_columns2(Qualifiers, AllIVs, Dependencies, State) -> - {JI, _Skip} = + {JI, _Skip} = join_info(Qualifiers, AllIVs, Dependencies, State,_JoinOp = '=='), JI. eq_columns2(Qualifiers, AllIVs, Dependencies, State) -> - {JI, _SKip} = + {JI, _SKip} = join_info(Qualifiers, AllIVs, Dependencies, State, _JoinOp = '=:='), JI. @@ -1081,7 +1084,7 @@ qualifier_dependencies(Qualifiers, IntroVs) -> UV <- qlc:vars(F)]), Depend = sofs:strict_relation(sofs:relative_product(Used, Intro)), G = sofs:family_to_digraph(sofs:relation_to_family(Depend)), - Dep0 = [{V,digraph_utils:reachable_neighbours([V], G)} || + Dep0 = [{V,digraph_utils:reachable_neighbours([V], G)} || V <- digraph:vertices(G)], true = digraph:delete(G), FilterIds = sofs:set(filter_ids(Qualifiers)), @@ -1097,27 +1100,27 @@ filter_ids(Qualifiers) -> %% The qualifiers [QualifierNumber'] are filters (F1, ..., Fn) that %% depend on QualifierNumber (a generator Pattern <- LE) only. %% MatchSpec is the match specification for [Pattern' || Pattern <- LE, -%% F1, ..., Fn], where Pattern' is Template if all qualifiers can be +%% F1, ..., Fn], where Pattern' is Template if all qualifiers can be %% replaced by one match specification, otherwise a modified Pattern. match_spec_quals(Template, Dependencies, Qualifiers, State) -> {FilterData, GeneratorData} = qual_data(Qualifiers), - NoFilterGIds = [GId || {GId,_} <- GeneratorData] + NoFilterGIds = [GId || {GId,_} <- GeneratorData] -- lists:flatmap(fun({_,GIds}) -> GIds end, Dependencies), Filters = filter_list(FilterData, Dependencies, State), - Candidates = [{QId2#qid.no,Pattern,[Filter],F} || + Candidates = [{QId2#qid.no,Pattern,[Filter],F} || {QId,[QId2]} <- Dependencies, {GQId,{gen,Pattern,_}} <- GeneratorData, GQId =:= QId2, {FQId,{fil,F}}=Filter <- Filters, % guard filters only - FQId =:= QId] + FQId =:= QId] ++ [{GId#qid.no,Pattern,[],{atom,anno0(),true}} || {GId,{gen,Pattern,_}} <- GeneratorData, lists:member(GId, NoFilterGIds)], E = {nil, anno0()}, - GF = [{{GNum,Pattern},Filter} || + GF = [{{GNum,Pattern},Filter} || {GNum,Pattern,Filter,F} <- Candidates, no =/= try_ms(E, Pattern, F, State)], - GFF = sofs:relation_to_family(sofs:relation(GF, + GFF = sofs:relation_to_family(sofs:relation(GF, [{gnum_pattern,[filter]}])), GFFL = sofs:to_external(sofs:family_union(GFF)), try @@ -1180,7 +1183,7 @@ pattern_as_template(E, TemplVar) -> %% Column = {QualifierNumber,ColumnNumber}} %% FilterNo is a filter that can be skipped at runtime provided constants %% are looked up. -%% ExtraConstants = +%% ExtraConstants = %% [{GeneratorNumber,[{ColumnNumber, %% [{AbstractConstant,AbstractOperator}]}]}] %% For every generator such that the unification binds value(s) to @@ -1191,33 +1194,33 @@ constants_and_sizes(Qualifiers0, E, Dependencies, AllIVs, State) -> TemplateAsPattern = template_as_pattern(E), Qualifiers = [TemplateAsPattern | Qualifiers0], {FilterData, GeneratorData} = qual_data(Qualifiers), - {Filter, Anon1, Imported} = + {Filter, Anon1, Imported} = filter_info(FilterData, AllIVs, Dependencies, State), PatBindFun = fun(_Op, Value) -> is_bindable(Value) end, - {PatternFrame, PatternVars} = + {PatternFrame, PatternVars} = pattern_frame(GeneratorData, PatBindFun, Anon1, State), PatternFrames = frame2frames(PatternFrame), - FilterFun = - fun(BindFun) -> + FilterFun = + fun(BindFun) -> filter(Filter, PatternFrames, BindFun, State, Imported) end, SzFs = FilterFun(PatBindFun), SizeInfo = pattern_sizes(PatternVars, SzFs), SelectorFun = const_selector(Imported), - PatternConstants = + PatternConstants = lists:flatten(frames_to_columns(PatternFrames, PatternVars, deref_pattern(Imported), SelectorFun, Imported, '=:=')), - {EqColumnConstants, _EqExtraConsts} = + {EqColumnConstants, _EqExtraConsts} = constants(FilterFun, PatternVars, PatternConstants, PatternFrame, - FilterData, Dependencies, _LookupOp1 = '=:=', + FilterData, Dependencies, _LookupOp1 = '=:=', Imported, State), - {EqualColumnConstants, EqualExtraConsts} = + {EqualColumnConstants, EqualExtraConsts} = constants(FilterFun, PatternVars, PatternConstants, PatternFrame, - FilterData, Dependencies, _LookupOp2 = '==', + FilterData, Dependencies, _LookupOp2 = '==', Imported, State), %% Use compared extra constants only because: @@ -1226,25 +1229,25 @@ constants_and_sizes(Qualifiers0, E, Dependencies, AllIVs, State) -> %% constants from the comparing unification. %% Using constants from the matching unification would make it %% possible to skip some (more) objects when joining. - ExtraCon1 = + ExtraCon1 = [{{GId,Col},{Val,Op}} || {Consts,Op} <- [{EqualExtraConsts,'=='}], {{GId,Col},Val} <- Consts], - ExtraConstants = + ExtraConstants = family_list([{GId, {Col,ValOps}} || {{GId,Col},ValOps} <- family_list(ExtraCon1)]), {EqColumnConstants, EqualColumnConstants, ExtraConstants, SizeInfo}. -constants(FilterFun, PatternVars, PatternConstants, PatternFrame, +constants(FilterFun, PatternVars, PatternConstants, PatternFrame, FilterData, Dependencies, LookupOp, Imported, State) -> BindFun = fun(_Op, Value) -> is_bindable(Value) end, Fs = FilterFun(BindFun), SelectorFun = const_selector(Imported), - ColumnConstants0 = frames_to_columns(Fs, PatternVars, + ColumnConstants0 = frames_to_columns(Fs, PatternVars, deref_lookup(Imported, LookupOp), SelectorFun, Imported, LookupOp), ColumnConstants1 = lists:flatten(ColumnConstants0), - ExtraConstants = + ExtraConstants = [{{GId,Col},Val} || {{GId,Col},Vals} <- ColumnConstants1 -- PatternConstants, GId =/= ?TNO, @@ -1285,15 +1288,15 @@ deref_lookup(Imported, '=:=') -> %% Augment ColConstants with filters that do not need to be run %% provided that constants are looked up. %% Does not find all filters that can be removed. -lu_skip(ColConstants, FilterData, PatternFrame, PatternVars, +lu_skip(ColConstants, FilterData, PatternFrame, PatternVars, Dependencies, State, Imported, LookupOp) -> %% If there is a test that does not compare or match, then the %% filter cannot be skipped. FailSelector = fun(_Frame) -> fun(Value) -> {yes, Value} end end, - %% In runtime, constants are looked up and matched against a pattern + %% In runtime, constants are looked up and matched against a pattern %% (the pattern acts like a filter), then the filters are run. PatternFrames = frame2frames(PatternFrame), - PatternColumns = + PatternColumns = lists:flatten(frames_to_columns(PatternFrames, PatternVars, deref_pattern(Imported), FailSelector, Imported, LookupOp)), @@ -1303,16 +1306,16 @@ lu_skip(ColConstants, FilterData, PatternFrame, PatternVars, %% Note: one filter at a time is tested; only the pattern is %% assumed to have been run when the filter is run. Sometimes it %% would be advantageously to assume some filter(s) occurring - %% before the filter had been run as well + %% before the filter had been run as well %% (an example: {{X,Y}} <- LE, X =:= 1, Y =:= a). BindFun = fun(_Op, Value) -> is_bindable(Value) end, ColFil = [{Column, FId#qid.no} || - {FId,{fil,Fil}} <- + {FId,{fil,Fil}} <- filter_list(FilterData, Dependencies, State), [] =/= (SFs = safe_filter(reset_anno(Fil), PatternFrames, BindFun, State, Imported)), {GId,PV} <- PatternVars, - [] =/= + [] =/= (Cols = hd(frames_to_columns(SFs, [{GId, PV}], deref_lu_skip(LookupOp, Imported), @@ -1338,19 +1341,19 @@ lu_skip(ColConstants, FilterData, PatternFrame, PatternVars, {NV, F1} = unify_column(PatternFrame, PV, Col, BindFun, Imported), - F2 = unify_var_bindings(VarValues, '=:=', NV, F1, + F2 = unify_var_bindings(VarValues, '=:=', NV, F1, BindFun, Imported, false), %% F2: the pattern has been matched and the %% constant has been looked up. If Frame has no %% more bindings than F2 (modulo unique - %% variables), then the filter can be skipped. - %% - %% Under rare circumstances (for instance: + %% variables), then the filter can be skipped. + %% + %% Under rare circumstances (for instance: %% "X =:= 1, X =:= U", U imported; only 1 is looked up), %% not all constants mentioned in a filter are looked up. %% The filter can only be skipped if all constants %% are looked up. - LookedUpConstants = + LookedUpConstants = case lists:keyfind(Column, 1, ColConstants) of false -> []; {Column, LUCs} -> LUCs @@ -1382,12 +1385,12 @@ deref_lu_skip('=:=', Imported) -> fun(PV, F) -> deref_values(PV, F, Imported) end. equal_columns(Qualifiers, AllIVs, Dependencies, State) -> - {Cs, Skip} = + {Cs, Skip} = join_info(Qualifiers, AllIVs, Dependencies, State, _JoinOp = '=='), join_gens(Cs, Qualifiers, Skip). eq_columns(Qualifiers, AllIVs, Dependencies, State) -> - {Cs, Skip} = + {Cs, Skip} = join_info(Qualifiers, AllIVs, Dependencies, State, _JoinOp = '=:='), join_gens(Cs, Qualifiers, Skip). @@ -1425,7 +1428,7 @@ skip_tag(Col, ColFils, FilterData) -> some end, {Tag, FilL}; - false -> + false -> {some,[]} end. @@ -1436,10 +1439,10 @@ skip_tag(Col, ColFils, FilterData) -> %% -> [[{QualifierNumber,ColumnNumber}]] % Eq.classes. join_info(Qualifiers, AllIVs, Dependencies, State, JoinOp) -> {FilterData, GeneratorData} = qual_data(Qualifiers), - {Filter, Anon1, Imported} = + {Filter, Anon1, Imported} = filter_info(FilterData, AllIVs, Dependencies, State), BindFun = fun(_Op, V) -> bind_no_const(V, Imported) end, - {PatternFrame, PatternVars} = + {PatternFrame, PatternVars} = pattern_frame(GeneratorData, BindFun, Anon1, State), PatternFrames = frame2frames(PatternFrame), Fs = filter(Filter, PatternFrames, BindFun, State, Imported), @@ -1477,23 +1480,23 @@ join_skip(JoinClasses, FilterData, PatternFrame, PatternVars, Dependencies, GId2#qid.no =:= Q2, %% Select a filter that depends on the two generators: - {FId,{fil,Fil}} <- + {FId,{fil,Fil}} <- filter_list(FilterData, Dependencies, State), - {value,{_,GIds}} <- + {value,{_,GIds}} <- [lists:keysearch(FId, 1, Dependencies)], GIds =:= lists:sort([GId1,GId2]), begin - %% Do what the join does: + %% Do what the join does: %% element(C1, G1) JoinOp element(C2, G2). %% As for lu_skip: sometimes it would be %% advantageously to assume some filter(s) %% occurring before the join filter had been run %% as well. BindFun = fun(_Op, V) -> is_bindable(V) end, - {V1, JF1} = + {V1, JF1} = unify_column(PatternFrame, PV1, C1, BindFun, Imported), - {V2, JF2} = + {V2, JF2} = unify_column(JF1, PV2, C2, BindFun, Imported), JF = unify(JoinOp, V1, V2, JF2, BindFun, Imported), @@ -1501,7 +1504,7 @@ join_skip(JoinClasses, FilterData, PatternFrame, PatternVars, Dependencies, SFs = safe_filter(reset_anno(Fil), PatternFrames, BindFun, State, Imported), JImp = qlc:vars([SFs, JF]), % kludge - lists:all(fun(Frame) -> + lists:all(fun(Frame) -> bindings_is_subset(Frame, JF, JImp) end, SFs) andalso SFs =/= [] end], @@ -1513,7 +1516,7 @@ filter_info(FilterData, AllIVs, Dependencies, State) -> Anon0 = 0, {Filter, Anon1} = anon_var(Filter0, Anon0), Imported = ordsets:subtract(qlc:vars(Filter), % anonymous too - ordsets:from_list(AllIVs)), + ordsets:from_list(AllIVs)), {Filter, Anon1, Imported}. %% Selects the guard filters. Other filters than guard filters are @@ -1524,7 +1527,7 @@ filter_info(FilterData, AllIVs, Dependencies, State) -> %% the failing filter is placed _after_ the guard filter, the failing %% objects have already been filtered out by the guard filter. %% Note: guard filters using variables from one generator are allowed -%% to be placed after further generators (the docs states otherwise, but +%% to be placed after further generators (the docs states otherwise, but %% this seems to be common practice). filter_list(FilterData, Dependencies, State) -> sel_gf(FilterData, 1, Dependencies, State, [], []). @@ -1564,12 +1567,12 @@ pattern_frame(GeneratorData, BindFun, Anon1, State) -> Frame0 = [], {PatternFrame, _Anon2, PatternVars} = lists:foldl(fun({QId,{gen,Pattern,_}}, {F0,An0,PVs}) -> - {F1, An1, PV} = + {F1, An1, PV} = pattern(Pattern, An0, F0, BindFun, State), {F1, An1, [{QId,PV} | PVs]} end, {Frame0, Anon1, []}, GeneratorData), {PatternFrame, PatternVars}. - + const_selector(Imported) -> selector(Imported, fun is_const/2). @@ -1578,7 +1581,7 @@ no_const_selector(Imported) -> selector(Imported, TestFun) -> fun(_Frame) -> - fun(Value) -> + fun(Value) -> case TestFun(Value, Imported) of true -> {yes, Value}; @@ -1598,7 +1601,7 @@ bind_no_const(Value, Imported) -> %% Tuple tails are variables, never constants. is_const(Value, Imported) -> - %% is_bindable() has checked that E is normalisable. + %% is_bindable() has checked that E is normalisable. [] =:= ordsets:to_list(ordsets:subtract(qlc:vars(Value), Imported)). is_bindable(Value) -> @@ -1610,7 +1613,7 @@ is_bindable(Value) -> end. pattern(P0, AnonI, Frame0, BindFun, State) -> - P1 = try + P1 = try expand_pattern_records(P0, State) catch _:_ -> P0 % template, records already expanded end, @@ -1672,10 +1675,10 @@ filter(E0, Frames0, BF, State, Imported) -> %% One frame for each path through the and/or expression. %% -%% "A xor B" is equal to "(A and not B) or (not A and B)". -%% Ignoring "not B" and "not A" this is the same as "A or B"; +%% "A xor B" is equal to "(A and not B) or (not A and B)". +%% Ignoring "not B" and "not A" this is the same as "A or B"; %% "xor" can be handled just as "or". -%% +%% %% One must handle filters with care, both when joining and when %% looking up values. The reference is a nested loop: if the filter %% fails for some combination of values, it must fail also when @@ -1708,7 +1711,7 @@ filter1({op, _, Op, L0, R0}, Fs, FS) when Op =:= '=:='; Op =:= '==' -> end, Fs); filter1({op, _, Op, L, R}, Fs, FS) when Op =:= 'and'; Op =:= 'andalso' -> filter1(R, filter1(L, Fs, FS), FS); -filter1({op, _, Op, L, R}, Fs, FS) when Op =:= 'or'; +filter1({op, _, Op, L, R}, Fs, FS) when Op =:= 'or'; Op =:= 'orelse'; Op =:= 'xor' -> filter1(L, Fs, FS) ++ filter1(R, Fs, FS); @@ -1758,7 +1761,7 @@ safe_filter1({atom,_,true}, Fs, _FS) -> safe_filter1(_E, _Fs, _FS) -> []. -%% Substitutions: +%% Substitutions: %% M:F() for {M,F}(); erlang:F() for F(); is_record() for record(). pre_expand({call,Anno1,{atom,Anno2,record},As}) -> pre_expand({call,Anno1,{atom,Anno2,is_record},As}); @@ -1782,16 +1785,16 @@ frames_to_columns(Fs, PatternVars, DerefFun, SelectorFun, Imp, CompOp) -> %% it doesn't matter, but when trying to find joined columns, the %% same variables have to be the representatives in every frame.) SizesVarsL = - [begin + [begin PatVar = {var,anno0(),PV}, - PatternSizes = [pattern_size([F], PatVar, false) || + PatternSizes = [pattern_size([F], PatVar, false) || F <- Fs], MaxPZ = lists:max([0 | PatternSizes -- [undefined]]), Vars = pat_vars(MaxPZ), {PatternId#qid.no, PatVar, PatternSizes, Vars} end || {PatternId, PV} <- PatternVars], BF = fun(_Op, Value) -> is_bindable(Value) end, - Fun = fun({_PatN, PatVar, PatSizes, Vars}, Frames) -> + Fun = fun({_PatN, PatVar, PatSizes, Vars}, Frames) -> [unify('=:=', pat_tuple(Sz, Vars), PatVar, Frame, BF, Imp) || {Sz, Frame} <- lists:zip(PatSizes, Frames)] end, @@ -1848,7 +1851,7 @@ col_ignore(Vs, '==') -> length(Vs) =/= length(lists:usort([element(2, normalise(V)) || V <- Vs])). pattern_sizes(PatternVars, Fs) -> - [{QId#qid.no, Size} || + [{QId#qid.no, Size} || {QId,PV} <- PatternVars, undefined =/= (Size = pattern_size(Fs, {var,anno0(),PV}, true))]. @@ -1964,14 +1967,14 @@ unify(Op, E1, E2, F, _BF, _Imported, Safe) -> try {ok, C1} = normalise(E1), {ok, C2} = normalise(E2), - if + if Op =:= '=:=', C1 =:= C2 -> F; Op =:= '==', C1 == C2 -> F; true -> failed - end + end catch error:_ when Safe -> failed; error:_ when not Safe -> F % ignored end. @@ -1986,7 +1989,7 @@ unify(Op, E1, E2, F, _BF, _Imported, Safe) -> %% to find lookup values for such QLCs at all. That might have been a %% better design decision. --record(bind, {var, value, op}). +-record(bind, {var, value, op}). extend_frame(Op, Var, Value, F, BF, Imported, Safe) -> case var_values(Var, F) of @@ -1997,7 +2000,7 @@ extend_frame(Op, Var, Value, F, BF, Imported, Safe) -> [] -> add_binding(Op, Value, Var, F, BF, Imported, Safe); ValsOps -> - maybe_add_binding(ValsOps, Op, Value, Var, F, + maybe_add_binding(ValsOps, Op, Value, Var, F, BF, Imported, Safe) end; _ -> @@ -2013,7 +2016,7 @@ maybe_add_binding(ValsOps, Op, Var, Value, F0, BF, Imported, Safe) -> failed; F -> case already_bound(Op, Var, Value, F) of - true -> + true -> F; false -> add_binding(Op, Var, Value, F, BF, Imported, Safe) @@ -2048,19 +2051,19 @@ deref_op(_, _) -> %%% Note: usort works; {integer,A,3} does not match {float,A,3.0}. var_values(Var, Frame) -> - [{Value, Op} || + [{Value, Op} || #bind{value = Value, op = Op} <- var_bindings(Var, Frame)]. deref_var(Var, Frame, Imported) -> deref_var(Var, Frame, fun(_DV, _Op) -> true end, Imported). deref_var(Var, Frame, BFun, Imported) -> - lists:usort([ValOp || + lists:usort([ValOp || #bind{value = Value, op = Op} <- var_bindings(Var, Frame), ValOp <- deref_value(Value, Op, Frame, BFun, Imported)]). deref_value(Value, Op, Frame, BFun, Imported) -> - lists:usort([{Val,value_op(ValOp, Op, Imported)} || + lists:usort([{Val,value_op(ValOp, Op, Imported)} || {Val,_Op}=ValOp <- deref(Value, Frame, BFun, Imported)]). add_binding(Op, Var0, Value0, F, BF, Imported, Safe) -> @@ -2098,11 +2101,11 @@ do_swap_var_value({var, _, V1}=Var1, {var, _, V2}=Var2, F, Imported) -> [] -> case swap_vv(Var2, Var1, F) of [] -> - ordsets:is_element(V1, Imported) andalso + ordsets:is_element(V1, Imported) andalso not ordsets:is_element(V2, Imported); _Bs -> true - end; + end; _Bs -> false end; @@ -2136,7 +2139,7 @@ deref_values(E, Frame, Imported) -> deref_values(E, Frame, fun(_DV, _Op) -> true end, Imported). deref_values(E, Frame, BFun, Imported) -> - lists:usort([V || + lists:usort([V || {V, Op} <- deref(E, Frame, BFun, Imported), BFun(V, Op)]). @@ -2145,7 +2148,7 @@ deref(E, F, Imp) -> deref(E, F, BFun, Imp). deref({var, _, _}=V, F, BFun, Imp) -> - DBs = lists:flatmap(fun(B) -> deref_binding(B, F, BFun, Imp) + DBs = lists:flatmap(fun(B) -> deref_binding(B, F, BFun, Imp) end, var_bindings(V, F)), case DBs of [] -> @@ -2154,7 +2157,7 @@ deref({var, _, _}=V, F, BFun, Imp) -> lists:usort(DBs) end; deref(T, F, BFun, Imp) when is_tuple(T) -> - [{list_to_tuple(DL), Op} || + [{list_to_tuple(DL), Op} || {DL, Op} <- deref(tuple_to_list(T), F, BFun, Imp)]; deref(Es, F, BFun, Imp) when is_list(Es) -> L = [deref(C, F, BFun, Imp) || C <- Es], @@ -2170,7 +2173,7 @@ deref_binding(Bind, Frame, BFun, Imp) -> [{Val, Op} || {Val, _Op}=ValOp <- deref(Value, Frame, BFun, Imp), BFun(Val, Op = value_op(ValOp, Op0, Imp))]. - + deref_list(L) -> Op = case lists:usort([Op || {_Val, Op} <- L]) of ['=:='] -> @@ -2223,7 +2226,7 @@ has_int({float,_,F}) when round(F) == F -> has_int(T) when is_tuple(T) -> has_int(tuple_to_list(T)); has_int([E | Es]) -> - has_int(E), + has_int(E), has_int(Es); has_int(_) -> false. @@ -2263,7 +2266,7 @@ cons2list(E) -> % tuple tail (always a variable) %% Returns true if all bindings in F1 also occur in F2. %% Viewing F1 and F2 as sets, the fact that F1 is a subset of F2 iff -%% F1 union F2 is equal to F2 is used. (This should take care of +%% F1 union F2 is equal to F2 is used. (This should take care of %% issues with anonymous variables.) bindings_is_subset(F1, F2, Imported) -> BF = fun(_Op, _Value) -> true end, % don't need any test here @@ -2290,13 +2293,13 @@ try_ms(E, P, Fltr, State) -> Expr = {call,Anno,{remote,Anno,{atom,Anno,ets},{atom,Anno,fun2ms}},[Fun]}, Form = {function,Anno,foo,0,[{clause,Anno,[],[],[Expr]}]}, X = ms_transform:parse_transform(State#state.records ++ [Form], []), - case catch + case catch begin {function,Anno,foo,0,[{clause,Anno,[],[],[MS0]}]} = lists:last(X), MS = erl_parse:normalise(var2const(MS0)), XMS = ets:match_spec_compile(MS), true = ets:is_compiled_ms(XMS), - {ok, MS, MS0} + {ok, MS, MS0} end of {'EXIT', _Reason} -> no; @@ -2313,7 +2316,7 @@ filters_as_one(FilterData) -> end, Filter1, Filters). qual_data(Qualifiers) -> - F = fun(T) -> + F = fun(T) -> [{QId,Q} || {QId,_,_,Q} <- Qualifiers, element(1,Q) =:= T] end, {F(fil), F(gen)}. @@ -2322,7 +2325,7 @@ set_field(Pos, Fs, Data) -> lists:sublist(Fs, Pos-1) ++ [Data] ++ lists:nthtail(Pos, Fs). qdata([{#qid{no = QIdNo},{_QIVs,{{gen,_P,LE,_GV},GoI,SI}}} | QCs], Anno) -> - Init = case LE of + Init = case LE of {join, Op, Q1, Q2, H1, H2, Cs1_0, Cs2_0} -> Cs1 = qcon(Cs1_0), Cs2 = qcon(Cs2_0), @@ -2361,7 +2364,7 @@ qcode(E, QCs, Source, Anno, State) -> {bin, Anno, [{bin_element, Anno, {string, Anno, binary_to_list(Bin)}, default, default}]} - end || {_,C} <- lists:keysort(1, [{qlc:template_state(),E} | + end || {_,C} <- lists:keysort(1, [{qlc:template_state(),E} | qcode(QCs, Source, State)])], {'fun', Anno, {clauses, [{clause, Anno, [], [], [{tuple, Anno, CL}]}]}}. @@ -2417,7 +2420,7 @@ template(E, RL, Fun, Go, AT, Anno, IVs, State) -> %% Extra careful here or arguments will be lifted into a wide fun. F = case split_args([Next | As0], Anno, State) of - {ArgsL, ArgsT} -> + {ArgsL, ArgsT} -> Call = {call,Anno,?V(Fun),ArgsL++[{var,Anno,AT}]}, {block,Anno, [{match,Anno,{var,Anno,AT},ArgsT}, @@ -2449,7 +2452,7 @@ generator(S, QIVs, P, GV, NGV, E, IVs, RL, Fun, Go, GoI, Anno, State) -> CsL = generator_list(P, GV, NGV, As, AsM, AsC, AsD, Fun, Anno, State), CsF = generator_cont(P, GV, NGV, E, As, AsM, AsC, AsD, Fun, Anno, State), [InitC | CsL ++ CsF]. - + generator_init(S, Anno, GV, RL, Fun, Go, GoI, IVs, State) -> As0 = abst_vars([RL, Fun, Go] ++ replace([GV], IVs, '_'), Anno), As = pack_args([?I(S) | As0], Anno, State), @@ -2481,7 +2484,7 @@ generator_cont(P, GV, NGV, E, As0, AsM, AsC, AsD, Fun, Anno, State) -> Cls = [CM, CC, CD, CE], B = {'case',Anno,{call,Anno,?V(GV),[]},Cls}, [{clause,Anno,As,[],[B]}]. - + filter(E, Anno, QIVs, S, RL, Fun, Go, GoI, IVs, State) -> IAs = replace(QIVs, IVs, '_'), As = pack_args([?I(S) | abst_vars([RL, Fun, Go] ++ IAs, Anno)], Anno, State), @@ -2494,17 +2497,17 @@ filter(E, Anno, QIVs, S, RL, Fun, Go, GoI, IVs, State) -> %% comprehension: if a filter looks like a guard test, it returns %% 'false' rather than fails. Body = case is_guard_test(E, State) of - true -> + true -> CT = {clause,Anno,[],[[E]],[{call,Anno,?V(Fun),NAsT}]}, CF = {clause,Anno,[],[[?A(true)]],[{call,Anno,?V(Fun),NAsF}]}, [{'if',Anno,[CT,CF]}]; - false -> + false -> CT = {clause,Anno,[?A(true)],[],[{call,Anno,?V(Fun),NAsT}]}, CF = {clause,Anno,[?A(false)],[],[{call,Anno,?V(Fun),NAsF}]}, [{'case',Anno,E,[CT,CF]}] end, [{clause,Anno,As,[],Body}]. - + pack_args(Args, Anno, State) -> case split_args(Args, Anno, State) of {ArgsL, ArgsT} -> @@ -2514,17 +2517,17 @@ pack_args(Args, Anno, State) -> end. split_args(Args, Anno, State) when length(Args) > State#state.maxargs -> - {lists:sublist(Args, State#state.maxargs-1), + {lists:sublist(Args, State#state.maxargs-1), {tuple,Anno,lists:nthtail(State#state.maxargs-1, Args)}}; split_args(Args, _Anno, _State) -> Args. - + %% Replace every element in IEs that is a member of Es by R, keep all %% other elements as they are. replace(Es, IEs, R) -> [case lists:member(E, Es) of - true -> R; - false -> E + true -> R; + false -> E end || E <- IEs]. is_list_c(V, Anno) -> @@ -2662,7 +2665,7 @@ no_shadows(Forms0, State) -> %% Variables that may shadow other variables are introduced in %% LCs and Funs. Such variables (call them SV, Shadowing %% Variables) are now renamed. Each (new) occurrence in a pattern - %% is assigned an index (integer), unique in the file. + %% is assigned an index (integer), unique in the file. %% %% The state {LastIndex,ActiveVars,UsedVars,AllVars,Singletons,State} %% holds the last index used for each SV (LastIndex), the SVs in @@ -2728,7 +2731,7 @@ nos({lc,Anno,E0,Qs0}, S) -> {LE, _} = nos(LE0, QS0), {P, QS} = nos_pattern(P0, QS0), {{T,GAnno,P,LE}, QS}; - (Filter, QS) -> + (Filter, QS) -> nos(Filter, QS) end, {Qs, S1} = lists:mapfoldl(F, S, Qs0), @@ -2757,12 +2760,12 @@ nos_pattern([P0 | Ps0], S0, PVs0) -> {Ps, S, PVs} = nos_pattern(Ps0, S1, PVs1), {[P | Ps], S, PVs}; nos_pattern({var,Anno,V}, {LI,Vs0,UV,A,Sg,State}, PVs0) when V =/= '_' -> - {Name, Vs, PVs} = + {Name, Vs, PVs} = case lists:keyfind(V, 1, PVs0) of {V, VN} -> - _ = used_var(V, Vs0, UV), + _ = used_var(V, Vs0, UV), {VN, Vs0, PVs0}; - false -> + false -> {VN, Vs1} = next_var(V, Vs0, A, LI, UV), N = case lists:member(VN, Sg) of true -> '_'; @@ -2826,7 +2829,7 @@ undo_no_shadows1({var, Anno, _}=Var, State) -> Var end. -%% QLC identifier. +%% QLC identifier. %% The first one encountered in the file has No=1. make_lcid(Anno, No) when is_integer(No), No > 0 -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 22a335c73992..775fcf5219d7 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -441,12 +441,12 @@ escape_quotes([], Acc) -> % because we've been prepending for efficiency reasons. lists:reverse(Acc); -escape_quotes([$\\, $\" | Rest], Acc) -> +escape_quotes([$\\, $\" | Rest], Acc) -> % If we find an escaped quote (\"), % we escape the backslash and the quote (\\\") and continue. escape_quotes(Rest, [$\", $\\, $\\, $\\ | Acc]); -escape_quotes([$\" | Rest], Acc) -> +escape_quotes([$\" | Rest], Acc) -> % If we find a quote ("), % we escape it (\\") and continue. escape_quotes(Rest, [$\", $\\ | Acc]); @@ -642,10 +642,16 @@ expand_fields([], _C) -> []. expand_quals([{generate,A,P,E}|Qs], C) -> [{generate,A,P,expand_expr(E, C)}|expand_quals(Qs, C)]; +expand_quals([{generate_strict,A,P,E}|Qs], C) -> + [{generate_strict,A,P,expand_expr(E, C)}|expand_quals(Qs, C)]; expand_quals([{b_generate,A,P,E}|Qs], C) -> [{b_generate,A,P,expand_expr(E, C)}|expand_quals(Qs, C)]; +expand_quals([{b_generate_strict,A,P,E}|Qs], C) -> + [{b_generate_strict,A,P,expand_expr(E, C)}|expand_quals(Qs, C)]; expand_quals([{m_generate,A,P,E}|Qs], C) -> [{m_generate,A,P,expand_expr(E, C)}|expand_quals(Qs, C)]; +expand_quals([{m_generate_strict,A,P,E}|Qs], C) -> + [{m_generate_strict,A,P,expand_expr(E, C)}|expand_quals(Qs, C)]; expand_quals([E|Qs], C) -> [expand_expr(E, C)|expand_quals(Qs, C)]; expand_quals([], _C) -> []. @@ -2075,7 +2081,7 @@ expressions submitted to the shell prettier. String2 :: string(). erl_pp_format_func(String) -> %% A simple pretty printer function of shell expressions. - %% + %% %% Comments will be filtered. %% If you add return_comments to the option list, %% parsing will fail, and we will end up with the original string. diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 2478d98b7516..779ccad43726 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -164,7 +164,7 @@ docs: # ---------------------------------------------------- # Release Target -# ---------------------------------------------------- +# ---------------------------------------------------- include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index e28dd788bb9b..164ea2a8196e 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1,8 +1,8 @@ %% %% %CopyrightBegin% -%% +%% %% Copyright Ericsson AB 1998-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 @@ -14,11 +14,11 @@ %% 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(erl_eval_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_testcase/2, end_per_testcase/2, init_per_group/2,end_per_group/2]). @@ -56,7 +56,8 @@ otp_16865/1, eep49/1, binary_and_map_aliases/1, - eep58/1]). + eep58/1, + strict_generators/1]). %% %% Define to run outside of test server @@ -65,7 +66,7 @@ -import(lists,[concat/1, sort/1]). --export([count_down/2, count_down_fun/0, do_apply/2, +-export([count_down/2, count_down_fun/0, do_apply/2, local_func/3, local_func_value/2]). -export([simple/0]). @@ -89,7 +90,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,1}}]. -all() -> +all() -> [guard_1, guard_2, match_pattern, string_plusplus, pattern_expr, match_bin, guard_3, guard_4, guard_5, lc, simple_cases, unary_plus, apply_atom, otp_5269, @@ -97,9 +98,9 @@ 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, strict_generators]. -groups() -> +groups() -> []. init_per_suite(Config) -> @@ -384,7 +385,7 @@ simple_cases(Config) when is_list(Config) -> (X) when X == 2 -> zwei end, ett = F(1), zwei = F(2) end, "begin F = fun(X) when X == 1 -> ett; - (X) when X == 2 -> zwei end, + (X) when X == 2 -> zwei end, ett = F(1), zwei = F(2) end.", zwei), error_check("begin F = fun(1) -> ett end, zwei = F(2) end.", @@ -515,7 +516,7 @@ unary_plus(Config) when is_list(Config) -> %% OTP-5064. Can no longer apply atoms. apply_atom(Config) when is_list(Config) -> error_check("[X || X <- [[1],[2]], - begin L = length, L(X) =:= 1 end].", + begin L = length, L(X) =:= 1 end].", {badfun,length}), ok. @@ -525,7 +526,7 @@ otp_5269(Config) when is_list(Config) -> F = fun(<>) -> B end, F(<<16:8, 7:16>>) end, - "begin + "begin L = 8, F = fun(<>) -> B end, F(<<16:8, 7:16>>) end.", 7), @@ -533,7 +534,7 @@ otp_5269(Config) when is_list(Config) -> F = fun(<>) -> B end, F(<<16:8, 7:16>>) end, - "begin + "begin L = 8, F = fun(<>) -> B end, F(<<16:8, 7:16>>) end.", 7), @@ -542,7 +543,7 @@ otp_5269(Config) when is_list(Config) -> 7), error_check("begin L = 8, <> = <<16:8, 7:16>> end.", {badmatch,<<16:8,7:16>>}), - + error_check("begin <> = <<16:16,8:16>>, L end.", {badmatch, <<16:16,8:16>>}), check(fun() -> U = 8, (fun(<>) -> U end)(<<32:8>>) end, @@ -577,18 +578,18 @@ otp_5269(Config) when is_list(Config) -> %% OTP-6539. try/catch bugs. otp_6539(Config) when is_list(Config) -> check(fun() -> - F = fun(A,B) -> - try A+B - catch _:_ -> dontthinkso - end + F = fun(A,B) -> + try A+B + catch _:_ -> dontthinkso + end end, lists:zipwith(F, [1,2], [2,3]) end, - "begin - F = fun(A,B) -> - try A+B - catch _:_ -> dontthinkso - end + "begin + F = fun(A,B) -> + try A+B + catch _:_ -> dontthinkso + end end, lists:zipwith(F, [1,2], [2,3]) end.", @@ -613,10 +614,10 @@ otp_6543(Config) when is_list(Config) -> "<< <> || <> <= <<\"hej\">> >>.", <<1,2,2,0,1,2,1,1,1,2,2,2>>), check(fun() -> - << <> || + << <> || <<65,X:4>> <= <<65,7:4,65,3:4,66,8:4>> >> end, - "<< <> || + "<< <> || <<65,X:4>> <= <<65,7:4,65,3:4,66,8:4>> >>.", <<7,3>>), check(fun() -> <<34:18/big>> end, @@ -690,61 +691,61 @@ otp_6543(Config) when is_list(Config) -> 34), check(fun() -> <> = <<34:18/little-signed>>, X end, - "begin <> = <<34:18/little-signed>>, + "begin <> = <<34:18/little-signed>>, X end.", 34), check(fun() -> <> = <<34:18/native-signed>>, X end, - "begin <> = <<34:18/native-signed>>, + "begin <> = <<34:18/native-signed>>, X end.", 34), check(fun() -> <> = <<34:18/big-unsigned>>, X end, - "begin <> = <<34:18/big-unsigned>>, + "begin <> = <<34:18/big-unsigned>>, X end.", 34), check(fun() -> - <> = <<34:18/little-unsigned>>, + <> = <<34:18/little-unsigned>>, X end, - "begin <> = <<34:18/little-unsigned>>, + "begin <> = <<34:18/little-unsigned>>, X end.", 34), check(fun() -> - <> = <<34:18/native-unsigned>>, + <> = <<34:18/native-unsigned>>, X end, - "begin <> = <<34:18/native-unsigned>>, + "begin <> = <<34:18/native-unsigned>>, X end.", 34), check(fun() -> <> = <<2.0:32/float-big>>, X end, - "begin <> = <<2.0:32/float-big>>, + "begin <> = <<2.0:32/float-big>>, X end.", 2.0), check(fun() -> <> = <<2.0:32/float-little>>, X end, - "begin <> = <<2.0:32/float-little>>, + "begin <> = <<2.0:32/float-little>>, X end.", 2.0), check(fun() -> <> = <<2.0:32/float-native>>, X end, - "begin <> = <<2.0:32/float-native>>, + "begin <> = <<2.0:32/float-native>>, X end.", 2.0), check( - fun() -> + fun() -> [X || <<"hej",X:8>> <= <<"hej",8,"san",9,"hej",17,"hej">>] end, - "[X || <<\"hej\",X:8>> <= + "[X || <<\"hej\",X:8>> <= <<\"hej\",8,\"san\",9,\"hej\",17,\"hej\">>].", [8,17]), check( fun() -> L = 8, << <> || <> <= <<16:8, 7:16>> >> end, - "begin L = 8, << <> || <> <= <<16:8, 7:16>> >> + "begin L = 8, << <> || <> <= <<16:8, 7:16>> >> end.", <<0,0,0,7>>), - %% Test the Value part of a binary segment. + %% Test the Value part of a binary segment. %% "Old" bugs have been fixed (partial_eval is called on Value). check(fun() -> [ 3 || <<17/float>> <= <<17.0/float>>] end, "[ 3 || <<17/float>> <= <<17.0/float>>].", @@ -771,28 +772,28 @@ otp_6543(Config) when is_list(Config) -> check(fun() -> [ foo || <<(1 bsl 1024)/float>> <- [<<(1 bsl 1023)/float>>]] end, - "[ foo || <<(1 bsl 1024)/float>> <- + "[ foo || <<(1 bsl 1024)/float>> <- [<<(1 bsl 1023)/float>>]].", []), check(fun() -> [ foo || <<(1 bsl 1024)/float>> <= <<(1 bsl 1023)/float>>] end, - "[ foo || <<(1 bsl 1024)/float>> <= + "[ foo || <<(1 bsl 1024)/float>> <= <<(1 bsl 1023)/float>>].", []), check(fun() -> - L = 8, + L = 8, [{L,B} || <> <= <<32:8,7:32/float>>] end, - "begin L = 8, + "begin L = 8, [{L,B} || <> <= <<32:8,7:32/float>>] end.", [{32,7.0}]), check(fun() -> - L = 8, + L = 8, [{L,B} || <> <- [<<32:8,7:32/float>>]] end, - "begin L = 8, + "begin L = 8, [{L,B} || <> <- [<<32:8,7:32/float>>]] end.", [{32,7.0}]), @@ -908,47 +909,47 @@ otp_7550(Config) when is_list(Config) -> otp_8133(Config) when is_list(Config) -> check( fun() -> - E = fun(N) -> - if - is_integer(N) -> <>; - true -> throw(foo) - end + E = fun(N) -> + if + is_integer(N) -> <>; + true -> throw(foo) + end end, - try << << (E(V))/binary >> || V <- [1,2,3,a] >> + try << << (E(V))/binary >> || V <- [1,2,3,a] >> catch foo -> ok end end, "begin - E = fun(N) -> - if is_integer(N) -> <>; - true -> throw(foo) - end + E = fun(N) -> + if is_integer(N) -> <>; + true -> throw(foo) + end end, - try << << (E(V))/binary >> || V <- [1,2,3,a] >> + try << << (E(V))/binary >> || V <- [1,2,3,a] >> catch foo -> ok end end.", ok), check( fun() -> - E = fun(N) -> - if - is_integer(N) -> <>; + E = fun(N) -> + if + is_integer(N) -> <>; - true -> erlang:error(foo) - end + true -> erlang:error(foo) + end end, - try << << (E(V))/binary >> || V <- [1,2,3,a] >> + try << << (E(V))/binary >> || V <- [1,2,3,a] >> catch error:foo -> ok end end, "begin - E = fun(N) -> - if is_integer(N) -> <>; - true -> erlang:error(foo) - end + E = fun(N) -> + if is_integer(N) -> <>; + true -> erlang:error(foo) + end end, - try << << (E(V))/binary >> || V <- [1,2,3,a] >> + try << << (E(V))/binary >> || V <- [1,2,3,a] >> catch error:foo -> ok end end.", @@ -1092,13 +1093,13 @@ otp_14826(_Config) -> ?MODULE]), backtrace_check("[A || A <- a].", {bad_generator, a}, - [{erl_eval,eval_generate,8}, {erl_eval, eval_lc, 7}]), + [{erl_eval,eval_generate,9}, {erl_eval, eval_lc, 7}]), backtrace_check("<< <> || <> <= a>>.", {bad_generator, a}, - [{erl_eval,eval_b_generate,8}, {erl_eval, eval_bc, 7}]), + [{erl_eval,eval_b_generate,9}, {erl_eval, eval_bc, 7}]), backtrace_check("[A || A <- [1], begin a end].", {bad_filter, a}, - [{erl_eval,eval_filter,7}, {erl_eval, eval_generate, 8}]), + [{erl_eval,eval_filter,7}, {erl_eval, eval_generate, 9}]), fun() -> {'EXIT', {{badarity, {_Fun, []}}, BT}} = (catch parse_and_run("fun(A) -> A end().")), @@ -1396,7 +1397,7 @@ many_args(N) -> [many_args1(I) || I <- lists:seq(1, N)]. many_args1(N) -> - F = fun(L, P) -> + F = fun(L, P) -> tl(lists:flatten([","++P++integer_to_list(E) || E <- L])) end, L = lists:seq(1, N), @@ -1414,16 +1415,16 @@ do_funs(LFH, EFH) -> M = atom_to_list(?MODULE), check(fun() -> F1 = fun(F,N) -> ?MODULE:count_down(F, N) end, F1(F1, 1000) end, - concat(["begin F1 = fun(F,N) -> ", M, + concat(["begin F1 = fun(F,N) -> ", M, ":count_down(F, N) end, F1(F1,1000) end."]), 0, ['F1'], LFH, EFH), check(fun() -> F1 = fun(F,N) -> apply(?MODULE,count_down,[F,N]) end, F1(F1, 1000) end, - concat(["begin F1 = fun(F,N) -> apply(", M, + concat(["begin F1 = fun(F,N) -> apply(", M, ",count_down,[F, N]) end, F1(F1,1000) end."]), 0, ['F1'], LFH, EFH), check(fun() -> F = fun(F,N) when N > 0 -> apply(F,[F,N-1]); - (_F,0) -> ok end, + (_F,0) -> ok end, F(F, 1000) end, "begin F = fun(F,N) when N > 0 -> apply(F,[F,N-1]);" @@ -1432,7 +1433,7 @@ do_funs(LFH, EFH) -> ok, ['F'], LFH, EFH), check(fun() -> F = fun(F,N) when N > 0 -> apply(erlang,apply,[F,[F,N-1]]); - (_F,0) -> ok end, + (_F,0) -> ok end, F(F, 1000) end, "begin F = fun(F,N) when N > 0 ->" @@ -1451,7 +1452,7 @@ do_funs(LFH, EFH) -> check(fun() -> F = fun(X) -> A = 1+X, {X,A} end, true = {2,3} == F(2) end, - "begin F = fun(X) -> A = 1+X, {X,A} end, + "begin F = fun(X) -> A = 1+X, {X,A} end, true = {2,3} == F(2) end.", true, ['F'], LFH, EFH), check(fun() -> F = fun(X) -> erlang:'+'(X,2) end, true = 3 == F(1) end, @@ -1459,7 +1460,7 @@ do_funs(LFH, EFH) -> " true = 3 == F(1) end.", true, ['F'], LFH, EFH), check(fun() -> F = fun(X) -> byte_size(X) end, - ?MODULE:do_apply(F,<<"hej">>) end, + ?MODULE:do_apply(F,<<"hej">>) end, concat(["begin F = fun(X) -> size(X) end,", M,":do_apply(F,<<\"hej\">>) end."]), 3, ['F'], LFH, EFH), @@ -1468,22 +1469,22 @@ do_funs(LFH, EFH) -> Z = 5, F2 = fun(X, Y) -> F1(Z,{X,Y}) end, F3 = fun(X, Y) -> {a,F1(Z,{X,Y})} end, - {5,{x,y}} = F2(x,y), - {a,{5,{y,x}}} = F3(y,x), - {5,{5,y}} = F2(Z,y), + {5,{x,y}} = F2(x,y), + {a,{5,{y,x}}} = F3(y,x), + {5,{5,y}} = F2(Z,y), true = {5,{x,5}} == F2(x,Z) end, "begin F1 = fun(X, Z) -> {X,Z} end, Z = 5, F2 = fun(X, Y) -> F1(Z,{X,Y}) end, F3 = fun(X, Y) -> {a,F1(Z,{X,Y})} end, - {5,{x,y}} = F2(x,y), - {a,{5,{y,x}}} = F3(y,x), - {5,{5,y}} = F2(Z,y), + {5,{x,y}} = F2(x,y), + {a,{5,{y,x}}} = F3(y,x), + {5,{5,y}} = F2(Z,y), true = {5,{x,5}} == F2(x,Z) end.", true, ['F1','Z','F2','F3'], LFH, EFH), check(fun() -> F = fun(X) -> byte_size(X) end, F2 = fun(Y) -> F(Y) end, - ?MODULE:do_apply(F2,<<"hej">>) end, + ?MODULE:do_apply(F2,<<"hej">>) end, concat(["begin F = fun(X) -> size(X) end,", "F2 = fun(Y) -> F(Y) end,", M,":do_apply(F2,<<\"hej\">>) end."]), @@ -1498,11 +1499,11 @@ do_funs(LFH, EFH) -> {1,1} = F2(1), Z = 7, Z end, "begin F = fun(Z) -> Z end, F2 = fun(X) -> F(X), Z = {X,X}, Z end, - {1,1} = F2(1), Z = 7, Z end.", 7, ['F','F2','Z'], + {1,1} = F2(1), Z = 7, Z end.", 7, ['F','F2','Z'], LFH, EFH), check(fun() -> F = fun(F, N) -> [?MODULE:count_down(F,N) || X <-[1]] end, F(F,2) end, - concat(["begin F = fun(F, N) -> [", M, + concat(["begin F = fun(F, N) -> [", M, ":count_down(F,N) || X <-[1]] end, F(F,2) end."]), [[[0]]], ['F'], LFH, EFH), ok. @@ -1636,7 +1637,7 @@ try_catch(Config) when is_list(Config) -> {badmatch,2}), %% Uncaught exception with after check(fun () -> {'EXIT',{{badmatch,2},_}} = - begin catch try 1=2 + begin catch try 1=2 after put(try_catch, 3) end end, get(try_catch) end, "begin {'EXIT',{{badmatch,2},_}} = " @@ -2030,12 +2031,95 @@ eep58(Config) when is_list(Config) -> ok. +strict_generators(Config) when is_list(Config) -> + %% Basic scenario for each comprehension and generator type + check(fun() -> [X+1 || X <:- [1,2,3]] end, + "[X+1 || X <:- [1,2,3]].", + [2,3,4]), + check(fun() -> [X+1 || <> <:= <<1,2,3>>] end, + "[X+1 || <> <:= <<1,2,3>>].", + [2,3,4]), + check(fun() -> [X*Y || X := Y <:- #{1 => 2, 3 => 4}] end, + "[X*Y || X := Y <:- #{1 => 2, 3 => 4}].", + [2,12]), + check(fun() -> << <<(X+1)>> || X <:- [1,2,3]>> end, + "<< <<(X+1)>> || X <:- [1,2,3]>>.", + <<2,3,4>>), + check(fun() -> << <<(X+1)>> || <> <:= <<1,2,3>> >> end, + "<< <<(X+1)>> || <> <:= <<1,2,3>> >>.", + <<2,3,4>>), + check(fun() -> << <<(X*Y)>> || X := Y <:- #{1 => 2, 3 => 4} >> end, + "<< <<(X*Y)>> || X := Y <:- #{1 => 2, 3 => 4} >>.", + <<2,12>>), + check(fun() -> #{X => X+1 || X <:- [1,2,3]} end, + "#{X => X+1 || X <:- [1,2,3]}.", + #{1 => 2, 2 => 3, 3 => 4}), + check(fun() -> #{X => X+1 || <> <:= <<1,2,3>>} end, + "#{X => X+1 || <> <:= <<1,2,3>>}.", + #{1 => 2, 2 => 3, 3 => 4}), + check(fun() -> #{X+1 => Y*2 || X := Y <:- #{1 => 2, 3 => 4}} end, + "#{X+1 => Y*2 || X := Y <:- #{1 => 2, 3 => 4}}.", + #{2 => 4, 4 => 8}), + %% A failing guard following a strict generator is ok + check(fun() -> [X+1 || X <:- [1,2,3], X > 1] end, + "[X+1 || X <:- [1,2,3], X > 1].", + [3,4]), + check(fun() -> [X+1 || <> <:= <<1,2,3>>, X > 1] end, + "[X+1 || <> <:= <<1,2,3>>, X > 1].", + [3,4]), + check(fun() -> [X*Y || X := Y <:- #{1 => 2, 3 => 4}, X > 1] end, + "[X*Y || X := Y <:- #{1 => 2, 3 => 4}, X > 1].", + [12]), + check(fun() -> << <<(X+1)>> || X <:- [1,2,3], X > 1>> end, + "<< <<(X+1)>> || X <:- [1,2,3], X > 1>>.", + <<3,4>>), + check(fun() -> << <<(X+1)>> || <> <:= <<1,2,3>>, X > 1 >> end, + "<< <<(X+1)>> || <> <:= <<1,2,3>>, X > 1 >>.", + <<3,4>>), + check(fun() -> << <<(X*Y)>> || X := Y <:- #{1 => 2, 3 => 4}, X > 1 >> end, + "<< <<(X*Y)>> || X := Y <:- #{1 => 2, 3 => 4}, X > 1 >>.", + <<12>>), + check(fun() -> #{X => X+1 || X <:- [1,2,3], X > 1} end, + "#{X => X+1 || X <:- [1,2,3], X > 1}.", + #{2 => 3, 3 => 4}), + check(fun() -> #{X => X+1 || <> <:= <<1,2,3>>, X > 1} end, + "#{X => X+1 || <> <:= <<1,2,3>>, X > 1}.", + #{2 => 3, 3 => 4}), + check(fun() -> #{X+1 => Y*2 || X := Y <:- #{1 => 2, 3 => 4}, X > 1} end, + "#{X+1 => Y*2 || X := Y <:- #{1 => 2, 3 => 4}, X > 1}.", + #{4 => 8}), + %% Non-matching elements cause a badmatch error + error_check("[X || {ok, X} <:- [{ok,1},2,{ok,3}]].", + {badmatch,2}), + error_check("[X || <<0:1, X:7>> <:= <<1,128,2>>].", + {badmatch,<<128,2>>}), + error_check("[X || X := ok <:- #{1 => ok, 2 => error, 3 => ok}].", + {badmatch,{2,error}}), + error_check("<< <> || {ok, X} <:- [{ok,1},2,{ok,3}] >>.", + {badmatch,2}), + error_check("<< <> || <<0:1, X:7>> <:= <<1,128,2>> >>.", + {badmatch,<<128,2>>}), + error_check("<< <> || X := ok <:- #{1 => ok, 2 => error, 3 => ok} >>.", + {badmatch,{2,error}}), + error_check("#{X => X+1 || {ok, X} <:- [{ok,1},2,{ok,3}]}.", + {badmatch,2}), + error_check("#{X => X+1 || <<0:1, X:7>> <:= <<1,128,2>>}.", + {badmatch,<<128,2>>}), + error_check("#{X => X+1 || X := ok <:- #{1 => ok, 2 => error, 3 => ok}}.", + {badmatch,{2,error}}), + %% Binary generators don't allow unused bits at the end either + error_check("[X || <> <:= <<0>>].", + {badmatch,<<0:2>>}), + error_check("[Y || <> <:= <<8,1,9,2>>].", + {badmatch,<<9,2>>}), + ok. + %% Check the string in different contexts: as is; in fun; from compiled code. check(F, String, Result) -> check1(F, String, Result), FunString = concat(["fun() -> ", no_final_dot(String), " end(). "]), check1(F, FunString, Result), - CompileString = concat(["hd(lists:map(fun(_) -> ", no_final_dot(String), + CompileString = concat(["hd(lists:map(fun(_) -> ", no_final_dot(String), " end, [foo])). "]), check1(F, CompileString, Result). diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 771ffe19a00b..656e33ea2008 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -57,11 +57,11 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,20}}]. -all() -> +all() -> [{group, error}, iso88591, otp_7810, otp_10302, otp_10990, otp_10992, otp_11807, otp_16480, otp_17024, text_fun, triple_quoted_string]. -groups() -> +groups() -> [{error, [], [error_1, error_2]}]. init_per_suite(Config) -> @@ -223,7 +223,7 @@ punctuations() -> Ts = [{W,{1,1}}], test_string(S, Ts) end || S <- L], - Three = ["/=:=", "<=:=", "==:=", ">=:="], % three tokens... + Three = ["/=:=", "<:=", "==:=", ">=:="], % three tokens... No = Three ++ L, SL0 = [{S1++S2,{-length(S1),S1,S2}} || S1 <- L, diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl index ff01d0f4e60a..bcb9982f3164 100644 --- a/lib/syntax_tools/src/erl_prettypr.erl +++ b/lib/syntax_tools/src/erl_prettypr.erl @@ -423,22 +423,22 @@ add_comment_prefix(S) -> lay_2(Node, Ctxt) -> case erl_syntax:type(Node) of %% We list literals and other common cases first. - + variable -> text(erl_syntax:variable_literal(Node)); - + atom -> text(erl_syntax:atom_literal(Node, Ctxt#ctxt.encoding)); - + integer -> text(erl_syntax:integer_literal(Node)); float -> text(tidy_float(erl_syntax:float_literal(Node))); - + char -> text(erl_syntax:char_literal(Node, Ctxt#ctxt.encoding)); - + string -> lay_string(erl_syntax:string_literal(Node, Ctxt#ctxt.encoding), Ctxt); @@ -452,7 +452,7 @@ lay_2(Node, Ctxt) -> beside(floating(text("{")), beside(sep(Es), floating(text("}")))); - + list -> Ctxt1 = reset_prec(Ctxt), Node1 = erl_syntax:compact_list(Node), @@ -473,7 +473,7 @@ lay_2(Node, Ctxt) -> operator -> floating(text(erl_syntax:operator_literal(Node))); - + infix_expr -> Operator = erl_syntax:infix_expr_operator(Node), {PrecL, Prec, PrecR} = @@ -491,7 +491,7 @@ lay_2(Node, Ctxt) -> set_prec(Ctxt, PrecR)), D4 = par([D1, D2, D3], Ctxt#ctxt.break_indent), maybe_parentheses(D4, Prec, Ctxt); - + prefix_expr -> Operator = erl_syntax:prefix_expr_operator(Node), {{Prec, PrecR}, Name} = @@ -514,7 +514,7 @@ lay_2(Node, Ctxt) -> par([D1, D2], Ctxt#ctxt.break_indent) end, maybe_parentheses(D3, Prec, Ctxt); - + application -> {PrecL, Prec} = func_prec(), D = lay(erl_syntax:application_operator(Node), @@ -526,7 +526,7 @@ lay_2(Node, Ctxt) -> beside(sep(As), floating(text(")"))))), maybe_parentheses(D1, Prec, Ctxt); - + match_expr -> {PrecL, Prec, PrecR} = inop_prec('='), D1 = lay(erl_syntax:match_expr_pattern(Node), @@ -593,7 +593,7 @@ lay_2(Node, Ctxt) -> Ctxt1#ctxt.break_indent), nest(Ctxt1#ctxt.break_indent, D2), text("end")]); - + if_expr -> Ctxt1 = reset_prec(Ctxt), D = lay_clauses(erl_syntax:if_expr_clauses(Node), @@ -814,7 +814,7 @@ lay_2(Node, Ctxt) -> eof_marker -> empty(); - + form_list -> Es = seq(erl_syntax:form_list_elements(Node), none, reset_prec(Ctxt), fun lay/2), @@ -826,18 +826,36 @@ lay_2(Node, Ctxt) -> D2 = lay(erl_syntax:generator_body(Node), Ctxt1), par([D1, beside(text("<- "), D2)], Ctxt1#ctxt.break_indent); + strict_generator -> + Ctxt1 = reset_prec(Ctxt), + D1 = lay(erl_syntax:strict_generator_pattern(Node), Ctxt1), + D2 = lay(erl_syntax:strict_generator_body(Node), Ctxt1), + par([D1, beside(text("<:- "), D2)], Ctxt1#ctxt.break_indent); + binary_generator -> Ctxt1 = reset_prec(Ctxt), D1 = lay(erl_syntax:binary_generator_pattern(Node), Ctxt1), D2 = lay(erl_syntax:binary_generator_body(Node), Ctxt1), par([D1, beside(text("<= "), D2)], Ctxt1#ctxt.break_indent); + strict_binary_generator -> + Ctxt1 = reset_prec(Ctxt), + D1 = lay(erl_syntax:strict_binary_generator_pattern(Node), Ctxt1), + D2 = lay(erl_syntax:strict_binary_generator_body(Node), Ctxt1), + par([D1, beside(text("<:= "), D2)], Ctxt1#ctxt.break_indent); + map_generator -> Ctxt1 = reset_prec(Ctxt), D1 = lay(erl_syntax:map_generator_pattern(Node), Ctxt1), D2 = lay(erl_syntax:map_generator_body(Node), Ctxt1), par([D1, beside(text("<- "), D2)], Ctxt1#ctxt.break_indent); + strict_map_generator -> + Ctxt1 = reset_prec(Ctxt), + D1 = lay(erl_syntax:strict_map_generator_pattern(Node), Ctxt1), + D2 = lay(erl_syntax:strict_map_generator_body(Node), Ctxt1), + par([D1, beside(text("<:- "), D2)], Ctxt1#ctxt.break_indent); + implicit_fun -> D = lay(erl_syntax:implicit_fun_name(Node), reset_prec(Ctxt)), @@ -933,7 +951,7 @@ lay_2(Node, Ctxt) -> maybe_parentheses(beside(D1, D3), Prec, Ctxt); record_expr -> - {PrecL, Prec, _} = inop_prec('#'), + {PrecL, Prec, _} = inop_prec('#'), Ctxt1 = reset_prec(Ctxt), D1 = lay(erl_syntax:record_expr_type(Node), Ctxt1), D2 = par(seq(erl_syntax:record_expr_fields(Node), @@ -949,7 +967,7 @@ lay_2(Node, Ctxt) -> beside(lay(A, set_prec(Ctxt, PrecL)), D3) end, maybe_parentheses(D4, Prec, Ctxt); - + record_field -> Ctxt1 = reset_prec(Ctxt), D1 = lay(erl_syntax:record_field_name(Node), Ctxt1), @@ -962,7 +980,7 @@ lay_2(Node, Ctxt) -> end; record_index_expr -> - {Prec, PrecR} = preop_prec('#'), + {Prec, PrecR} = preop_prec('#'), D1 = lay(erl_syntax:record_index_expr_type(Node), reset_prec(Ctxt)), D2 = lay(erl_syntax:record_index_expr_field(Node), @@ -1342,7 +1360,7 @@ split_string_2([$x, ${ | Xs], N, L, As) -> split_string_2([X1, X2, X3 | Xs], N, L, As) when X1 >= $0, X1 =< $7, X2 >= $0, X2 =< $7, X3 >= $0, X3 =< $7 -> split_string_1(Xs, N - 3, L - 3, [X3, X2, X1 | As]); -split_string_2([X1, X2 | Xs], N, L, As) when +split_string_2([X1, X2 | Xs], N, L, As) when X1 >= $0, X1 =< $7, X2 >= $0, X2 =< $7 -> split_string_1(Xs, N - 2, L - 2, [X2, X1 | As]); split_string_2([X | Xs], N, L, As) -> diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 84605345dfc4..82ca6a8e9e8f 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -269,6 +269,15 @@ trees. named_fun_expr_clauses/1, named_fun_expr_name/1, nil/0, + strict_binary_generator/2, + strict_binary_generator_body/1, + strict_binary_generator_pattern/1, + strict_generator/2, + strict_generator_body/1, + strict_generator_pattern/1, + strict_map_generator/2, + strict_map_generator_body/1, + strict_map_generator_pattern/1, operator/1, operator_literal/1, operator_name/1, @@ -621,8 +630,11 @@ type(Node) -> {cons, _, _, _} -> list; {function, _, _, _, _} -> function; {b_generate, _, _, _} -> binary_generator; + {b_generate_strict, _, _, _} -> strict_binary_generator; {generate, _, _, _} -> generator; + {generate_strict, _, _, _} -> strict_generator; {m_generate, _, _, _} -> map_generator; + {m_generate_strict, _, _, _} -> strict_map_generator; {lc, _, _, _} -> list_comp; {bc, _, _, _} -> binary_comp; {mc, _, _, _} -> map_comp; @@ -5836,6 +5848,68 @@ generator_body(Node) -> end. +%% ===================================================================== + +-record(strict_generator, {pattern :: syntaxTree(), body :: syntaxTree()}). + +-doc """ +Creates an abstract strict list generator. + +The result represents "`*Pattern*<:- *Body*`". + +_See also: _`binary_comp/2`, `strict_generator_body/1`, +`strict_generator_pattern/1`, `list_comp/2`. +""". +-spec strict_generator(syntaxTree(), syntaxTree()) -> syntaxTree(). + +%% `erl_parse' representation: +%% +%% {generate_strict, Pos, Pattern, Body} +%% +%% Pattern = Body = erl_parse() + +strict_generator(Pattern, Body) -> + tree(strict_generator, #strict_generator{pattern = Pattern, body = Body}). + +revert_strict_generator(Node) -> + Pos = get_pos(Node), + Pattern = strict_generator_pattern(Node), + Body = strict_generator_body(Node), + {generate_strict, Pos, Pattern, Body}. + + +-doc """ +Returns the pattern subtree of a `generator` node. + +_See also: _`strict_generator/2`. +""". +-spec strict_generator_pattern(syntaxTree()) -> syntaxTree(). + +strict_generator_pattern(Node) -> + case unwrap(Node) of + {generate_strict, _, Pattern, _} -> + Pattern; + Node1 -> + (data(Node1))#strict_generator.pattern + end. + + +-doc """ +Returns the body subtree of a `generator` node. + +_See also: _`strict_generator/2`. +""". +-spec strict_generator_body(syntaxTree()) -> syntaxTree(). + +strict_generator_body(Node) -> + case unwrap(Node) of + {generate_strict, _, _, Body} -> + Body; + Node1 -> + (data(Node1))#strict_generator.body + end. + + %% ===================================================================== -record(binary_generator, {pattern :: syntaxTree(), body :: syntaxTree()}). @@ -5898,6 +5972,68 @@ binary_generator_body(Node) -> end. +%% ===================================================================== + +-record(strict_binary_generator, {pattern :: syntaxTree(), body :: syntaxTree()}). + +-doc """ +Creates an abstract strict binary_generator. + +The result represents "`*Pattern*<:- *Body*`". + +_See also: _`binary_comp/2`, `strict_binary_generator_body/1`, +`strict_binary_generator_pattern/1`, `list_comp/2`. +""". +-spec strict_binary_generator(syntaxTree(), syntaxTree()) -> syntaxTree(). + +%% `erl_parse' representation: +%% +%% {b_generate_strict, Pos, Pattern, Body} +%% +%% Pattern = Body = erl_parse() + +strict_binary_generator(Pattern, Body) -> + tree(strict_binary_generator, #strict_binary_generator{pattern = Pattern, body = Body}). + +revert_strict_binary_generator(Node) -> + Pos = get_pos(Node), + Pattern = strict_binary_generator_pattern(Node), + Body = strict_binary_generator_body(Node), + {b_generate_strict, Pos, Pattern, Body}. + + +-doc """ +Returns the pattern subtree of a `generator` node. + +_See also: _`strict_binary_generator/2`. +""". +-spec strict_binary_generator_pattern(syntaxTree()) -> syntaxTree(). + +strict_binary_generator_pattern(Node) -> + case unwrap(Node) of + {b_generate_strict, _, Pattern, _} -> + Pattern; + Node1 -> + (data(Node1))#strict_binary_generator.pattern + end. + + +-doc """ +Returns the body subtree of a `generator` node. + +_See also: _`strict_binary_generator/2`. +""". +-spec strict_binary_generator_body(syntaxTree()) -> syntaxTree(). + +strict_binary_generator_body(Node) -> + case unwrap(Node) of + {b_generate_strict, _, _, Body} -> + Body; + Node1 -> + (data(Node1))#strict_binary_generator.body + end. + + %% ===================================================================== -record(map_generator, {pattern :: syntaxTree(), body :: syntaxTree()}). @@ -5960,6 +6096,68 @@ map_generator_body(Node) -> end. +%% ===================================================================== + +-record(strict_map_generator, {pattern :: syntaxTree(), body :: syntaxTree()}). + +-doc """ +Creates an abstract strict map_generator. The result represents +"`*Pattern*<- *Body*`". + +_See also: _`list_comp/2`, `map_comp/2`, +`strict_map_generator_body/1`, +`strict_map_generator_pattern/1`. +""". +-spec strict_map_generator(syntaxTree(), syntaxTree()) -> syntaxTree(). + +%% `erl_parse' representation: +%% +%% {m_generate_strict, Pos, Pattern, Body} +%% +%% Pattern = Body = erl_parse() + +strict_map_generator(Pattern, Body) -> + tree(strict_map_generator, #strict_map_generator{pattern = Pattern, body = Body}). + +revert_strict_map_generator(Node) -> + Pos = get_pos(Node), + Pattern = strict_map_generator_pattern(Node), + Body = strict_map_generator_body(Node), + {m_generate_strict, Pos, Pattern, Body}. + + +-doc """ +Returns the pattern subtree of a `generator` node. + +_See also: _`strict_map_generator/2`. +""". +-spec strict_map_generator_pattern(syntaxTree()) -> syntaxTree(). + +strict_map_generator_pattern(Node) -> + case unwrap(Node) of + {m_generate_strict, _, Pattern, _} -> + Pattern; + Node1 -> + (data(Node1))#strict_map_generator.pattern + end. + + +-doc """ +Returns the body subtree of a `generator` node. + +_See also: _`strict_map_generator/2`. +""". +-spec strict_map_generator_body(syntaxTree()) -> syntaxTree(). + +strict_map_generator_body(Node) -> + case unwrap(Node) of + {m_generate_strict, _, _, Body} -> + Body; + Node1 -> + (data(Node1))#strict_map_generator.body + end. + + %% ===================================================================== -doc """ @@ -7337,6 +7535,12 @@ revert_root(Node) -> revert_named_fun_expr(Node); nil -> revert_nil(Node); + strict_binary_generator -> + revert_strict_binary_generator(Node); + strict_generator -> + revert_strict_generator(Node); + strict_map_generator -> + revert_strict_map_generator(Node); parentheses -> revert_parentheses(Node); prefix_expr -> @@ -7655,6 +7859,15 @@ subtrees(T) -> named_fun_expr -> [[named_fun_expr_name(T)], named_fun_expr_clauses(T)]; + strict_binary_generator -> + [[strict_binary_generator_pattern(T)], + [strict_binary_generator_body(T)]]; + strict_generator -> + [[strict_generator_pattern(T)], + [strict_generator_body(T)]]; + strict_map_generator -> + [[strict_map_generator_pattern(T)], + [strict_map_generator_body(T)]]; parentheses -> [[parentheses_body(T)]]; prefix_expr -> @@ -7816,6 +8029,9 @@ make_tree(maybe_expr, [Body, [Else]]) -> maybe_expr(Body, Else); make_tree(maybe_match_expr, [[P], [E]]) -> maybe_match_expr(P, E); make_tree(named_fun_expr, [[N], C]) -> named_fun_expr(N, C); make_tree(module_qualifier, [[M], [N]]) -> module_qualifier(M, N); +make_tree(strict_binary_generator, [[P], [E]]) -> strict_binary_generator(P, E); +make_tree(strict_generator, [[P], [E]]) -> strict_generator(P, E); +make_tree(strict_map_generator, [[P], [E]]) -> strict_map_generator(P, E); make_tree(parentheses, [[E]]) -> parentheses(E); make_tree(prefix_expr, [[F], [A]]) -> prefix_expr(F, A); make_tree(receive_expr, [C]) -> receive_expr(C); diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl index 8b0e1126d6fb..670b40961a6d 100644 --- a/lib/syntax_tools/src/erl_syntax_lib.erl +++ b/lib/syntax_tools/src/erl_syntax_lib.erl @@ -492,10 +492,16 @@ vann(Tree, Env) -> vann_binary_comp(Tree, Env); generator -> vann_generator(Tree, Env); + strict_generator -> + vann_strict_generator(Tree, Env); binary_generator -> vann_binary_generator(Tree, Env); + strict_binary_generator -> + vann_strict_binary_generator(Tree, Env); map_generator -> vann_map_generator(Tree, Env); + strict_map_generator -> + vann_strict_map_generator(Tree, Env); block_expr -> vann_block_expr(Tree, Env); macro -> @@ -630,10 +636,16 @@ vann_list_comp_body_join() -> {T1, Bound1, Free1} = case erl_syntax:type(T) of generator -> vann_generator(T, Env); + strict_generator -> + vann_strict_generator(T, Env); binary_generator -> vann_binary_generator(T,Env); + strict_binary_generator -> + vann_strict_binary_generator(T,Env); map_generator -> vann_map_generator(T,Env); + strict_map_generator -> + vann_strict_map_generator(T,Env); _ -> %% Bindings in filters are not %% exported to the rest of the @@ -643,7 +655,7 @@ vann_list_comp_body_join() -> end, Env1 = ordsets:union(Env, Bound1), {T1, {Env1, ordsets:union(Bound, Bound1), - ordsets:union(Free, + ordsets:union(Free, ordsets:subtract(Free1, Bound))}} end. @@ -668,10 +680,16 @@ vann_binary_comp_body_join() -> {T1, Bound1, Free1} = case erl_syntax:type(T) of generator -> vann_generator(T, Env); + strict_generator -> + vann_strict_generator(T, Env); binary_generator -> vann_binary_generator(T,Env); + strict_binary_generator -> + vann_strict_binary_generator(T,Env); map_generator -> vann_map_generator(T,Env); + strict_map_generator -> + vann_strict_map_generator(T,Env); _ -> %% Bindings in filters are not %% exported to the rest of the @@ -681,7 +699,7 @@ vann_binary_comp_body_join() -> end, Env1 = ordsets:union(Env, Bound1), {T1, {Env1, ordsets:union(Bound, Bound1), - ordsets:union(Free, + ordsets:union(Free, ordsets:subtract(Free1, Bound))}} end. @@ -703,6 +721,14 @@ vann_generator(Tree, Env) -> Tree1 = rewrite(Tree, erl_syntax:generator(P1, E1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. +vann_strict_generator(Tree, Env) -> + P = erl_syntax:strict_generator_pattern(Tree), + {P1, Bound, _} = vann_pattern(P, []), + E = erl_syntax:strict_generator_body(Tree), + {E1, _, Free} = vann(E, Env), + Tree1 = rewrite(Tree, erl_syntax:strict_generator(P1, E1)), + {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. + vann_binary_generator(Tree, Env) -> P = erl_syntax:binary_generator_pattern(Tree), {P1, Bound, _} = vann_pattern(P, Env), @@ -711,6 +737,14 @@ vann_binary_generator(Tree, Env) -> Tree1 = rewrite(Tree, erl_syntax:binary_generator(P1, E1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. +vann_strict_binary_generator(Tree, Env) -> + P = erl_syntax:strict_binary_generator_pattern(Tree), + {P1, Bound, _} = vann_pattern(P, Env), + E = erl_syntax:strict_binary_generator_body(Tree), + {E1, _, Free} = vann(E, Env), + Tree1 = rewrite(Tree, erl_syntax:strict_binary_generator(P1, E1)), + {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. + vann_map_generator(Tree, Env) -> P = erl_syntax:map_generator_pattern(Tree), {P1, Bound, _} = vann_pattern(P, []), @@ -719,6 +753,14 @@ vann_map_generator(Tree, Env) -> Tree1 = rewrite(Tree, erl_syntax:map_generator(P1, E1)), {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. +vann_strict_map_generator(Tree, Env) -> + P = erl_syntax:strict_map_generator_pattern(Tree), + {P1, Bound, _} = vann_pattern(P, []), + E = erl_syntax:strict_map_generator_body(Tree), + {E1, _, Free} = vann(E, Env), + Tree1 = rewrite(Tree, erl_syntax:strict_map_generator(P1, E1)), + {ann_bindings(Tree1, Env, Bound, Free), Bound, Free}. + vann_block_expr(Tree, Env) -> Es = erl_syntax:block_expr_body(Tree), {Es1, {Bound, Free}} = vann_body(Es, Env), @@ -877,7 +919,7 @@ _See also: _[//erts/erlang:error/1](`erlang:error/1`), """. -spec is_fail_expr(syntaxTree()) -> boolean(). -is_fail_expr(E) -> +is_fail_expr(E) -> case erl_syntax:type(E) of application -> N = length(erl_syntax:application_arguments(E)), diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index bb6b36174832..87aa5cc810c5 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -19,7 +19,7 @@ -include_lib("common_test/include/ct.hrl"). %% Test server specific exports --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). %% Test cases @@ -32,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. -all() -> +all() -> [app_test,appup_test,smoke_test,revert,revert_map,revert_map_type, revert_preserve_pos_changes, wrapped_subtrees, @@ -40,7 +40,7 @@ all() -> t_epp_dodger,t_epp_dodger_clever, t_comment_scan,t_prettypr,test_named_fun_bind_ann]. -groups() -> +groups() -> []. init_per_suite(Config) -> @@ -91,7 +91,7 @@ print_error_markers(F, File) -> _ -> ok end. - + %% Read with erl_parse, wrap and revert with erl_syntax and check for equality. revert(Config) when is_list(Config) -> @@ -332,10 +332,13 @@ t_erl_parse_type(Config) when is_list(Config) -> {"#{ a:=1, b:=2 }", map_expr,false}, {"M#{ a=>1, b=>2 }", map_expr,false}, {"[V||V <- Vs]", list_comp,false}, + {"[V||V <:- Vs]", list_comp,false}, {"[catch V||V <- Vs]", list_comp,false}, {"<< <> || <> <= Bs>>", binary_comp,false}, + {"<< <> || <> <:= Bs>>", binary_comp,false}, {"<< (catch <>) || <> <= Bs>>", binary_comp,false}, {"#{K => V || {K,V} <- KVs}", map_comp,false}, + {"#{K => V || {K,V} <:- KVs}", map_comp,false}, {"#{K => (catch V) || {K,V} <- KVs}", map_comp,false}, {"#state{ a = A, b = B}", record_expr,false}, {"#state{}", 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..9551e2641e59 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 @@ -9,6 +9,7 @@ sub_string/2,sub_string/3,centre/2,centre/3, join/2]). -export([to_upper/1, to_lower/1]). -export([eep49/0, eep58/0]). +-export([strict_generators/0]). -import(lists,[reverse/1,member/2]). @@ -216,7 +217,7 @@ cspan([], _Cs, I) -> I. SubString :: string(), Start :: pos_integer(). -substr(String, 1) when is_list(String) -> +substr(String, 1) when is_list(String) -> String; substr(String, S) when is_integer(S), S > 1 -> substr2(String, S). @@ -344,9 +345,9 @@ sub_word(String, Index, Char) when is_integer(Index), is_integer(Char) -> s_word([], _, _, _,Res) -> reverse(Res); s_word([Char|_],Index,Char,Index,Res) -> reverse(Res); s_word([H|T],Index,Char,Index,Res) -> s_word(T,Index,Char,Index,[H|Res]); -s_word([Char|T],Stop,Char,Index,Res) when Index < Stop -> +s_word([Char|T],Stop,Char,Index,Res) when Index < Stop -> s_word(strip(T,left,Char),Stop,Char,Index+1,Res); -s_word([_|T],Stop,Char,Index,Res) when Index < Stop -> +s_word([_|T],Stop,Char,Index,Res) when Index < Stop -> s_word(T,Stop,Char,Index,Res). %%% STRIP %%% @@ -590,3 +591,10 @@ eep58() -> MapDouble = maps:from_list([{{key,I}, 2 * I} || I <- Seq]), ok. + +strict_generators() -> + [X+1 || X <:- [1,2,3]], + [X+1 || <> <:= <<1,2,3>>], + [X*Y || X := Y <:- #{1 => 2, 3 => 4}], + + ok. \ No newline at end of file diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 0d8af99dc5f2..c1f92b9bd202 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) diff --git a/system/doc/reference_manual/expressions.md b/system/doc/reference_manual/expressions.md index 5bf071c8d75c..5a254dd4989c 100644 --- a/system/doc/reference_manual/expressions.md +++ b/system/doc/reference_manual/expressions.md @@ -1958,30 +1958,57 @@ is either a **generator** or a **filter**. > > Map comprehensions and map generators were introduced in Erlang/OTP 26. -There are three kinds of generators. +There are three kinds of generators, each with a relaxed and a strict +variant. -A _list generator_ has the following syntax: +> #### Change {: .info } +> +> Strict generators were introduced in Erlang/OTP 28. + +Relaxed generators ignore terms in the right-hand side expression that +do not match the left-hand side pattern. Strict generators on the other +hand fail with exception `badmatch`. + +A _list generator_ has the following syntax for relaxed: ``` Pattern <- ListExpr ``` +and strict variant: + +``` +Pattern <:- ListExpr +``` + where `ListExpr` is an expression that evaluates to a list of terms. -A _bit string generator_ has the following syntax: +A _bit string generator_ has the following syntax for relaxed: ``` BitstringPattern <= BitStringExpr ``` +and strict variant: + +``` +BitstringPattern <:= BitStringExpr +``` + where `BitStringExpr` is an expression that evaluates to a bit string. -A _map generator_ has the following syntax: +A _map generator_ has the following syntax for relaxed: ``` KeyPattern := ValuePattern <- MapExpression ``` +and strict variant: + +``` +KeyPattern := ValuePattern <:- MapExpression +``` + where `MapExpr` is an expression that evaluates to a map, or a map iterator obtained by calling `maps:iterator/1` or `maps:iterator/2`.