From 0f0e375d835bf83e3eae3f4b994634eaecdf8339 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?D=C3=A1niel=20Szoboszlay?= Date: Thu, 13 Jun 2024 12:52:59 +0200 Subject: [PATCH 1/2] Fix minor imparity issues between various generator types --- lib/stdlib/src/erl_parse.yrl | 2 +- lib/stdlib/src/qlc_pt.erl | 5 +++- lib/stdlib/src/shell.erl | 2 ++ lib/syntax_tools/src/erl_syntax.erl | 8 +++--- lib/syntax_tools/src/erl_syntax_lib.erl | 26 +++++++++++++++----- lib/syntax_tools/test/syntax_tools_SUITE.erl | 2 ++ 6 files changed, 33 insertions(+), 12 deletions(-) diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 01540c00db94..dd99245d336a 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -933,7 +933,7 @@ processed (see section [Error Information](#module-error-information)). -type af_qualifier() :: af_generator() | af_filter(). --doc "Abstract representation of a generator or a bitstring generator.". +-doc "Abstract representation of a list, bitstring or map generator.". -type af_generator() :: {'generate', anno(), af_pattern(), abstract_expr()} | {'m_generate', anno(), af_assoc_exact(af_pattern()), abstract_expr()} | {'b_generate', anno(), af_pattern(), abstract_expr()}. diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index 21c55555ae59..d34b139781ae 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -292,10 +292,13 @@ record_attributes(Forms) -> %% transformation. %% compile_messages(Forms, FormsNoShadows, Options, State) -> - %% The qlc module cannot handle binary generators. + %% The qlc module can only handle list generators. BGenF = fun(_QId,{b_generate,Anno,_P,_LE}=BGen, GA, A) -> M = {loc(Anno),?APIMOD,binary_generator}, {BGen,[{get(?QLC_FILE),[M]}|GA],A}; + (_QId,{m_generate,Anno,_P,_LE}=BGen, GA, A) -> + M = {loc(Anno),?APIMOD,map_generator}, + {BGen,[{get(?QLC_FILE),[M]}|GA],A}; (_QId, Q, GA, A) -> {Q,GA,A} end, diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 002f0d16786d..22a335c73992 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -644,6 +644,8 @@ expand_quals([{generate,A,P,E}|Qs], C) -> [{generate,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([{m_generate,A,P,E}|Qs], C) -> + [{m_generate,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) -> []. diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index a6fd397fda07..84605345dfc4 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -2650,7 +2650,7 @@ compact_list(Node) -> copy_attrs(Node, Node1)); _ -> - Node + Node end end; _ -> @@ -3172,7 +3172,7 @@ revert_attribute(Node) -> revert_attribute_1(module, [M], Pos, Node) -> case revert_module_name(M) of - {ok, A} -> + {ok, A} -> {attribute, Pos, module, A}; error -> Node end; @@ -3189,7 +3189,7 @@ revert_attribute_1(module, [M, List], Pos, Node) -> Node end, case revert_module_name(M) of - {ok, A} -> + {ok, A} -> {attribute, Pos, module, {A, Vs}}; error -> Node end; @@ -7528,7 +7528,7 @@ subtrees(T) -> Ts] end; binary_generator -> - [[binary_generator_pattern(T)], + [[binary_generator_pattern(T)], [binary_generator_body(T)]]; bitstring_type -> [[bitstring_type_m(T)], diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl index 2e0df3c46b25..8b0e1126d6fb 100644 --- a/lib/syntax_tools/src/erl_syntax_lib.erl +++ b/lib/syntax_tools/src/erl_syntax_lib.erl @@ -494,6 +494,8 @@ vann(Tree, Env) -> vann_generator(Tree, Env); binary_generator -> vann_binary_generator(Tree, Env); + map_generator -> + vann_map_generator(Tree, Env); block_expr -> vann_block_expr(Tree, Env); macro -> @@ -626,10 +628,12 @@ vann_list_comp(Tree, Env) -> vann_list_comp_body_join() -> fun (T, {Env, Bound, Free}) -> {T1, Bound1, Free1} = case erl_syntax:type(T) of - binary_generator -> - vann_binary_generator(T,Env); - generator -> + generator -> vann_generator(T, Env); + binary_generator -> + vann_binary_generator(T,Env); + map_generator -> + vann_map_generator(T,Env); _ -> %% Bindings in filters are not %% exported to the rest of the @@ -662,10 +666,12 @@ vann_binary_comp(Tree, Env) -> vann_binary_comp_body_join() -> fun (T, {Env, Bound, Free}) -> {T1, Bound1, Free1} = case erl_syntax:type(T) of - binary_generator -> - vann_binary_generator(T, Env); - generator -> + generator -> vann_generator(T, Env); + binary_generator -> + vann_binary_generator(T,Env); + map_generator -> + vann_map_generator(T,Env); _ -> %% Bindings in filters are not %% exported to the rest of the @@ -705,6 +711,14 @@ vann_binary_generator(Tree, Env) -> Tree1 = rewrite(Tree, erl_syntax: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, []), + E = erl_syntax:map_generator_body(Tree), + {E1, _, Free} = vann(E, Env), + Tree1 = rewrite(Tree, erl_syntax: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), diff --git a/lib/syntax_tools/test/syntax_tools_SUITE.erl b/lib/syntax_tools/test/syntax_tools_SUITE.erl index 0ed660121fae..bb6b36174832 100644 --- a/lib/syntax_tools/test/syntax_tools_SUITE.erl +++ b/lib/syntax_tools/test/syntax_tools_SUITE.erl @@ -335,6 +335,8 @@ t_erl_parse_type(Config) when is_list(Config) -> {"[catch V||V <- Vs]", list_comp,false}, {"<< <> || <> <= Bs>>", binary_comp,false}, {"<< (catch <>) || <> <= Bs>>", binary_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}, {"#s{ a = #def{ a=A }, b = B}", record_expr,false}, From 11d97aa6caab7208fdf89dbf88e68a8629130619 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?D=C3=A1niel=20Szoboszlay?= Date: Thu, 13 Jun 2024 12:09:11 +0200 Subject: [PATCH 2/2] Implement strict generators Currently existing generators are "relaxed": they 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. The motivation for strict generators is that relaxed generators can hide the presence of unexpected elements in the input data of a comprehension. For example consider the below snippet: [{User, Email} || #{user := User, email := Email} <- all_users()] This list comprehension would filter out users that don't have an email address. This may be an issue if we suspect potentially incorrect input data, like in case all_users/0 would read the users from a JSON file. Therefore cautious code that would prefer crashing instead of silently filtering out incorrect input would have to use a more verbose map function: lists:map(fun(#{user := User, email := Email}) -> {User, Email} end, all_users()) Unlike the generator, the anonymous function would crash on a user without an email address. Strict generators would allow similar semantics in comprehensions too: [{User, Email} || #{user := User, email := Email} <:- all_users()] This generator would crash (with a badmatch error) if the pattern wouldn't match an element of the list. Syntactically strict generators use <:- (for lists and maps) and <:= (for binaries) instead of <- and <=. This syntax was chosen because <:- and <:= somewhat resemble the =:= operator that tests whether two terms match, and at the same time keep the operators short and easy to type. Having the two types of operators differ by a single character, `:`, also makes the operators easy to remember as "`:` means strict." --- erts/doc/guides/absform.md | 7 + lib/compiler/src/sys_coverage.erl | 12 + lib/compiler/src/v3_core.erl | 241 ++++++++++--- lib/compiler/test/Makefile | 2 +- lib/compiler/test/bs_bincomp_SUITE.erl | 38 ++- lib/compiler/test/lc_SUITE.erl | 17 +- lib/compiler/test/mc_SUITE.erl | 15 + lib/debugger/src/dbg_ieval.erl | 125 +++---- lib/debugger/src/dbg_iload.erl | 12 +- lib/debugger/test/bs_bincomp_SUITE.erl | 32 +- lib/debugger/test/lc_SUITE.erl | 19 +- lib/debugger/test/mc_SUITE.erl | 15 + lib/stdlib/examples/erl_id_trans.erl | 24 +- lib/stdlib/src/erl_eval.erl | 64 ++-- lib/stdlib/src/erl_expand_records.erl | 26 +- lib/stdlib/src/erl_lint.erl | 16 +- lib/stdlib/src/erl_parse.yrl | 12 +- lib/stdlib/src/erl_pp.erl | 9 + lib/stdlib/src/erl_scan.erl | 8 +- lib/stdlib/src/qlc_pt.erl | 317 +++++++++--------- lib/stdlib/src/shell.erl | 12 +- lib/stdlib/test/Makefile | 2 +- lib/stdlib/test/erl_eval_SUITE.erl | 260 +++++++++----- lib/stdlib/test/erl_scan_SUITE.erl | 6 +- lib/syntax_tools/src/erl_prettypr.erl | 50 ++- lib/syntax_tools/src/erl_syntax.erl | 216 ++++++++++++ lib/syntax_tools/src/erl_syntax_lib.erl | 48 ++- lib/syntax_tools/test/syntax_tools_SUITE.erl | 11 +- .../syntax_tools_SUITE_test_module.erl | 14 +- lib/tools/emacs/erlang.el | 4 +- system/doc/reference_manual/expressions.md | 35 +- 31 files changed, 1213 insertions(+), 456 deletions(-) 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`.