Merge pull request #1725 from michalmuskala/fun-literals

Compile external fun expressions to literals

OTP-15003

10 files changed, 77 insertions, 24 deletions

diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index af620d7432..e61199a8fd 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -4522,6 +4522,19 @@ is_empty_map(LoaderState* stp, GenOpArg Lit)
 }
 
 /*
+ * Predicate to test whether the given literal is an export.
+ */
+static int
+literal_is_export(LoaderState* stp, GenOpArg Lit)
+{
+    Eterm term;
+
+    ASSERT(Lit.type == TAG_q);
+    term = stp->literals[Lit.val].term;
+    return is_export(term);
+}
+
+/*
  * Pseudo predicate map_key_sort that will sort the Rest operand for
  * map instructions as a side effect.
  */
diff --git a/erts/emulator/beam/erl_printf_term.c b/erts/emulator/beam/erl_printf_term.c
index e6f8460164..910f241a3a 100644
--- a/erts/emulator/beam/erl_printf_term.c
+++ b/erts/emulator/beam/erl_printf_term.c
@@ -532,14 +532,13 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) {
 		Atom* module = atom_tab(atom_val(ep->info.mfa.module));
 		Atom* name = atom_tab(atom_val(ep->info.mfa.function));
 
-		PRINT_STRING(res, fn, arg, "#Fun<");
+		PRINT_STRING(res, fn, arg, "fun ");
 		PRINT_BUF(res, fn, arg, module->name, module->len);
-		PRINT_CHAR(res, fn, arg, '.');
+		PRINT_CHAR(res, fn, arg, ':');
 		PRINT_BUF(res, fn, arg, name->name, name->len);
-		PRINT_CHAR(res, fn, arg, '.');
+		PRINT_CHAR(res, fn, arg, '/');
 		PRINT_SWORD(res, fn, arg, 'd', 0, 1,
 			    (ErlPfSWord) ep->info.mfa.arity);
-		PRINT_CHAR(res, fn, arg, '>');
 	    }
 	    break;
 	case FUN_DEF:
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index bc765a8c94..8b2d9098a8 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -710,7 +710,8 @@ is_boolean Fail=f ac => jump Fail
 is_boolean f? xy
 %hot
 
-is_function2 Fail=f acq Arity => jump Fail
+is_function2 Fail=f Literal=q Arity | literal_is_export(Literal) =>
+is_function2 Fail=f c Arity => jump Fail
 is_function2 Fail=f Fun a => jump Fail
 
 is_function2 f? S s
diff --git a/erts/emulator/test/beam_literals_SUITE.erl b/erts/emulator/test/beam_literals_SUITE.erl
index 09761263e2..b447ca0210 100644
--- a/erts/emulator/test/beam_literals_SUITE.erl
+++ b/erts/emulator/test/beam_literals_SUITE.erl
@@ -248,35 +248,58 @@ literal_type_tests(Config) when is_list(Config) ->
     ok.
 
 make_test([{is_function=T,L}|Ts]) ->
-    [test(T, L),test(T, 0, L)|make_test(Ts)];
+    [guard_test(T, L),guard_test(T, 0, L),body_test(T, L),body_test(T, 0, L)|make_test(Ts)];
 make_test([{T,L}|Ts]) ->
-    [test(T, L)|make_test(Ts)];
+    [guard_test(T, L),body_test(T, L)|make_test(Ts)];
 make_test([]) -> [].
 
