new warning for infinite recursion

[Fergus Henderson]

Hi,

Simon, can you please review this change?

-----------------------------------------------------------------------------

Warn about obvious instances of infinite recursion:
directly recursive calls with the same (or equivalent) input arguments.

compiler/simplify.m:
	Check for new warning.

compiler/det_report.m:
	Add code to output the new warning.

compiler/common.m:
	Export common__vars_are_equivalent, for use by simplify.m.
	Also slightly tidy up the code for that predicate and its callers.

tests/warnings/Mmake:
tests/warnings/infinite_recursion.m:
tests/warnings/infinite_recursion.exp:
	Test case for new warning.


Index: simplify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/simplify.m,v
retrieving revision 1.21
diff -u -r1.21 simplify.m
--- simplify.m	1997/01/30 15:08:00	1.21
+++ simplify.m	1997/02/08 15:47:21
@@ -370,12 +370,50 @@
 	;
 		Info1 = Info0
 	),
-	( simplify_do_calls(Info1) ->
+
+	%
+	% Check for recursive calls with the same input arguments,
+	% and warn about them (since they will lead to infinite loops).
+	%
+	(
+		simplify_do_warn(Info1),
+
+		%
+		% Is this a (directly) recursive call,
+		% i.e. is the procedure being called the same as the
+		% procedure we're analyzing?
+		%
+		simplify_info_get_det_info(Info1, DetInfo),
+		det_info_get_pred_id(DetInfo, PredId),
+		det_info_get_proc_id(DetInfo, ProcId),
+
+		%
+		% Are the input arguments the same (or equivalent)?
+		%
+		simplify_info_get_module_info(Info1, ModuleInfo1),
+		module_info_pred_proc_info(ModuleInfo1, PredId, ProcId,
+			_PredInfo1, ProcInfo1),
+		proc_info_headvars(ProcInfo1, HeadVars),
+		proc_info_argmodes(ProcInfo1, ArgModes),
+		simplify_info_get_common_info(Info1, CommonInfo1),
+		simplify__input_args_are_equiv(Args, HeadVars, ArgModes,
+			CommonInfo1, ModuleInfo1)
+	->
+		simplify_info_add_msg(Info1, warn_infinite_recursion(GoalInfo),
+				Info2)
+	;
+		Info2 = Info1
+	),
+
+	%
+	% check for duplicate calls to the same procedure
+	%
+	( simplify_do_calls(Info2) ->
 		common__optimise_call(PredId, ProcId, Args, Goal0, GoalInfo,
-			Goal, Info1, Info)
+			Goal, Info2, Info)
 	;
 		Goal = Goal0,
-		Info = Info1
+		Info = Info2
 	).
 
 simplify__goal_2(Goal0, GoalInfo0, Goal, GoalInfo, Info0, Info) :-
@@ -513,6 +551,31 @@
 		Info = Info0,
 		Goal = Goal0
 	).
