diff options
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 |