[m-dev.] diff: bug fix for infinite loop in mode analysis

[Fergus Henderson]

Hi,

I wrote:

> Tom, can you please review this one?
> 
> compiler/inst_match.m:
> 	Fix an infinite loop in inst_matches_final for higher-order
> 	recursive insts.
> 
> compiler/mode_util.m:
> 	Avoid creating insts of the form `typed_inst(..., typed_inst(...))',
> 	because that is unnecessary, and could lead to inefficiencies or
> 	perhaps even infinite loops (?).

Sorry, I included the wrong diff with that one.  Here is the correct diff.

Index: inst_match.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/inst_match.m,v
retrieving revision 1.29
diff -u -r1.29 inst_match.m
--- inst_match.m	1997/04/10 20:18:32	1.29
+++ inst_match.m	1997/06/16 07:58:37
@@ -265,32 +265,48 @@
 	%	This is true if they both have the same PredOrFunc indicator
 	%	and the same determinism, and if the arguments match
 	%	using pred_inst_argmodes_match.
+	% pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, Expansions)
+	%	Same as pred_inst_matches_2, except that inst pairs in
+	%	Expansions are assumed to match_final each other.
+	%	(This avoids infinite loops when calling inst_matches_final
+	%	on higher-order recursive insts.)
 	%
 :- pred pred_inst_matches(pred_inst_info, pred_inst_info, module_info).
 :- mode pred_inst_matches(in, in, in) is semidet.
 
-pred_inst_matches(pred_inst_info(PredOrFunc, ModesA, Det),
-		pred_inst_info(PredOrFunc, ModesB, Det), ModuleInfo) :-
-	pred_inst_argmodes_matches(ModesA, ModesB, ModuleInfo).
+pred_inst_matches(PredInstA, PredInstB, ModuleInfo) :-
+	set__init(Expansions),
+	pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, Expansions).
+
+:- pred pred_inst_matches_2(pred_inst_info, pred_inst_info, module_info,
+			expansions).
+:- mode pred_inst_matches_2(in, in, in, in) is semidet.
+
+pred_inst_matches_2(pred_inst_info(PredOrFunc, ModesA, Det),
+		pred_inst_info(PredOrFunc, ModesB, Det),
+		ModuleInfo, Expansions) :-
+	pred_inst_argmodes_matches(ModesA, ModesB, ModuleInfo, Expansions).
 
-	% pred_inst_matches_argmodes(ModesA, ModesB, ModuleInfo):
+	% pred_inst_matches_argmodes(ModesA, ModesB, ModuleInfo, Expansions):
 	% succeeds if the initial insts of ModesB specify at least as
 	% much information as, and the same binding as, the initial
 	% insts of ModesA; and the final insts of ModesA specify at
 	% least as much information as, and the same binding as, the
-	% final insts of ModesB.
+	% final insts of ModesB.  Any inst pairs in Expansions are assumed
+	% to match_final each other.
 	%
-:- pred pred_inst_argmodes_matches(list(mode), list(mode), module_info).
-:- mode pred_inst_argmodes_matches(in, in, in) is semidet.
+:- pred pred_inst_argmodes_matches(list(mode), list(mode),
+				module_info, expansions).
+:- mode pred_inst_argmodes_matches(in, in, in, in) is semidet.
 
-pred_inst_argmodes_matches([], [], _).
+pred_inst_argmodes_matches([], [], _, _).
 pred_inst_argmodes_matches([ModeA|ModeAs], [ModeB|ModeBs],
-		ModuleInfo) :-
+		ModuleInfo, Expansions) :-
 	mode_get_insts(ModuleInfo, ModeA, InitialA, FinalA),
 	mode_get_insts(ModuleInfo, ModeB, InitialB, FinalB),
-	inst_matches_final(InitialB, InitialA, ModuleInfo),
-	inst_matches_final(FinalA, FinalB, ModuleInfo),
-	pred_inst_argmodes_matches(ModeAs, ModeBs, ModuleInfo).
+	inst_matches_final_2(InitialB, InitialA, ModuleInfo, Expansions),
+	inst_matches_final_2(FinalA, FinalB, ModuleInfo, Expansions),
+	pred_inst_argmodes_matches(ModeAs, ModeBs, ModuleInfo, Expansions).
 
 :- pred unique_matches_initial(uniqueness, uniqueness).
 :- mode unique_matches_initial(in, in) is semidet.
@@ -456,8 +472,9 @@
 		% of all the constructors for the type in question.
 	%%% error("not implemented: `ground' matches_final `bound(...)'").
 inst_matches_final_3(ground(UniqA, PredInstA), ground(UniqB, PredInstB),
-		ModuleInfo, _) :-
-	maybe_pred_inst_matches_final(PredInstA, PredInstB, ModuleInfo),
+		ModuleInfo, Expansions) :-
+	maybe_pred_inst_matches_final(PredInstA, PredInstB,
+		ModuleInfo, Expansions),
 	unique_matches_final(UniqA, UniqB).
 /* not yet:
 inst_matches_final_2(abstract_inst(_, _), any(shared), _, _).
@@ -468,13 +485,14 @@
 inst_matches_final_3(not_reached, _, _, _).
 
 :- pred maybe_pred_inst_matches_final(maybe(pred_inst_info),
-		maybe(pred_inst_info), module_info).
-:- mode maybe_pred_inst_matches_final(in, in, in) is semidet.
+		maybe(pred_inst_info), module_info, expansions).
+:- mode maybe_pred_inst_matches_final(in, in, in, in) is semidet.
 
-maybe_pred_inst_matches_final(no, no, _).
-maybe_pred_inst_matches_final(yes(_), no, _).
-maybe_pred_inst_matches_final(yes(PredInstA), yes(PredInstB), ModuleInfo) :-
-	pred_inst_matches(PredInstA, PredInstB, ModuleInfo).
+maybe_pred_inst_matches_final(no, no, _, _).
+maybe_pred_inst_matches_final(yes(_), no, _, _).
+maybe_pred_inst_matches_final(yes(PredInstA), yes(PredInstB),
+		ModuleInfo, Expansions) :-
+	pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, Expansions).
 
 :- pred inst_list_matches_final(list(inst), list(inst), module_info,
 				expansions).
Index: mode_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mode_util.m,v
retrieving revision 1.92
diff -u -r1.92 mode_util.m
--- mode_util.m	1997/06/16 07:19:53	1.92
+++ mode_util.m	1997/06/16 07:52:15
@@ -1258,7 +1258,17 @@
 propagate_ctor_info_lazily(defined_inst(InstName0), Type0, Subst, _,
 		defined_inst(InstName)) :-
 	apply_type_subst(Type0, Subst, Type),
-	InstName = typed_inst(Type, InstName0).
+	( InstName0 = typed_inst(_, _) ->
+		% If this happens, it means that we have already
+		% lazily propagated type info into this inst.
+		% We want to avoid creating insts of the form
+		% typed_inst(_, typed_inst(...)), because that would be
+		% unnecessary, and could cause efficiency problems
+		% or perhaps even infinite loops (?).
+		InstName = InstName0
+	;
+		InstName = typed_inst(Type, InstName0)
+	).
 
 	%
 	% If the user does not explicitly specify a higher-order inst

-- 
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.