From 6c5c39827cc06a9e9b3e3fa4fa856f4610eb40b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Fri, 8 Nov 2013 23:50:43 +0100 Subject: Support non top level letrecs in dialyzer Dialyzer so far only supported letrecs at the top-level and comprehension-like letrecs (i.e. that were directly applied) in their body. This commit address this issue by storing in the callgraph bound letrec labels pointing to their functions. This information is then used by the dataflow to properly lookup recursive definitions. --- lib/dialyzer/src/dialyzer_callgraph.erl | 24 +++++++++++++++++++----- lib/dialyzer/src/dialyzer_dataflow.erl | 11 +++++------ lib/dialyzer/src/dialyzer_dep.erl | 27 +++++++++++++++++++++------ 3 files changed, 45 insertions(+), 17 deletions(-) diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index b9ad3f857d..bc32110751 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -35,6 +35,7 @@ is_escaping/2, is_self_rec/2, non_local_calls/1, + lookup_letrec/2, lookup_rec_var/2, lookup_call_site/2, lookup_label/2, @@ -81,6 +82,8 @@ %% digraph - A digraph representing the callgraph. %% Nodes are represented as MFAs or labels. %% esc - A set of all escaping functions as reported by dialyzer_dep. +%% letrec_map - A dict mapping from letrec bound labels to function labels. +%% Includes all functions. %% name_map - A mapping from label to MFA. %% rev_name_map - A reverse mapping of the name_map. %% rec_var_map - A dict mapping from letrec bound labels to function names. @@ -93,6 +96,7 @@ -record(callgraph, {digraph = digraph:new() :: digraph(), active_digraph :: active_digraph(), esc :: ets:tid(), + letrec_map :: ets:tid(), name_map :: ets:tid(), rev_name_map :: ets:tid(), rec_var_map :: ets:tid(), @@ -117,11 +121,12 @@ -spec new() -> callgraph(). new() -> - [ETSEsc, ETSNameMap, ETSRevNameMap, ETSRecVarMap, ETSSelfRec, ETSCalls] = + [ETSEsc, ETSNameMap, ETSRevNameMap, ETSRecVarMap, ETSLetrecMap, ETSSelfRec, ETSCalls] = [ets:new(N,[public, {read_concurrency, true}]) || N <- [callgraph_esc, callgraph_name_map, callgraph_rev_name_map, - callgraph_rec_var_map, callgraph_self_rec, callgraph_calls]], + callgraph_rec_var_map, callgraph_letrec_map, callgraph_self_rec, callgraph_calls]], #callgraph{esc = ETSEsc, + letrec_map = ETSLetrecMap, name_map = ETSNameMap, rev_name_map = ETSRevNameMap, rec_var_map = ETSRecVarMap, @@ -144,6 +149,12 @@ lookup_rec_var(Label, #callgraph{rec_var_map = RecVarMap}) when is_integer(Label) -> ets_lookup_dict(Label, RecVarMap). +-spec lookup_letrec(label(), callgraph()) -> 'error' | {'ok', label()}. + +lookup_letrec(Label, #callgraph{letrec_map = LetrecMap}) + when is_integer(Label) -> + ets_lookup_dict(Label, LetrecMap). + -spec lookup_call_site(label(), callgraph()) -> 'error' | {'ok', [_]}. % XXX: refine lookup_call_site(Label, #callgraph{calls = Calls}) @@ -348,16 +359,18 @@ ets_lookup_set(Key, Table) -> scan_core_tree(Tree, #callgraph{calls = ETSCalls, esc = ETSEsc, + letrec_map = ETSLetrecMap, name_map = ETSNameMap, rec_var_map = ETSRecVarMap, rev_name_map = ETSRevNameMap, self_rec = ETSSelfRec}) -> %% Build name map and recursion variable maps. - build_maps(Tree, ETSRecVarMap, ETSNameMap, ETSRevNameMap), + build_maps(Tree, ETSRecVarMap, ETSNameMap, ETSRevNameMap, ETSLetrecMap), %% First find the module-local dependencies. - {Deps0, EscapingFuns, Calls} = dialyzer_dep:analyze(Tree), + {Deps0, EscapingFuns, Calls, Letrecs} = dialyzer_dep:analyze(Tree), true = ets:insert(ETSCalls, dict:to_list(Calls)), + true = ets:insert(ETSLetrecMap, dict:to_list(Letrecs)), true = ets:insert(ETSEsc, [{E} || E <- EscapingFuns]), LabelEdges = get_edges_from_deps(Deps0), @@ -394,7 +407,7 @@ scan_core_tree(Tree, #callgraph{calls = ETSCalls, NamedEdges3 = NewNamedEdges1 ++ NewNamedEdges2, {Names3, NamedEdges3}. -build_maps(Tree, ETSRecVarMap, ETSNameMap, ETSRevNameMap) -> +build_maps(Tree, ETSRecVarMap, ETSNameMap, ETSRevNameMap, ETSLetrecMap) -> %% We only care about the named (top level) functions. The anonymous %% functions will be analysed together with their parents. Defs = cerl:module_defs(Tree), @@ -406,6 +419,7 @@ build_maps(Tree, ETSRecVarMap, ETSNameMap, ETSRevNameMap) -> MFA = {Mod, FunName, Arity}, FunLabel = get_label(Function), VarLabel = get_label(Var), + true = ets:insert(ETSLetrecMap, {VarLabel, FunLabel}), true = ets:insert(ETSNameMap, {FunLabel, MFA}), true = ets:insert(ETSRevNameMap, {MFA, FunLabel}), true = ets:insert(ETSRecVarMap, {VarLabel, MFA}) diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 6956850f1a..922ccad599 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -308,7 +308,7 @@ traverse(Tree, Map, State) -> {State1, Map1, Type}; var -> ?debug("Looking up unknown variable: ~p\n", [Tree]), - case state__lookup_type_for_rec_var(Tree, State) of + case state__lookup_type_for_letrec(Tree, State) of error -> LType = lookup_type(Tree, Map), Opaques = State#state.opaques, @@ -1468,7 +1468,7 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) -> var -> Opaques = State#state.opaques, VarType1 = - case state__lookup_type_for_rec_var(Pat, State) of + case state__lookup_type_for_letrec(Pat, State) of error -> LType = lookup_type(Pat, Map), case t_opaque_match_record(LType, Opaques) of @@ -2829,12 +2829,11 @@ state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab, state__is_escaping(Fun, #state{callgraph = Callgraph}) -> dialyzer_callgraph:is_escaping(Fun, Callgraph). -state__lookup_type_for_rec_var(Var, #state{callgraph = Callgraph} = State) -> +state__lookup_type_for_letrec(Var, #state{callgraph = Callgraph} = State) -> Label = get_label(Var), - case dialyzer_callgraph:lookup_rec_var(Label, Callgraph) of + case dialyzer_callgraph:lookup_letrec(Label, Callgraph) of error -> error; - {ok, MFA} -> - {ok, FunLabel} = dialyzer_callgraph:lookup_label(MFA, Callgraph), + {ok, FunLabel} -> {ok, state__fun_type(FunLabel, State)} end. diff --git a/lib/dialyzer/src/dialyzer_dep.erl b/lib/dialyzer/src/dialyzer_dep.erl index febb65b766..1a477f4388 100644 --- a/lib/dialyzer/src/dialyzer_dep.erl +++ b/lib/dialyzer/src/dialyzer_dep.erl @@ -39,7 +39,7 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% -%% analyze(CoreTree) -> {Deps, Esc, Calls}. +%% analyze(CoreTree) -> {Deps, Esc, Calls, Letrecs}. %% %% Deps = a dict mapping labels of functions to an ordset of functions %% it calls. @@ -53,6 +53,10 @@ %% which the operation can refer to. If 'external' is part of %% the set the operation can be externally defined. %% +%% Letrecs = a dict mapping var labels to their recursive definition. +%% top-level letrecs are not included as they are handled +%% separatedly. +%% -spec analyze(cerl:c_module()) -> {dict(), ordset('external' | label()), dict()}. @@ -64,7 +68,8 @@ analyze(Tree) -> State1 = state__add_deps(external, output(Esc), State), Deps = state__deps(State1), Calls = state__calls(State1), - {map__finalize(Deps), set__to_ordsets(Esc), map__finalize(Calls)}. + Letrecs = state__letrecs(State1), + {map__finalize(Deps), set__to_ordsets(Esc), map__finalize(Calls), Letrecs}. traverse(Tree, Out, State, CurrentFun) -> %% io:format("Type: ~w\n", [cerl:type(Tree)]), @@ -131,9 +136,12 @@ traverse(Tree, Out, State, CurrentFun) -> letrec -> Defs = cerl:letrec_defs(Tree), Body = cerl:letrec_body(Tree), + State1 = lists:foldl(fun({ Var, Fun }, Acc) -> + state__add_letrecs(cerl_trees:get_label(Var), cerl_trees:get_label(Fun), Acc) + end, State, Defs), Out1 = bind_defs(Defs, Out), - State1 = traverse_defs(Defs, Out1, State, CurrentFun), - traverse(Body, Out1, State1, CurrentFun); + State2 = traverse_defs(Defs, Out1, State1, CurrentFun), + traverse(Body, Out1, State2, CurrentFun); literal -> {output(none), State}; module -> @@ -463,7 +471,8 @@ all_vars(Tree, AccIn) -> -record(state, {deps :: dict(), esc :: local_set(), call :: dict(), - arities :: dict()}). + arities :: dict(), + letrecs :: dict()}). state__new(Tree) -> Exports = set__from_list([X || X <- cerl:module_exports(Tree)]), @@ -471,7 +480,7 @@ state__new(Tree) -> || {Var, Fun} <- cerl:module_defs(Tree), set__is_element(Var, Exports)]), Arities = cerl_trees:fold(fun find_arities/2, dict:new(), Tree), - #state{deps = map__new(), esc = InitEsc, call = map__new(), arities = Arities}. + #state{deps = map__new(), esc = InitEsc, call = map__new(), arities = Arities, letrecs = map__new()}. find_arities(Tree, AccMap) -> case cerl:is_c_fun(Tree) of @@ -490,9 +499,15 @@ state__add_deps(From, #output{type = single, content=To}, %% io:format("Adding deps from ~w to ~w\n", [From, set__to_ordsets(To)]), State#state{deps = map__add(From, To, Map)}. +state__add_letrecs(Var, Fun, #state{letrecs = Map} = State) -> + State#state{letrecs = map__store(Var, Fun, Map)}. + state__deps(#state{deps = Deps}) -> Deps. +state__letrecs(#state{letrecs = Letrecs}) -> + Letrecs. + state__add_esc(#output{content = none}, State) -> State; state__add_esc(#output{type = single, content = Set}, -- cgit v1.2.3 From acbca8379bdde12612e27f3313a5c73f4db25381 Mon Sep 17 00:00:00 2001 From: Anthony Ramine Date: Sat, 10 Nov 2012 17:06:01 +0100 Subject: EEP 37: Funs with names This adds optional names to fun expressions. A named fun expression is parsed as a tuple `{named_fun,Loc,Name,Clauses}` in erl_parse. If a fun expression has a name, it must be present and be the same in every of its clauses. The function name shadows the environment of the expression shadowing the environment and it is shadowed by the environment of the clauses' arguments. An unused function name triggers a warning unless it is prefixed by _, just as every variable. Variable _ is allowed as a function name. It is not an error to put a named function in a record field default value. When transforming to Core Erlang, the named fun Fun is changed into the following expression: letrec 'Fun'/Arity = fun (Args) -> let = 'Fun'/Arity in Case in 'Fun'/Arity where Args is the list of arguments of 'Fun'/Arity and Case the Core Erlang expression corresponding to the clauses of Fun. This transformation allows us to entirely skip any k_var to k_local transformation in the fun's clauses bodies. --- lib/compiler/src/sys_pre_expand.erl | 14 ++- lib/compiler/src/v3_core.erl | 68 +++++++---- .../src/compiler/sys_expand_pmod.erl | 2 + lib/stdlib/examples/erl_id_trans.erl | 2 + lib/stdlib/src/epp.erl | 2 + lib/stdlib/src/erl_expand_records.erl | 3 + lib/stdlib/src/erl_lint.erl | 10 ++ lib/stdlib/src/erl_parse.yrl | 12 +- lib/stdlib/src/erl_pp.erl | 20 +++- lib/stdlib/src/ms_transform.erl | 7 ++ lib/stdlib/src/qlc_pt.erl | 16 +++ lib/syntax_tools/src/erl_syntax.erl | 126 ++++++++++++++++++++- lib/tools/src/cover.erl | 7 ++ lib/tools/src/xref_reader.erl | 10 ++ 14 files changed, 268 insertions(+), 31 deletions(-) diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index 7d918a55ed..48d9c16718 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -344,6 +344,8 @@ expr({'receive',Line,Cs0,To0,ToEs0}, St0) -> {{'receive',Line,Cs,To,ToEs},St3}; expr({'fun',Line,Body}, St) -> fun_tq(Line, Body, St); +expr({named_fun,Line,Name,Cs}, St) -> + fun_tq(Line, Cs, St, Name); expr({call,Line,{atom,La,N}=Atom,As0}, St0) -> {As,St1} = expr_list(As0, St0), Ar = length(As), @@ -475,6 +477,11 @@ fun_tq(Lf, {clauses,Cs0}, St0) -> Index = Uniq = 0, {{'fun',Lf,{clauses,Cs1},{Index,Uniq,Fname}},St2}. +fun_tq(Line, Cs0, St0, Name) -> + {Cs1,St1} = fun_clauses(Cs0, St0), + {Fname,St2} = new_fun_name(St1, Name), + {{named_fun,Line,Name,Cs1,{0,0,Fname}},St2}. + fun_clauses([{clause,L,H0,G0,B0}|Cs0], St0) -> {H,St1} = head(H0, St0), {G,St2} = guard(G0, St1), @@ -485,9 +492,12 @@ fun_clauses([], St) -> {[],St}. %% new_fun_name(State) -> {FunName,State}. -new_fun_name(#expand{func=F,arity=A,fcount=I}=St) -> +new_fun_name(St) -> + new_fun_name(St, 'fun'). + +new_fun_name(#expand{func=F,arity=A,fcount=I}=St, FName) -> Name = "-" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A) - ++ "-fun-" ++ integer_to_list(I) ++ "-", + ++ "-" ++ atom_to_list(FName) ++ "-" ++ integer_to_list(I) ++ "-", {list_to_atom(Name),St#expand{fcount=I+1}}. %% pattern_bin([Element], State) -> {[Element],[Variable],[UsedVar],State}. diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 33f5015e0b..321cf7af1c 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -92,7 +92,7 @@ -record(icase, {anno=#a{},args,clauses,fc}). -record(icatch, {anno=#a{},body}). -record(iclause, {anno=#a{},pats,pguard=[],guard,body}). --record(ifun, {anno=#a{},id,vars,clauses,fc}). +-record(ifun, {anno=#a{},id,vars,clauses,fc,name=unnamed}). -record(iletrec, {anno=#a{},defs,body}). -record(imatch, {anno=#a{},pat,guard=[],arg,fc}). -record(iprimop, {anno=#a{},name,args}). @@ -587,7 +587,11 @@ expr({'fun',L,{function,M,F,A}}, St0) -> name=#c_literal{val=make_fun}, args=As},Aps,St1}; expr({'fun',L,{clauses,Cs},Id}, St) -> - fun_tq(Id, Cs, L, St); + fun_tq(Id, Cs, L, St, unnamed); +expr({named_fun,L,'_',Cs,Id}, St) -> + fun_tq(Id, Cs, L, St, unnamed); +expr({named_fun,L,Name,Cs,{Index,Uniq,_Fname}}, St) -> + fun_tq({Index,Uniq,Name}, Cs, L, St, {named, Name}); expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) -> {[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0), Lanno = lineno_anno(L, St1), @@ -842,9 +846,9 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> flags=#c_literal{val=Flags}}, Eps ++ Eps2,St2}. -%% fun_tq(Id, [Clauses], Line, State) -> {Fun,[PreExp],State}. +%% fun_tq(Id, [Clauses], Line, State, NameInfo) -> {Fun,[PreExp],State}. -fun_tq({_,_,Name}=Id, Cs0, L, St0) -> +fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> Arity = clause_arity(hd(Cs0)), {Cs1,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), @@ -853,7 +857,7 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0) -> Fc = function_clause(Ps, Anno, {Name,Arity}), Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! - vars=Args,clauses=Cs1,fc=Fc}, + vars=Args,clauses=Cs1,fc=Fc,name=NameInfo}, {Fun,[],St3}. %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. @@ -1711,13 +1715,18 @@ uexpr(#icase{anno=A,args=As0,clauses=Cs0,fc=Fc0}, Ks, St0) -> Used = union(used_in_any(As1), used_in_any(Cs1)), New = new_in_all(Cs1), {#icase{anno=A#a{us=Used,ns=New},args=As1,clauses=Cs1,fc=Fc1},St3}; -uexpr(#ifun{anno=A,id=Id,vars=As,clauses=Cs0,fc=Fc0}, Ks0, St0) -> +uexpr(#ifun{anno=A0,id=Id,vars=As,clauses=Cs0,fc=Fc0,name=Name}, Ks0, St0) -> Avs = lit_list_vars(As), - Ks1 = union(Avs, Ks0), - {Cs1,St1} = ufun_clauses(Cs0, Ks1, St0), - {Fc1,St2} = ufun_clause(Fc0, Ks1, St1), - Used = subtract(intersection(used_in_any(Cs1), Ks0), Avs), - {#ifun{anno=A#a{us=Used,ns=[]},id=Id,vars=As,clauses=Cs1,fc=Fc1},St2}; + Ks1 = case Name of + unnamed -> Ks0; + {named,FName} -> union(subtract([FName], Avs), Ks0) + end, + Ks2 = union(Avs, Ks1), + {Cs1,St1} = ufun_clauses(Cs0, Ks2, St0), + {Fc1,St2} = ufun_clause(Fc0, Ks2, St1), + Used = subtract(intersection(used_in_any(Cs1), Ks1), Avs), + A1 = A0#a{us=Used,ns=[]}, + {#ifun{anno=A1,id=Id,vars=As,clauses=Cs1,fc=Fc1,name=Name},St2}; uexpr(#iapply{anno=A,op=Op,args=As}, _, St) -> Used = union(lit_vars(Op), lit_list_vars(As)), {#iapply{anno=A#a{us=Used},op=Op,args=As},St}; @@ -2012,15 +2021,24 @@ cexpr(#itry{anno=A,args=La,vars=Vs,body=Lb,evars=Evs,handler=Lh}, As, St0) -> cexpr(#icatch{anno=A,body=Les}, _As, St0) -> {Ces,_Us1,St1} = cexprs(Les, [], St0), %Never export! {#c_catch{body=Ces},[],A#a.us,St1}; -cexpr(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> - {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export! - {Cfc,St2} = cclause(Lfc, [], St1), - Anno = A#a.anno, - {#c_fun{anno=Id++Anno,vars=Args, - body=#c_case{anno=Anno, - arg=set_anno(core_lib:make_values(Args), Anno), - clauses=Ccs ++ [Cfc]}}, - [],A#a.us,St2}; +cexpr(#ifun{name=unnamed}=Fun, As, St0) -> + cfun(Fun, As, St0); +cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0, + As, St0) -> + case is_element(Name, Us0) of + false -> + cfun(Fun0, As, St0); + true -> + A1 = A0#a{us=del_element(Name, Us0)}, + Fun1 = Fun0#ifun{anno=A1}, + {#c_fun{body=Body}=CFun0,[],Us1,St1} = cfun(Fun1, As, St0), + RecVar = #c_var{name={Name,length(Ps)}}, + Let = #c_let{vars=[#c_var{name=Name}],arg=RecVar,body=Body}, + CFun1 = CFun0#c_fun{body=Let}, + Letrec = #c_letrec{defs=[{RecVar,CFun1}], + body=RecVar}, + {Letrec,[],Us1,St1} + end; cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) -> {#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St}; cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) -> @@ -2047,6 +2065,16 @@ cexpr(Lit, _As, St) -> %%Vs = lit_vars(Lit), {set_anno(Lit, Anno#a.anno),[],Vs,St}. +cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> + {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export! + {Cfc,St2} = cclause(Lfc, [], St1), + Anno = A#a.anno, + {#c_fun{anno=Id++Anno,vars=Args, + body=#c_case{anno=Anno, + arg=set_anno(core_lib:make_values(Args), Anno), + clauses=Ccs ++ [Cfc]}}, + [],A#a.us,St2}. + %% lit_vars(Literal) -> [Var]. lit_vars(Lit) -> lit_vars(Lit, []). diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_expand_pmod.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_expand_pmod.erl index f48cc05b9c..cd13f468b2 100644 --- a/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_expand_pmod.erl +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_expand_pmod.erl @@ -341,6 +341,8 @@ expr({'fun',Line,Body,Info},St) -> {function,M,F,A} -> %This is an error in lint! {'fun',Line,{function,M,F,A},Info} end; +expr({named_fun,Loc,Name,Cs,Info},St) -> + {named_fun,Loc,Name,fun_clauses(Cs, St),Info}; expr({call,Lc,{atom,_,new}=Name,As0},#pmod{parameters=Ps}=St) when length(As0) =:= length(Ps) -> %% The new() function does not take a 'THIS' argument (it's static). diff --git a/lib/stdlib/examples/erl_id_trans.erl b/lib/stdlib/examples/erl_id_trans.erl index 51def8c8e1..2c842fafc7 100644 --- a/lib/stdlib/examples/erl_id_trans.erl +++ b/lib/stdlib/examples/erl_id_trans.erl @@ -419,6 +419,8 @@ expr({'fun',Line,Body}) -> A = expr(A0), {'fun',Line,{function,M,F,A}} end; +expr({named_fun,Loc,Name,Cs}) -> + {named_fun,Loc,Name,fun_clauses(Cs)}; expr({call,Line,F0,As0}) -> %% N.B. If F an atom then call to local function or BIF, if F a %% remote structure (see below) then call to other module, diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index dd0512be4d..4fd302e612 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -1247,6 +1247,8 @@ macro_arg([{'case',Lc}|Toks], E, Arg) -> macro_arg(Toks, ['end'|E], [{'case',Lc}|Arg]); macro_arg([{'fun',Lc}|[{'(',_}|_]=Toks], E, Arg) -> macro_arg(Toks, ['end'|E], [{'fun',Lc}|Arg]); +macro_arg([{'fun',_}=Fun,{var,_,_}=Name|[{'(',_}|_]=Toks], E, Arg) -> + macro_arg(Toks, ['end'|E], [Name,Fun|Arg]); macro_arg([{'receive',Lr}|Toks], E, Arg) -> macro_arg(Toks, ['end'|E], [{'receive',Lr}|Arg]); macro_arg([{'try',Lr}|Toks], E, Arg) -> diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index d05f630d8e..776b433613 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -344,6 +344,9 @@ expr({'fun',_,{function,_M,_F,_A}}=Fun, St) -> expr({'fun',Line,{clauses,Cs0}}, St0) -> {Cs,St1} = clauses(Cs0, St0), {{'fun',Line,{clauses,Cs}},St1}; +expr({named_fun,Line,Name,Cs0}, St0) -> + {Cs,St1} = clauses(Cs0, St0), + {{named_fun,Line,Name,Cs},St1}; expr({call,Line,{atom,_,is_record},[A,{atom,_,Name}]}, St) -> record_test(Line, A, Name, St); expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,is_record}}, diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index bcf3ccef3b..cf01e1f8cf 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2030,6 +2030,15 @@ expr({'fun',Line,Body}, Vt, St) -> {Bvt, St1} = expr_list([M,F,A], Vt, St), {vtupdate(Bvt, Vt),St1} end; +expr({named_fun,_,'_',Cs}, Vt, St) -> + fun_clauses(Cs, Vt, St); +expr({named_fun,Line,Name,Cs}, Vt, St0) -> + Nvt0 = [{Name,{bound,unused,[Line]}}], + St1 = shadow_vars(Nvt0, Vt, 'named fun', St0), + Nvt1 = vtupdate(vtsubtract(Vt, Nvt0), Nvt0), + {Csvt,St2} = fun_clauses(Cs, Nvt1, St1), + {_,St3} = check_unused_vars(vtupdate(Csvt, Nvt0), [], St2), + {vtold(Csvt, Vt),St3}; expr({call,_Line,{atom,_Lr,is_record},[E,{atom,Ln,Name}]}, Vt, St0) -> {Rvt,St1} = expr(E, Vt, St0), {Rvt,exist_record(Ln, Name, St1)}; @@ -2182,6 +2191,7 @@ is_valid_record(Rec) -> {lc, _, _, _} -> false; {record_index, _, _, _} -> false; {'fun', _, _} -> false; + {named_fun, _, _, _} -> false; _ -> true end. diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 7145b0858f..59a05a48ee 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -406,6 +406,9 @@ fun_clause -> argument_list clause_guard clause_body : {Args,Pos} = '$1', {clause,Pos,'fun',Args,'$2','$3'}. +fun_clause -> var argument_list clause_guard clause_body : + {clause,element(2, '$1'),element(3, '$1'),element(1, '$2'),'$3','$4'}. + try_expr -> 'try' exprs 'of' cr_clauses try_catch : build_try(?line('$1'),'$2','$4','$5'). try_expr -> 'try' exprs try_catch : @@ -799,8 +802,15 @@ build_rule(Cs) -> %% build_fun(Line, [Clause]) -> {'fun',Line,{clauses,[Clause]}}. build_fun(Line, Cs) -> + Name = element(3, hd(Cs)), Arity = length(element(4, hd(Cs))), - {'fun',Line,{clauses,check_clauses(Cs, 'fun', Arity)}}. + CheckedCs = check_clauses(Cs, Name, Arity), + case Name of + 'fun' -> + {'fun',Line,{clauses,CheckedCs}}; + Name -> + {named_fun,Line,Name,CheckedCs} + end. check_clauses(Cs, Name, Arity) -> mapl(fun ({clause,L,N,As,G,B}) when N =:= Name, length(As) =:= Arity -> diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl index 657cb5d34c..8a1d8e0440 100644 --- a/lib/stdlib/src/erl_pp.erl +++ b/lib/stdlib/src/erl_pp.erl @@ -511,10 +511,17 @@ lexpr({'fun',_,{function,M,F,A}}, _Prec, Opts) -> ArityItem = lexpr(A, Opts), ["fun ",NameItem,$:,CallItem,$/,ArityItem]; lexpr({'fun',_,{clauses,Cs}}, _Prec, Opts) -> - {list,[{first,'fun',fun_clauses(Cs, Opts)},'end']}; + {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},'end']}; +lexpr({named_fun,_,Name,Cs}, _Prec, Opts) -> + {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}; lexpr({'fun',_,{clauses,Cs},Extra}, _Prec, Opts) -> {force_nl,fun_info(Extra), - {list,[{first,'fun',fun_clauses(Cs, Opts)},'end']}}; + {list,[{first,'fun',fun_clauses(Cs, Opts, unnamed)},'end']}}; +lexpr({named_fun,_,Name,Cs,Extra}, _Prec, Opts) -> + {force_nl,fun_info(Extra), + {list,[{first,['fun', " "],fun_clauses(Cs, Opts, {named, Name})},'end']}}; +lexpr({'query',_,Lc}, _Prec, Opts) -> + {list,[{step,leaf("query"),lexpr(Lc, 0, Opts)},'end']}; lexpr({call,_,{remote,_,{atom,_,M},{atom,_,F}=N}=Name,Args}, Prec, Opts) -> case erl_internal:bif(M, F, length(Args)) of true -> @@ -729,8 +736,13 @@ stack_backtrace(S, El, Opts) -> %% fun_clauses(Clauses, Opts) -> [Char]. %% Print 'fun' clauses. -fun_clauses(Cs, Opts) -> - nl_clauses(fun fun_clause/2, [$;], Opts, Cs). +fun_clauses(Cs, Opts, unnamed) -> + nl_clauses(fun fun_clause/2, [$;], Opts, Cs); +fun_clauses(Cs, Opts, {named, Name}) -> + nl_clauses(fun (C, H) -> + {step,Gl,Bl} = fun_clause(C, H), + {step,[atom_to_list(Name),Gl],Bl} + end, [$;], Opts, Cs). fun_clause({clause,_,A,G,B}, Opts) -> El = args(A, Opts), diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 4e2ce39ec2..25b04fe45e 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -369,6 +369,13 @@ copy({var,_Line,Name} = VarDef,Bound) -> copy({'fun',Line,{clauses,Clauses}},Bound) -> % Dont export bindings from funs {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound), {{'fun',Line,{clauses,NewClauses}},Bound}; +copy({named_fun,Line,Name,Clauses},Bound) -> % Dont export bindings from funs + Bound1 = case Name of + '_' -> Bound; + Name -> gb_sets:add(Name,Bound) + end, + {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound1), + {{named_fun,Line,Name,NewClauses},Bound}; copy({'case',Line,Of,ClausesList},Bound) -> % Dont export bindings from funs {NewOf,NewBind0} = copy(Of,Bound), {NewClausesList,NewBindings} = copy_case_clauses(ClausesList,NewBind0,[]), diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index 26bc4d1bdf..c26764eb18 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -2540,6 +2540,19 @@ nos({'fun',L,{clauses,Cs}}, S) -> {clause,Ln,H,G,B} end || {clause,Ln,H0,G0,B0} <- Cs], {{'fun',L,{clauses,NCs}}, S}; +nos({named_fun,Loc,Name,Cs}, S) -> + {{var,NLoc,NName}, S1} = case Name of + '_' -> + S; + Name -> + nos_pattern({var,Loc,Name}, S) + end, + NCs = [begin + {H, S2} = nos_pattern(H0, S1), + {[G, B], _} = nos([G0, B0], S2), + {clause,CLoc,H,G,B} + end || {clause,CLoc,H0,G0,B0} <- Cs], + {{named_fun,NLoc,NName,NCs}, S}; nos({lc,L,E0,Qs0}, S) -> %% QLCs as well as LCs. It is OK to modify LCs as long as they %% occur within QLCs--the warning messages have already been found @@ -2713,6 +2726,9 @@ var2const(E) -> var_map(F, {var, _, _}=V) -> F(V); +var_map(F, {named_fun,NLoc,NName,Cs}) -> + {var,Loc,Name} = F({var,NLoc,NName}), + {named_fun,Loc,Name,var_map(F, Cs)}; var_map(F, T) when is_tuple(T) -> list_to_tuple(var_map(F, tuple_to_list(T))); var_map(F, [E | Es]) -> diff --git a/lib/syntax_tools/src/erl_syntax.erl b/lib/syntax_tools/src/erl_syntax.erl index 409805e95f..5911502960 100644 --- a/lib/syntax_tools/src/erl_syntax.erl +++ b/lib/syntax_tools/src/erl_syntax.erl @@ -226,6 +226,10 @@ module_qualifier/2, module_qualifier_argument/1, module_qualifier_body/1, + named_fun_expr/2, + named_fun_expr_arity/1, + named_fun_expr_clauses/1, + named_fun_expr_name/1, nil/0, operator/1, operator_literal/1, @@ -442,28 +446,30 @@ %% match_expr %% module_qualifier %% +%% named_fun_expr %% nil %% operator %% parentheses -%% prefix_expr %% +%% prefix_expr %% receive_expr %% record_access -%% %% record_expr +%% %% record_field %% record_index_expr %% rule -%% %% size_qualifier +%% %% string %% text %% try_expr -%% %% tuple +%% %% underscore %% variable %% warning_marker +%% %% %% %% @@ -506,6 +512,7 @@ %% @see macro/2 %% @see match_expr/2 %% @see module_qualifier/2 +%% @see named_fun_expr/1 %% @see nil/0 %% @see operator/1 %% @see parentheses/1 @@ -554,6 +561,7 @@ type(Node) -> {'catch', _, _} -> catch_expr; {'cond', _, _} -> cond_expr; {'fun', _, {clauses, _}} -> fun_expr; + {named_fun, _, _, _} -> named_fun_expr; {'fun', _, {function, _, _}} -> implicit_fun; {'fun', _, {function, _, _, _}} -> implicit_fun; {'if', _, _} -> if_expr; @@ -5615,6 +5623,110 @@ fun_expr_arity(Node) -> length(clause_patterns(hd(fun_expr_clauses(Node)))). +%% ===================================================================== +%% @doc Creates an abstract named fun-expression. If `Clauses' is +%% `[C1, ..., Cn]', the result represents "fun +%% Name C1; ...; Name Cn end". +%% More exactly, if each `Ci' represents +%% "(Pi1, ..., Pim) Gi -> Bi", +%% then the result represents +%% "fun Name(P11, ..., P1m) G1 -> +%% B1; ...; Name(Pn1, ..., Pnm) +%% Gn -> Bn end". +%% +%% @see named_fun_expr_name/1 +%% @see named_fun_expr_clauses/1 +%% @see named_fun_expr_arity/1 + +-record(named_fun_expr, {name :: syntaxTree(), clauses :: [syntaxTree()]}). + +%% type(Node) = named_fun_expr +%% data(Node) = #named_fun_expr{name :: Name, clauses :: Clauses} +%% +%% Name = syntaxTree() +%% Clauses = [syntaxTree()] +%% +%% (See `function' for notes; e.g. why the arity is not stored.) +%% +%% `erl_parse' representation: +%% +%% {named_fun, Pos, Name, Clauses} +%% +%% Clauses = [Clause] \ [] +%% Clause = {clause, ...} +%% +%% See `clause' for documentation on `erl_parse' clauses. + +-spec named_fun_expr(syntaxTree(), [syntaxTree()]) -> syntaxTree(). + +named_fun_expr(Name, Clauses) -> + tree(fun_expr, #named_fun_expr{name = Name, clauses = Clauses}). + +revert_named_fun_expr(Node) -> + Pos = get_pos(Node), + Name = named_fun_expr_name(Node), + Clauses = [revert_clause(C) || C <- named_fun_expr_clauses(Node)], + case type(Name) of + var -> + {named_fun, Pos, concrete(Name), Clauses}; + _ -> + Node + end. + + +%% ===================================================================== +%% @doc Returns the name subtree of a `named_fun_expr' node. +%% +%% @see named_fun_expr/2 + +-spec named_fun_expr_name(syntaxTree()) -> syntaxTree(). + +named_fun_expr_name(Node) -> + case unwrap(Node) of + {named_fun, Pos, Name, _} -> + set_pos(atom(Name), Pos); + Node1 -> + (data(Node1))#named_fun_expr.name + end. + + +%% ===================================================================== +%% @doc Returns the list of clause subtrees of a `named_fun_expr' node. +%% +%% @see named_fun_expr/1 + +-spec named_fun_expr_clauses(syntaxTree()) -> [syntaxTree()]. + +named_fun_expr_clauses(Node) -> + case unwrap(Node) of + {named_fun, _, _, Clauses} -> + Clauses; + Node1 -> + (data(Node1))#named_fun_expr.clauses + end. + + +%% ===================================================================== +%% @doc Returns the arity of a `named_fun_expr' node. The result is +%% the number of parameter patterns in the first clause of the +%% named fun-expression; subsequent clauses are ignored. +%% +%% An exception is thrown if `named_fun_expr_clauses(Node)' +%% returns an empty list, or if the first element of that list is not a +%% syntax tree `C' of type `clause' such that +%% `clause_patterns(C)' is a nonempty list. +%% +%% @see named_fun_expr/1 +%% @see named_fun_expr_clauses/1 +%% @see clause/3 +%% @see clause_patterns/1 + +-spec named_fun_expr_arity(syntaxTree()) -> arity(). + +named_fun_expr_arity(Node) -> + length(clause_patterns(hd(named_fun_expr_clauses(Node)))). + + %% ===================================================================== %% @doc Creates an abstract parenthesised expression. The result %% represents "(Body)", independently of the @@ -5978,6 +6090,8 @@ revert_root(Node) -> revert_match_expr(Node); module_qualifier -> revert_module_qualifier(Node); + named_fun_expr -> + revert_named_fun_expr(Node); nil -> revert_nil(Node); parentheses -> @@ -6219,6 +6333,9 @@ subtrees(T) -> module_qualifier -> [[module_qualifier_argument(T)], [module_qualifier_body(T)]]; + named_fun_expr -> + [[named_fun_expr_name(T)], + named_fun_expr_clauses(T)]; parentheses -> [[parentheses_body(T)]]; prefix_expr -> @@ -6349,6 +6466,7 @@ make_tree(list_comp, [[T], B]) -> list_comp(T, B); make_tree(macro, [[N]]) -> macro(N); make_tree(macro, [[N], A]) -> macro(N, A); make_tree(match_expr, [[P], [E]]) -> 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(parentheses, [[E]]) -> parentheses(E); make_tree(prefix_expr, [[F], [A]]) -> prefix_expr(F, A); diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 13d9aefb0c..6aeb251ac2 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -1883,6 +1883,13 @@ munge_expr({'fun',Line,{clauses,Clauses}}, Vars) -> %% Only for Vsn=raw_abstract_v1 {MungedClauses,Vars2}=munge_clauses(Clauses, Vars), {{'fun',Line,{clauses,MungedClauses}}, Vars2}; +munge_expr({named_fun,Line,Name,Clauses,_Extra}, Vars) -> + {MungedClauses,Vars2}=munge_clauses(Clauses, Vars), + {{named_fun,Line,Name,MungedClauses}, Vars2}; +munge_expr({named_fun,Line,Name,Clauses}, Vars) -> + %% Only for Vsn=raw_abstract_v1 + {MungedClauses,Vars2}=munge_clauses(Clauses, Vars), + {{named_fun,Line,Name,MungedClauses}, Vars2}; munge_expr({bin,Line,BinElements}, Vars) -> {MungedBinElements,Vars2} = munge_exprs(BinElements, Vars, []), {{bin,Line,MungedBinElements}, Vars2}; diff --git a/lib/tools/src/xref_reader.erl b/lib/tools/src/xref_reader.erl index d3601c6ea0..142d28ebe6 100644 --- a/lib/tools/src/xref_reader.erl +++ b/lib/tools/src/xref_reader.erl @@ -171,6 +171,11 @@ expr({'fun', Line, {function, Name, Arity}, _Extra}, S) -> handle_call(local, S#xrefr.module, Name, Arity, Line, S); expr({'fun', _Line, {clauses, Cs}, _Extra}, S) -> clauses(Cs, S); +expr({named_fun, _Line, '_', Cs, _Extra}, S) -> + clauses(Cs, S); +expr({named_fun, _Line, Name, Cs, _Extra}, S) -> + S1 = S#xrefr{funvars = [Name | S#xrefr.funvars]}, + clauses(Cs, S1); expr({call, Line, {atom, _, Name}, As}, S) -> S1 = handle_call(local, S#xrefr.module, Name, length(As), Line, S), expr(As, S1); @@ -186,6 +191,9 @@ expr({match, _Line, {var,_,Var}, {'fun', _, {clauses, Cs}, _Extra}}, S) -> %% that are passed around by the "expansion" of list comprehension. S1 = S#xrefr{funvars = [Var | S#xrefr.funvars]}, clauses(Cs, S1); +expr({match, _Line, {var,_,Var}, {named_fun, _, _, _, _} = Fun}, S) -> + S1 = S#xrefr{funvars = [Var | S#xrefr.funvars]}, + expr(Fun, S1); expr({match, _Line, {var,_,Var}, E}, S) -> %% Used for resolving code like %% Args = [A,B], apply(m, f, Args) @@ -288,6 +296,8 @@ funarg({'fun', _, _Clauses, _Extra}, _S) -> true; funarg({'fun', _, {function,_,_,_}}, _S) -> %% New abstract format for fun M:F/A in R15. true; +funarg({named_fun, _, _, _, _}, _S) -> + true; funarg({var, _, Var}, S) -> member(Var, S#xrefr.funvars); funarg(_, _S) -> false. -- cgit v1.2.3 From 8261c96c35d0691dc2619456a29ee41c1b944b1c Mon Sep 17 00:00:00 2001 From: Anthony Ramine Date: Mon, 12 Nov 2012 10:10:34 +0100 Subject: Update primary bootstrap for named funs --- bootstrap/lib/compiler/ebin/sys_pre_expand.beam | Bin 13420 -> 13620 bytes bootstrap/lib/compiler/ebin/v3_core.beam | Bin 51276 -> 51976 bytes bootstrap/lib/stdlib/ebin/epp.beam | Bin 27520 -> 27592 bytes bootstrap/lib/stdlib/ebin/erl_expand_records.beam | Bin 21788 -> 21872 bytes bootstrap/lib/stdlib/ebin/erl_lint.beam | Bin 84356 -> 84628 bytes bootstrap/lib/stdlib/ebin/erl_parse.beam | Bin 69084 -> 69620 bytes bootstrap/lib/stdlib/ebin/erl_pp.beam | Bin 25120 -> 25632 bytes bootstrap/lib/stdlib/ebin/ms_transform.beam | Bin 20236 -> 20360 bytes bootstrap/lib/stdlib/ebin/qlc_pt.beam | Bin 73056 -> 73648 bytes 9 files changed, 0 insertions(+), 0 deletions(-) diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam index 60933730c3..1e27f9e222 100644 Binary files a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam and b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam differ diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam index 3da6d334b4..db2c79cae7 100644 Binary files a/bootstrap/lib/compiler/ebin/v3_core.beam and b/bootstrap/lib/compiler/ebin/v3_core.beam differ diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam index 1d438315ae..62e4840c77 100644 Binary files a/bootstrap/lib/stdlib/ebin/epp.beam and b/bootstrap/lib/stdlib/ebin/epp.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam index 411f453a95..0f0da08a87 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam and b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam index c087684fa1..00431e7bc9 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_lint.beam and b/bootstrap/lib/stdlib/ebin/erl_lint.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam index b66feba048..4098c1d1d1 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_parse.beam and b/bootstrap/lib/stdlib/ebin/erl_parse.beam differ diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam index ecc8933bef..22d48708b8 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_pp.beam and b/bootstrap/lib/stdlib/ebin/erl_pp.beam differ diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam index f532375e3a..1715cfac50 100644 Binary files a/bootstrap/lib/stdlib/ebin/ms_transform.beam and b/bootstrap/lib/stdlib/ebin/ms_transform.beam differ diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam index 2f1db1d159..9624629b83 100644 Binary files a/bootstrap/lib/stdlib/ebin/qlc_pt.beam and b/bootstrap/lib/stdlib/ebin/qlc_pt.beam differ -- cgit v1.2.3 From ad882c4ae17d23fd0ce0affbf2cccefc264de6a9 Mon Sep 17 00:00:00 2001 From: Anthony Ramine Date: Mon, 12 Nov 2012 10:02:58 +0100 Subject: Support named funs in the shell The current code for the evaluation of ordinary funs is dependent on the order on variables in the fun environment as returned by erlang:fun_info(Fun, env). To avoid the problem in the future, make sure that we only have one free variable in the funs that we will need to inspect using erlang:fun_info(Fun, env). --- lib/stdlib/src/erl_eval.erl | 170 +++++++++++++++++++++++++++++++++----------- lib/stdlib/src/ets.erl | 2 +- lib/stdlib/src/qlc.erl | 2 + lib/stdlib/src/shell.erl | 7 ++ 4 files changed, 137 insertions(+), 44 deletions(-) diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index ca6a4b5c58..18d8148b15 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -179,8 +179,12 @@ check_command(Es, Bs) -> fun_data(F) when is_function(F) -> case erlang:fun_info(F, module) of {module,erl_eval} -> - {env, [FBs,_FEf,_FLf,FCs]} = erlang:fun_info(F, env), - {fun_data,FBs,FCs}; + case erlang:fun_info(F, env) of + {env,[{FBs,_FLf,_FEf,FCs}]} -> + {fun_data,FBs,FCs}; + {env,[{FBs,_FLf,_FEf,FCs,FName}]} -> + {named_fun_data,FBs,FName,FCs} + end; _ -> false end; @@ -262,51 +266,99 @@ expr({'fun',Line,{clauses,Cs}} = Ex, Bs, Lf, Ef, RBs) -> {Ex1, _} = hide_calls(Ex, 0), {ok,Used} = erl_lint:used_vars([Ex1], Bs), En = orddict:filter(fun(K,_V) -> member(K,Used) end, Bs), + Info = {En,Lf,Ef,Cs}, %% This is a really ugly hack! F = case length(element(3,hd(Cs))) of - 0 -> fun () -> eval_fun(Cs, [], En, Lf, Ef) end; - 1 -> fun (A) -> eval_fun(Cs, [A], En, Lf, Ef) end; - 2 -> fun (A,B) -> eval_fun(Cs, [A,B], En, Lf, Ef) end; - 3 -> fun (A,B,C) -> eval_fun(Cs, [A,B,C], En, Lf, Ef) end; - 4 -> fun (A,B,C,D) -> eval_fun(Cs, [A,B,C,D], En, Lf, Ef) end; - 5 -> fun (A,B,C,D,E) -> eval_fun(Cs, [A,B,C,D,E], En, Lf, Ef) end; - 6 -> fun (A,B,C,D,E,F) -> eval_fun(Cs, [A,B,C,D,E,F], En, Lf, Ef) end; - 7 -> fun (A,B,C,D,E,F,G) -> - eval_fun(Cs, [A,B,C,D,E,F,G], En, Lf, Ef) end; - 8 -> fun (A,B,C,D,E,F,G,H) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H], En, Lf, Ef) end; - 9 -> fun (A,B,C,D,E,F,G,H,I) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I], En, Lf, Ef) end; - 10 -> fun (A,B,C,D,E,F,G,H,I,J) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J], En, Lf, Ef) end; - 11 -> fun (A,B,C,D,E,F,G,H,I,J,K) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K], En, Lf, Ef) end; - 12 -> fun (A,B,C,D,E,F,G,H,I,J,K,L) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L], En, Lf, Ef) end; - 13 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M], En, Lf, Ef) end; - 14 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N], En, Lf, Ef) end; - 15 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O], En, Lf, Ef) end; - 16 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P], En, Lf, Ef) end; - 17 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q], En, Lf, Ef) end; - 18 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R], En, Lf, Ef) end; - 19 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S], - En, Lf, Ef) end; - 20 -> fun (A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T], - En, Lf, Ef) end; + 0 -> fun () -> eval_fun([], Info) end; + 1 -> fun (A) -> eval_fun([A], Info) end; + 2 -> fun (A,B) -> eval_fun([A,B], Info) end; + 3 -> fun (A,B,C) -> eval_fun([A,B,C], Info) end; + 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) -> eval_fun([A,B,C,D,E,F,G], Info) end; + 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) -> 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) -> + 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) -> + 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) -> + 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) -> + 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) -> + 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) -> + 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) -> + 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) -> + 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) -> + 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) -> + 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) -> + 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 -> erlang:raise(error, {'argument_limit',{'fun',Line,Cs}}, stacktrace()) end, ret_expr(F, Bs, RBs); +expr({named_fun,Line,Name,Cs} = Ex, Bs, Lf, Ef, RBs) -> + %% Save only used variables in the function environment. + %% {value,L,V} are hidden while lint finds used variables. + {Ex1, _} = hide_calls(Ex, 0), + {ok,Used} = erl_lint:used_vars([Ex1], Bs), + En = orddict:filter(fun(K,_V) -> member(K,Used) end, Bs), + Info = {En,Lf,Ef,Cs,Name}, + %% This is a really ugly hack! + F = + case length(element(3,hd(Cs))) of + 0 -> fun RF() -> eval_named_fun([], RF, Info) end; + 1 -> fun RF(A) -> eval_named_fun([A], RF, Info) end; + 2 -> fun RF(A,B) -> eval_named_fun([A,B], RF, Info) end; + 3 -> fun RF(A,B,C) -> eval_named_fun([A,B,C], RF, Info) end; + 4 -> fun RF(A,B,C,D) -> eval_named_fun([A,B,C,D], RF, Info) end; + 5 -> fun RF(A,B,C,D,E) -> eval_named_fun([A,B,C,D,E], RF, Info) end; + 6 -> fun RF(A,B,C,D,E,F) -> eval_named_fun([A,B,C,D,E,F], RF, Info) end; + 7 -> fun RF(A,B,C,D,E,F,G) -> + eval_named_fun([A,B,C,D,E,F,G], RF, Info) end; + 8 -> fun RF(A,B,C,D,E,F,G,H) -> + eval_named_fun([A,B,C,D,E,F,G,H], RF, Info) end; + 9 -> fun RF(A,B,C,D,E,F,G,H,I) -> + eval_named_fun([A,B,C,D,E,F,G,H,I], RF, Info) end; + 10 -> fun RF(A,B,C,D,E,F,G,H,I,J) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J], RF, Info) end; + 11 -> fun RF(A,B,C,D,E,F,G,H,I,J,K) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K], RF, Info) end; + 12 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L], RF, Info) end; + 13 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M], RF, Info) end; + 14 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N], RF, Info) end; + 15 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O], RF, Info) end; + 16 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P], RF, Info) end; + 17 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q], RF, Info) end; + 18 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R], RF, Info) end; + 19 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S], + RF, Info) end; + 20 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T], + RF, Info) end; + _Other -> + erlang:raise(error, {'argument_limit',{named_fun,Line,Name,Cs}}, + stacktrace()) + end, + ret_expr(F, Bs, RBs); expr({call,_,{remote,_,{atom,_,qlc},{atom,_,q}},[{lc,_,_E,_Qs}=LC | As0]}, Bs0, Lf, Ef, RBs) when length(As0) =< 1 -> %% No expansion or evaluation of module name or function name. @@ -534,7 +586,7 @@ do_apply(Func, As, Bs0, Ef, RBs) -> no_env end, case {Env,Ef} of - {{env,[FBs, FEf, FLf, FCs]},_} -> + {{env,[{FBs,FLf,FEf,FCs}]},_} -> %% If we are evaluting within another function body %% (RBs =/= none), we return RBs when this function body %% has been evalutated, otherwise we return Bs0, the @@ -549,6 +601,17 @@ do_apply(Func, As, Bs0, Ef, RBs) -> _ -> erlang:raise(error, {badarity,{Func,As}},stacktrace()) end; + {{env,[{FBs,FLf,FEf,FCs,FName}]},_} -> + NRBs = if + RBs =:= none -> Bs0; + true -> RBs + end, + case {erlang:fun_info(Func, arity), length(As)} of + {{arity, Arity}, Arity} -> + eval_named_fun(FCs, As, FBs, FLf, FEf, FName, Func, NRBs); + _ -> + erlang:raise(error, {badarity,{Func,As}},stacktrace()) + end; {no_env,none} when RBs =:= value -> %% Make tail recursive calls when possible. apply(Func, As); @@ -676,12 +739,12 @@ ret_expr(V, Bs, none) -> ret_expr(V, _Bs, RBs) when is_list(RBs) -> {value,V,RBs}. -%% eval_fun(Clauses, Arguments, Bindings, LocalFunctionHandler, -%% ExternalFunctionHandler) -> Value +%% eval_fun(Arguments, {Bindings,LocalFunctionHandler, +%% ExternalFunctionHandler,Clauses}) -> Value %% This function is called when the fun is called from compiled code %% or from apply. -eval_fun(Cs, As, Bs0, Lf, Ef) -> +eval_fun(As, {Bs0,Lf,Ef,Cs}) -> eval_fun(Cs, As, Bs0, Lf, Ef, value). eval_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, RBs) -> @@ -699,6 +762,27 @@ eval_fun([], As, _Bs, _Lf, _Ef, _RBs) -> erlang:raise(error, function_clause, [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]). + +eval_named_fun(As, Fun, {Bs0,Lf,Ef,Cs,Name}) -> + eval_named_fun(Cs, As, Bs0, Lf, Ef, Name, Fun, value). + +eval_named_fun([{clause,_,H,G,B}|Cs], As, Bs0, Lf, Ef, Name, Fun, RBs) -> + Bs1 = add_binding(Name, Fun, Bs0), + case match_list(H, As, new_bindings(), Bs1) of + {match,Bsn} -> % The new bindings for the head + Bs2 = add_bindings(Bsn, Bs1), % which then shadow! + case guard(G, Bs2, Lf, Ef) of + true -> exprs(B, Bs2, Lf, Ef, RBs); + false -> eval_named_fun(Cs, As, Bs0, Lf, Ef, Name, Fun, RBs) + end; + nomatch -> + eval_named_fun(Cs, As, Bs0, Lf, Ef, Name, Fun, RBs) + end; +eval_named_fun([], As, _Bs, _Lf, _Ef, _Name, _Fun, _RBs) -> + erlang:raise(error, function_clause, + [{?MODULE,'-inside-an-interpreted-fun-',As}|stacktrace()]). + + %% expr_list(ExpressionList, Bindings) %% expr_list(ExpressionList, Bindings, LocalFuncHandler) %% expr_list(ExpressionList, Bindings, LocalFuncHandler, ExternalFuncHandler) diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index f05bfd12a7..cc5e69f574 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -507,7 +507,7 @@ fun2ms(ShellFun) when is_function(ShellFun) -> Else -> Else end; - false -> + _ -> exit({badarg,{?MODULE,fun2ms, [function,called,with,real,'fun', should,be,transformed,with, diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 48f6622565..002032d48d 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1266,6 +1266,8 @@ abstr_term(Fun, Line) when is_function(Fun) -> case erl_eval:fun_data(Fun) of {fun_data, _Bs, Cs} -> {'fun', Line, {clauses, Cs}}; + {named_fun_data, _Bs, Name, Cs} -> + {named_fun, Line, Name, Cs}; false -> {name, Name} = erlang:fun_info(Fun, name), {arity, Arity} = erlang:fun_info(Fun, arity), diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 0d2fc47d13..3b90542452 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -424,6 +424,8 @@ expand_expr({remote,L,M,F}, C) -> {remote,L,expand_expr(M, C),expand_expr(F, C)}; expand_expr({'fun',L,{clauses,Cs}}, C) -> {'fun',L,{clauses,expand_exprs(Cs, C)}}; +expand_expr({named_fun,L,Name,Cs}, C) -> + {named_fun,L,Name,expand_exprs(Cs, C)}; expand_expr({clause,L,H,G,B}, C) -> %% Could expand H and G, but then erl_eval has to be changed as well. {clause,L,H, G, expand_exprs(B, C)}; @@ -1313,6 +1315,11 @@ list_bindings([{Name,Val}|Bs], RT) -> F = {'fun',0,{clauses,FCs}}, M = {match,0,{var,0,Name},F}, io:fwrite(<<"~ts\n">>, [erl_pp:expr(M, enc())]); + {named_fun_data,_FBs,FName,FCs0} -> + FCs = expand_value(FCs0), % looks nicer + F = {named_fun,0,FName,FCs}, + M = {match,0,{var,0,Name},F}, + io:fwrite(<<"~ts\n">>, [erl_pp:expr(M, enc())]); false -> Namel = io_lib:fwrite(<<"~s = ">>, [Name]), Nl = iolist_size(Namel)+1, -- cgit v1.2.3 From 1b5c922b37c9c60dcfa53894a9968735019822e7 Mon Sep 17 00:00:00 2001 From: Anthony Ramine Date: Mon, 12 Nov 2012 19:08:51 +0100 Subject: Update primary bootstrap for named funs in the shell --- bootstrap/lib/stdlib/ebin/erl_eval.beam | Bin 22744 -> 29228 bytes bootstrap/lib/stdlib/ebin/ets.beam | Bin 22328 -> 22316 bytes bootstrap/lib/stdlib/ebin/qlc.beam | Bin 70300 -> 70376 bytes bootstrap/lib/stdlib/ebin/shell.beam | Bin 29764 -> 29960 bytes 4 files changed, 0 insertions(+), 0 deletions(-) diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam index 1124de722e..60a39206f7 100644 Binary files a/bootstrap/lib/stdlib/ebin/erl_eval.beam and b/bootstrap/lib/stdlib/ebin/erl_eval.beam differ diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam index b9cb892454..a6b4947b6c 100644 Binary files a/bootstrap/lib/stdlib/ebin/ets.beam and b/bootstrap/lib/stdlib/ebin/ets.beam differ diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam index a1a8ed113f..a654bb3d99 100644 Binary files a/bootstrap/lib/stdlib/ebin/qlc.beam and b/bootstrap/lib/stdlib/ebin/qlc.beam differ diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam index 190ca28439..1971561ef1 100644 Binary files a/bootstrap/lib/stdlib/ebin/shell.beam and b/bootstrap/lib/stdlib/ebin/shell.beam differ -- cgit v1.2.3 From a122254898597d73658e72070862e2da0d1cf85b Mon Sep 17 00:00:00 2001 From: Anthony Ramine Date: Tue, 13 Nov 2012 11:01:48 +0100 Subject: Support named funs in the debugger interpreter The current code for the evaluation of ordinary funs is dependent on the order on variables in the fun environment as returned by erlang:fun_info(Fun, env). As it happened, adding the code for named funs changed the order in the environment for ordinary funs. To avoid the problem in the future, make sure that we only have one free variable in the funs that we will need to inspect using erlang:fun_info(Fun, env). --- lib/debugger/src/dbg_ieval.erl | 145 +++++++++++++++++++++++++++++++++-------- lib/debugger/src/dbg_iload.erl | 3 + 2 files changed, 122 insertions(+), 26 deletions(-) diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index f4b6d488a5..6ce3262ed2 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -204,7 +204,8 @@ meta(Int, Debugged, M, F, As) -> %% If it's a fun we're evaluating, show a text %% representation of the fun and its arguments, %% not dbg_ieval:eval_fun(...) - {dbg_ieval, eval_fun} -> + {dbg_ieval, EvalFun} when EvalFun =:= eval_fun; + EvalFun =:= eval_named_fun -> {Mx, Fx} = lists:last(As), {Mx, Fx, lists:nth(2, As)}; _ -> @@ -432,7 +433,8 @@ eval_function(Mod, Name, As, Bs, Called, Ieval0, Lc) -> do_eval_function(Mod, Fun, As0, Bs0, _, Ieval0) when is_function(Fun); Mod =:= ?MODULE, - Fun =:= eval_fun -> + Fun =:= eval_fun orelse + Fun =:= eval_named_fun -> #ieval{level=Le,line=Li,top=Top} = Ieval0, case lambda(Fun, As0) of {[{clause,Fc,_,_,_}|_]=Cs,Module,Name,As,Bs} -> @@ -487,13 +489,29 @@ lambda(eval_fun, [Cs,As,Bs,{Mod,Name}=F]) -> true -> {error,{badarity,{F,As}}} end; +lambda(eval_named_fun, [Cs,As,Bs0,FName,RF,{Mod,Name}=F]) -> + %% Fun defined in interpreted code, called from outside + if + length(element(3,hd(Cs))) =:= length(As) -> + db_ref(Mod), %% Adds ref between module and process + Bs1 = add_binding(FName, RF, Bs0), + {Cs,Mod,Name,As,Bs1}; + true -> + {error,{badarity,{F,As}}} + end; lambda(Fun, As) when is_function(Fun) -> %% Fun called from within interpreted code... case erlang:fun_info(Fun, module) of %% ... and the fun was defined in interpreted code {module, ?MODULE} -> - {env, [{Mod,Name},Bs,Cs]} = erlang:fun_info(Fun, env), + {Mod,Name,Bs} = + case erlang:fun_info(Fun, env) of + {env,[{{M,F},Bs0,Cs}]} -> + {M,F,Bs0}; + {env,[{{M,F},Bs0,Cs,FName}]} -> + {M,F,add_binding(FName, Fun, Bs0)} + end, {arity, Arity} = erlang:fun_info(Fun, arity), if length(As) =:= Arity -> @@ -727,50 +745,121 @@ expr({match,Line,Lhs,Rhs0}, Bs0, Ieval0) -> %% Construct a fun expr({make_fun,Line,Name,Cs}, Bs, #ieval{module=Module}=Ieval) -> Arity = length(element(3,hd(Cs))), - Info = {Module,Name}, + Info = {{Module,Name},Bs,Cs}, Fun = case Arity of - 0 -> fun() -> eval_fun(Cs, [], Bs, Info) end; - 1 -> fun(A) -> eval_fun(Cs, [A], Bs,Info) end; - 2 -> fun(A,B) -> eval_fun(Cs, [A,B], Bs,Info) end; - 3 -> fun(A,B,C) -> eval_fun(Cs, [A,B,C], Bs,Info) end; - 4 -> fun(A,B,C,D) -> eval_fun(Cs, [A,B,C,D], Bs,Info) end; - 5 -> fun(A,B,C,D,E) -> eval_fun(Cs, [A,B,C,D,E], Bs,Info) end; - 6 -> fun(A,B,C,D,E,F) -> eval_fun(Cs, [A,B,C,D,E,F], Bs,Info) end; + 0 -> fun() -> eval_fun([], Info) end; + 1 -> fun(A) -> eval_fun([A], Info) end; + 2 -> fun(A,B) -> eval_fun([A,B], Info) end; + 3 -> fun(A,B,C) -> eval_fun([A,B,C], Info) end; + 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) -> - eval_fun(Cs, [A,B,C,D,E,F,G], Bs,Info) end; + eval_fun([A,B,C,D,E,F,G], Info) end; 8 -> fun(A,B,C,D,E,F,G,H) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H], Bs,Info) end; + eval_fun([A,B,C,D,E,F,G,H], Info) end; 9 -> fun(A,B,C,D,E,F,G,H,I) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I], Bs,Info) end; + 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) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J], Bs,Info) end; + 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) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K], Bs,Info) end; + 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) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L], Bs,Info) end; + 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) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M], Bs,Info) end; + 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) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N], Bs,Info) end; + 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) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O], Bs,Info) end; + 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) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P], Bs,Info) end; + 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) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q], Bs,Info) end; + 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) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R], Bs,Info) end; + 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) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S],Bs,Info) end; + 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) -> - eval_fun(Cs, [A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T],Bs,Info) end; + 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, Ieval#ieval{line=Line}) end, {value,Fun,Bs}; +%% Construct a fun +expr({make_named_fun,Line,Name,FName,Cs}, Bs, #ieval{module=Module}=Ieval) -> + Arity = length(element(3,hd(Cs))), + Info = {{Module,Name},Bs,Cs,FName}, + Fun = + case Arity of + 0 -> fun RF() -> eval_named_fun([], RF, Info) end; + 1 -> fun RF(A) -> eval_named_fun([A], RF, Info) end; + 2 -> fun RF(A,B) -> + eval_named_fun([A,B], RF, Info) end; + 3 -> fun RF(A,B,C) -> + eval_named_fun([A,B,C], RF, Info) end; + 4 -> fun RF(A,B,C,D) -> + eval_named_fun([A,B,C,D], RF, Info) end; + 5 -> fun RF(A,B,C,D,E) -> + eval_named_fun([A,B,C,D,E], + RF, Info) end; + 6 -> fun RF(A,B,C,D,E,F) -> + eval_named_fun([A,B,C,D,E,F], + RF, Info) end; + 7 -> fun RF(A,B,C,D,E,F,G) -> + eval_named_fun([A,B,C,D,E,F,G], + RF, Info) end; + 8 -> fun RF(A,B,C,D,E,F,G,H) -> + eval_named_fun([A,B,C,D,E,F,G,H], + RF, Info) end; + 9 -> fun RF(A,B,C,D,E,F,G,H,I) -> + eval_named_fun([A,B,C,D,E,F,G,H,I], + RF, Info) end; + 10 -> fun RF(A,B,C,D,E,F,G,H,I,J) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J], + RF, Info) end; + 11 -> fun RF(A,B,C,D,E,F,G,H,I,J,K) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K], + RF, Info) end; + 12 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L], + RF, Info) end; + 13 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M], + RF, Info) end; + 14 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N], + RF, Info) end; + 15 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O], + RF, Info) end; + 16 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P], + RF, Info) end; + 17 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q], + RF, Info) end; + 18 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q, + R], + RF, Info) end; + 19 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q, + R,S], + RF, Info) end; + 20 -> fun RF(A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T) -> + eval_named_fun([A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q, + R,S,T], + RF, Info) end; + _Other -> + exception(error, {'argument_limit',{named_fun,FName,Cs}}, Bs, + Ieval#ieval{line=Line}) + end, + {value,Fun,Bs}; + %% Construct an external fun. expr({make_ext_fun,Line,MFA0}, Bs0, Ieval0) -> {[M,F,A],Bs} = eval_list(MFA0, Bs0, Ieval0), @@ -960,9 +1049,13 @@ expr(E, _Bs, _Ieval) -> erlang:error({'NYI',E}). %% Interpreted fun() called from uninterpreted module, recurse -eval_fun(Cs, As, Bs, Info) -> +eval_fun(As, {Info,Bs,Cs}) -> dbg_debugged:eval(?MODULE, eval_fun, [Cs,As,Bs,Info]). +%% Interpreted named fun() called from uninterpreted module, recurse +eval_named_fun(As, RF, {Info,Bs,Cs,FName}) -> + dbg_debugged:eval(?MODULE, eval_named_fun, [Cs,As,Bs,FName,RF,Info]). + %% eval_lc(Expr,[Qualifier],Bindings,IevalState) -> %% {value,Value,Bindings}. %% This is evaluating list comprehensions "straight out of the book". diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index 3c95ef8068..9806692afc 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -369,6 +369,9 @@ expr({'fun',Line,{function,F,A},{_Index,_OldUniq,Name}}, _Lc) -> As = new_vars(A, Line), Cs = [{clause,Line,As,[],[{local_call,Line,F,As,true}]}], {make_fun,Line,Name,Cs}; +expr({named_fun,Line,FName,Cs0,{_,_,Name}}, _Lc) when is_atom(Name) -> + Cs = fun_clauses(Cs0), + {make_named_fun,Line,Name,FName,Cs}; expr({'fun',Line,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}, _Lc) when 0 =< A, A =< 255 -> %% New format in R15 for fun M:F/A (literal values). -- cgit v1.2.3 From a0988a638a92211ae0af6ec35ca99edfc05110aa Mon Sep 17 00:00:00 2001 From: Anthony Ramine Date: Sat, 10 Nov 2012 21:32:31 +0100 Subject: Test named funs --- erts/emulator/test/binary_SUITE.erl | 7 ++- erts/emulator/test/fun_SUITE.erl | 10 ++++ lib/compiler/test/fun_SUITE.erl | 13 ++++- lib/debugger/test/erl_eval_SUITE.erl | 26 +++++++++- lib/debugger/test/fun_SUITE.erl | 17 ++++++- lib/dialyzer/test/small_SUITE_data/results/eep37 | 0 lib/dialyzer/test/small_SUITE_data/src/eep37.erl | 15 ++++++ lib/stdlib/test/erl_eval_SUITE.erl | 27 ++++++++++- lib/stdlib/test/erl_lint_SUITE.erl | 60 ++++++++++++++++++++++-- lib/stdlib/test/erl_pp_SUITE.erl | 27 ++++++++++- lib/stdlib/test/ms_transform_SUITE.erl | 11 ++++- lib/stdlib/test/qlc_SUITE.erl | 14 +++++- lib/tools/test/cover_SUITE.erl | 18 ++++++- lib/tools/test/xref_SUITE.erl | 13 +++-- lib/tools/test/xref_SUITE_data/read/read.erl | 27 +++++------ 15 files changed, 246 insertions(+), 39 deletions(-) create mode 100644 lib/dialyzer/test/small_SUITE_data/results/eep37 create mode 100644 lib/dialyzer/test/small_SUITE_data/src/eep37.erl diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl index a340a805b5..44dbb2c588 100644 --- a/erts/emulator/test/binary_SUITE.erl +++ b/erts/emulator/test/binary_SUITE.erl @@ -935,7 +935,7 @@ otp_6817_try_bin(Bin) -> otp_8117(doc) -> "Some bugs in binary_to_term when 32-bit integers are negative."; otp_8117(suite) -> []; otp_8117(Config) when is_list(Config) -> - [otp_8117_do(Op,-(1 bsl N)) || Op <- ['fun',list,tuple], + [otp_8117_do(Op,-(1 bsl N)) || Op <- ['fun',named_fun,list,tuple], N <- lists:seq(0,31)], ok. @@ -944,6 +944,11 @@ otp_8117_do('fun',Neg) -> FunBin = term_to_binary(fun() -> ok end), ?line <> = FunBin, ?line bad_bin_to_term(<>); +otp_8117_do(named_fun,Neg) -> + % Named fun with negative num_free + FunBin = term_to_binary(fun F() -> F end), + ?line <> = FunBin, + ?line bad_bin_to_term(<>); otp_8117_do(list,Neg) -> %% List with negative length ?line bad_bin_to_term(<<131,104,2,108,Neg:32,97,11,104,1,97,12,97,13,106,97,14>>); diff --git a/erts/emulator/test/fun_SUITE.erl b/erts/emulator/test/fun_SUITE.erl index 36ba4e0f48..8ad5f290ed 100644 --- a/erts/emulator/test/fun_SUITE.erl +++ b/erts/emulator/test/fun_SUITE.erl @@ -262,6 +262,16 @@ equality(Config) when is_list(Config) -> ?line false = eq(FF2, FF4), ?line false = eq(FF3, FF4), + %% EEP37 + H1 = fun Fact(N) when N > 0 -> N * Fact(N - 1); Fact(0) -> 1 end, + H2 = fun Pow(N, M) when M > 0 -> N * Pow(N, M - 1); Pow(_, 0) -> 1 end, + H1_copy = copy_term(H1), + + true = eq(H1, H1), + true = eq(H1, H1_copy), + true = eq(H2, H2), + false = eq(H1, H2), + ok. eq(X, X) -> true; diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index 6067ee8e06..e35692efd1 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -21,7 +21,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1, - external/1]). + external/1,eep37/1]). %% Internal export. -export([call_me/1]). @@ -32,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [test1,overwritten_fun,otp_7202,bif_fun,external]. + [test1,overwritten_fun,otp_7202,bif_fun,external,eep37]. groups() -> []. @@ -197,5 +197,14 @@ external(Config) when is_list(Config) -> call_me(I) -> {ok,I}. +eep37(Config) when is_list(Config) -> + F = fun Fact(N) when N > 0 -> N * Fact(N - 1); Fact(0) -> 1 end, + Add = fun _(N) -> N + 1 end, + UnusedName = fun BlackAdder(N) -> N + 42 end, + 720 = F(6), + 10 = Add(9), + 50 = UnusedName(8), + ok. + id(I) -> I. diff --git a/lib/debugger/test/erl_eval_SUITE.erl b/lib/debugger/test/erl_eval_SUITE.erl index bb2669f450..be9312b68f 100644 --- a/lib/debugger/test/erl_eval_SUITE.erl +++ b/lib/debugger/test/erl_eval_SUITE.erl @@ -39,7 +39,8 @@ otp_8133/1, funs/1, try_catch/1, - eval_expr_5/1]). + eval_expr_5/1, + eep37/1]). %% %% Define to run outside of test server @@ -78,7 +79,7 @@ all() -> pattern_expr, match_bin, guard_3, guard_4, lc, simple_cases, unary_plus, apply_atom, otp_5269, otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, - otp_8133, funs, try_catch, eval_expr_5]. + otp_8133, funs, try_catch, eval_expr_5, eep37]. groups() -> []. @@ -1323,6 +1324,27 @@ eval_expr_5(Config) when is_list(Config) -> ok end. +eep37(Config) when is_list(Config) -> + check(fun () -> (fun _(X) -> X end)(42) end, + "(fun _(X) -> X end)(42).", + 42), + check(fun () -> (fun _Id(X) -> X end)(42) end, + "(fun _Id(X) -> X end)(42).", 42), + check(fun () -> is_function((fun Self() -> Self end)(), 0) end, + "is_function((fun Self() -> Self end)(), 0).", + true), + check(fun () -> + F = fun Fact(N) when N > 0 -> + N * Fact(N - 1); + Fact(0) -> + 1 + end, + F(6) + end, + "(fun Fact(N) when N > 0 -> N * Fact(N - 1); Fact(0) -> 1 end)(6).", + 720), + ok. + %% Check the string in different contexts: as is; in fun; from compiled code. check(F, String, Result) -> check1(F, String, Result), diff --git a/lib/debugger/test/fun_SUITE.erl b/lib/debugger/test/fun_SUITE.erl index a06cdc7165..8425f973e6 100644 --- a/lib/debugger/test/fun_SUITE.erl +++ b/lib/debugger/test/fun_SUITE.erl @@ -24,7 +24,7 @@ init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, good_call/1,bad_apply/1,bad_fun_call/1,badarity/1, - ext_badarity/1,otp_6061/1,external/1]). + ext_badarity/1,otp_6061/1,external/1,eep37/1]). %% Internal exports. -export([nothing/0,call_me/1]). @@ -48,7 +48,7 @@ end_per_group(_GroupName, Config) -> cases() -> [good_call, bad_apply, bad_fun_call, badarity, - ext_badarity, otp_6061, external]. + ext_badarity, otp_6061, external, eep37]. init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), @@ -288,5 +288,18 @@ external(Config) when is_list(Config) -> call_me(I) -> {ok,I}. +eep37(Config) when is_list(Config) -> + F = fun Fact(N) when N > 0 -> N * Fact(N - 1); Fact(0) -> 1 end, + Add = fun _(N) -> N + 1 end, + UnusedName = fun BlackAdder(N) -> N + 42 end, + 720 = F(6), + 10 = Add(9), + 50 = UnusedName(8), + [1,1,2,6,24,120] = lists:map(F, lists:seq(0, 5)), + {'EXIT',{{badarity,_},_}} = (catch lists:map(fun G() -> G() end, [1])), + {'EXIT',{{badarity,_},_}} = (catch F()), + + ok. + id(I) -> I. diff --git a/lib/dialyzer/test/small_SUITE_data/results/eep37 b/lib/dialyzer/test/small_SUITE_data/results/eep37 new file mode 100644 index 0000000000..e69de29bb2 diff --git a/lib/dialyzer/test/small_SUITE_data/src/eep37.erl b/lib/dialyzer/test/small_SUITE_data/src/eep37.erl new file mode 100644 index 0000000000..2818688f95 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/eep37.erl @@ -0,0 +1,15 @@ +-module(eep37). + +-compile(export_all). + +-spec self() -> fun(() -> fun()). +self() -> + fun Self() -> Self end. + +-spec fact() -> fun((non_neg_integer()) -> non_neg_integer()). +fact() -> + fun Fact(N) when N > 0 -> + N * Fact(N - 1); + Fact(0) -> + 1 + end. diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index 7ceef727f1..c4b6b35e72 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -41,7 +41,8 @@ funs/1, try_catch/1, eval_expr_5/1, - zero_width/1]). + zero_width/1, + eep37/1]). %% %% Define to run outside of test server @@ -80,7 +81,8 @@ all() -> pattern_expr, match_bin, guard_3, guard_4, lc, simple_cases, unary_plus, apply_atom, otp_5269, otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, - otp_8133, otp_10622, funs, try_catch, eval_expr_5, zero_width]. + otp_8133, otp_10622, funs, try_catch, eval_expr_5, zero_width, + eep37]. groups() -> []. @@ -1401,6 +1403,27 @@ zero_width(Config) when is_list(Config) -> "ok end.", ok), ok. +eep37(Config) when is_list(Config) -> + check(fun () -> (fun _(X) -> X end)(42) end, + "(fun _(X) -> X end)(42).", + 42), + check(fun () -> (fun _Id(X) -> X end)(42) end, + "(fun _Id(X) -> X end)(42).", 42), + check(fun () -> is_function((fun Self() -> Self end)(), 0) end, + "is_function((fun Self() -> Self end)(), 0).", + true), + check(fun () -> + F = fun Fact(N) when N > 0 -> + N * Fact(N - 1); + Fact(0) -> + 1 + end, + F(6) + end, + "(fun Fact(N) when N > 0 -> N * Fact(N - 1); Fact(0) -> 1 end)(6).", + 720), + ok. + %% Check the string in different contexts: as is; in fun; from compiled code. check(F, String, Result) -> check1(F, String, Result), diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 6bf87adf14..a71d7f3018 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -575,7 +575,7 @@ unused_vars_warn_rec(Config) when is_list(Config) -> ok. unused_vars_warn_fun(doc) -> - "Warnings for unused variables in records."; + "Warnings for unused variables in funs."; unused_vars_warn_fun(suite) -> []; unused_vars_warn_fun(Config) when is_list(Config) -> Ts = [{fun1, @@ -643,7 +643,60 @@ unused_vars_warn_fun(Config) when is_list(Config) -> {22,erl_lint,{unused_var,'U'}}, {24,erl_lint,{unused_var,'U'}}, {26,erl_lint,{unused_var,'U'}}, - {26,erl_lint,{shadowed_var,'U','fun'}}]}} + {26,erl_lint,{shadowed_var,'U','fun'}}]}}, + {named_fun, + <<"u() -> + fun U() -> foo end, % U unused. + U; % U unbound. + u() -> + case foo of + true -> + U = 2; + false -> + true + end, + fun U() -> foo end, % U unused. + U; % U unsafe. + u() -> + case foo of + true -> + U = 2; + false -> + U = 3 + end, + fun U() -> foo end, % U shadowed. U unused. + U; + u() -> + case foo of + true -> + U = 2; % U unused. + false -> + U = 3 % U unused. + end, + fun U() -> foo end; % U shadowed. U unused. + u() -> + fun U(U) -> foo end; % U shadowed. U unused. + u() -> + fun U(1) -> U; U(U) -> foo end; % U shadowed. U unused. + u() -> + fun _(N) -> N + 1 end. % Cover handling of '_' name. + ">>, + [warn_unused_vars], + {error,[{3,erl_lint,{unbound_var,'U'}}, + {12,erl_lint,{unsafe_var,'U',{'case',5}}}], + [{2,erl_lint,{unused_var,'U'}}, + {11,erl_lint,{unused_var,'U'}}, + {20,erl_lint,{unused_var,'U'}}, + {20,erl_lint,{shadowed_var,'U','named fun'}}, + {25,erl_lint,{unused_var,'U'}}, + {27,erl_lint,{unused_var,'U'}}, + {29,erl_lint,{unused_var,'U'}}, + {29,erl_lint,{shadowed_var,'U','named fun'}}, + {31,erl_lint,{unused_var,'U'}}, + {31,erl_lint,{unused_var,'U'}}, + {31,erl_lint,{shadowed_var,'U','fun'}}, + {33,erl_lint,{unused_var,'U'}}, + {33,erl_lint,{shadowed_var,'U','fun'}}]}} ], ?line [] = run(Config, Ts), ok. @@ -2201,7 +2254,8 @@ otp_5878(Config) when is_list(Config) -> <<"-record(r1, {t = case foo of _ -> 3 end}). -record(r2, {a = case foo of A -> A; _ -> 3 end}). -record(r3, {a = case foo of A -> A end}). - t() -> {#r1{},#r2{},#r3{}}. + -record(r4, {a = fun _AllowedFunName() -> allowed end}). + t() -> {#r1{},#r2{},#r3{},#r4{}}. ">>, [warn_unused_record], {errors,[{2,erl_lint,{variable_in_record_def,'A'}}, diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 70a9d70e5c..cc744ee76b 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -130,7 +130,27 @@ func(Config) when is_list(Config) -> true end)().">>}, {func_7, - <<"t(M, F, A) -> fun M:F/A.">>} + <<"t(M, F, A) -> fun M:F/A.">>}, + {func_8, + <<"-record(r1, {a,b}). + -record(r3, {a = fun Id(_) -> #r1{} end(1), b}). + + t() -> + fun Id(A) when record(A#r3.a, r1) -> 7 end(#r3{}). + ">>}, + {func_9, + <<"-record(r1, {a,b}). + -record(r3, {a = fun Id(_) -> #r1{} end(1), b}). + + t() -> + fsdfsdfjsdfjkljf:sdlfjdsfjlf( + fun Id(sdfsd) -> {sdkjsdf,sdfjsdkljfsdl,sdfkjdklf} end). + ">>}, + {func_10, + <<"t() -> + (fun True() -> + true + end)().">>} ], ?line compile(Config, Ts), ok. @@ -158,6 +178,7 @@ recs(Config) when is_list(Config) -> -record(r1, {a,b}). -record(r2, {a = #r1{},b,c=length([1,2,3])}). -record(r3, {a = fun(_) -> #r1{} end(1), b}). + -record(r4, {a = fun R1(_) -> #r1{} end(1), b}). t() -> foo = fun(A) when A#r1.a > A#r1.b -> foo end(#r1{b = 2}), @@ -741,6 +762,7 @@ neg_indent(Config) when is_list(Config) -> ?line ok = pp_expr(<<"{[a,b,c],[d,e|f]}">>), ?line ok = pp_expr(<<"f(a,b,c)">>), ?line ok = pp_expr(<<"fun() when a,b;c,d -> a end">>), + ?line ok = pp_expr(<<"fun A() when a,b;c,d -> a end">>), ?line ok = pp_expr(<<"<<34:32,17:32>>">>), ?line ok = pp_expr(<<"if a,b,c -> d; e,f,g -> h,i end">>), ?line ok = pp_expr(<<"if a -> d; c -> d end">>), @@ -763,6 +785,9 @@ neg_indent(Config) when is_list(Config) -> Fun2 = {'fun',2,{clauses,[{clause,2,[],[],[{atom,3,true}]}]}, {0,108059557,'-t/0-fun-0-'}}, ?line "fun() -> true end" = flat_expr(Fun2), + Fun3 = {named_fun,3,'True',[{clause,3,[],[],[{atom,3,true}]}], + {0,424242424,'-t/0-True-0-'}}, + ?line "fun True() -> true end" = flat_expr(Fun3), ok. diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl index a17307b07b..4ec13ed472 100644 --- a/lib/stdlib/test/ms_transform_SUITE.erl +++ b/lib/stdlib/test/ms_transform_SUITE.erl @@ -40,6 +40,7 @@ -export([action_function/1]). -export([warnings/1]). -export([no_warnings/1]). +-export([eep37/1]). -export([init_per_testcase/2, end_per_testcase/2]). init_per_testcase(_Func, Config) -> @@ -57,7 +58,7 @@ all() -> record_index, multipass, bitsyntax, record_defaults, andalso_orelse, float_1_function, action_function, warnings, no_warnings, top_match, old_guards, autoimported, - semicolon]. + semicolon, eep37]. groups() -> []. @@ -806,6 +807,14 @@ action_function(Config) when is_list(Config) -> ok. +eep37(Config) when is_list(Config) -> + setup(Config), + [{'$1',[],['$1']}] = + compile_and_run(<<"F = fun _Ms() ->\n" + " ets:fun2ms(fun (X) -> X end)\n" + " end,\n" + "F()">>). + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl index 5f9244b479..2846657c09 100644 --- a/lib/stdlib/test/qlc_SUITE.erl +++ b/lib/stdlib/test/qlc_SUITE.erl @@ -76,7 +76,9 @@ manpage/1, - backward/1, forward/1]). + backward/1, forward/1, + + eep37/1]). %% Internal exports. -export([bad_table_throw/1, bad_table_exit/1, default_table/1, bad_table/1, @@ -132,7 +134,7 @@ groups() -> evaluator, string_to_handle, table, process_dies, sort, keysort, filesort, cache, cache_list, filter, info, nested_info, lookup1, lookup2, lookup_rec, indices, - pre_fun, skip_filters]}, + pre_fun, skip_filters, eep37]}, {table_impls, [], [ets, dets]}, {join, [], [join_option, join_filter, join_lookup, join_merge, @@ -7427,6 +7429,14 @@ forward(Config) when is_list(Config) -> ?line run(Config, Ts), ok. +eep37(Config) when is_list(Config) -> + Ts = [ + <<"H = (fun _Handle() -> qlc:q([X || X <- []]) end)(), + [] = qlc:eval(H)">> + ], + run(Config, Ts), + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% bad_table_throw(Tab) -> diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 29b26c7a76..bd71218474 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -28,7 +28,7 @@ export_import/1, otp_5031/1, eif/1, otp_5305/1, otp_5418/1, otp_6115/1, otp_7095/1, otp_8188/1, otp_8270/1, otp_8273/1, otp_8340/1, - otp_10979_hanging_node/1, compile_beam_opts/1]). + otp_10979_hanging_node/1, compile_beam_opts/1, eep37/1]). -include_lib("test_server/include/test_server.hrl"). @@ -53,7 +53,7 @@ all() -> dont_reconnect_after_stop, stop_node_after_disconnect, export_import, otp_5031, eif, otp_5305, otp_5418, otp_6115, otp_7095, otp_8188, otp_8270, otp_8273, - otp_8340, otp_10979_hanging_node, compile_beam_opts]; + otp_8340, otp_10979_hanging_node, compile_beam_opts, eep37]; _pid -> {skip, "It looks like the test server is running " @@ -1382,6 +1382,20 @@ comprehension_8188(Cf) -> ok. +eep37(Config) when is_list(Config) -> + [{{t,1},1},{{t,2},1},{{t,4},6},{{t,6},1},{{t,8},1}] = + analyse_expr(<<"begin\n" % 1 + " F =\n" % 1 + " fun Fact(N) when N > 0 ->\n" + " N * Fact(N - 1);\n" % 6 + " Fact(0) ->\n" + " 1\n" % 1 + " end,\n" + " F(6)\n" % 1 + "end\n">>, + Config), + ok. + otp_10979_hanging_node(_Config) -> P1 = processes(), diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index 31b0b13b7b..3e9eaf259c 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -1047,7 +1047,7 @@ read_expected(Version) -> POS1 = 28, POS2 = POS1+10, POS3 = POS2+6, POS4 = POS3+6, POS5 = POS4+10, POS6 = POS5+5, POS7 = POS6+6, POS8 = POS7+6, POS9 = POS8+8, POS10 = POS9+10, POS11 = POS10+7, POS12 = POS11+8, POS13 = POS12+10, - POS14 = POS13+18, % POS15 = POS14+23, + POS14 = POS13+18, POS15 = POS14+23, FF = {read,funfuns,0}, U = [{POS1+5,{FF,{dist,'$F_EXPR',0}}}, @@ -1196,11 +1196,6 @@ read_expected(Version) -> {0,{FF,{modul,'$F_EXPR',179}}}] ++ O1; _ -> -% [{POS15+2,{{read,bi,0},{foo,t,0}}}, -% {POS15+3,{{read,bi,0},{bar,t,0}}}, -% {POS15+6,{{read,bi,0},{read,local,0}}}, -% {POS15+8,{{read,bi,0},{foo,t,0}}}, -% {POS15+10,{{read,bi,0},{bar,t,0}}}] ++ [{16,{FF,{read,'$F_EXPR',178}}}, {17,{FF,{modul,'$F_EXPR',179}}}] ++ @@ -1227,7 +1222,11 @@ read_expected(Version) -> _ -> [{POS13+16, {{read,bi,0},{erlang,'!',2}}}, {POS13+16, {{read,bi,0},{erlang,'-',1}}}, - {POS13+16, {{read,bi,0},{erlang,self,0}}}] + {POS13+16, {{read,bi,0},{erlang,self,0}}}, + {POS15+1, {{read,bi,0},{erlang,'>',2}}}, + {POS15+2, {{read,bi,0},{erlang,'-',2}}}, + {POS15+2, {{read,bi,0},{erlang,'*',2}}}, + {POS15+8, {{read,bi,0},{erlang,'/',2}}}] end ++ [{POS14+19, {{read,bi,0},{erlang,'+',2}}}, {POS14+21, {{read,bi,0},{erlang,'+',2}}}, diff --git a/lib/tools/test/xref_SUITE_data/read/read.erl b/lib/tools/test/xref_SUITE_data/read/read.erl index 19694c9e25..5f388194b0 100644 --- a/lib/tools/test/xref_SUITE_data/read/read.erl +++ b/lib/tools/test/xref_SUITE_data/read/read.erl @@ -156,20 +156,19 @@ bi() -> <> = Bin3, X = 9, <<(X+1):8>>, _Fyy = <>, - D + E + F. -%bi() -> -% %% POS15=POS14+13 -% try -% foo:t(), -% bar:t() -% of -% {v,1} -> -% local(); -% {v,2} -> -% foo:t() -% catch -% {'EXIT',_} -> bar:t() -% end. + D + E + F; +bi() -> + %% EEP37. POS15=POS14+23 + F = fun Fact(N) when N > 0 -> + N * Fact(N - 1); + Fact(0) -> + 1 + end, + F(6), + G = fun _(foo) -> bar; + _(X) -> X / 3 + end, + G(foo). local() -> true. -- cgit v1.2.3 From a929df291877df45c93303d22995bbbebf6a2c45 Mon Sep 17 00:00:00 2001 From: Anthony Ramine Date: Mon, 12 Nov 2012 10:07:37 +0100 Subject: Document named fun expressions --- erts/doc/src/absform.xml | 12 ++++++++++++ system/doc/reference_manual/expressions.xml | 23 ++++++++++++++--------- 2 files changed, 26 insertions(+), 9 deletions(-) diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml index 55aef9f8ab..4acc03b133 100644 --- a/erts/doc/src/absform.xml +++ b/erts/doc/src/absform.xml @@ -290,6 +290,18 @@ If E is where each is a function clause then Rep(E) = . + If E is + where is a variable and each + is a function clause then Rep(E) = + . + + If E is , + where each is a generator or a filter, then + Rep(E) = . + For Rep(W), see below. + If E is , a Mnesia record access + inside a query, then + Rep(E) = . If E is , then Rep(E) = , i.e., parenthesized expressions cannot be distinguished from their bodies. diff --git a/system/doc/reference_manual/expressions.xml b/system/doc/reference_manual/expressions.xml index 0dc6bfe576..e9de3e006e 100644 --- a/system/doc/reference_manual/expressions.xml +++ b/system/doc/reference_manual/expressions.xml @@ -954,19 +954,20 @@ Ei = Value | Fun Expressions 
 fun
