path: root/lib/compiler/src/sys_expand_pmod.erl

%%
%% %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(sys_expand_pmod).

%% Expand function definition forms of parameterized module. We assume
%% all record definitions, imports, queries, etc., have been expanded
%% away. Any calls on the form 'foo(...)' must be calls to local
%% functions. Auto-generated functions (module_info,...) have not yet
%% been added to the function definitions, but are listed in 'defined'
%% and 'exports'. The automatic 'new/N' function is neither added to the
%% definitions nor to the 'exports'/'defines' lists yet.

-export([forms/4]).

-record(pmod, {parameters, exports, defined, predef}).

%% TODO: more abstract handling of predefined/static functions.

forms(Fs0, Ps, Es0, Ds0) ->
    PreDef = [{module_info,0},{module_info,1}],
    forms(Fs0, Ps, Es0, Ds0, PreDef).

forms(Fs0, Ps, Es0, Ds0, PreDef) ->
    St0 = #pmod{parameters=Ps,exports=Es0,defined=Ds0, predef=PreDef},
    {Fs1, St1} = forms(Fs0, St0),
    Es1 = update_function_names(Es0, St1),
    Ds1 = update_function_names(Ds0, St1),
    Fs2 = update_forms(Fs1, St1),
    {Fs2,Es1,Ds1}.

%% This is extremely simplistic for now; all functions get an extra
%% parameter, whether they need it or not, except for static functions.

update_function_names(Es, St) ->
    [update_function_name(E, St) || E <- Es].

