Merge pull request #1499 from josevalim/jv-tuple-calls

Make tuple calls opt-in

OTP-14497

2 files changed, 76 insertions, 4 deletions

diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index ae650546e5..20cb3343fb 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -2505,8 +2505,46 @@ cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0,
     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) ->
-    {#c_call{anno=A#a.anno,module=Mod,name=Name,args=Args},[],A#a.us,St};
+cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St0) ->
+    Anno = A#a.anno,
+    case (not cerl:is_c_atom(Mod)) andalso member(tuple_calls, St0#core.opts) of
+	true ->
+	    GenAnno = [compiler_generated|Anno],
+
+	    %% Generate the clause that matches on the tuple
+	    {TupleVar,St1} = new_var(GenAnno, St0),
+	    {TupleSizeVar, St2} = new_var(GenAnno, St1),
+	    {TupleModVar, St3} = new_var(GenAnno, St2),
+	    {TupleArgsVar, St4} = new_var(GenAnno, St3),
+	    TryVar = cerl:c_var('Try'),
+
+	    TupleGuardExpr =
+		cerl:c_let([TupleSizeVar],
+			   c_call_erl(tuple_size, [TupleVar]),
+			   c_call_erl('>', [TupleSizeVar, cerl:c_int(0)])),
+
+	    TupleGuard =
+		cerl:c_try(TupleGuardExpr, [TryVar], TryVar,
+			   [cerl:c_var('T'),cerl:c_var('R')], cerl:c_atom(false)),
+
+	    TupleApply =
+		cerl:c_let([TupleModVar],
+			   c_call_erl(element, [cerl:c_int(1),TupleVar]),
+			   cerl:c_let([TupleArgsVar],
+				      cerl:make_list(Args ++ [TupleVar]),
+				      c_call_erl(apply, [TupleModVar,Name,TupleArgsVar]))),
+
+	    TupleClause = cerl:ann_c_clause(GenAnno, [TupleVar], TupleGuard, TupleApply),
+
+	    %% Generate the fallback clause
+	    {OtherVar,St5} = new_var(GenAnno, St4),
+	    OtherApply = cerl:ann_c_call(GenAnno, OtherVar, Name, Args),
+	    OtherClause = cerl:ann_c_clause(GenAnno, [OtherVar], OtherApply),
+
+	    {cerl:ann_c_case(GenAnno, Mod, [TupleClause,OtherClause]),[],A#a.us,St5};
+	false ->
+	    {#c_call{anno=Anno,module=Mod,name=Name,args=Args},[],A#a.us,St0}
+    end;
 cexpr(#iprimop{anno=A,name=Name,args=Args}, _As, St) ->
     {#c_primop{anno=A#a.anno,name=Name,args=Args},[],A#a.us,St};
 cexpr(#iprotect{anno=A,body=Es}, _As, St0) ->
@@ -2536,6 +2574,9 @@ cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) ->
                          clauses=Ccs ++ [Cfc]}},
      [],A#a.us,St2}.
 
+c_call_erl(Fun, Args) ->
+    cerl:c_call(cerl:c_atom(erlang), cerl:c_atom(Fun), Args).
+
 %% lit_vars(Literal) -> [Var].
 
 lit_vars(Lit) -> lit_vars(Lit, []).
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index f647a4030d..aaa2005e73 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -32,7 +32,7 @@
 	 binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1,
 	 other_output/1, kernel_listing/1, encrypted_abstr/1,
 	 strict_record/1, utf8_atoms/1, utf8_functions/1, extra_chunks/1,
-	 cover/1, env/1, core_pp/1,
+	 cover/1, env/1, core_pp/1, tuple_calls/1,
 	 core_roundtrip/1, asm/1, optimized_guards/1,
 	 sys_pre_attributes/1, dialyzer/1,
 	 warnings/1, pre_load_check/1, env_compiler_options/1,
@@ -49,7 +49,7 @@ all() ->
     test_lib:recompile(?MODULE),
     [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir,
      binary, makedep, cond_and_ifdef, listings, listings_big,
-     other_output, kernel_listing, encrypted_abstr,
+     other_output, kernel_listing, encrypted_abstr, tuple_calls,
      strict_record, utf8_atoms, utf8_functions, extra_chunks,
      cover, env, core_pp, core_roundtrip, asm, optimized_guards,
      sys_pre_attributes, dialyzer, warnings, pre_load_check,
@@ -781,6 +781,37 @@ extra_chunks(Config) when is_list(Config) ->
     {ok,{extra_chunks,[{"ExCh",<<"Contents">>}]}} =
 	beam_lib:chunks(ExtraChunksBinary, ["ExCh"]).
 
+tuple_calls(Config) when is_list(Config) ->
+    Anno = erl_anno:new(1),
+    Forms = [{attribute,Anno,export,[{size,1},{store,1}]},
+	     {function,Anno,size,1,
+	      [{clause,Anno,[{var,[],mod}],[],
+	       [{call,[],{remote,[],{var,[],mod},{atom,[],size}},[]}]}]},
+	     {function,Anno,store,1,
+	      [{clause,Anno,[{var,[],mod}],[],
+	       [{call,[],{remote,[],{var,[],mod},{atom,[],store}},[{atom,[],key},{atom,[],value}]}]}]}],
+
+    TupleCallsFalse = [{attribute,Anno,module,tuple_calls_false}|Forms],
+    {ok,_,TupleCallsFalseBinary} = compile:forms(TupleCallsFalse, [binary]),
+    code:load_binary(tuple_calls_false, "compile_SUITE.erl", TupleCallsFalseBinary),
+    {'EXIT',{badarg,_}} = (catch tuple_calls_false:store(dict())),
+    {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(dict())),
+    {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(empty_tuple())),
+
+    TupleCallsTrue = [{attribute,Anno,module,tuple_calls_true}|Forms],
+    {ok,_,TupleCallsTrueBinary} = compile:forms(TupleCallsTrue, [binary,tuple_calls]),
+    code:load_binary(tuple_calls_true, "compile_SUITE.erl", TupleCallsTrueBinary),
+    Dict = tuple_calls_true:store(dict()),
+    1 = tuple_calls_true:size(Dict),
+    {'EXIT',{badarg,_}} = (catch tuple_calls_true:size(empty_tuple())),
+
+    ok.
+
+dict() ->
+    dict:new().
+empty_tuple() ->
+    {}.
+
 env(Config) when is_list(Config) ->
     {Simple,Target} = get_files(Config, simple, env),
     {ok,Cwd} = file:get_cwd(),