-    (Pattern11,...,Pattern1N) [when GuardSeq1] ->
-        Body1;
+    [Name](Pattern11,...,Pattern1N) [when GuardSeq1] ->
+              Body1;
     ...;
-    (PatternK1,...,PatternKN) [when GuardSeqK] ->
-        BodyK
+    [Name](PatternK1,...,PatternKN) [when GuardSeqK] ->
+              BodyK
 end

A fun expression begins with the keyword fun and ends with the keyword end. Between them should be a function declaration, similar to a - regular function declaration, except that no function name is - specified.

-

Variables in a fun head shadow variables in the - function clause surrounding the fun expression, and + regular function declaration, + except that the function name is optional and should be a variable if + any.

+

Variables in a fun head shadow the function name and both shadow + variables in the function clause surrounding the fun expression, and variables bound in a fun body are local to the fun body.

The return value of the expression is the resulting fun.

Examples:

@@ -978,7 +979,11 @@ end 3> Fun2 = fun (X) when X>=5 -> gt; (X) -> lt end. #Fun<erl_eval.6.39074546> 4> Fun2(7). -gt +gt +5> Fun3 = fun Fact(1) -> 1; Fact(X) when X > 1 -> X * Fact(X - 1) end. +#Fun<erl_eval.6.39074546> +6> Fun3(4). +24