update_function_name(E={F,A}, St) when F =/= new ->
    case ordsets:is_element(E, St#pmod.predef) of
	true -> E;
	false -> {F, A + 1}
    end;
update_function_name(E, _St) ->
    E.

update_forms([{function,L,N,A,Cs}|Fs],St) when N =/= new ->
    [{function,L,N,A+1,Cs}|update_forms(Fs,St)];
update_forms([F|Fs],St) ->
    [F|update_forms(Fs,St)];
update_forms([],_St) ->
    [].

%% Process the program forms.

forms([F0|Fs0],St0) ->
    {F1,St1} = form(F0,St0),
    {Fs1,St2} = forms(Fs0,St1),
    {[F1|Fs1],St2};
forms([], St0) ->
    {[], St0}.

%% Only function definitions are of interest here. State is not updated.
form({function,Line,Name0,Arity0,Clauses0},St) when Name0 =/= new ->
    {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0, St),
    {{function,Line,Name,Arity,Clauses},St};
%% Pass anything else through
form(F,St) -> {F,St}.

function(Name, Arity, Clauses0, St) ->
    Clauses1 = clauses(Clauses0,St),
    {Name,Arity,Clauses1}.

clauses([C|Cs],St) ->
    {clause,L,H,G,B} = clause(C,St),
    T = {tuple,L,[{var,L,V} || V <- ['_'|St#pmod.parameters]]},
    [{clause,L,H++[{match,L,T,{var,L,'THIS'}}],G,B}|clauses(Cs,St)];
clauses([],_St) -> [].

clause({clause,Line,H0,G0,B0},St) ->
    H1 = head(H0,St),
    G1 = guard(G0,St),
    B1 = exprs(B0,St),
    {clause,Line,H1,G1,B1}.

head(Ps,St) -> patterns(Ps,St).

patterns([P0|Ps],St) ->
    P1 = pattern(P0,St),
    [P1|patterns(Ps,St)];
patterns([],_St) -> [].

string_to_conses([], _Line, Tail) ->
    Tail;
string_to_conses([E|Rest], Line, Tail) ->
    {cons, Line, {integer, Line, E}, string_to_conses(Rest, Line, Tail)}.

pattern({var,_Line,_V}=Var,_St) -> Var;
pattern({match,Line,L0,R0},St) ->
    L1 = pattern(L0,St),
    R1 = pattern(R0,St),
    {match,Line,L1,R1};
pattern({integer,_Line,_I}=Integer,_St) -> Integer;
pattern({char,_Line,_C}=Char,_St) -> Char;
pattern({float,_Line,_F}=Float,_St) -> Float;
pattern({atom,_Line,_A}=Atom,_St) -> Atom;
pattern({string,_Line,_S}=String,_St) -> String;
pattern({nil,_Line}=Nil,_St) -> Nil;
pattern({cons,Line,H0,T0},St) ->
    H1 = pattern(H0,St),
    T1 = pattern(T0,St),
    {cons,Line,H1,T1};
pattern({tuple,Line,Ps0},St) ->
    Ps1 = pattern_list(Ps0,St),
    {tuple,Line,Ps1};
pattern({bin,Line,Fs},St) ->
    Fs2 = pattern_grp(Fs,St),
    {bin,Line,Fs2};
pattern({op,_Line,'++',{nil,_},R},St) ->
    pattern(R,St);
pattern({op,_Line,'++',{cons,Li,{char,_C2,_I}=Char,T},R},St) ->
    pattern({cons,Li,Char,{op,Li,'++',T,R}},St);
pattern({op,_Line,'++',{cons,Li,{integer,_L2,_I}=Integer,T},R},St) ->
    pattern({cons,Li,Integer,{op,Li,'++',T,R}},St);
pattern({op,_Line,'++',{string,Li,L},R},St) ->
    pattern(string_to_conses(L, Li, R),St);
pattern({op,_Line,_Op,_A}=Op4,_St) -> Op4;
pattern({op,_Line,_Op,_L,_R}=Op5,_St) -> Op5.

pattern_grp([{bin_element,L1,E1,S1,T1} | Fs],St) ->
    S2 = case S1 of
	     default ->
		 default;
	     _ ->
		 expr(S1,St)
	 end,
    T2 = case T1 of
	     default ->
		 default;
	     _ ->
		 bit_types(T1)
	 end,
    [{bin_element,L1,expr(E1,St),S2,T2} | pattern_grp(Fs,St)];
pattern_grp([],_St) ->
    [].

bit_types([]) ->
    [];
bit_types([Atom | Rest]) when is_atom(Atom) ->
    [Atom | bit_types(Rest)];
bit_types([{Atom, Integer} | Rest]) when is_atom(Atom), is_integer(Integer) ->
    [{Atom, Integer} | bit_types(Rest)].

pattern_list([P0|Ps],St) ->
    P1 = pattern(P0,St),
    [P1|pattern_list(Ps,St)];
pattern_list([],_St) -> [].

guard([G0|Gs],St) when is_list(G0) ->
    [guard0(G0,St) | guard(Gs,St)];
guard(L,St) ->
    guard0(L,St).

guard0([G0|Gs],St) ->
    G1 = guard_test(G0,St),
    [G1|guard0(Gs,St)];
guard0([],_St) -> [].

guard_test(Expr={call,Line,{atom,La,F},As0},St) ->
    case erl_internal:type_test(F, length(As0)) of
	true ->
	    As1 = gexpr_list(As0,St),
	    {call,Line,{atom,La,F},As1};
	_ ->
	    gexpr(Expr,St)
    end;
guard_test(Any,St) ->
    gexpr(Any,St).

gexpr({var,_L,_V}=Var,_St) -> Var;
% %% alternative implementation of accessing module parameters
%     case index(V,St#pmod.parameters) of
% 	N when N > 0 ->
% 	    {call,L,{remote,L,{atom,L,erlang},{atom,L,element}},
% 	     [{integer,L,N+1},{var,L,'THIS'}]};
% 	_ ->
% 	    Var
%     end;
gexpr({integer,_Line,_I}=Integer,_St) -> Integer;
gexpr({char,_Line,_C}=Char,_St) -> Char;
gexpr({float,_Line,_F}=Float,_St) -> Float;
gexpr({atom,_Line,_A}=Atom,_St) -> Atom;
gexpr({string,_Line,_S}=String,_St) -> String;
gexpr({nil,_Line}=Nil,_St) -> Nil;
gexpr({cons,Line,H0,T0},St) ->
    H1 = gexpr(H0,St),
    T1 = gexpr(T0,St),
    {cons,Line,H1,T1};
gexpr({tuple,Line,Es0},St) ->
    Es1 = gexpr_list(Es0,St),
    {tuple,Line,Es1};
gexpr({call,Line,{atom,_La,F}=Atom,As0},St) ->
    true = erl_internal:guard_bif(F, length(As0)),
    As1 = gexpr_list(As0,St),
    {call,Line,Atom,As1};
%% Pre-expansion generated calls to erlang:is_record/3 must also be handled
gexpr({call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,is_record}},[_,_,_]=As0},St) ->
    As1 = gexpr_list(As0,St),
    {call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,is_record}},As1};
%% Guard BIFs can be remote, but only in the module erlang...
gexpr({call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,F}},As0},St) ->
    A = length(As0),
    true =
	erl_internal:guard_bif(F, A) orelse erl_internal:arith_op(F, A) orelse
	erl_internal:comp_op(F, A) orelse erl_internal:bool_op(F, A),
    As1 = gexpr_list(As0,St),
    {call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,F}},As1};
