[m-rev.] for review: fix purity in tabling and optimization passes

Simon Taylor stayl at cs.mu.OZ.AU
Sat Mar 24 13:23:27 AEDT 2001


Estimated hours taken: 15
Branches: main

Fix the handling of purity in the optimization and tabling passes.
Without this change tests/tabling/unused_args.m fails with
inter-module optimization.

compiler/purity.m:
compiler/post_typecheck.m:
	Allow purity checking to be rerun on a single procedure
	without requiring an io__state. If the purity is worse
	(due to inlining a predicate with a `:- pragma promise_pure'
	declaration), add `promised_pure' or `promised_semipure'
	to the pred_info.

compiler/hlds_out.m:
compiler/hlds_pred.m:
compiler/intermod.m:
compiler/make_hlds.m:
compiler/mercury_to_mercury.m:
compiler/module_qual.m:
compiler/modules.m:
compiler/prog_data.m:
compiler/prog_io_pragma.m:
compiler/purity.m:
doc/reference_manual.texi:
NEWS:
	Implement `:- pragma promise_semipure'. This is needed if
	an predicate marked `promised_pure' which calls impure
	predicates is inlined into  a semipure predicate.

compiler/inlining.m:
	Make sure the purity markers on the goal_infos are correct
	after inlining predicates which are promised pure.

	Export a predicate inlining__can_inline_proc which is used
	by deforestation to determine whether inlining a procedure
	will change the semantics or will break code generator invariants.

compiler/deforest.m:
	Use the same method as inlining.m to work out whether
	a procedure can be inlined. Don't inline predicates which
	are promised pure because the extra impurity which
	will be propagated through the goal will stop deforestation
	working on the goal.

compiler/simplify.m:
	Make sure the goal_info resulting from converting a singleton
	switch into a conjunction has the correct purity.

compiler/table_gen.m:
	Make sure the purity markers on the generated goal_infos are
	correct.
	
	Make sure that call_table_gen goal features cannot be removed
	by optimization passes.

	Don't put unnecessary `impure' markers on calls to error/1.

tests/debugger/loopcheck.exp:
tests/debugger/retry.exp:
	Adjust the expected output. The change to ensure that
	`call_table_gen' goal features can't be removed alters
	the goal paths slightly.

tests/invalid/impure_method_impl.m:
	Adjust the expected output now that predicates can
	be promised semipure.


Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.205
diff -u -u -r1.205 NEWS
--- NEWS	2001/03/13 15:53:36	1.205
+++ NEWS	2001/03/24 02:04:43
@@ -6,6 +6,11 @@
 and split development of that version off onto a separate branch
 of our CVS repository (the `version-0_10_y' branch).
 
+Changes to the Mercury language:
+* We now allow `:- pragma promise_semipure' declarations. For more
+  information, see the "Impurity" chapter of the Mercury Language
+  Reference Manual.
+
 Changes to the Mercury standard library:
 * The exception module has a new predicate `try_store', which is
   like `try_io', but which works with stores rather than io__states.
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.18
diff -u -u -r1.18 deforest.m
--- compiler/deforest.m	2000/11/17 17:47:01	1.18
+++ compiler/deforest.m	2001/03/16 03:09:18
@@ -214,8 +214,8 @@
 	deforest__goal(Goal0, Goal).
 
 deforest__goal(Goal0, Goal) -->
-	{ Goal0 = call(PredId, ProcId, Args, _, _, Name) - _ },
-	deforest__call(PredId, ProcId, Args, Name, Goal0, Goal).
+	{ Goal0 = call(PredId, ProcId, Args, BuiltinState, _, Name) - _ },
+	deforest__call(PredId, ProcId, Args, Name, BuiltinState, Goal0, Goal).
 	
 deforest__goal(Goal, Goal) -->
 	{ Goal = unify(_, _, _, _, _) - _ }.
@@ -594,6 +594,7 @@
 
 	pd_info_get_module_info(ModuleInfo),
 	pd_info_lookup_option(fully_strict, FullyStrictOp),
+	pd_info_get_pred_info(PredInfo),
 	( 
 		{ DepthLimitOpt = int(MaxDepth) },
 		{ MaxDepth \= -1 }, 	% no depth limit set
@@ -608,14 +609,19 @@
 	;
 		% Check whether either of the goals to be
 		% deforested can't be inlined.
-		( 
-			{ EarlierGoal = call(PredId, _, _, _, _, _) - _ }
-		;
-			{ LaterGoal = call(PredId, _, _, _, _, _) - _ }
-		),
-		{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
-		{ pred_info_get_markers(PredInfo, Markers) },
-		{ check_marker(Markers, no_inline) }
+		{ EarlierGoal = call(PredId, ProcId, _, BuiltinState, _, _) - _
+		; LaterGoal = call(PredId, ProcId, _, BuiltinState, _, _) - _
+		},
+
+		% We don't attempt to deforest predicates which are
+		% promised pure because the extra impurity propagated
+		% through the goal when such predicates are inlined
+		% will defeat any attempt at deforestation.
+		{ InlinePromisedPure = no },
+		{ pred_info_get_markers(PredInfo, CallerMarkers) },
+		{ \+ inlining__can_inline_proc(PredId, ProcId, BuiltinState,
+			InlinePromisedPure, CallerMarkers, ModuleInfo) }
+			
 	->
 		pd_debug__message("non-inlineable calls\n", []),		
 		{ ShouldTry = no }
@@ -1514,10 +1520,10 @@
 %-----------------------------------------------------------------------------%
 
 :- pred deforest__call(pred_id::in, proc_id::in, list(prog_var)::in,
-		sym_name::in, hlds_goal::in, hlds_goal::out, 
+		sym_name::in, builtin_state::in, hlds_goal::in, hlds_goal::out, 
 		pd_info::pd_info_di, pd_info::pd_info_uo) is det.
 
-deforest__call(PredId, ProcId, Args, SymName, Goal0, Goal) -->
+deforest__call(PredId, ProcId, Args, SymName, BuiltinState, Goal0, Goal) -->
 	pd_info_get_proc_arg_info(ProcArgInfos),
 	pd_info_get_module_info(ModuleInfo),
 	pd_info_get_instmap(InstMap),
@@ -1527,10 +1533,17 @@
 	{ goal_info_get_context(GoalInfo0, Context) },
 
 	pd_info_get_local_term_info(LocalTermInfo0),
-	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
-	{ pred_info_get_markers(PredInfo, Markers) },
+
+	pd_info_get_pred_info(PredInfo),
+	{ pred_info_get_markers(PredInfo, CallerMarkers) },
 	( 
-		{ \+ check_marker(Markers, no_inline) },
+		% We don't attempt to deforest predicates which are
+		% promised pure because the extra impurity propagated
+		% through the goal when such predicates are inlined
+		% will defeat any attempt at deforestation.
+		{ InlinePromisedPure = no },
+		{ inlining__can_inline_proc(PredId, ProcId, BuiltinState,
+			InlinePromisedPure, CallerMarkers, ModuleInfo) },
 		{ map__search(ProcArgInfos, proc(PredId, ProcId), 
 			ProcArgInfo) },
 		{ ProcArgInfo = pd_branch_info(_, LeftArgs, _) },
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.255
diff -u -u -r1.255 hlds_out.m
--- compiler/hlds_out.m	2001/03/05 10:30:59	1.255
+++ compiler/hlds_out.m	2001/03/15 01:47:50
@@ -881,6 +881,7 @@
 hlds_out__marker_name((impure), "impure").
 hlds_out__marker_name((semipure), "semipure").
 hlds_out__marker_name(promised_pure, "promise_pure").
+hlds_out__marker_name(promised_semipure, "promise_semipure").
 hlds_out__marker_name(terminates, "terminates").
 hlds_out__marker_name(check_termination, "check_termination").
 hlds_out__marker_name(does_not_terminate, "does_not_terminate").
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.93
diff -u -u -r1.93 hlds_pred.m
--- compiler/hlds_pred.m	2001/03/05 10:31:02	1.93
+++ compiler/hlds_pred.m	2001/03/15 02:41:12
@@ -421,6 +421,10 @@
 	;	promised_pure	% Requests that calls to this predicate be
 				% transformed as usual, despite any impure
 				% or semipure markers present.
+	;	promised_semipure
+				% Requests that calls to this predicate be
+				% treated as semipure, despite any impure
+				% calls in the body.
 
 				% The terminates and does_not_terminate
 				% pragmas are kept as markers to ensure
@@ -735,8 +739,8 @@
 :- pred pred_info_get_purity(pred_info, purity).
 :- mode pred_info_get_purity(in, out) is det.
 
-:- pred pred_info_get_promised_pure(pred_info, bool).
-:- mode pred_info_get_promised_pure(in, out) is det.
+:- pred pred_info_get_promised_purity(pred_info, purity).
+:- mode pred_info_get_promised_purity(in, out) is det.
 
 :- pred purity_to_markers(purity, pred_markers).
 :- mode purity_to_markers(in, out) is det.
@@ -1135,20 +1139,22 @@
 
 pred_info_get_purity(PredInfo0, Purity) :-
 	pred_info_get_markers(PredInfo0, Markers),
-	(   check_marker(Markers, (impure)) ->
+	( check_marker(Markers, (impure)) ->
 		Purity = (impure)
-	;   check_marker(Markers, (semipure)) ->
+	; check_marker(Markers, (semipure)) ->
 		Purity = (semipure)
 	;
 		Purity = pure
 	).
 
-pred_info_get_promised_pure(PredInfo0, Promised) :-
+pred_info_get_promised_purity(PredInfo0, PromisedPurity) :-
 	pred_info_get_markers(PredInfo0, Markers),
-	(   check_marker(Markers, promised_pure) ->
-		Promised = yes
+	( check_marker(Markers, promised_pure) ->
+		PromisedPurity = pure
+	; check_marker(Markers, promised_semipure) ->
+		PromisedPurity = (semipure)
 	;
-		Promised = no
+		PromisedPurity = (impure)
 	).
 
 purity_to_markers(pure, []).
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.97
diff -u -u -r1.97 inlining.m
--- compiler/inlining.m	2001/01/11 07:37:12	1.97
+++ compiler/inlining.m	2001/03/16 03:12:10
@@ -84,7 +84,7 @@
 :- interface.
 
 :- import_module hlds_goal, hlds_module, hlds_pred, prog_data.
-:- import_module io, list, map.
+:- import_module bool, io, list, map.
 
 :- pred inlining(module_info, module_info, io__state, io__state).
 :- mode inlining(in, out, di, uo) is det.
@@ -133,6 +133,14 @@
 :- mode inlining__rename_goal(in, in, in, in, out,
 		in, in, out, out, in, out) is det.
 
+	% inlining__can_inline_proc(PredId, ProcId, BuiltinState,
+	% 	InlinePromisedPure, CallingPredMarkers, ModuleInfo).
+	%
+	% Determine whether a predicate can be inlined.
+:- pred inlining__can_inline_proc(pred_id, proc_id, builtin_state,
+		bool, pred_markers, module_info).
+:- mode inlining__can_inline_proc(in, in, in, in, in, in) is semidet.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -144,13 +152,13 @@
 % HLDS modules
 :- import_module hlds_data, type_util, mode_util, goal_util, det_analysis.
 :- import_module quantification, code_aux, dead_proc_elim, dependency_graph.
-:- import_module passes_aux.
+:- import_module passes_aux, purity.
 
 % Misc
 :- import_module globals, options.
 
 % Standard library modules
-:- import_module bool, int, list, assoc_list, set, std_util, require.
+:- import_module int, list, assoc_list, set, std_util, require.
 :- import_module term, varset.
 
 %-----------------------------------------------------------------------------%
@@ -398,8 +406,10 @@
 		bool,			% Did we do any inlining in the proc?
 		bool,			% Does the goal need to be
 					% requantified?
-		bool			% Did we change the determinism
+		bool,			% Did we change the determinism
 					% of any subgoal?
+		bool			% Did we change the purity of
+					% any subgoal.
 	).
 
 :- pred inlining__in_predproc(pred_proc_id, set(pred_proc_id), inline_params,
@@ -430,17 +440,18 @@
 	DidInlining0 = no,
 	Requantify0 = no,
 	DetChanged0 = no,
+	PurityChanged0 = no,
 
 	InlineInfo0 = inline_info(VarThresh, HighLevelCode,
 		InlinedProcs, ModuleInfo0, UnivQTVars, Markers,
 		VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0,
-		DidInlining0, Requantify0, DetChanged0),
+		DidInlining0, Requantify0, DetChanged0, PurityChanged0),
 
 	inlining__inlining_in_goal(Goal0, Goal, InlineInfo0, InlineInfo),
 
 	InlineInfo = inline_info(_, _, _, _, _, _, VarSet, VarTypes,
 		TypeVarSet, TypeInfoVarMap, DidInlining, Requantify,
-		DetChanged),
+		DetChanged, PurityChanged),
 
 	pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo1),
 
@@ -469,7 +480,17 @@
 	),
 
 	map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable),
-	pred_info_set_procedures(PredInfo1, ProcTable, PredInfo),
+	pred_info_set_procedures(PredInfo1, ProcTable, PredInfo2),
+
+	(
+		PurityChanged = yes,
+		repuritycheck_proc(ModuleInfo1, PredProcId,
+			PredInfo2, PredInfo)
+	;
+		PurityChanged = no,
+		PredInfo = PredInfo2
+	),
+
 	map__det_update(PredTable0, PredId, PredInfo, PredTable),
 	module_info_set_preds(ModuleInfo1, PredTable, ModuleInfo2),
 
@@ -527,7 +548,7 @@
 	InlineInfo0 = inline_info(VarThresh, HighLevelCode,
 		InlinedProcs, ModuleInfo, HeadTypeParams, Markers,
 		VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0,
-		DidInlining0, Requantify0, DetChanged0),
+		DidInlining0, Requantify0, DetChanged0, PurityChanged0),
 
 	% should we inline this call?
 	(
@@ -563,6 +584,17 @@
 			Requantify = yes
 		),
 
+		pred_info_get_markers(PredInfo, CalleeMarkers),
+		(
+			( check_marker(CalleeMarkers, promised_pure)
+			; check_marker(CalleeMarkers, promised_semipure)
+			)
+		->
+			PurityChanged = yes
+		;
+			PurityChanged = PurityChanged0
+		),
+			
 			% If the inferred determinism of the called
 			% goal differs from the declared determinism,
 			% flag that we should re-run determinism analysis
@@ -584,12 +616,13 @@
 		TypeInfoVarMap = TypeInfoVarMap0,
 		DidInlining = DidInlining0,
 		Requantify = Requantify0,
-		DetChanged = DetChanged0
+		DetChanged = DetChanged0,
+		PurityChanged = PurityChanged0
 	),
 	InlineInfo = inline_info(VarThresh, HighLevelCode,
 		InlinedProcs, ModuleInfo, HeadTypeParams, Markers,
 		VarSet, VarTypes, TypeVarSet, TypeInfoVarMap, DidInlining,
-		Requantify, DetChanged).
+		Requantify, DetChanged, PurityChanged).
 
 inlining__inlining_in_goal(generic_call(A, B, C, D) - GoalInfo,
 		generic_call(A, B, C, D) - GoalInfo) --> [].
@@ -793,19 +826,48 @@
 
 inlining__should_inline_proc(PredId, ProcId, BuiltinState, HighLevelCode,
 		InlinedProcs, CallingPredMarkers, ModuleInfo) :-
+	InlinePromisedPure = yes,
+	inlining__can_inline_proc(PredId, ProcId, BuiltinState,
+		HighLevelCode, InlinePromisedPure,
+		CallingPredMarkers, ModuleInfo),
 
-	% don't inline builtins, the code generator will handle them
 
-	BuiltinState = not_builtin,
+	% OK, we could inline it - but should we?  Apply our heuristic.
 
-	% don't try to inline imported predicates, since we don't
-	% have the code for them.
+	(
+		module_info_pred_info(ModuleInfo, PredId, PredInfo),
+		pred_info_requested_inlining(PredInfo)
+	;
+		set__member(proc(PredId, ProcId), InlinedProcs)
+	).
 
+inlining__can_inline_proc(PredId, ProcId, BuiltinState, InlinePromisedPure,
+		CallingPredMarkers, ModuleInfo) :-
+	module_info_globals(ModuleInfo, Globals),
+	globals__lookup_bool_option(Globals, highlevel_code, HighLevelCode), 
+	inlining__can_inline_proc(PredId, ProcId, BuiltinState,
+		HighLevelCode, InlinePromisedPure,
+		CallingPredMarkers, ModuleInfo).
+
+:- pred inlining__can_inline_proc(pred_id, proc_id, builtin_state, bool,
+		bool, pred_markers, module_info).
+:- mode inlining__can_inline_proc(in, in, in, in, in, in, in) is semidet.
+
+inlining__can_inline_proc(PredId, ProcId, BuiltinState, HighLevelCode,
+		InlinePromisedPure, CallingPredMarkers, ModuleInfo) :-
+
+	% don't inline builtins, the code generator will handle them
+	BuiltinState = not_builtin,
+
 	module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, 
 		ProcInfo),
+
+	% don't try to inline imported predicates, since we don't
+	% have the code for them.
 	\+ pred_info_is_imported(PredInfo),
-		% this next line catches the case of locally defined
-		% unification predicates for imported types.
+
+	% this next line catches the case of locally defined
+	% unification predicates for imported types.
 	\+ (
 		pred_info_is_pseudo_imported(PredInfo),
 		hlds_pred__in_in_unification_proc_id(ProcId)
@@ -816,12 +878,10 @@
 	% using any of the other methods because the code generator for
 	% the methods can only handle whole procedures not code 
 	% fragments.
-
 	proc_info_eval_method(ProcInfo, eval_normal),
 	
-	% don't inlining anything we have been specifically requested
+	% Don't inlining anything we have been specifically requested
 	% not to inline.
-
 	\+ pred_info_requested_no_inlining(PredInfo),
 
 	% For the LLDS back-end,
@@ -835,8 +895,8 @@
 		( Detism = nondet ; Detism = multidet )
 	),
 
-	% only inline foreign_code if it is appropriate for
-	% the target language
+	% Only inline foreign_code if it is appropriate for
+	% the target language.
 	module_info_globals(ModuleInfo, Globals),
 	globals__get_target(Globals, Target),
 	(
@@ -857,19 +917,24 @@
 	% since this could result in joins being performed by
 	% backtracking rather than by more efficient methods in
 	% the database.
-
 	pred_info_get_markers(PredInfo, CalledPredMarkers),
 	\+ (
 		\+ check_marker(CallingPredMarkers, aditi),
 		check_marker(CalledPredMarkers, aditi)
 	),
-
-	% OK, we could inline it - but should we?  Apply our heuristic.
-
+	
 	(
-		pred_info_requested_inlining(PredInfo)
+		InlinePromisedPure = yes
 	;
-		set__member(proc(PredId, ProcId), InlinedProcs)
+		%
+		% For some optimizations (such as deforestation)
+		% we don't want to inline predicates which are
+		% promised pure because the extra impurity propagated
+		% through the goal will defeat any attempts at
+		% optimization.
+		%
+		InlinePromisedPure = no,
+		pred_info_get_promised_purity(PredInfo, (impure))
 	).
 
 	% Succeed iff it is appropriate to inline `pragma foreign_code'
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.94
diff -u -u -r1.94 intermod.m
--- compiler/intermod.m	2001/03/07 02:46:50	1.94
+++ compiler/intermod.m	2001/03/15 01:54:31
@@ -1697,6 +1697,7 @@
 intermod__should_output_marker(supp_magic, yes).
 intermod__should_output_marker(context, yes).
 intermod__should_output_marker(promised_pure, yes).
+intermod__should_output_marker(promised_semipure, yes).
 intermod__should_output_marker(terminates, yes).
 intermod__should_output_marker(does_not_terminate, yes).
 	% Termination should only be checked in the defining module.
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.365
diff -u -u -r1.365 make_hlds.m
--- compiler/make_hlds.m	2001/03/18 23:09:54	1.365
+++ compiler/make_hlds.m	2001/03/23 05:09:00
@@ -517,6 +517,10 @@
 		add_pred_marker(Module0, "promise_pure", Name, Arity,
 			ImportStatus, Context, promised_pure, [], Module)
 	;
+		{ Pragma = promise_semipure(Name, Arity) },
+		add_pred_marker(Module0, "promise_semipure", Name, Arity,
+			ImportStatus, Context, promised_semipure, [], Module)
+	;
 		{ Pragma = termination_info(PredOrFunc, SymName, ModeList, 
 			MaybeArgSizeInfo, MaybeTerminationInfo) },
 		add_pragma_termination_info(PredOrFunc, SymName, ModeList,
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.182
diff -u -u -r1.182 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	2001/02/09 03:24:07	1.182
+++ compiler/mercury_to_mercury.m	2001/03/15 01:47:28
@@ -431,6 +431,10 @@
 		mercury_output_pragma_decl(Pred, Arity, predicate,
 					   "promise_pure")
 	;
+		{ Pragma = promise_semipure(Pred, Arity) },
+		mercury_output_pragma_decl(Pred, Arity, predicate,
+					   "promise_semipure")
+	;
 		{ Pragma = termination_info(PredOrFunc, PredName, 
 			ModeList, MaybePragmaArgSizeInfo,
 			MaybePragmaTerminationInfo) },
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.63
diff -u -u -r1.63 module_qual.m
--- compiler/module_qual.m	2001/01/10 02:05:06	1.63
+++ compiler/module_qual.m	2001/03/15 02:00:38
@@ -964,6 +964,8 @@
 		Info, Info) --> [].
 qualify_pragma(promise_pure(SymName, Arity), promise_pure(SymName, Arity),
 		Info, Info) --> [].
+qualify_pragma(promise_semipure(SymName, Arity), promise_pure(SymName, Arity),
+		Info, Info) --> [].
 qualify_pragma(termination_info(PredOrFunc, SymName, ModeList0, Args, Term), 
 		termination_info(PredOrFunc, SymName, ModeList, Args, Term), 
 		Info0, Info) --> 
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.154
diff -u -u -r1.154 modules.m
--- compiler/modules.m	2001/03/01 12:06:30	1.154
+++ compiler/modules.m	2001/03/15 02:01:01
@@ -1039,6 +1039,7 @@
 pragma_allowed_in_interface(fact_table(_, _, _), no).
 pragma_allowed_in_interface(tabled(_, _, _, _, _), no).
 pragma_allowed_in_interface(promise_pure(_, _), no).
+pragma_allowed_in_interface(promise_semipure(_, _), no).
 pragma_allowed_in_interface(unused_args(_, _, _, _, _), no).
 pragma_allowed_in_interface(type_spec(_, _, _, _, _, _, _), yes).
 pragma_allowed_in_interface(termination_info(_, _, _, _, _), yes).
Index: compiler/post_typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/post_typecheck.m,v
retrieving revision 1.29
diff -u -u -r1.29 post_typecheck.m
--- compiler/post_typecheck.m	2000/10/13 13:55:51	1.29
+++ compiler/post_typecheck.m	2001/03/24 02:16:50
@@ -34,7 +34,7 @@
 :- module post_typecheck.
 :- interface.
 :- import_module hlds_data, hlds_goal, hlds_module, hlds_pred, prog_data.
-:- import_module list, io, bool.
+:- import_module list, io, bool, std_util.
 
 	% check_type_bindings(PredId, PredInfo, ModuleInfo, ReportErrors):
 	%
@@ -70,18 +70,26 @@
 :- pred post_typecheck__finish_aditi_builtin(module_info, pred_info,
 		list(prog_var), term__context, aditi_builtin, aditi_builtin,
 		simple_call_id, simple_call_id, list(mode),
-		io__state, io__state).
+		maybe(aditi_builtin_error)).
 :- mode post_typecheck__finish_aditi_builtin(in, in, in, in,
-		in, out, in, out, out, di, uo) is det.
+		in, out, in, out, out, out) is det.
+
+:- type aditi_builtin_error
+	--->	aditi_update_of_derived_relation(prog_context,
+			aditi_builtin, simple_call_id).
+
+:- pred report_aditi_builtin_error(aditi_builtin_error, io__state, io__state).
+:- mode report_aditi_builtin_error(in, di, uo) is det.
 
 	% Work out whether a var-functor unification is actually a function
 	% call. If so, replace the unification goal with a call.
 	%
 :- pred post_typecheck__resolve_unify_functor(prog_var, cons_id,
 		list(prog_var), unify_mode, unification, unify_context,
-		hlds_goal_info, module_info, pred_info, pred_info, hlds_goal).
+		hlds_goal_info, module_info, pred_info, pred_info,
+		vartypes, vartypes, prog_varset, prog_varset, hlds_goal).
 :- mode post_typecheck__resolve_unify_functor(in, in, in, in, in, in,
-		in, in, in, out, out) is det.
+		in, in, in, out, in, out, in, out, out) is det.
 
 	% Do the stuff needed to initialize the pred_infos and proc_infos
 	% so that a pred is ready for running polymorphism and then
