aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe/cerl/cerl_lib.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/hipe/cerl/cerl_lib.erl')
-rw-r--r--lib/hipe/cerl/cerl_lib.erl462
1 files changed, 462 insertions, 0 deletions
diff --git a/lib/hipe/cerl/cerl_lib.erl b/lib/hipe/cerl/cerl_lib.erl
new file mode 100644
index 0000000000..83bb20e047
--- /dev/null
+++ b/lib/hipe/cerl/cerl_lib.erl
@@ -0,0 +1,462 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2004-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%
+%%
+
+%% @doc Utility functions for Core Erlang abstract syntax trees.
+%%
+%% <p>Syntax trees are defined in the module <a
+%% href=""><code>cerl</code></a>.</p>
+%%
+%% @type cerl() = cerl:cerl()
+
+-module(cerl_lib).
+
+-define(NO_UNUSED, true).
+
+-export([is_safe_expr/2, reduce_expr/1, is_simple_clause/1,
+ is_bool_switch/1, bool_switch_cases/1]).
+-ifndef(NO_UNUSED).
+-export([is_safe_expr/1, is_pure_expr/1, is_pure_expr/2,
+ make_bool_switch/3]).
+-endif.
+
+
+%% Test if a clause has a single pattern and an always-true guard.
+
+-spec is_simple_clause(cerl:c_clause()) -> boolean().
+
+is_simple_clause(C) ->
+ case cerl:clause_pats(C) of
+ [_P] ->
+ G = cerl:clause_guard(C),
+ case cerl_clauses:eval_guard(G) of
+ {value, true} -> true;
+ _ -> false
+ end;
+ _ -> false
+ end.
+
+%% Creating an if-then-else construct that can be recognized as such.
+%% `Test' *must* be guaranteed to return a boolean.
+
+-ifndef(NO_UNUSED).
+make_bool_switch(Test, True, False) ->
+ Cs = [cerl:c_clause([cerl:c_atom(true)], True),
+ cerl:c_clause([cerl:c_atom(false)], False)],
+ cerl:c_case(Test, Cs).
+-endif.
+
+%% A boolean switch cannot have a catch-all; only true/false branches.
+
+-spec is_bool_switch([cerl:c_clause()]) -> boolean().
+
+is_bool_switch([C1, C2]) ->
+ case is_simple_clause(C1) andalso is_simple_clause(C2) of
+ true ->
+ [P1] = cerl:clause_pats(C1),
+ [P2] = cerl:clause_pats(C2),
+ case cerl:is_c_atom(P1) andalso cerl:is_c_atom(P2) of
+ true ->
+ A1 = cerl:concrete(P1),
+ A2 = cerl:concrete(P2),
+ is_boolean(A1) andalso is_boolean(A2)
+ andalso A1 =/= A2;
+ false ->
+ false
+ end;
+ false ->
+ false
+ end;
+is_bool_switch(_) ->
+ false.
+
+%% Returns the true-body and the false-body for boolean switch clauses.
+
+-spec bool_switch_cases([cerl:c_clause()]) -> {cerl:cerl(), cerl:cerl()}.
+
+bool_switch_cases([C1, C2]) ->
+ B1 = cerl:clause_body(C1),
+ B2 = cerl:clause_body(C2),
+ [P1] = cerl:clause_pats(C1),
+ case cerl:concrete(P1) of
+ true ->
+ {B1, B2};
+ false ->
+ {B2, B1}
+ end.
+
+%%
+%% The type of the check functions like the default check below - XXX: refine
+%%
+-type check_fun() :: fun((_, _) -> boolean()).
+
+%% The default function property check always returns `false':
+
+default_check(_Property, _Function) -> false.
+
+
+%% @spec is_safe_expr(Expr::cerl()) -> boolean()
+%%
+%% @doc Returns `true' if `Expr' represents a "safe" Core Erlang
+%% expression, otherwise `false'. An expression is safe if it always
+%% completes normally and does not modify the state (although the return
+%% value may depend on the state).
+%%
+%% Expressions of type `apply', `case', `receive' and `binary' are
+%% always considered unsafe by this function.
+
+%% TODO: update cerl_inline to use these functions instead.
+
+-ifndef(NO_UNUSED).
+is_safe_expr(E) ->
+ Check = fun default_check/2,
+ is_safe_expr(E, Check).
+-endif.
+%% @clear
+
+-spec is_safe_expr(cerl:cerl(), check_fun()) -> boolean().
+
+is_safe_expr(E, Check) ->
+ case cerl:type(E) of
+ literal ->
+ true;
+ var ->
+ true;
+ 'fun' ->
+ true;
+ values ->
+ is_safe_expr_list(cerl:values_es(E), Check);
+ tuple ->
+ is_safe_expr_list(cerl:tuple_es(E), Check);
+ cons ->
+ case is_safe_expr(cerl:cons_hd(E), Check) of
+ true ->
+ is_safe_expr(cerl:cons_tl(E), Check);
+ false ->
+ false
+ end;
+ 'let' ->
+ case is_safe_expr(cerl:let_arg(E), Check) of
+ true ->
+ is_safe_expr(cerl:let_body(E), Check);
+ false ->
+ false
+ end;
+ letrec ->
+ is_safe_expr(cerl:letrec_body(E), Check);
+ seq ->
+ case is_safe_expr(cerl:seq_arg(E), Check) of
+ true ->
+ is_safe_expr(cerl:seq_body(E), Check);
+ false ->
+ false
+ end;
+ 'catch' ->
+ is_safe_expr(cerl:catch_body(E), Check);
+ 'try' ->
+ %% If the guarded expression is safe, the try-handler will
+ %% never be evaluated, so we need only check the body. If
+ %% the guarded expression is pure, but could fail, we also
+ %% have to check the handler.
+ case is_safe_expr(cerl:try_arg(E), Check) of
+ true ->
+ is_safe_expr(cerl:try_body(E), Check);
+ false ->
+ case is_pure_expr(cerl:try_arg(E), Check) of
+ true ->
+ case is_safe_expr(cerl:try_body(E), Check) of
+ true ->
+ is_safe_expr(cerl:try_handler(E), Check);
+ false ->
+ false
+ end;
+ false ->
+ false
+ end
+ end;
+ primop ->
+ Name = cerl:atom_val(cerl:primop_name(E)),
+ As = cerl:primop_args(E),
+ case Check(safe, {Name, length(As)}) of
+ true ->
+ is_safe_expr_list(As, Check);
+ false ->
+ false
+ end;
+ call ->
+ Module = cerl:call_module(E),
+ Name = cerl:call_name(E),
+ case cerl:is_c_atom(Module) and cerl:is_c_atom(Name) of
+ true ->
+ M = cerl:atom_val(Module),
+ F = cerl:atom_val(Name),
+ As = cerl:call_args(E),
+ case Check(safe, {M, F, length(As)}) of
+ true ->
+ is_safe_expr_list(As, Check);
+ false ->
+ false
+ end;
+ false ->
+ false % Call to unknown function
+ end;
+ _ ->
+ false
+ end.
+
+is_safe_expr_list([E | Es], Check) ->
+ case is_safe_expr(E, Check) of
+ true ->
+ is_safe_expr_list(Es, Check);
+ false ->
+ false
+ end;
+is_safe_expr_list([], _Check) ->
+ true.
+
+
+%% @spec (Expr::cerl()) -> bool()
+%%
+%% @doc Returns `true' if `Expr' represents a "pure" Core Erlang
+%% expression, otherwise `false'. An expression is pure if it does not
+%% affect the state, nor depend on the state, although its evaluation is
+%% not guaranteed to complete normally for all input.
+%%
+%% Expressions of type `apply', `case', `receive' and `binary' are
+%% always considered impure by this function.
+
+-ifndef(NO_UNUSED).
+is_pure_expr(E) ->
+ Check = fun default_check/2,
+ is_pure_expr(E, Check).
+-endif.
+%% @clear
+
+is_pure_expr(E, Check) ->
+ case cerl:type(E) of
+ literal ->
+ true;
+ var ->
+ true;
+ 'fun' ->
+ true;
+ values ->
+ is_pure_expr_list(cerl:values_es(E), Check);
+ tuple ->
+ is_pure_expr_list(cerl:tuple_es(E), Check);
+ cons ->
+ case is_pure_expr(cerl:cons_hd(E), Check) of
+ true ->
+ is_pure_expr(cerl:cons_tl(E), Check);
+ false ->
+ false
+ end;
+ 'let' ->
+ case is_pure_expr(cerl:let_arg(E), Check) of
+ true ->
+ is_pure_expr(cerl:let_body(E), Check);
+ false ->
+ false
+ end;
+ letrec ->
+ is_pure_expr(cerl:letrec_body(E), Check);
+ seq ->
+ case is_pure_expr(cerl:seq_arg(E), Check) of
+ true ->
+ is_pure_expr(cerl:seq_body(E), Check);
+ false ->
+ false
+ end;
+ 'catch' ->
+ is_pure_expr(cerl:catch_body(E), Check);
+ 'try' ->
+ case is_pure_expr(cerl:try_arg(E), Check) of
+ true ->
+ case is_pure_expr(cerl:try_body(E), Check) of
+ true ->
+ is_pure_expr(cerl:try_handler(E), Check);
+ false ->
+ false
+ end;
+ false ->
+ false
+ end;
+ primop ->
+ Name = cerl:atom_val(cerl:primop_name(E)),
+ As = cerl:primop_args(E),
+ case Check(pure, {Name, length(As)}) of
+ true ->
+ is_pure_expr_list(As, Check);
+ false ->
+ false
+ end;
+ call ->
+ Module = cerl:call_module(E),
+ Name = cerl:call_name(E),
+ case cerl:is_c_atom(Module) and cerl:is_c_atom(Name) of
+ true ->
+ M = cerl:atom_val(Module),
+ F = cerl:atom_val(Name),
+ As = cerl:call_args(E),
+ case Check(pure, {M, F, length(As)}) of
+ true ->
+ is_pure_expr_list(As, Check);
+ false ->
+ false
+ end;
+ false ->
+ false % Call to unknown function
+ end;
+ _ ->
+ false
+ end.
+
+is_pure_expr_list([E | Es], Check) ->
+ case is_pure_expr(E, Check) of
+ true ->
+ is_pure_expr_list(Es, Check);
+ false ->
+ false
+ end;
+is_pure_expr_list([], _Check) ->
+ true.
+
+
+%% Peephole optimizations
+%%
+%% This is only intended to be a light-weight cleanup optimizer,
+%% removing small things that may e.g. have been generated by other
+%% optimization passes or in the translation from higher-level code.
+%% It is not recursive in general - it only descends until it can do no
+%% more work in the current context.
+%%
+%% To expose hidden cases of final expressions (enabling last call
+%% optimization), we try to remove all trivial let-bindings (`let X = Y
+%% in X', `let X = Y in Y', `let X = Y in let ... in ...', `let X = let
+%% ... in ... in ...', etc.). We do not, however, try to recognize any
+%% other similar cases, even for simple `case'-expressions like `case E
+%% of X -> X end', or simultaneous multiple-value bindings.
+
+-spec reduce_expr(cerl:cerl()) -> cerl:cerl().
+
+reduce_expr(E) ->
+ Check = fun default_check/2,
+ reduce_expr(E, Check).
+
+-spec reduce_expr(cerl:cerl(), check_fun()) -> cerl:cerl().
+
+reduce_expr(E, Check) ->
+ case cerl:type(E) of
+ values ->
+ case cerl:values_es(E) of
+ [E1] ->
+ %% Not really an "optimization" in itself, but
+ %% enables other rewritings by removing the wrapper.
+ reduce_expr(E1, Check);
+ _ ->
+ E
+ end;
+ 'seq' ->
+ A = reduce_expr(cerl:seq_arg(E), Check),
+ B = reduce_expr(cerl:seq_body(E), Check),
+ %% `do <E1> <E2>' is equivalent to `<E2>' if `<E1>' is
+ %% "safe" (cannot effect the behaviour in any way).
+ case is_safe_expr(A, Check) of
+ true ->
+ B;
+ false ->
+ case cerl:is_c_seq(B) of
+ true ->
+ %% Rewrite `do <E1> do <E2> <E3>' to `do do
+ %% <E1> <E2> <E3>' so that the "body" of the
+ %% outermost seq-operator is the expression
+ %% which produces the final result (i.e.,
+ %% E3). This can make other optimizations
+ %% easier; see `let'.
+ B1 = cerl:seq_arg(B),
+ B2 = cerl:seq_body(B),
+ cerl:c_seq(cerl:c_seq(A, B1), B2);
+ false ->
+ cerl:c_seq(A, B)
+ end
+ end;
+ 'let' ->
+ A = reduce_expr(cerl:let_arg(E), Check),
+ case cerl:is_c_seq(A) of
+ true ->
+ %% `let X = do <E1> <E2> in Y' is equivalent to `do
+ %% <E1> let X = <E2> in Y'. Note that `<E2>' cannot
+ %% be a seq-operator, due to the `seq' optimization.
+ A1 = cerl:seq_arg(A),
+ A2 = cerl:seq_body(A),
+ E1 = cerl:update_c_let(E, cerl:let_vars(E),
+ A2, cerl:let_body(E)),
+ cerl:c_seq(A1, reduce_expr(E1, Check));
+ false ->
+ B = reduce_expr(cerl:let_body(E), Check),
+ Vs = cerl:let_vars(E),
+ %% We give up if the body does not reduce to a
+ %% single variable. This is not a generic copy
+ %% propagation.
+ case cerl:type(B) of
+ var when length(Vs) =:= 1 ->
+ %% We have `let <V1> = <E> in <V2>':
+ [V] = Vs,
+ N1 = cerl:var_name(V),
+ N2 = cerl:var_name(B),
+ if N1 =:= N2 ->
+ %% `let X = <E> in X' equals `<E>'
+ A;
+ true ->
+ %% `let X = <E> in Y' when X and Y
+ %% are different variables is
+ %% equivalent to `do <E> Y'.
+ reduce_expr(cerl:c_seq(A, B), Check)
+ end;
+ literal ->
+ %% `let X = <E> in T' when T is a literal
+ %% term is equivalent to `do <E> T'.
+ reduce_expr(cerl:c_seq(A, B), Check);
+ _ ->
+ cerl:update_c_let(E, Vs, A, B)
+ end
+ end;
+ 'try' ->
+ %% Get rid of unnecessary try-expressions.
+ A = reduce_expr(cerl:try_arg(E), Check),
+ B = reduce_expr(cerl:try_body(E), Check),
+ case is_safe_expr(A, Check) of
+ true ->
+ B;
+ false ->
+ cerl:update_c_try(E, A, cerl:try_vars(E), B,
+ cerl:try_evars(E),
+ cerl:try_handler(E))
+ end;
+ 'catch' ->
+ %% Just a simpler form of try-expressions.
+ B = reduce_expr(cerl:catch_body(E), Check),
+ case is_safe_expr(B, Check) of
+ true ->
+ B;
+ false ->
+ cerl:update_c_catch(E, B)
+ end;
+ _ ->
+ E
+ end.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-24 09:44:39 +0000