1%% ``Licensed under the Apache License, Version 2.0 (the "License");
2%% you may not use this file except in compliance with the License.
3%% You may obtain a copy of the License at
4%%
5%%     http://www.apache.org/licenses/LICENSE-2.0
6%%
7%% Unless required by applicable law or agreed to in writing, software
8%% distributed under the License is distributed on an "AS IS" BASIS,
9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
10%% See the License for the specific language governing permissions and
11%% limitations under the License.
12%%
13%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
14%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
15%% AB. All Rights Reserved.''
16%%
17%%     $Id: sys_expand_pmod.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $
18%%
19-module(sys_expand_pmod).
20
21%% Expand function definition forms of parameterized module. We assume
22%% all record definitions, imports, queries, etc., have been expanded
23%% away. Any calls on the form 'foo(...)' must be calls to local
24%% functions. Auto-generated functions (module_info,...) have not yet
25%% been added to the function definitions, but are listed in 'defined'
26%% and 'exports'. The 'new/N' function is neither added to the
27%% definitions nor to the 'exports'/'defines' lists yet.
28
29-export([forms/4]).
30
31-record(pmod, {parameters, exports, defined, predef}).
32
33%% TODO: more abstract handling of predefined/static functions.
34
35forms(Fs0, Ps, Es0, Ds0) ->
36    PreDef = [{module_info,0},{module_info,1}],
37    forms(Fs0, Ps, Es0, Ds0, PreDef).
38
39forms(Fs0, Ps, Es0, Ds0, PreDef) ->
40    St0 = #pmod{parameters=Ps,exports=Es0,defined=Ds0, predef=PreDef},
41    {Fs1, St1} = forms(Fs0, St0),
42    Es1 = update_function_names(Es0, St1),
43    Ds1 = update_function_names(Ds0, St1),
44    Fs2 = update_forms(Fs1, St1),
45    {Fs2,Es1,Ds1}.
46
47%% This is extremely simplistic for now; all functions get an extra
48%% parameter, whether they need it or not, except for static functions.
49
50update_function_names(Es, St) ->
51    [update_function_name(E, St) || E <- Es].
52
53update_function_name(E={F,A}, St) ->
54    case ordsets:is_element(E, St#pmod.predef) of
55	true -> E;
56	false -> {F, A + 1}
57    end.
58
59update_forms([{function,L,N,A,Cs}|Fs],St) ->
60    [{function,L,N,A+1,Cs}|update_forms(Fs,St)];
61update_forms([F|Fs],St) ->
62    [F|update_forms(Fs,St)];
63update_forms([],_St) ->
64    [].
65
66%% Process the program forms.
67
68forms([F0|Fs0],St0) ->
69    {F1,St1} = form(F0,St0),
70    {Fs1,St2} = forms(Fs0,St1),
71    {[F1|Fs1],St2};
72forms([], St0) ->
73    {[], St0}.
74
75%% Only function definitions are of interest here. State is not updated.
76form({function,Line,Name0,Arity0,Clauses0},St) ->
77    {Name,Arity,Clauses} = function(Name0, Arity0, Clauses0, St),
78    {{function,Line,Name,Arity,Clauses},St};
79%% Pass anything else through
80form(F,St) -> {F,St}.
81
82function(Name, Arity, Clauses0, St) ->
83    Clauses1 = clauses(Clauses0,St),
84    {Name,Arity,Clauses1}.
85
86clauses([C|Cs],St) ->
87    {clause,L,H,G,B} = clause(C,St),
88    T = {tuple,L,[{var,L,V} || V <- ['_'|St#pmod.parameters]]},
89    [{clause,L,H++[{match,L,T,{var,L,'THIS'}}],G,B}|clauses(Cs,St)];
90clauses([],_St) -> [].
91
92clause({clause,Line,H0,G0,B0},St) ->
93    H1 = head(H0,St),
94    G1 = guard(G0,St),
95    B1 = exprs(B0,St),
96    {clause,Line,H1,G1,B1}.
97
98head(Ps,St) -> patterns(Ps,St).
99
100patterns([P0|Ps],St) ->
101    P1 = pattern(P0,St),
102    [P1|patterns(Ps,St)];
103patterns([],_St) -> [].
104
105string_to_conses([], _Line, Tail) ->
106    Tail;
107string_to_conses([E|Rest], Line, Tail) ->
108    {cons, Line, {integer, Line, E}, string_to_conses(Rest, Line, Tail)}.
109
110pattern({var,Line,V},_St) -> {var,Line,V};
111pattern({match,Line,L0,R0},St) ->
112    L1 = pattern(L0,St),
113    R1 = pattern(R0,St),
114    {match,Line,L1,R1};
115pattern({integer,Line,I},_St) -> {integer,Line,I};
116pattern({char,Line,C},_St) -> {char,Line,C};
117pattern({float,Line,F},_St) -> {float,Line,F};
118pattern({atom,Line,A},_St) -> {atom,Line,A};
119pattern({string,Line,S},_St) -> {string,Line,S};
120pattern({nil,Line},_St) -> {nil,Line};
121pattern({cons,Line,H0,T0},St) ->
122    H1 = pattern(H0,St),
123    T1 = pattern(T0,St),
124    {cons,Line,H1,T1};
125pattern({tuple,Line,Ps0},St) ->
126    Ps1 = pattern_list(Ps0,St),
127    {tuple,Line,Ps1};
128pattern({bin,Line,Fs},St) ->
129    Fs2 = pattern_grp(Fs,St),
130    {bin,Line,Fs2};
131pattern({op,_Line,'++',{nil,_},R},St) ->
132    pattern(R,St);
133pattern({op,_Line,'++',{cons,Li,{char,C2,I},T},R},St) ->
134    pattern({cons,Li,{char,C2,I},{op,Li,'++',T,R}},St);
135pattern({op,_Line,'++',{cons,Li,{integer,L2,I},T},R},St) ->
136    pattern({cons,Li,{integer,L2,I},{op,Li,'++',T,R}},St);
137pattern({op,_Line,'++',{string,Li,L},R},St) ->
138    pattern(string_to_conses(L, Li, R),St);
139pattern({op,Line,Op,A},_St) ->
140    {op,Line,Op,A};
141pattern({op,Line,Op,L,R},_St) ->
142    {op,Line,Op,L,R}.
143
144pattern_grp([{bin_element,L1,E1,S1,T1} | Fs],St) ->
145    S2 = case S1 of
146	     default ->
147		 default;
148	     _ ->
149		 expr(S1,St)
150	 end,
151    T2 = case T1 of
152	     default ->
153		 default;
154	     _ ->
155		 bit_types(T1)
156	 end,
157    [{bin_element,L1,expr(E1,St),S2,T2} | pattern_grp(Fs,St)];
158pattern_grp([],_St) ->
159    [].
160
161bit_types([]) ->
162    [];
163bit_types([Atom | Rest]) when atom(Atom) ->
164    [Atom | bit_types(Rest)];
165bit_types([{Atom, Integer} | Rest]) when atom(Atom), integer(Integer) ->
166    [{Atom, Integer} | bit_types(Rest)].
167
168pattern_list([P0|Ps],St) ->
169    P1 = pattern(P0,St),
170    [P1|pattern_list(Ps,St)];
171pattern_list([],_St) -> [].
172
173guard([G0|Gs],St) when list(G0) ->
174    [guard0(G0,St) | guard(Gs,St)];
175guard(L,St) ->
176    guard0(L,St).
177
178guard0([G0|Gs],St) ->
179    G1 = guard_test(G0,St),
180    [G1|guard0(Gs,St)];
181guard0([],_St) -> [].
182
183guard_test(Expr={call,Line,{atom,La,F},As0},St) ->
184    case erl_internal:type_test(F, length(As0)) of
185	true ->
186	    As1 = gexpr_list(As0,St),
187	    {call,Line,{atom,La,F},As1};
188	_ ->
189	    gexpr(Expr,St)
190    end;
191guard_test(Any,St) ->
192    gexpr(Any,St).
193
194gexpr({var,L,V},_St) ->
195    {var,L,V};
196% %% alternative implementation of accessing module parameters
197%     case index(V,St#pmod.parameters) of
198% 	N when N > 0 ->
199% 	    {call,L,{remote,L,{atom,L,erlang},{atom,L,element}},
200% 	     [{integer,L,N+1},{var,L,'THIS'}]};
201% 	_ ->
202% 	    {var,L,V}
203%     end;
204gexpr({integer,Line,I},_St) -> {integer,Line,I};
205gexpr({char,Line,C},_St) -> {char,Line,C};
206gexpr({float,Line,F},_St) -> {float,Line,F};
207gexpr({atom,Line,A},_St) -> {atom,Line,A};
208gexpr({string,Line,S},_St) -> {string,Line,S};
209gexpr({nil,Line},_St) -> {nil,Line};
210gexpr({cons,Line,H0,T0},St) ->
211    H1 = gexpr(H0,St),
212    T1 = gexpr(T0,St),
213    {cons,Line,H1,T1};
214gexpr({tuple,Line,Es0},St) ->
215    Es1 = gexpr_list(Es0,St),
216    {tuple,Line,Es1};
217gexpr({call,Line,{atom,La,F},As0},St) ->
218    case erl_internal:guard_bif(F, length(As0)) of
219	true -> As1 = gexpr_list(As0,St),
220		{call,Line,{atom,La,F},As1}
221    end;
222% Pre-expansion generated calls to erlang:is_record/3 must also be handled
223gexpr({call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,is_record}},As0},St)
224  when length(As0) == 3 ->
225    As1 = gexpr_list(As0,St),
226    {call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,is_record}},As1};
227% Guard bif's can be remote, but only in the module erlang...
228gexpr({call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,F}},As0},St) ->
229    case erl_internal:guard_bif(F, length(As0)) or
230	 erl_internal:arith_op(F, length(As0)) or
231	 erl_internal:comp_op(F, length(As0)) or
232	 erl_internal:bool_op(F, length(As0)) of
233	true -> As1 = gexpr_list(As0,St),
234		{call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,F}},As1}
235    end;
236% Unfortunately, writing calls as {M,F}(...) is also allowed.
237gexpr({call,Line,{tuple,La,[{atom,Lb,erlang},{atom,Lc,F}]},As0},St) ->
238    case erl_internal:guard_bif(F, length(As0)) or
239	 erl_internal:arith_op(F, length(As0)) or
240	 erl_internal:comp_op(F, length(As0)) or
241	 erl_internal:bool_op(F, length(As0)) of
242	true -> As1 = gexpr_list(As0,St),
243		{call,Line,{tuple,La,[{atom,Lb,erlang},{atom,Lc,F}]},As1}
244    end;
245gexpr({bin,Line,Fs},St) ->
246    Fs2 = pattern_grp(Fs,St),
247    {bin,Line,Fs2};
248gexpr({op,Line,Op,A0},St) ->
249    case erl_internal:arith_op(Op, 1) or
250	 erl_internal:bool_op(Op, 1) of
251	true -> A1 = gexpr(A0,St),
252		{op,Line,Op,A1}
253    end;
254gexpr({op,Line,Op,L0,R0},St) ->
255    case erl_internal:arith_op(Op, 2) or
256	  erl_internal:bool_op(Op, 2) or
257	  erl_internal:comp_op(Op, 2) of
258	true ->
259	    L1 = gexpr(L0,St),
260	    R1 = gexpr(R0,St),
261	    {op,Line,Op,L1,R1}
262    end.
263
264gexpr_list([E0|Es],St) ->
265    E1 = gexpr(E0,St),
266    [E1|gexpr_list(Es,St)];
267gexpr_list([],_St) -> [].
268
269exprs([E0|Es],St) ->
270    E1 = expr(E0,St),
271    [E1|exprs(Es,St)];
272exprs([],_St) -> [].
273
274expr({var,L,V},_St) ->
275    {var,L,V};
276%     case index(V,St#pmod.parameters) of
277% 	N when N > 0 ->
278% 	    {call,L,{remote,L,{atom,L,erlang},{atom,L,element}},
279% 	     [{integer,L,N+1},{var,L,'THIS'}]};
280% 	_ ->
281% 	    {var,L,V}
282%     end;
283expr({integer,Line,I},_St) -> {integer,Line,I};
284expr({float,Line,F},_St) -> {float,Line,F};
285expr({atom,Line,A},_St) -> {atom,Line,A};
286expr({string,Line,S},_St) -> {string,Line,S};
287expr({char,Line,C},_St) -> {char,Line,C};
288expr({nil,Line},_St) -> {nil,Line};
289expr({cons,Line,H0,T0},St) ->
290    H1 = expr(H0,St),
291    T1 = expr(T0,St),
292    {cons,Line,H1,T1};
293expr({lc,Line,E0,Qs0},St) ->
294    Qs1 = lc_quals(Qs0,St),
295    E1 = expr(E0,St),
296    {lc,Line,E1,Qs1};
297expr({tuple,Line,Es0},St) ->
298    Es1 = expr_list(Es0,St),
299    {tuple,Line,Es1};
300expr({block,Line,Es0},St) ->
301    Es1 = exprs(Es0,St),
302    {block,Line,Es1};
303expr({'if',Line,Cs0},St) ->
304    Cs1 = icr_clauses(Cs0,St),
305    {'if',Line,Cs1};
306expr({'case',Line,E0,Cs0},St) ->
307    E1 = expr(E0,St),
308    Cs1 = icr_clauses(Cs0,St),
309    {'case',Line,E1,Cs1};
310expr({'receive',Line,Cs0},St) ->
311    Cs1 = icr_clauses(Cs0,St),
312    {'receive',Line,Cs1};
313expr({'receive',Line,Cs0,To0,ToEs0},St) ->
314    To1 = expr(To0,St),
315    ToEs1 = exprs(ToEs0,St),
316    Cs1 = icr_clauses(Cs0,St),
317    {'receive',Line,Cs1,To1,ToEs1};
318expr({'try',Line,Es0,Scs0,Ccs0,As0},St) ->
319    Es1 = exprs(Es0,St),
320    Scs1 = icr_clauses(Scs0,St),
321    Ccs1 = icr_clauses(Ccs0,St),
322    As1 = exprs(As0,St),
323    {'try',Line,Es1,Scs1,Ccs1,As1};
324expr({'fun',Line,Body,Info},St) ->
325    case Body of
326	{clauses,Cs0} ->
327	    Cs1 = fun_clauses(Cs0,St),
328	    {'fun',Line,{clauses,Cs1},Info};
329	{function,F,A} ->
330	    {F1,A1} = update_function_name({F,A},St),
331	    if A1 == A ->
332		    {'fun',Line,{function,F,A},Info};
333	       true ->
334		    %% Must rewrite local fun-name to a fun that does a
335		    %% call with the extra THIS parameter.
336		    As = make_vars(A, Line),
337		    As1 = As ++ [{var,Line,'THIS'}],
338		    Call = {call,Line,{atom,Line,F1},As1},
339		    Cs = [{clause,Line,As,[],[Call]}],
340		    {'fun',Line,{clauses,Cs},Info}
341	    end;
342	{function,M,F,A} ->			%This is an error in lint!
343	    {'fun',Line,{function,M,F,A},Info}
344    end;
345expr({named_fun,Loc,Name,Cs,Info},St) ->
346    {named_fun,Loc,Name,fun_clauses(Cs, St),Info};
347expr({call,Lc,{atom,_,new}=Name,As0},#pmod{parameters=Ps}=St)
348  when length(As0) =:= length(Ps) ->
349    %% The new() function does not take a 'THIS' argument (it's static).
350    As1 = expr_list(As0,St),
351    {call,Lc,Name,As1};
352expr({call,Lc,{atom,_,module_info}=Name,As0},St)
353  when length(As0) == 0; length(As0) == 1 ->
354    %% The module_info/0 and module_info/1 functions are also static.
355    As1 = expr_list(As0,St),
356    {call,Lc,Name,As1};
357expr({call,Lc,{atom,Lf,F},As0},St) ->
358    %% Local function call - needs THIS parameter.
359    As1 = expr_list(As0,St),
360    {call,Lc,{atom,Lf,F},As1 ++ [{var,0,'THIS'}]};
361expr({call,Line,F0,As0},St) ->
362    %% Other function call
363    F1 = expr(F0,St),
364    As1 = expr_list(As0,St),
365    {call,Line,F1,As1};
366expr({'catch',Line,E0},St) ->
367    E1 = expr(E0,St),
368    {'catch',Line,E1};
369expr({match,Line,P0,E0},St) ->
370    E1 = expr(E0,St),
371    P1 = pattern(P0,St),
372    {match,Line,P1,E1};
373expr({bin,Line,Fs},St) ->
374    Fs2 = pattern_grp(Fs,St),
375    {bin,Line,Fs2};
376expr({op,Line,Op,A0},St) ->
377    A1 = expr(A0,St),
378    {op,Line,Op,A1};
379expr({op,Line,Op,L0,R0},St) ->
380    L1 = expr(L0,St),
381    R1 = expr(R0,St),
382    {op,Line,Op,L1,R1};
383%% The following are not allowed to occur anywhere!
384expr({remote,Line,M0,F0},St) ->
385    M1 = expr(M0,St),
386    F1 = expr(F0,St),
387    {remote,Line,M1,F1}.
388
389expr_list([E0|Es],St) ->
390    E1 = expr(E0,St),
391    [E1|expr_list(Es,St)];
392expr_list([],_St) -> [].
393
394icr_clauses([C0|Cs],St) ->
395    C1 = clause(C0,St),
396    [C1|icr_clauses(Cs,St)];
397icr_clauses([],_St) -> [].
398
399lc_quals([{generate,Line,P0,E0}|Qs],St) ->
400    E1 = expr(E0,St),
401    P1 = pattern(P0,St),
402    [{generate,Line,P1,E1}|lc_quals(Qs,St)];
403lc_quals([E0|Qs],St) ->
404    E1 = expr(E0,St),
405    [E1|lc_quals(Qs,St)];
406lc_quals([],_St) -> [].
407
408fun_clauses([C0|Cs],St) ->
409    C1 = clause(C0,St),
410    [C1|fun_clauses(Cs,St)];
411fun_clauses([],_St) -> [].
412
413% %% Return index from 1 upwards, or 0 if not in the list.
414%
415% index(X,Ys) -> index(X,Ys,1).
416%
417% index(X,[X|Ys],A) -> A;
418% index(X,[Y|Ys],A) -> index(X,Ys,A+1);
419% index(X,[],A) -> 0.
420
421make_vars(N, L) ->
422    make_vars(1, N, L).
423
424make_vars(N, M, L) when N =< M ->
425    V = list_to_atom("X"++integer_to_list(N)),
426    [{var,L,V} | make_vars(N + 1, M, L)];
427make_vars(_, _, _) ->
428    [].
429