File 2771-Compile-external-fun-expressions-to-litera... of Package erlang

Overview Repositories Revisions Requests Users Attributes Meta

File 2771-Compile-external-fun-expressions-to-literals.patch of Package erlang (Revision 84136f040b8e10a77a20fc548a9bd409)

Currently displaying revision 84136f040b8e10a77a20fc548a9bd409 , Show latest

From 63e1c58d27ab695a19897423fc75e607f69ff51b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Micha=C5=82=20Muska=C5=82a?= <michal@muskala.eu>
Date: Sun, 25 Feb 2018 14:19:48 +0100
Subject: [PATCH] Compile external fun expressions to literals

The expressions fun M:F/A, when all elements are literals are also
treated as a literal. Since they have consistent representation and
don't depend on the code currently loaded in the VM, this is safe.
This can provide significant performance improvements in code using such
functions extensively - a full function call to erlang:make_fun/3 is
replaced by a single move instruction and no register shuffling or
saving registers to stack is necessary. Additionally, compound data
types that contain such external functions as elements can be treated as
literals too.

The commit also changes the representation of external funs to be a
valid Erlang syntax and adds support for literal external funs to core
Erlang.
---
 erts/emulator/beam/beam_load.c             | 13 +++++++
 erts/emulator/beam/erl_printf_term.c       |  7 ++--
 erts/emulator/beam/ops.tab                 |  3 +-
 erts/emulator/test/beam_literals_SUITE.erl | 55 +++++++++++++++++++++---------
 lib/compiler/src/cerl.erl                  |  2 ++
 lib/compiler/src/core_parse.yrl            |  6 +++-
 lib/compiler/src/core_pp.erl               |  6 +++-
 lib/compiler/src/erl_bifs.erl              |  2 ++
 lib/compiler/src/sys_core_fold.erl         |  5 ++-
 lib/stdlib/src/erl_parse.yrl               |  2 ++
 10 files changed, 77 insertions(+), 24 deletions(-)

diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index e242fe9140..3ac98cec8d 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -4520,6 +4520,19 @@ is_empty_map(LoaderState* stp, GenOpArg Lit)
     return is_flatmap(term) && flatmap_get_size(flatmap_val(term)) == 0;
 }
 
+/*
+ * 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
@@ -529,14 +529,13 @@ print_term(fmtfn_t fn, void* arg, Eterm obj, long *dcount) {
 		Atom* module = atom_tab(atom_val(ep->code[0]));
 		Atom* name = atom_tab(atom_val(ep->code[1]));
 
-		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->code[2]);
-		PRINT_CHAR(res, fn, arg, '>');
 	    }
 	    break;
 	case FUN_DEF:
diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab
index 77e375f2c0..6e03f39d97 100644
--- a/erts/emulator/beam/ops.tab
+++ b/erts/emulator/beam/ops.tab
@@ -774,7 +774,8 @@ is_boolean Fail=f ac => jump Fail
 is_boolean f y
 %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 79a7cccd98..f828b3ed56 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 a9bd363ee1..e39b9df218 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -392,7 +392,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 ->
@@ -487,6 +487,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;
-- 
2.16.3

Places

File 2771-Compile-external-fun-expressions-to-literals.patch of Package erlang (Revision 84136f040b8e10a77a20fc548a9bd409)

Places