fix for simplify.m

[Simon TAYLOR]

Hi Fergus,

Could you please review this change.

Simon


Estimated hours taken: 0.5

Fix a bug reported by Michael Winikoff which was caused by
simplify.m not properly initialising the hlds_goal_info
used in a disj([], SM) - Info.

compiler/hlds_goal.m
	Added predicates true_goal/1 and fail_goal/1 to
	return the hlds_goals corresponding to true and fail,
	to avoid this kind of bug in the future.

compiler/simplify.m
	Use true_goal/1 and fail_goal/1 instead of conj([]) - Info and
	disj([], SM) - Info.

tests/general/Mmake
	Enable fail_detism.m.


Index: hlds_goal.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/hlds_goal.m,v
retrieving revision 1.29
diff -u -r1.29 hlds_goal.m
--- hlds_goal.m	1997/02/23 06:06:31	1.29
+++ hlds_goal.m	1997/03/18 06:30:11
@@ -588,6 +588,14 @@
 :- pred goal_is_atomic(hlds_goal_expr).
 :- mode goal_is_atomic(in) is semidet.
 
+	% Return the HLDS equivalent of `true'.
+:- pred true_goal(hlds_goal).
+:- mode true_goal(out) is det.
+
+	% Return the HLDS equivalent of `fail'.
+:- pred fail_goal(hlds_goal).
+:- mode fail_goal(out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -810,6 +818,21 @@
 goal_is_atomic(call(_,_,_,_,_,_)).
 goal_is_atomic(unify(_,_,_,_,_)).
 goal_is_atomic(pragma_c_code(_,_,_,_,_,_,_)).
+
+%-----------------------------------------------------------------------------%
+
+true_goal(conj([]) - GoalInfo) :-
+	goal_info_init(GoalInfo0),
+	goal_info_set_determinism(GoalInfo0, det, GoalInfo1), 
+	instmap_delta_init_reachable(InstMapDelta),
+	goal_info_set_instmap_delta(GoalInfo1, InstMapDelta, GoalInfo).
+
+fail_goal(disj([], SM) - GoalInfo) :-
+	map__init(SM),
+	goal_info_init(GoalInfo0),
+	goal_info_set_determinism(GoalInfo0, failure, GoalInfo1), 
+	instmap_delta_init_unreachable(InstMapDelta),
+	goal_info_set_instmap_delta(GoalInfo1, InstMapDelta, GoalInfo).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: simplify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/simplify.m,v
retrieving revision 1.26
diff -u -r1.26 simplify.m
--- simplify.m	1997/02/23 06:07:59	1.26
+++ simplify.m	1997/03/18 06:32:18
@@ -158,7 +158,8 @@
 
 %-----------------------------------------------------------------------------%
 
-simplify__goal(Goal0 - GoalInfo0, Goal - GoalInfo, Info0, Info) :-
+simplify__goal(Goal0, Goal - GoalInfo, Info0, Info) :-
+	Goal0 = _GoalExpr0 - GoalInfo0,
 	simplify_info_get_det_info(Info0, DetInfo),
 	goal_info_get_determinism(GoalInfo0, Detism),
 	simplify_info_get_module_info(Info0, ModuleInfo),
@@ -170,12 +171,10 @@
 		%
 		Detism = failure,
 		( det_info_get_fully_strict(DetInfo, no)
-		; code_aux__goal_cannot_loop(ModuleInfo, Goal0 - GoalInfo0)
+		; code_aux__goal_cannot_loop(ModuleInfo, Goal0)
 		)
 	->
-		map__init(Empty),
-		Goal1 = disj([], Empty),
-		GoalInfo1 = GoalInfo0		% need we massage this?
+		fail_goal(Goal1)
 	;
 		%
 		% if --no-fully-strict,
@@ -195,18 +194,17 @@
 		det_no_output_vars(NonLocalVars, InstMap0, InstMapDelta,
 			DetInfo),
 		( det_info_get_fully_strict(DetInfo, no)
-		; code_aux__goal_cannot_loop(ModuleInfo, Goal0 - GoalInfo0)
+		; code_aux__goal_cannot_loop(ModuleInfo, Goal0)
 		)
 	->
-		Goal1 = conj([]),
-		GoalInfo1 = GoalInfo0		% need we massage this?
+		true_goal(Goal1)
 	;
-		Goal1 = Goal0,
-		GoalInfo1 = GoalInfo0
+		Goal1 = Goal0
 	),
