diff options
author | Björn Gustavsson <[email protected]> | 2013-12-13 11:51:25 +0100 |
---|---|---|
committer | Björn Gustavsson <[email protected]> | 2013-12-13 11:51:25 +0100 |
commit | fa6407f35c12156a9ed2eb25fb131e1ef5c7f0e4 (patch) | |
tree | 86f2b4178f0a15e33d300cf648a0b235252b9990 | |
parent | af17798534de376505498b86525ab8618753ebf7 (diff) | |
parent | 4df233adc5a1d5ab54d3c7419a463ae1ef417c12 (diff) | |
download | otp-fa6407f35c12156a9ed2eb25fb131e1ef5c7f0e4.tar.gz otp-fa6407f35c12156a9ed2eb25fb131e1ef5c7f0e4.tar.bz2 otp-fa6407f35c12156a9ed2eb25fb131e1ef5c7f0e4.zip |
Merge branch 'nox/eep37/OTP-11537'
* nox/eep37/OTP-11537:
Support EEP37 named funs in emacs erlang-mode
Document named fun expressions
Test named funs
Support named funs in the debugger interpreter
Update primary bootstrap for named funs in the shell
Support named funs in the shell
Update primary bootstrap for named funs
EEP 37: Funs with names
Support non top level letrecs in dialyzer
56 files changed, 876 insertions, 166 deletions
diff --git a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam Binary files differindex 60933730c3..1e27f9e222 100644 --- a/bootstrap/lib/compiler/ebin/sys_pre_expand.beam +++ b/bootstrap/lib/compiler/ebin/sys_pre_expand.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 3da6d334b4..db2c79cae7 100644 --- a/bootstrap/lib/compiler/ebin/v3_core.beam +++ b/bootstrap/lib/compiler/ebin/v3_core.beam diff --git a/bootstrap/lib/stdlib/ebin/epp.beam b/bootstrap/lib/stdlib/ebin/epp.beam Binary files differindex 1d438315ae..62e4840c77 100644 --- a/bootstrap/lib/stdlib/ebin/epp.beam +++ b/bootstrap/lib/stdlib/ebin/epp.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_eval.beam b/bootstrap/lib/stdlib/ebin/erl_eval.beam Binary files differindex 1124de722e..60a39206f7 100644 --- a/bootstrap/lib/stdlib/ebin/erl_eval.beam +++ b/bootstrap/lib/stdlib/ebin/erl_eval.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam Binary files differindex 411f453a95..0f0da08a87 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex c087684fa1..00431e7bc9 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex b66feba048..4098c1d1d1 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_pp.beam b/bootstrap/lib/stdlib/ebin/erl_pp.beam Binary files differindex ecc8933bef..22d48708b8 100644 --- a/bootstrap/lib/stdlib/ebin/erl_pp.beam +++ b/bootstrap/lib/stdlib/ebin/erl_pp.beam diff --git a/bootstrap/lib/stdlib/ebin/ets.beam b/bootstrap/lib/stdlib/ebin/ets.beam Binary files differindex b9cb892454..a6b4947b6c 100644 --- a/bootstrap/lib/stdlib/ebin/ets.beam +++ b/bootstrap/lib/stdlib/ebin/ets.beam diff --git a/bootstrap/lib/stdlib/ebin/ms_transform.beam b/bootstrap/lib/stdlib/ebin/ms_transform.beam Binary files differindex f532375e3a..1715cfac50 100644 --- a/bootstrap/lib/stdlib/ebin/ms_transform.beam +++ b/bootstrap/lib/stdlib/ebin/ms_transform.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc.beam b/bootstrap/lib/stdlib/ebin/qlc.beam Binary files differindex a1a8ed113f..a654bb3d99 100644 --- a/bootstrap/lib/stdlib/ebin/qlc.beam +++ b/bootstrap/lib/stdlib/ebin/qlc.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam Binary files differindex 2f1db1d159..9624629b83 100644 --- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam +++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam diff --git a/bootstrap/lib/stdlib/ebin/shell.beam b/bootstrap/lib/stdlib/ebin/shell.beam Binary files differindex 190ca28439..1971561ef1 100644 --- a/bootstrap/lib/stdlib/ebin/shell.beam +++ b/bootstrap/lib/stdlib/ebin/shell.beam 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 @@ <item>If E is <c><![CDATA[fun Fc_1 ; ... ; Fc_k end]]></c> where each <c><![CDATA[Fc_i]]></c> is a function clause then Rep(E) = <c><![CDATA[{'fun',LINE,{clauses,[Rep(Fc_1), ..., Rep(Fc_k)]}}]]></c>.</item> + <item>If E is <c><![CDATA[fun Name Fc_1 ; ... ; Name Fc_k end]]></c> + where <c><![CDATA[Name]]></c> is a variable and each + <c><![CDATA[Fc_i]]></c> is a function clause then Rep(E) = + <c><![CDATA[{named_fun,LINE,Name,[Rep(Fc_1), ..., Rep(Fc_k)]}]]></c>. + </item> + <item>If E is <c><![CDATA[query [E_0 || W_1, ..., W_k] end]]></c>, + where each <c><![CDATA[W_i]]></c> is a generator or a filter, then + Rep(E) = <c><![CDATA[{'query',LINE,{lc,LINE,Rep(E_0),[Rep(W_1), ..., Rep(W_k)]}}]]></c>. + For Rep(W), see below.</item> + <item>If E is <c><![CDATA[E_0.Field]]></c>, a Mnesia record access + inside a query, then + Rep(E) = <c><![CDATA[{record_field,LINE,Rep(E_0),Rep(Field)}]]></c>.</item> <item>If E is <c><![CDATA[( E_0 )]]></c>, then Rep(E) = <c><![CDATA[Rep(E_0)]]></c>, i.e., parenthesized expressions cannot be distinguished from their bodies.</item> 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 <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin, ?line bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>); +otp_8117_do(named_fun,Neg) -> + % Named fun with negative num_free + FunBin = term_to_binary(fun F() -> F end), + ?line <<B1:27/binary,_NumFree:32,Rest/binary>> = FunBin, + ?line bad_bin_to_term(<<B1/binary,Neg:32,Rest/binary>>); 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/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/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/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). 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/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}, 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/dialyzer/test/small_SUITE_data/results/eep37 b/lib/dialyzer/test/small_SUITE_data/results/eep37 new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/eep37 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/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_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/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/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/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.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/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/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, 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/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/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() -> 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. 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() -> <<D:16, E, F/binary>> = Bin3, X = 9, <<(X+1):8>>, _Fyy = <<X:4/little-signed-integer-unit:8>>, - 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. 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 | <title>Fun Expressions</title> <pre> fun - (Pattern11,...,Pattern1N) [when GuardSeq1] -> - Body1; + [Name](Pattern11,...,Pattern1N) [when GuardSeq1] -> + Body1; ...; - (PatternK1,...,PatternKN) [when GuardSeqK] -> - BodyK + [Name](PatternK1,...,PatternKN) [when GuardSeqK] -> + BodyK end</pre> <p>A fun expression begins with the keyword <c>fun</c> and ends with the keyword <c>end</c>. Between them should be a function declaration, similar to a - <seealso marker="functions#syntax">regular function declaration</seealso>, except that no function name is - specified.</p> - <p>Variables in a fun head shadow variables in the - function clause surrounding the fun expression, and + <seealso marker="functions#syntax">regular function declaration</seealso>, + except that the function name is optional and should be a variable if + any.</p> + <p>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.</p> <p>The return value of the expression is the resulting fun.</p> <p>Examples:</p> @@ -978,7 +979,11 @@ end</pre> 3> <input>Fun2 = fun (X) when X>=5 -> gt; (X) -> lt end.</input> #Fun<erl_eval.6.39074546> 4> <input>Fun2(7).</input> -gt</pre> +gt +5> <input>Fun3 = fun Fact(1) -> 1; Fact(X) when X > 1 -> X * Fact(X - 1) end.</input> +#Fun<erl_eval.6.39074546> +6> <input>Fun3(4).</input> +24</pre> <p>The following fun expressions are also allowed:</p> <pre> fun Name/Arity |