-test(T, L) ->
-    S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T, L, T, L])),
-    {ok,Toks,_Line} = erl_scan:string(S),
-    {ok,E} = erl_parse:parse_exprs(Toks),
-    {value,Val,_Bs} = erl_eval:exprs(E, []),
+guard_test(_, L) when is_function(L) ->
+    %% Skip guard tests with exports - they are not literals
+    {atom,erl_anno:new(0),true};
+guard_test(T, L) ->
+    S = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T, L, T, L]),
+    {Val,Expr} = eval_string(S),
+    Anno = erl_anno:new(0),
+    {match,Anno,{atom,Anno,Val},Expr}.
+
+guard_test(_, _, L) when is_function(L) ->
+    %% Skip guard tests with exports - they are not literals
+    {atom,erl_anno:new(0),true};
+guard_test(T, A, L) ->
+    S = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ", [T,L,A,T,L,A]),
+    {Val,Expr} = eval_string(S),
+    Anno = erl_anno:new(0),
+    {match,Anno,{atom,Anno,Val},Expr}.
+
+body_test(T, L) ->
+    S = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), ~w(~w) end. ", [T,L,T,L]),
+    {Val,Expr} = eval_string(S),
     Anno = erl_anno:new(0),
-    {match,Anno,{atom,Anno,Val},hd(E)}.
+    {match,Anno,{atom,Anno,Val},Expr}.
 
-test(T, A, L) ->
-    S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ",
-				    [T,L,A,T,L,A])),
-    {ok,Toks,_Line} = erl_scan:string(S),
+body_test(T, A, L) ->
+    S = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), ~w(~w,~w) end. ", [T,L,A,T,L,A]),
+    {Val,Expr} = eval_string(S),
+    Anno = erl_anno:new(0),
+    {match,Anno,{atom,Anno,Val},Expr}.
+
+eval_string(S) ->
+    {ok,Toks,_Line} = erl_scan:string(lists:flatten(S)),
     {ok,E} = erl_parse:parse_exprs(Toks),
     {value,Val,_Bs} = erl_eval:exprs(E, []),
-    Anno = erl_anno:new(0),
-    {match,Anno,{atom,Anno,Val},hd(E)}.
-    
+    {Val,hd(E)}.
+
 literals() ->
     [42,
      3.14,
      -3,
      32982724987789283473473838474,
      [],
-     xxxx].
+     "abc",
+     <<"abc">>,
+     {},
+     xxxx,
+     fun erlang:erase/0].
 
 type_tests() ->
     [is_boolean,
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 6b936a7687..fce23bfd68 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -433,6 +433,8 @@ is_literal_term(T) when is_tuple(T) ->
 is_literal_term(B) when is_bitstring(B) -> true;
 is_literal_term(M) when is_map(M) ->
     is_literal_term_list(maps:to_list(M));
+is_literal_term(F) when is_function(F) ->
+    erlang:fun_info(F, type) =:= {type,external};
 is_literal_term(_) ->
     false.
 
diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl
index 85444023c6..11c4cd8b50 100644
--- a/lib/compiler/src/core_parse.yrl
+++ b/lib/compiler/src/core_parse.yrl
@@ -36,7 +36,7 @@ other_pattern atomic_pattern tuple_pattern cons_pattern tail_pattern
 binary_pattern segment_patterns segment_pattern
 
 expression single_expression
-literal literals atomic_literal tuple_literal cons_literal tail_literal
+literal literals atomic_literal tuple_literal cons_literal tail_literal fun_literal
 nil tuple cons tail
 binary segments segment
 
@@ -267,6 +267,7 @@ single_expression -> cons : '$1'.
 single_expression -> binary : '$1'.
 single_expression -> variable : '$1'.
 single_expression -> function_name : '$1'.
+single_expression -> fun_literal : '$1'.
 single_expression -> fun_expr : '$1'.
 single_expression -> let_expr : '$1'.
 single_expression -> letrec_expr : '$1'.
@@ -303,6 +304,9 @@ tail_literal -> ']' : #c_literal{val=[]}.
 tail_literal -> '|' literal ']' : '$2'.
 tail_literal -> ',' literal tail_literal : c_cons('$2', '$3').
 
+fun_literal -> 'fun' atom ':' atom '/' integer :
+	#c_literal{val = erlang:make_fun(tok_val('$2'), tok_val('$4'), tok_val('$6'))}.
+
 tuple -> '{' '}' : c_tuple([]).
 tuple -> '{' anno_expressions '}' : c_tuple('$2').
 
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index 2516a9a1e1..f247722b4c 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -136,6 +136,11 @@ format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) ->
 			  key=#c_literal{val=K},
 			  val=#c_literal{val=V}} || {K,V} <- Pairs],
     format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt);
