From ca4633fd683527097451ca1398c90c87bb5c14fc Mon Sep 17 00:00:00 2001 From: Stavros Aronis Date: Sat, 2 Apr 2011 18:57:42 +0300 Subject: Rename suite data directories --- .../src/compiler/sys_expand_pmod.erl | 425 +++++++++++++++++++++ 1 file changed, 425 insertions(+) create mode 100644 lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_expand_pmod.erl (limited to 'lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_expand_pmod.erl') diff --git a/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_expand_pmod.erl b/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_expand_pmod.erl new file mode 100644 index 0000000000..f48cc05b9c --- /dev/null +++ b/lib/dialyzer/test/options1_SUITE_data/src/compiler/sys_expand_pmod.erl @@ -0,0 +1,425 @@ +%% ``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 via the world wide web 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. +%% +%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. +%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +%% AB. All Rights Reserved.'' +%% +%% $Id: sys_expand_pmod.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $ +%% +-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 '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) -> + case ordsets:is_element(E, St#pmod.predef) of + true -> E; + false -> {F, A + 1} + end. + +update_forms([{function,L,N,A,Cs}|Fs],St) -> + [{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) -> + {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},_St) -> {var,Line,V}; +pattern({match,Line,L0,R0},St) -> + L1 = pattern(L0,St), + R1 = pattern(R0,St), + {match,Line,L1,R1}; +pattern({integer,Line,I},_St) -> {integer,Line,I}; +pattern({char,Line,C},_St) -> {char,Line,C}; +pattern({float,Line,F},_St) -> {float,Line,F}; +pattern({atom,Line,A},_St) -> {atom,Line,A}; +pattern({string,Line,S},_St) -> {string,Line,S}; +pattern({nil,Line},_St) -> {nil,Line}; +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},T},R},St) -> + pattern({cons,Li,{char,C2,I},{op,Li,'++',T,R}},St); +pattern({op,_Line,'++',{cons,Li,{integer,L2,I},T},R},St) -> + pattern({cons,Li,{integer,L2,I},{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},_St) -> + {op,Line,Op,A}; +pattern({op,Line,Op,L,R},_St) -> + {op,Line,Op,L,R}. + +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 atom(Atom) -> + [Atom | bit_types(Rest)]; +bit_types([{Atom, Integer} | Rest]) when atom(Atom), 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 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},_St) -> + {var,L,V}; +% %% 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,L,V} +% end; +gexpr({integer,Line,I},_St) -> {integer,Line,I}; +gexpr({char,Line,C},_St) -> {char,Line,C}; +gexpr({float,Line,F},_St) -> {float,Line,F}; +gexpr({atom,Line,A},_St) -> {atom,Line,A}; +gexpr({string,Line,S},_St) -> {string,Line,S}; +gexpr({nil,Line},_St) -> {nil,Line}; +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},As0},St) -> + case erl_internal:guard_bif(F, length(As0)) of + true -> As1 = gexpr_list(As0,St), + {call,Line,{atom,La,F},As1} + end; +% 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) + when length(As0) == 3 -> + As1 = gexpr_list(As0,St), + {call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,is_record}},As1}; +% Guard bif's can be remote, but only in the module erlang... +gexpr({call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,F}},As0},St) -> + case erl_internal:guard_bif(F, length(As0)) or + erl_internal:arith_op(F, length(As0)) or + erl_internal:comp_op(F, length(As0)) or + erl_internal:bool_op(F, length(As0)) of + true -> As1 = gexpr_list(As0,St), + {call,Line,{remote,La,{atom,Lb,erlang},{atom,Lc,F}},As1} + end; +% Unfortunately, writing calls as {M,F}(...) is also allowed. +gexpr({call,Line,{tuple,La,[{atom,Lb,erlang},{atom,Lc,F}]},As0},St) -> + case erl_internal:guard_bif(F, length(As0)) or + erl_internal:arith_op(F, length(As0)) or + erl_internal:comp_op(F, length(As0)) or + erl_internal:bool_op(F, length(As0)) of + true -> As1 = gexpr_list(As0,St), + {call,Line,{tuple,La,[{atom,Lb,erlang},{atom,Lc,F}]},As1} + end; +gexpr({bin,Line,Fs},St) -> + Fs2 = pattern_grp(Fs,St), + {bin,Line,Fs2}; +gexpr({op,Line,Op,A0},St) -> + case erl_internal:arith_op(Op, 1) or + erl_internal:bool_op(Op, 1) of + true -> A1 = gexpr(A0,St), + {op,Line,Op,A1} + end; +gexpr({op,Line,Op,L0,R0},St) -> + case erl_internal:arith_op(Op, 2) or + erl_internal:bool_op(Op, 2) or + erl_internal:comp_op(Op, 2) of + true -> + L1 = gexpr(L0,St), + R1 = gexpr(R0,St), + {op,Line,Op,L1,R1} + end. + +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},_St) -> + {var,L,V}; +% 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,L,V} +% end; +expr({integer,Line,I},_St) -> {integer,Line,I}; +expr({float,Line,F},_St) -> {float,Line,F}; +expr({atom,Line,A},_St) -> {atom,Line,A}; +expr({string,Line,S},_St) -> {string,Line,S}; +expr({char,Line,C},_St) -> {char,Line,C}; +expr({nil,Line},_St) -> {nil,Line}; +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} -> + {F1,A1} = update_function_name({F,A},St), + if A1 == A -> + {'fun',Line,{function,F,A},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} -> %This is an error in lint! + {'fun',Line,{function,M,F,A},Info} + end; +expr({call,Lc,{atom,_,new}=Name,As0},#pmod{parameters=Ps}=St) + when length(As0) =:= length(Ps) -> + %% The new() function does not take a 'THIS' argument (it's static). + 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},As0},St) -> + %% Local function call - needs THIS parameter. + As1 = expr_list(As0,St), + {call,Lc,{atom,Lf,F},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(_, _, _) -> + []. -- cgit v1.2.3