aboutsummaryrefslogtreecommitdiffstats
path: root/lib/hipe/cerl/cerl_hybrid_transform.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
committerErlang/OTP <[email protected]>2009-11-20 14:54:40 +0000
commit84adefa331c4159d432d22840663c38f155cd4c1 (patch)
treebff9a9c66adda4df2106dfd0e5c053ab182a12bd /lib/hipe/cerl/cerl_hybrid_transform.erl
downloadotp-84adefa331c4159d432d22840663c38f155cd4c1.tar.gz
otp-84adefa331c4159d432d22840663c38f155cd4c1.tar.bz2
otp-84adefa331c4159d432d22840663c38f155cd4c1.zip
The R13B03 release.OTP_R13B03
Diffstat (limited to 'lib/hipe/cerl/cerl_hybrid_transform.erl')
-rw-r--r--lib/hipe/cerl/cerl_hybrid_transform.erl153
1 files changed, 153 insertions, 0 deletions
diff --git a/lib/hipe/cerl/cerl_hybrid_transform.erl b/lib/hipe/cerl/cerl_hybrid_transform.erl
new file mode 100644
index 0000000000..b248b0ccd0
--- /dev/null
+++ b/lib/hipe/cerl/cerl_hybrid_transform.erl
@@ -0,0 +1,153 @@
+%%
+%% %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%
+%%
+
+-module(cerl_hybrid_transform).
+
+%% Use compile option `{core_transform, cerl_hybrid_transform}' to
+%% insert this as a compilation pass.
+
+-export([transform/2, core_transform/2]).
+
+-spec core_transform(cerl:cerl(), [term()]) -> cerl:cerl().
+
+core_transform(Code, Opts) ->
+ cerl:to_records(transform(cerl:from_records(Code), Opts)).
+
+-spec transform(cerl:cerl(), [term()]) -> cerl:cerl().
+
+transform(Code, _Opts) ->
+ Code0 = cerl_trees:map(fun unfold_literal/1, Code),
+ {Code1, _} = cerl_trees:label(Code0),
+ io:fwrite("Running hybrid heap analysis..."),
+ {T1,_} = statistics(runtime),
+ {Code2, _, Vars} = cerl_messagean:annotate(Code1),
+ {T2,_} = statistics(runtime),
+ io:fwrite("(~w ms), transform...", [T2 - T1]),
+ Code3 = rewrite(Code2, Vars),
+ io:fwrite("done.\n"),
+ cerl_trees:map(fun fold_literal/1, Code3).
+
+unfold_literal(T) ->
+ cerl:unfold_literal(T).
+
+fold_literal(T) ->
+ cerl:fold_literal(T).
+
+%% If escape-annotated:
+%% {...} => hybrid:tuple([...])
+%% [H | T] => hybrid:cons(H, T)
+%%
+%% Wrapper for args to hybrid:cons/hybrid:tuple that may need copying:
+%% hybrid:copy(A)
+
+rewrite(Node, Vars) ->
+ case cerl:type(Node) of
+ tuple ->
+ Es = rewrite_list(cerl:tuple_es(Node), Vars),
+ case is_escaping(Node) of
+ false ->
+ cerl:update_c_tuple(Node, Es);
+ true ->
+ Es1 = wrap(Es, Node, Vars),
+ cerl:update_c_call(Node,
+ cerl:abstract(hybrid),
+ cerl:abstract(tuple),
+ [cerl:make_list(Es1)])
+%%% cerl:update_c_call(Node, cerl:abstract(hybrid),
+%%% cerl:abstract(tuple), Es1)
+ end;
+ cons ->
+ H = rewrite(cerl:cons_hd(Node), Vars),
+ T = rewrite(cerl:cons_tl(Node), Vars),
+ case is_escaping(Node) of
+ false ->
+ cerl:update_c_cons(Node, H, T);
+ true ->
+ Es = wrap([H, T], Node, Vars),
+ cerl:update_c_call(Node,
+ cerl:abstract(hybrid),
+ cerl:abstract(cons),
+ Es)
+ end;
+%%% call ->
+%%% M = rewrite(cerl:call_module(Node)),
+%%% F = rewrite(cerl:call_name(Node)),
+%%% As = rewrite_list(cerl:call_args(Node)),
+%%% case cerl:is_c_atom(M) andalso cerl:is_c_atom(F) of
+%%% true ->
+%%% case {cerl:atom_val(M), cerl:atom_val(F), length(As)} of
+%%% {erlang, '!', 2} ->
+%%% cerl:update_c_call(Node,
+%%% cerl:abstract(hipe_bifs),
+%%% cerl:abstract(send),
+%%% [cerl:make_list(As)]);
+%%% _ ->
+%%% cerl:update_c_call(Node, M, F, As)
+%%% end;
+%%% false ->
+%%% cerl:update_c_call(Node, M, F, As)
+%%% end;
+ clause ->
+ B = rewrite(cerl:clause_body(Node), Vars),
+ cerl:update_c_clause(Node, cerl:clause_pats(Node),
+ cerl:clause_guard(Node), B);
+ primop ->
+ case cerl:atom_val(cerl:primop_name(Node)) of
+ match_fail ->
+ Node;
+ _ ->
+ As = rewrite_list(cerl:primop_args(Node), Vars),
+ cerl:update_c_primop(Node, cerl:primop_name(Node), As)
+ end;
+ _T ->
+ case cerl:subtrees(Node) of
+ [] ->
+ Node;
+ Gs ->
+ cerl:update_tree(Node, [rewrite_list(Ns, Vars)
+ || Ns <- Gs])
+ end
+ end.
+
+rewrite_list([N | Ns], Vars) ->
+ [rewrite(N, Vars) | rewrite_list(Ns, Vars)];
+rewrite_list([], _) ->
+ [].
+
+is_escaping(T) ->
+ lists:member(escapes, cerl:get_ann(T)).
+
+wrap(Es, Node, Vars) ->
+ L = cerl_trees:get_label(Node),
+ Xs = dict:fetch(L, Vars),
+ wrap(Es, Xs).
+
+wrap([E | Es], [{S, _} | Xs]) ->
+ case ordsets:is_element(unsafe, S) of
+%% case cerl:type(E) =/= literal of
+ true ->
+ [cerl:c_call(cerl:abstract(hybrid),
+ cerl:abstract(copy),
+ [E])
+ | wrap(Es, Xs)];
+ false ->
+ [E | wrap(Es, Xs)]
+ end;
+wrap([], _) ->
+ [].