@@ -129,7 +137,7 @@
 :- import_module mercury_to_mercury, prog_out, hlds_out, type_util.
 :- import_module globals, options.
 
-:- import_module map, set, assoc_list, bool, std_util, term, require, int.
+:- import_module map, set, assoc_list, term, require, int.
 :- import_module string, varset.
 
 %-----------------------------------------------------------------------------%
@@ -400,13 +408,14 @@
 %-----------------------------------------------------------------------------%
 
 post_typecheck__finish_aditi_builtin(_, _, _, _, aditi_call(_, _, _, _),
-		_, _, _, _) -->
+               _, _, _, _, _) :-
 	% These are only added by magic.m.
-	{ error("post_typecheck__finish_aditi_builtin: aditi_call") }.
+	error("post_typecheck__finish_aditi_builtin: aditi_call").
+
 post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
 		aditi_tuple_insert_delete(InsertDelete, PredId0), Builtin,
 		PredOrFunc - SymName0/Arity, InsertCallId,
-		Modes, IO0, IO) :-
+		Modes, MaybeError) :-
 	% make_hlds.m checks the arity, so this is guaranteed to succeed.
 	get_state_args_det(Args, OtherArgs, _, _),
 
@@ -420,7 +429,7 @@
 
 	module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
 	check_base_relation(Context, RelationPredInfo,
-		Builtin, InsertCallId, IO0, IO),
+		Builtin, InsertCallId, MaybeError),
 
 	% `aditi_insert' calls do not use the `aditi_state' argument
 	% in the tuple to insert, so set its mode to `unused'.
@@ -433,7 +442,7 @@
 
 post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context,
 		Builtin0, Builtin, PredOrFunc - SymName0/Arity,
-		UpdateCallId, Modes, IO0, IO) :-
+		UpdateCallId, Modes, MaybeError) :-
 	Builtin0 = aditi_insert_delete_modify(InsertDelMod, PredId0, Syntax),
 	UnchangedArgTypes = (pred(X::in, X::out) is det),
 	(
@@ -467,7 +476,7 @@
 
 	module_info_pred_info(ModuleInfo, PredId, RelationPredInfo),
 	check_base_relation(Context, RelationPredInfo,
-		Builtin, UpdateCallId, IO0, IO),
+		Builtin, UpdateCallId, MaybeError),
 
 	pred_info_arg_types(RelationPredInfo, ArgTypes),
 	post_typecheck__insert_delete_modify_closure_info(InsertDelMod,
@@ -584,27 +593,30 @@
 	% Report an error if a predicate modified by an Aditi builtin
 	% is not a base relation.
 :- pred check_base_relation(prog_context, pred_info, aditi_builtin,
-		simple_call_id, io__state, io__state).
-:- mode check_base_relation(in, in, in, in, di, uo) is det.
+	simple_call_id, maybe(aditi_builtin_error)).
+:- mode check_base_relation(in, in, in, in, out) is det.
 
-check_base_relation(Context, PredInfo, Builtin, CallId) -->
-	( { hlds_pred__pred_info_is_base_relation(PredInfo) } ->
-		[]
+check_base_relation(Context, PredInfo, Builtin, CallId, MaybeError) :-
+	( hlds_pred__pred_info_is_base_relation(PredInfo) ->
+		MaybeError = no
 	;
-		io__set_exit_status(1),
-		prog_out__write_context(Context),
-		io__write_string("In "),
-		hlds_out__write_call_id(
-			generic_call(aditi_builtin(Builtin, CallId))
-		),
-		io__write_string(":\n"),
-		prog_out__write_context(Context),
-		io__write_string("  error: the modified "),
-		{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
-		hlds_out__write_pred_or_func(PredOrFunc),
-		io__write_string(" is not a base relation.\n")
+		MaybeError = yes(aditi_update_of_derived_relation(Context,
+					Builtin, CallId))
 	).
 
+report_aditi_builtin_error(
+		aditi_update_of_derived_relation(Context, Builtin, CallId)) -->
+	io__set_exit_status(1),
+	prog_out__write_context(Context),
+	io__write_string("In "),
+	hlds_out__write_call_id(generic_call(aditi_builtin(Builtin, CallId))),
+	io__write_string(":\n"),
+	prog_out__write_context(Context),
+	io__write_string("  error: the modified "),
+	{ CallId = PredOrFunc - _ },
+	hlds_out__write_pred_or_func(PredOrFunc),
+	io__write_string(" is not a base relation.\n").
+
 %-----------------------------------------------------------------------------%
 
 	% 
@@ -951,11 +963,9 @@
 
 post_typecheck__resolve_unify_functor(X0, ConsId0, ArgVars0, Mode0,
 		Unification0, UnifyContext, GoalInfo0,
-		ModuleInfo0, PredInfo0, PredInfo, Goal) :-
+		ModuleInfo0, PredInfo0, PredInfo, VarTypes0, VarTypes,
+		VarSet0, VarSet, Goal) :-
 
-        pred_info_clauses_info(PredInfo0, ClausesInfo),
-        clauses_info_vartypes(ClausesInfo, VarTypes0),
-
 	map__lookup(VarTypes0, X0, TypeOfX),
 	list__length(ArgVars0, Arity),
 	(
@@ -983,6 +993,8 @@
 			ArgVars, Modes, Det),
 
 		PredInfo = PredInfo0,
+		VarTypes = VarTypes0,
+		VarSet = VarSet0,
 		Goal = HOCall - GoalInfo0
 	;
 		%
@@ -1042,6 +1054,8 @@
 			yes(FuncCallUnifyContext), QualifiedFuncName),
 
 		PredInfo = PredInfo0,
+		VarTypes = VarTypes0,
+		VarSet = VarSet0,
 		Goal = FuncCall - GoalInfo0
 	;
 		%
@@ -1071,7 +1085,8 @@
 			ConsId0, TypeOfX, ArgTypes0)
 	->
 		post_typecheck__finish_field_access_function(ModuleInfo0,
-			PredInfo0, PredInfo, AccessType, FieldName,
+			PredInfo0, PredInfo, VarTypes0, VarTypes,
+			VarSet0, VarSet, AccessType, FieldName,
 			UnifyContext, X0, ArgVars0, GoalInfo0, Goal)
 	;
 		%
@@ -1079,6 +1094,8 @@
 		% we leave alone
 		%
 		PredInfo = PredInfo0,
+		VarTypes = VarTypes0,
+		VarSet = VarSet0,
 		Goal = unify(X0, functor(ConsId0, ArgVars0), Mode0,
 				Unification0, UnifyContext) - GoalInfo0
 	).
@@ -1118,53 +1135,58 @@
 	% shouldn't be too much worse than if the goals were special cases.
 	%
 :- pred post_typecheck__finish_field_access_function(module_info, pred_info,
-		pred_info, field_access_type, ctor_field_name,
+		pred_info, vartypes, vartypes, prog_varset, prog_varset,
+		field_access_type, ctor_field_name,
 		unify_context, prog_var, list(prog_var),
 		hlds_goal_info, hlds_goal).
-:- mode post_typecheck__finish_field_access_function(in, in, out, in, in,
-		in, in, in, in, out) is det.
+:- mode post_typecheck__finish_field_access_function(in, in, out, in, out,
+		in, out, in, in, in, in, in, in, out) is det.
 
 post_typecheck__finish_field_access_function(ModuleInfo, PredInfo0, PredInfo,
-		AccessType, FieldName, UnifyContext,
-		Var, Args, GoalInfo, GoalExpr - GoalInfo) :-
+		VarTypes0, VarTypes, VarSet0, VarSet, AccessType, FieldName,
+		UnifyContext, Var, Args, GoalInfo, GoalExpr - GoalInfo) :-
 	(
 		AccessType = get,
 		field_extraction_function_args(Args, TermVar),
 		post_typecheck__translate_get_function(ModuleInfo,
-			PredInfo0, PredInfo, FieldName, UnifyContext,
+			PredInfo0, PredInfo, VarTypes0, VarTypes,
+			VarSet0, VarSet, FieldName, UnifyContext,
 			Var, TermVar, GoalInfo, GoalExpr)
 	;
 		AccessType = set,
 		field_update_function_args(Args, TermInputVar, FieldVar),
 		post_typecheck__translate_set_function(ModuleInfo,
-			PredInfo0, PredInfo, FieldName, UnifyContext,
+			PredInfo0, PredInfo, VarTypes0, VarTypes,
+			VarSet0, VarSet, FieldName, UnifyContext,
 			FieldVar, TermInputVar, Var,
 			GoalInfo, GoalExpr)
 	).
 
 :- pred post_typecheck__translate_get_function(module_info,
-		pred_info, pred_info, ctor_field_name, unify_context, prog_var,
-		prog_var, hlds_goal_info, hlds_goal_expr).
-:- mode post_typecheck__translate_get_function(in, in, out,
+		pred_info, pred_info, vartypes, vartypes,
+		prog_varset, prog_varset, ctor_field_name,
+		unify_context, prog_var, prog_var,
+		hlds_goal_info, hlds_goal_expr).
+:- mode post_typecheck__translate_get_function(in, in, out, in, out, in, out,
 		in, in, in, in, in, out) is det.
 
 post_typecheck__translate_get_function(ModuleInfo, PredInfo0, PredInfo,
-		FieldName, UnifyContext, FieldVar, TermInputVar,
-		OldGoalInfo, GoalExpr) :-
-	pred_info_clauses_info(PredInfo0, ClausesInfo0),
-	clauses_info_vartypes(ClausesInfo0, VarTypes0),
+		VarTypes0, VarTypes, VarSet0, VarSet, FieldName, UnifyContext,
+		FieldVar, TermInputVar, OldGoalInfo, GoalExpr) :-
 	map__lookup(VarTypes0, TermInputVar, TermType),
 	get_constructor_containing_field(ModuleInfo, TermType, FieldName,
 		ConsId, FieldNumber),
 
 	get_cons_id_arg_types_adding_existq_tvars(ModuleInfo, ConsId,
-		TermType, ArgTypes, _, PredInfo0, PredInfo1),
+		TermType, ArgTypes, _, PredInfo0, PredInfo),
 
 	split_list_at_index(FieldNumber, ArgTypes,
 		TypesBeforeField, _, TypesAfterField),
 
-	make_new_vars(TypesBeforeField, VarsBeforeField, PredInfo1, PredInfo2),
-	make_new_vars(TypesAfterField, VarsAfterField, PredInfo2, PredInfo),
+	make_new_vars(TypesBeforeField, VarsBeforeField,
+		VarTypes0, VarTypes1, VarSet0, VarSet1),
+	make_new_vars(TypesAfterField, VarsAfterField,
+		VarTypes1, VarTypes, VarSet1, VarSet),
 
 	list__append(VarsBeforeField, [FieldVar | VarsAfterField], ArgVars),
 
@@ -1176,30 +1198,32 @@
 	FunctorGoal = GoalExpr - _.
 
 :- pred post_typecheck__translate_set_function(module_info,
-		pred_info, pred_info, ctor_field_name, unify_context, prog_var,
-		prog_var, prog_var, hlds_goal_info, hlds_goal_expr).
-:- mode post_typecheck__translate_set_function(in, in, out,
+		pred_info, pred_info, vartypes, vartypes,
+		prog_varset, prog_varset, ctor_field_name, unify_context,
+		prog_var, prog_var, prog_var, hlds_goal_info, hlds_goal_expr).
+:- mode post_typecheck__translate_set_function(in, in, out, in, out, in, out,
 		in, in, in, in, in, in, out) is det.
 
 post_typecheck__translate_set_function(ModuleInfo, PredInfo0, PredInfo,
-		FieldName, UnifyContext, FieldVar, TermInputVar, TermOutputVar,
-		OldGoalInfo, Goal) :-
-	pred_info_clauses_info(PredInfo0, ClausesInfo0),
-	clauses_info_vartypes(ClausesInfo0, VarTypes0),
+		VarTypes0, VarTypes, VarSet0, VarSet, FieldName, UnifyContext,
+		FieldVar, TermInputVar, TermOutputVar, OldGoalInfo, Goal) :-
 	map__lookup(VarTypes0, TermInputVar, TermType),
 
 	get_constructor_containing_field(ModuleInfo, TermType, FieldName,
 		ConsId0, FieldNumber),
 
 	get_cons_id_arg_types_adding_existq_tvars(ModuleInfo, ConsId0,
-		TermType, ArgTypes, ExistQVars, PredInfo0, PredInfo1),
+		TermType, ArgTypes, ExistQVars, PredInfo0, PredInfo),
 
 	split_list_at_index(FieldNumber, ArgTypes,
 		TypesBeforeField, TermFieldType, TypesAfterField),
 
-	make_new_vars(TypesBeforeField, VarsBeforeField, PredInfo1, PredInfo2),
-	make_new_var(TermFieldType, SingletonFieldVar, PredInfo2, PredInfo3),
-	make_new_vars(TypesAfterField, VarsAfterField, PredInfo3, PredInfo),
+	make_new_vars(TypesBeforeField, VarsBeforeField, VarTypes0, VarTypes1,
+		VarSet0, VarSet1),
+	make_new_var(TermFieldType, SingletonFieldVar, VarTypes1, VarTypes2,
+		VarSet1, VarSet2),
+	make_new_vars(TypesAfterField, VarsAfterField, VarTypes2, VarTypes,
+		VarSet2, VarSet),
 
 	%
 	% Build a goal to deconstruct the input.
@@ -1393,33 +1417,23 @@
 	goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo), 
 	Goal = GoalExpr0 - GoalInfo.
 
-:- pred make_new_vars(list(type), list(prog_var), pred_info, pred_info).
-:- mode make_new_vars(in, out, in, out) is det.
+:- pred make_new_vars(list(type), list(prog_var), vartypes, vartypes,
+		prog_varset, prog_varset).
+:- mode make_new_vars(in, out, in, out, in, out) is det.
 
-make_new_vars(Types, Vars, PredInfo0, PredInfo) :-
-	pred_info_clauses_info(PredInfo0, ClausesInfo0),
-	clauses_info_varset(ClausesInfo0, VarSet0),
-	clauses_info_vartypes(ClausesInfo0, VarTypes0),
+make_new_vars(Types, Vars, VarTypes0, VarTypes, VarSet0, VarSet) :-
 	list__length(Types, NumVars),
 	varset__new_vars(VarSet0, NumVars, Vars, VarSet),
 	map__det_insert_from_corresponding_lists(VarTypes0,
-		Vars, Types, VarTypes),
-	clauses_info_set_varset(ClausesInfo0, VarSet, ClausesInfo1),
-	clauses_info_set_vartypes(ClausesInfo1, VarTypes, ClausesInfo),
-	pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo).
+		Vars, Types, VarTypes).
 
-:- pred make_new_var((type), prog_var, pred_info, pred_info).
-:- mode make_new_var(in, out, in, out) is det.
+:- pred make_new_var((type), prog_var, vartypes, vartypes,
+		prog_varset, prog_varset).
+:- mode make_new_var(in, out, in, out, in, out) is det.
 
-make_new_var(Type, Var, PredInfo0, PredInfo) :-
-	pred_info_clauses_info(PredInfo0, ClausesInfo0),
-	clauses_info_varset(ClausesInfo0, VarSet0),
-	clauses_info_vartypes(ClausesInfo0, VarTypes0),
+make_new_var(Type, Var, VarTypes0, VarTypes, VarSet0, VarSet) :-
 	varset__new_var(VarSet0, Var, VarSet),
-	map__det_insert(VarTypes0, Var, Type, VarTypes),
-	clauses_info_set_varset(ClausesInfo0, VarSet, ClausesInfo1),
-	clauses_info_set_vartypes(ClausesInfo1, VarTypes, ClausesInfo),
-	pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo).
+	map__det_insert(VarTypes0, Var, Type, VarTypes).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.63
diff -u -u -r1.63 prog_data.m
--- compiler/prog_data.m	2000/12/06 06:05:14	1.63
+++ compiler/prog_data.m	2001/03/15 01:46:46
@@ -247,6 +247,9 @@
 	;	promise_pure(sym_name, arity)
 			% Predname, Arity
 
+	;	promise_semipure(sym_name, arity)
+			% Predname, Arity
+
 	;	termination_info(pred_or_func, sym_name, list(mode),
 				maybe(pragma_arg_size_info),
 				maybe(pragma_termination_info))
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.28
diff -u -u -r1.28 prog_io_pragma.m
--- compiler/prog_io_pragma.m	2001/03/22 14:38:41	1.28
+++ compiler/prog_io_pragma.m	2001/03/23 05:09:07
@@ -965,6 +965,13 @@
 			Pragma = promise_pure(Name, Arity)),
 		PragmaTerms, ErrorTerm, Result).
 
+parse_pragma_type(ModuleName, "promise_semipure", PragmaTerms, ErrorTerm,
+		_VarSet, Result) :-
+	parse_simple_pragma(ModuleName, "promise_semipure",
+		lambda([Name::in, Arity::in, Pragma::out] is det,
+			Pragma = promise_semipure(Name, Arity)),
+		PragmaTerms, ErrorTerm, Result).
+
 parse_pragma_type(ModuleName, "termination_info", PragmaTerms, ErrorTerm,
 	_VarSet, Result) :-
     (
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.28
diff -u -u -r1.28 purity.m
--- compiler/purity.m	2000/11/17 17:48:35	1.28
+++ compiler/purity.m	2001/03/24 01:39:02
@@ -122,8 +122,8 @@
 :- module purity.
 :- interface.
 
-:- import_module prog_data, hlds_module, hlds_goal.
-:- import_module io, bool.
+:- import_module prog_data, hlds_module, hlds_goal, hlds_pred.
+:- import_module io, bool, list.
 
 % The purity type itself is defined in prog_data.m as follows:
 % :- type purity	--->	pure
@@ -141,6 +141,15 @@
 :- pred puritycheck(bool, module_info, bool, module_info, io__state, io__state).
 :- mode puritycheck(in, in, out, out, di, uo) is det.
 
+% Rerun purity checking on a procedure after an optimization pass has
+% performed transformations which might affect the procedure's purity.
+% repuritycheck_proc makes sure that the goal_infos contain the correct
+% purity, and that the pred_info contains the promised_pure or
+% promised_semipure markers which might be needed if a promised pure
+% procedure was inlined into the procedure being checked. 
+:- pred repuritycheck_proc(module_info, pred_proc_id, pred_info, pred_info).
+:- mode repuritycheck_proc(in, in, in, out) is det.
+
 %  Sort of a "maximum" for impurity.
 :- pred worst_purity(purity, purity, purity).
 :- mode worst_purity(in, in, out) is det.
@@ -180,6 +189,10 @@
 :- pred goal_info_is_impure(hlds_goal_info).
 :- mode goal_info_is_impure(in) is semidet.
 
+% Work out the purity of a list of goals. 
+:- pred goal_list_purity(list(hlds_goal), purity).
+:- mode goal_list_purity(in, out) is det.
+
 % Give an error message for unifications marked impure/semipure that are  
 % not function calls (e.g. impure X = 4)
 :- pred impure_unification_expr_error(prog_context, purity,
@@ -188,14 +201,14 @@
 
 :- implementation.
 
-:- import_module hlds_pred, hlds_data, prog_io_util.
+:- import_module hlds_data, prog_io_util.
 :- import_module type_util, mode_util, code_util, prog_data, unify_proc.
 :- import_module globals, options, mercury_to_mercury, hlds_out.
 :- import_module passes_aux, typecheck, module_qual, clause_to_proc.
 :- import_module inst_util, prog_out.
 :- import_module post_typecheck.
 
-:- import_module list, map, varset, term, string, require, std_util.
+:- import_module map, varset, term, string, require, std_util.
 :- import_module assoc_list, bool, int, set.
 
 %-----------------------------------------------------------------------------%
@@ -239,9 +252,11 @@
 	goal_info_remove_feature(GoalInfo0, (semipure), GoalInfo1),
 	goal_info_remove_feature(GoalInfo1, (impure), GoalInfo).
 add_goal_info_purity_feature(GoalInfo0, (semipure), GoalInfo) :-
-	goal_info_add_feature(GoalInfo0, (semipure), GoalInfo).
+	goal_info_remove_feature(GoalInfo0, (impure), GoalInfo1),
+	goal_info_add_feature(GoalInfo1, (semipure), GoalInfo).
 add_goal_info_purity_feature(GoalInfo0, (impure), GoalInfo) :-
-	goal_info_add_feature(GoalInfo0, (impure), GoalInfo).
+	goal_info_remove_feature(GoalInfo0, (semipure), GoalInfo1),
+	goal_info_add_feature(GoalInfo1, (impure), GoalInfo).
 
 
 infer_goal_info_purity(GoalInfo, Purity) :-
@@ -256,6 +271,13 @@
 	).
 
 
+goal_list_purity(Goals, Purity) :-
+	Purity = list__foldl(
+			(func(_ - GoalInfo, Purity0) = Purity1 :-
+				infer_goal_info_purity(GoalInfo, GoalPurity),
+		    		worst_purity(GoalPurity, Purity0, Purity1)
+			), Goals, pure).
+			
 goal_info_is_pure(GoalInfo) :-
 	\+ goal_info_has_feature(GoalInfo, (impure)),
 	\+ goal_info_has_feature(GoalInfo, (semipure)).
@@ -396,7 +418,7 @@
 
 puritycheck_pred(PredId, PredInfo0, PredInfo, ModuleInfo, NumErrors) -->
 	{ pred_info_get_purity(PredInfo0, DeclPurity) } ,
-	{ pred_info_get_promised_pure(PredInfo0, Promised) },
+	{ pred_info_get_promised_purity(PredInfo0, PromisedPurity) },
 	( { pred_info_get_goal_type(PredInfo0, pragmas) } ->
 		{ WorstPurity = (impure) },
 		{ IsPragmaCCode = yes },
@@ -408,21 +430,34 @@
 	;   
 		{ pred_info_clauses_info(PredInfo0, ClausesInfo0) },
 		{ clauses_info_clauses(ClausesInfo0, Clauses0) },
-		compute_purity(Clauses0, Clauses, PredInfo0, PredInfo1,
-				ModuleInfo, pure, Purity, 0, NumErrors0),
-
-		% The code in post_typecheck.m to handle field access functions
-		% may modify the varset and vartypes in the clauses_info.
-		{ pred_info_clauses_info(PredInfo1, ClausesInfo1) },
-		{ clauses_info_set_clauses(ClausesInfo1, Clauses,
+		{ clauses_info_vartypes(ClausesInfo0, VarTypes0) },
+		{ clauses_info_varset(ClausesInfo0, VarSet0) },
+		{ RunPostTypecheck = yes },
+		{ PurityInfo0 = purity_info(ModuleInfo, RunPostTypecheck,
+			PredInfo0, VarTypes0, VarSet0, []) },
+		{ compute_purity(Clauses0, Clauses, pure, Purity,
+			PurityInfo0, PurityInfo) },
+		{ PurityInfo = purity_info(_, _, PredInfo1,
+			VarTypes, VarSet, RevMessages) },
+		{ clauses_info_set_vartypes(ClausesInfo0,
+			VarTypes, ClausesInfo1) },
+		{ clauses_info_set_varset(ClausesInfo1,
+			VarSet, ClausesInfo2) },
+		{ Messages = list__reverse(RevMessages) },
+		list__foldl(report_post_typecheck_message(ModuleInfo),
+			Messages),
+		{ NumErrors0 = list__length(
+				list__filter((pred(error(_)::in) is semidet),
+				Messages)) },
+		{ clauses_info_set_clauses(ClausesInfo2, Clauses,
 				ClausesInfo) },
 		{ pred_info_set_clauses_info(PredInfo1, ClausesInfo,
 				PredInfo) },
 		{ WorstPurity = Purity },
 		{ IsPragmaCCode = no }
 	),
-	{ perform_pred_purity_checks(PredInfo, Purity, DeclPurity, Promised,
-		IsPragmaCCode, PurityCheckResult) },
+	{ perform_pred_purity_checks(PredInfo, Purity, DeclPurity,
+		PromisedPurity, IsPragmaCCode, PurityCheckResult) },
 	( { PurityCheckResult = inconsistent_promise },
 		{ NumErrors is NumErrors0 + 1 },
 		error_inconsistent_promise(ModuleInfo, PredInfo, PredId,
@@ -436,123 +471,173 @@
 		error_inferred_impure(ModuleInfo, PredInfo, PredId, Purity)
 	; { PurityCheckResult = unnecessary_promise_pure },
 		{ NumErrors = NumErrors0 },
-		warn_unnecessary_promise_pure(ModuleInfo, PredInfo, PredId)
-	; { PurityCheckResult = no_impure_in_closure },
-		{ error("puritycheck_pred: preds cannot be in closures") }
+		warn_unnecessary_promise_pure(ModuleInfo, PredInfo, PredId,
+			PromisedPurity)
 	; { PurityCheckResult = no_worries },
 		{ NumErrors = NumErrors0 }
 	).
 
+repuritycheck_proc(ModuleInfo, proc(_PredId, ProcId), PredInfo0, PredInfo) :-
+	pred_info_procedures(PredInfo0, Procs0),
+	map__lookup(Procs0, ProcId, ProcInfo0),
+	proc_info_goal(ProcInfo0, Goal0),
+	proc_info_vartypes(ProcInfo0, VarTypes0),
+	proc_info_varset(ProcInfo0, VarSet0),
+	RunPostTypeCheck = no,
+	PurityInfo0 = purity_info(ModuleInfo, RunPostTypeCheck,
+		PredInfo0, VarTypes0, VarSet0, []),
+	InClosure = no,
+	compute_goal_purity(Goal0, Goal, InClosure, Bodypurity,
+		PurityInfo0, PurityInfo),
+	PurityInfo = purity_info(_, _, PredInfo1, VarTypes, VarSet, _),
+	proc_info_set_goal(ProcInfo0, Goal, ProcInfo1),
+	proc_info_set_vartypes(ProcInfo1, VarTypes, ProcInfo2),
+	proc_info_set_varset(ProcInfo2, VarSet, ProcInfo),
+	map__det_update(Procs0, ProcId, ProcInfo, Procs),
+	pred_info_set_procedures(PredInfo1, Procs, PredInfo2),
 
+	%
+	% A predicate should never become less pure after inlining,
+	% so update any promises in the pred_info if the purity of
+	% the goal worsened (for example if a promised pure predicate
+	% was inlined).
+	%
+	pred_info_get_purity(PredInfo2, OldPurity),
+	pred_info_get_markers(PredInfo2, Markers0),
+	(
+		less_pure(Bodypurity, OldPurity)
+	->
+		(
+			OldPurity = pure,
+			remove_marker(Markers0, promised_semipure, Markers1),
+			add_marker(Markers1, promised_pure, Markers)
+		;
+			OldPurity = (semipure),
+			add_marker(Markers0, promised_semipure, Markers)
+		;
+			OldPurity = (impure),
+			Markers = Markers0
+		),
+		pred_info_set_markers(PredInfo2, Markers, PredInfo)
+	;
+		less_pure(OldPurity, Bodypurity),
+		pred_info_procids(PredInfo2, [_])
+	->
+
+		%
+		% If there is only one procedure, update the
+		% purity in the pred_info if the purity improved.
+		%
+		% XXX Storing the purity in the pred_info is the
+		% wrong thing to do, because optimizations can
+		% make some procedures more pure than others.
+		%
+
+		(
+			Bodypurity = pure,
+			remove_marker(Markers0, (impure), Markers1),
+			remove_marker(Markers1, (semipure), Markers)
+		;
+			Bodypurity = (semipure),
+			remove_marker(Markers0, (impure), Markers1),
+			add_marker(Markers1, (semipure), Markers)
+		;
+			Bodypurity = (impure),
+			Markers = Markers0
+		),
+		pred_info_set_markers(PredInfo2, Markers, PredInfo)
+	;
+		PredInfo = PredInfo2
+	).
+
 % Infer the purity of a single (non-pragma c_code) predicate
+
+:- pred compute_purity(list(clause), list(clause),
+	purity, purity, purity_info, purity_info).
+:- mode compute_purity(in, out, in, out, in, out) is det.
 
-:- pred compute_purity(list(clause), list(clause), pred_info, pred_info,
-	module_info, purity, purity, int, int, io__state, io__state).
-:- mode compute_purity(in, out, in, out, in, in, out, in, out, di, uo) is det.
-
-compute_purity([], [], PredInfo, PredInfo, _, Purity, Purity,
-		NumErrors, NumErrors) -->
-	[].
-compute_purity([Clause0|Clauses0], [Clause|Clauses], PredInfo0, PredInfo,
-		ModuleInfo, Purity0, Purity, NumErrors0, NumErrors) -->
+compute_purity([], [], Purity, Purity) --> [].
+compute_purity([Clause0|Clauses0], [Clause|Clauses], Purity0, Purity) -->
 	{ Clause0 = clause(Ids, Body0 - Info0, Context) },
-	compute_expr_purity(Body0, Body, Info0, PredInfo0, PredInfo1,
-			ModuleInfo, no, Bodypurity, NumErrors0, NumErrors1),
+	compute_expr_purity(Body0, Body, Info0, no, Bodypurity),
 	{ add_goal_info_purity_feature(Info0, Bodypurity, Info) },
 	{ worst_purity(Purity0, Bodypurity, Purity1) },
 	{ Clause = clause(Ids, Body - Info, Context) },
-	compute_purity(Clauses0, Clauses, PredInfo1, PredInfo, ModuleInfo,
-		       Purity1, Purity, NumErrors1, NumErrors).
+	compute_purity(Clauses0, Clauses, Purity1, Purity).
 
-:- pred compute_expr_purity(hlds_goal_expr, hlds_goal_expr, hlds_goal_info,
-	pred_info, pred_info, module_info, bool, purity, int, int,
-	io__state, io__state).
-:- mode compute_expr_purity(in, out, in, in, out, in, in, out, in, out,
-	di, uo) is det.
+:- pred compute_expr_purity(hlds_goal_expr, hlds_goal_expr,
+	hlds_goal_info, bool, purity, purity_info, purity_info).
+:- mode compute_expr_purity(in, out, in, in, out, in, out) is det.
 
-compute_expr_purity(conj(Goals0), conj(Goals), _, PredInfo0, PredInfo,
-		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
-	compute_goals_purity(Goals0, Goals, PredInfo0, PredInfo, ModuleInfo,
-			     InClosure, pure, Purity, NumErrors0, NumErrors).
+compute_expr_purity(conj(Goals0), conj(Goals), _, InClosure, Purity) -->
+	compute_goals_purity(Goals0, Goals, InClosure, pure, Purity).
 compute_expr_purity(par_conj(Goals0, SM), par_conj(Goals, SM), _,
-		PredInfo0, PredInfo, ModuleInfo, InClosure, Purity,
-		NumErrors0, NumErrors) -->
-	compute_goals_purity(Goals0, Goals, PredInfo0, PredInfo, ModuleInfo,
-			     InClosure, pure, Purity, NumErrors0, NumErrors).
+		InClosure, Purity) -->
+	compute_goals_purity(Goals0, Goals, InClosure, pure, Purity).
 compute_expr_purity(call(PredId0,ProcId,Vars,BIState,UContext,Name0),
-		call(PredId,ProcId,Vars,BIState,UContext,Name), GoalInfo,
-		PredInfo, PredInfo, ModuleInfo, InClosure, ActualPurity,
-		NumErrors0, NumErrors) -->
-	{ post_typecheck__resolve_pred_overloading(PredId0, Vars, PredInfo,
-		ModuleInfo, Name0, Name, PredId) },
-	{ module_info_preds(ModuleInfo, Preds) },
-	{ map__lookup(Preds, PredId, CalleePredInfo) },
-	{ pred_info_get_purity(CalleePredInfo, ActualPurity) },
+		call(PredId,ProcId,Vars,BIState,UContext,Name),
+		GoalInfo, InClosure, ActualPurity) -->
+	RunPostTypecheck =^ run_post_typecheck,
+	PredInfo =^ pred_info,
+	ModuleInfo =^ module_info,
+	{
+		RunPostTypecheck = yes,
+		post_typecheck__resolve_pred_overloading(PredId0,
+			Vars, PredInfo, ModuleInfo, Name0, Name, PredId)
+	;	
+		RunPostTypecheck = no,
+		PredId = PredId0,
+		Name = Name0
+	},
 	{ infer_goal_info_purity(GoalInfo, DeclaredPurity) },
 	{ goal_info_get_context(GoalInfo, CallContext) },
 
-	{ perform_goal_purity_checks(PredInfo, ActualPurity, DeclaredPurity,
-		InClosure, PurityCheckResult) },
-	( { PurityCheckResult = insufficient_decl },
-		error_missing_body_impurity_decl(ModuleInfo, CalleePredInfo,
-						 PredId, CallContext,
-						 ActualPurity),
-		{ NumErrors is NumErrors0 + 1 }
-	; { PurityCheckResult = unnecessary_decl },
-		warn_unnecessary_body_impurity_decl(ModuleInfo, CalleePredInfo,
-						    PredId, CallContext,
-						    ActualPurity,
-						    DeclaredPurity),
-		{ NumErrors = NumErrors0 }
-	; { PurityCheckResult = no_impure_in_closure },
-			% We catch this error at the creation of the closure
-			% It might also make sense to flag missing
-			% impurity declarations inside closures, but we
-			% don't do so currently.
-		{ NumErrors = NumErrors0 }
-	; { PurityCheckResult = inconsistent_promise },
-		{ error("compute_expr_purity: goals cannot have promises") }
-	; { PurityCheckResult = unnecessary_promise_pure },
-		{ error("compute_expr_purity: goals cannot have promises") }
-	; { PurityCheckResult = no_worries },
-		{ NumErrors = NumErrors0 }
-	).
+	perform_goal_purity_checks(CallContext, PredId,
+		DeclaredPurity, InClosure, ActualPurity).
 
-
-compute_expr_purity(generic_call(GenericCall0, Args, Modes0, Det), GoalExpr,
-		GoalInfo, PredInfo0, PredInfo, ModuleInfo, _InClosure, Purity,
-		NumErrors0, NumErrors) -->
+compute_expr_purity(generic_call(GenericCall0, Args, Modes0, Det),
+		GoalExpr, GoalInfo, _InClosure, Purity) -->
 	(
 		{ GenericCall0 = higher_order(_, _, _) },
 		{ Purity = pure },
-		{ PredInfo = PredInfo0 },
-		{ NumErrors = NumErrors0 },
 		{ GoalExpr = generic_call(GenericCall0, Args, Modes0, Det) }
 	;
 		{ GenericCall0 = class_method(_, _, _, _) },
 		{ Purity = pure },
-		{ PredInfo = PredInfo0 },
-		{ NumErrors = NumErrors0 },
 		{ GoalExpr = generic_call(GenericCall0, Args, Modes0, Det) }
 	;
 		{ GenericCall0 = aditi_builtin(Builtin0, CallId0) },
 		{ Purity = pure },
 		{ goal_info_get_context(GoalInfo, Context) },
-		post_typecheck__finish_aditi_builtin(ModuleInfo, PredInfo,
-			Args, Context, Builtin0, Builtin,
-			CallId0, CallId, Modes),
-		{ GenericCall = aditi_builtin(Builtin, CallId) },
-		{ GoalExpr = generic_call(GenericCall, Args, Modes, Det) },
-		{ PredInfo = PredInfo0 },
-		{ NumErrors = NumErrors0 }
+		RunPostTypecheck =^ run_post_typecheck,
+		(
+			{ RunPostTypecheck = yes },
+			ModuleInfo =^ module_info,
+			PredInfo =^ pred_info,
+			{ post_typecheck__finish_aditi_builtin(ModuleInfo,
+				PredInfo, Args, Context, Builtin0, Builtin,
+				CallId0, CallId, Modes, MaybeMessage) },
+			(
+				{ MaybeMessage = yes(Message) },
+				purity_info_add_message(
+					error(aditi_builtin_error(Message)))
+			;
+				{ MaybeMessage = no }
+			),
+			{ GenericCall = aditi_builtin(Builtin, CallId) }
+		;
+			{ RunPostTypecheck = no },
+			{ GenericCall = GenericCall0 },
+			{ Modes = Modes0 }
+		),
+
+		{ GoalExpr = generic_call(GenericCall, Args, Modes, Det) }
 	).
 compute_expr_purity(switch(Var,Canfail,Cases0,Storemap),
-		switch(Var,Canfail,Cases,Storemap), _, PredInfo0, PredInfo,
-		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
-	compute_cases_purity(Cases0, Cases, PredInfo0, PredInfo, ModuleInfo,
-			     InClosure, pure, Purity, NumErrors0, NumErrors).
-compute_expr_purity(Unif0, GoalExpr, GoalInfo, PredInfo0, PredInfo,
-		ModuleInfo, InClosure, ActualPurity, NumErrors0, NumErrors) -->
+		switch(Var,Canfail,Cases,Storemap), _, InClosure, Purity) -->
+	compute_cases_purity(Cases0, Cases, InClosure, pure, Purity).
+compute_expr_purity(Unif0, GoalExpr, GoalInfo, InClosure,
+		ActualPurity) -->
 	{ Unif0 = unify(Var, RHS0, Mode, Unification, UnifyContext) },
 	(
 		{ RHS0 = lambda_goal(F, EvalMethod, FixModes, H, Vars,
@@ -560,11 +645,11 @@
 	->
 		{ RHS = lambda_goal(F, EvalMethod, modes_are_ok, H, Vars,
 			Modes, K, Goal - Info0) },
-		compute_expr_purity(Goal0, Goal, Info0, PredInfo0, PredInfo,
-			ModuleInfo, yes, Purity, NumErrors0, NumErrors1),
-		error_if_closure_impure(GoalInfo, Purity,
-					NumErrors1, NumErrors),
+		compute_expr_purity(Goal0, Goal, Info0, yes, Purity),
+		error_if_closure_impure(GoalInfo, Purity),
 
+		VarTypes =^ vartypes,
+
 		{
 			FixModes = modes_are_ok,
 			Modes = Modes0
@@ -590,8 +675,6 @@
 				% a `ui' mode for their aditi_state.
 				StateMode = aditi_mui_mode
 			),
