The R13B03 release.OTP_R13B03

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.