From 7493d97d7f8211cb60d52a5cb6af9fb9983b84fa Mon Sep 17 00:00:00 2001 From: Patrik Nyblom Date: Fri, 4 Jun 2010 10:16:32 +0200 Subject: Add warnings for shadowed variables in ms_transform funs Also changed compiler to allow for warnings in parse_transforms. --- lib/stdlib/src/ms_transform.erl | 168 ++++++++++++++++++++++++++-------------- 1 file changed, 111 insertions(+), 57 deletions(-) (limited to 'lib/stdlib/src/ms_transform.erl') diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index 78b1de6e16..1a571fc607 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -43,6 +43,7 @@ -define(ERR_GENREMOTECALL,22). -define(ERR_GENBINCONSTRUCT,23). -define(ERR_GENDISALLOWEDOP,24). +-define(WARN_SHADOW_VAR,50). -define(ERR_GUARDMATCH,?ERR_GENMATCH+?ERROR_BASE_GUARD). -define(ERR_BODYMATCH,?ERR_GENMATCH+?ERROR_BASE_BODY). -define(ERR_GUARDLOCALCALL,?ERR_GENLOCALCALL+?ERROR_BASE_GUARD). @@ -63,8 +64,13 @@ -define(ERR_BODYDISALLOWEDOP,?ERR_GENDISALLOWEDOP+?ERROR_BASE_BODY). %% -%% Called by compiler or ets/dbg:fun2ms when errors occur +%% Called by compiler or ets/dbg:fun2ms when errors/warnings occur %% +format_error({?WARN_SHADOW_VAR,Name}) -> + lists:flatten( + io_lib:format("variable ~p shadowed in ms_transform fun head", + [Name])); + format_error(?ERR_NOFUN) -> "Parameter of ets/dbg:fun2ms/1 is not a literal fun"; format_error(?ERR_ETS_HEAD) -> @@ -182,7 +188,7 @@ format_error(Else) -> %% transform_from_shell(Dialect, Clauses, BoundEnvironment) -> SaveFilename = setup_filename(), - case catch ms_clause_list(1,Clauses,Dialect) of + case catch ms_clause_list(1,Clauses,Dialect,gb_sets:new()) of {'EXIT',Reason} -> cleanup_filename(SaveFilename), exit(Reason); @@ -207,6 +213,7 @@ transform_from_shell(Dialect, Clauses, BoundEnvironment) -> %% parse_transform(Forms, _Options) -> SaveFilename = setup_filename(), + %io:format("~p~n",[Forms]), case catch forms(Forms) of {'EXIT',Reason} -> cleanup_filename(SaveFilename), @@ -215,12 +222,31 @@ parse_transform(Forms, _Options) -> {error, [{cleanup_filename(SaveFilename), [{Line, ?MODULE, R}]}], []}; Else -> - cleanup_filename(SaveFilename), + %io:format("Transformed into: ~p~n",[Else]), + case get_warnings() of + [] -> + cleanup_filename(SaveFilename), + Else; + WL -> + FName = cleanup_filename(SaveFilename) , + WList = [ {FName, [{L, ?MODULE, R}]} || {L,R} <- WL ], + {warning, Else, WList} + end + end. + +get_warnings() -> + case get(warnings) of + undefined -> + []; + Else -> Else end. +add_warning(Line,R) -> + put(warnings,[{Line,R}| get_warnings()]). + setup_filename() -> - {erase(filename),erase(records)}. + {erase(filename),erase(records),erase(warnings)}. put_filename(Name) -> put(filename,Name). @@ -235,7 +261,7 @@ get_records() -> Else -> Else end. -cleanup_filename({Old,OldRec}) -> +cleanup_filename({Old,OldRec,OldWarnings}) -> Ret = case erase(filename) of undefined -> "TOP_LEVEL"; @@ -248,6 +274,12 @@ cleanup_filename({Old,OldRec}) -> Rec -> put(records,Rec) end, + case OldWarnings of + undefined -> + erase(warnings); + Warn -> + put(warnings,Warn) + end, case Old of undefined -> Ret; @@ -285,42 +317,52 @@ form({function,Line,Name0,Arity0,Clauses0}) -> form(AnyOther) -> AnyOther. function(Name, Arity, Clauses0) -> - Clauses1 = clauses(Clauses0), + {Clauses1,_} = clauses(Clauses0,gb_sets:new()), {Name,Arity,Clauses1}. -clauses([C0|Cs]) -> - C1 = clause(C0), - [C1|clauses(Cs)]; -clauses([]) -> []. -clause({clause,Line,H0,G0,B0}) -> - B1 = copy(B0), - {clause,Line,H0,G0,B1}. +clauses([C0|Cs],Bound) -> + {C1,Bound1} = clause(C0,Bound), + {C2,Bound2} = clauses(Cs,Bound1), + {[C1|C2],Bound2}; +clauses([],Bound) -> {[],Bound}. +clause({clause,Line,H0,G0,B0},Bound) -> + {H1,Bound1} = copy(H0,Bound), + {B1,Bound2} = copy(B0,Bound1), + {{clause,Line,H1,G0,B1},Bound2}. copy({call,Line,{remote,_Line2,{atom,_Line3,ets},{atom,_Line4,fun2ms}}, - As0}) -> - transform_call(ets,Line,As0); + As0},Bound) -> + {transform_call(ets,Line,As0,Bound),Bound}; copy({call,Line,{remote,_Line2,{record_field,_Line3, {atom,_Line4,''},{atom,_Line5,ets}}, - {atom,_Line6,fun2ms}}, As0}) -> + {atom,_Line6,fun2ms}}, As0},Bound) -> %% Packages... - transform_call(ets,Line,As0); + {transform_call(ets,Line,As0,Bound),Bound}; copy({call,Line,{remote,_Line2,{atom,_Line3,dbg},{atom,_Line4,fun2ms}}, - As0}) -> - transform_call(dbg,Line,As0); -copy(T) when is_tuple(T) -> - list_to_tuple(copy_list(tuple_to_list(T))); -copy(L) when is_list(L) -> - copy_list(L); -copy(AnyOther) -> - AnyOther. + As0},Bound) -> + {transform_call(dbg,Line,As0,Bound),Bound}; +copy({var,_Line,'_'} = VarDef,Bound) -> + {VarDef,Bound}; +copy({var,_Line,Name} = VarDef,Bound) -> + Bound1 = gb_sets:add(Name,Bound), + {VarDef,Bound1}; +copy(T,Bound) when is_tuple(T) -> + {L,Bound1} = copy_list(tuple_to_list(T),Bound), + {list_to_tuple(L),Bound1}; +copy(L,Bound) when is_list(L) -> + copy_list(L,Bound); +copy(AnyOther,Bound) -> + {AnyOther,Bound}. -copy_list([H|T]) -> - [copy(H)|copy_list(T)]; -copy_list([]) -> - []. +copy_list([H|T],Bound) -> + {C1,Bound1} = copy(H,Bound), + {C2,Bound2} = copy_list(T,Bound1), + {[C1|C2],Bound2}; +copy_list([],Bound) -> + {[],Bound}. -transform_call(Type,_Line,[{'fun',Line2,{clauses, ClauseList}}]) -> - ms_clause_list(Line2, ClauseList,Type); -transform_call(_Type,Line,_NoAbstractFun) -> +transform_call(Type,_Line,[{'fun',Line2,{clauses, ClauseList}}],Bound) -> + ms_clause_list(Line2, ClauseList,Type,Bound); +transform_call(_Type,Line,_NoAbstractFun,_) -> throw({error,Line,?ERR_NOFUN}). % Fixup semicolons in guards @@ -329,18 +371,19 @@ ms_clause_expand({clause, Line, Parameters, Guard = [_,_|_], Body}) -> ms_clause_expand(_Other) -> false. -ms_clause_list(Line,[H|T],Type) -> +ms_clause_list(Line,[H|T],Type,Bound) -> case ms_clause_expand(H) of NewHead when is_list(NewHead) -> - ms_clause_list(Line,NewHead ++ T, Type); + ms_clause_list(Line,NewHead ++ T, Type, Bound); false -> - {cons, Line, ms_clause(H,Type), ms_clause_list(Line, T,Type)} + {cons, Line, ms_clause(H, Type, Bound), + ms_clause_list(Line, T, Type, Bound)} end; -ms_clause_list(Line,[],_) -> +ms_clause_list(Line,[],_,_) -> {nil,Line}. -ms_clause({clause, Line, Parameters, Guards, Body},Type) -> +ms_clause({clause, Line, Parameters, Guards, Body},Type,Bound) -> check_type(Line,Parameters,Type), - {MSHead,Bindings} = transform_head(Parameters), + {MSHead,Bindings} = transform_head(Parameters,Bound), MSGuards = transform_guards(Line, Guards, Bindings), MSBody = transform_body(Line,Body,Bindings), {tuple, Line, [MSHead,MSGuards,MSBody]}. @@ -627,29 +670,31 @@ tg(Other,B) -> Element = io_lib:format("unknown element ~w", [Other]), throw({error,unknown,{?ERR_GENELEMENT+B#tgd.eb,Element}}). -transform_head([V]) -> +transform_head([V],OuterBound) -> Bind = cre_bind(), - {NewV,NewBind} = toplevel_head_match(V,Bind), - th(NewV,NewBind). + {NewV,NewBind} = toplevel_head_match(V,Bind,OuterBound), + th(NewV,NewBind,OuterBound). -toplevel_head_match({match,_,{var,_,VName},Expr},B) -> +toplevel_head_match({match,Line,{var,_,VName},Expr},B,OB) -> + warn_var_clash(Line,VName,OB), {Expr,new_bind({VName,'$_'},B)}; -toplevel_head_match({match,_,Expr,{var,_,VName}},B) -> +toplevel_head_match({match,Line,Expr,{var,_,VName}},B,OB) -> + warn_var_clash(Line,VName,OB), {Expr,new_bind({VName,'$_'},B)}; -toplevel_head_match(Other,B) -> +toplevel_head_match(Other,B,_OB) -> {Other,B}. -th({record,Line,RName,RFields},B) -> +th({record,Line,RName,RFields},B,OB) -> % youch... RDefs = get_records(), {KeyList0,NewB} = lists:foldl(fun({record_field,_,{atom,_,Key},Value}, {L,B0}) -> - {NV,B1} = th(Value,B0), + {NV,B1} = th(Value,B0,OB), {[{Key,NV}|L],B1}; ({record_field,_,{var,_,'_'},Value}, {L,B0}) -> - {NV,B1} = th(Value,B0), + {NV,B1} = th(Value,B0,OB), {[{{default},NV}|L],B1}; (_,_) -> throw({error,Line,{?ERR_HEADBADREC, @@ -692,9 +737,9 @@ th({record,Line,RName,RFields},B) -> _ -> throw({error,Line,{?ERR_HEADBADREC,RName}}) end; -th({match,Line,_,_},_) -> +th({match,Line,_,_},_,_) -> throw({error,Line,?ERR_HEADMATCH}); -th({atom,Line,A},B) -> +th({atom,Line,A},B,_OB) -> case atom_to_list(A) of [$$|NL] -> case (catch list_to_integer(NL)) of @@ -706,10 +751,11 @@ th({atom,Line,A},B) -> _ -> {{atom,Line,A},B} end; -th({bin_element,_Line0,{var, Line, A},_,_},_) -> +th({bin_element,_Line0,{var, Line, A},_,_},_,_) -> throw({error,Line,{?ERR_HEADBINMATCH,A}}); -th({var,Line,Name},B) -> +th({var,Line,Name},B,OB) -> + warn_var_clash(Line,Name,OB), case lkup_bind(Name,B) of undefined -> NewB = new_bind(Name,B), @@ -717,16 +763,24 @@ th({var,Line,Name},B) -> Trans -> {{atom,Line,Trans},B} end; -th([H|T],B) -> - {NH,NB} = th(H,B), - {NT,NNB} = th(T,NB), +th([H|T],B,OB) -> + {NH,NB} = th(H,B,OB), + {NT,NNB} = th(T,NB,OB), {[NH|NT],NNB}; -th(T,B) when is_tuple(T) -> - {L,NB} = th(tuple_to_list(T),B), +th(T,B,OB) when is_tuple(T) -> + {L,NB} = th(tuple_to_list(T),B,OB), {list_to_tuple(L),NB}; -th(Nonstruct,B) -> +th(Nonstruct,B,_OB) -> {Nonstruct,B}. +warn_var_clash(Line,Name,OuterBound) -> + case gb_sets:is_member(Name,OuterBound) of + true -> + add_warning(Line,{?WARN_SHADOW_VAR,Name}); + _ -> + ok + end. + %% Could be more efficient... check_multi_field(_, _, [], _) -> ok; -- cgit v1.2.3