aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--erts/emulator/beam/beam_load.c13
-rw-r--r--erts/emulator/beam/erl_printf_term.c7
-rw-r--r--erts/emulator/beam/ops.tab3
-rw-r--r--erts/emulator/test/beam_literals_SUITE.erl55
-rw-r--r--lib/compiler/src/cerl.erl2
-rw-r--r--lib/compiler/src/core_parse.yrl6
-rw-r--r--lib/compiler/src/core_pp.erl6
-rw-r--r--lib/compiler/src/erl_bifs.erl2
-rw-r--r--lib/compiler/src/sys_core_fold.erl5
-rw-r--r--lib/stdlib/src/erl_parse.yrl2
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
@@ -4521,6 +4521,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 77e375f2c0..6e03f39d97 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 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;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 06:50:20 +0000