%% Unfortunately, writing calls as {M,F}(...) is also allowed.
gexpr({call,Line,{tuple,La,[{atom,Lb,erlang},{atom,Lc,F}]},As0},St) ->
    A = length(As0),
    true =
	erl_internal:guard_bif(F, A) orelse erl_internal:arith_op(F, A) orelse 
	erl_internal:comp_op(F, A) orelse erl_internal:bool_op(F, A),
    As1 = gexpr_list(As0,St),
    {call,Line,{tuple,La,[{atom,Lb,erlang},{atom,Lc,F}]},As1};
gexpr({bin,Line,Fs},St) ->
    Fs2 = pattern_grp(Fs,St),
    {bin,Line,Fs2};
gexpr({op,Line,Op,A0},St) ->
    true = erl_internal:arith_op(Op, 1) orelse erl_internal:bool_op(Op, 1),
    A1 = gexpr(A0,St),
    {op,Line,Op,A1};
gexpr({op,Line,Op,L0,R0},St) ->
    true =
	Op =:= 'andalso' orelse Op =:= 'orelse' orelse
	erl_internal:arith_op(Op, 2) orelse
	erl_internal:bool_op(Op, 2) orelse erl_internal:comp_op(Op, 2),
    L1 = gexpr(L0,St),
    R1 = gexpr(R0,St),
    {op,Line,Op,L1,R1}.

gexpr_list([E0|Es],St) ->
    E1 = gexpr(E0,St),
    [E1|gexpr_list(Es,St)];
gexpr_list([],_St) -> [].

exprs([E0|Es],St) ->
    E1 = expr(E0,St),
    [E1|exprs(Es,St)];
exprs([],_St) -> [].

expr({var,_L,_V}=Var,_St) ->
    Var;
