[m-rev.] diff: fix deforestation bug

[Simon Taylor]

Estimated hours taken: 1

Fix a compiler abort when compiling browser/declarative_user.m
with inter-module optimization and deforestation.

compiler/det_analysis.m:
	Check the inferred determinism when deciding whether a
	predicate should be in a single-solution context. The 
	declared determinism is not set for procedures introduced
	by deforestation. 

compiler/deforest.m:
	Don't attempt to improve the determinism of procedures
	with determinism cc_multi or cc_nondet -- those determinisms
	can't be inferred, and attempting to do so would cause
	errors in determinism analysis.

tests/hard_coded/Mmakefile:
tests/hard_coded/deforest_cc_bug.{m,exp}:
	Test case.

Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.26
diff -u -u -r1.26 deforest.m
--- compiler/deforest.m	28 Mar 2002 03:42:52 -0000	1.26
+++ compiler/deforest.m	28 Apr 2002 17:40:14 -0000
@@ -132,9 +132,17 @@
 reset_inferred_proc_determinism(PredProcId, ModuleInfo0, ModuleInfo) :-
 	module_info_pred_proc_info(ModuleInfo0, PredProcId,
 		PredInfo, ProcInfo0),
-	proc_info_set_inferred_determinism(ProcInfo0, erroneous, ProcInfo),
-	module_info_set_pred_proc_info(ModuleInfo0, PredProcId,
-		PredInfo, ProcInfo, ModuleInfo).
+	proc_info_inferred_determinism(ProcInfo0, Detism0),
+	( determinism_components(Detism0, _, at_most_many_cc) ->
+		% `cc_multi' or `cc_nondet' determinisms are never inferred,
+		% so resetting the determinism would cause determinism errors.
+		ModuleInfo = ModuleInfo0
+	;	
+		proc_info_set_inferred_determinism(ProcInfo0, erroneous,
+			ProcInfo),
+		module_info_set_pred_proc_info(ModuleInfo0, PredProcId,
+			PredInfo, ProcInfo, ModuleInfo)
+	).
 
 :- pred proc_arg_info_init(map(pred_proc_id, pd_proc_arg_info)::out) is det.
 
Index: compiler/det_analysis.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/det_analysis.m,v
retrieving revision 1.154
diff -u -u -r1.154 det_analysis.m
--- compiler/det_analysis.m	28 Mar 2002 03:42:53 -0000	1.154
+++ compiler/det_analysis.m	28 Apr 2002 17:23:34 -0000
@@ -249,10 +249,20 @@
 		% context or not.  Currently we only assume so if
 		% the predicate has an explicit determinism declaration
 		% that says so.
+	det_get_soln_context(Detism0, OldInferredSolnContext),
 	proc_info_declared_determinism(Proc0, MaybeDeclaredDetism),
 	( MaybeDeclaredDetism = yes(DeclaredDetism) ->
-		det_get_soln_context(DeclaredDetism, SolnContext)
+		det_get_soln_context(DeclaredDetism, DeclaredSolnContext)
 	;	
+		DeclaredSolnContext = all_solns
+	),
+	(
+		( DeclaredSolnContext = first_soln
+		; OldInferredSolnContext = first_soln
+		)
+	->
+		SolnContext = first_soln
+	;
 		SolnContext = all_solns
 	),
 
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.148
diff -u -u -r1.148 Mmakefile
--- tests/hard_coded/Mmakefile	25 Apr 2002 09:31:58 -0000	1.148
+++ tests/hard_coded/Mmakefile	28 Apr 2002 17:15:36 -0000
@@ -34,6 +34,7 @@
 	deep_copy \
 	deep_copy_bug \
 	deep_copy_exist \
+	deforest_cc_bug \
 	det_in_semidet_cntxt \
 	division_test \
 	dupcall_types_bug \
@@ -236,6 +237,7 @@
 MCFLAGS-bigtest		=	--intermodule-optimization -O3
 MCFLAGS-constraint	=	--constraint-propagation --enable-termination
 MCFLAGS-constraint_order =	--constraint-propagation --enable-termination
+MCFLAGS-deforest_cc_bug =	--deforestation
 MCFLAGS-lp		=	--intermodule-optimization -O3
 MCFLAGS-boyer		=	--infer-all
 MCFLAGS-func_test	=	--infer-all
Index: tests/hard_coded/deforest_cc_bug.exp
===================================================================
RCS file: tests/hard_coded/deforest_cc_bug.exp
diff -N tests/hard_coded/deforest_cc_bug.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/deforest_cc_bug.exp	28 Apr 2002 17:14:52 -0000
@@ -0,0 +1 @@
+123456
Index: tests/hard_coded/deforest_cc_bug.m
===================================================================
RCS file: tests/hard_coded/deforest_cc_bug.m
diff -N tests/hard_coded/deforest_cc_bug.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/deforest_cc_bug.m	28 Apr 2002 16:53:41 -0000
@@ -0,0 +1,46 @@
+:- module deforest_cc_bug.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module list, std_util.
+
+main -->
+	bug(1, [2,3,4,5,6,7]).
+
+:- pred bug(int::in, list(int)::in, io__state::di, io__state::uo) is cc_multi.
+:- pragma no_inline(bug/4).
+	
+bug(FirstArg, ArgsRest) -->
+	{ get_inputs_and_result(FirstArg, ArgsRest, Inputs, _) },
+	my_write_list(Inputs, write_decl_atom_arg),
+	io__nl.
+
+:- pred write_decl_atom_arg(int, io__state, io__state).
+:- mode write_decl_atom_arg(in, di, uo) is cc_multi.
+
+write_decl_atom_arg(Arg) -->
+	cc_multi_equal,
+	io__write_int(Arg).
+
+:- pred get_inputs_and_result(int, list(int), list(int), int).
+:- mode get_inputs_and_result(in, in, out, out) is det.
+
+get_inputs_and_result(A, [], [], A).
+get_inputs_and_result(A1, [A2 | As], [A1 | Inputs0], Result) :-
+	get_inputs_and_result(A2, As, Inputs0, Result).
+
+:- pred my_write_list(list(int)::in,
+	pred(int, io__state, io__state)::(pred(in, di, uo) is cc_multi),
+	io__state::di, io__state::uo) is cc_multi.
+
+my_write_list([], _OutputPred) --> [].
+my_write_list([E|Es], OutputPred) -->
+	OutputPred(E),
+	my_write_list(Es, OutputPred).
+
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------