Add warnings for shadowed variables in ms_transform funs

Also changed compiler to allow for warnings in parse_transforms.

1 files changed, 111 insertions, 57 deletions

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;