-	simplify_info_maybe_clear_structs(before, Goal1 - GoalInfo1,
+	simplify_info_maybe_clear_structs(before, Goal1,
 		Info0, Info1),
-	simplify__goal_2(Goal1, GoalInfo1, Goal, GoalInfo, Info1, Info2),
+	Goal1 = GoalExpr1 - GoalInfo1,
+	simplify__goal_2(GoalExpr1, GoalInfo1, Goal, GoalInfo, Info1, Info2),
 	simplify_info_maybe_clear_structs(after, Goal - GoalInfo, Info2, Info).
 
 %-----------------------------------------------------------------------------%
@@ -248,14 +246,14 @@
 		)
 	).
 
-simplify__goal_2(disj(Disjuncts0, SM), GoalInfo,
+simplify__goal_2(disj(Disjuncts0, SM), GoalInfo0,
 		Goal, GoalInfo, Info0, Info) :-
 	( Disjuncts0 = [] ->
-		Goal = disj([], SM),
+		fail_goal(Goal - GoalInfo),
 		Info = Info0
 	; Disjuncts0 = [SingleGoal0] ->
 		% a singleton disjunction is equivalent to the goal itself
-		simplify__goal(SingleGoal0, Goal - _, Info0, Info) 
+		simplify__goal(SingleGoal0, Goal - GoalInfo, Info0, Info) 
 	;
 		simplify__disj(Disjuncts0, Disjuncts, [], InstMaps,
 			Info0, Info0, Info1),
@@ -283,7 +281,8 @@
 				MsgsA, Msgs)
 		;
 	****/
-			Goal = disj(Disjuncts, SM)
+			Goal = disj(Disjuncts, SM),
+			GoalInfo = GoalInfo0
 		)
 	).
 
@@ -303,12 +302,8 @@
 	),
 	( Cases1 = [] ->
 		% An empty switch always fails.
-		Goal = disj([], SM),
-		Info = Info0,
-		goal_info_init(GoalInfo1),
-		goal_info_set_determinism(GoalInfo1, failure, GoalInfo2),
-		instmap_delta_init_unreachable(Delta),
-		goal_info_set_instmap_delta(GoalInfo2, Delta, GoalInfo)
+		fail_goal(Goal - GoalInfo),
+		Info = Info0
 	; Cases1 = [case(ConsId, SingleGoal0)] ->
 		% a singleton switch is equivalent to the goal itself with 
 		% a possibly can_fail unification with the functor on the front.
@@ -758,9 +753,7 @@
 		(inst)::in, list(case)::in, hlds_goal::out) is semidet.
 
 simplify__inst_contains_more_information(not_reached, _, _, Goal) :-
-	goal_info_init(GoalInfo),
-	map__init(SM),
-	Goal = disj([], SM) - GoalInfo.
+	fail_goal(Goal).
 simplify__inst_contains_more_information(bound(_, BoundInsts),
 		_, Cases0, Goal) :-
 	functors_to_cons_ids(BoundInsts, ConsIds0),
@@ -768,9 +761,7 @@
 	delete_unreachable_cases(Cases0, ConsIds, Cases),
 	(
 		Cases = [],
-		goal_info_init(GoalInfo),
-		map__init(SM),
-		Goal = disj([], SM) - GoalInfo
+		fail_goal(Goal)
 	;
 		Cases = [case(_, Goal)]
 	).


Index: Mmake
===================================================================
RCS file: /home/staff/zs/imp/tests/general/Mmake,v
retrieving revision 1.37
diff -u -r1.37 Mmake
--- Mmake	1997/03/18 07:57:52	1.37
+++ Mmake	1997/03/19 00:41:31
@@ -34,6 +34,7 @@
 		double_error2 \
 		duplicate_label \
 		environment \
+		fail_detism \
 		float_test \
 		frameopt_mkframe_bug \
 		higher_order \
@@ -50,7 +51,7 @@
 		univ \
 		unreachable
 
-NOTWORKING=	fail_detism
+NOTWORKING=
 
 #
 # The nondet tests use solutions/2, which is currently implemented only for GC