-			pred_info_clauses_info(PredInfo, ClausesInfo),
-			clauses_info_vartypes(ClausesInfo, VarTypes),
 			map__apply_to_list(Vars, VarTypes, LambdaVarTypes),
 			SeenState = no,
 			fix_aditi_state_modes(SeenState, StateMode,
@@ -602,95 +685,92 @@
 	;
 		{ RHS0 = functor(ConsId, Args) } 
 	->
-		{ post_typecheck__resolve_unify_functor(Var, ConsId, Args,
-			Mode, Unification, UnifyContext, GoalInfo,
-			ModuleInfo, PredInfo0, PredInfo1, Goal1) },
+		RunPostTypecheck =^ run_post_typecheck,
+		(
+			{ RunPostTypecheck = yes },
+			ModuleInfo =^ module_info,
+			PredInfo0 =^ pred_info,
+			VarTypes0 =^ vartypes,
+			VarSet0 =^ varset,
+			{ post_typecheck__resolve_unify_functor(Var, ConsId,
+				Args, Mode, Unification, UnifyContext,
+				GoalInfo, ModuleInfo, PredInfo0, PredInfo,
+				VarTypes0, VarTypes, VarSet0, VarSet, Goal1) },
+			^ vartypes := VarTypes,
+			^ varset := VarSet,
+			^ pred_info := PredInfo
+		;
+			{ RunPostTypecheck = no },
+			{ Goal1 = Unif0 - GoalInfo }
+		),
 		( 
 			{ Goal1 \= unify(_, _, _, _, _) - _ }
 		->
-			compute_goal_purity(Goal1, Goal, PredInfo1, PredInfo, 
-				ModuleInfo, InClosure, ActualPurity, NumErrors0,
-				NumErrors)
-		;
-			check_higher_order_purity(ModuleInfo, PredInfo1,
-				GoalInfo, ConsId, Var, Args,
-				NumErrors0, NumErrors, ActualPurity),
-			{ PredInfo = PredInfo1 },
+			compute_goal_purity(Goal1, Goal,
+				InClosure, ActualPurity)
+		;
+			check_higher_order_purity(GoalInfo, ConsId,
+				Var, Args, ActualPurity),
 			{ Goal = Goal1 }
 		),
 		{ Goal = GoalExpr - _ }
 	;
-		{ PredInfo = PredInfo0 },
 		{ GoalExpr = Unif0 },
-		{ ActualPurity = pure },
-		{ NumErrors = NumErrors0 }
+		{ ActualPurity = pure }
 	).
 compute_expr_purity(disj(Goals0,Store), disj(Goals,Store), _,
-		PredInfo0, PredInfo, ModuleInfo, InClosure, Purity,
-		NumErrors0, NumErrors) -->
-	compute_goals_purity(Goals0, Goals, PredInfo0, PredInfo, ModuleInfo,
-			     InClosure, pure, Purity, NumErrors0, NumErrors).
-compute_expr_purity(not(Goal0), NotGoal, GoalInfo0, PredInfo0, PredInfo,
-		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
+		InClosure, Purity) -->
+	compute_goals_purity(Goals0, Goals, InClosure, pure, Purity).
+compute_expr_purity(not(Goal0), NotGoal, GoalInfo0, InClosure, Purity) -->
 	%
 	% eliminate double negation
 	%
 	{ negate_goal(Goal0, GoalInfo0, NotGoal0) },
 	( { NotGoal0 = not(Goal1) - _GoalInfo1 } ->
-		compute_goal_purity(Goal1, Goal, PredInfo0, PredInfo,
-			ModuleInfo, InClosure, Purity, NumErrors0, NumErrors),
+		compute_goal_purity(Goal1, Goal, InClosure, Purity),
 		{ NotGoal = not(Goal) }
 	;
-		compute_goal_purity(NotGoal0, NotGoal1, PredInfo0, PredInfo,
-			ModuleInfo, InClosure, Purity, NumErrors0, NumErrors),
+		compute_goal_purity(NotGoal0, NotGoal1, InClosure, Purity),
 		{ NotGoal1 = NotGoal - _ }
 	).
 compute_expr_purity(some(Vars, CanRemove, Goal0), some(Vars, CanRemove, Goal),
-		_, PredInfo0, PredInfo, ModuleInfo, InClosure, Purity,
-		NumErrors0, NumErrors) -->
-	compute_goal_purity(Goal0, Goal, PredInfo0, PredInfo, ModuleInfo, 
-			    InClosure, Purity, NumErrors0, NumErrors).
+		_, InClosure, Purity) -->
+	compute_goal_purity(Goal0, Goal, InClosure, Purity).
 compute_expr_purity(if_then_else(Vars,Goali0,Goalt0,Goale0,Store),
 		if_then_else(Vars,Goali,Goalt,Goale,Store), _,
-		PredInfo0, PredInfo, ModuleInfo, InClosure, Purity,
-		NumErrors0, NumErrors) -->
-	compute_goal_purity(Goali0, Goali, PredInfo0, PredInfo1, ModuleInfo,
-			    InClosure, Purity1, NumErrors0, NumErrors1),
-	compute_goal_purity(Goalt0, Goalt, PredInfo1, PredInfo2, ModuleInfo,
-			    InClosure, Purity2, NumErrors1, NumErrors2),
-	compute_goal_purity(Goale0, Goale, PredInfo2, PredInfo, ModuleInfo,
-			    InClosure, Purity3, NumErrors2, NumErrors),
+		InClosure, Purity) -->
+	compute_goal_purity(Goali0, Goali, InClosure, Purity1),
+	compute_goal_purity(Goalt0, Goalt, InClosure, Purity2),
+	compute_goal_purity(Goale0, Goale, InClosure, Purity3),
 	{ worst_purity(Purity1, Purity2, Purity12) },
 	{ worst_purity(Purity12, Purity3, Purity) }.
