~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/compiler/src/v3_kernel.erl

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
1
%%
2
2
%% %CopyrightBegin%
3
 
%% 
4
 
%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
5
 
%% 
 
3
%%
 
4
%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
 
5
%%
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/.
11
 
%% 
 
11
%%
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.
16
 
%% 
 
16
%%
17
17
%% %CopyrightEnd%
18
18
%%
19
19
%% Purpose : Transform Core Erlang to Kernel Erlang
80
80
 
81
81
-export([module/2,format_error/1]).
82
82
 
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]).
85
86
 
86
87
-compile({nowarn_deprecated_function, {erlang,hash,2}}).
126
127
-spec module(cerl:c_module(), [compile:option()]) ->
127
128
        {'ok', #k_mdef{}, [warning()]}.
128
129
 
129
 
module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) ->
130
 
    Lit = case member(no_constant_pool, Options) of
131
 
              true -> no;
132
 
              false -> dict:new()
133
 
          end,
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)}.
141
137
 
 
138
attributes([{#c_literal{val=Name},Val}|As]) ->
 
139
    case include_attribute(Name) of
 
140
        false ->
 
141
            attributes(As);
 
142
        true ->
 
143
            [{Name,core_lib:literal_value(Val)}|attributes(As)]
 
144
    end;
 
145
attributes([]) -> [].
 
146
 
 
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.
 
152
 
142
153
function({#c_var{name={F,Arity}=FA},Body}, St0) ->
143
154
    try
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),
247
 
    expr(Core, Sub, St);
248
254
expr(#c_literal{}=Lit, Sub, St) ->
249
255
    Core = handle_literal(Lit),
250
256
    expr(Core, Sub, St);
265
271
    {V,[],St};
266
272
expr(#k_atom{}=V, _Sub, St) ->
267
273
    {V,[],St};
268
 
expr(#k_string{}=V, _Sub, St) ->
269
 
    %% Only for compatibility with a previous version.
270
 
    {V,[],St};
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.
420
423
            {Call,Ap,St}
421
424
    end;
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}.
449
452
 
450
 
%% Translate a function_clause to case_clause if it has been moved into
451
 
%% another function.
452
 
translate_match_fail([#c_tuple{es=[#c_literal{anno=A0,
453
 
                                              val=function_clause}|As]}]=Args,
454
 
                     Sub,
455
 
                     #kern{ff=FF}) ->
456
 
    A = case A0 of
457
 
            [{name,{Func0,Arity0}}] ->
458
 
                [{name,{get_fsub(Func0, Arity0, Sub),Arity0}}];
459
 
            _ ->
460
 
                A0
461
 
        end,
462
 
    case {A,FF} of
463
 
        {[{name,Same}],Same} ->
464
 
            %% Still in the correct function.
465
 
            Args;
466
 
        {[{name,{F,_}}],F} ->
467
 
            %% Still in the correct function.
468
 
            Args;
469
 
        _ ->
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) ->
 
458
    case Args of
 
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);
 
468
                _ ->
 
469
                    Args
 
470
            end;
 
471
        _ ->
 
472
            %% Not a function_clause exception.
 
473
            Args
 
474
    end.
 
475
 
 
476
translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) ->
 
477
    AnnoFunc = case keyfind(function_name, 1, Anno) of
 
478
                   false ->
 
479
                       none;                    %Force rewrite.
 
480
                   {function_name,{Name,Arity}} ->
 
481
                       {get_fsub(Name, Arity, Sub),Arity}
 
482
               end,
 
483
    case {AnnoFunc,FF} of
 
484
        {Same,Same} ->
 
485
            %% Still in the correct function.
 
486
            Args;
 
487
        {{F,_},F} ->
 
488
            %% Still in the correct function.
 
489
            Args;
 
490
        _ ->
 
491
            %% Wrong function or no function_name annotation.
 
492
            %%
 
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}]}]
474
 
    end;
475
 
translate_match_fail(Args, _, _) -> Args.
 
499
    end.
476
500
 
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
981
1005
%%  smart.
982
1006
 
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
1783
1802
lit_vars(#k_float{}) -> [];
1784
1803
lit_vars(#k_atom{}) -> [];
1785
1804
%%lit_vars(#k_char{}) -> [];
1786
 
lit_vars(#k_string{}) -> [];
1787
1805
lit_vars(#k_nil{}) -> [];
1788
1806
lit_vars(#k_cons{hd=H,tl=T}) ->
1789
1807
    union(lit_vars(H), lit_vars(T));
1845
1863
    case V of
1846
1864
        [_|_] ->
1847
1865
            #k_literal{anno=A,val=V};
 
1866
        [] ->
 
1867
            #k_nil{anno=A};
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};
1852
 
        _ ->
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}
1854
1878
    end.
1855
1879
 
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).
1860
 
 
1861
 
expand_literal([H|T]=V, A) when is_integer(H), 0 =< H, H =< 255 ->
1862
 
    case is_print_char_list(T) of
1863
 
        false ->
1864
 
            #c_cons{anno=A,hd=#k_int{anno=A,val=H},tl=expand_literal(T, A)};
1865
 
        true ->
1866
 
            #k_string{anno=A,val=V}
1867
 
    end;
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) ->
1871
 
    #k_nil{anno=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}.
1880
 
 
1881
 
expand_literal_list([H|T], A) ->
1882
 
    [expand_literal(H, A)|expand_literal_list(T, A)];
1883
 
expand_literal_list([], _) -> [].
1884
 
 
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.
1889
 
 
1890
1880
make_list(Es) ->
1891
1881
    foldr(fun(E, Acc) ->
1892
1882
                  #c_cons{hd=E,tl=Acc}