4
%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
4
%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
6
6
%% The contents of this file are subject to the Erlang Public License,
7
7
%% Version 1.1, (the "License"); you may not use this file except in
8
8
%% compliance with the License. You should have received a copy of the
9
9
%% Erlang Public License along with this software. If not, it can be
10
10
%% retrieved online at http://www.erlang.org/.
12
12
%% Software distributed under the License is distributed on an "AS IS"
13
13
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
14
14
%% the License for the specific language governing rights and limitations
15
15
%% under the License.
19
19
%% Purpose : Transform Core Erlang to Kernel Erlang
81
81
-export([module/2,format_error/1]).
83
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,keymember/3]).
83
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,
84
keymember/3,keyfind/3]).
84
85
-import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
86
87
-compile({nowarn_deprecated_function, {erlang,hash,2}}).
126
127
-spec module(cerl:c_module(), [compile:option()]) ->
127
128
{'ok', #k_mdef{}, [warning()]}.
129
module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) ->
130
Lit = case member(no_constant_pool, Options) of
134
St0 = #kern{lit=Lit},
130
module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) ->
131
Kas = attributes(As),
132
Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es),
133
St0 = #kern{lit=dict:new()},
135
134
{Kfs,St} = mapfoldl(fun function/2, St0, Fs),
136
Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es),
137
Kas = map(fun ({#c_literal{val=N},V}) ->
138
{N,core_lib:literal_value(V)} end, As),
139
135
{ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas,
140
136
body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}.
138
attributes([{#c_literal{val=Name},Val}|As]) ->
139
case include_attribute(Name) of
143
[{Name,core_lib:literal_value(Val)}|attributes(As)]
145
attributes([]) -> [].
147
include_attribute(type) -> false;
148
include_attribute(spec) -> false;
149
include_attribute(opaque) -> false;
150
include_attribute(export_type) -> false;
151
include_attribute(_) -> true.
142
153
function({#c_var{name={F,Arity}=FA},Body}, St0) ->
144
155
St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=sets:new()},
240
251
expr(Fun, Sub, St);
241
252
expr(#c_var{anno=A,name=V}, Sub, St) ->
242
253
{#k_var{anno=A,name=get_vsub(V, Sub)},[],St};
243
expr(#c_literal{anno=A,val=Lit}, Sub, #kern{lit=no}=St) ->
244
%% No constant pools for compatibility with a previous version.
245
%% Fully expand the literal.
246
Core = expand_literal(Lit, A),
248
254
expr(#c_literal{}=Lit, Sub, St) ->
249
255
Core = handle_literal(Lit),
250
256
expr(Core, Sub, St);
266
272
expr(#k_atom{}=V, _Sub, St) ->
268
expr(#k_string{}=V, _Sub, St) ->
269
%% Only for compatibility with a previous version.
271
274
expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) ->
272
275
%% Do cons in two steps, first the expressions left to right, then
273
276
%% any remaining literals right to left.
422
425
expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=Cargs0}, Sub, St0) ->
423
Cargs = translate_match_fail(Cargs0, Sub, St0),
426
Cargs = translate_match_fail(Cargs0, Sub, A, St0),
424
427
%% This special case will disappear.
425
428
{Kargs,Ap,St} = atomic_list(Cargs, Sub, St0),
426
429
Ar = length(Cargs),
447
450
%% Handle internal expressions.
448
451
expr(#ireceive_accept{anno=A}, _Sub, St) -> {#k_receive_accept{anno=A},[],St}.
450
%% Translate a function_clause to case_clause if it has been moved into
452
translate_match_fail([#c_tuple{es=[#c_literal{anno=A0,
453
val=function_clause}|As]}]=Args,
457
[{name,{Func0,Arity0}}] ->
458
[{name,{get_fsub(Func0, Arity0, Sub),Arity0}}];
463
{[{name,Same}],Same} ->
464
%% Still in the correct function.
466
{[{name,{F,_}}],F} ->
467
%% Still in the correct function.
470
%% Inlining has probably moved the function_clause into another
471
%% function (where it will not work correctly).
472
%% Rewrite to a case_clause.
453
%% Translate a function_clause exception to a case_clause exception if
454
%% it has been moved into another function. (A function_clause exception
455
%% will not work correctly if it is moved into another function, or
456
%% even if it is invoked not from the top level in the correct function.)
457
translate_match_fail(Args, Sub, Anno, St) ->
459
[#c_tuple{es=[#c_literal{val=function_clause}|As]}] ->
460
translate_match_fail_1(Anno, Args, As, Sub, St);
461
[#c_literal{val=Tuple}] when is_tuple(Tuple) ->
462
%% The inliner may have created a literal out of
463
%% the original #c_tuple{}.
464
case tuple_to_list(Tuple) of
465
[function_clause|As0] ->
466
As = [#c_literal{val=E} || E <- As0],
467
translate_match_fail_1(Anno, Args, As, Sub, St);
472
%% Not a function_clause exception.
476
translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) ->
477
AnnoFunc = case keyfind(function_name, 1, Anno) of
479
none; %Force rewrite.
480
{function_name,{Name,Arity}} ->
481
{get_fsub(Name, Arity, Sub),Arity}
483
case {AnnoFunc,FF} of
485
%% Still in the correct function.
488
%% Still in the correct function.
491
%% Wrong function or no function_name annotation.
493
%% The inliner has copied the match_fail(function_clause)
494
%% primop from another function (or from another instance of
495
%% the current function). match_fail(function_clause) will
496
%% only work at the top level of the function it was originally
497
%% defined in, so we will need to rewrite it to a case_clause.
473
498
[#c_tuple{es=[#c_literal{val=case_clause},#c_tuple{es=As}]}]
475
translate_match_fail(Args, _, _) -> Args.
477
501
%% call_type(Module, Function, Arity) -> call | bif | apply | error.
478
502
%% Classify the call.
980
1004
%% according to type, the order is really irrelevant but tries to be
983
match_con(Us, Cs0, Def, #kern{lit=no}=St) ->
984
%% No constant pool (for compatibility with R11B).
985
%% We must expand literals.
986
Cs = [expand_pat_lit_clause(C, true) || C <- Cs0],
987
match_con_1(Us, Cs, Def, St);
988
1007
match_con(Us, [C], Def, St) ->
989
1008
%% There is only one clause. We can keep literal tuples and
990
1009
%% lists, but we must convert []/integer/float/atom literals
1847
1865
#k_literal{anno=A,val=V};
1848
1868
V when is_tuple(V) ->
1849
1869
#k_literal{anno=A,val=V};
1850
1870
V when is_bitstring(V) ->
1851
1871
#k_literal{anno=A,val=V};
1853
expand_literal(V, A)
1872
V when is_integer(V) ->
1873
#k_int{anno=A,val=V};
1874
V when is_float(V) ->
1875
#k_float{anno=A,val=V};
1876
V when is_atom(V) ->
1877
#k_atom{anno=A,val=V}
1856
%% expand_literal(Literal, Anno) -> CoreTerm | KernelTerm
1857
%% Fully expand the literal. Atomic terms such as integers are directly
1858
%% translated to the Kernel Erlang format, while complex terms are kept
1859
%% in the Core Erlang format (but the content is recursively processed).
1861
expand_literal([H|T]=V, A) when is_integer(H), 0 =< H, H =< 255 ->
1862
case is_print_char_list(T) of
1864
#c_cons{anno=A,hd=#k_int{anno=A,val=H},tl=expand_literal(T, A)};
1866
#k_string{anno=A,val=V}
1868
expand_literal([H|T], A) ->
1869
#c_cons{anno=A,hd=expand_literal(H, A),tl=expand_literal(T, A)};
1870
expand_literal([], A) ->
1872
expand_literal(V, A) when is_tuple(V) ->
1873
#c_tuple{anno=A,es=expand_literal_list(tuple_to_list(V), A)};
1874
expand_literal(V, A) when is_integer(V) ->
1875
#k_int{anno=A,val=V};
1876
expand_literal(V, A) when is_float(V) ->
1877
#k_float{anno=A,val=V};
1878
expand_literal(V, A) when is_atom(V) ->
1879
#k_atom{anno=A,val=V}.
1881
expand_literal_list([H|T], A) ->
1882
[expand_literal(H, A)|expand_literal_list(T, A)];
1883
expand_literal_list([], _) -> [].
1885
is_print_char_list([H|T]) when is_integer(H), 0 =< H, H =< 255 ->
1886
is_print_char_list(T);
1887
is_print_char_list([]) -> true;
1888
is_print_char_list(_) -> false.
1890
1880
make_list(Es) ->
1891
1881
foldr(fun(E, Acc) ->
1892
1882
#c_cons{hd=E,tl=Acc}