[m-rev.] diff: more circularly defined insts

[Mark Brown]

Estimated hours taken: 0.5
Branches: main, release

Fix another problem with circularly defined insts.

compiler/make_hlds.m:
	When checking for circularly defined insts, substitute the correct
	arguments for user defined insts.  Use unrelated insts as the
	inital argument values (in this case, use not_reached for all of
	them).

tests/invalid/Mmakefile:
	Add some new tests.

tests/invalid/circ_inst5.err_exp:
tests/invalid/circ_inst5.m:
	A test case where looping occurs via an argument substitution.
	Before this change, attempting to compile this module would result
	in a loop.

tests/invalid/circ_type5.err_exp:
tests/invalid/circ_type5.m:
	A similar test case for equivalence types.  The algorithm to expand
	equivalence types already handled this case correctly, but it was
	untested.

	There is no corresponding test case for modes, since this kind of
	error cannot occur in mode declarations.

Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.428
diff -u -r1.428 make_hlds.m
--- compiler/make_hlds.m	10 Dec 2002 11:35:06 -0000	1.428
+++ compiler/make_hlds.m	12 Jan 2003 00:58:11 -0000
@@ -1835,7 +1835,9 @@
 	%
 	{ Arity = list__length(Args) },
 	{ InstId = Name - Arity },
-	check_for_cyclic_inst(Insts, InstId, InstId, [], Context, InvalidMode).
+	{ TestArgs = list__duplicate(Arity, not_reached) },
+	check_for_cyclic_inst(Insts, InstId, InstId, TestArgs, [], Context,
+		InvalidMode).
 
 :- pred insts_add(user_inst_table, inst_varset, sym_name, list(inst_var),
 		inst_defn, condition, prog_context, import_status,
@@ -1872,11 +1874,11 @@
 	%
 	% check if the inst is infinitely recursive (at the top level)
 	%
-:- pred check_for_cyclic_inst(user_inst_table, inst_id, inst_id, list(inst_id),
-		prog_context, bool, io__state, io__state).
-:- mode check_for_cyclic_inst(in, in, in, in, in, out, di, uo) is det.
+:- pred check_for_cyclic_inst(user_inst_table, inst_id, inst_id, list(inst),
+		list(inst_id), prog_context, bool, io__state, io__state).
+:- mode check_for_cyclic_inst(in, in, in, in, in, in, out, di, uo) is det.
 
-check_for_cyclic_inst(UserInstTable, OrigInstId, InstId0, Expansions0,
+check_for_cyclic_inst(UserInstTable, OrigInstId, InstId0, Args0, Expansions0,
 		Context, InvalidMode) -->
 	( { list__member(InstId0, Expansions0) } ->
 		report_circular_equiv_error("inst", OrigInstId, InstId0,
@@ -1886,15 +1888,17 @@
 		{ user_inst_table_get_inst_defns(UserInstTable, InstDefns) },
 		(
 			{ map__search(InstDefns, InstId0, InstDefn) },
-			{ InstDefn = hlds_inst_defn(_, _, Body, _, _, _) },
-			{ Body = eqv_inst(EqvInst) },
+			{ InstDefn = hlds_inst_defn(_, Params, Body, _, _, _) },
+			{ Body = eqv_inst(EqvInst0) },
+			{ inst_substitute_arg_list(EqvInst0, Params, Args0,
+				EqvInst) },
 			{ EqvInst = defined_inst(user_inst(Name, Args)) }
 		->
 			{ Arity = list__length(Args) },
 			{ InstId = Name - Arity },
 			{ Expansions = [InstId0 | Expansions0] },
 			check_for_cyclic_inst(UserInstTable, OrigInstId,
-				InstId, Expansions, Context, InvalidMode)
+				InstId, Args, Expansions, Context, InvalidMode)
 		;
 			{ InvalidMode = no }
 		)
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.131
diff -u -r1.131 Mmakefile
--- tests/invalid/Mmakefile	22 Nov 2002 13:41:58 -0000	1.131
+++ tests/invalid/Mmakefile	12 Jan 2003 00:58:43 -0000
@@ -38,6 +38,7 @@
 	circ_inst2 \
 	circ_inst3 \
 	circ_inst4 \
+	circ_inst5 \
 	circ_mode \
 	circ_mode2 \
 	circ_mode3 \
@@ -45,6 +46,7 @@
 	circ_type \
 	circ_type2 \
 	circ_type3 \
+	circ_type5 \
 	constrained_poly_insts \
 	constructor_warning \
 	det_errors \
Index: tests/invalid/circ_inst5.err_exp
===================================================================
RCS file: tests/invalid/circ_inst5.err_exp
diff -N tests/invalid/circ_inst5.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/circ_inst5.err_exp	12 Jan 2003 00:58:43 -0000
@@ -0,0 +1,3 @@
+circ_inst5.m:005: Error: circular equivalence insts `circ_inst5:i/1' and
+circ_inst5.m:005:   `circ_inst5:c/1'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/circ_inst5.m
===================================================================
RCS file: tests/invalid/circ_inst5.m
diff -N tests/invalid/circ_inst5.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/circ_inst5.m	12 Jan 2003 00:58:43 -0000
@@ -0,0 +1,15 @@
+:- module circ_inst5.
+:- interface.
+
+:- inst i(I) == I.
+:- inst c(I) == i(c(I)).
+:- inst c == c(ground).
+
+:- type foo ---> foo.
+
+:- func f(foo) = int.
+:- mode f(in(c)) = out is det.
+
+:- implementation.
+
+f(foo) = 1.
Index: tests/invalid/circ_type5.err_exp
===================================================================
RCS file: tests/invalid/circ_type5.err_exp
diff -N tests/invalid/circ_type5.err_exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/circ_type5.err_exp	12 Jan 2003 00:58:44 -0000
@@ -0,0 +1,3 @@
+circ_type5.m:006: Error: circular equivalence type `circ_type5:c/1'.
+circ_type5.m:007: Error: circular equivalence type `circ_type5:c/0'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/circ_type5.m
===================================================================
RCS file: tests/invalid/circ_type5.m
diff -N tests/invalid/circ_type5.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/invalid/circ_type5.m	12 Jan 2003 00:58:44 -0000
@@ -0,0 +1,8 @@
+% This corresponds to circ_inst5.
+:- module circ_type5.
+:- interface.
+
+:- type i(I) == I.
+:- type c(I) == i(c(I)).
+:- type c == c(int).
+
--------------------------------------------------------------------------
mercury-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------