diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 3abcb1df6e2f..74e58091403b 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -101,7 +101,7 @@ forms(Forms) -> forms(Forms, ?DEFAULT_OPTIONS). forms(Forms, Opts) when is_list(Opts) -> do_compile({forms,Forms}, [binary|Opts++env_default_opts()]); -forms(Forms, Opt) when is_atom(Opt) -> +forms(Forms, Opt) when is_atom(Opt) orelse is_tuple(Opt) -> forms(Forms, [Opt|?DEFAULT_OPTIONS]). %% Given a list of compilation options, returns true if compile:file/2 diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 30e6c505bd15..9b0aff47b7c6 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -612,8 +612,11 @@ fun2ms(ShellFun) when is_function(ShellFun) -> %% Check that this is really a shell fun... case erl_eval:fun_data(ShellFun) of {fun_data,ImportList,Clauses} -> + {module, FunModule} = erlang:fun_info(ShellFun,module), + CompilationOptions = FunModule:module_info(compile), + ShouldOptimise = not proplists:get_bool(no_optimise_fun2ms, CompilationOptions), case ms_transform:transform_from_shell( - ?MODULE,Clauses,ImportList) of + ?MODULE,Clauses,ImportList, ShouldOptimise) of {error,[{_,[{_,_,Code}|_]}|_],_} -> io:format("Error: ~ts~n", [ms_transform:format_error(Code)]), diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 01496adb5508..8cd66d88441f 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -19,7 +19,7 @@ %% -module(ms_transform). --export([format_error/1,transform_from_shell/3, +-export([format_error/1,transform_from_shell/3,transform_from_shell/4, parse_transform/2,parse_transform_info/0]). %% Error codes. @@ -205,8 +205,22 @@ parse_transform_info() -> BoundEnvironment :: erl_eval:binding_struct(). transform_from_shell(Dialect, Clauses, BoundEnvironment) -> + transform_from_shell(Dialect, Clauses, BoundEnvironment, true). + +-spec transform_from_shell(Dialect, Clauses, BoundEnvironment, ShouldOptimise) -> term() when + Dialect :: ets | dbg, + Clauses :: [erl_parse:abstract_clause()], + BoundEnvironment :: erl_eval:binding_struct(), + ShouldOptimise :: boolean(). + +transform_from_shell(Dialect, Clauses, BoundEnvironment, ShouldOptimise) -> SaveFilename = setup_filename(), - case catch ms_clause_list(1,Clauses,Dialect,gb_sets:new()) of + MaybeOptimise = + case ShouldOptimise of + true -> fun optimise_ms/1; + false -> fun (MS) -> MS end + end, + case catch MaybeOptimise(ms_clause_list(1,Clauses,Dialect,gb_sets:new())) of {'EXIT',Reason} -> cleanup_filename(SaveFilename), exit(Reason); @@ -224,7 +238,7 @@ transform_from_shell(Dialect, Clauses, BoundEnvironment) -> Ret end end. - + %% %% Called when translating during compiling @@ -237,10 +251,10 @@ transform_from_shell(Dialect, Clauses, BoundEnvironment) -> Errors :: {error, ErrInfo :: [tuple()], WarnInfo :: []}, Warnings :: {warning, Forms2, WarnInfo :: [tuple()]}. -parse_transform(Forms, _Options) -> +parse_transform(Forms, Options) -> SaveFilename = setup_filename(), - %io:format("Forms: ~p~n",[Forms]), - case catch forms(Forms) of + ShouldOptimise = not proplists:get_bool(no_optimise_fun2ms, Options), + case catch forms(Forms, ShouldOptimise) of {'EXIT',Reason} -> cleanup_filename(SaveFilename), exit(Reason); @@ -248,7 +262,6 @@ parse_transform(Forms, _Options) -> {error, [{cleanup_filename(SaveFilename), [{location(AnnoOrUnknown), ?MODULE, R}]}], []}; Else -> - %io:format("Transformed into: ~p~n",[Else]), case get_warnings() of [] -> cleanup_filename(SaveFilename), @@ -345,10 +358,10 @@ record_field({record_field,_,{atom,_,FieldName},Def}, C) -> record_field({typed_record_field,Field,_Type}, C) -> record_field(Field, C). -forms(Forms0) -> +forms(Forms0, ShouldOptimise) -> put(records_replaced_by_tuples, []), try - Forms = [form(F) || F <- Forms0], + Forms = [form(F, ShouldOptimise) || F <- Forms0], %% Add `-compile({nowarn_unused_record, RecordNames}).', where %% RecordNames is the names of all records replaced by tuples, %% in order to silence the code linter's warnings about unused @@ -364,96 +377,790 @@ forms(Forms0) -> erase(records_replaced_by_tuples) end. -form({attribute,_,file,{Filename,_}}=Form) -> +form({attribute,_,file,{Filename,_}}=Form, _) -> put_filename(Filename), Form; -form({attribute,_,record,Definition}=Form) -> +form({attribute,_,record,Definition}=Form, _) -> add_record_definition(Definition), Form; -form({function,Anno,Name0,Arity0,Clauses0}) -> - {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0), +form({function,Anno,Name0,Arity0,Clauses0}, ShouldOptimise) -> + {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0, ShouldOptimise), {function,Anno,Name,Arity,Clauses}; -form(AnyOther) -> +form(AnyOther, _) -> AnyOther. -function(Name, Arity, Clauses0) -> - Clauses1 = clauses(Clauses0), +function(Name, Arity, Clauses0, ShouldOptimise) -> + Clauses1 = clauses(Clauses0, ShouldOptimise), {Name,Arity,Clauses1}. -clauses([C0|Cs]) -> - C1 = clause(C0,gb_sets:new()), - C2 = clauses(Cs), +clauses([C0|Cs], ShouldOptimise) -> + C1 = clause(C0,gb_sets:new(), ShouldOptimise), + C2 = clauses(Cs, ShouldOptimise), [C1|C2]; -clauses([]) -> []. +clauses([],_) -> []. -clause({clause,Anno,H0,G0,B0},Bound) -> - {H1,Bound1} = copy(H0,Bound), - {B1,_Bound2} = copy(B0,Bound1), +clause({clause,Anno,H0,G0,B0},Bound, ShouldOptimise) -> + {H1,Bound1} = copy(H0,Bound, ShouldOptimise), + {B1,_Bound2} = copy(B0,Bound1, ShouldOptimise), {clause,Anno,H1,G0,B1}. copy({call,Anno,{remote,_Anno2,{atom,_Anno3,ets},{atom,_Anno4,fun2ms}}, - As0},Bound) -> - {transform_call(ets,Anno,As0,Bound),Bound}; + As0},Bound, ShouldOptimise) -> + {transform_call(ets,Anno,As0,Bound,ShouldOptimise),Bound}; copy({call,Anno,{remote,_Anno2,{atom,_Anno3,dbg},{atom,_Anno4,fun2ms}}, - As0},Bound) -> - {transform_call(dbg,Anno,As0,Bound),Bound}; -copy({match,Anno,A,B},Bound) -> - {B1,Bound1} = copy(B,Bound), - {A1,Bound2} = copy(A,Bound), + As0},Bound, ShouldOptimise) -> + {transform_call(dbg,Anno,As0,Bound,ShouldOptimise),Bound}; +copy({match,Anno,A,B},Bound,ShouldOptimise) -> + {B1,Bound1} = copy(B,Bound,ShouldOptimise), + {A1,Bound2} = copy(A,Bound,ShouldOptimise), {{match,Anno,A1,B1},gb_sets:union(Bound1,Bound2)}; -copy({var,_Anno,'_'} = VarDef,Bound) -> +copy({var,_Anno,'_'} = VarDef,Bound,_) -> {VarDef,Bound}; -copy({var,_Anno,Name} = VarDef,Bound) -> +copy({var,_Anno,Name} = VarDef,Bound,_) -> Bound1 = gb_sets:add(Name,Bound), {VarDef,Bound1}; -copy({'fun',Anno,{clauses,Clauses}},Bound) -> % Dont export bindings from funs - {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound), +copy({'fun',Anno,{clauses,Clauses}},Bound,ShouldOptimise) -> % Dont export bindings from funs + {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound,ShouldOptimise), {{'fun',Anno,{clauses,NewClauses}},Bound}; -copy({named_fun,Anno,Name,Clauses},Bound) -> % Dont export bindings from funs +copy({named_fun,Anno,Name,Clauses},Bound,ShouldOptimise) -> % Dont export bindings from funs Bound1 = case Name of '_' -> Bound; Name -> gb_sets:add(Name,Bound) end, - {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound1), + {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound1,ShouldOptimise), {{named_fun,Anno,Name,NewClauses},Bound}; -copy({'case',Anno,Of,ClausesList},Bound) -> % Dont export bindings from funs - {NewOf,NewBind0} = copy(Of,Bound), - {NewClausesList,NewBindings} = copy_case_clauses(ClausesList,NewBind0,[]), +copy({'case',Anno,Of,ClausesList},Bound,ShouldOptimise) -> % Dont export bindings from funs + {NewOf,NewBind0} = copy(Of,Bound,ShouldOptimise), + {NewClausesList,NewBindings} = copy_case_clauses(ClausesList,NewBind0,[],ShouldOptimise), {{'case',Anno,NewOf,NewClausesList},NewBindings}; -copy(T,Bound) when is_tuple(T) -> - {L,Bound1} = copy_list(tuple_to_list(T),Bound), +copy(T,Bound,ShouldOptimise) when is_tuple(T) -> + {L,Bound1} = copy_list(tuple_to_list(T),Bound,ShouldOptimise), {list_to_tuple(L),Bound1}; -copy(L,Bound) when is_list(L) -> - copy_list(L,Bound); -copy(AnyOther,Bound) -> +copy(L,Bound,ShouldOptimise) when is_list(L) -> + copy_list(L,Bound,ShouldOptimise); +copy(AnyOther,Bound,_) -> {AnyOther,Bound}. -copy_case_clauses([],Bound,AddSets) -> +copy_case_clauses([],Bound,AddSets,_) -> ReallyAdded = gb_sets:intersection(AddSets), {[],gb_sets:union(Bound,ReallyAdded)}; -copy_case_clauses([{clause,Anno,Match,Guard,Clauses}|T],Bound,AddSets) -> - {NewMatch,MatchBinds} = copy(Match,Bound), - {NewGuard,GuardBinds} = copy(Guard,MatchBinds), %% Really no new binds - {NewClauses,AllBinds} = copy(Clauses,GuardBinds), +copy_case_clauses([{clause,Anno,Match,Guard,Clauses}|T],Bound,AddSets,ShouldOptimise) -> + {NewMatch,MatchBinds} = copy(Match,Bound,ShouldOptimise), + {NewGuard,GuardBinds} = copy(Guard,MatchBinds,ShouldOptimise), %% Really no new binds + {NewClauses,AllBinds} = copy(Clauses,GuardBinds,ShouldOptimise), %% To limit the setsizes, I subtract what I had before the case clause %% and add it in the end AddedBinds = gb_sets:subtract(AllBinds,Bound), {NewTail,ExportedBindings} = - copy_case_clauses(T,Bound,[AddedBinds | AddSets]), + copy_case_clauses(T,Bound,[AddedBinds | AddSets],ShouldOptimise), {[{clause,Anno,NewMatch,NewGuard,NewClauses}|NewTail],ExportedBindings}. -copy_list([H|T],Bound) -> - {C1,Bound1} = copy(H,Bound), - {C2,Bound2} = copy_list(T,Bound1), +copy_list([H|T],Bound,ShouldOptimise) -> + {C1,Bound1} = copy(H,Bound,ShouldOptimise), + {C2,Bound2} = copy_list(T,Bound1,ShouldOptimise), {[C1|C2],Bound2}; -copy_list([],Bound) -> +copy_list([],Bound,_) -> {[],Bound}. -transform_call(Type,_Anno,[{'fun',Anno2,{clauses, ClauseList}}],Bound) -> - ms_clause_list(Anno2, ClauseList,Type,Bound); -transform_call(_Type,Anno,_NoAbstractFun,_) -> +transform_call(Type,_Anno,[{'fun',Anno2,{clauses, ClauseList}}],Bound,ShouldOptimise) -> + Ms = ms_clause_list(Anno2, ClauseList,Type,Bound), + case ShouldOptimise of + true -> optimise_ms(Ms); + false -> Ms + end; +transform_call(_Type,Anno,_NoAbstractFun,_,_) -> throw({error,Anno,?ERR_NOFUN}). +% Multiple semicolon-separated clauses in the function given to ets:fun2ms +% results in an ETS head-guard-body-triple match spec per clause. We iterate +% through those clauses here. +optimise_ms({cons, _Anno, Tuple, Tail}=Unopt) -> + % One clause may be expanded to many clauses to make applying the optimisation + % simplier + Clauses = optimise_ms_clause(Tuple), + try + Compound = + lists:foldr( + fun + AppendOrMerge( + {cons, Anno2, + {tuple, Anno3, [MSHead1, MSGuards1, MSBody1]}=MoreClause, MoreTail}, + {cons, _, + {tuple, _, [MSHead2, MSGuards2, MSBody2]}, + AccTail}=Acc) -> + % Multiple clauses with equivalent heads and bodies can be merged + % for compactness and performance reasons + case equiv(MSHead1, MSHead2) andalso equiv(MSBody1, MSBody2) of + true -> + {cons, Anno2, + {tuple, Anno3, [MSHead1, merge_guards(MSGuards1, MSGuards2), MSBody1]}, + AppendOrMerge(MoreTail, AccTail)}; + false -> + {cons, Anno2, MoreClause, AppendOrMerge(MoreTail, Acc)} + end; + AppendOrMerge({cons, Anno2, MoreClause, MoreTail}, Acc) -> + {cons, Anno2, MoreClause, AppendOrMerge(MoreTail, Acc)}; + AppendOrMerge({nil, _}, Acc) -> + Acc + end, + optimise_ms(Tail), + Clauses + ), + Compound + catch _:_:_ -> + Unopt + end; +optimise_ms({nil, _}=Nil) -> + Nil. + +merge_guards(Guards1, Guards2) -> + disj(conj_list(Guards1), conj_list(Guards2)). + +conj_list(Guards) -> + case as_list(Guards) of + [] -> none; + [G] -> {ok, G}; + [_|_] = Gs -> {ok, {tuple, gen_loc(), [{atom, gen_loc(), 'andalso'} | Gs]}} + end. + +disj(none, none) -> + {nil, gen_loc()}; +disj({ok, Guard1}, none) -> + {cons, gen_loc(), Guard1, {nil, gen_loc()}}; +disj(none, {ok, Guard2}) -> + {cons, gen_loc(), Guard2, {nil, gen_loc()}}; +disj({ok, Guard1}, {ok, Guard2}) -> + OrElse = {tuple, gen_loc(), [{atom, gen_loc(), 'orelse'}, Guard1, Guard2]}, + {cons, gen_loc(), OrElse, {nil, gen_loc()}}. + +as_list({cons, _Anno, Head, Tail}) -> + [Head | as_list(Tail)]; +as_list({nil, _}) -> + []. + +equiv({atom,_,Val}, {atom,_,Val}) -> + true; +equiv({char,_,Val}, {char,_,Val}) -> + true; +equiv({integer,_,Val}, {integer,_,Val}) -> + true; +equiv({string,_,Val}, {string,_,Val}) -> + true; +equiv({float,_,Val}, {float,_,Val}) -> + true; +equiv({nil,_}, {nil,_}) -> + true; +equiv({cons,_,Head1,Tail1}, {cons,_,Head2,Tail2}) -> + equiv(Head1,Head2) andalso equiv(Tail1, Tail2); +equiv({tuple,_,Elems1}, {tuple,_,Elems2}) -> + equiv_list(Elems1, Elems2); +equiv({bin,_,Elems1}, {bin,_,Elems2}) -> + equiv_list(Elems1, Elems2); +equiv({bin_element,_,Elem1,S,T}, {bin_element,_,Elem2,S,T}) -> + equiv(Elem1, Elem2); +equiv(_, _) -> false. + +equiv_list(Elems1, Elems2) -> + lists:all( + fun ({Elem1, Elem2}) -> + equiv(Elem1,Elem2) + end, + lists:zip(Elems1,Elems2) + ). + +% We simplify match functions with multiple alternative conditions +% into multiple separate match functions which can be optimised +% independently +optimise_ms_clause({tuple, Anno, [MSHead, MSGuards, MSBody]}=Unoptimised) -> + MSGuardAlternatives = split_alternatives_list(MSGuards), + try [optimise_ms_clause_alternative( + {cons, Anno, + {tuple, Anno, [MSHead, AltGuards, MSBody]}, + {nil, Anno}}) + || AltGuards <- MSGuardAlternatives] of + NewClauses -> NewClauses + catch + throw:{unoptimisable_operation, _Operation} -> + [{cons, Anno, Unoptimised, {nil, Anno}}]; + _:Err:_ -> + error(Err) + end. + +optimise_ms_clause_alternative( + {cons, Anno1, + {tuple, Anno2, [MSHead, MSGuards, MSBody]}, + {nil, Anno3}}) -> + {ColumnsToSubstitute1,NewGuards1} = find_substitutable_columns_list(MSGuards), + % Gracefully handle contradictive cases such as (X =:= 1) and (X =:= 2) + % by reducing the guard to just 'false' + ConflictingColumns = + maps:filter( + fun (_Column, AllSubstitutionsForColumn) -> + AllLiteralSubstitutionsForColumn = + % (K1 =:= K2) andalso (K1 =:= K3) doesn't imply a contradiction, + % since despite the names being different, their bound values + % may be the same at runtime + [ S || S <- AllSubstitutionsForColumn, not is_column_ref(S)], + erlang:length(lists:uniq(AllLiteralSubstitutionsForColumn)) > 1 end, + maps:groups_from_list( + fun ({{atom,_,Col},_Subs}) -> Col end, + fun ({_Col,Subs}) -> Subs end, + ColumnsToSubstitute1) + ), + {ColumnsToSubstitute2,NewGuards2} = + case maps:size(ConflictingColumns) of + % lists:uniq to remove duplicates, e.g. when the guards contains + % `(X =:= 1) and (X =:= 1)` + 0 -> {lists:uniq(ColumnsToSubstitute1),NewGuards1}; + _ -> {[], {cons, Anno2, {atom,Anno2,false}, {nil, Anno2}}} + end, + ColumnsToSubstitute3 = set_substitution_precedence(ColumnsToSubstitute2), + NewGuards3 = substitute_promotions_in_guards(ColumnsToSubstitute3, NewGuards2), + NewGuards4 = remove_const_true_guards(NewGuards3), + NewHead = substitute_columns(ColumnsToSubstitute3, MSHead), + NewBody = simplify_bodies(substitute_columns(ColumnsToSubstitute3, MSBody)), + {cons, Anno1, {tuple, Anno2, [NewHead,NewGuards4,NewBody]}, {nil, Anno3}}. + +split_alternatives_list({cons, Anno1, Expr, {nil,Anno2}}) -> + [ {cons, Anno1, Alt, {nil,Anno2}} || Alt <- split_alternatives_expr(Expr)]; +split_alternatives_list(Unsplittable) -> + [Unsplittable]. + +split_alternatives_expr({tuple, _Anno2, [{atom, _Anno3, 'or'}, Operand1, Operand2]}) -> + split_alternatives_expr(Operand1) ++ split_alternatives_expr(Operand2); +split_alternatives_expr({tuple, _Anno2, [{atom, _Anno3, 'orelse'}, Operand1, Operand2]}) -> + split_alternatives_expr(Operand1) ++ split_alternatives_expr(Operand2); +split_alternatives_expr(Expr) -> + [Expr]. + +% If we have ($1 =:= foo) and ($1 =:= $2) and ($3 =:= $2), +% inline all of those columns to just be the value foo +% once all substitutions are applied +set_substitution_precedence(ColumnsToSubstitutions) -> + % When both the key and the column are a column reference, + % and neither has a literal substitution, canonicalise them into the column + % with the lower index to deterministically pick the new column index to use + % for all equal values + {ColumnEqualities, OtherEqualities} = + lists:partition(fun + ({K,V}) -> is_column_ref(K) andalso is_column_ref(V); + (_) -> false + end, + ColumnsToSubstitutions + ), + LookupSubstitution = + fun + L({atom,_,Column}, [{{atom,_,Column}, Value} | _Tail ]) -> + {value, Value}; + L(Needle, [_| Tail ]) -> + L(Needle, Tail); + L(_Needle, []) -> + false + end, + Canonicalise = + fun (Substitutions) -> + lists:sort( + fun + ({{atom,_,Before},{atom,_,After1}},{{atom,_,Before},{atom,_,After2}}) -> + After1 < After2; + ({{atom,_,Before1},{atom,_,_}},{{atom,_,Before2},{atom,_,_}}) -> + Before1 < Before2 + end, + [ case {get_column_index(Col1), get_column_index(Col2)} of + {{value, Col1Index},{value, Col2Index}} when Col1Index =< Col2Index -> + {Col2,Col1}; + _ -> + {Col1,Col2} + end + || {Col1={atom,_,Col1Idx},Col2={atom,_,Col2Idx}} <- Substitutions + % If we have something like ($1 =:= $1), we can eliminate that + % redundant substitution + , (Col1Idx =/= Col2Idx) + ] + ) + end, + Unify = + fun + U([{BeforeCol,AfterCol}|Tail], OtherSubstitutions) -> + case LookupSubstitution(BeforeCol, OtherSubstitutions) of + {value, SubsForBeforeCol} -> + U(Tail, [{AfterCol,SubsForBeforeCol}|OtherSubstitutions]); + false -> + U(Tail, [{BeforeCol,AfterCol}|OtherSubstitutions]) + end; + U([], OtherSubstitutions) -> + OtherSubstitutions + end, + Unify( + Canonicalise(ColumnEqualities), + OtherEqualities + ). + +remove_const_true_guards({nil, _}=Nil) -> + Nil; +remove_const_true_guards({cons, _, {atom,_,true}, Tail}) -> + remove_const_true_guards(Tail); +remove_const_true_guards({cons, Anno, Head, Tail}) -> + {cons, Anno, Head, remove_const_true_guards(Tail)}. + +substitute_columns([{{atom,_,Key},Value}|MorePromotions], {atom,_,Key}) -> + % Keep replacing until we run out of replacements in case we have + % a chain of equalities such as (X =:= Y), (Y =:= Z), (Z =:= foo), + % so that we end up substituting foo in place of X + substitute_columns(MorePromotions, Value); +substitute_columns([{{atom,_,_},_}|MorePromotions], {atom,_,_}=Guard) -> + substitute_columns(MorePromotions, Guard) ; +substitute_columns(Promotions, {cons, Anno, Guard, MoreGuards}) -> + {cons, + Anno, + substitute_columns(Promotions, Guard), + substitute_columns(Promotions, MoreGuards)}; +substitute_columns(Promotions, {tuple,Anno,Elems}) -> + {tuple, Anno, [substitute_columns(Promotions, Elem) || Elem <- Elems]}; +substitute_columns(Promotions, {map, Anno, Assocs}) -> + {map, Anno, [substitute_columns(Promotions, Assoc) || Assoc <- Assocs]}; +substitute_columns(Promotions, {map_field_assoc,Anno,NField,NValue}) -> + {map_field_assoc, + Anno, + substitute_columns(Promotions, NField), + substitute_columns(Promotions, NValue)}; +substitute_columns(_, Other) -> + Other. + +-define(ATOM_LIT_EQ_KV_VK_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {atom,_,_}=Value, {atom,_,_}=Key]}). +-define(CHAR_LIT_EQ_KV_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {char,_,_}=Value, {atom,_,_}=Key]}). +-define(INTEGER_LIT_EQ_KV_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {integer,_,_}=Value, {atom,_,_}=Key]}). +-define(NIL_LIT_EQ_KV_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {nil, _}=Value, {atom,_,_}=Key]}). +-define(STRING_LIT_EQ_KV_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {string,_,_}=Value, {atom,_,_}=Key]}). +-define(TUPLE_LIT_EQ_KV_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {tuple,_,_}=Value, {atom,_,_}=Key]}). +-define(CONS_LIT_EQ_KV_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {cons,_,_,_}=Value, {atom,_,_}=Key]}). +-define(BIN_LIT_EQ_KV_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {bin,_,_}=Value, {atom,_,_}=Key]}). +-define(MAP_LIT_EQ_KV_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {map,_,_}=Value, {atom,_,_}=Key]}). +-define(CHAR_LIT_EQ_VK_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {atom,_,_}=Key, {char,_,_}=Value]}). +-define(INTEGER_LIT_EQ_VK_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {atom,_,_}=Key, {integer,_,_}=Value]}). +-define(NIL_LIT_EQ_VK_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {atom,_,_}=Key, {nil, _}=Value]}). +-define(STRING_LIT_EQ_VK_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {atom,_,_}=Key, {string,_,_}=Value]}). +-define(TUPLE_LIT_EQ_VK_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {atom,_,_}=Key, {tuple,_,_}=Value]}). +-define(CONS_LIT_EQ_VK_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {atom,_,_}=Key, {cons,_,_,_}=Value]}). +-define(BIN_LIT_EQ_VK_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {atom,_,_}=Key, {bin,_,_}=Value]}). +-define(MAP_LIT_EQ_VK_CANDIDATE, + {tuple, _Anno2, [{atom, _Anno3, '=:='}, {atom,_,_}=Key, {map,_,_}=Value]}). + +-define(VAR_EQ_KV, + {tuple, _Anno2, + [{atom, _Anno3, '=:='}, {atom,_,_}=Key, {var,_,_}=Value]}). +-define(VAR_EQ_VK, + {tuple, _Anno2, + [{atom, _Anno3, '=:='}, + {var,_,_}=Value, + {atom,_,_}=Key]}). +-define(VAR_EQ_KV_CONST, + {tuple, _Anno2, + [{atom, _Anno3, '=:='}, + {atom,_,_}=Key, + {tuple,_Anno4,[{atom, _Anno5, const}, {var,_,_}=Value]}]}). +-define(VAR_EQ_VK_CONST, + {tuple, _Anno2, + [{atom, _Anno3, '=:='}, + {tuple,_Anno4, + [{atom, _Anno5, const},{var,_,_}=Value]},{atom,_,_}=Key]}). + +% Special atoms of the form `$` refer to columns we are to match against +% rather than normal atom values +is_column_ref(Val) -> + case get_column_index(Val) of + {value,_} -> true; + false -> false + end. + +get_column_index({atom,_,Key}) -> + case atom_to_list(Key) of + [$$|MaybeIndex] -> + case string:to_integer(MaybeIndex) of + {ColIndex, ""} -> {value, ColIndex}; + _ -> false + end; + _ -> false + end; +get_column_index(_) -> + false. + +extract_literal_column_guard(Key, Value, OriginalGuard) -> + case is_column_ref(Key) of + true -> + {[{Key,Value}],{atom, undefined, true}}; + false -> + {[], OriginalGuard} + end. + +% Applicable when there's a `=:=` guard that could be promoted to a pattern +find_substitutable_columns((?VAR_EQ_KV)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns((?VAR_EQ_VK)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns((?VAR_EQ_KV_CONST)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns((?VAR_EQ_VK_CONST)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns((?ATOM_LIT_EQ_KV_VK_CANDIDATE)=Guard) -> + case is_column_ref(Key) of + true -> extract_literal_column_guard(Key, Value, Guard); + false -> extract_literal_column_guard(Value, Key, Guard) + end; +find_substitutable_columns((?CHAR_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?INTEGER_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?NIL_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?STRING_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?TUPLE_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?CONS_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?BIN_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?MAP_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?CHAR_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?INTEGER_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?NIL_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?STRING_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?TUPLE_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?CONS_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?BIN_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns((?MAP_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_literal_column_guard(Key, Value, Guard); +find_substitutable_columns({tuple, _, [{atom, _Anno3, 'andalso'}, _, _]}=Op) -> + find_substitutable_columns_expr(Op); +find_substitutable_columns({tuple, _, [{atom, _Anno3, 'and'}, _, _]}=Op) -> + find_substitutable_columns_expr(Op); +find_substitutable_columns({tuple, _, [{atom, _Anno3, 'or'}, _, _]}=Op) -> + throw({unoptimisable_operation, Op}); +find_substitutable_columns({tuple, _, [{atom, _Anno3, 'orelse'}, _, _]}=Op) -> + throw({unoptimisable_operation, Op}); +find_substitutable_columns({tuple, _, [{atom, _Anno3, 'xor'}, _, _]}=Op) -> + throw({unoptimisable_operation, Op}); +find_substitutable_columns({tuple, _, [{atom, _Anno3, 'not'}, _]}=Op) -> + throw({unoptimisable_operation, Op}); +find_substitutable_columns(Other) -> + {[], Other}. + + +find_substitutable_columns_list({cons, Anno, Guard, MoreGuards}) -> + {Promotable, Remaining} = find_substitutable_columns(Guard), + {PromotableMore, RemainingMore} = find_substitutable_columns_list(MoreGuards), + {Promotable ++ PromotableMore, {cons, Anno, Remaining, RemainingMore}}; +find_substitutable_columns_list({nil, _Anno}=Nil) -> + {[], Nil}. + +simplify_bodies({cons, Anno, Body, MoreBodies}) -> + {cons, Anno, simplify_body_expr(Body), simplify_bodies(MoreBodies)}; +simplify_bodies({nil, _Anno}=Nil) -> + Nil. + +% e.g. is_record/3 +simplify_body_expr({tuple, _, [{atom, _, Operator}, Operand1, Operand2, Operand3]}) -> + SimplifiedOperand1 = simplify_body_expr(Operand1), + SimplifiedOperand2 = simplify_body_expr(Operand2), + SimplifiedOperand3 = simplify_body_expr(Operand3), + simplify_guard_function( + Operator, + SimplifiedOperand1, + SimplifiedOperand2, + SimplifiedOperand3); +% e.g. is_function/2, '>', etc. +simplify_body_expr({tuple, _, [{atom, _, Operator}, Operand1, Operand2]}) -> + SimplifiedOperand1 = simplify_body_expr(Operand1), + SimplifiedOperand2 = simplify_body_expr(Operand2), + simplify_guard_function(Operator, SimplifiedOperand1, SimplifiedOperand2); +% e.g. not/1, is_integer/1, etc. +simplify_body_expr({tuple, _, [{atom, _, Operator}, Operand]}) -> + SimplifiedOperand = simplify_body_expr(Operand), + simplify_guard_function(Operator, SimplifiedOperand); +% Tuple values need to be escaped by being double-wrapped in curly braces +simplify_body_expr({tuple, Anno1, [{tuple, Anno2, Elems}]}) -> + SimplifiedElems = [ simplify_body_expr(Elem) || Elem <- Elems ], + {tuple, Anno1, [{tuple, Anno2, SimplifiedElems}]}; +simplify_body_expr({cons, Anno, Head, Tail}) -> + {cons, Anno, simplify_body_expr(Head), simplify_body_expr(Tail)}; +% e.g. '$1', [] +simplify_body_expr(Other) -> + Other. + +% If we inline guards such as `X =:= 1` into the pattern `$1` to get the +% pattern `1`, then `$1` will not be bound elsewhere in the guards. Typically, +% this doesn't occur, since equality constraints such as `X =:= 1` are +% already as specific as a guard can be, so subsequent guards that reference +% `X` tend to be redundant (e.g. `X > 0`), or a contradiction (e.g. `X =:= 2`). +% Here, we substitute in the value for the variable we have, then partially +% evaluate the result to simplify it. +substitute_promotions_in_guards(Promotions, {cons, Anno, Guard, MoreGuards}) -> + SubstitutedGuard = substitute_promotions_in_guards_expr(Promotions, Guard), + SubstitutedMore = substitute_promotions_in_guards(Promotions, MoreGuards), + {cons, Anno, SubstitutedGuard, SubstitutedMore}; +substitute_promotions_in_guards(_Promotions, {nil, _Anno}=Nil) -> + Nil. + +% e.g. is_record/3 +substitute_promotions_in_guards_expr( + Promotions, + {tuple, _, [{atom, _, Operator}, Operand1, Operand2, Operand3]}) -> + RemainingOperand1 = substitute_promotions_in_guards_expr(Promotions, Operand1), + RemainingOperand2 = substitute_promotions_in_guards_expr(Promotions, Operand2), + RemainingOperand3 = substitute_promotions_in_guards_expr(Promotions, Operand3), + simplify_guard_function( + Operator, + RemainingOperand1, + RemainingOperand2, + RemainingOperand3); +% e.g. is_function/2, '>', etc. +substitute_promotions_in_guards_expr( + Promotions, + {tuple, _, [{atom, _, Operator}, Operand1, Operand2]}) -> + RemainingOperand1 = substitute_promotions_in_guards_expr(Promotions, Operand1), + RemainingOperand2 = substitute_promotions_in_guards_expr(Promotions, Operand2), + simplify_guard_function(Operator, RemainingOperand1, RemainingOperand2); +% e.g. not/1, is_integer/1, etc. +substitute_promotions_in_guards_expr( + Promotions, + {tuple, _, [{atom, _, Operator}, Operand]}) -> + RemainingOperand = substitute_promotions_in_guards_expr(Promotions, Operand), + simplify_guard_function(Operator, RemainingOperand); +% e.g. '$1' +substitute_promotions_in_guards_expr(Promotions, {atom,_,AtomInGuard}=Expr) -> + case is_column_ref(Expr) of + true -> + Search = + lists:search(fun ({{atom,_,PromotionColumnName},_PromotionValue}) -> + PromotionColumnName =:= AtomInGuard + end, + Promotions), + case Search of + {value, {_ColumnKey, SubstitutedValue}} -> SubstitutedValue; + false -> Expr + end; + false -> + Expr + end; +substitute_promotions_in_guards_expr(_Promotions, Other) -> + Other. + +% Once we've inlined a column value (e.g. '$1' is replaced with 4, because we +% saw `$1 =:= 4`), % there may be some easy further simplifiations we can make, +% such as: +% {'>', $1, 2} +% substituted: +% {'>', 4, 2} +% simplified: +% true +% +% Notably, this function doesn't claim to exhaustively +% partially evaluate guards, and we can't use erl_eval:partial_eval +% because we have match spec guards, which aren't normal erlang expressions +simplify_guard_function(is_atom, {atom,_,_}=Val) -> + case is_column_ref(Val) of + false -> {atom, gen_loc(), true}; + true -> {tuple, gen_loc(), [{atom, gen_loc(), is_atom}, Val]} + end; +simplify_guard_function(is_float, {float,_,_}) -> + {atom,gen_loc(),true}; +simplify_guard_function(is_number, {float,_,_}) -> + {atom,gen_loc(),true}; +simplify_guard_function(is_number, {integer,_,_}) -> + {atom,gen_loc(),true}; +simplify_guard_function(is_integer, {integer,_,_}) -> + {atom,gen_loc(),true}; +simplify_guard_function(is_tuple, {tuple,_,_}) -> + {atom,gen_loc(),true}; +simplify_guard_function(is_binary, {bin, _, _}) -> + {atom,gen_loc(),true}; +simplify_guard_function('not', {atom, _, X}) when is_boolean(X) -> + {atom,gen_loc(), not X}; +simplify_guard_function(Op, Operand) -> + {tuple, gen_loc(), [{atom, gen_loc(), Op}, Operand]}. + +simplify_guard_function('>', {integer, _, X}, {integer, _, Y}) -> + {atom,gen_loc(),X > Y}; +simplify_guard_function('>', {float, _, X}, {float, _, Y}) -> + {atom,gen_loc(),X > Y}; +simplify_guard_function('>=', {integer, _, X}, {integer, _, Y}) -> + {atom,gen_loc(),X >= Y}; +simplify_guard_function('>=', {float, _, X}, {float, _, Y}) -> + {atom,gen_loc(),X >= Y}; +simplify_guard_function('<', {integer, _, X}, {integer, _, Y}) -> + {atom,gen_loc(),X < Y}; +simplify_guard_function('<', {float, _, X}, {float, _, Y}) -> + {atom,gen_loc(),X < Y}; +simplify_guard_function('=<', {integer, _, X}, {integer, _, Y}) -> + {atom,gen_loc(),X =< Y}; +simplify_guard_function('=<', {float, _, X}, {float, _, Y}) -> + {atom,gen_loc(),X =< Y}; +simplify_guard_function('=:=', {integer, _, X}, {integer, _, Y}) -> + {atom,gen_loc(),X =:= Y}; +simplify_guard_function('=:=', {float, _, X}, {float, _, Y}) -> + {atom,gen_loc(),X =:= Y}; +simplify_guard_function('=/=', {integer, _, X}, {integer, _, Y}) -> + {atom,gen_loc(),X =/= Y}; +simplify_guard_function('=/=', {float, _, X}, {float, _, Y}) -> + {atom,gen_loc(),X =/= Y}; +simplify_guard_function('and', {atom, _, X}, {atom, _, Y}) when is_boolean(X), is_boolean(Y) -> + {atom,gen_loc(),X and Y}; +simplify_guard_function('or', {atom, _, X}, {atom, _, Y}) when is_boolean(X), is_boolean(Y) -> + {atom,gen_loc(),X or Y}; +simplify_guard_function('andalso', {atom, _, X}, {atom, _, Y}) when is_boolean(X), is_boolean(Y) -> + {atom,gen_loc(),X andalso Y}; +simplify_guard_function('orelse', {atom, _, X}, {atom, _, Y}) when is_boolean(X), is_boolean(Y) -> + {atom,gen_loc(),X orelse Y}; +simplify_guard_function('xor', {atom, _, X}, {atom, _, Y}) when is_boolean(X), is_boolean(Y) -> + {atom,gen_loc(),X xor Y}; + +simplify_guard_function('+', {integer, _, X}, {integer, _, Y}) -> + {integer,gen_loc(), X+Y}; +simplify_guard_function('+', {float, _, X}, {float, _, Y}) -> + {float,gen_loc(), X+Y}; +simplify_guard_function('-', {integer, _, X}, {integer, _, Y}) -> + {integer,gen_loc(), X-Y}; +simplify_guard_function('-', {float, _, X}, {float, _, Y}) -> + {float,gen_loc(), X-Y}; +simplify_guard_function('*', {integer, _, X}, {integer, _, Y}) -> + {integer,gen_loc(), X*Y}; +simplify_guard_function('*', {float, _, X}, {float, _, Y}) -> + {float,gen_loc(), X*Y}; +simplify_guard_function('/', {integer, _, X}, {integer, _, Y}) -> + {float,gen_loc(), X/Y}; +simplify_guard_function('/', {float, _, X}, {float, _, Y}) -> + {float,gen_loc(), X/Y}; +simplify_guard_function('div', {integer, _, X}, {integer, _, Y}) -> + {integer,gen_loc(), X div Y}; +simplify_guard_function('rem', {integer, _, X}, {integer, _, Y}) -> + {integer,gen_loc(), X div Y}; + +simplify_guard_function(Op, Operand1, Operand2) -> + {tuple, gen_loc(), [{atom, gen_loc(), Op}, Operand1, Operand2]}. + +simplify_guard_function(Op, Operand1, Operand2, Operand3) -> + {tuple, gen_loc(), [{atom, gen_loc(), Op}, Operand1, Operand2, Operand3]}. + +extract_column_guard_expr(Key, Value, OriginalGuard) -> + case is_column_ref(Key) of + true -> + {[{Key,Value}], {atom, gen_loc(), true}}; + false -> + {[], OriginalGuard} + end. + +extract_variable_column_guard_expr(Key, Value, OriginalGuard) -> + case is_column_ref(Key) of + true -> + NewGuard = {atom,gen_loc(),true}, + {[{Key,Value}], NewGuard}; + false -> + {[], OriginalGuard} + end. + +% In the case of conjunctions, such as `X andalso Y`, we can continue +% searching for usages of `=:=`, simplifying the remaining expression as we go +find_substitutable_columns_expr((?VAR_EQ_KV)=Guard) -> + extract_variable_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?VAR_EQ_VK)=Guard) -> + extract_variable_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?ATOM_LIT_EQ_KV_VK_CANDIDATE)=Guard) -> + case is_column_ref(Key) of + true -> extract_column_guard_expr(Key, Value, Guard); + false -> extract_column_guard_expr(Value, Key, Guard) + end; +find_substitutable_columns_expr((?CHAR_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?INTEGER_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?NIL_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?STRING_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?TUPLE_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?CONS_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?BIN_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?MAP_LIT_EQ_KV_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?CHAR_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?INTEGER_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?NIL_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?STRING_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?TUPLE_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?CONS_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?BIN_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr((?MAP_LIT_EQ_VK_CANDIDATE)=Guard) -> + extract_column_guard_expr(Key, Value, Guard); +find_substitutable_columns_expr({tuple, Anno2, [{atom, Anno3, 'andalso'}, Left, Right]}) -> + {PromotableLeft, RemainingLeft} = find_substitutable_columns_expr(Left), + {PromotableRight, RemainingRight} = find_substitutable_columns_expr(Right), + Promotable = PromotableLeft ++ PromotableRight, + Remaining = + case {RemainingLeft, RemainingRight} of + {{atom, _, true},R} -> R; + {{tuple, _,[{atom, _, const}, {atom, _, true}]},R} -> R; + {L,{atom, _, true}} -> L; + {L,{tuple, _,[{atom, _, const}, {atom, _, true}]}} -> L; + _ -> + {tuple, Anno2, [{atom, Anno3, 'andalso'}, RemainingLeft, RemainingRight]} + end, + {Promotable, Remaining}; +find_substitutable_columns_expr({tuple, Anno2, [{atom, Anno3, 'and'}, Left, Right]}) -> + {PromotableLeft, RemainingLeft} = find_substitutable_columns_expr(Left), + {PromotableRight, RemainingRight} = find_substitutable_columns_expr(Right), + Remaining = + case {RemainingLeft, RemainingRight} of + {{atom, _, true},R} -> R; + {{tuple, _,[{atom, _, const}, {atom, _, true}]},R} -> R; + {L,{atom, _, true}} -> L; + {L,{tuple, _,[{atom, _, const}, {atom, _, true}]}} -> L; + _ -> + {tuple, Anno2, [{atom, Anno3, 'and'}, RemainingLeft, RemainingRight]} + end, + Promotable = PromotableLeft ++ PromotableRight, + {Promotable, Remaining}; +find_substitutable_columns_expr(Other) -> + {[], Other}. + +% A placeholder location for generated code +gen_loc() -> + erl_anno:new(0). + % Fixup semicolons in guards ms_clause_expand({clause, Anno, Parameters, Guard = [_,_|_], Body}) -> [ {clause, Anno, Parameters, [X], Body} || X <- Guard ]; @@ -477,7 +1184,6 @@ ms_clause({clause, Anno, Parameters, Guards, Body},Type,Bound) -> MSBody = transform_body(Anno,Body,Bindings), {tuple, Anno, [MSHead,MSGuards,MSBody]}. - check_type(_,[{var,_,_}],_) -> ok; check_type(_,[{tuple,_,_}],ets) -> @@ -509,11 +1215,9 @@ transform_guards(Anno,[G],Bindings) -> tg0(Anno,G,B); transform_guards(Anno,_,_) -> throw({error,Anno,?ERR_SEMI_GUARD}). - transform_body(Anno,Body,Bindings) -> B = #tgd{b = Bindings, p = body, eb = ?ERROR_BASE_BODY}, tg0(Anno,Body,B). - guard_top_trans({call,Anno0,{atom,Anno1,OldTest},Params}) -> case old_bool_test(OldTest,length(Params)) of @@ -532,7 +1236,6 @@ tg0(Anno,[H0|T],B) when B#tgd.p =:= guard -> {cons,Anno, tg(H,B), tg0(Anno,T,B)}; tg0(Anno,[H|T],B) -> {cons,Anno, tg(H,B), tg0(Anno,T,B)}. - tg({match,Anno,_,_},B) -> throw({error,Anno,?ERR_GENMATCH+B#tgd.eb}); @@ -748,7 +1451,7 @@ tg({bin_element,_Anno0,{var, Anno, A},_,_} = Whole,B) -> Whole; % exists in environment hopefully _AtomName -> throw({error,Anno,{?ERR_GENBINCONSTRUCT+B#tgd.eb,A}}) - end; + end; tg(default,_B) -> default; tg({bin_element,Anno,X,Y,Z},B) -> @@ -1100,9 +1803,9 @@ is_ms_function(X,A,body) -> is_ms_function(X,A,guard) -> guard_function(X,A) or bool_test(X,A). -fixup_environment(L,B) when is_list(L) -> +fixup_environment(L,B) when is_list(L) -> lists:map(fun(X) -> - fixup_environment(X,B) + fixup_environment(X,B) end, L); fixup_environment({var,Anno,Name},B) -> @@ -1112,15 +1815,14 @@ fixup_environment({var,Anno,Name},B) -> _ -> throw({error,Anno,{?ERR_UNBOUND_VARIABLE,atom_to_list(Name)}}) end; -fixup_environment(T,B) when is_tuple(T) -> +fixup_environment(T,B) when is_tuple(T) -> list_to_tuple( lists:map(fun(X) -> - fixup_environment(X,B) + fixup_environment(X,B) end, tuple_to_list(T))); fixup_environment(Other,_B) -> Other. - freeze(Anno,Term) -> {frozen,Anno,Term}. diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index be7dcafef72a..45822cc2dc81 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -2285,7 +2285,9 @@ try_ms(E, P, Fltr, State) -> Fun = {'fun',Anno,{clauses,[{clause,Anno,[P],[[Fltr]],[E]}]}}, 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], []), + % We disable fun2ms optimisations because they can interfere with the + % pre-existing assumptions of qlc + X = ms_transform:parse_transform(State#state.records ++ [Form], [no_optimise_fun2ms]), case catch begin {function,Anno,foo,0,[{clause,Anno,[],[],[MS0]}]} = lists:last(X), diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl index 5e8e6076ae21..9648fbcc773c 100644 --- a/lib/stdlib/test/ms_transform_SUITE.erl +++ b/lib/stdlib/test/ms_transform_SUITE.erl @@ -21,8 +21,9 @@ -author('pan@erix.ericsson.se'). -include_lib("common_test/include/ct.hrl"). +-include_lib("stdlib/include/assert.hrl"). --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]). -export([basic_ets/1]). @@ -53,6 +54,11 @@ -export([otp_14454/1]). -export([otp_16824/1]). -export([unused_record/1]). +-export([optimise_equality_guards_ets_compilation/1]). +-export([optimise_equality_guards_ets_execution/1]). +-export([optimise_equality_guards_ets_equivalence/1]). +-export([ms_transform_optimisations_can_be_disabled_but_default_to_on/1]). + init_per_testcase(_Func, Config) -> Config. @@ -64,7 +70,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,6}}]. -all() -> +all() -> [from_shell, basic_ets, basic_dbg, records, record_index, multipass, bitsyntax, binary_bifs, record_defaults, andalso_orelse, float_1_function, action_function, @@ -72,9 +78,13 @@ all() -> semicolon, eep37, otp_14454, otp_16824, unused_record, map_pattern, map_expr_in_head, map_pattern_from_shell, map_expr_in_head_from_shell, - map_exprs, map_exprs_from_shell]. + map_exprs, map_exprs_from_shell, + optimise_equality_guards_ets_compilation, + optimise_equality_guards_ets_execution, + optimise_equality_guards_ets_equivalence, + ms_transform_optimisations_can_be_disabled_but_default_to_on]. -groups() -> +groups() -> []. init_per_suite(Config) -> @@ -201,34 +211,34 @@ no_warnings(Config) when is_list(Config) -> %% Test that andalso and orelse are allowed in guards. andalso_orelse(Config) when is_list(Config) -> setup(Config), - [{{'$1','$2'}, + ?assertEqual([{{'$1','$2'}, [{'and',{is_integer,'$1'},{'>',{'+','$1',5},'$2'}}], - [{'andalso','$1','$2'}]}] = + [{'andalso','$1','$2'}]}], compile_and_run(<<"ets:fun2ms(fun({A,B}) " " when is_integer(A) and (A+5 > B) -> " " A andalso B " - " end)">>), - [{{'$1','$2'}, - [{'or',{is_atom,'$1'},{'>',{'+','$1',5},'$2'}}], - [{'orelse','$1','$2'}]}] = + " end)">>)), + ?assertEqual([{{'$1','$2'}, + [{'orelse',{is_atom,'$1'},{'>',{'+','$1',5},'$2'}}], + [{'orelse','$1','$2'}]}], compile_and_run(<<"ets:fun2ms(fun({A,B}) " " when is_atom(A) or (A+5 > B) -> " " A orelse B " - " end)">>), - [{{'$1','$2'}, - [{'andalso',{is_integer,'$1'},{'>',{'+','$1',5},'$2'}}], - ['$1']}] = + " end)">>)), + ?assertEqual([{{'$1','$2'}, + [{'andalso', {is_integer,'$1'},{'>',{'+','$1',5},'$2'}}], + ['$1']}], compile_and_run( <<"ets:fun2ms(fun({A,B}) when is_integer(A) andalso (A+5 > B) ->" " A " - " end)">>), - [{{'$1','$2'}, + " end)">>)), + ?assertEqual([{{'$1','$2'}, [{'orelse',{is_atom,'$1'},{'>',{'+','$1',5},'$2'}}], - ['$1']}] = + ['$1']}], compile_and_run( <<"ets:fun2ms(fun({A,B}) when is_atom(A) orelse (A+5 > B) -> " " A " - " end)">>), + " end)">>)), ok. @@ -239,13 +249,8 @@ bitsyntax(Config) when is_list(Config) -> [<<0,27,0,27>>]}] = compile_and_run(<<"A = 27, " "ets:fun2ms(fun(_) -> <> end)">>), - [{{<<15,47>>, - '$1', - '$2'}, - [{'=:=','$1', - <<0,27>>}, - {'=:=','$2', - <<27,28,19>>}], + [{{<<15,47>>,<<0,27>>,<<27,28,19>>}, + [], [<<188,0,13>>]}] = compile_and_run(<<"A = 27, " "ets:fun2ms(" @@ -308,21 +313,21 @@ record_defaults(Config) when is_list(Config) -> %% Test basic ets:fun2ms. basic_ets(Config) when is_list(Config) -> setup(Config), - [{{a,b},[],[true]}] = compile_and_run( - <<"ets:fun2ms(fun({a,b}) -> true end)">>), - [{{'$1',foo},[{is_list,'$1'}],[{{{hd,'$1'},'$_'}}]}, - {{'$1','$1'},[{is_tuple,'$1'}],[{{{element,1,'$1'},'$*'}}]}] = + ?assertEqual([{{a,b},[],[true]}], compile_and_run( + <<"ets:fun2ms(fun({a,b}) -> true end)">>)), + ?assertEqual([{{'$1',foo},[{is_list,'$1'}],[{{{hd,'$1'},'$_'}}]}, + {{'$1','$1'},[{is_tuple,'$1'}],[{{{element,1,'$1'},'$*'}}]}], compile_and_run(<<"ets:fun2ms(fun({X,foo}) when is_list(X) -> ", "{hd(X),object()};", "({X,X}) when is_tuple(X) ->", "{element(1,X),bindings()}", - "end)">>), - [{{'$1','$2'},[],[{{'$2','$1'}}]}] = - compile_and_run(<<"ets:fun2ms(fun({A,B}) -> {B,A} end)">>), - [{{'$1','$2'},[],[['$2','$1']]}] = - compile_and_run(<<"ets:fun2ms(fun({A,B}) -> [B,A] end)">>), - [{{"foo" ++ '_','$1'},[],['$1']}] = - compile_and_run(<<"ets:fun2ms(fun({\"foo\" ++ _, X}) -> X end)">>), + "end)">>)), + ?assertEqual([{{'$1','$2'},[],[{{'$2','$1'}}]}], + compile_and_run(<<"ets:fun2ms(fun({A,B}) -> {B,A} end)">>)), + ?assertEqual([{{'$1','$2'},[],[['$2','$1']]}], + compile_and_run(<<"ets:fun2ms(fun({A,B}) -> [B,A] end)">>)), + ?assertEqual([{{"foo" ++ '_','$1'},[],['$1']}], + compile_and_run(<<"ets:fun2ms(fun({\"foo\" ++ _, X}) -> X end)">>)), ok. %% Tests basic dbg:fun2ms. @@ -368,39 +373,39 @@ records(Config) when is_list(Config) -> "t3," "t4" "}).">>, - [{{t,'$1','$2',foo,'_'},[{is_list,'$1'}],[{{{hd,'$1'},'$_'}}]}, - {{t,'_','_','_','_'},[{'==',{element,2,'$_'},nisse}],[{{'$*'}}]}] = + ?assertEqual([{{t,'$1','$2',foo,'_'},[{is_list,'$1'}],[{{{hd,'$1'},'$_'}}]}, + {{t,'_','_','_','_'},[{'==',{element,2,'$_'},nisse}],[{{'$*'}}]}], compile_and_run(RD,<< "ets:fun2ms(fun(#t{t1 = X, t2 = Y, t3 = foo}) when is_list(X) -> - {hd(X),object()}; + {hd(X),object()}; (#t{}) when (object())#t.t1 == nisse -> {bindings()} - end)">>), - [{{t,'$1','$2','_',foo}, + end)">>)), + ?assertEqual([{{t,'$1','$2','_',foo}, [{'==',{element,4,'$_'},7},{is_list,'$1'}], [{{{hd,'$1'},'$_'}}]}, {'$1',[{is_record,'$1',t,5}], [{{{element,2,'$1'}, {{t,'$1',foo,undefined,undefined}}, - {{t,{element,2,'$1'},{element,3,'$1'},{element,4,'$1'},boooo}}}}]}] = + {{t,{element,2,'$1'},{element,3,'$1'},{element,4,'$1'},boooo}}}}]}], compile_and_run(RD,<< - "ets:fun2ms(fun(#t{t1 = X, t2 = Y, t4 = foo}) when - (object())#t.t3==7,is_list(X) -> - {hd(X),object()}; - (A) when is_record(A,t) -> + "ets:fun2ms(fun(#t{t1 = X, t2 = Y, t4 = foo}) when + (object())#t.t3==7,is_list(X) -> + {hd(X),object()}; + (A) when is_record(A,t) -> {A#t.t1 ,#t{t1=A} ,A#t{t4=boooo} - } + } end)" - >>), + >>)), [{[{t,'$1','$2',foo,'_'}],[{is_list,'$1'}],[{{{hd,'$1'},'$_'}}]}, {[{t,'_','_','_','_'}],[{'==',{element,2,{hd,'$_'}},nisse}],[{{'$*'}}]}]= compile_and_run(RD,<< - "dbg:fun2ms(fun([#t{t1 = X, t2 = Y, t3 = foo}]) when is_list(X) -> - {hd(X),object()}; - ([#t{}]) when (hd(object()))#t.t1 == nisse -> - {bindings()} + "dbg:fun2ms(fun([#t{t1 = X, t2 = Y, t3 = foo}]) when is_list(X) -> + {hd(X),object()}; + ([#t{}]) when (hd(object()))#t.t1 == nisse -> + {bindings()} end)" >>), ok. @@ -455,7 +460,7 @@ map_expr_in_head_from_shell(Config) when is_list(Config) -> map_exprs(Config) when is_list(Config) -> setup(Config), - MSGuard = [{{key,'$1','$2'}, [{'=:=','$1',#{foo => '$2'}}], ['$1']}], + MSGuard = [{{key,#{foo => '$2'},'$2'}, [], [#{foo => '$2'}]}], MSGuard = compile_and_run( <<"ets:fun2ms(fun({key, V1, V2}) when V1 =:= #{foo => V2} -> V1 end)">>), MSBody = [{{key,'$1'}, [], [#{foo => '$1'}]}], @@ -465,7 +470,7 @@ map_exprs(Config) when is_list(Config) -> map_exprs_from_shell(Config) when is_list(Config) -> setup(Config), - MSGuard = [{{key,'$1','$2'}, [{'=:=','$1',#{foo => '$2'}}], ['$1']}], + MSGuard = [{{key,#{foo => '$2'},'$2'}, [], [#{foo => '$2'}]}], MSGuard = do_eval("ets:fun2ms(fun({key, V1, V2}) when V1 =:= #{foo => V2} -> V1 end)"), MSBody = [{{key,'$1'}, [], [#{foo => '$1'}]}], MSBody = do_eval("ets:fun2ms(fun({key, V}) -> #{foo => V} end)"), @@ -502,14 +507,14 @@ multipass(Config) when is_list(Config) -> expect_failure(RD,<<"ets:fun2ms(fun(A) -> #a{a=2,a=3} end)">>), expect_failure(RD,<<"ets:fun2ms(fun(A) -> A#a{a=2,a=3} end)">>), expect_failure(RD,<<"ets:fun2ms(fun(A) when A =:= #a{a=2,a=3} ->", - " true end)">>), - expect_failure(RD,<<"ets:fun2ms(fun({A,B})when A =:= B#a{a=2,a=3}->", + " true end)">>), + expect_failure(RD,<<"ets:fun2ms(fun({A,B}) when A =:= B#a{a=2,a=3}->", "true end)">>), expect_failure(RD,<<"ets:fun2ms(fun(#a{a=3,a=3}) -> true end)">>), compile_and_run(RD,<<"ets:fun2ms(fun(A) -> #a{a=2,b=3} end)">>), compile_and_run(RD,<<"ets:fun2ms(fun(A) -> A#a{a=2,b=3} end)">>), compile_and_run(RD,<<"ets:fun2ms(fun(A) when A =:= #a{a=2,b=3} ->", - " true end)">>), + " true end)">>), compile_and_run(RD,<<"ets:fun2ms(fun({A,B})when A=:= B#a{a=2,b=3}->", "true end)">>), compile_and_run(RD,<<"ets:fun2ms(fun(#a{a=3,b=3}) -> true end)">>), @@ -537,7 +542,7 @@ old_guards(Config) when is_list(Config) -> atom_to_list(Old), <<"(X) -> true end)">>]), case compile_and_run(Bin) of - [{'$1',[{New,'$1'}],[true]}] -> + [{'$1',[{New,'$1'}],[true]}] -> ok; _ -> exit({bad_result_for, binary_to_list(Bin)}) @@ -572,7 +577,7 @@ old_guards(Config) when is_list(Config) -> "binary(X), record(X,a) -> true end)" >>), ok. - + %% Test use of autoimported BIFs used like erlang:'+'(A,B) in guards %% and body. autoimported(Config) when is_list(Config) -> @@ -757,7 +762,7 @@ semicolon(Config) when is_list(Config) -> Res02 = compile_and_run (<<"ets:fun2ms(fun(X) when is_integer(X) -> true; " "(X) when is_float(X) -> true end)">>), - Res01 = Res02, + ?assertEqual(Res01, Res02), Res11 = compile_and_run (<<"ets:fun2ms(fun(X) when is_integer(X); " "is_float(X); atom(X) -> true end)">>), @@ -765,52 +770,52 @@ semicolon(Config) when is_list(Config) -> (<<"ets:fun2ms(fun(X) when is_integer(X) -> true; " "(X) when is_float(X) -> true; " "(X) when is_atom(X) -> true end)">>), - Res11 = Res12, + ?assertEqual(Res11, Res12), ok. - - + + %% OTP-5297. The function float/1. float_1_function(Config) when is_list(Config) -> setup(Config), - RunMS = fun(L, MS) -> - ets:match_spec_run(L, ets:match_spec_compile(MS)) + RunMS = fun(L, MS) -> + ets:match_spec_run(L, ets:match_spec_compile(MS)) end, MS1 = compile_and_run (<<"ets:fun2ms(fun(X) -> float(X) end)">>), [F1] = RunMS([3], MS1), - true = is_float(F1) and (F1 == 3), - + ?assert(is_float(F1) and (F1 == 3)), + MS1b = compile_and_run (<<"dbg:fun2ms(fun(X) -> float(X) end)">>), [F2] = RunMS([3], MS1b), - true = is_float(F2) and (F2 == 3), - + ?assert(is_float(F2) and (F2 == 3)), + MS2 = compile_and_run (<<"ets:fun2ms(fun(X) when is_pid(X) or float(X) -> true end)">>), - [] = RunMS([3.0], MS2), + ?assertEqual([], RunMS([3.0], MS2)), MS3 = compile_and_run (<<"dbg:fun2ms(fun(X) when is_pid(X); float(X) -> true end)">>), - [true] = RunMS([3.0], MS3), + ?assertEqual([true], RunMS([3.0], MS3)), MS4 = compile_and_run (<<"ets:fun2ms(fun(X) when erlang:float(X) > 1 -> big;" " (_) -> small end)">>), - [small,big] = RunMS([1.0, 3.0], MS4), + ?assertEqual([small,big], RunMS([1.0, 3.0], MS4)), MS5 = compile_and_run (<<"ets:fun2ms(fun(X) when float(X) > 1 -> big;" " (_) -> small end)">>), - [small,big] = RunMS([1.0, 3.0], MS5), + ?assertEqual([small,big], RunMS([1.0, 3.0], MS5)), %% This is the test from autoimported/1. - [{'$1',[{is_float,'$1'}],[{float,'$1'}]}] = + ?assertEqual([{'$1',[{is_float,'$1'}],[{float,'$1'}]}], compile_and_run - (<<"ets:fun2ms(fun(X) when float(X) -> float(X) end)">>), - [{'$1',[{float,'$1'}],[{float,'$1'}]}] = + (<<"ets:fun2ms(fun(X) when float(X) -> float(X) end)">>)), + ?assertEqual([{'$1',[{float,'$1'}],[{float,'$1'}]}], compile_and_run (<<"ets:fun2ms(fun(X) when erlang:'float'(X) -> " - "erlang:'float'(X) end)">>), + "erlang:'float'(X) end)">>)), ok. @@ -914,6 +919,688 @@ unused_record(Config) when is_list(Config) -> [] = compile_ww(Record, Expr), ok. +optimise_equality_guards_ets_compilation(Config) when is_list(Config) -> + setup(Config), + ?assertMatch( + [{{42,'$2'},[],[{{42,'$2'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V}) when K =:= 42 -> {K,V} end)">>)), + ?assertMatch( + [{{42,'$2'},[],[{{42,'$2'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V}) when 42 =:= K -> {K,V} end)">>)), + ?assertMatch( + [{{my_atom,'$2'},[],[{{my_atom,'$2'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V}) when K =:= my_atom -> {K,V} end)">>)), + ?assertMatch( + [{{[],'$2'},[],[{{[],'$2'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V}) when K =:= [] -> {K,V} end)">>)), + ?assertMatch( + [{{$z,'$2'},[],[{{$z,'$2'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V}) when K =:= $z -> {K,V} end)">>)), + ?assertMatch( + [{{"str",'$2'},[],[{{"str",'$2'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V}) when K =:= \"str\" -> {K,V} end)">>)), + ?assertMatch( + [{{42,my_atom,'$3'},[],[{{42,my_atom,'$3'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({A, B, C}) when A =:= 42, B =:= my_atom -> {A, B, C} end)">>)), + ?assertMatch( + [{{{'$1',42},'$3'},[],[{{{{'$1',42}},'$3'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({{K1,K2}, V}) when K2 =:= 42 -> {{K1,K2},V} end)">>)), + ?assertMatch( + [{{#{'$1':=42},'$3'},[],[{{#{'$1':=42},'$3'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({#{A := B}, V}) when B =:= 42 -> {#{A => 42},V} end)">>)), + ?assertMatch( + [{{#{a:=42},'$2'},[],[{{#{a:=42},'$2'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({#{a := B}, V}) when B =:= 42 -> {#{a => B},V} end)">>)), + ?assertMatch( + [{{#{42:='$2'},'$3'},[],[{{#{42:='$2'},'$3'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({#{A := B}, V}) when A =:= 42 -> {#{42 => B},V} end)">>)), + ?assertMatch( + [{{42,'$2'},[{'>', '$2', 10}],[{{42,'$2'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V}) when (V > 10) andalso (K =:= 42) -> {K,V} end)">>)), + ?assertMatch( + [{{42,'$2'},[{'>', '$2', 10}],[{{42,'$2'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V}) when (K =:= 42) and (V > 10) -> {K,V} end)">>)), + ?assertMatch( + [{{42,7,'$3'},[],[{{42,7,'$3'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V1, V2}) when (V1 =:= 7) andalso (K =:= 42) -> {K,V1,V2} end)">>)), + ?assertMatch( + [{{42,7,'$3'},[{'>', '$3', 6}],[{{42,7,'$3'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V1, V2}) when ((V2 > 6) andalso (V1 =:= 7)) andalso (K =:= 42) -> {K,V1,V2} end)">>)), + ?assertMatch( + [{{6,'$2'},[],[{{6,'$2'}}]}], + compile_and_run_decl( + <<"Needle">>, + 6, + <<"ets:fun2ms(fun ({K, V}) when K =:= Needle -> {K,V} end)">>)), + ?assertMatch( + [{{6.0,'$2'},[],[{{6.0,'$2'}}]}], + compile_and_run_decl( + <<"Needle">>, + 6.0, + <<"ets:fun2ms(fun ({K, V}) when K =:= Needle -> {K,V} end)">>)), + ?assertEqual( + [{ '$1', + [{'is_integer','$1'}, {'>', '$1', 2}], + ['$1'] + }], + compile_and_run( + <<"ets:fun2ms(fun(X) when is_integer(X), " + "X > 2 -> X end)">>) + ), + ?assertEqual( + [{ 2, + [], + ['true']} + ], + compile_and_run( + <<"ets:fun2ms(fun(X) when is_integer(X), " + "X =:= 2 -> true end)">>) + ), + ?assertEqual( + [{ '$1', + [ {'orelse', + {'is_integer','$1'}, + {'is_float','$1'}}], + ['$1']}, + { 5, + [], + [5]} + ], + compile_and_run( + <<"ets:fun2ms(fun(X) when is_integer(X); " + "is_float(X); X =:= 5 -> X end)">>) + ), + ?assertEqual( + [{ '$1', + [{'is_integer','$1'}], + ['$1']}, + { 8, + [], + [8]}, + { '$1', + [{'is_float','$1'}], + ['$1']} + ], + compile_and_run( + <<"ets:fun2ms(fun(X) when is_integer(X) -> X; " + "(X) when 8 =:= X -> X;" + "(X) when is_float(X) -> X end)">>) + ), + ?assertMatch( + [{{{1,2}},[],[{{1,2}}]}], + compile_and_run( + <<"ets:fun2ms(fun (A) when A =:= {1,2} -> A end)">>)), + ?assertMatch( + [{{{{11,12}},'$2','$3'},[{'>', '$2', 4}],['$3']}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V1, V2}) when (K =:= {11,12}) andalso (V1 > 4) -> V2 end)">>)), + ?assertMatch( + [{[1,2,3],[],[[1,2,3]]}], + compile_and_run( + <<"ets:fun2ms(fun (A) when A =:= [1,2,3] -> A end)">>)), + ?assertMatch( + [{{{[1,2,{{foo,bar}}], {{a, 7}}}},[],[{{[1,2,{{foo,bar}}], {{a, 7}}}}]}], + compile_and_run( + <<"ets:fun2ms(fun (Complex) when Complex =:= {[1,2,{foo,bar}], {a, 7}} -> Complex end)">>)), + ?assertMatch( + [{1,[false],[1]}], + compile_and_run( + <<"ets:fun2ms(fun (A) when A =:= 1, A > 2 -> A end)">>)), + ?assertMatch( + [{{42,'$2'},[{'>', '$2', 10}],[{{42,'$2'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V}) when (K =:= 42) and (V > 10) -> {K,V} end)">>)), + ?assertMatch( + [{{'$1', '$2'},[false],[{{'$1', '$2'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K, V}) when (K =:= 42) and (K =:= 7) -> {K,V} end)">>)), + ?assertMatch( + [{{'_','_'},[],['$_']}], + compile_and_run( + <<"ets:fun2ms(fun ({_, _}=KV) -> KV end)">>)), + ?assertMatch( + [{{'_',6},[],['$_']}], + compile_and_run( + <<"ets:fun2ms(fun (KV={_, V}) when V =:= 6 -> KV end)">>)), + ?assertMatch( + [{'$1',[{'=/=', '$1', 7}],['$1']}], + compile_and_run( + <<"ets:fun2ms(fun (A) when A =/= 7 -> A end)">>)), + ?assertMatch( + [{{'$1','$2',[{"yes",'_','_'}]},[],['$_']}], + compile_and_run( + <<"ets:fun2ms(fun({_A, _B, [{C, _, _}]} = All) when (C =:= \"yes\") -> All end)">>)), + ?assertMatch( + [{9,[],[11]}], + compile_and_run( + <<"ets:fun2ms(fun (A) when A =:= (4 + 5) -> (A + 2) end)">>)), + ?assertEqual( + [{0,[false],[0]}], + compile_and_run( + <<"ets:fun2ms(fun(X) when is_integer(X), " + "X =:= 0, " + "X > 2 -> X end)">>) + ), + ?assertEqual( + compile_and_run( + <<"ets:fun2ms(fun(X) when " + "X =:= 0; X =:= 6 -> X end)">>), + compile_and_run( + <<"ets:fun2ms(fun(X) when " + "(X =:= 0) or (X =:= 6) -> X end)">>) + ), + ?assertEqual( + compile_and_run( + <<"ets:fun2ms(fun(X) when X =:= 0 -> X; " + "(X) when X =:= 6 -> X end)">>), + compile_and_run( + <<"ets:fun2ms(fun(X) when " + "(X =:= 0) or (X =:= 6) -> X end)">>) + ), + ?assertEqual( + compile_and_run( + <<"ets:fun2ms(fun(X) when " + "X =:= 0, X =:= 6 -> X end)">>), + compile_and_run( + <<"ets:fun2ms(fun(X) when " + "(X =:= 0) and (X =:= 6) -> X end)">>) + ), + ?assertEqual( + compile_and_run( + <<"ets:fun2ms(fun(X) when " + "X =:= 0 -> X end)">>), + compile_and_run( + <<"ets:fun2ms(fun(X) when " + "is_integer(X), (X =:= 0) -> X end)">>) + ), + ?assertEqual( + compile_and_run( + <<"ets:fun2ms(fun(X) when X =:= 0 -> X; " + "(X) when X =:= 6 -> X;" + "(X) when is_integer(X) and (X > 11) -> X end)">>), + compile_and_run( + <<"ets:fun2ms(fun(X) when (is_integer(X) and " + "(X =:= 0)) or (X =:= 6) or (is_integer(X) and (X > 11)) -> X end)">>) + ), + ?assertEqual( + compile_and_run( + <<"ets:fun2ms(fun(X) when X =:= 0 -> X; " + "(X) when X =:= 6 -> X;" + "(X) when is_integer(X) and ((X > 11) or (X < -3)) -> X end)">>), + compile_and_run( + <<"ets:fun2ms(fun(X) when " + "(X =:= 0) or (X =:= 6) or (is_integer(X) and ((X > 11) or (X < -3))) -> X end)">>) + ), + ?assertMatch( + [{{[1,2,3],'$2'},[],['$2']}], + compile_and_run( + <<"ets:fun2ms(fun ({A,B}) when A =:= [1,2,3] -> B end)">>)), + ?assertMatch( + [{{<<"a string"/utf8>>,'$2'},[],['$2']}], + compile_and_run( + <<"ets:fun2ms(fun ({Bin, Val}) when Bin =:= <<\"a string\"/utf8>> -> Val end)">>)), + ?assertMatch( + [{{#{},'$2'},[],['$2']}], + compile_and_run( + <<"ets:fun2ms(fun ({Map, Val}) when Map =:= #{} -> Val end)">>)), + ?assertMatch( + [{{#{foo := bar},'$2'},[],['$2']}], + compile_and_run( + <<"ets:fun2ms(fun ({Map, Val}) when Map =:= #{foo => bar} -> Val end)">>)), + ?assertMatch( + [{{{'$1','$1'}, '$3'},[],['$3']}], + compile_and_run( + <<"ets:fun2ms(fun ({{K1,K2}, V}) when (K1 =:= K2) -> V end)">>)), + ?assertMatch( + [{{{'$1','$1'}, '$1', '$4'},[],['$4']}], + compile_and_run( + <<"ets:fun2ms(fun ({{K1,K2}, K3, V}) when (K1 =:= K2), (K3 =:= K2) -> V end)">>)), + ?assertMatch( + [{{{'$1','$1'}, '$1', '$3'},[],['$3']}], + compile_and_run( + <<"ets:fun2ms(fun ({{K1,K2}, K2, V}) when (K1 =:= K2) -> V end)">>)), + ?assertMatch( + [{{{'$1','$1'}, '$1', '$3'},[],['$3']}], + compile_and_run( + <<"ets:fun2ms(fun ({{K1,K2}, K2, V}) when (K2 =:= K1) -> V end)">>)), + ?assertMatch( + [{{{'$1','$1'}, '$1', '$4'},[],['$4']}], + compile_and_run( + <<"ets:fun2ms(fun ({{K1,K2}, K3, V}) when (K2 =:= K1) andalso (K3 =:= K2) -> V end)">>)), + ?assertMatch( + [{{{8,8},8, '$4'},[],['$4']}], + compile_and_run( + <<"ets:fun2ms(fun ({{K1,K2}, K3, V}) when (K2 =:= K1) andalso (K3 =:= K2) andalso (K2 =:= 8) -> V end)">>)), + ?assertMatch( + [{{{'$1','$1'}, '$1', '$4'},[],[{{'$1', '$4'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({{K1,K2}, K3, V}) when (K2 =:= K1) andalso (K3 =:= K2) -> {K3, V} end)">>)), + ?assertMatch( + [{{'$1','$1','$1','$1','$5'},[],[{{'$1','$5'}}]}], + compile_and_run( + <<"ets:fun2ms(fun ({K1,K2,K3,K4,V}) when (K2 =:= K1) andalso (K3 =:= K2) andalso (K1 =:= K4) -> {K3, V} end)">>)), + ok. + +optimise_equality_guards_ets_execution(Config) when is_list(Config) -> + setup(Config), + % We don't just use ets:test_ms/2 here, since we also watch to capture correctness + % with respect to more subtle parameters, such as ordered_set vs. set + ?assertMatch( + [{42,"yep"}], + compile_and_execute( + <<"ets:fun2ms(fun ({K, V}) when K =:= 42 -> {K,V} end)">>, + [ordered_set], + [{41,"nope"},{42,"yep"},{43,"no way"}] + ) + ), + ?assertMatch( + [{42,"yep"}], + compile_and_execute( + <<"ets:fun2ms(fun ({K, V}) when V =:= \"yep\" -> {K,V} end)">>, + [ordered_set], + [{41,"nope"},{42,"yep"},{43,"no way"}] + ) + ), + ?assertMatch( + [{42,my_atom,"yep"}], + compile_and_execute( + <<"ets:fun2ms(fun ({A, B, C}) when A =:= 42, B =:= my_atom -> {A, B, C} end)">>, + [set], + [ {41,my_atom,"nope"}, + {42,my_atom,"yep"}, + {43,your_atom, "no way"}, + {44,"not_an_atom", "definitely not"} + ] + ) + ), + ?assertMatch( + [{42,my_atom,"yep"}], + compile_and_execute( + <<"ets:fun2ms(fun ({A, B, C}) when A =:= 42, B =:= my_atom -> {A, B, C} end)">>, + [ordered_set], + [ {41,my_atom,"nope"}, + {42,my_atom,"yep"}, + {43,your_atom, "no way"}, + {44,"not_an_atom", "definitely not"} + ] + ) + ), + ?assertMatch( + [], + compile_and_execute( + <<"ets:fun2ms(fun ({A, B, C}) when A =:= 42, B =:= my_atom -> {A, B, C} end)">>, + [set], + [ {41,my_atom,"nope"}, + {42,your_atom,"yep"}, + {43,my_atom, "no way"}, + {44,"not_an_atom", "definitely not"} + ] + ) + ), + ?assertMatch( + [], + compile_and_execute( + <<"ets:fun2ms(fun ({A, B, C}) when A =:= 42, B =:= my_atom -> {A, B, C} end)">>, + [ordered_set], + [ {41,my_atom,"nope"}, + {42,your_atom,"yep"}, + {43,my_atom, "no way"}, + {44,"not_an_atom", "definitely not"} + ] + ) + ), + ?assertMatch( + [{42,my_atom,"yep"}], + compile_and_execute( + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [ordered_set], + [ {41,my_atom,"nope"}, + {42,my_atom,"yep"}, + {43,your_atom, "no way"}, + {44,"not_an_atom", "definitely not"} + ] + ) + ), + ?assertMatch( + [], + compile_and_execute( + <<"ets:fun2ms(fun ({A, B, C}) when A =:= 42, B =:= my_atom -> {A, B, C} end)">>, + [ordered_set], + [ {41.0,my_atom,"nope"}, + {42.0,my_atom,"yep"}, + {43.0,your_atom, "no way"}, + {44.0,"not_an_atom", "definitely not"} + ] + ) + ), + ?assertMatch( + [], + compile_and_execute( + <<"ets:fun2ms(fun ({A, B, C}) when A =:= 42, B =:= my_atom -> {A, B, C} end)">>, + [ordered_set], + [ {41.0,my_atom,"nope"}, + {42.0,my_atom,"yep"}, + {43.0,your_atom, "no way"}, + {44.0,"not_an_atom", "definitely not"} + ] + ) + ), + ?assertMatch( + [], + compile_and_execute( + <<"ets:fun2ms(fun ({A, B, C}) when A =:= 42, B =:= my_atom -> {A, B, C} end)">>, + [set], + [ {41.0,my_atom,"nope"}, + {42.0,my_atom,"yep"}, + {43.0,your_atom, "no way"}, + {44.0,"not_an_atom", "definitely not"} + ] + ) + ), + ok. + +optimise_equality_guards_ets_equivalence(Config) when is_list(Config) -> + setup(Config), + FloatKeySetData = + [ {41.0,my_atom,"nope"}, + {42.0,my_atom,"yep"}, + {43.0,your_atom, "no way"}, + {44.0,"not_an_atom", "definitely not"} + ], + IntKeySetData = + [ {41,my_atom,"nope"}, + {42,my_atom,"yep"}, + {43,your_atom, "no way"}, + {44,"not_an_atom", "definitely not"} + ], + FloatKeyBagData = + [ {41.0,my_atom,"nope"}, + {42.3,my_atom,"yep"}, + {42.3,my_atom,"yep"}, + {42.3,your_atom,"yes"}, + {43.0,your_atom, "no way"}, + {44.0,"not_an_atom", "definitely not"} + ], + IntKeyBagData = + [ {41,my_atom,"nope"}, + {42,my_atom,"yep"}, + {42,my_atom,"yep"}, + {42,your_atom,"yes"}, + {43,your_atom, "no way"}, + {44,"not_an_atom", "definitely not"} + ], + Compare = fun (SimpleQuery,OptimisedQuery,TableOpts,Data) -> + ?assertEqual( + compile_and_execute( + SimpleQuery, + TableOpts, + Data + ), + compile_and_execute( + OptimisedQuery, + TableOpts, + Data + ) + ) + end, + + % ordered_set float equality handling + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [ordered_set], + IntKeySetData), + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [ordered_set], + FloatKeySetData), + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42.0},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42.0) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [ordered_set], + IntKeySetData), + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42.0},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42.0) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [ordered_set], + FloatKeySetData), + + % set float equality handling + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [set], + IntKeySetData), + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [set], + FloatKeySetData), + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42.0},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42.0) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [set], + IntKeySetData), + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42.0},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42.0) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [set], + FloatKeySetData), + + % duplicate_bag float equality handling + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [duplicate_bag], + IntKeyBagData), + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [duplicate_bag], + FloatKeyBagData), + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42.3},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42.3) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [duplicate_bag], + IntKeyBagData), + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42.3},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42.3) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [duplicate_bag], + FloatKeyBagData), + + % bag float equality handling + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [bag], + IntKeyBagData), + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [bag], + FloatKeyBagData), + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42.3},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42.3) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [bag], + IntKeyBagData), + Compare( + <<"[{{'$1','$2','$3'}, + [{'andalso',{'=:=','$1',42.3},{'=:=','$2',my_atom}}], + [{{'$1','$2','$3'}}]}]">>, + <<"ets:fun2ms(fun ({A, B, C}) when (A =:= 42.3) andalso (B =:= my_atom) -> {A, B, C} end)">>, + [bag], + FloatKeyBagData), + + % handling of clause separators + Compare( + <<"ets:fun2ms(fun(X) when is_integer(X); " + "is_float(X) -> true end)">>, + <<"ets:fun2ms(fun(X) when is_integer(X) -> true; " + "(X) when is_float(X) -> true end)">>, + [ordered_set], + IntKeyBagData), + Compare( + <<"ets:fun2ms(fun(X) when is_integer(X); " + "is_float(X); atom(X) -> true end)">>, + <<"ets:fun2ms(fun(X) when is_integer(X) -> true; " + "(X) when is_float(X) -> true; " + "(X) when is_atom(X) -> true end)">>, + [ordered_set], + IntKeyBagData), + Compare( + <<"[{ {'$1'}, + [{'is_integer','$1'}], + ['$1']}, + { {'$1'}, + [{'is_float','$1'}], + ['$1']} + ]">>, + <<"ets:fun2ms(fun(X) when is_integer(X); " + "is_float(X) -> X end)">>, + [ordered_set], + IntKeyBagData), + Compare( + <<"[{ '_', + [false], + ['$_']} + ]">>, + <<"ets:fun2ms(fun(X) when is_integer(X), " + "X =:= 0, " + "X > 2 -> X end)">>, + [ordered_set], + IntKeyBagData), + Compare( + <<"[{ '$1', + [{'is_integer','$1'}], + [{{'$1'}}]}, + { 0, + [], + [{{0}}]}, + { '$1', + [{'>', '$1', 2}], + ['$1']} + ]">>, + <<"ets:fun2ms(fun(X) when is_integer(X); " + "X =:= 0; " + "X > 2 -> X end)">>, + [ordered_set], + IntKeyBagData), + Compare( + <<"[{ '$1', + [{'is_integer','$1'}], + [{{'$1'}}]}, + { 2, + [], + [{{2}}]} + ]">>, + <<"ets:fun2ms(fun(X) when is_integer(X), " + "X =:= 2 -> X end)">>, + [ordered_set], + IntKeyBagData), + + % The inlined value is itself a compound value + Compare( + <<"[{ {{41,my_atom,\"nope\"}}, + [], + [{{41,my_atom,\"nope\"}}] + }]">>, + <<"ets:fun2ms(fun (A) when A =:= {41,my_atom,\"nope\"} -> A end)">>, + [ordered_set], + IntKeySetData), + + % A carefully crafted query ends up giving the same results as + % a more naively written one + Compare( + <<"ets:fun2ms(fun({0,_}) -> 0; " + "({6,_}) -> 6; " + "({X,42}) when is_integer(X) -> X end)">>, + <<"ets:fun2ms(fun({X,Y}) when " + "(X =:= 0) orelse (X =:= 6) orelse (is_integer(X) andalso (Y =:= 42)) -> X end)">>, + [ordered_set], + [ {0,x}, + {6.0,42}, + {6,y}, + {b,42}, + {1,42}, + {a,42} + ] + ), + ok. + +ms_transform_optimisations_can_be_disabled_but_default_to_on(Config) -> + setup(Config), + OptimisableFunctionSrc = + <<"ets:fun2ms(fun (X) when X =:= 1 -> X end)">>, + OptimisationsOff = + compile_and_run_with_opt(OptimisableFunctionSrc, {no_optimise_fun2ms, true}), + OptimisationsOn = + compile_and_run_with_opt(OptimisableFunctionSrc, {no_optimise_fun2ms, false}), + OptimisationsDefault = + compile_and_run(OptimisableFunctionSrc), + ?assertEqual( + [{ '$1', + [{'=:=', '$1', 1}], + ['$1']} + ], + OptimisationsOff + ), + ?assertEqual( + [{ 1, + [], + [1]} + ], + OptimisationsOn + ), + ?assertEqual(OptimisationsOn, OptimisationsDefault). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Helpers %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -937,7 +1624,7 @@ expect_failure(Recs,Code) -> Other -> exit({expected,failure,got,Other}) end. - + compile_and_run(Expr) -> compile_and_run(<<>>,Expr). compile_and_run(Records,Expr) -> @@ -951,10 +1638,81 @@ compile_and_run(Records,Expr) -> FN=temp_name(), file:write_file(FN,Prog), {ok,Forms} = parse_file(FN), - {ok,tmp,Bin} = compile:forms(Forms), + Bin = + case compile:forms(Forms) of + {ok,tmp,B} -> B; + E -> + error(lists:flatten(io_lib:format( + "Compilation of match expression failed: ~tp~nForms were:~n~tp~nStacktrace:~tp~n", + [E, lists:flatten([erl_pp:form(Form) || Form <- Forms]), (catch error("Stack trace"))]))) + end, + code:load_binary(tmp,FN,Bin), + tmp:tmp(). + +compile_and_run_with_opt(Expr,Opt) -> + compile_and_run_with_opt(<<>>,Expr,Opt). +compile_and_run_with_opt(Records,Expr,Opt) -> + Prog = << + "-module(tmp).\n", + "-include_lib(\"stdlib/include/ms_transform.hrl\").\n", + "-export([tmp/0]).\n", + Records/binary,"\n", + "tmp() ->\n", + Expr/binary,".\n">>, + FN=temp_name(), + file:write_file(FN,Prog), + {ok,Forms} = parse_file(FN), + Bin = + case compile:forms(Forms,Opt) of + {ok,tmp,B} -> B; + E -> + error(lists:flatten(io_lib:format( + "Compilation of match expression failed: ~tp~nForms were:~n~tp~nStacktrace:~tp~n", + [E, lists:flatten([erl_pp:form(Form) || Form <- Forms]), (catch error("Stack trace"))]))) + end, code:load_binary(tmp,FN,Bin), tmp:tmp(). +compile_and_execute(Expr, TableOpts, TableData) -> + compile_and_execute(<<>>,Expr,TableOpts,TableData). +compile_and_execute(Records,Expr,TableOpts,TableData) -> + Prog = << + "-module(tmp).\n", + "-include_lib(\"stdlib/include/ms_transform.hrl\").\n", + "-export([tmp/0]).\n", + Records/binary,"\n", + "tmp() ->\n", + Expr/binary,".\n">>, + FN=temp_name(), + file:write_file(FN,Prog), + {ok,Forms} = parse_file(FN), + {ok,tmp,Bin} = compile:forms(Forms), + code:load_binary(tmp,FN,Bin), + MatchSpec = tmp:tmp(), + T = ets:new(t, TableOpts), + try + ets:insert(T, TableData), + ets:select(T, MatchSpec) + catch E -> + throw(E) + after + ets:delete(T) + end. + +compile_and_run_decl(ArgName, ArgValue, Body) -> + Prog = << + "-module(tmp).\n", + "-include_lib(\"stdlib/include/ms_transform.hrl\").\n", + "-export([tmp/1]).\n", + "tmp(",ArgName/binary,") ->\n", + Body/binary,".\n">>, + FN=temp_name(), + file:write_file(FN,Prog), + {ok,Forms} = parse_file(FN), + {ok,tmp,Bin} = compile:forms(Forms), + code:load_binary(tmp,FN,Bin), + tmp:tmp(ArgValue). + compile_ww(Expr) -> compile_ww(<<>>,Expr). diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index bc758cc308e0..e4e268af5a1b 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -7257,15 +7257,18 @@ manpage(Config) when is_list(Config) -> [2,3,4] = qlc:eval(QH), %% ets(3) - MS = ets:fun2ms(fun({X,Y}) when (X > 1) or (X < 5) -> {Y} end), + MS = ets:fun2ms(fun({X,Y}) when (X > 1) and (X < 5) -> {Y} end), ETs = [ [<<"true = ets:insert(Tab = ets:new(t, []),[{1,a},{2,b},{3,c},{4,d}]), MS = ">>, io_lib:format("~w", [MS]), <<", QH1 = ets:table(Tab, [{traverse, {select, MS}}]), - QH2 = qlc:q([{Y} || {X,Y} <- ets:table(Tab), (X > 1) or (X < 5)]), + QH2 = qlc:q([{Y} || {X,Y} <- ets:table(Tab), (X > 1) and (X < 5)]), - true = qlc:info(QH1) =:= qlc:info(QH2), + case (qlc:info(QH1) =:= qlc:info(QH2)) of + true -> ok; + false -> error({\"QH1 =/= QH2\", {qh1, QH1}, {qh2, QH2}}) + end, true = ets:delete(Tab)">>]], run(Config, ETs), @@ -7276,9 +7279,12 @@ manpage(Config) when is_list(Config) -> MS = ">>, io_lib:format("~w", [MS]), <<", QH1 = dets:table(T, [{traverse, {select, MS}}]), - QH2 = qlc:q([{Y} || {X,Y} <- dets:table(t), (X > 1) or (X < 5)]), + QH2 = qlc:q([{Y} || {X,Y} <- dets:table(t), (X > 1) and (X < 5)]), - true = qlc:info(QH1) =:= qlc:info(QH2), + case (qlc:info(QH1) =:= qlc:info(QH2)) of + true -> ok; + false -> error({\"QH1 =/= QH2\", {qh1, QH1}, {qh2, QH2}}) + end, ok = dets:close(T)">>]], run(Config, DTs), @@ -7872,7 +7878,7 @@ run_test(Config, Extra, {cres, Body, Opts, ExpectedCompileReturn}) -> R = case catch Mod:function() of {'EXIT', _Reason} = Error -> - io:format("failed, got ~p~n", [Error]), + io:format(standard_error, "failed, got ~p~n", [Error]), fail(SourceFile); Reply -> Reply