diff options
Diffstat (limited to 'lib/compiler/src/cerl_inline.erl')
| -rw-r--r-- | lib/compiler/src/cerl_inline.erl | 2717 |
1 files changed, 2717 insertions, 0 deletions
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl new file mode 100644 index 0000000000..191efa3032 --- /dev/null +++ b/lib/compiler/src/cerl_inline.erl @@ -0,0 +1,2717 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% Core Erlang inliner. + +%% ===================================================================== +%% +%% This is an implementation of the algorithm by Waddell and Dybvig +%% ("Fast and Effective Procedure Inlining", International Static +%% Analysis Symposium 1997), adapted to the Core Erlang language. +%% +%% Instead of always renaming variables and function variables, this +%% implementation uses the "no-shadowing strategy" of Peyton Jones and +%% Marlow ("Secrets of the Glasgow Haskell Compiler Inliner", 1999). +%% +%% ===================================================================== + +%% TODO: inline single-source-reference operands without size limit. + +-module(cerl_inline). + +-export([core_transform/2, transform/1, transform/2]). + +-import(cerl, [abstract/1, alias_pat/1, alias_var/1, apply_args/1, + apply_op/1, atom_name/1, atom_val/1, bitstr_val/1, + bitstr_size/1, bitstr_unit/1, bitstr_type/1, + bitstr_flags/1, binary_segments/1, update_c_alias/3, + update_c_apply/3, update_c_binary/2, update_c_bitstr/6, + update_c_call/4, update_c_case/3, update_c_catch/2, + update_c_clause/4, c_fun/2, c_int/1, c_let/3, + update_c_let/4, update_c_letrec/3, update_c_module/5, + update_c_primop/3, update_c_receive/4, update_c_seq/3, + c_seq/2, update_c_try/6, c_tuple/1, update_c_values/2, + c_values/1, c_var/1, call_args/1, call_module/1, + call_name/1, case_arity/1, case_arg/1, case_clauses/1, + catch_body/1, clause_body/1, clause_guard/1, + clause_pats/1, clause_vars/1, concrete/1, cons_hd/1, + cons_tl/1, data_arity/1, data_es/1, data_type/1, + fun_body/1, fun_vars/1, get_ann/1, int_val/1, + is_c_atom/1, is_c_cons/1, is_c_fun/1, is_c_int/1, + is_c_list/1, is_c_seq/1, is_c_tuple/1, is_c_var/1, + is_data/1, is_literal/1, is_literal_term/1, let_arg/1, + let_body/1, let_vars/1, letrec_body/1, letrec_defs/1, + list_length/1, list_elements/1, update_data/3, + make_list/1, make_data_skel/2, module_attrs/1, + module_defs/1, module_exports/1, module_name/1, + primop_args/1, primop_name/1, receive_action/1, + receive_clauses/1, receive_timeout/1, seq_arg/1, + seq_body/1, set_ann/2, try_arg/1, try_body/1, try_vars/1, + try_evars/1, try_handler/1, tuple_es/1, tuple_arity/1, + type/1, values_es/1, var_name/1]). + +-import(erlang, [max/2]). +-import(lists, [foldl/3, foldr/3, mapfoldl/3, reverse/1]). + +%% +%% Constants +%% + +debug_runtime() -> false. +debug_counters() -> false. + +%% Normal execution times for inlining are between 0.1 and 0.3 seconds +%% (on the author's current equipment). The default effort limit of 150 +%% is high enough that most normal programs never hit the limit even +%% once, and for difficult programs, it generally keeps the execution +%% times below 2-5 seconds. Using an effort counter of 1000 will thus +%% have no further effect on most programs, but some programs may take +%% as much as 10 seconds or more. Effort counts larger than 2500 have +%% never been observed even on very ill-conditioned programs. +%% +%% Size limits between 6 and 18 tend to actually shrink the code, +%% because of the simplifications made possible by inlining. A limit of +%% 16 seems to be optimal for this purpose, often shrinking the +%% executable code by up to 10%. Size limits between 18 and 30 generally +%% give the same code size as if no inlining was done (i.e., code +%% duplication balances out the simplifications at these levels). A size +%% limit between 1 and 5 tends to inline small functions and propagate +%% constants, but does not cause much simplifications do be done, so the +%% net effect will be a slight increase in code size. For size limits +%% above 30, the executable code size tends to increase with about 10% +%% per 100 units, with some variations depending on the sizes of +%% functions in the source code. +%% +%% Typically, about 90% of the maximum speedup achievable is already +%% reached using a size limit of 30, and 98% is reached at limits around +%% 100-150; there is rarely any point in letting the code size increase +%% by more than 10-15%. If too large functions are inlined, cache +%% effects will slow the program down. + +default_effort() -> 150. +default_size() -> 24. +default_unroll() -> 1. + +%% Base costs/weights for different kinds of expressions. If these are +%% modified, the size limits above may have to be adjusted. + +weight(var) -> 0; % We count no cost for variable accesses. +weight(values) -> 0; % Value aggregates have no cost in themselves. +weight(literal) -> 1; % We assume efficient handling of constants. +weight(data) -> 1; % Base cost; add 1 per element. +weight(element) -> 1; % Cost of storing/fetching an element. +weight(argument) -> 1; % Cost of passing a function argument. +weight('fun') -> 6; % Base cost + average number of free vars. +weight('let') -> 0; % Count no cost for let-bindings. +weight(letrec) -> 0; % Like a let-binding. +weight('case') -> 0; % Case switches have no base cost. +weight(clause) -> 1; % Count one jump at the end of each clause body. +weight('receive') -> 9; % Initialization/cleanup cost. +weight('try') -> 1; % Assume efficient implementation. +weight('catch') -> 1; % See `try'. +weight(apply) -> 3; % Average base cost: call/return. +weight(call) -> 3; % Assume remote-calls as efficient as `apply'. +weight(primop) -> 2; % Assume more efficient than `apply'. +weight(binary) -> 4; % Initialisation base cost. +weight(bitstr) -> 3; % Coding/decoding a value; like a primop. +weight(module) -> 1. % Like a letrec with a constant body + +%% These "reference" structures are used for variables and function +%% variables. They keep track of the variable name, any bound operand, +%% and the associated store location. + +-record(ref, {name, opnd, loc}). + +%% Operand structures contain the operand expression, the renaming and +%% environment, the state location, and the effort counter at the call +%% site (cf. `visit'). + +-record(opnd, {expr, ren, env, loc, effort}). + +%% Since expressions are only visited in `effect' context when they are +%% not bound to a referenced variable, only expressions visited in +%% 'value' context are cached. + +-record(cache, {expr, size}). + +%% The context flags for an application structure are kept separate from +%% the structure itself. Note that the original algorithm had exactly +%% one operand in each application context structure, while we can have +%% several, or none. + +-record(app, {opnds, ctxt, loc}). + + +%% +%% Interface functions +%% + +%% Use compile option `{core_transform, inline}' to insert this as a +%% compilation pass. + +-spec core_transform(cerl:cerl(), [compile:option()]) -> cerl:cerl(). + +core_transform(Code, Opts) -> + cerl:to_records(transform(cerl:from_records(Code), Opts)). + +-spec transform(cerl:cerl()) -> cerl:cerl(). + +transform(Tree) -> + transform(Tree, []). + +-spec transform(cerl:cerl(), [compile:option()]) -> cerl:cerl(). + +transform(Tree, Opts) -> + main(Tree, value, Opts). + +main(Tree, Ctxt, Opts) -> + %% We spawn a new process to do the work, so we don't have to worry + %% about cluttering the process dictionary with debugging info, or + %% proper deallocation of ets-tables. + Opts1 = Opts ++ [{inline_size, default_size()}, + {inline_effort, default_effort()}, + {inline_unroll, default_unroll()}], + Reply = self(), + Pid = spawn_link(fun () -> start(Reply, Tree, Ctxt, Opts1) end), + receive + {Pid, Tree1} -> Tree1 + end. + +start(Reply, Tree, Ctxt, Opts) -> + init_debug(), + case debug_runtime() of + %% true -> + %% put(inline_start_time, + %% element(1, erlang:statistics(runtime))); + false -> + ok + end, + Size = max(1, proplists:get_value(inline_size, Opts)), + Effort = max(1, proplists:get_value(inline_effort, Opts)), + Unroll = max(1, proplists:get_value(inline_unroll, Opts)), + case proplists:get_bool(verbose, Opts) of + true -> + io:fwrite("Inlining: inline_size=~w inline_effort=~w\n", + [Size, Effort]); + false -> + ok + end, + + %% Note that the counters of the new state are passive. + S = st__new(Effort, Size, Unroll), + +%%% Initialization is not needed at present. Note that the code in +%%% `inline_init' is not up-to-date with this module. +%%% {Tree1, S1} = inline_init:init(Tree, S), +%%% {Tree2, _S2} = i(Tree1, Ctxt, S1), + {Tree2, _S2} = i(Tree, Ctxt, S), + report_debug(), + Reply ! {self(), Tree2}. + +init_debug() -> + case debug_counters() of + %% true -> + %% put(counter_effort_triggers, 0), + %% put(counter_effort_max, 0), + %% put(counter_size_triggers, 0), + %% put(counter_size_max, 0); + false -> + ok + end. + +report_debug() -> + case debug_runtime() of + %% true -> + %% {Time, _} = erlang:statistics(runtime), + %% report("Total run time for inlining: ~.2.0f s.\n", + %% [(Time - get(inline_start_time))/1000]); + false -> + ok + end, + case debug_counters() of + %% true -> + %% counter_stats(); + false -> + ok + end. + +%% counter_stats() -> +%% T1 = get(counter_effort_triggers), +%% T2 = get(counter_size_triggers), +%% E = get(counter_effort_max), +%% S = get(counter_size_max), +%% M1 = io_lib:fwrite("\tNumber of triggered " +%% "effort counters: ~p.\n", [T1]), +%% M2 = io_lib:fwrite("\tNumber of triggered " +%% "size counters: ~p.\n", [T2]), +%% M3 = io_lib:fwrite("\tLargest active effort counter: ~p.\n", +%% [E]), +%% M4 = io_lib:fwrite("\tLargest active size counter: ~p.\n", +%% [S]), +%% report("Counter statistics:\n~s", [[M1, M2, M3, M4]]). + + +%% ===================================================================== +%% The main inlining function +%% +%% i(E :: coreErlang(), +%% Ctxt :: value | effect | #app{} +%% Ren :: renaming(), +%% Env :: environment(), +%% S :: state()) +%% -> {E', S'} +%% +%% Note: It is expected that the input source code ('E') does not +%% contain free variables. If it does, there is a risk of accidental +%% name capture, in case a generated "new" variable name happens to be +%% the same as the name of a variable that is free further below in the +%% tree; the algorithm only consults the current environment to check if +%% a name already exists. +%% +%% The renaming maps names of source-code variable and function +%% variables to new names as necessary to avoid clashes, according to +%% the "no-shadowing" strategy. The environment maps *residual-code* +%% variables and function variables to operands and global information. +%% Separating the renaming from the environment, and using the +%% residual-code variables instead of the source-code variables as its +%% domain, improves the behaviour of the algorithm when code needs to be +%% traversed more than once. +%% +%% Note that there is no such thing as a `test' context for expressions +%% in (Core) Erlang (see `i_case' below for details). + +i(E, Ctxt, S) -> + i(E, Ctxt, ren__identity(), env__empty(), S). + +i(E, Ctxt, Ren, Env, S0) -> + %% Count one unit of effort on each pass. + S = count_effort(1, S0), + case is_data(E) of + true -> + i_data(E, Ctxt, Ren, Env, S); + false -> + case type(E) of + var -> + i_var(E, Ctxt, Ren, Env, S); + values -> + i_values(E, Ctxt, Ren, Env, S); + 'fun' -> + i_fun(E, Ctxt, Ren, Env, S); + seq -> + i_seq(E, Ctxt, Ren, Env, S); + 'let' -> + i_let(E, Ctxt, Ren, Env, S); + letrec -> + i_letrec(E, Ctxt, Ren, Env, S); + 'case' -> + i_case(E, Ctxt, Ren, Env, S); + 'receive' -> + i_receive(E, Ctxt, Ren, Env, S); + apply -> + i_apply(E, Ctxt, Ren, Env, S); + call -> + i_call(E, Ctxt, Ren, Env, S); + primop -> + i_primop(E, Ren, Env, S); + 'try' -> + i_try(E, Ctxt, Ren, Env, S); + 'catch' -> + i_catch(E, Ctxt, Ren, Env, S); + binary -> + i_binary(E, Ren, Env, S); + module -> + i_module(E, Ctxt, Ren, Env, S) + end + end. + +i_data(E, Ctxt, Ren, Env, S) -> + case is_literal(E) of + true -> + %% This is the `(const c)' case of the original algorithm: + %% literal terms which (regardless of size) do not need to + %% be constructed dynamically at runtime - boldly assuming + %% that the compiler/runtime system can handle this. + case Ctxt of + effect -> + %% Reduce useless constants to a simple value. + {void(), count_size(weight(literal), S)}; + _ -> + %% (In Erlang, we cannot set all non-`false' + %% constants to `true' in a `test' context, like we + %% could do in Lisp or C, so the above is the only + %% special case to be handled here.) + {E, count_size(weight(literal), S)} + end; + false -> + %% Data constructors are like to calls to safe built-in + %% functions, for which we can "decide to inline" + %% immediately; there is no need to create operand + %% structures. In `effect' context, we can simply make a + %% sequence of the argument expressions, also visited in + %% `effect' context. In all other cases, the arguments are + %% visited for value. + case Ctxt of + effect -> + %% Note that this will count the sizes of the + %% subexpressions, even though some or all of them + %% might be discarded by the sequencing afterwards. + {Es1, S1} = mapfoldl(fun (E, S) -> + i(E, effect, Ren, Env, + S) + end, + S, data_es(E)), + E1 = foldl(fun (E1, E2) -> make_seq(E1, E2) end, + void(), Es1), + {E1, S1}; + _ -> + {Es1, S1} = mapfoldl(fun (E, S) -> + i(E, value, Ren, Env, + S) + end, + S, data_es(E)), + %% The total size/cost is the base cost for a data + %% constructor plus the cost for storing each + %% element. + N = weight(data) + length(Es1) * weight(element), + S2 = count_size(N, S1), + {update_data(E, data_type(E), Es1), S2} + end + end. + +%% This is the `(ref x)' (variable use) case of the original algorithm. +%% Note that binding occurrences are always handled in the respective +%% cases of the binding constructs. + +i_var(E, Ctxt, Ren, Env, S) -> + case Ctxt of + effect -> + %% Reduce useless variable references to a simple constant. + %% This also avoids useless visiting of bound operands. + {void(), count_size(weight(literal), S)}; + _ -> + Name = var_name(E), + case env__lookup(ren__map(Name, Ren), Env) of + {ok, R} -> + case R#ref.opnd of + undefined -> + %% The variable is not associated with an + %% argument expression; just residualize it. + residualize_var(R, S); + Opnd -> + i_var_1(R, Opnd, Ctxt, Env, S) + end; + error -> + %% The variable is unbound. (It has not been + %% accidentally captured, however, or it would have + %% been in the environment.) We leave it as it is, + %% without any warning. + {E, count_size(weight(var), S)} + end + end. + +%% This first visits the bound operand and then does copy propagation. +%% Note that we must first set the "inner-pending" flag, and clear the +%% flag afterwards. + +i_var_1(R, Opnd, Ctxt, Env, S) -> + %% If the operand is already "inner-pending", it is residualised. + %% (In Lisp/C, if the variable might be assigned to, it should also + %% be residualised.) + L = Opnd#opnd.loc, + case st__test_inner_pending(L, S) of + true -> + residualize_var(R, S); + false -> + S1 = st__mark_inner_pending(L, S), + case catch {ok, visit(Opnd, S1)} of + {ok, {E, S2}} -> + %% Note that we pass the current environment and + %% context to `copy', but not the current renaming. + S3 = st__clear_inner_pending(L, S2), + copy(R, Opnd, E, Ctxt, Env, S3); + {'EXIT', X} -> + exit(X); + X -> + %% If we use destructive update for the + %% `inner-pending' flag, we must make sure to clear + %% it also if we make a nonlocal return. + _S2 = st__clear_inner_pending(Opnd#opnd.loc, S1), + throw(X) + end + end. + +%% A multiple-value aggregate `<e1, ..., en>'. This is very much like a +%% tuple data constructor `{e1, ..., en}'; cf. `i_data' for details. + +i_values(E, Ctxt, Ren, Env, S) -> + case values_es(E) of + [E1] -> + %% Single-value aggregates can be dropped; they are simply + %% notation. + i(E1, Ctxt, Ren, Env, S); + Es -> + %% In `effect' context, we can simply make a sequence of the + %% argument expressions, also visited in `effect' context. + %% In all other cases, the arguments are visited for value. + case Ctxt of + effect -> + {Es1, S1} = + mapfoldl(fun (E, S) -> + i(E, effect, Ren, Env, S) + end, + S, Es), + E1 = foldl(fun (E1, E2) -> + make_seq(E1, E2) + end, + void(), Es1), + {E1, S1}; % drop annotations on E + _ -> + {Es1, S1} = mapfoldl(fun (E, S) -> + i(E, value, Ren, Env, + S) + end, + S, Es), + %% Aggregating values does not write them to memory, + %% so we count no extra cost per element. + S2 = count_size(weight(values), S1), + {update_c_values(E, Es1), S2} + end + end. + +%% A let-expression `let <v1,...,vn> = e0 in e1' is semantically +%% equivalent to a case-expression `case e0 of <v1,...,vn> when 'true' +%% -> e1 end'. As a special case, `let <v> = e0 in e1' is also +%% equivalent to `apply fun (v) -> e0 (e1)'. However, for efficiency, +%% and in order to allow the handling of `case' clauses to introduce new +%% let-expressions without entering an infinite rewrite loop, we handle +%% these directly. + +%%% %% Rewriting a `let' to an equivalent expression. +%%% i_let(E, Ctxt, Ren, Env, S) -> +%%% case let_vars(E) of +%%% [V] -> +%%% E1 = update_c_apply(E, c_fun([V], let_body(E)), [let_arg(E)]), +%%% i(E1, Ctxt, Ren, Env, S); +%%% Vs -> +%%% C = c_clause(Vs, abstract(true), let_body(E)), +%%% E1 = update_c_case(E, let_arg(E), [C]), +%%% i(E1, Ctxt, Ren, Env, S) +%%% end. + +i_let(E, Ctxt, Ren, Env, S) -> + case let_vars(E) of + [V] -> + i_let_1(V, E, Ctxt, Ren, Env, S); + Vs -> + %% Visit the argument expression in `value' context, to + %% simplify it as far as possible. + {A, S1} = i(let_arg(E), value, Ren, Env, S), + case get_components(length(Vs), result(A)) of + {true, As} -> + %% Note that only the components of the result of + %% `A' are passed on; any effects are hoisted. + {E1, S2} = i_let_2(Vs, As, E, Ctxt, Ren, Env, S1), + {hoist_effects(A, E1), S2}; + false -> + %% We cannot do anything with this `let', since the + %% variables cannot be matched against the argument + %% components. Just visit the variables for renaming + %% and visit the body for value (cf. `i_fun'). + {_, Ren1, Env1, S2} = bind_locals(Vs, Ren, Env, S1), + Vs1 = i_params(Vs, Ren1, Env1), + %% The body is always visited for value here. + {B, S3} = i(let_body(E), value, Ren1, Env1, S2), + S4 = count_size(weight('let'), S3), + {update_c_let(E, Vs1, A, B), S4} + end + end. + +%% Single-variable `let' binding. + +i_let_1(V, E, Ctxt, Ren, Env, S) -> + %% Make an operand structure for the argument expression, create a + %% local binding from the parameter to the operand structure, and + %% visit the body. Finally create necessary bindings and/or set + %% flags. + {Opnd, S1} = make_opnd(let_arg(E), Ren, Env, S), + {[R], Ren1, Env1, S2} = bind_locals([V], [Opnd], Ren, Env, S1), + {E1, S3} = i(let_body(E), Ctxt, Ren1, Env1, S2), + i_let_3([R], [Opnd], E1, S3). + +%% Multi-variable `let' binding. + +i_let_2(Vs, As, E, Ctxt, Ren, Env, S) -> + %% Make operand structures for the argument components. Note that + %% since the argument has already been visited at this point, we use + %% the identity renaming for the operands. + {Opnds, S1} = mapfoldl(fun (E, S) -> + make_opnd(E, ren__identity(), Env, S) + end, + S, As), + %% Create local bindings from the parameters to their respective + %% operand structures, and visit the body. + {Rs, Ren1, Env1, S2} = bind_locals(Vs, Opnds, Ren, Env, S1), + {E1, S3} = i(let_body(E), Ctxt, Ren1, Env1, S2), + i_let_3(Rs, Opnds, E1, S3). + +i_let_3(Rs, Opnds, E, S) -> + %% Create necessary bindings and/or set flags. + {E1, S1} = make_let_bindings(Rs, E, S), + + %% We must also create evaluation for effect, for any unused + %% operands, as after an application expression. + residualize_operands(Opnds, E1, S1). + +%% A sequence `do e1 e2', written `(seq e1 e2)' in the original +%% algorithm, where `e1' is evaluated for effect only (since its value +%% is not used), and `e2' yields the final value. Note that we use +%% `make_seq' to recompose the sequence after visiting the parts. + +i_seq(E, Ctxt, Ren, Env, S) -> + {E1, S1} = i(seq_arg(E), effect, Ren, Env, S), + {E2, S2} = i(seq_body(E), Ctxt, Ren, Env, S1), + %% A sequence has no cost in itself. + {make_seq(E1, E2), S2}. + + +%% The `case' switch of Core Erlang is rather different from the boolean +%% `(if e1 e2 e3)' case of the original algorithm, but the central idea +%% is the same: if, given the simplified switch expression (which is +%% visited in `value' context - a boolean `test' context would not be +%% generally useful), there is a clause which could definitely be +%% selected, such that no clause before it can possibly be selected, +%% then we can eliminate all other clauses. (And even if this is not the +%% case, some clauses can often be eliminated.) Furthermore, if a clause +%% can be selected, we can replace the case-expression (including the +%% switch expression) with the body of the clause and a set of zero or +%% more let-bindings of subexpressions of the switch expression. (In the +%% simplest case, the switch expression is evaluated only for effect.) + +i_case(E, Ctxt, Ren, Env, S) -> + %% First visit the switch expression in `value' context, to simplify + %% it as far as possible. Note that only the result part is passed + %% on to the clause matching below; any effects are hoisted. + {A, S1} = i(case_arg(E), value, Ren, Env, S), + A1 = result(A), + + %% Propagating an application context into the branches could cause + %% the arguments of the application to be evaluated *after* the + %% switch expression, but *before* the body of the selected clause. + %% Such interleaving is not allowed in general, and it does not seem + %% worthwile to make a more powerful transformation here. Therefore, + %% the clause bodies are conservatively visited for value if the + %% context is `application'. + Ctxt1 = safe_context(Ctxt), + {E1, S2} = case get_components(case_arity(E), A1) of + {true, As} -> + i_case_1(As, E, Ctxt1, Ren, Env, S1); + false -> + i_case_1([], E, Ctxt1, Ren, Env, S1) + end, + {hoist_effects(A, E1), S2}. + +i_case_1(As, E, Ctxt, Ren, Env, S) -> + case i_clauses(As, case_clauses(E), Ctxt, Ren, Env, S) of + {false, {As1, Vs, Env1, Cs}, S1} -> + %% We still have a list of clauses. Sanity check: + if Cs =:= [] -> + report_warning("empty list of clauses " + "in residual program!.\n"); + true -> + ok + end, + {A, S2} = i(c_values(As1), value, ren__identity(), Env1, + S1), + {E1, S3} = i_case_2(Cs, A, E, S2), + i_case_3(Vs, Env1, E1, S3); + {true, {_, Vs, Env1, [C]}, S1} -> + %% A single clause was selected; we just take the body. + i_case_3(Vs, Env1, clause_body(C), S1) + end. + +%% Check if all clause bodies are actually equivalent expressions that +%% do not depent on pattern variables (this sometimes occurs as a +%% consequence of inlining, e.g., all branches might yield 'true'), and +%% if so, replace the `case' with a sequence, first evaluating the +%% clause selection for effect, then evaluating one of the clause bodies +%% for its value. (Unless the switch contains a catch-all clause, the +%% clause selection must be evaluated for effect, since there is no +%% guarantee that any of the clauses will actually match. Assuming that +%% some clause always matches could make an undefined program produce a +%% value.) This makes the final size less than what was accounted for +%% when visiting the clauses, but currently we don't try to adjust for +%% this. + +i_case_2(Cs, A, E, S) -> + case equivalent_clauses(Cs) of + false -> + %% Count the base sizes for the remaining clauses; pattern + %% and guard sizes are already counted. + N = weight('case') + weight(clause) * length(Cs), + S1 = count_size(N, S), + {update_c_case(E, A, Cs), S1}; + true -> + case cerl_clauses:any_catchall(Cs) of + true -> + %% We know that some clause must be selected, so we + %% can drop all the testing as well. + E1 = make_seq(A, clause_body(hd(Cs))), + {E1, S}; + false -> + %% The clause selection must be performed for + %% effect. + E1 = update_c_case(E, A, + set_clause_bodies(Cs, void())), + {make_seq(E1, clause_body(hd(Cs))), S} + end + end. + +i_case_3(Vs, Env, E, S) -> + %% For the variables bound to the switch expression subexpressions, + %% make let bindings or create evaluation for effect. + Rs = [env__get(var_name(V), Env) || V <- Vs], + {E1, S1} = make_let_bindings(Rs, E, S), + Opnds = [R#ref.opnd || R <- Rs], + residualize_operands(Opnds, E1, S1). + +%% This function takes a sequence of switch expressions `Es' (which can +%% be the empty list if these are unknown) and a list `Cs' of clauses, +%% and returns `{Match, {As, Vs, Env1, Cs1}, S1}' where `As' is a list +%% of residual switch expressions, `Vs' the list of variables used in +%% the templates, `Env1' the environment for the templates, and `Cs1' +%% the list of residual clauses. `Match' is `true' if some clause could +%% be shown to definitely match (in this case, `Cs1' contains exactly +%% one element), and `false' otherwise. `S1' is the new state. The given +%% `Ctxt' is the context to be used for visiting the body of clauses. +%% +%% Visiting a clause basically amounts to extending the environment for +%% all variables in the pattern, as for a `fun' (cf. `i_fun'), +%% propagating match information if possible, and visiting the guard and +%% body in the new environment. +%% +%% To make it cheaper to do handle a set of clauses, and to avoid +%% unnecessarily exceeding the size limit, we avoid visiting the bodies +%% of clauses which are subsequently removed, by dividing the visiting +%% of a clause into two stages: first construct the environment(s) and +%% visit the pattern (for renaming) and the guard (for value), then +%% reduce the switch as much as possible, and lastly visit the body. + +i_clauses(Cs, Ctxt, Ren, Env, S) -> + i_clauses([], Cs, Ctxt, Ren, Env, S). + +i_clauses(Es, Cs, Ctxt, Ren, Env, S) -> + %% Create templates for the switch expressions. + {Ts, {Vs, Env0}} = mapfoldl(fun (E, {Vs, Env}) -> + {T, Vs1, Env1} = + make_template(E, Env), + {T, {Vs1 ++ Vs, Env1}} + end, + {[], Env}, Es), + + %% Make operand structures for the switch subexpression templates + %% (found in `Env0') and add proper ref-structure bindings to the + %% environment. Since the subexpressions in general can be + %% interdependent (Vs is in reverse-dependency order), the + %% environment (and renaming) must be created incrementally. Note + %% that since the switch expressions have been visited already, the + %% identity renaming is used for the operands. + Vs1 = lists:reverse(Vs), + {Ren1, Env1, S1} = + foldl(fun (V, {Ren, Env, S}) -> + E = env__get(var_name(V), Env0), + {Opnd, S_1} = make_opnd(E, ren__identity(), Env, + S), + {_, Ren1, Env1, S_2} = bind_locals([V], [Opnd], + Ren, Env, S_1), + {Ren1, Env1, S_2} + end, + {Ren, Env, S}, Vs1), + + %% First we visit the head of each individual clause, renaming + %% pattern variables, inserting let-bindings in the guard and body, + %% and visiting the guard. The information used for visiting the + %% clause body will be prefixed to the clause annotations. + {Cs1, S2} = mapfoldl(fun (C, S) -> + i_clause_head(C, Ts, Ren1, Env1, S) + end, + S1, Cs), + + %% Now that the clause guards have been reduced as far as possible, + %% we can attempt to reduce the clauses. + As = [hd(get_ann(T)) || T <- Ts], + case cerl_clauses:reduce(Cs1, Ts) of + {false, Cs2} -> + %% We still have one or more clauses (with associated + %% extended environments). Their bodies have not yet been + %% visited, so we do that (in the respective safe + %% environments, adding the sizes of the visited heads to + %% the current size counter) and return the final list of + %% clauses. + {Cs3, S3} = mapfoldl( + fun (C, S) -> + i_clause_body(C, Ctxt, S) + end, + S2, Cs2), + {false, {As, Vs1, Env1, Cs3}, S3}; + {true, {C, _}} -> + %% A clause C could be selected (the bindings have already + %% been added to the guard/body). Note that since the clause + %% head will probably be discarded, its size is not counted. + {C1, Ren2, Env2, _} = get_clause_extras(C), + {B, S3} = i(clause_body(C), Ctxt, Ren2, Env2, S2), + C2 = update_c_clause(C1, clause_pats(C1), clause_guard(C1), B), + {true, {As, Vs1, Env1, [C2]}, S3} + end. + +%% This visits the head of a clause, renames pattern variables, inserts +%% let-bindings in the guard and body, and does inlining on the guard +%% expression. Returns a list of pairs `{NewClause, Data}', where `Data' +%% is `{Renaming, Environment, Size}' used for visiting the body of the +%% new clause. + +i_clause_head(C, Ts, Ren, Env, S) -> + %% Match the templates against the (non-renamed) patterns to get the + %% available information about matching subexpressions. We don't + %% care at this point whether an exact match/nomatch is detected. + Ps = clause_pats(C), + Bs = case cerl_clauses:match_list(Ps, Ts) of + {_, Bs1} -> Bs1; + none -> [] + end, + + %% The patterns must be visited for renaming; cf. `i_pattern'. We + %% use a passive size counter for visiting the patterns and the + %% guard (cf. `visit'), because we do not know at this stage whether + %% the clause will be kept or not; the final value of the counter is + %% included in the returned value below. + {_, Ren1, Env1, S1} = bind_locals(clause_vars(C), Ren, Env, S), + S2 = new_passive_size(get_size_limit(S1), S1), + {Ps1, S3} = mapfoldl(fun (P, S) -> + i_pattern(P, Ren1, Env1, Ren, Env, S) + end, + S2, Ps), + + %% Rewrite guard and body and visit the guard for value. Discard the + %% latter size count if the guard turns out to be a constant. + G = add_match_bindings(Bs, clause_guard(C)), + B = add_match_bindings(Bs, clause_body(C)), + {G1, S4} = i(G, value, Ren1, Env1, S3), + S5 = case is_literal(G1) of + true -> + revert_size(S3, S4); + false -> + S4 + end, + + %% Revert to the size counter we had on entry to this function. The + %% environment and renaming, together with the size of the clause + %% head, are prefixed to the annotations for later use. + Size = get_size_value(S5), + C1 = update_c_clause(C, Ps1, G1, B), + {set_clause_extras(C1, Ren1, Env1, Size), revert_size(S, S5)}. + +add_match_bindings(Bs, E) -> + %% Don't waste time if the variables definitely cannot be used. + %% (Most guards are simply `true'.) + case is_literal(E) of + true -> + E; + false -> + Vs = [V || {V, E} <- Bs, E =/= any], + Es = [hd(get_ann(E)) || {_V, E} <- Bs, E =/= any], + c_let(Vs, c_values(Es), E) + end. + +i_clause_body(C0, Ctxt, S) -> + {C, Ren, Env, Size} = get_clause_extras(C0), + S1 = count_size(Size, S), + {B, S2} = i(clause_body(C), Ctxt, Ren, Env, S1), + C1 = update_c_clause(C, clause_pats(C), clause_guard(C), B), + {C1, S2}. + +get_clause_extras(C) -> + [{Ren, Env, Size} | As] = get_ann(C), + {set_ann(C, As), Ren, Env, Size}. + +set_clause_extras(C, Ren, Env, Size) -> + As = [{Ren, Env, Size} | get_ann(C)], + set_ann(C, As). + +%% This is the `(lambda x e)' case of the original algorithm. A +%% `fun' is like a lambda expression, but with a varying number of +%% parameters; possibly zero. + +i_fun(E, Ctxt, Ren, Env, S) -> + case Ctxt of + effect -> + %% Reduce useless `fun' expressions to a simple constant; + %% visiting the body would be a waste of time, and could + %% needlessly mark variables as referenced. + {void(), count_size(weight(literal), S)}; + value -> + %% Note that the variables are visited as patterns. + Vs = fun_vars(E), + {_, Ren1, Env1, S1} = bind_locals(Vs, Ren, Env, S), + Vs1 = i_params(Vs, Ren1, Env1), + + %% The body is always visited for value. + {B, S2} = i(fun_body(E), value, Ren1, Env1, S1), + + %% We don't bother to include the exact number of free + %% variables in the cost for creating a fun-value. + S3 = count_size(weight('fun'), S2), + + %% Inlining might have duplicated code, so we must remove + %% any 'id'-annotations from the original fun-expression. + %% (This forces a later stage to invent new id:s.) This is + %% necessary as long as fun:s may still need to be + %% identified the old way. Function variables that are not + %% in application context also have such annotations, but + %% the inlining will currently lose all annotations on + %% variable references (I think), so that's not a problem. + {set_ann(c_fun(Vs1, B), kill_id_anns(get_ann(E))), S3}; + #app{} -> + %% An application of a fun-expression (in the original + %% source code) is handled by going directly to `inline'. + %% This is never residualised unless there is an arity + %% mismatch, so we don't set up new counters here. Note that + %% inlining of copy-propagated fun-expressions is done in + %% `copy'; not here! + inline(E, Ctxt, Ren, Env, S) + end. + +%% A `letrec' requires a circular environment, but is otherwise like a +%% `let', i.e. like a direct lambda application. Note that only +%% fun-expressions (lambda abstractions) may occur in the right-hand +%% side of each definition. + +i_letrec(E, Ctxt, Ren, Env, S) -> + %% Note that we pass an empty list for the auto-referenced + %% (exported) functions here. + {Es, B, _, S1} = i_letrec(letrec_defs(E), letrec_body(E), [], Ctxt, + Ren, Env, S), + + %% If no bindings remain, only the body is returned. + case Es of + [] -> + {B, S1}; % drop annotations on E + _ -> + S2 = count_size(weight(letrec), S1), + {update_c_letrec(E, Es, B), S2} + end. + +%% The major part of this is shared by letrec-expressions and module +%% definitions alike. + +i_letrec(Es, B, Xs, Ctxt, Ren, Env, S) -> + %% First, we create operands with dummy renamings and environments, + %% and with fresh store locations for cached expressions and operand + %% info. + {Opnds, S1} = mapfoldl(fun ({_, E}, S) -> + make_opnd(E, undefined, undefined, S) + end, + S, Es), + + %% Then we make recursive bindings for the definitions. + {Rs, Ren1, Env1, S2} = bind_recursive([F || {F, _} <- Es], + Opnds, Ren, Env, S1), + + %% For the function variables listed in Xs (none for a + %% letrec-expression), we must make sure that the corresponding + %% operand expressions are visited and that the definitions are + %% marked as referenced; we also need to return the possibly renamed + %% function variables. + {Xs1, S3} = + mapfoldl( + fun (X, S) -> + Name = ren__map(var_name(X), Ren1), + case env__lookup(Name, Env1) of + {ok, R} -> + S_1 = i_letrec_export(R, S), + {ref_to_var(R), S_1}; + error -> + %% We just skip any exports that are not + %% actually defined here, and generate a + %% warning message. + {N, A} = var_name(X), + report_warning("export `~w'/~w " + "not defined.\n", [N, A]), + {X, S} + end + end, + S2, Xs), + + %% At last, we can then visit the body. + {B1, S4} = i(B, Ctxt, Ren1, Env1, S3), + + %% Finally, we create new letrec-bindings for any and all + %% residualised definitions. All referenced functions should have + %% been visited; the call to `visit' below is expected to retreive a + %% cached expression. + Rs1 = keep_referenced(Rs, S4), + {Es1, S5} = mapfoldl(fun (R, S) -> + {E_1, S_1} = visit(R#ref.opnd, S), + {{ref_to_var(R), E_1}, S_1} + end, + S4, Rs1), + {Es1, B1, Xs1, S5}. + +%% This visits the operand for a function definition exported by a +%% `letrec' (which is really a `module' module definition, since normal +%% letrecs have no export declarations). Only the updated state is +%% returned. We must handle the "inner-pending" flag when doing this; +%% cf. `i_var'. + +i_letrec_export(R, S) -> + Opnd = R#ref.opnd, + S1 = st__mark_inner_pending(Opnd#opnd.loc, S), + {_, S2} = visit(Opnd, S1), + {_, S3} = residualize_var(R, st__clear_inner_pending(Opnd#opnd.loc, + S2)), + S3. + +%% This is the `(call e1 e2)' case of the original algorithm. The only +%% difference is that we must handle multiple (or no) operand +%% expressions. + +i_apply(E, Ctxt, Ren, Env, S) -> + {Opnds, S1} = mapfoldl(fun (E, S) -> + make_opnd(E, Ren, Env, S) + end, + S, apply_args(E)), + + %% Allocate a new app-context location and set up an application + %% context structure containing the surrounding context. + {L, S2} = st__new_app_loc(S1), + Ctxt1 = #app{opnds = Opnds, ctxt = Ctxt, loc = L}, + + %% Visit the operator expression in the new call context. + {E1, S3} = i(apply_op(E), Ctxt1, Ren, Env, S2), + + %% Check the "inlined" flag to find out what to do next. (The store + %% location could be recycled after the flag has been tested, but + %% there is no real advantage to that, because in practice, only + %% 4-5% of all created store locations will ever be reused, while + %% there will be a noticable overhead for managing the free list.) + case st__get_app_inlined(L, S3) of + true -> + %% The application was inlined, so we have the final + %% expression in `E1'. We just have to handle any operands + %% that need to be residualized for effect only (i.e., those + %% the values of which are not used). + residualize_operands(Opnds, E1, S3); + false -> + %% Otherwise, `E1' is the residual operator expression. We + %% make sure all operands are visited, and rebuild the + %% application. + {Es, S4} = mapfoldl(fun (Opnd, S) -> + visit_and_count_size(Opnd, S) + end, + S3, Opnds), + N = apply_size(length(Es)), + {update_c_apply(E, E1, Es), count_size(N, S4)} + end. + +apply_size(A) -> + weight(apply) + weight(argument) * A. + +%% Since it is not the task of this transformation to handle +%% cross-module inlining, all inter-module calls are handled by visiting +%% the components (the module and function name, and the arguments of +%% the call) for value. In `effect' context, if the function itself is +%% known to be completely effect free, the call can be discarded and the +%% arguments evaluated for effect. Otherwise, if all the visited +%% arguments are to constants, and the function is known to be safe to +%% execute at compile time, then we try to evaluate the call. If +%% evaluation completes normally, the call is replaced by the result; +%% otherwise the call is residualised. + +i_call(E, Ctxt, Ren, Env, S) -> + {M, S1} = i(call_module(E), value, Ren, Env, S), + {F, S2} = i(call_name(E), value, Ren, Env, S1), + As = call_args(E), + Arity = length(As), + + %% Check if the name of the called function is static. If so, + %% discard the size counts performed above, since the values will + %% not cause any runtime cost. + Static = is_c_atom(M) and is_c_atom(F), + S3 = case Static of + true -> + revert_size(S, S2); + false -> + S2 + end, + case Ctxt of + effect when Static =:= true -> + case is_safe_call(atom_val(M), atom_val(F), Arity) of + true -> + %% The result will not be used, and the call is + %% effect free, so we create a multiple-value + %% aggregate containing the (not yet visited) + %% arguments and process that instead. + i(c_values(As), effect, Ren, Env, S3); + false -> + %% We are not allowed to simply discard the call, + %% but we can try to evaluate it. + i_call_1(Static, M, F, Arity, As, E, Ctxt, Ren, Env, + S3) + end; + _ -> + i_call_1(Static, M, F, Arity, As, E, Ctxt, Ren, Env, S3) + end. + +i_call_1(Static, M, F, Arity, As, E, Ctxt, Ren, Env, S) -> + %% Visit the arguments for value. + {As1, S1} = mapfoldl(fun (X, A) -> i(X, value, Ren, Env, A) end, + S, As), + case Static of + true -> + case erl_bifs:is_pure(atom_val(M), atom_val(F), Arity) of + true -> + %% It is allowed to evaluate this at compile time. + case all_static(As1) of + true -> + i_call_3(M, F, As1, E, Ctxt, Env, S1); + false -> + %% See if the call can be rewritten instead. + i_call_4(M, F, As1, E, Ctxt, Env, S1) + end; + false -> + i_call_2(M, F, As1, E, S1) + end; + false -> + i_call_2(M, F, As1, E, S1) + end. + +%% Residualise the call. + +i_call_2(M, F, As, E, S) -> + N = weight(call) + weight(argument) * length(As), + {update_c_call(E, M, F, As), count_size(N, S)}. + +%% Attempt to evaluate the call to yield a literal; if that fails, try +%% to rewrite the expression. + +i_call_3(M, F, As, E, Ctxt, Env, S) -> + %% Note that we extract the results of argument expessions here; the + %% expressions could still be sequences with side effects. + Vs = [concrete(result(A)) || A <- As], + case catch {ok, apply(atom_val(M), atom_val(F), Vs)} of + {ok, V} -> + %% Evaluation completed normally - try to turn the result + %% back into a syntax tree (representing a literal). + case is_literal_term(V) of + true -> + %% Make a sequence of the arguments (as a + %% multiple-value aggregate) and the final value. + S1 = count_size(weight(values), S), + S2 = count_size(weight(literal), S1), + {make_seq(c_values(As), abstract(V)), S2}; + false -> + %% The result could not be represented as a literal. + i_call_4(M, F, As, E, Ctxt, Env, S) + end; + _ -> + %% The evaluation attempt did not complete normally. + i_call_4(M, F, As, E, Ctxt, Env, S) + end. + +%% Rewrite the expression, if possible, otherwise residualise it. + +i_call_4(M, F, As, E, Ctxt, Env, S) -> + case reduce_bif_call(atom_val(M), atom_val(F), As, Env) of + false -> + %% Nothing more to be done - residualise the call. + i_call_2(M, F, As, E, S); + {true, E1} -> + %% We revisit the result, because the rewriting might have + %% opened possibilities for further inlining. Since the + %% parts have already been visited once, we use the identity + %% renaming here. + i(E1, Ctxt, ren__identity(), Env, S) + end. + +%% For now, we assume that primops cannot be evaluated at compile time, +%% probably being too special. Also, we have no knowledge about their +%% side effects. + +i_primop(E, Ren, Env, S) -> + %% Visit the arguments for value. + {As, S1} = mapfoldl(fun (E, S) -> + i(E, value, Ren, Env, S) + end, + S, primop_args(E)), + N = weight(primop) + weight(argument) * length(As), + {update_c_primop(E, primop_name(E), As), count_size(N, S1)}. + +%% This is like having an expression with an extra fun-expression +%% attached for "exceptional cases"; actually, there are exactly two +%% parameter variables for the body, but they are easiest handled as if +%% their number might vary, just as for a `fun'. + +i_try(E, Ctxt, Ren, Env, S) -> + %% The argument expression is evaluated in `value' context, and the + %% surrounding context is propagated into both branches. We do not + %% try to recognize cases when the protected expression will + %% actually raise an exception. Note that the variables are visited + %% as patterns. + {A, S1} = i(try_arg(E), value, Ren, Env, S), + Vs = try_vars(E), + {_, Ren1, Env1, S2} = bind_locals(Vs, Ren, Env, S1), + Vs1 = i_params(Vs, Ren1, Env1), + {B, S3} = i(try_body(E), Ctxt, Ren1, Env1, S2), + case is_safe(A) of + true -> + %% The `try' wrapper can be dropped in this case. Since the + %% expressions have been visited already, the identity + %% renaming is used when we revisit the new let-expression. + i(c_let(Vs1, A, B), Ctxt, ren__identity(), Env, S3); + false -> + Evs = try_evars(E), + {_, Ren2, Env2, S4} = bind_locals(Evs, Ren, Env, S3), + Evs1 = i_params(Evs, Ren2, Env2), + {H, S5} = i(try_handler(E), Ctxt, Ren2, Env2, S4), + S6 = count_size(weight('try'), S5), + {update_c_try(E, A, Vs1, B, Evs1, H), S6} + end. + +%% A special case of try-expressions: + +i_catch(E, Ctxt, Ren, Env, S) -> + %% We cannot propagate application contexts into the catch. + {E1, S1} = ES1 = i(catch_body(E), safe_context(Ctxt), Ren, Env, S), + case is_safe(E1) of + true -> + %% The `catch' wrapper can be dropped in this case. + ES1; + false -> + S2 = count_size(weight('catch'), S1), + {update_c_catch(E, E1), S2} + end. + +%% A receive-expression is very much like a case-expression, with the +%% difference that we do not have access to a switch expression, since +%% the value being switched on is taken from the mailbox. The fact that +%% the receive-expression may iterate over an arbitrary number of +%% messages is not of interest to us. All we can do here is to visit its +%% subexpressions, and possibly eliminate definitely unselectable +%% clauses. + +i_receive(E, Ctxt, Ren, Env, S) -> + %% We first visit the expiry expression (for value) and the expiry + %% body (in the surrounding context). + {T, S1} = i(receive_timeout(E), value, Ren, Env, S), + {B, S2} = i(receive_action(E), Ctxt, Ren, Env, S1), + + %% Then we visit the clauses. Note that application contexts may not + %% in general be propagated into the branches (and the expiry body), + %% because the execution of the `receive' may remove a message from + %% the mailbox as a side effect; the situation is thus analogous to + %% that in a `case' expression. + Ctxt1 = safe_context(Ctxt), + case i_clauses(receive_clauses(E), Ctxt1, Ren, Env, S2) of + {false, {[], _, _, Cs}, S3} -> + %% We still have a list of clauses. If the list is empty, + %% and the expiry expression is the integer zero, the + %% expression reduces to the expiry body. + if Cs =:= [] -> + case is_c_int(T) andalso (int_val(T) =:= 0) of + true -> + {B, S3}; + false -> + i_receive_1(E, Cs, T, B, S3) + end; + true -> + i_receive_1(E, Cs, T, B, S3) + end; + {true, {_, _, _, Cs}, S3} -> + %% Cs is a single clause that will always be matched (if a + %% message exists), but we must keep the `receive' statement + %% in order to fetch the message from the mailbox. + i_receive_1(E, Cs, T, B, S3) + end. + +i_receive_1(E, Cs, T, B, S) -> + %% Here, we just add the base sizes for the receive-expression + %% itself and for each remaining clause; cf. `case'. + N = weight('receive') + weight(clause) * length(Cs), + {update_c_receive(E, Cs, T, B), count_size(N, S)}. + +%% A module definition is like a `letrec', with some add-ons (export and +%% attribute declarations) but without an explicit body. Actually, the +%% exporting of function names has the same effect as if there was a +%% body consisting of the list of references to the exported functions. +%% Thus, the exported functions are exactly those which can be +%% referenced from outside the module. + +i_module(E, Ctxt, Ren, Env, S) -> + %% Cf. `i_letrec'. Note that we pass a dummy constant value for the + %% "body" parameter. + {Es, _, Xs1, S1} = i_letrec(module_defs(E), void(), + module_exports(E), Ctxt, Ren, Env, S), + %% Sanity check: + case Es of + [] -> + report_warning("no function definitions remaining " + "in module `~s'.\n", + [atom_name(module_name(E))]); + _ -> + ok + end, + E1 = update_c_module(E, module_name(E), Xs1, module_attrs(E), Es), + {E1, count_size(weight(module), S1)}. + +%% Binary-syntax expressions are too complicated to do anything +%% interesting with here - that is beyond the scope of this program; +%% also, their construction could have side effects, so even in effect +%% context we can't remove them. (We don't bother to identify cases of +%% "safe" unused binaries which could be removed.) + +i_binary(E, Ren, Env, S) -> + %% Visit the segments for value. + {Es, S1} = mapfoldl(fun (E, S) -> + i_bitstr(E, Ren, Env, S) + end, + S, binary_segments(E)), + S2 = count_size(weight(binary), S1), + {update_c_binary(E, Es), S2}. + +i_bitstr(E, Ren, Env, S) -> + %% It is not necessary to visit the Unit, Type and Flags fields, + %% since these are always literals. + {Val, S1} = i(bitstr_val(E), value, Ren, Env, S), + {Size, S2} = i(bitstr_size(E), value, Ren, Env, S1), + Unit = bitstr_unit(E), + Type = bitstr_type(E), + Flags = bitstr_flags(E), + S3 = count_size(weight(bitstr), S2), + {update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}. + +%% This is a simplified version of `i_pattern', for lists of parameter +%% variables only. It does not modify the state. + +i_params([V | Vs], Ren, Env) -> + Name = ren__map(var_name(V), Ren), + case env__lookup(Name, Env) of + {ok, R} -> + [ref_to_var(R) | i_params(Vs, Ren, Env)]; + error -> + report_internal_error("variable `~w' not bound " + "in pattern.\n", [Name]), + exit(error) + end; +i_params([], _, _) -> + []. + +%% For ordinary patterns, we just visit to rename variables and count +%% the size/cost. All occurring binding instances of variables should +%% already have been added to the renaming and environment; however, to +%% handle the size expressions of binary-syntax patterns, we must pass +%% the renaming and environment of the containing expression + +i_pattern(E, Ren, Env, Ren0, Env0, S) -> + case type(E) of + var -> + %% Count no size. + Name = ren__map(var_name(E), Ren), + case env__lookup(Name, Env) of + {ok, R} -> + {ref_to_var(R), S}; + error -> + report_internal_error("variable `~w' not bound " + "in pattern.\n", [Name]), + exit(error) + end; + alias -> + %% Count no size. + V = alias_var(E), + Name = ren__map(var_name(V), Ren), + case env__lookup(Name, Env) of + {ok, R} -> + %% Visit the subpattern and recompose. + V1 = ref_to_var(R), + {P, S1} = i_pattern(alias_pat(E), Ren, Env, Ren0, + Env0, S), + {update_c_alias(E, V1, P), S1}; + error -> + report_internal_error("variable `~w' not bound " + "in pattern.\n", [Name]), + exit(error) + end; + binary -> + {Es, S1} = mapfoldl(fun (E, S) -> + i_bitstr_pattern(E, Ren, Env, + Ren0, Env0, S) + end, + S, binary_segments(E)), + S2 = count_size(weight(binary), S1), + {update_c_binary(E, Es), S2}; + _ -> + case is_literal(E) of + true -> + {E, count_size(weight(literal), S)}; + false -> + {Es1, S1} = mapfoldl(fun (E, S) -> + i_pattern(E, Ren, Env, + Ren0, Env0, + S) + end, + S, data_es(E)), + %% We assume that in general, the elements of the + %% constructor will all be fetched. + N = weight(data) + length(Es1) * weight(element), + S2 = count_size(N, S1), + {update_data(E, data_type(E), Es1), S2} + end + end. + +i_bitstr_pattern(E, Ren, Env, Ren0, Env0, S) -> + %% It is not necessary to visit the Unit, Type and Flags fields, + %% since these are always literals. The Value field is a limited + %% pattern - either a literal or an unbound variable. The Size field + %% is a limited expression - either a literal or a variable bound in + %% the environment of the containing expression. + {Val, S1} = i_pattern(bitstr_val(E), Ren, Env, Ren0, Env0, S), + {Size, S2} = i(bitstr_size(E), value, Ren0, Env0, S1), + Unit = bitstr_unit(E), + Type = bitstr_type(E), + Flags = bitstr_flags(E), + S3 = count_size(weight(bitstr), S2), + {update_c_bitstr(E, Val, Size, Unit, Type, Flags), S3}. + + +%% --------------------------------------------------------------------- +%% Other central inlining functions + +%% The following function assumes that `E' is a fun-expression and the +%% context is an app-structure. If the inlining could be aborted, a +%% corresponding catch should be set up before entering the function. +%% +%% Note: if the inlined body is some lambda abstraction, and the +%% surrounding context of the app-context is also an app-context, the +%% `inlined' flag of the outermost context will be set before that of +%% the inner context is set. E.g.: `let F = fun (X) -> fun (Y) -> E in +%% apply apply F(A)(B)' will propagate the body of F, which is a lambda +%% abstraction, into the outer application context, which will be +%% inlined to produce expression `E', and the flag of the outer context +%% will be set. Upon return, the flag of the inner context will also be +%% set. However, the flags are then tested in innermost-first order. +%% Thus, if some inlining attempt is aborted, the `inlined' flags of any +%% nested app-contexts must be cleared. +%% +%% This implementation does nothing to handle inlining of calls to +%% recursive functions in a smart way. This means that as long as the +%% size and effort counters do not prevent it, the function body will be +%% inlined (i.e., the first iteration will be unrolled), and the +%% recursive calls will be residualized. + +inline(E, #app{opnds = Opnds, ctxt = Ctxt, loc = L}, Ren, Env, S) -> + %% Check that the arities match: + Vs = fun_vars(E), + if length(Opnds) =/= length(Vs) -> + %% Arity mismatch: the call will be residualized + {E, S}; + true -> + %% Create local bindings for the parameters to their + %% respective operand structures from the app-structure, and + %% visit the body in the context saved in the structure. + {Rs, Ren1, Env1, S1} = bind_locals(Vs, Opnds, Ren, Env, S), + {E1, S2} = i(fun_body(E), Ctxt, Ren1, Env1, S1), + + %% Create necessary bindings and/or set flags. + {E2, S3} = make_let_bindings(Rs, E1, S2), + + %% Lastly, flag the application as inlined, since the inlining + %% attempt was not aborted before we reached this point. + {E2, st__set_app_inlined(L, S3)} + end. + +%% For the (possibly renamed) argument variables to an inlined call, +%% either create `let' bindings for them, if they are still referenced +%% in the residual expression (in C/Lisp, also if they are assigned to), +%% or otherwise (if they are not referenced or assigned) mark them for +%% evaluation for side effects. + +make_let_bindings([R | Rs], E, S) -> + {E1, S1} = make_let_bindings(Rs, E, S), + make_let_binding(R, E1, S1); +make_let_bindings([], E, S) -> + {E, S}. + +make_let_binding(R, E, S) -> + %% The `referenced' flag is conservatively computed. We therefore + %% first check some simple cases where parameter R is definitely not + %% referenced in the resulting body E. + case is_literal(E) of + true -> + %% A constant contains no variable references. + make_let_binding_1(R, E, S); + false -> + case is_c_var(E) of + true -> + case var_name(E) =:= R#ref.name of + true -> + %% The body is simply the parameter variable + %% itself. Visit the operand for value and + %% substitute the result for the body. + visit_and_count_size(R#ref.opnd, S); + false -> + %% Not the same variable, so the parameter + %% is not referenced at all. + make_let_binding_1(R, E, S) + end; + false -> + %% Proceed to check the `referenced' flag. + case st__get_var_referenced(R#ref.loc, S) of + true -> + %% The parameter is probably referenced in + %% the residual code (although it might not + %% be). Visit the operand for value and + %% create a let-binding. + {E1, S1} = visit_and_count_size(R#ref.opnd, + S), + S2 = count_size(weight('let'), S1), + {c_let([ref_to_var(R)], E1, E), S2}; + false -> + %% The parameter is definitely not + %% referenced. + make_let_binding_1(R, E, S) + end + end + end. + +%% This marks the operand for evaluation for effect. + +make_let_binding_1(R, E, S) -> + Opnd = R#ref.opnd, + {E, st__set_opnd_effect(Opnd#opnd.loc, S)}. + +%% Here, `R' is the ref-structure which is the target of the copy +%% propagation, and `Opnd' is a visited operand structure, to be +%% propagated through `R' if possible - if not, `R' is residualised. +%% `Opnd' is normally the operand that `R' is bound to, and `E' is the +%% result of visiting `Opnd' for value; we pass this as an argument so +%% we don't have to fetch it multiple times (because we don't have +%% constant time access). +%% +%% We also pass the environment of the site of the variable reference, +%% for use when inlining a propagated fun-expression. In the original +%% algorithm by Waddell, the environment used for inlining such cases is +%% the identity mapping, because the fun-expression body has already +%% been visited for value, and their algorithm combines renaming of +%% source-code variables with the looking up of information about +%% residual-code variables. We, however, need to check the environment +%% of the call site when creating new non-shadowed variables, but we +%% must avoid repeated renaming. We therefore separate the renaming and +%% the environment (as in the renaming algorithm of Peyton-Jones and +%% Marlow). This also makes our implementation more general, compared to +%% the original algorithm, because we do not give up on propagating +%% variables that were free in the fun-body. +%% +%% Example: +%% +%% let F = fun (X) -> {'foo', X} in +%% let G = fun (H) -> apply H(F) % F is free in the fun G +%% in apply G(fun (F) -> apply F(42)) +%% => +%% let F = fun (X) -> {'foo', X} in +%% apply (fun (H) -> apply H(F))(fun (F) -> apply F(42)) +%% => +%% let F = fun (X) -> {'foo', X} in +%% apply (fun (F) -> apply F(42))(F) +%% => +%% let F = fun (X) -> {'foo', X} in +%% apply F(42) +%% => +%% apply (fun (X) -> {'foo', X})(2) +%% => +%% {'foo', 42} +%% +%% The original algorithm would give up at stage 4, because F was free +%% in the propagated fun-expression. Our version inlines this example +%% completely. + +copy(R, Opnd, E, Ctxt, Env, S) -> + case is_c_var(E) of + true -> + %% The operand reduces to another variable - get its + %% ref-structure and attempt to propagate further. + copy_var(env__get(var_name(E), Opnd#opnd.env), Ctxt, Env, + S); + false -> + %% Apart from variables and functional values (the latter + %% are handled by `copy_1' below), only constant literals + %% are copyable in general; other things, including e.g. + %% tuples `{foo, X}', could cause duplication of work, and + %% are not copy propagated. + case is_literal(E) of + true -> + {E, count_size(weight(literal), S)}; + false -> + copy_1(R, Opnd, E, Ctxt, Env, S) + end + end. + +copy_var(R, Ctxt, Env, S) -> + %% (In Lisp or C, if this other variable might be assigned to, we + %% should residualize the "parent" instead, so we don't bypass any + %% destructive updates.) + case R#ref.opnd of + undefined -> + %% This variable is not bound to an expression, so just + %% residualize it. + residualize_var(R, S); + Opnd -> + %% Note that because operands are always visited before + %% copied, all copyable operand expressions will be + %% propagated through any number of bindings. If `R' was + %% bound to a constant literal, we would never have reached + %% this point. + case st__lookup_opnd_cache(Opnd#opnd.loc, S) of + error -> + %% The result for this operand is not yet ready + %% (which should mean that it is a recursive + %% reference). Thus, we must residualise the + %% variable. + residualize_var(R, S); + {ok, #cache{expr = E1}} -> + %% The result for the operand is ready, so we can + %% proceed to propagate it. + copy_1(R, Opnd, E1, Ctxt, Env, S) + end + end. + +copy_1(R, Opnd, E, Ctxt, Env, S) -> + %% Fun-expression (lambdas) are a bit special; they are copyable, + %% but should preferably not be duplicated, so they should not be + %% copy propagated except into application contexts, where they can + %% be inlined. + case is_c_fun(E) of + true -> + case Ctxt of + #app{} -> + %% First test if the operand is "outer-pending"; if + %% so, don't inline. + case st__test_outer_pending(Opnd#opnd.loc, S) of + false -> + copy_inline(R, Opnd, E, Ctxt, Env, S); + true -> + %% Cyclic reference forced inlining to stop + %% (avoiding infinite unfolding). + residualize_var(R, S) + end; + _ -> + residualize_var(R, S) + end; + false -> + %% We have no other cases to handle here + residualize_var(R, S) + end. + +%% This inlines a function value that was propagated to an application +%% context. The inlining is done with an identity renaming (since the +%% expression is already visited) but in the environment of the call +%% site (which is OK because of the no-shadowing strategy for renaming, +%% and because the domain of our environments are the residual-program +%% variables instead of the source-program variables). Note that we must +%% first set the "outer-pending" flag, and clear it afterwards. + +copy_inline(R, Opnd, E, Ctxt, Env, S) -> + S1 = st__mark_outer_pending(Opnd#opnd.loc, S), + case catch {ok, copy_inline_1(R, E, Ctxt, Env, S1)} of + {ok, {E1, S2}} -> + {E1, st__clear_outer_pending(Opnd#opnd.loc, S2)}; + {'EXIT', X} -> + exit(X); + X -> + %% If we use destructive update for the `outer-pending' + %% flag, we must make sure to clear it upon a nonlocal + %% return. + _S2 = st__clear_outer_pending(Opnd#opnd.loc, S1), + throw(X) + end. + +%% If the current effort counter was passive, we use a new active effort +%% counter with the inherited limit for this particular inlining. + +copy_inline_1(R, E, Ctxt, Env, S) -> + case effort_is_active(S) of + true -> + copy_inline_2(R, E, Ctxt, Env, S); + false -> + S1 = new_active_effort(get_effort_limit(S), S), + case catch {ok, copy_inline_2(R, E, Ctxt, Env, S1)} of + {ok, {E1, S2}} -> + %% Revert to the old effort counter. + {E1, revert_effort(S, S2)}; + {counter_exceeded, effort, _} -> + %% Aborted this inlining attempt because too much + %% effort was spent. Residualize the variable and + %% revert to the previous state. + residualize_var(R, S); + {'EXIT', X} -> + exit(X); + X -> + throw(X) + end + end. + +%% Regardless of whether the current size counter is active or not, we +%% use a new active size counter for each inlining. If the current +%% counter was passive, the new counter gets the inherited size limit; +%% if it was active, the size limit of the new counter will be equal to +%% the remaining budget of the current counter (which itself is not +%% affected by the inlining). This distributes the size budget more +%% evenly over "inlinings within inlinings", so that the whole size +%% budget is not spent on the first few call sites (in an inlined +%% function body) forcing the remaining call sites to be residualised. + +copy_inline_2(R, E, Ctxt, Env, S) -> + Limit = case size_is_active(S) of + true -> + get_size_limit(S) - get_size_value(S); + false -> + get_size_limit(S) + end, + %% Add the cost of the application to the new size limit, so we + %% always inline functions that are small enough, even if `Limit' is + %% close to zero at this point. (This is an extension to the + %% original algorithm.) + S1 = new_active_size(Limit + apply_size(length(Ctxt#app.opnds)), S), + case catch {ok, inline(E, Ctxt, ren__identity(), Env, S1)} of + {ok, {E1, S2}} -> + %% Revert to the old size counter. + {E1, revert_size(S, S2)}; + {counter_exceeded, size, S2} -> + %% Aborted this inlining attempt because it got too big. + %% Residualize the variable and revert to the old size + %% counter. (It is important that we do not also revert the + %% effort counter here. Because the effort and size counters + %% are always set up together, we know that the effort + %% counter returned in S2 is the same that was passed to + %% `inline'.) + S3 = revert_size(S, S2), + %% If we use destructive update for the `inlined' flag, we + %% must make sure to clear the flags of any nested + %% app-contexts upon aborting; see `inline' for details. + S4 = reset_nested_apps(Ctxt, S3), % for effect + residualize_var(R, S4); + {'EXIT', X} -> + exit(X); + X -> + throw(X) + end. + +reset_nested_apps(#app{ctxt = Ctxt, loc = L}, S) -> + reset_nested_apps(Ctxt, st__clear_app_inlined(L, S)); +reset_nested_apps(_, S) -> + S. + + +%% --------------------------------------------------------------------- +%% Support functions + +new_var(Env) -> + Name = env__new_vname(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)}. + +%% This function returns the value-producing subexpression of any +%% expression. (Except for sequencing expressions, this is the +%% expression itself.) + +result(E) -> + case is_c_seq(E) of + true -> + %% Also see `make_seq', which is used in all places to build + %% sequences so that they are always nested in the first + %% position. + seq_body(E); + false -> + E + end. + +%% This function rewrites E to `do A1 E' if A is `do A1 A2', and +%% otherwise returns E unchanged. + +hoist_effects(A, E) -> + case type(A) of + seq -> make_seq(seq_arg(A), E); + _ -> E + end. + +%% This "build sequencing expression" operation assures that sequences +%% are always nested in the first position, which makes it easy to find +%% the actual value-producing expression of a sequence (cf. `result'). + +make_seq(E1, E2) -> + case is_safe(E1) of + true -> + %% The first expression can safely be dropped. + E2; + false -> + %% If `E1' is a sequence whose final expression has no side + %% effects, then we can lose *that* expression when we + %% compose the new sequence, since its value will not be + %% used. + E3 = case is_c_seq(E1) of + true -> + case is_safe(seq_body(E1)) of + true -> + %% Drop the final expression. + seq_arg(E1); + false -> + E1 + end; + false -> + E1 + end, + case is_c_seq(E2) of + true -> + %% `E2' is a sequence (E2' E2''), so we must + %% rearrange the nesting to ((E1, E2') E2''), to + %% preserve the invariant. Annotations on `E2' are + %% lost. + c_seq(c_seq(E3, seq_arg(E2)), seq_body(E2)); + false -> + c_seq(E3, E2) + end + end. + +%% Currently, safe expressions include variables, lambda expressions, +%% constructors with safe subexpressions (this includes atoms, integers, +%% empty lists, etc.), seq-, let- and letrec-expressions with safe +%% subexpressions, try- and catch-expressions with safe subexpressions +%% and calls to safe functions with safe argument subexpressions. +%% Binaries seem too tricky to be considered. + +is_safe(E) -> + case is_data(E) of + true -> + is_safe_list(data_es(E)); + false -> + case type(E) of + var -> + true; + 'fun' -> + true; + values -> + is_safe_list(values_es(E)); + 'seq' -> + is_safe(seq_arg(E)) andalso is_safe(seq_body(E)); + 'let' -> + is_safe(let_arg(E)) andalso is_safe(let_body(E)); + letrec -> + is_safe(letrec_body(E)); + 'try' -> + %% If the argument expression is not safe, it could + %% be modifying the state; thus, even if the body is + %% safe, the try-expression as a whole would not be. + %% If the argument is safe, the handler is not used. + is_safe(try_arg(E)) andalso is_safe(try_body(E)); + 'catch' -> + is_safe(catch_body(E)); + call -> + M = call_module(E), + F = call_name(E), + case is_c_atom(M) andalso is_c_atom(F) of + true -> + As = call_args(E), + is_safe_list(As) andalso + is_safe_call(atom_val(M), + atom_val(F), + length(As)); + false -> + false + end; + _ -> + false + end + end. + +is_safe_list([E | Es]) -> + case is_safe(E) of + true -> + is_safe_list(Es); + false -> + false + end; +is_safe_list([]) -> + true. + +is_safe_call(M, F, A) -> + erl_bifs:is_safe(M, F, A). + +%% When setting up local variables, we only create new names if we have +%% to, according to the "no-shadowing" strategy. + +make_locals(Vs, Ren, Env) -> + make_locals(Vs, [], Ren, Env). + +make_locals([V | Vs], As, Ren, Env) -> + Name = var_name(V), + case env__is_defined(Name, Env) of + false -> + %% The variable need not be renamed. Just make sure that the + %% renaming will map it to itself. + Name1 = Name, + Ren1 = ren__add_identity(Name, Ren); + true -> + %% The variable must be renamed to maintain the no-shadowing + %% invariant. Do the right thing for function variables. + Name1 = case Name of + {A, N} -> + env__new_fname(A, N, Env); + _ -> + env__new_vname(Env) + end, + Ren1 = ren__add(Name, Name1, Ren) + end, + %% This temporary binding is added for correct new-key generation. + Env1 = env__bind(Name1, dummy, Env), + make_locals(Vs, [Name1 | As], Ren1, Env1); +make_locals([], As, Ren, Env) -> + {reverse(As), Ren, Env}. + +%% This adds let-bindings for the source code variables in `Es' to the +%% environment `Env'. +%% +%% Note that we always assign a new state location for the +%% residual-program variable, since we cannot know when a location for a +%% particular variable in the source code can be reused. + +bind_locals(Vs, Ren, Env, S) -> + Opnds = [undefined || _ <- Vs], + bind_locals(Vs, Opnds, Ren, Env, S). + +bind_locals(Vs, Opnds, Ren, Env, S) -> + {Ns, Ren1, Env1} = make_locals(Vs, Ren, Env), + {Rs, Env2, S1} = bind_locals_1(Ns, Opnds, [], Env1, S), + {Rs, Ren1, Env2, S1}. + +%% Note that the `Vs' are currently not used for anything except the +%% number of variables. If we were maintaining "source-referenced" +%% flags, then the flag in the new variable should be initialized to the +%% current value of the (residual-) referenced-flag of the "parent". + +bind_locals_1([N | Ns], [Opnd | Opnds], Rs, Env, S) -> + {R, S1} = new_ref(N, Opnd, S), + Env1 = env__bind(N, R, Env), + bind_locals_1(Ns, Opnds, [R | Rs], Env1, S1); +bind_locals_1([], [], Rs, Env, S) -> + {lists:reverse(Rs), Env, S}. + +new_refs(Ns, Opnds, S) -> + new_refs(Ns, Opnds, [], S). + +new_refs([N | Ns], [Opnd | Opnds], Rs, S) -> + {R, S1} = new_ref(N, Opnd, S), + new_refs(Ns, Opnds, [R | Rs], S1); +new_refs([], [], Rs, S) -> + {lists:reverse(Rs), S}. + +new_ref(N, Opnd, S) -> + {L, S1} = st__new_ref_loc(S), + {#ref{name = N, opnd = Opnd, loc = L}, S1}. + +%% This adds recursive bindings for the source code variables in `Es' to +%% the environment `Env'. Note that recursive binding of a set of +%% variables is an atomic operation on the environment - they cannot be +%% added one at a time. + +bind_recursive(Vs, Opnds, Ren, Env, S) -> + {Ns, Ren1, Env1} = make_locals(Vs, Ren, Env), + {Rs, S1} = new_refs(Ns, Opnds, S), + + %% When this fun-expression is evaluated, it updates the operand + %% structure in the ref-structure to contain the recursively defined + %% environment and the correct renaming. + Fun = fun (R, Env) -> + Opnd = R#ref.opnd, + R#ref{opnd = Opnd#opnd{ren = Ren1, env = Env}} + end, + {Rs, Ren1, env__bind_recursive(Ns, Rs, Fun, Env1), S1}. + +safe_context(Ctxt) -> + case Ctxt of + #app{} -> + value; + _ -> + Ctxt + end. + +%% Note that the name of a variable encodes its type: a "plain" variable +%% or a function variable. The latter kind also contains an arity number +%% which should be preserved upon renaming. + +ref_to_var(#ref{name = Name}) -> + %% If we were maintaining "source-referenced" flags, the annotation + %% `add_ann([#source_ref{loc = L}], E)' should also be done here, to + %% make the algorithm reapplicable. This is however not necessary + %% since there are no destructive variable assignments in Erlang. + c_var(Name). + +%% Including the effort counter of the call site assures that the cost +%% of processing an operand via `visit' is charged to the correct +%% counter. In particular, if the effort counter of the call site was +%% passive, the operands will also be processed with a passive counter. + +make_opnd(E, Ren, Env, S) -> + {L, S1} = st__new_opnd_loc(S), + C = st__get_effort(S1), + Opnd = #opnd{expr = E, ren = Ren, env = Env, loc = L, effort = C}, + {Opnd, S1}. + +keep_referenced(Rs, S) -> + [R || R <- Rs, st__get_var_referenced(R#ref.loc, S)]. + +residualize_operands(Opnds, E, S) -> + foldr(fun (Opnd, {E, S}) -> residualize_operand(Opnd, E, S) end, + {E, S}, Opnds). + +%% This is the only case where an operand expression can be visited in +%% `effect' context instead of `value' context. + +residualize_operand(Opnd, E, S) -> + case st__get_opnd_effect(Opnd#opnd.loc, S) of + true -> + %% The operand has not been visited, so we do that now, but + %% in `effect' context. (Waddell's algoritm does some stuff + %% here to account specially for the operand size, which + %% appears unnecessary.) + {E1, S1} = i(Opnd#opnd.expr, effect, Opnd#opnd.ren, + Opnd#opnd.env, S), + {make_seq(E1, E), S1}; + false -> + {E, S} + end. + +%% The `visit' function always visits the operand expression in `value' +%% context (`residualize_operand' visits an unreferenced operand +%% expression in `effect' context when necessary). A new passive size +%% counter is used for visiting the operand, the final value of which is +%% then cached along with the resulting expression. +%% +%% Note that the effort counter of the call site, included in the +%% operand structure, is not a shared object. Thus, the effort budget is +%% actually reused over all occurrences of the operands of a single +%% application. This does not appear to be a problem; just a +%% modification of the algorithm. + +visit(Opnd, S) -> + {C, S1} = visit_1(Opnd, S), + {C#cache.expr, S1}. + +visit_and_count_size(Opnd, S) -> + {C, S1} = visit_1(Opnd, S), + {C#cache.expr, count_size(C#cache.size, S1)}. + +visit_1(Opnd, S) -> + case st__lookup_opnd_cache(Opnd#opnd.loc, S) of + error -> + %% Use a new, passive, size counter for visiting operands, + %% and use the effort counter of the context of the operand. + %% It turns out that if the latter is active, it must be the + %% same object as the one currently used, and if it is + %% passive, it does not matter if it is the same object as + %% any other counter. + Effort = Opnd#opnd.effort, + Active = counter__is_active(Effort), + S1 = case Active of + true -> + S; % don't change effort counter + false -> + st__set_effort(Effort, S) + end, + S2 = new_passive_size(get_size_limit(S1), S1), + + %% Visit the expression and cache the result, along with the + %% final value of the size counter. + {E, S3} = i(Opnd#opnd.expr, value, Opnd#opnd.ren, + Opnd#opnd.env, S2), + Size = get_size_value(S3), + C = #cache{expr = E, size = Size}, + S4 = revert_size(S, st__set_opnd_cache(Opnd#opnd.loc, C, + S3)), + case Active of + true -> + {C, S4}; % keep using the same effort counter + false -> + {C, revert_effort(S, S4)} + end; + {ok, C} -> + {C, S} + end. + +%% Create a pattern matching template for an expression. A template +%% contains only data constructors (including atomic ones) and +%% variables, and compound literals are not folded into a single node. +%% Each node in the template is annotated with the variable which holds +%% the corresponding subexpression; these are new, unique variables not +%% existing in the given `Env'. Returns `{Template, Variables, NewEnv}', +%% where `Variables' is the list of all variables corresponding to nodes +%% in the template *listed in reverse dependency order*, and `NewEnv' is +%% `Env' augmented with mappings from the variable names to +%% subexpressions of `E' (not #ref{} structures!) rewritten so that no +%% computations are duplicated. `Variables' is guaranteed to be nonempty +%% - at least the root node will always be bound to a new variable. + +make_template(E, Env) -> + make_template(E, [], Env). + +make_template(E, Vs0, Env0) -> + case is_data(E) of + true -> + {Ts, {Vs1, Env1}} = mapfoldl( + fun (E, {Vs0, Env0}) -> + {T, Vs1, Env1} = + make_template(E, Vs0, + Env0), + {T, {Vs1, Env1}} + end, + {Vs0, Env0}, data_es(E)), + 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), + Env2 = env__bind(var_name(V), E1, Env1), + {set_ann(T, [V]), [V | Vs1], Env2}; + false -> + case type(E) of + seq -> + %% For a sequencing, we can rebind the variable used + %% for the body, and pass on the template as it is. + {T, Vs1, Env1} = make_template(seq_body(E), Vs0, + Env0), + V = var_name(hd(get_ann(T))), + E1 = update_c_seq(E, seq_arg(E), env__get(V, Env1)), + Env2 = env__bind(V, E1, Env1), + {T, Vs1, Env2}; + _ -> + V = new_var(Env0), + Env1 = env__bind(var_name(V), E, Env0), + {set_ann(V, [V]), [V | Vs0], Env1} + end + end. + +%% Two clauses are equivalent if their bodies are equivalent expressions +%% given that the respective pattern variables are local. + +equivalent_clauses([]) -> + true; +equivalent_clauses([C | Cs]) -> + Env = cerl_trees:variables(c_values(clause_pats(C))), + equivalent_clauses_1(clause_body(C), Cs, Env). + +equivalent_clauses_1(E, [C | Cs], Env) -> + Env1 = cerl_trees:variables(c_values(clause_pats(C))), + case equivalent(E, clause_body(C), ordsets:union(Env, Env1)) of + true -> + equivalent_clauses_1(E, Cs, Env); + false -> + false + end; +equivalent_clauses_1(_, [], _Env) -> + true. + +%% Two expressions are equivalent if and only if they yield the same +%% value and has the same side effects in the same order. Currently, we +%% only accept equality between constructors (constants) and nonlocal +%% variables, since this should cover most cases of interest. If a +%% variable is locally bound in one expression, it cannot be equivalent +%% to one with the same name in the other expression, so we need not +%% keep track of two environments. + +equivalent(E1, E2, Env) -> + case is_data(E1) of + true -> + case is_data(E2) of + true -> + T1 = {data_type(E1), data_arity(E1)}, + T2 = {data_type(E2), data_arity(E2)}, + %% Note that we must test for exact equality. + T1 =:= T2 andalso + equivalent_lists(data_es(E1), data_es(E2), Env); + false -> + false + end; + false -> + case type(E1) of + var -> + case is_c_var(E2) of + true -> + N1 = var_name(E1), + N2 = var_name(E2), + N1 =:= N2 andalso not ordsets:is_element(N1, Env); + false -> + false + end; + _ -> + %% Other constructs are not being considered. + false + end + end. + +equivalent_lists([E1 | Es1], [E2 | Es2], Env) -> + equivalent(E1, E2, Env) and equivalent_lists(Es1, Es2, Env); +equivalent_lists([], [], _) -> + true; +equivalent_lists(_, _, _) -> + false. + +%% Return `false' or `{true, EffectExpr, ValueExpr}'. The environment is +%% passed for new-variable generation. + +reduce_bif_call(M, F, As, Env) -> + reduce_bif_call_1(M, F, length(As), As, Env). + +reduce_bif_call_1(erlang, element, 2, [X, Y], _Env) -> + case is_c_int(X) and is_c_tuple(Y) of + true -> + %% We are free to change the relative evaluation order of + %% the elements, so lifting out a particular element is OK. + T = list_to_tuple(tuple_es(Y)), + N = int_val(X), + if is_integer(N), N > 0, N =< tuple_size(T) -> + E = element(N, T), + Es = tuple_to_list(setelement(N, T, void())), + {true, make_seq(c_tuple(Es), E)}; + true -> + false + end; + false -> + false + end; +reduce_bif_call_1(erlang, hd, 1, [X], _Env) -> + case is_c_cons(X) of + true -> + %% Cf. `element/2' above. + {true, make_seq(cons_tl(X), cons_hd(X))}; + false -> + false + end; +reduce_bif_call_1(erlang, length, 1, [X], _Env) -> + case is_c_list(X) of + true -> + %% Cf. `erlang:size/1' below. + {true, make_seq(X, c_int(list_length(X)))}; + false -> + false + end; +reduce_bif_call_1(erlang, list_to_tuple, 1, [X], _Env) -> + case is_c_list(X) of + true -> + %% This does not actually preserve all the evaluation order + %% constraints of the list, but I don't imagine that it will + %% be a problem. + {true, c_tuple(list_elements(X))}; + false -> + false + end; +reduce_bif_call_1(erlang, setelement, 3, [X, Y, Z], Env) -> + case is_c_int(X) and is_c_tuple(Y) of + true -> + %% Here, unless `Z' is a simple expression, we must bind it + %% to a new variable, because in that case, `Z' must be + %% evaluated before any part of `Y'. + T = list_to_tuple(tuple_es(Y)), + N = int_val(X), + if is_integer(N), N > 0, N =< tuple_size(T) -> + E = element(N, T), + case is_simple(Z) of + true -> + Es = tuple_to_list(setelement(N, T, Z)), + {true, make_seq(E, c_tuple(Es))}; + false -> + V = new_var(Env), + Es = tuple_to_list(setelement(N, T, V)), + E1 = make_seq(E, c_tuple(Es)), + {true, c_let([V], Z, E1)} + end; + true -> + false + end; + false -> + false + end; +reduce_bif_call_1(erlang, size, 1, [X], Env) -> + case is_c_tuple(X) of + true -> + reduce_bif_call_1(erlang, tuple_size, 1, [X], Env); + false -> + false + end; +reduce_bif_call_1(erlang, tl, 1, [X], _Env) -> + case is_c_cons(X) of + true -> + %% Cf. `element/2' above. + {true, make_seq(cons_hd(X), cons_tl(X))}; + false -> + false + end; +reduce_bif_call_1(erlang, tuple_size, 1, [X], _Env) -> + case is_c_tuple(X) of + true -> + %% Just evaluate the tuple for effect and use the size (the + %% arity) as the result. + {true, make_seq(X, c_int(tuple_arity(X)))}; + false -> + false + end; +reduce_bif_call_1(erlang, tuple_to_list, 1, [X], _Env) -> + case is_c_tuple(X) of + true -> + %% This actually introduces slightly stronger constraints on + %% the evaluation order of the subexpressions. + {true, make_list(tuple_es(X))}; + false -> + false + end; +reduce_bif_call_1(_M, _F, _A, _As, _Env) -> + false. + +effort_is_active(S) -> + counter__is_active(st__get_effort(S)). + +size_is_active(S) -> + counter__is_active(st__get_size(S)). + +get_effort_limit(S) -> + counter__limit(st__get_effort(S)). + +new_active_effort(Limit, S) -> + st__set_effort(counter__new_active(Limit), S). + +revert_effort(S1, S2) -> + st__set_effort(st__get_effort(S1), S2). + +new_active_size(Limit, S) -> + st__set_size(counter__new_active(Limit), S). + +new_passive_size(Limit, S) -> + st__set_size(counter__new_passive(Limit), S). + +revert_size(S1, S2) -> + st__set_size(st__get_size(S1), S2). + +count_effort(N, S) -> + C = st__get_effort(S), + C1 = counter__add(N, C, effort, S), + case debug_counters() of + %% true -> + %% case counter__is_active(C1) of + %% true -> + %% V = counter__value(C1), + %% case V > get(counter_effort_max) of + %% true -> + %% put(counter_effort_max, V); + %% false -> + %% ok + %% end; + %% false -> + %% ok + %% end; + false -> + ok + end, + st__set_effort(C1, S). + +count_size(N, S) -> + C = st__get_size(S), + C1 = counter__add(N, C, size, S), + case debug_counters() of + %% true -> + %% case counter__is_active(C1) of + %% true -> + %% V = counter__value(C1), + %% case V > get(counter_size_max) of + %% true -> + %% put(counter_size_max, V); + %% false -> + %% ok + %% end; + %% false -> + %% ok + %% end; + false -> + ok + end, + st__set_size(C1, S). + +get_size_value(S) -> + counter__value(st__get_size(S)). + +get_size_limit(S) -> + counter__limit(st__get_size(S)). + +kill_id_anns([{'id',_} | As]) -> + kill_id_anns(As); +kill_id_anns([A | As]) -> + [A | kill_id_anns(As)]; +kill_id_anns([]) -> + []. + + +%% ===================================================================== +%% General utilities + +%% The atom `ok', is widely used in Erlang for "void" values. + +void() -> abstract(ok). + +is_simple(E) -> + case type(E) of + literal -> true; + var -> true; + 'fun' -> true; + _ -> false + end. + +get_components(N, E) -> + case type(E) of + values -> + Es = values_es(E), + if length(Es) =:= N -> + {true, Es}; + true -> + false + end; + _ when N =:= 1 -> + {true, [E]}; + _ -> + false + end. + +all_static(Es) -> + lists:all(fun (E) -> is_literal(result(E)) end, Es). + +set_clause_bodies([C | Cs], B) -> + [update_c_clause(C, clause_pats(C), clause_guard(C), B) + | set_clause_bodies(Cs, B)]; +set_clause_bodies([], _) -> + []. + +%% ===================================================================== +%% Abstract datatype: renaming() + +ren__identity() -> + dict:new(). + +ren__add(X, Y, Ren) -> + dict:store(X, Y, Ren). + +ren__map(X, Ren) -> + case dict:find(X, Ren) of + {ok, Y} -> + Y; + error -> + X + end. + +ren__add_identity(X, Ren) -> + dict:erase(X, Ren). + + +%% ===================================================================== +%% Abstract datatype: environment() + +env__empty() -> + rec_env:empty(). + +env__bind(Key, Val, Env) -> + rec_env:bind(Key, Val, Env). + +%% `Es' should have type `[{Key, Val}]', and `Fun' should have type +%% `(Val, Env) -> T', mapping a value together with the recursive +%% environment itself to some term `T' to be returned when the entry is +%% looked up. + +env__bind_recursive(Ks, Vs, F, Env) -> + rec_env:bind_recursive(Ks, Vs, F, Env). + +env__lookup(Key, Env) -> + rec_env:lookup(Key, Env). + +env__get(Key, Env) -> + rec_env:get(Key, Env). + +env__is_defined(Key, Env) -> + rec_env:is_defined(Key, Env). + +env__new_vname(Env) -> + rec_env:new_key(Env). + +env__new_fname(A, N, Env) -> + rec_env:new_key(fun (X) -> + S = integer_to_list(X), + {list_to_atom(atom_to_list(A) ++ "_" ++ S), + N} + end, Env). + + +%% ===================================================================== +%% Abstract datatype: state() + +-record(state, {free, % next free location + size, % size counter + effort, % effort counter + unroll, % inner/outer-pending initial value + cache, % operand expression cache + var_flags, % flags for variables (#ref-structures) + opnd_flags, % flags for operands + app_flags}). % flags for #app-structures + +%% Note that we do not have a `var_assigned' flag, since there is no +%% destructive assignment in Erlang. In the original algorithm, the +%% "residual-referenced"-flags of the previous inlining pass (or +%% initialization pass) are used as the "source-referenced"-flags for +%% the subsequent pass. The latter may then be used as a safe +%% approximation whenever we need to base a decision on whether or not a +%% particular variable or function variable could be referenced in the +%% program being generated, and computation of the new +%% "residual-referenced" flag for that variable is not yet finished. In +%% the present algorithm, this can only happen in the presence of +%% variable assignments, which do not exist in Erlang. Therefore, we do +%% not keep "source-referenced" flags for residual-code references in +%% our implementation. +%% +%% The "inner-pending" flag tells us whether we are already in the +%% process of visiting a particular operand, and the "outer-pending" +%% flag whether we are in the process of inlining a propagated +%% functional value. The "pending flags" are really counters limiting +%% the number of times an operand may be inlined recursively, causing +%% loop unrolling. Note that the initial value must be greater than zero +%% in order for any inlining at all to be done. + +%% Flags are stored in ETS-tables, one table for each class. The second +%% element in each stored tuple is the key (the "label"). + +-record(var_flags, {lab, referenced = false}). +-record(opnd_flags, {lab, inner_pending = 1, outer_pending = 1, + effect = false}). +-record(app_flags, {lab, inlined = false}). + +st__new(Effort, Size, Unroll) -> + EtsOpts = [set, private, {keypos, 2}], + #state{free = 0, + size = counter__new_passive(Size), + effort = counter__new_passive(Effort), + unroll = Unroll, + cache = dict:new(), + var_flags = ets:new(var, EtsOpts), + opnd_flags = ets:new(opnd, EtsOpts), + app_flags = ets:new(app, EtsOpts)}. + +st__new_loc(S) -> + N = S#state.free, + {N, S#state{free = N + 1}}. + +st__get_effort(S) -> + S#state.effort. + +st__set_effort(C, S) -> + S#state{effort = C}. + +st__get_size(S) -> + S#state.size. + +st__set_size(C, S) -> + S#state{size = C}. + +st__set_var_referenced(L, S) -> + T = S#state.var_flags, + [F] = ets:lookup(T, L), + ets:insert(T, F#var_flags{referenced = true}), + S. + +st__get_var_referenced(L, S) -> + ets:lookup_element(S#state.var_flags, L, #var_flags.referenced). + +st__lookup_opnd_cache(L, S) -> + dict:find(L, S#state.cache). + +%% Note that setting the cache should only be done once. + +st__set_opnd_cache(L, C, S) -> + S#state{cache = dict:store(L, C, S#state.cache)}. + +st__set_opnd_effect(L, S) -> + T = S#state.opnd_flags, + [F] = ets:lookup(T, L), + ets:insert(T, F#opnd_flags{effect = true}), + S. + +st__get_opnd_effect(L, S) -> + ets:lookup_element(S#state.opnd_flags, L, #opnd_flags.effect). + +st__set_app_inlined(L, S) -> + T = S#state.app_flags, + [F] = ets:lookup(T, L), + ets:insert(T, F#app_flags{inlined = true}), + S. + +st__clear_app_inlined(L, S) -> + T = S#state.app_flags, + [F] = ets:lookup(T, L), + ets:insert(T, F#app_flags{inlined = false}), + S. + +st__get_app_inlined(L, S) -> + ets:lookup_element(S#state.app_flags, L, #app_flags.inlined). + +%% The pending-flags are initialized by `st__new_opnd_loc' below. + +st__test_inner_pending(L, S) -> + T = S#state.opnd_flags, + P = ets:lookup_element(T, L, #opnd_flags.inner_pending), + P =< 0. + +st__mark_inner_pending(L, S) -> + ets:update_counter(S#state.opnd_flags, L, + {#opnd_flags.inner_pending, -1}), + S. + +st__clear_inner_pending(L, S) -> + ets:update_counter(S#state.opnd_flags, L, + {#opnd_flags.inner_pending, 1}), + S. + +st__test_outer_pending(L, S) -> + T = S#state.opnd_flags, + P = ets:lookup_element(T, L, #opnd_flags.outer_pending), + P =< 0. + +st__mark_outer_pending(L, S) -> + ets:update_counter(S#state.opnd_flags, L, + {#opnd_flags.outer_pending, -1}), + S. + +st__clear_outer_pending(L, S) -> + ets:update_counter(S#state.opnd_flags, L, + {#opnd_flags.outer_pending, 1}), + S. + +st__new_app_loc(S) -> + V = {L, _S1} = st__new_loc(S), + ets:insert(S#state.app_flags, #app_flags{lab = L}), + V. + +st__new_ref_loc(S) -> + V = {L, _S1} = st__new_loc(S), + ets:insert(S#state.var_flags, #var_flags{lab = L}), + V. + +st__new_opnd_loc(S) -> + V = {L, _S1} = st__new_loc(S), + N = S#state.unroll, + ets:insert(S#state.opnd_flags, + #opnd_flags{lab = L, + inner_pending = N, + outer_pending = N}), + V. + + +%% ===================================================================== +%% Abstract datatype: counter() +%% +%% `counter__add' throws `{counter_exceeded, Type, Data}' if the +%% resulting counter value would exceed the limit for the counter in +%% question (`Type' and `Data' are given by the user). + +counter__new_passive(Limit) when Limit > 0 -> + {0, Limit}. + +counter__new_active(Limit) when Limit > 0 -> + {Limit, Limit}. + +%% Active counters have values > 0 internally; passive counters start at +%% zero. The 'limit' field is only accessed by the 'counter__limit' +%% function. + +counter__is_active({C, _}) -> + C > 0. + +counter__limit({_, L}) -> + L. + +counter__value({N, L}) -> + if N > 0 -> + L - N; + true -> + -N + end. + +counter__add(N, {V, L}, Type, Data) -> + N1 = V - N, + if V > 0, N1 =< 0 -> + case debug_counters() of + %% true -> + %% case Type of + %% effort -> + %% put(counter_effort_triggers, + %% get(counter_effort_triggers) + 1); + %% size -> + %% put(counter_size_triggers, + %% get(counter_size_triggers) + 1) + %% end; + false -> + ok + end, + throw({counter_exceeded, Type, Data}); + true -> + {N1, L} + end. + + +%% ===================================================================== +%% Reporting + +% report_internal_error(S) -> +% report_internal_error(S, []). + +report_internal_error(S, Vs) -> + report_error("internal error: " ++ S, Vs). + +%% report_error(D) -> +%% report_error(D, []). + +report_error(D, Vs) -> + report({error, D}, Vs). + +report_warning(D) -> + report_warning(D, []). + +report_warning(D, Vs) -> + report({warning, D}, Vs). + +report(D, Vs) -> + io:put_chars(format(D, Vs)). + +format({error, D}, Vs) -> + ["error: ", format(D, Vs)]; +format({warning, D}, Vs) -> + ["warning: ", format(D, Vs)]; +format(S, Vs) when is_list(S) -> + [io_lib:fwrite(S, Vs), $\n]. + + +%% ===================================================================== |