diff options
author | Anthony Ramine <[email protected]> | 2012-11-10 17:06:01 +0100 |
---|---|---|
committer | Anthony Ramine <[email protected]> | 2013-12-12 10:46:08 +0100 |
commit | acbca8379bdde12612e27f3313a5c73f4db25381 (patch) | |
tree | 536f5f2d71f4ef1339b03472048e1b932d7064c5 /lib | |
parent | 6c5c39827cc06a9e9b3e3fa4fa856f4610eb40b6 (diff) | |
download | otp-acbca8379bdde12612e27f3313a5c73f4db25381.tar.gz otp-acbca8379bdde12612e27f3313a5c73f4db25381.tar.bz2 otp-acbca8379bdde12612e27f3313a5c73f4db25381.zip |
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> = '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.
Diffstat (limited to 'lib')
-rw-r--r-- | lib/compiler/src/sys_pre_expand.erl | 14 | ||||
-rw-r--r-- | lib/compiler/src/v3_core.erl | 68 | ||||
-rw-r--r-- | lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_expand_pmod.erl | 2 | ||||
-rw-r--r-- | lib/stdlib/examples/erl_id_trans.erl | 2 | ||||
-rw-r--r-- | lib/stdlib/src/epp.erl | 2 | ||||
-rw-r--r-- | lib/stdlib/src/erl_expand_records.erl | 3 | ||||
-rw-r--r-- | lib/stdlib/src/erl_lint.erl | 10 | ||||
-rw-r--r-- | lib/stdlib/src/erl_parse.yrl | 12 | ||||
-rw-r--r-- | lib/stdlib/src/erl_pp.erl | 20 | ||||
-rw-r--r-- | lib/stdlib/src/ms_transform.erl | 7 | ||||
-rw-r--r-- | lib/stdlib/src/qlc_pt.erl | 16 | ||||
-rw-r--r-- | lib/syntax_tools/src/erl_syntax.erl | 126 | ||||
-rw-r--r-- | lib/tools/src/cover.erl | 7 | ||||
-rw-r--r-- | 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 @@ %% <td>match_expr</td> %% <td>module_qualifier</td> %% </tr><tr> +%% <td>named_fun_expr</td> %% <td>nil</td> %% <td>operator</td> %% <td>parentheses</td> -%% <td>prefix_expr</td> %% </tr><tr> +%% <td>prefix_expr</td> %% <td>receive_expr</td> %% <td>record_access</td> -%% </tr><tr> %% <td>record_expr</td> +%% </tr><tr> %% <td>record_field</td> %% <td>record_index_expr</td> %% <td>rule</td> -%% </tr><tr> %% <td>size_qualifier</td> +%% </tr><tr> %% <td>string</td> %% <td>text</td> %% <td>try_expr</td> -%% </tr><tr> %% <td>tuple</td> +%% </tr><tr> %% <td>underscore</td> %% <td>variable</td> %% <td>warning_marker</td> +%% <td></td> %% </tr> %% </table></center> %% @@ -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; @@ -5616,6 +5624,110 @@ fun_expr_arity(Node) -> %% ===================================================================== +%% @doc Creates an abstract named fun-expression. If `Clauses' is +%% `[C1, ..., Cn]', the result represents "<code>fun +%% <em>Name</em> <em>C1</em>; ...; <em>Name</em> <em>Cn</em> end</code>". +%% More exactly, if each `Ci' represents +%% "<code>(<em>Pi1</em>, ..., <em>Pim</em>) <em>Gi</em> -> <em>Bi</em></code>", +%% then the result represents +%% "<code>fun <em>Name</em>(<em>P11</em>, ..., <em>P1m</em>) <em>G1</em> -> +%% <em>B1</em>; ...; <em>Name</em>(<em>Pn1</em>, ..., <em>Pnm</em>) +%% <em>Gn</em> -> <em>Bn</em> end</code>". +%% +%% @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 "<code>(<em>Body</em>)</code>", independently of the %% context. @@ -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. |