[m-dev.] diff: fix bug in goal_util__if_then_else_to_disjunction

[Simon Taylor]

Estimated hours taken: 1

compiler/goal_util.m:
	When converting an if-then-else to a disjunction,
	wrap a commit around the condition inside the negation
	in the else branch if it can succeed more than once.

tests/valid/Mmakefile:
tests/valid/ite_to_disj.m:
	Test case.

Index: compiler/goal_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/goal_util.m,v
retrieving revision 1.53
diff -u -u -r1.53 goal_util.m
--- goal_util.m	1999/07/13 08:52:54	1.53
+++ goal_util.m	1999/08/04 01:43:10
@@ -859,13 +859,29 @@
 
 %-----------------------------------------------------------------------------%
 
-goal_util__if_then_else_to_disjunction(Cond, Then, Else, GoalInfo, Goal) :-
-	goal_util__compute_disjunct_goal_info(Cond, Then, 
+goal_util__if_then_else_to_disjunction(Cond0, Then, Else, GoalInfo, Goal) :-
+	goal_util__compute_disjunct_goal_info(Cond0, Then, 
 		GoalInfo, CondThenInfo),
-	conj_list_to_goal([Cond, Then], CondThenInfo, CondThen),
+	conj_list_to_goal([Cond0, Then], CondThenInfo, CondThen),
 
-	Cond = _ - CondInfo,
-	goal_info_get_determinism(CondInfo, CondDetism),
+	Cond0 = _ - CondInfo0,
+	goal_info_get_determinism(CondInfo0, CondDetism0),
+
+	determinism_components(CondDetism0, CondCanFail0, CondMaxSoln0),
+
+	% Add a commit inside the negation of the condition in the else branch
+	% if the condition can succeed more than once.
+	( CondMaxSoln0 = at_most_many ->
+		CondMaxSoln = at_most_one,
+		determinism_components(CondDetism, CondCanFail0, CondMaxSoln),
+		goal_info_set_determinism(CondInfo0, CondDetism, CondInfo),
+		Cond = some([], can_remove, Cond0) - CondInfo
+	;
+		CondDetism = CondDetism0,
+		CondInfo = CondInfo0,
+		Cond = Cond0
+	),
+
 	det_negation_det(CondDetism, MaybeNegCondDet),
 	( MaybeNegCondDet = yes(NegCondDet1) ->
 		NegCondDet = NegCondDet1
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/valid/Mmakefile,v
retrieving revision 1.38
diff -u -u -r1.38 Mmakefile
--- Mmakefile	1999/07/22 17:14:51	1.38
+++ Mmakefile	1999/08/04 01:51:36
@@ -60,6 +60,7 @@
 	intermod_lambda.m \
 	intermod_quote.m \
 	intermod_test.m \
+	ite_to_disj.m \
 	lambda_inference.m\
 	lambda_instmap_bug.m \
 	lambda_output.m \
@@ -178,6 +179,7 @@
 MCFLAGS-intermod_quote2		= --intermodule-optimization
 MCFLAGS-intermod_test		= --intermodule-optimization
 MCFLAGS-intermod_test2		= --intermodule-optimization
+MCFLAGS-ite_to_disj		= --aditi
 MCFLAGS-livevals_seq		= -O5 --opt-space
 MCFLAGS-middle_rec_labels	= --middle-rec --no-follow-vars 
 MCFLAGS-mostly_uniq_mode_inf	= --infer-all
Index: tests/valid/ite_to_disj.m
===================================================================
RCS file: ite_to_disj.m
diff -N ite_to_disj.m
--- /dev/null	Wed Aug  4 12:39:58 1999
+++ ite_to_disj.m	Wed Aug  4 11:41:46 1999
@@ -0,0 +1,31 @@
+% Test conversion of if-then-elses to disjunctions.
+% The Mercury compiler of 4/8/1999 did not wrap a commit around
+% the negated condition in the else branch, causing an abort.
+:- module ite_to_disj.
+
+:- interface.
+
+:- import_module aditi.
+
+:- pred footy_current_name(aditi:state, string, string).
+:- mode footy_current_name(aditi:aditi_ui, in, out) is multi.
+:- pragma aditi(footy_current_name/3).
+
+:- implementation.
+
+footy_current_name(DB, Name, CurrentName) :-
+        (
+            footy_alias(DB, Name, NewName)
+        ->
+            CurrentName = NewName
+        ;
+            CurrentName = Name
+        ).
+
+% footy_alias(DB, OldTeamName, NewTeamName)
+:- pred footy_alias(aditi:state, string, string).
+:- mode footy_alias(aditi:aditi_ui, out, out) is nondet.
+:- pragma base_relation(footy_alias/3).
+:- pragma aditi_index(footy_alias/3,unique_B_tree,[2]).
+% relation name: $USER/footy/footy_alias__3
+
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------