-compute_expr_purity(Ccode, Ccode, _, PredInfo, PredInfo, ModuleInfo, _, Purity,
-		NumErrors, NumErrors) -->
+compute_expr_purity(Ccode, Ccode, _, _, Purity) -->
 	{ Ccode = pragma_foreign_code(_,PredId,_,_,_,_,_) },
+	ModuleInfo =^ module_info,
 	{ module_info_preds(ModuleInfo, Preds) },
 	{ map__lookup(Preds, PredId, CalledPredInfo) },
 	{ pred_info_get_purity(CalledPredInfo, Purity) }.
-compute_expr_purity(bi_implication(_, _), _, _, _, _, _, _, _, _, _) -->
+compute_expr_purity(bi_implication(_, _), _, _, _, _) -->
 	% these should have been expanded out by now
 	{ error("compute_expr_purity: unexpected bi_implication") }.
 
 
-:- pred check_higher_order_purity(module_info, pred_info,
-	hlds_goal_info, cons_id, prog_var, list(prog_var),
-	int, int, purity, io__state, io__state).
-:- mode check_higher_order_purity(in, in, in, in, in, in, in, out, out, 
-	di, uo) is det.
-check_higher_order_purity(ModuleInfo, PredInfo, GoalInfo, ConsId, Var, Args,
-	NumErrors0, NumErrors, ActualPurity) -->
-	{ pred_info_clauses_info(PredInfo, ClausesInfo) },
-	{ clauses_info_vartypes(ClausesInfo, VarTypes) },
+:- pred check_higher_order_purity(hlds_goal_info, cons_id, prog_var,
+	list(prog_var), purity, purity_info, purity_info).
+:- mode check_higher_order_purity(in, in, in, in, out, in, out) is det.
+check_higher_order_purity(GoalInfo, ConsId, Var, Args, ActualPurity) -->
+	VarTypes =^ vartypes,
 	{ map__lookup(VarTypes, Var, TypeOfVar) },
 	( 
 		{ ConsId = cons(PName, _) },
 		{ type_is_higher_order(TypeOfVar, PredOrFunc,
 			_EvalMethod, VarArgTypes) }
 	->
+		PredInfo =^ pred_info,
 		{ pred_info_typevarset(PredInfo, TVarSet) },
 		{ map__apply_to_list(Args, VarTypes, ArgTypes0) },
 		{ list__append(ArgTypes0, VarArgTypes, PredArgTypes) },
+		ModuleInfo =^ module_info,
 		( 
 			{ get_pred_id(PName, PredOrFunc, TVarSet, PredArgTypes,
 				ModuleInfo, CalleePredId) }
@@ -699,31 +779,31 @@
 				CalleePredId, CalleePredInfo) },
 			{ pred_info_get_purity(CalleePredInfo, Purity) },
 			( { Purity = pure } ->
-				{ NumErrors = NumErrors0 }
+				[]
 			;
-				{ goal_info_get_context(GoalInfo, CallContext) },
-				error_missing_body_impurity_decl(ModuleInfo,
-					CalleePredInfo, CalleePredId,
-					CallContext, Purity),
-				{ NumErrors is NumErrors0 + 1 }
+				{ goal_info_get_context(GoalInfo,
+					CallContext) },
+				{ Message = missing_body_impurity_error(
+						CallContext, CalleePredId) },
+				purity_info_add_message(error(Message))
 			)
 		;
 			% If we can't find the type of the function, 
 			% it's because typecheck couldn't give it one.
 			% Typechecking gives an error in this case, we
 			% just keep silent.