+
+%-----------------------------------------------------------------------------%
+
+	% simplify__input_args_are_equiv(Args, HeadVars, Modes,
+	% 		CommonInfo, ModuleInfo1):
+	% Succeeds if all the input arguments (determined by looking at
+	% `Modes') in `Args' are equivalent (according to the equivalence
+	% class specified by `CommonInfo') to the corresponding variables
+	% in HeadVars.  HeadVars, Modes, and Args should all be lists of
+	% the same length.
+
+:- pred simplify__input_args_are_equiv(list(var), list(var), list(mode),
+	common_info, module_info).
+:- mode simplify__input_args_are_equiv(in, in, in, in, in) is semidet.
+
+simplify__input_args_are_equiv([], [], _, _, _).
+simplify__input_args_are_equiv([Arg|Args], [HeadVar|HeadVars], [Mode|Modes],
+		CommonInfo, ModuleInfo1) :-
+	( mode_is_input(ModuleInfo1, Mode) ->
+		common__vars_are_equivalent(Arg, HeadVar, CommonInfo)
+	;
+		true
+	),
+	simplify__input_args_are_equiv(Args, HeadVars, Modes,
+			CommonInfo, ModuleInfo1).
 
 %-----------------------------------------------------------------------------%
 
Index: det_report.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/det_report.m,v
retrieving revision 1.30
diff -u -r1.30 det_report.m
--- det_report.m	1997/02/02 21:34:24	1.30
+++ det_report.m	1997/02/08 13:14:57
@@ -32,6 +32,9 @@
 				% warning about calls to predicates
 				% for which there is a `:- pragma obsolete'
 				% declaration.
+		;	warn_infinite_recursion(hlds__goal_info)
+				% warning about recursive calls
+				% which would cause infinite loops.
 		;	duplicate_call(seen_call_id, term__context,
 				hlds__goal_info)
 				% multiple calls with the same input args.
@@ -825,6 +828,7 @@
 det_msg_get_type(negated_goal_cannot_fail(_), warning).
 det_msg_get_type(negated_goal_cannot_succeed(_), warning).
 det_msg_get_type(warn_obsolete(_, _), warning).
+det_msg_get_type(warn_infinite_recursion(_), warning).
 det_msg_get_type(duplicate_call(_, _, _), warning).
 det_msg_get_type(cc_pred_in_wrong_context(_, _, _, _), error).
 det_msg_get_type(higher_order_cc_pred_in_wrong_context(_, _), error).
@@ -895,6 +899,27 @@
 	io__write_string("Warning: call to obsolete "),
 	hlds_out__write_pred_id(ModuleInfo, PredId),
 	io__write_string(".\n").
+det_report_msg(warn_infinite_recursion(GoalInfo), _ModuleInfo) -->
+	{ goal_info_get_context(GoalInfo, Context) },
+/*
+% it would be better if we supplied more information
+% than just the line number.
+	prog_out__write_context(Context),
+	io__write_string("In "),
+	hlds_out__write_pred_id(ModuleInfo, PredId),
+	io__write_string(":\n"),
+*/
+	prog_out__write_context(Context),
+	io__write_string(
+		"Warning: recursive call will lead to infinite recursion.\n"),
+	globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
+	( { VerboseErrors = yes } ->
+		io__write_string(
+"\tIf this recursive call is executed, the procedure will call itself
+\twith exactly the same input arguments, leading to infinite recursion.\n")
+	;
+		[]
+	).
 det_report_msg(duplicate_call(SeenCall, PrevContext, GoalInfo), ModuleInfo) -->
 	{ goal_info_get_context(GoalInfo, Context) },
 	prog_out__write_context(Context),
Index: common.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/common.m,v
retrieving revision 1.35
diff -u -r1.35 common.m
--- common.m	1997/01/30 15:07:51	1.35
+++ common.m	1997/02/08 13:38:16
@@ -60,6 +60,10 @@
 :- mode common__optimise_higher_order_call(in, in, in, in, in, in, out,
 		in, out) is det.
 
+	% succeeds if the two variables are equivalent
+	% according to the specified equivalence class.
+:- pred common__vars_are_equivalent(var, var, common_info).
+:- mode common__vars_are_equivalent(in, in, in) is semidet.
 
 	% Assorted stuff used here that simplify.m doesn't need to know about.
 :- type common_info.
@@ -226,7 +230,7 @@
 		ConsId = StructConsId,
 		(
 			UniType = construction,
-			common__vars_are_equivalent(ArgVars,
+			common__var_lists_are_equiv(ArgVars,
 				StructArgVars, VarEqv),
 
 			% Two structures of the same shape may have different 
@@ -235,7 +239,7 @@
 			common__compatible_types(VarType, StructType)
 		;
 			UniType = deconstruction,
-			common__vars_are_equivalent([Var], [OldVar], VarEqv)
+			common__vars_are_equiv(Var, OldVar, VarEqv)
 		)
 	->
 		OldStruct = Struct
@@ -270,26 +274,40 @@
 
 %---------------------------------------------------------------------------%
 
-:- pred common__vars_are_equivalent(list(var), list(var), eqvclass(var)).
-:- mode common__vars_are_equivalent(in, in, in) is semidet.
+	% succeeds if the two lists of variables are equivalent
+	% according to the specified equivalence class.
+:- pred common__var_lists_are_equiv(list(var), list(var), eqvclass(var)).
+:- mode common__var_lists_are_equiv(in, in, in) is semidet.
+
+common__var_lists_are_equiv([], [], _VarEqv).
+common__var_lists_are_equiv([X | Xs], [Y | Ys], VarEqv) :-
+	common__vars_are_equiv(X, Y, VarEqv),
+	common__var_lists_are_equiv(Xs, Ys, VarEqv).
+
+common__vars_are_equivalent(X, Y, CommonInfo) :-
+	CommonInfo = common(EqvVars, _, _, _),
+	common__vars_are_equiv(X, Y, EqvVars).
+
+	% succeeds if the two variables are equivalent
+	% according to the specified equivalence class.
+:- pred common__vars_are_equiv(var, var, eqvclass(var)).
+:- mode common__vars_are_equiv(in, in, in) is semidet.
 
-common__vars_are_equivalent([], [], _VarEqv).
-common__vars_are_equivalent([Arg | Args], [Struct | Structs], VarEqv) :-
+common__vars_are_equiv(X, Y, VarEqv) :-
 	% write('looking for equivalence of '),
-	% write(Arg),
+	% write(X),
 	% write(' and '),
-	% write(Struct),
+	% write(Y),
 	% nl,
 	(
-		Arg = Struct
+		X = Y
 	;
-		eqvclass__is_member(VarEqv, Arg),
-		eqvclass__is_member(VarEqv, Struct),
-		eqvclass__same_eqvclass(VarEqv, Arg, Struct)
-	),
+		eqvclass__is_member(VarEqv, X),
+		eqvclass__is_member(VarEqv, Y),
+		eqvclass__same_eqvclass(VarEqv, X, Y)
+	).
 	% write('they are equivalent'),
-	% nl,
-	common__vars_are_equivalent(Args, Structs, VarEqv).
+	% nl.
 
 %---------------------------------------------------------------------------%
 
@@ -533,7 +551,7 @@
 common__find_previous_call([SeenCall | SeenCalls], InputArgs,
 		Eqv, OutputArgs2, PrevContext) :-
 	SeenCall = call_args(PrevContext, InputArgs1, OutputArgs1),
-	( common__vars_are_equivalent(InputArgs, InputArgs1, Eqv) ->
+	( common__var_lists_are_equiv(InputArgs, InputArgs1, Eqv) ->
 		OutputArgs2 = OutputArgs1
 	;
 		common__find_previous_call(SeenCalls, InputArgs, Eqv,

-- 
Fergus Henderson <fjh at cs.mu.oz.au>   |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>   |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3         |     -- the last words of T. S. Garp.