Create a shared wrapper function for all occurrences of 'fun F/A'

If the `fun F/A` syntax is used multiple times with the same `F/A`,
(for examle, `fun foo/2`), there would a wrapper function and fun
entry generated for each occurrence.

Using the new support in the OTP 23 runtime system, generate a single
wrapper function and fun entry for each `F/A`. Since there is only one
wrapper function, it can be named based on the name of the function it
calls to faciliate debugging, not based on the function that defines
the fun. For example, the wrapper function for `fun foo/0` will now be
named `-fun.foo/0-'.

7 files changed, 115 insertions, 48 deletions

diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index df09dcb06c..60e19ec596 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -64,11 +64,30 @@ module(Code, ExtraChunks, CompileInfo, CompilerOpts) ->
 assemble({Mod,Exp0,Attr0,Asm0,NumLabels}, ExtraChunks, CompileInfo, CompilerOpts) ->
     {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()),
     {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0),
+    Dict2 = shared_fun_wrappers(CompilerOpts, Dict1),
     NumFuncs = length(Asm0),
     {Asm,Attr} = on_load(Asm0, Attr0),
     Exp = cerl_sets:from_list(Exp0),
-    {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []),
-    build_file(Code, Attr, Dict2, NumLabels, NumFuncs, ExtraChunks, CompileInfo, CompilerOpts).
+    {Code,Dict} = assemble_1(Asm, Exp, Dict2, []),
+    build_file(Code, Attr, Dict, NumLabels, NumFuncs,
+               ExtraChunks, CompileInfo, CompilerOpts).
+
+shared_fun_wrappers(Opts, Dict) ->
+    case proplists:get_bool(no_shared_fun_wrappers, Opts) of
+        false ->
+            %% The compiler in OTP 23 depends on the on the loader
+            %% using the new indices in funs and being able to have
+            %% multiple make_fun2 instructions referring to the same
+            %% fun entry. Artificially set the highest opcode for the
+            %% module to ensure that it cannot be loaded in OTP 22
+            %% and earlier.
+            Swap = beam_opcodes:opcode(swap, 2),
+            beam_dict:opcode(Swap, Dict);
+        true ->
+            %% Fun wrappers are not shared for compatibility with a
+            %% previous OTP release.
+            Dict
+    end.
 
 on_load(Fs0, Attr0) ->
     case proplists:get_value(on_load, Attr0) of
diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl
index b2056332e6..4d0cec857d 100644
--- a/lib/compiler/src/beam_dict.erl
+++ b/lib/compiler/src/beam_dict.erl
@@ -40,6 +40,7 @@
 
 -type lambda_info() :: {label(),{index(),label(),non_neg_integer()}}.
 -type lambda_tab() :: {non_neg_integer(),[lambda_info()]}.
+-type wrapper() :: #{label() => index()}.
 
 -record(asm,
 	{atoms = #{}                :: atom_tab(),
@@ -48,6 +49,7 @@
 	 imports = gb_trees:empty() :: import_tab(),
 	 strings = <<>>		    :: binary(),	%String pool
 	 lambdas = {0,[]}           :: lambda_tab(),
+         wrappers = #{}             :: wrapper(),
 	 literals = dict:new()	    :: literal_tab(),
 	 fnames = #{}               :: fname_tab(),
 	 lines = #{}                :: line_tab(),
@@ -147,11 +149,21 @@ string(BinString, Dict) when is_binary(BinString) ->
 -spec lambda(label(), non_neg_integer(), bdict()) ->
         {non_neg_integer(), bdict()}.
 
-lambda(Lbl, NumFree, #asm{lambdas={OldIndex,Lambdas0}}=Dict) ->
-    %% Set Index the same as OldIndex.
-    Index = OldIndex,
-    Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0],
-    {OldIndex,Dict#asm{lambdas={OldIndex+1,Lambdas}}}.
+lambda(Lbl, NumFree, #asm{wrappers=Wrappers0,
+                          lambdas={OldIndex,Lambdas0}}=Dict) ->
+    case Wrappers0 of
+        #{Lbl:=Index} ->
+            %% OTP 23: There old is a fun entry for this wrapper function.
+            %% Share the fun entry.
+            {Index,Dict};
+        #{} ->
+            %% Set Index the same as OldIndex.
+            Index = OldIndex,
+            Wrappers = Wrappers0#{Lbl=>Index},
+            Lambdas = [{Lbl,{Index,Lbl,NumFree}}|Lambdas0],
+            {OldIndex,Dict#asm{wrappers=Wrappers,
+                               lambdas={OldIndex+1,Lambdas}}}
+    end.
 
 %% Returns the index for a literal (adding it to the literal table if necessary).
 %%    literal(Literal, Dict) -> {Index,Dict'}
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index 098f82fdc0..42f9e8b902 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -265,9 +265,10 @@ expand_opt(r19, Os) ->
 expand_opt(r20, Os) ->
     expand_opt_before_21(Os);
 expand_opt(r21, Os) ->
-    [no_swap, no_put_tuple2 | expand_opt(no_bsm3, Os)];
+    [no_shared_fun_wrappers,
+     no_swap, no_put_tuple2 | expand_opt(no_bsm3, Os)];
 expand_opt(r22, Os) ->
-    [no_swap | Os];
+    [no_shared_fun_wrappers, no_swap | Os];
 expand_opt({debug_info_key,_}=O, Os) ->
     [encrypt_debug_info,O|Os];
 expand_opt(no_type_opt, Os) ->
@@ -277,7 +278,8 @@ expand_opt(no_type_opt, Os) ->
 expand_opt(O, Os) -> [O|Os].
 
 expand_opt_before_21(Os) ->
-    [no_swap, no_put_tuple2, no_get_hd_tl, no_ssa_opt_record,
+    [no_shared_fun_wrappers, no_swap,
+     no_put_tuple2, no_get_hd_tl, no_ssa_opt_record,
      no_utf8_atoms | expand_opt(no_bsm3, Os)].
 
 %% format_error(ErrorDescriptor) -> string()
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index e2b8787224..6fd1790c1a 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -81,8 +81,11 @@
 
 -export([module/2,format_error/1]).
 
--import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,
-		keyfind/3,partition/2,droplast/1,last/1,sort/1,reverse/1]).
+-import(lists, [droplast/1,flatten/1,foldl/3,foldr/3,
+                map/2,mapfoldl/3,member/2,
+		keyfind/3,keyreplace/4,
+                last/1,partition/2,reverse/1,
+                splitwith/2,sort/1]).
 -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
 -import(cerl, [c_tuple/1]).
 
@@ -120,15 +123,19 @@ copy_anno(Kdst, Ksrc) ->
 	       funs=[],				%Fun functions
 	       free=#{},			%Free variables
 	       ws=[]   :: [warning()],		%Warnings.
-	       guard_refc=0}).			%> 0 means in guard
+	       guard_refc=0, 			%> 0 means in guard
+               no_shared_fun_wrappers=false :: boolean()
+              }).
 
 -spec module(cerl:c_module(), [compile:option()]) ->
 	{'ok', #k_mdef{}, [warning()]}.
 
-module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) ->
+module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) ->
     Kas = attributes(As),
     Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es),
-    St0 = #kern{},
+    NoSharedFunWrappers = proplists:get_bool(no_shared_fun_wrappers,
+                                             Options),
+    St0 = #kern{no_shared_fun_wrappers=NoSharedFunWrappers},
     {Kfs,St} = mapfoldl(fun function/2, St0, Fs),
     {ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas,
 		body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}.
@@ -716,16 +723,27 @@ gexpr_test_add(Ke, St0) ->
 %% expr(Cexpr, Sub, State) -> {Kexpr,[PreKexpr],State}.
 %%  Convert a Core expression, flattening it at the same time.
 
-expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) ->
-    %% A local in an expression.
-    %% For now, these are wrapped into a fun by reverse
-    %% eta-conversion, but really, there should be exactly one
-    %% such "lambda function" for each escaping local name,
-    %% instead of one for each occurrence as done now.
+expr(#c_var{anno=A0,name={Name,Arity}}=Fname, Sub, St) ->
     Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} ||
-	     V <- integers(1, Arity)],
-    Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}},
-    expr(Fun, Sub, St);
+             V <- integers(1, Arity)],
+    case St#kern.no_shared_fun_wrappers of
+        false ->
+            %% Generate a (possibly shared) wrapper function for calling
+            %% this function.
+            Wrapper0 = ["-fun.",atom_to_list(Name),"/",integer_to_list(Arity),"-"],
+            Wrapper = list_to_atom(flatten(Wrapper0)),
+            Id = {id,{0,0,Wrapper}},
+            A = keyreplace(id, 1, A0, Id),
+            Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}},
+            expr(Fun, Sub, St);
+        true ->
+            %% For backward compatibility with OTP 22 and earlier,
+            %% use the pre-generated name for the fun wrapper.
+            %% There will be one wrapper function for each occurrence
+            %% of `fun F/A`.
+            Fun = #c_fun{anno=A0,vars=Vs,body=#c_apply{anno=A0,op=Fname,args=Vs}},
+            expr(Fun, Sub, St)
+    end;
 expr(#c_var{anno=A,name=V}, Sub, St) ->
     {#k_var{anno=A,name=get_vsub(V, Sub)},[],St};
 expr(#c_literal{anno=A,val=V}, _Sub, St) ->
@@ -2446,8 +2464,21 @@ uexpr(Lit, {break,Rs0}, St0) ->
     {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)},
 	    arg=Lit,ret=Rs},Used,St1}.
 
-add_local_function(_, #kern{funs=ignore}=St) -> St;
-add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}.
+add_local_function(_, #kern{funs=ignore}=St) ->
+    St;
+add_local_function(#k_fdef{func=Name,arity=Arity}=F, #kern{funs=Funs}=St) ->
+    case is_defined(Name, Arity, Funs) of
+        false ->
+            St#kern{funs=[F|Funs]};
+        true ->
+            St
+    end.
+
+is_defined(Name, Arity, [#k_fdef{func=Name,arity=Arity}|_]) ->
+    true;
+is_defined(Name, Arity, [#k_fdef{}|T]) ->
+    is_defined(Name, Arity, T);
+is_defined(_, _, []) -> false.
 
 %% Make a #k_fdef{}, making sure that the body is always a #k_match{}.
 make_fdef(Anno, Name, Arity, Vs, #k_match{}=Body) ->
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 7e9e641478..453debc0c1 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -1382,27 +1382,33 @@ env_compiler_options(_Config) ->
 bc_options(Config) ->
     DataDir = proplists:get_value(data_dir, Config),
 
-    L = [{101, small_float, [no_get_hd_tl,no_line_info]},
-         {103, big, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
+    L = [{101, small_float, [no_shared_fun_wrappers,
+                             no_get_hd_tl,no_line_info]},
+         {103, big, [no_shared_fun_wrappers,
+                     no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
                      no_line_info,no_stack_trimming]},
-         {125, small_float, [no_get_hd_tl,no_line_info,no_ssa_opt_float]},
+         {125, small_float, [no_shared_fun_wrappers,no_get_hd_tl,
+                             no_line_info,
+                             no_ssa_opt_float]},
 
-         {132, small, [no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
+         {132, small, [no_shared_fun_wrappers,
+                       no_put_tuple2,no_get_hd_tl,no_ssa_opt_record,
                        no_ssa_opt_float,no_line_info,no_bsm3]},
 
+         {136, big, [no_shared_fun_wrappers,no_put_tuple2,no_get_hd_tl,
+                     no_ssa_opt_record,no_line_info]},
+
          {153, small, [r20]},
          {153, small, [r21]},
 
-         {136, big, [no_put_tuple2,no_get_hd_tl,
-                     no_ssa_opt_record,no_line_info]},
-
-         {153, big, [no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]},
+         {153, big, [no_shared_fun_wrappers,
+                     no_put_tuple2,no_get_hd_tl, no_ssa_opt_record]},
          {153, big, [r16]},
          {153, big, [r17]},
          {153, big, [r18]},
          {153, big, [r19]},
          {153, small_float, [r16]},
-         {153, small_float, []},
+         {153, small_float, [no_shared_fun_wrappers]},
 
          {158, small_maps, [r17]},
          {158, small_maps, [r18]},
@@ -1412,11 +1418,15 @@ bc_options(Config) ->
 
          {164, small_maps, [r22]},
          {164, big, [r22]},
-         {164, small_maps, []},
-         {164, big, []},
+         {164, small_maps, [no_shared_fun_wrappers]},
+         {164, big, [no_shared_fun_wrappers]},
 
          {168, small, [r22]},
-         {168, small, []}
+         {168, small, [no_shared_fun_wrappers]},
+
+         {169, small_maps, []},
+         {169, big, []},
+         {169, small, []}
         ],
 
     Test = fun({Expected,Mod,Options}) ->
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index 98210a351c..a468482acb 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -79,6 +79,7 @@ opt_opts(Mod) ->
                      (no_put_tuple2) -> true;
                      (no_recv_opt) -> true;
                      (no_share_opt) -> true;
+                     (no_shared_fun_wrappers) -> true;
                      (no_ssa_float) -> true;
                      (no_ssa_opt) -> true;
                      (no_stack_trimming) -> true;
diff --git a/lib/tools/test/cprof_SUITE.erl b/lib/tools/test/cprof_SUITE.erl
index 9cbc27fb17..39239a66a9 100644
--- a/lib/tools/test/cprof_SUITE.erl
+++ b/lib/tools/test/cprof_SUITE.erl
@@ -211,16 +211,12 @@ on_load_test(Config) ->
     Lr = seq_r(1, M, fun succ/1),
     N2 = cprof:pause(),
     {Module,0,[]} = cprof:analyse(Module),
-    M_1 = M - 1,
     M4__4 = M*4 - 4,
     M10_7 = M*10 - 7,
     {?MODULE,M10_7,[{{?MODULE,succ,1},M4__4},
+                    {{?MODULE,'-fun.succ/1-',1},M4__4},
                     {{?MODULE,seq_r,4},M},
                     {{?MODULE,seq,3},M},
-                    {{?MODULE,'-on_load_test/1-fun-5-',1},M_1},
-                    {{?MODULE,'-on_load_test/1-fun-4-',1},M_1},
-                    {{?MODULE,'-on_load_test/1-fun-3-',1},M_1},
-                    {{?MODULE,'-on_load_test/1-fun-2-',1},M_1},
                     {{?MODULE,seq_r,3},1}]}
     = cprof:analyse(?MODULE),
     N2 = cprof:stop(),
@@ -246,18 +242,14 @@ modules_test(Config) ->
     Lr = seq_r(1, M, fun succ/1),
     N = cprof:pause(),
     Lr = lists:reverse(L),
-    M_1 = M - 1,
     M4_4 = M*4 - 4,
     M10_7 = M*10 - 7,
     M2__1 = M*2 + 1,
     {Tot,ModList} = cprof:analyse(),
     {value,{?MODULE,M10_7,[{{?MODULE,succ,1},M4_4},
+                           {{?MODULE,'-fun.succ/1-',1},M4_4},
                            {{?MODULE,seq_r,4},M},
                            {{?MODULE,seq,3},M},
-                           {{?MODULE,'-modules_test/1-fun-3-',1},M_1},
-                           {{?MODULE,'-modules_test/1-fun-2-',1},M_1},
-                           {{?MODULE,'-modules_test/1-fun-1-',1},M_1},
-                           {{?MODULE,'-modules_test/1-fun-0-',1},M_1},
                            {{?MODULE,seq_r,3},1}]}} =
       lists:keysearch(?MODULE, 1, ModList),
     {value,{Module,M2__1,[{{Module,seq_r,4},M},