-			{ Purity = pure },
-			{ NumErrors = NumErrors0 }
+			{ Purity = pure }
 		),
 		{ ActualPurity = Purity }
 	;
 		{ infer_goal_info_purity(GoalInfo, DeclaredPurity) },
 		( { DeclaredPurity \= pure } ->
 			{ goal_info_get_context(GoalInfo, Context) },
-			impure_unification_expr_error(Context, DeclaredPurity),
-			{ NumErrors = NumErrors0 + 1 }
+			{ Message = impure_unification_expr_error(Context,
+					DeclaredPurity) },
+			purity_info_add_message(error(Message))
 		;
-			{ NumErrors = NumErrors0 }
+			[]
 		),
 		{ ActualPurity = pure }
 	).
@@ -733,8 +813,6 @@
 		--->	no_worries		% all is well
 		;	insufficient_decl	% purity decl is less than
 						% required.
-		;	no_impure_in_closure	% impurity not allowed in
-						% closures 
 		;	inconsistent_promise    % promise is given
 						% but decl is impure
 		;	unnecessary_promise_pure % purity promise is given
@@ -750,29 +828,31 @@
 	% InPragmaCCode: Is this a pragma c code?
 	% Promised: Did we promise this pred as pure?
 :- pred perform_pred_purity_checks(pred_info::in, purity::in, purity::in,
-	bool::in, bool::in, purity_check_result::out) is det.
+	purity::in, bool::in, purity_check_result::out) is det.
 perform_pred_purity_checks(PredInfo, ActualPurity, DeclaredPurity,
-		Promised, IsPragmaCCode, PurityCheckResult) :-
+		PromisedPurity, IsPragmaCCode, PurityCheckResult) :-
 	( 
-		% You have to declare pure if a promise is made
-		% (if we implement promise semipure this will change)
-		Promised = yes, DeclaredPurity \= pure
+		% The declared purity must match any promises.
+		% (A promise of impure means no promise was made).
+		PromisedPurity \= (impure), DeclaredPurity \= PromisedPurity
 	->
 		PurityCheckResult = inconsistent_promise
 	;
 		% You shouldn't promise pure unnecessarily.
-		Promised = yes, ActualPurity = pure
+		PromisedPurity \= (impure), ActualPurity = PromisedPurity
 	->
 		PurityCheckResult = unnecessary_promise_pure
 	;
-		% The purity should match the declaration
+		% The purity should match the declaration.
 		ActualPurity = DeclaredPurity
 	->
 		PurityCheckResult = no_worries
 	; 
 		less_pure(ActualPurity, DeclaredPurity)
 	->
-		( Promised = no ->
+		( 
+			PromisedPurity = (impure)
+		->
 			PurityCheckResult = insufficient_decl
 		;
 			PurityCheckResult = no_worries
@@ -807,30 +887,31 @@
 	% ActualPurity: The inferred purity of the goal
 	% DeclaredPurity: The declared purity of the goal
 	% InClosure: Is this a goal inside a closure?
-:- pred perform_goal_purity_checks(pred_info::in, purity::in, purity::in,
-	bool::in, purity_check_result::out) is det.
-perform_goal_purity_checks(PredInfo, ActualPurity, DeclaredPurity,
-		InClosure, PurityCheckResult) :-
+:- pred perform_goal_purity_checks(prog_context::in, pred_id::in, purity::in,
+	bool::in, purity::out, purity_info::in, purity_info::out) is det.
+
+perform_goal_purity_checks(Context, PredId, DeclaredPurity,
+		_InClosure, ActualPurity) -->
+	ModuleInfo =^ module_info,
+	PredInfo =^ pred_info,
+	{ module_info_pred_info(ModuleInfo, PredId, CalleePredInfo) },
+	{ pred_info_get_purity(CalleePredInfo, ActualPurity) },
 	( 
 		% The purity should match the declaration
-		ActualPurity = DeclaredPurity
+		{ ActualPurity = DeclaredPurity }
 	->
-		PurityCheckResult = no_worries
-
+		[]
+	; 
 		% Don't require purity annotations on calls in
 		% compiler-generated code.
-	; 
-		code_util__compiler_generated(PredInfo)
-	->
-		PurityCheckResult = no_worries
-	; 
-		InClosure = yes, less_pure(ActualPurity, pure)
+		{ code_util__compiler_generated(PredInfo) }
 	->
-		PurityCheckResult = no_impure_in_closure
+		[]
 	; 
-		less_pure(ActualPurity, DeclaredPurity)
+		{ less_pure(ActualPurity, DeclaredPurity) }
 	->
-		PurityCheckResult = insufficient_decl
+		purity_info_add_message(
+			error(missing_body_impurity_error(Context, PredId)))
 	;
 			% We don't warn about exaggerated impurity decls in
 			% class methods or instance methods --- it just
@@ -841,27 +922,26 @@
 			% decls in c_code -- this is just because we
 			% assume they are pure, but you can declare them
 			% to be impure.
-		pred_info_get_markers(PredInfo, Markers),
-		( 
+		{ pred_info_get_markers(PredInfo, Markers) },
+		{ 
 			check_marker(Markers, class_method) 
 		;
 			check_marker(Markers, class_instance_method) 
-		)
+		}
 	->
-		PurityCheckResult = no_worries
+		[]
 	;
-		PurityCheckResult = unnecessary_decl
+		purity_info_add_message(
+			warning(unnecessary_body_impurity_decl(Context,
+				PredId, DeclaredPurity)))
 	).
 
-:- pred compute_goal_purity(hlds_goal, hlds_goal, pred_info, pred_info,
-	module_info, bool, purity, int, int, io__state, io__state).
-:- mode compute_goal_purity(in, out, in, out, in, in,
-	out, in, out, di, uo) is det.
-
-compute_goal_purity(Goal0 - GoalInfo0, Goal - GoalInfo, PredInfo0, PredInfo,
-		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
-	compute_expr_purity(Goal0, Goal, GoalInfo0, PredInfo0, PredInfo,
-		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors),
+:- pred compute_goal_purity(hlds_goal, hlds_goal,
+		bool, purity, purity_info, purity_info).
+:- mode compute_goal_purity(in, out, in, out, in, out) is det.
+
+compute_goal_purity(Goal0 - GoalInfo0, Goal - GoalInfo, InClosure, Purity) -->
+	compute_expr_purity(Goal0, Goal, GoalInfo0, InClosure, Purity),
 	{ add_goal_info_purity_feature(GoalInfo0, Purity, GoalInfo) }.
 
 
@@ -870,41 +950,29 @@
 %  the same code for both
 
 :- pred compute_goals_purity(list(hlds_goal), list(hlds_goal),
-	pred_info, pred_info, module_info, bool, purity, purity, int, int,
-	io__state, io__state).
-:- mode compute_goals_purity(in, out, in, out, in, in, in, out, in, out,
-	di, uo) is det.
+	bool, purity, purity, purity_info, purity_info).
+:- mode compute_goals_purity(in, out, in, in, out, in, out) is det.
 
-compute_goals_purity([], [], PredInfo, PredInfo, _, _, Purity, Purity,
-		NumErrors, NumErrors) -->
-	[].
-compute_goals_purity([Goal0|Goals0], [Goal|Goals], PredInfo0, PredInfo,
-		ModuleInfo, InClosure, Purity0, Purity,
-		NumErrors0, NumErrors) -->
-	compute_goal_purity(Goal0, Goal, PredInfo0, PredInfo1, ModuleInfo, 
-		InClosure, Purity1, NumErrors0, NumErrors1),
+compute_goals_purity([], [], _, Purity, Purity) --> [].
+compute_goals_purity([Goal0|Goals0], [Goal|Goals], InClosure,
+		Purity0, Purity) -->
+	compute_goal_purity(Goal0, Goal, InClosure, Purity1),
 	{ worst_purity(Purity0, Purity1, Purity2) },
-	compute_goals_purity(Goals0, Goals, PredInfo1, PredInfo, ModuleInfo,
-		InClosure, Purity2, Purity, NumErrors1, NumErrors).
+	compute_goals_purity(Goals0, Goals, InClosure, Purity2, Purity).
 
 
 
-:- pred compute_cases_purity(list(case), list(case), pred_info, pred_info,
-	module_info, bool, purity, purity, int, int, io__state, io__state).
-:- mode compute_cases_purity(in, out, in, out, in, in, in, out, in, out,
-	di, uo) is det.
+:- pred compute_cases_purity(list(case), list(case),
+	bool, purity, purity, purity_info, purity_info).
+:- mode compute_cases_purity(in, out, in, in, out, in, out) is det.
 
-compute_cases_purity([], [], PredInfo, PredInfo, _, _, Purity, Purity,
-		NumErrors, NumErrors) -->
-	[].
+compute_cases_purity([], [], _,
+		Purity, Purity) --> [].
 compute_cases_purity([case(Ctor,Goal0)|Goals0], [case(Ctor,Goal)|Goals],
-		PredInfo0, PredInfo, ModuleInfo, InClosure, Purity0, Purity,
-		NumErrors0, NumErrors) -->
-	compute_goal_purity(Goal0, Goal, PredInfo0, PredInfo1, ModuleInfo, 
-			InClosure, Purity1, NumErrors0, NumErrors1),
+		InClosure, Purity0, Purity) -->
+	compute_goal_purity(Goal0, Goal, InClosure, Purity1),
 	{ worst_purity(Purity0, Purity1, Purity2) },
-	compute_cases_purity(Goals0, Goals, PredInfo1, PredInfo, ModuleInfo,
-			InClosure, Purity2, Purity, NumErrors1, NumErrors).
+	compute_cases_purity(Goals0, Goals, InClosure, Purity2, Purity).
 
 	% Make sure lambda expressions introduced by the compiler
 	% have the correct mode for their `aditi__state' arguments.
@@ -940,9 +1008,7 @@
 	fix_aditi_state_modes(SeenState, AditiStateMode, Types, Modes0, Modes).
 
 %-----------------------------------------------------------------------------%
-%				Print error messages
 
-
 :- pred error_inconsistent_promise(module_info, pred_info, pred_id, purity,
 				  io__state, io__state).
 :- mode error_inconsistent_promise(in, in, in, in, di, uo) is det.
@@ -985,28 +1051,43 @@
 	write_purity(AcutalPurity),
 	io__write_string(".\n").
 
-:- pred warn_unnecessary_promise_pure(module_info, pred_info, pred_id,
+:- pred warn_unnecessary_promise_pure(module_info, pred_info, pred_id, purity,
 				  io__state, io__state).
-:- mode warn_unnecessary_promise_pure(in, in, in, di, uo) is det.
+:- mode warn_unnecessary_promise_pure(in, in, in, in, di, uo) is det.
 
-warn_unnecessary_promise_pure(ModuleInfo, PredInfo, PredId) -->
+warn_unnecessary_promise_pure(ModuleInfo, PredInfo, PredId, PromisedPurity) -->
 	{ pred_info_context(PredInfo, Context) },
 	write_context_and_pred_id(ModuleInfo, PredInfo, PredId),
 	prog_out__write_context(Context),
-	report_warning("  warning: unnecessary `promise_pure' pragma.\n"),
+	{
+		PromisedPurity = pure,
+		Pragma = "promise_pure",
+		CodeStr = "impure or semipure"
+	;
+		PromisedPurity = (semipure),
+		Pragma = "promise_semipure",
+		CodeStr = "impure"
+	;
+		PromisedPurity = (impure),
+		error("purity__warn_unnecessary_promise_pure: promise_impure?")
+	},
+
+	report_warning("  warning: unnecessary `"),
+	io__write_string(Pragma),
+	io__write_string("' pragma.\n"),
 	globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
 	( { VerboseErrors = yes } ->
 		prog_out__write_context(Context),
 		{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
 		io__write_string("  This "),
 		hlds_out__write_pred_or_func(PredOrFunc),
-		io__write_string(
-		    " does not invoke any impure or semipure code,\n"
-		),
+		io__write_string(" does not invoke any "),
+		io__write_string(CodeStr),  
+		io__write_string(",\n"),
 		prog_out__write_context(Context),
-		io__write_string(
-		    "  so there is no need for a `promise_pure' pragma.\n"
-		)
+		io__write_string("  so there is no need for a `"),
+		io__write_string(Pragma),
+		io__write_string("' pragma.\n")
 	;
 		[]
 	).
@@ -1027,21 +1108,72 @@
 	write_purity(Purity),
 	io__write_string(".\n"),
 	prog_out__write_context(Context),
+	{ pred_info_get_purity(PredInfo, DeclaredPurity) },
 	( { code_util__compiler_generated(PredInfo) } ->
 		io__write_string("  It must be pure.\n")
 	;
 		io__write_string("  It must be declared `"),
 		write_purity(Purity),
-		io__write_string("' or promised pure.\n")
+		io__write_string("' or promised "),
+		write_purity(DeclaredPurity),
+		io__write_string(".\n")
 	).
 
+:- type post_typecheck_message
+	--->	error(post_typecheck_error)
+	;	warning(post_typecheck_warning)
+	.
+
+:- type post_typecheck_messages == list(post_typecheck_message).
+	
+:- type post_typecheck_error
+	--->	missing_body_impurity_error(prog_context, pred_id)
+	;	impure_closure(prog_context, purity)
+	;	impure_unification_expr_error(prog_context, purity)
+	;	aditi_builtin_error(aditi_builtin_error)
+	.
+
+:- type post_typecheck_warning
+	--->	unnecessary_body_impurity_decl(prog_context, pred_id, purity).
 
-:- pred error_missing_body_impurity_decl(module_info, pred_info, pred_id,
-				  prog_context, purity, io__state, io__state).
-:- mode error_missing_body_impurity_decl(in, in, in, in, in, di, uo) is det.
+:- pred report_post_typecheck_message(module_info, post_typecheck_message, 
+		io__state, io__state).
+:- mode report_post_typecheck_message(in, in, di, uo) is det.
 
-error_missing_body_impurity_decl(ModuleInfo, PredInfo, PredId, Context,
-		Purity) -->
+report_post_typecheck_message(ModuleInfo, error(Message)) -->
+	io__set_exit_status(1),
+	(
+		{ Message = missing_body_impurity_error(Context, PredId) },
+		error_missing_body_impurity_decl(ModuleInfo, PredId, Context)
+	;
+		{ Message = impure_closure(Context, Purity) },
+		report_error_impure_closure(Context, Purity)
+	;
+		{ Message = impure_unification_expr_error(Context, Purity) },
+		impure_unification_expr_error(Context, Purity)
+	;
+		{ Message = aditi_builtin_error(AditiError) },
+		report_aditi_builtin_error(AditiError)
+	).
+
+report_post_typecheck_message(ModuleInfo,
+		warning(unnecessary_body_impurity_decl(Context,
+			PredId, DeclaredPurity))) -->
+	globals__io_lookup_bool_option(halt_at_warn, HaltAtWarn),
+	(
+		{ HaltAtWarn = yes },
+		io__set_exit_status(1)
+	;
+		{ HaltAtWarn = no }
+	),
+	warn_unnecessary_body_impurity_decl(ModuleInfo, PredId, Context,
+		DeclaredPurity). 
+
+:- pred error_missing_body_impurity_decl(module_info, pred_id,
+				  prog_context, io__state, io__state).
+:- mode error_missing_body_impurity_decl(in, in, in, di, uo) is det.
+
+error_missing_body_impurity_decl(ModuleInfo, PredId, Context) -->
 	prog_out__write_context(Context),
 	io__write_string("In call to "),
 	write_purity(Purity),
@@ -1049,7 +1181,9 @@
 	hlds_out__write_pred_id(ModuleInfo, PredId),
 	io__write_string(":\n"),
 	prog_out__write_context(Context),
+	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
 	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
+	{ pred_info_get_purity(PredInfo, Purity) },
 	( { PredOrFunc = predicate } ->
 		io__write_string("  purity error: call must be preceded by `"),
 		write_purity(Purity),
@@ -1063,13 +1197,13 @@
 
 	).
 
-:- pred warn_unnecessary_body_impurity_decl(module_info, pred_info, 
-	pred_id, prog_context, purity, purity, io__state, io__state).
-:- mode warn_unnecessary_body_impurity_decl(in, in, in, in, in, in, di, uo)
+:- pred warn_unnecessary_body_impurity_decl(module_info, pred_id,
+	prog_context, purity, io__state, io__state).
+:- mode warn_unnecessary_body_impurity_decl(in, in, in, in, di, uo)
 	is det.
 
-warn_unnecessary_body_impurity_decl(ModuleInfo, _PredInfo,
-		PredId, Context, ActualPurity, DeclaredPurity) -->
+warn_unnecessary_body_impurity_decl(ModuleInfo, PredId, Context,
+		DeclaredPurity) -->
 	prog_out__write_context(Context),
 	io__write_string("In call to "),
 	hlds_out__write_pred_id(ModuleInfo, PredId),
@@ -1079,6 +1213,8 @@
 	write_purity(DeclaredPurity),
 	io__write_string("' indicator.\n"),
 	prog_out__write_context(Context),
+	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
+	{ pred_info_get_purity(PredInfo, ActualPurity) },
 	( { ActualPurity = pure } ->
 		io__write_string("  No purity indicator is necessary.\n")
 	;
@@ -1087,27 +1223,34 @@
 		io__write_string("' is sufficient.\n")
 	).
 	
-:- pred error_if_closure_impure(hlds_goal_info, purity, int, int,
-	io__state, io__state).
-:- mode error_if_closure_impure(in, in, in, out, di, uo) is det.
+:- pred error_if_closure_impure(hlds_goal_info, purity,
+		purity_info, purity_info).	
+:- mode error_if_closure_impure(in, in, in, out) is det.
 
-error_if_closure_impure(GoalInfo, Purity, NumErrors0, NumErrors) -->
+error_if_closure_impure(GoalInfo, Purity) -->
 	( { Purity = pure } ->
-		{ NumErrors = NumErrors0 }
+		[]
 	;
-		{ NumErrors is NumErrors0 + 1 },
 		{ goal_info_get_context(GoalInfo, Context) },
+		purity_info_add_message(
+			error(impure_closure(Context, Purity)))
+	).
+
+:- pred report_error_impure_closure(prog_context, purity,
+		io__state, io__state).
+:- mode report_error_impure_closure(in, in, di, uo) is det.
+
+report_error_impure_closure(Context, Purity) -->
+	prog_out__write_context(Context),
+	io__write_string("Purity error in closure: closure is "),
+	write_purity(Purity),
+	io__write_string(".\n"),
+	globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
+	( { VerboseErrors = yes } ->
 		prog_out__write_context(Context),
-		io__write_string("Purity error in closure: closure is "),
-		write_purity(Purity),
-		io__write_string(".\n"),
-		globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
-		( { VerboseErrors = yes } ->
-			prog_out__write_context(Context),
-			io__write_string("  All closures must be pure.\n")
-		;   
-			[]
-		)
+		io__write_string("  All closures must be pure.\n")
+	;   
+		[]
 	).
 
 :- pred write_context_and_pred_id(module_info, pred_info, pred_id,
@@ -1122,12 +1265,33 @@
 	io__write_string(":\n").
 
 impure_unification_expr_error(Context, Purity) -->
-	io__set_exit_status(1),
 	prog_out__write_context(Context),
 	io__write_string("Purity error: unification with expression was declared\n"),
 	prog_out__write_context(Context),
 	io__write_string("  "),
 	write_purity(Purity),
 	io__write_string(", but expression was not a function call.\n").
+
+%-----------------------------------------------------------------------------%
+
+:- type purity_info
+	--->	purity_info(
+			% fields not changed by purity checking.
+			module_info :: module_info,
+			run_post_typecheck :: bool,
+
+			% fields which may be changed.
+			pred_info :: pred_info,
+			vartypes :: vartypes,
+			varset :: prog_varset,
+			messages :: post_typecheck_messages
+	).
+
+:- pred purity_info_add_message(post_typecheck_message,
+		purity_info, purity_info).
+:- mode purity_info_add_message(in, in, out) is det.
+
+purity_info_add_message(Message, Info,
+		Info ^ messages := [Message | Info ^ messages]).
 
 %-----------------------------------------------------------------------------%
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.93
diff -u -u -r1.93 simplify.m
--- compiler/simplify.m	2001/02/03 22:39:28	1.93
+++ compiler/simplify.m	2001/03/16 05:00:21
@@ -639,7 +639,10 @@
 			goal_info_get_determinism(GoalInfo0, CaseDetism),
 			det_conjunction_detism(semidet, CaseDetism, Detism),
 			goal_info_init(NonLocals, InstMapDelta, Detism, 
-				CombinedGoalInfo),
+				CombinedGoalInfo0),
+			goal_list_purity(GoalList, Purity),
+			add_goal_info_purity_feature(CombinedGoalInfo0,
+				Purity, CombinedGoalInfo),
 
 			simplify_info_set_requantify(Info3, Info4),
 			Goal = conj(GoalList),
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.27
diff -u -u -r1.27 table_gen.m
--- compiler/table_gen.m	2000/12/06 06:05:19	1.27
+++ compiler/table_gen.m	2001/03/15 02:44:37
@@ -381,7 +381,8 @@
 
 	pred_info_procedures(PredInfo1, ProcTable1),
 	map__det_update(ProcTable1, ProcId, ProcInfo, ProcTable),
-	pred_info_set_procedures(PredInfo1, ProcTable, PredInfo),
+	pred_info_set_procedures(PredInfo1, ProcTable, PredInfo2),
+	repuritycheck_proc(Module2, proc(PredId, ProcId), PredInfo2, PredInfo),
 	module_info_preds(Module2, PredTable1),
 	map__det_update(PredTable1, PredId, PredInfo, PredTable),
 	module_info_set_preds(Module2, PredTable, Module).
@@ -961,7 +962,12 @@
 	goal_info_get_features(GoalInfo0, Features0),
 	set__insert(Features0, call_table_gen, Features),
 	goal_info_set_features(GoalInfo0, Features, GoalInfo),
-	Goal = GoalEx - GoalInfo.
+
+	% We need to wrap the conjunction in a `some' which cannot be removed
+	% to make sure the `call_table_gen' marker doesn't get removed by
+	% any of the optimization passes (e.g. simplify.m flattening
+	% conjunctions).
+	Goal = some([], cannot_remove, GoalEx - GoalInfo0) - GoalInfo.
 
 :- pred generate_non_lookup_goal(list(prog_var)::in, pred_id::in, proc_id::in,
 	term__context::in, map(prog_var, type)::in, map(prog_var, type)::out,
@@ -992,7 +998,12 @@
 	goal_info_get_features(GoalInfo0, Features0),
 	set__insert(Features0, call_table_gen, Features),
 	goal_info_set_features(GoalInfo0, Features, GoalInfo),
-	Goal = GoalEx - GoalInfo.
+
+	% We need to wrap the conjunction in a `some' which cannot be removed
+	% to make sure the `call_table_gen' marker doesn't get removed by
+	% any of the optimization passes (e.g. simplify.m flattening
+	% conjunctions).
+	Goal = some([], cannot_remove, GoalEx - GoalInfo) - GoalInfo.
 
 :- pred generate_lookup_goals(list(prog_var)::in, term__context::in,
 	prog_var::in, prog_var::out,
@@ -1427,7 +1438,7 @@
 	gen_string_construction("MessageS", Message, VarTypes0, VarTypes,
 		VarSet0, VarSet, MessageVar, MessageConsGoal),
 	generate_call("table_loopcheck_error", [MessageVar], erroneous,
-		yes(impure), [], ModuleInfo, Context, CallGoal),
+		no, [], ModuleInfo, Context, CallGoal),
 
 	GoalEx = conj([MessageConsGoal, CallGoal]),
 	set__init(NonLocals),
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.203
diff -u -u -r1.203 reference_manual.texi
--- doc/reference_manual.texi	2001/03/15 06:32:06	1.203
+++ doc/reference_manual.texi	2001/03/24 02:10:09
@@ -5846,20 +5846,24 @@
 declared purity of the calls it executes,  the lowest purity bound is
 propagated up from callee to caller through the program.
 
-However, some predicates which call impure or semipure predicates are
-themselves pure. 
-The only way for the programmer to stop the propagation of impurity is
-to explicitly promise that a predicate or function is pure.
+In some cases the impurity of a predicate's body is an implementation
+detail which should not be exposed to callers. These predicates should
+be considered to be pure or semipure even though they call impure or
+semipure predicates. The only way for the programmer to stop the
+propagation of impurity is to explicitly promise that the predicate
+or function is pure or semipure.
 
-Of course, the Mercury compiler cannot verify that a predicate is pure,
-so it is the programmer's responsibility to ensure this.  If a predicate
-is promised pure and is not, the behaviour of the program is undefined.
+Of course, the Mercury compiler cannot verify that the predicate's
+purity matches the promise, so it is the programmer's responsibility
+to ensure this.  If a predicate is promised pure or semipure and is not,
+the behaviour of the program is undefined.
 
-The programmer may promise that a predicate is pure using the
- at code{promise_pure} pragma:
+The programmer may promise that a predicate or function is pure or semipure
+using the @code{promise_pure} and @code{promise_semipure} pragmas:
 
 @example
 :- pragma promise_pure(@var{Name}/@var{Arity}).
+:- pragma promise_semipure(@var{Name}/@var{Arity}).
 @end example
 
 
Index: tests/debugger/loopcheck.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/loopcheck.exp,v
retrieving revision 1.4
diff -u -u -r1.4 loopcheck.exp
--- tests/debugger/loopcheck.exp	2000/11/01 04:23:04	1.4
+++ tests/debugger/loopcheck.exp	2001/03/16 01:26:06
@@ -6,15 +6,15 @@
 mdb> continue -a
        2:      2  2 CALL pred loopcheck:loop/1-0 (erroneous)
                          loopcheck.m:21 (from loopcheck.m:14)
-       3:      2  2 ELSE pred loopcheck:loop/1-0 (erroneous) c3;e;
+       3:      2  2 ELSE pred loopcheck:loop/1-0 (erroneous) c2;e;
                          loopcheck.m:21
-       4:      2  2 ELSE pred loopcheck:loop/1-0 (erroneous) c3;e;e;
+       4:      2  2 ELSE pred loopcheck:loop/1-0 (erroneous) c2;e;e;
                          loopcheck.m:21
        5:      3  3 CALL pred loopcheck:loop/1-0 (erroneous)
                          loopcheck.m:21 (from loopcheck.m:21)
-       6:      3  3 ELSE pred loopcheck:loop/1-0 (erroneous) c3;e;
+       6:      3  3 ELSE pred loopcheck:loop/1-0 (erroneous) c2;e;
                          loopcheck.m:21
-       7:      3  3 THEN pred loopcheck:loop/1-0 (erroneous) c3;e;t;
+       7:      3  3 THEN pred loopcheck:loop/1-0 (erroneous) c2;e;t;
                          loopcheck.m:21
        8:      3  3 EXCP pred loopcheck:loop/1-0 (erroneous)
                          loopcheck.m:21 (from loopcheck.m:21)
Index: tests/debugger/retry.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/retry.exp,v
retrieving revision 1.1
diff -u -u -r1.1 retry.exp
--- tests/debugger/retry.exp	2000/10/13 04:06:40	1.1
+++ tests/debugger/retry.exp	2001/03/24 01:13:20
@@ -111,13 +111,13 @@
 mdb> continue
      101:     32  5 CALL pred retry:fib/2-0 (det)
 mdb> step
-     102:     32  5 ELSE pred retry:fib/2-0 (det) c3;e;
+     102:     32  5 ELSE pred retry:fib/2-0 (det) c2;e;
 mdb> retry 2
       93:     30  3 CALL pred retry:fib/2-0 (det)
 mdb> print *
        HeadVar__1             	14
 mdb> next
-      94:     30  3 ELSE pred retry:fib/2-0 (det) c3;e;
+      94:     30  3 ELSE pred retry:fib/2-0 (det) c2;e;
 mdb> retry 1
       89:     29  2 CALL pred retry:fib/2-0 (det)
 mdb> finish
Index: tests/invalid/impure_method_impl.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/impure_method_impl.err_exp,v
retrieving revision 1.2
diff -u -u -r1.2 impure_method_impl.err_exp
--- tests/invalid/impure_method_impl.err_exp	2000/04/22 07:12:41	1.2
+++ tests/invalid/impure_method_impl.err_exp	2001/03/16 03:23:58
@@ -2,7 +2,7 @@
 impure_method_impl.m:017:   purity error: call must be preceded by `impure' indicator.
 impure_method_impl.m:017: In type class method implementation:
 impure_method_impl.m:017:   purity error: predicate is impure.
-impure_method_impl.m:017:   It must be declared `impure' or promised pure.
+impure_method_impl.m:017:   It must be declared `impure' or promised semipure.
 impure_method_impl.m:016: In call to semipure predicate `impure_method_impl:foo_m1/2':
 impure_method_impl.m:016:   purity error: call must be preceded by `semipure' indicator.
 impure_method_impl.m:016: In type class method implementation:
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list