+format_1(#c_literal{val=F},_Ctxt) when is_function(F) ->
+    {module,M} = erlang:fun_info(F, module),
+    {name,N} = erlang:fun_info(F, name),
+    {arity,A} = erlang:fun_info(F, arity),
+    ["fun ",core_atom(M),$:,core_atom(N),$/,integer_to_list(A)];
 format_1(#c_var{name={I,A}}, _) ->
     [core_atom(I),$/,integer_to_list(A)];
 format_1(#c_var{name=V}, _) ->
@@ -541,4 +546,3 @@ segs_from_bitstring(Bitstring) ->
 	      unit=#c_literal{val=1},
 	      type=#c_literal{val=integer},
 	      flags=#c_literal{val=[unsigned,big]}}].
-
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index bafa9d75b7..8fab2400f7 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -109,6 +109,7 @@ is_pure(erlang, list_to_integer, 1) -> true;
 is_pure(erlang, list_to_pid, 1) -> true;
 is_pure(erlang, list_to_tuple, 1) -> true;
 is_pure(erlang, max, 2) -> true;
+is_pure(erlang, make_fun, 3) -> true;
 is_pure(erlang, min, 2) -> true;
 is_pure(erlang, phash, 2) -> false;
 is_pure(erlang, pid_to_list, 1) -> true;
@@ -196,6 +197,7 @@ is_safe(erlang, is_port, 1) -> true;
 is_safe(erlang, is_reference, 1) -> true;
 is_safe(erlang, is_tuple, 1) -> true;
 is_safe(erlang, make_ref, 0) -> true;
+is_safe(erlang, make_fun, 3) -> true;
 is_safe(erlang, max, 2) -> true;
 is_safe(erlang, min, 2) -> true;
 is_safe(erlang, node, 0) -> true;
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 395b6bd677..bb3a9c7628 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -404,7 +404,7 @@ expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) ->
 expr(#c_apply{anno=Anno,op=Op0,args=As0}=App, _, Sub) ->
     Op1 = expr(Op0, value, Sub),
     As1 = expr_list(As0, value, Sub),
-    case cerl:is_data(Op1) of
+    case cerl:is_data(Op1) andalso not is_literal_fun(Op1) of
         false ->
 	    App#c_apply{op=Op1,args=As1};
 	true ->
@@ -499,6 +499,9 @@ bitstr_list(Es, Sub) ->
 bitstr(#c_bitstr{val=Val,size=Size}=BinSeg, Sub) ->
     BinSeg#c_bitstr{val=expr(Val, Sub),size=expr(Size, value, Sub)}.
 
+is_literal_fun(#c_literal{val=F}) -> is_function(F);
+is_literal_fun(_) -> false.
+
 %% is_safe_simple(Expr, Sub) -> true | false.
 %%  A safe simple cannot fail with badarg and is safe to use
 %%  in a guard.
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 14ca24362e..0c338b5952 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -1377,6 +1377,8 @@ normalise({map,_,Pairs}=M) ->
 		({map_field_assoc,_,K,V}) -> {normalise(K),normalise(V)};
 		(_) -> erlang:error({badarg,M})
 	    end, Pairs));
+normalise({'fun',_,{function,{atom,_,M},{atom,_,F},{integer,_,A}}}) ->
+    fun M:F/A;
 %% Special case for unary +/-.
 normalise({op,_,'+',{char,_,I}}) -> I;
 normalise({op,_,'+',{integer,_,I}}) -> I;