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