%     case index(V,St#pmod.parameters) of
% 	N when N > 0 ->
% 	    {call,L,{remote,L,{atom,L,erlang},{atom,L,element}},
% 	     [{integer,L,N+1},{var,L,'THIS'}]};
% 	_ ->
% 	    Var
%     end;
expr({integer,_Line,_I}=Integer,_St) -> Integer;
expr({float,_Line,_F}=Float,_St) -> Float;
expr({atom,_Line,_A}=Atom,_St) -> Atom;
expr({string,_Line,_S}=String,_St) -> String;
expr({char,_Line,_C}=Char,_St) -> Char;
expr({nil,_Line}=Nil,_St) -> Nil;
expr({cons,Line,H0,T0},St) ->
    H1 = expr(H0,St),
    T1 = expr(T0,St),
    {cons,Line,H1,T1};
expr({lc,Line,E0,Qs0},St) ->
    Qs1 = lc_quals(Qs0,St),
    E1 = expr(E0,St),
    {lc,Line,E1,Qs1};
expr({tuple,Line,Es0},St) ->
    Es1 = expr_list(Es0,St),
    {tuple,Line,Es1};
expr({block,Line,Es0},St) ->
    Es1 = exprs(Es0,St),
    {block,Line,Es1};
expr({'if',Line,Cs0},St) ->
    Cs1 = icr_clauses(Cs0,St),
    {'if',Line,Cs1};
expr({'case',Line,E0,Cs0},St) ->
    E1 = expr(E0,St),
    Cs1 = icr_clauses(Cs0,St),
    {'case',Line,E1,Cs1};
expr({'receive',Line,Cs0},St) ->
    Cs1 = icr_clauses(Cs0,St),
    {'receive',Line,Cs1};
expr({'receive',Line,Cs0,To0,ToEs0},St) ->
    To1 = expr(To0,St),
    ToEs1 = exprs(ToEs0,St),
    Cs1 = icr_clauses(Cs0,St),
    {'receive',Line,Cs1,To1,ToEs1};
expr({'try',Line,Es0,Scs0,Ccs0,As0},St) ->
    Es1 = exprs(Es0,St),
    Scs1 = icr_clauses(Scs0,St),
    Ccs1 = icr_clauses(Ccs0,St),
    As1 = exprs(As0,St),
    {'try',Line,Es1,Scs1,Ccs1,As1};
expr({'fun',Line,Body,Info},St) ->
    case Body of
	{clauses,Cs0} ->
	    Cs1 = fun_clauses(Cs0,St),
	    {'fun',Line,{clauses,Cs1},Info};
	{function,F,A} = Function ->
	    {F1,A1} = update_function_name({F,A},St),
	    if A1 =:= A ->
		    {'fun',Line,Function,Info};
	       true ->
		    %% Must rewrite local fun-name to a fun that does a
		    %% call with the extra THIS parameter.
		    As = make_vars(A, Line),
		    As1 = As ++ [{var,Line,'THIS'}],
		    Call = {call,Line,{atom,Line,F1},As1},
		    Cs = [{clause,Line,As,[],[Call]}],
		    {'fun',Line,{clauses,Cs},Info}
	    end;
	{function,_M,_F,_A} = Fun4 ->		%This is an error in lint!
	    {'fun',Line,Fun4,Info}
    end;
expr({call,Lc,{atom,_,instance}=Name,As0},St) ->
    %% All local functions 'instance(...)' are static by definition,
    %% so they do not take a 'THIS' argument when called
    As1 = expr_list(As0,St),
    {call,Lc,Name,As1};
expr({call,Lc,{atom,_,new}=Name,As0},St) ->
    %% All local functions 'new(...)' are static by definition,
    %% so they do not take a 'THIS' argument when called
    As1 = expr_list(As0,St),
    {call,Lc,Name,As1};
expr({call,Lc,{atom,_,module_info}=Name,As0},St)
  when length(As0) =:= 0; length(As0) =:= 1 ->
    %% The module_info/0 and module_info/1 functions are also static.
    As1 = expr_list(As0,St),
    {call,Lc,Name,As1};
expr({call,Lc,{atom,_Lf,_F}=Atom,As0},St) ->
    %% Local function call - needs THIS parameter.
    As1 = expr_list(As0,St),
    {call,Lc,Atom,As1 ++ [{var,0,'THIS'}]};
expr({call,Line,F0,As0},St) ->
    %% Other function call
    F1 = expr(F0,St),
    As1 = expr_list(As0,St),
    {call,Line,F1,As1};
expr({'catch',Line,E0},St) ->
    E1 = expr(E0,St),
    {'catch',Line,E1};
expr({match,Line,P0,E0},St) ->
    E1 = expr(E0,St),
    P1 = pattern(P0,St),
    {match,Line,P1,E1};
expr({bin,Line,Fs},St) ->
    Fs2 = pattern_grp(Fs,St),
    {bin,Line,Fs2};
expr({op,Line,Op,A0},St) ->
    A1 = expr(A0,St),
    {op,Line,Op,A1};
expr({op,Line,Op,L0,R0},St) ->
    L1 = expr(L0,St),
    R1 = expr(R0,St),
    {op,Line,Op,L1,R1};
%% The following are not allowed to occur anywhere!
expr({remote,Line,M0,F0},St) ->
    M1 = expr(M0,St),
    F1 = expr(F0,St),
    {remote,Line,M1,F1}.

expr_list([E0|Es],St) ->
    E1 = expr(E0,St),
    [E1|expr_list(Es,St)];
expr_list([],_St) -> [].

icr_clauses([C0|Cs],St) ->
    C1 = clause(C0,St),
    [C1|icr_clauses(Cs,St)];
icr_clauses([],_St) -> [].

lc_quals([{generate,Line,P0,E0}|Qs],St) ->
    E1 = expr(E0,St),
    P1 = pattern(P0,St),
    [{generate,Line,P1,E1}|lc_quals(Qs,St)];
lc_quals([E0|Qs],St) ->
    E1 = expr(E0,St),
    [E1|lc_quals(Qs,St)];
lc_quals([],_St) -> [].

fun_clauses([C0|Cs],St) ->
    C1 = clause(C0,St),
    [C1|fun_clauses(Cs,St)];
fun_clauses([],_St) -> [].

%% %% Return index from 1 upwards, or 0 if not in the list.
%%
%% index(X,Ys) -> index(X,Ys,1).
%%
%% index(X,[X|Ys],A) -> A;
%% index(X,[Y|Ys],A) -> index(X,Ys,A+1);
%% index(X,[],A) -> 0.

make_vars(N, L) ->
    make_vars(1, N, L).

make_vars(N, M, L) when N =< M ->
    V = list_to_atom("X"++integer_to_list(N)),
    [{var,L,V} | make_vars(N + 1, M, L)];
make_vars(_, _, _) ->
    [].