diff options
Diffstat (limited to 'lib/hipe/cerl/cerl_hybrid_transform.erl')
| -rw-r--r-- | lib/hipe/cerl/cerl_hybrid_transform.erl | 153 |
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([], _) -> + []. |