%%
%% %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([], _) ->
[].
