aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler/src
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler/src')
-rw-r--r--lib/compiler/src/beam_clean.erl2
-rw-r--r--lib/compiler/src/cerl.erl2
-rw-r--r--lib/compiler/src/cerl_inline.erl17
-rw-r--r--lib/compiler/src/cerl_trees.erl109
-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.erl27
-rw-r--r--lib/compiler/src/v3_codegen.erl5
-rw-r--r--lib/compiler/src/v3_core.erl2
-rw-r--r--lib/compiler/src/v3_kernel.erl11
11 files changed, 171 insertions, 18 deletions
diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl
index 7ddf9fa2e2..955c128699 100644
--- a/lib/compiler/src/beam_clean.erl
+++ b/lib/compiler/src/beam_clean.erl
@@ -254,7 +254,7 @@ bs_restores([_|Is], Dict) ->
bs_restores([], Dict) -> Dict.
%% Pass 2.
-bs_replace([{test,bs_start_match2,F,Live,[Src,Ctx],CtxR}|T], Dict, Acc) when is_atom(Ctx) ->
+bs_replace([{test,bs_start_match2,F,Live,[Src,{context,Ctx}],CtxR}|T], Dict, Acc) ->
Slots = case gb_trees:lookup(Ctx, Dict) of
{value,Slots0} -> Slots0;
none -> 0
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/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index f5afa75b16..caff47dbcb 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -1822,6 +1822,14 @@ new_var(Env) ->
Name = env__new_vname(Env),
c_var(Name).
+%% The way a template variable is used makes it necessary
+%% to make sure that it is unique in the entire function.
+%% Therefore, template variables are atoms with the prefix "@i".
+
+new_template_var(Env) ->
+ Name = env__new_tname(Env),
+ c_var(Name).
+
residualize_var(R, S) ->
S1 = count_size(weight(var), S),
{ref_to_var(R), st__set_var_referenced(R#ref.loc, S1)}.
@@ -2183,7 +2191,7 @@ make_template(E, Vs0, Env0) ->
T = make_data_skel(data_type(E), Ts),
E1 = update_data(E, data_type(E),
[hd(get_ann(T)) || T <- Ts]),
- V = new_var(Env1),
+ V = new_template_var(Env1),
Env2 = env__bind(var_name(V), E1, Env1),
{set_ann(T, [V]), [V | Vs1], Env2};
false ->
@@ -2198,7 +2206,7 @@ make_template(E, Vs0, Env0) ->
Env2 = env__bind(V, E1, Env1),
{T, Vs1, Env2};
_ ->
- V = new_var(Env0),
+ V = new_template_var(Env0),
Env1 = env__bind(var_name(V), E, Env0),
{set_ann(V, [V]), [V | Vs0], Env1}
end
@@ -2564,6 +2572,11 @@ env__is_defined(Key, Env) ->
env__new_vname(Env) ->
rec_env:new_key(Env).
+env__new_tname(Env) ->
+ rec_env:new_key(fun(I) ->
+ list_to_atom("@i"++integer_to_list(I))
+ end, Env).
+
env__new_fname(A, N, Env) ->
rec_env:new_key(fun (X) ->
S = integer_to_list(X),
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index f30a0b33ac..c7a129b42c 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -22,7 +22,8 @@
-module(cerl_trees).
-export([depth/1, fold/3, free_variables/1, get_label/1, label/1, label/2,
- map/2, mapfold/3, mapfold/4, size/1, variables/1]).
+ map/2, mapfold/3, mapfold/4, next_free_variable_name/1,
+ size/1, variables/1]).
-import(cerl, [alias_pat/1, alias_var/1, ann_c_alias/3, ann_c_apply/3,
ann_c_binary/2, ann_c_bitstr/6, ann_c_call/4,
@@ -507,6 +508,7 @@ mapfold_pairs(_, _, S, []) ->
%% well-formed Core Erlang syntax tree.
%%
%% @see free_variables/1
+%% @see next_free_variable_name/1
-spec variables(cerl:cerl()) -> [cerl:var_name()].
@@ -519,6 +521,7 @@ variables(T) ->
%% @doc Like <code>variables/1</code>, but only includes variables
%% that are free in the tree.
%%
+%% @see next_free_variable_name/1
%% @see variables/1
-spec free_variables(cerl:cerl()) -> [cerl:var_name()].
@@ -678,6 +681,110 @@ var_list_names([V | Vs], A) ->
var_list_names([], A) ->
A.
+%% ---------------------------------------------------------------------
+
+%% @spec next_free_variable_name(Tree::cerl()) -> var_name()
+%%
+%% var_name() = integer()
+%%
+%% @doc Returns a integer variable name higher than any other integer
+%% variable name in the syntax tree. An exception is thrown if
+%% <code>Tree</code> does not represent a well-formed Core Erlang
+%% syntax tree.
+%%
+%% @see variables/1
+%% @see free_variables/1
+
+-spec next_free_variable_name(cerl:cerl()) -> integer().
+
+next_free_variable_name(T) ->
+ 1 + next_free(T, -1).
+
+next_free(T, Max) ->
+ case type(T) of
+ literal ->
+ Max;
+ var ->
+ case var_name(T) of
+ Int when is_integer(Int) ->
+ max(Int, Max);
+ _ ->
+ Max
+ end;
+ values ->
+ next_free_in_list(values_es(T), Max);
+ cons ->
+ next_free(cons_hd(T), next_free(cons_tl(T), Max));
+ tuple ->
+ next_free_in_list(tuple_es(T), Max);
+ map ->
+ next_free_in_list([map_arg(T)|map_es(T)], Max);
+ map_pair ->
+ next_free_in_list([map_pair_op(T),map_pair_key(T),
+ map_pair_val(T)], Max);
+ 'let' ->
+ Max1 = next_free(let_body(T), Max),
+ Max2 = next_free_in_list(let_vars(T), Max1),
+ next_free(let_arg(T), Max2);
+ seq ->
+ next_free(seq_arg(T),
+ next_free(seq_body(T), Max));
+ apply ->
+ next_free(apply_op(T),
+ next_free_in_list(apply_args(T), Max));
+ call ->
+ next_free(call_module(T),
+ next_free(call_name(T),
+ next_free_in_list(
+ call_args(T), Max)));
+ primop ->
+ next_free_in_list(primop_args(T), Max);
+ 'case' ->
+ next_free(case_arg(T),
+ next_free_in_list(case_clauses(T), Max));
+ clause ->
+ Max1 = next_free(clause_guard(T),
+ next_free(clause_body(T), Max)),
+ next_free_in_list(clause_pats(T), Max1);
+ alias ->
+ next_free(alias_var(T),
+ next_free(alias_pat(T), Max));
+ 'fun' ->
+ next_free(fun_body(T),
+ next_free_in_list(fun_vars(T), Max));
+ 'receive' ->
+ Max1 = next_free_in_list(receive_clauses(T),
+ next_free(receive_timeout(T), Max)),
+ next_free(receive_action(T), Max1);
+ 'try' ->
+ Max1 = next_free(try_body(T), Max),
+ Max2 = next_free_in_list(try_vars(T), Max1),
+ Max3 = next_free(try_handler(T), Max2),
+ Max4 = next_free_in_list(try_evars(T), Max3),
+ next_free(try_arg(T), Max4);
+ 'catch' ->
+ next_free(catch_body(T), Max);
+ binary ->
+ next_free_in_list(binary_segments(T), Max);
+ bitstr ->
+ next_free(bitstr_val(T), next_free(bitstr_size(T), Max));
+ letrec ->
+ Max1 = next_free_in_defs(letrec_defs(T), Max),
+ Max2 = next_free(letrec_body(T), Max1),
+ next_free_in_list(letrec_vars(T), Max2);
+ module ->
+ next_free_in_defs(module_defs(T), Max)
+ end.
+
+next_free_in_list([H | T], Max) ->
+ next_free_in_list(T, next_free(H, Max));
+next_free_in_list([], Max) ->
+ Max.
+
+next_free_in_defs([{_, Post} | Ds], Max) ->
+ next_free_in_defs(Ds, next_free(Post, Max));
+next_free_in_defs([], Max) ->
+ Max.
%% ---------------------------------------------------------------------
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 a9bd363ee1..bb3a9c7628 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -108,17 +108,29 @@
module(#c_module{defs=Ds0}=Mod, Opts) ->
put(no_inline_list_funcs, not member(inline_list_funcs, Opts)),
- case get(new_var_num) of
- undefined -> put(new_var_num, 0);
- _ -> ok
- end,
init_warnings(),
Ds1 = [function_1(D) || D <- Ds0],
+ erase(new_var_num),
erase(no_inline_list_funcs),
{ok,Mod#c_module{defs=Ds1},get_warnings()}.
function_1({#c_var{name={F,Arity}}=Name,B0}) ->
+ %% Find a suitable starting value for the variable counter. Note
+ %% that this pass assumes that new_var_name/1 returns a variable
+ %% name distinct from any variable used in the entire body of
+ %% the function. We use integers as variable names to avoid
+ %% filling up the atom table when compiling huge functions.
+ Count = cerl_trees:next_free_variable_name(B0),
+ put(new_var_num, Count),
try
+ %% Find a suitable starting value for the variable
+ %% counter. Note that this pass assumes that new_var_name/1
+ %% returns a variable name distinct from any variable used in
+ %% the entire body of the function. We use integers as
+ %% variable names to avoid filling up the atom table when
+ %% compiling huge functions.
+ Count = cerl_trees:next_free_variable_name(B0),
+ put(new_var_num, Count),
B = find_fixpoint(fun(Core) ->
%% This must be a fun!
expr(Core, value, sub_new())
@@ -392,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 ->
@@ -487,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.
@@ -2154,7 +2169,7 @@ make_var(A) ->
make_var_name() ->
N = get(new_var_num),
put(new_var_num, N+1),
- list_to_atom("@f"++integer_to_list(N)).
+ N.
letify(Bs, Body) ->
Ann = cerl:get_ann(Body),
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index a8f4926e55..8808c0a3b7 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -1162,7 +1162,7 @@ select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=V}},body=B,
{Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0#cg{ctx=V}),
CtxReg = fetch_var(V, Int0),
Live = max_reg(Bef#sr.reg),
- Bis1 = [{test,bs_start_match2,{f,Tf},Live,[CtxReg,V],CtxReg},
+ Bis1 = [{test,bs_start_match2,{f,Tf},Live,[CtxReg,{context,V}],CtxReg},
{bs_save2,CtxReg,{V,V}}|Bis0],
Bis = finish_select_binary(Bis1),
{Bis,Aft,St1#cg{ctx=OldCtx}};
@@ -1174,7 +1174,8 @@ select_binary(#k_val_clause{val=#k_binary{segs=#k_var{name=Ivar}},body=B,
{Bis0,Aft,St1} = match_cg(B, Vf, Int0, St0#cg{ctx=Ivar}),
CtxReg = fetch_var(Ivar, Int0),
Live = max_reg(Bef#sr.reg),
- Bis1 = [{test,bs_start_match2,{f,Tf},Live,[fetch_var(V, Bef),Ivar],CtxReg},
+ Bis1 = [{test,bs_start_match2,{f,Tf},Live,
+ [fetch_var(V, Bef),{context,Ivar}],CtxReg},
{bs_save2,CtxReg,{Ivar,Ivar}}|Bis0],
Bis = finish_select_binary(Bis1),
{Bis,Aft,St1#cg{ctx=OldCtx}}.
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 8cf8c69fef..4799105d05 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -2005,7 +2005,7 @@ new_fun_name(Type, #core{fcount=C}=St) ->
%% new_var_name(State) -> {VarName,State}.
new_var_name(#core{vcount=C}=St) ->
- {list_to_atom("@c" ++ integer_to_list(C)),St#core{vcount=C + 1}}.
+ {C,St#core{vcount=C + 1}}.
%% new_var(State) -> {{var,Name},State}.
%% new_var(LineAnno, State) -> {{var,Name},State}.
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index dfe8d26afb..4e3ceedbc0 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -157,7 +157,13 @@ include_attribute(_) -> true.
function({#c_var{name={F,Arity}=FA},Body}, St0) ->
%%io:format("~w/~w~n", [F,Arity]),
try
- St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=cerl_sets:new()},
+ %% Find a suitable starting value for the variable counter. Note
+ %% that this pass assumes that new_var_name/1 returns a variable
+ %% name distinct from any variable used in the entire body of
+ %% the function. We use integers as variable names to avoid
+ %% filling up the atom table when compiling huge functions.
+ Count = cerl_trees:next_free_variable_name(Body),
+ St1 = St0#kern{func=FA,ff=undefined,vcount=Count,fcount=0,ds=cerl_sets:new()},
{#ifun{anno=Ab,vars=Kvs,body=B0},[],St2} = expr(Body, new_sub(), St1),
{B1,_,St3} = ubody(B0, return, St2),
%%B1 = B0, St3 = St2, %Null second pass
@@ -168,7 +174,6 @@ function({#c_var{name={F,Arity}=FA},Body}, St0) ->
erlang:raise(Class, Error, Stack)
end.
-
%% body(Cexpr, Sub, State) -> {Kexpr,[PreKepxr],State}.
%% Do the main sequence of a body. A body ends in an atomic value or
%% values. Must check if vector first so do expr.
@@ -1356,7 +1361,7 @@ new_fun_name(Type, #kern{func={F,Arity},fcount=C}=St) ->
%% new_var_name(State) -> {VarName,State}.
new_var_name(#kern{vcount=C}=St) ->
- {list_to_atom("@k" ++ integer_to_list(C)),St#kern{vcount=C+1}}.
+ {C,St#kern{vcount=C+1}}.
%% new_var(State) -> {#k_var{},State}.
generated by cgit v1.2.3 (git 2.25.1) at 2025-05-04 21:54:34 +0000