The following fun expressions are also allowed:

 fun Name/Arity
-- 
cgit v1.2.3


From 4df233adc5a1d5ab54d3c7419a463ae1ef417c12 Mon Sep 17 00:00:00 2001
From: Steve Vinoski 
Date: Wed, 11 Sep 2013 06:44:27 -0400
Subject: Support EEP37 named funs in emacs erlang-mode

Change emacs erlang-mode to recognize EEP37 named funs so they're indented
properly. Specifically, modify erlang-partial-parse to allow for an
optional Erlang variable name to appear between the "fun" keyword and the
opening parenthesis of its argument list.
---
 lib/tools/emacs/erlang.el         |  6 ++++++
 lib/tools/emacs/test.erl.indented | 13 +++++++++++++
 lib/tools/emacs/test.erl.orig     | 13 +++++++++++++
 3 files changed, 32 insertions(+)

diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index c395d22356..c1e9bec6ae 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -2600,6 +2600,12 @@ Value is list (stack token-start token-type in-what)."
 	     (if (save-excursion
 		   (goto-char (match-end 1))
 		   (erlang-skip-blank to)
+		   ;; Use erlang-variable-regexp here to look for an
+		   ;; optional variable name to match EEP37 named funs.
+		   (if (looking-at erlang-variable-regexp)
+		       (progn
+			 (goto-char (match-end 0))
+			 (erlang-skip-blank to)))
 		   (eq (following-char) ?\())
 		 (erlang-push (list 'fun token (current-column)) stack)))
 	    ((looking-at "\\(begin\\|query\\)[^_a-zA-Z0-9]")
diff --git a/lib/tools/emacs/test.erl.indented b/lib/tools/emacs/test.erl.indented
index 7e61bcc45b..0de626125c 100644
--- a/lib/tools/emacs/test.erl.indented
+++ b/lib/tools/emacs/test.erl.indented
@@ -483,6 +483,19 @@ indent_fun() ->
 			Y = true andalso
 			    kalle
 		end),
+    %% check EEP37 named funs
+    Fn1 = fun Fact(N) when N > 0 ->
+		  F = Fact(N-1),
+		  N * F;
+	      Fact(0) ->
+		  1
+	  end,
+    %% check anonymous funs too
+    Fn2 = fun(0) ->
+		  1;
+	     (N) ->
+		  N
+	  end,
     ok.
 
 indent_try_catch() ->
diff --git a/lib/tools/emacs/test.erl.orig b/lib/tools/emacs/test.erl.orig
index 932758997d..57263d573b 100644
--- a/lib/tools/emacs/test.erl.orig
+++ b/lib/tools/emacs/test.erl.orig
@@ -483,6 +483,19 @@ Var = spawn(fun(X)
   Y = true andalso
 	  kalle
  end),
+%% check EEP37 named funs
+Fn1 = fun Fact(N) when N > 0 ->
+   F = Fact(N-1),
+          N * F;
+Fact(0) ->
+                 1
+  end,
+%% check anonymous funs too
+   Fn2 = fun(0) ->
+1;
+   (N) ->
+   N
+ end,
   ok.
 
 indent_try_catch() ->
-- 
cgit v1.2.3