[m-dev.] for review: impure functions

Tyson Dowd trd at cs.mu.OZ.AU
Tue Apr 4 18:32:35 AEST 2000


Hi,

DJ, if you would be so kind...

===================================================================


Estimated hours taken: 30

Add impure functions to Mercury, clean up the purity module somewhat,
fix some bugs in purity, update and expand the purity documentation, 
and re-organize the purity checks.

Impure functions can be declared just like impure preds.
However, they can only be called in an explicit unification preceeded
by a purity level:

	impure X = some_impure_func(Y, Z)

The bug fixed was the fact that closures of impure predicates
were only being detected when using lambda syntax.  Purity information
was discarded and impure closures could be created like this:

	Pred = some_impure_pred

You could then use this predicate anywhere you like without any purity
declarations.

compiler/hlds_module.m:
	Add get_pred_id pred which will return the pred_id of a
	predicate matching a given type.  This is like
	get_pred_and_proc_id, but only gets the information we are
	interested in, and is semidet.
	We need a semidet version to handle cases where type inference
	cannot infer a type before the limit is reached, but we try to
	purity check this code.  (The bug mentioned above was stopping
	us from purity checking the test case for this before).

compiler/make_hlds.m:
compiler/mercury_to_goedel.m:
compiler/mercury_to_mercury.m:
compiler/module_qual.m:
compiler/prog_data.m:
compiler/prog_io.m:
compiler/prog_io_dcg.m:
compiler/prog_io_goal.m:
compiler/prog_util.m:
	Add purity information to unify goals.
	Don't assume unify goals are pure.

compiler/purity.m:
	Allow impure functions.
	Check unification goals for purity (not just lambda unification).
	Check unifications that are transformed into calls to make sure
	the call is purity correct.
	Put purity checking logic into separate predicates.
	Use an enum to return different errors and warnings.
	(The last two changes make it much easier to see the
	similarities between checking goals and checking predicates for
	purity correctness).
	Give different error messages for impure functions (highlight
	that you need to use them in an explicit unification).
	Handle unknown predicate lookups (can occur when unifying with
	a higher order term whose type could not be inferred).
	Add a few comments delineating where changes might need to be
	made to make foreign code impure by default in future.

compiler/notes/authors.html:
	Add Peter Schachte to the authors list.

doc/reference_manual.texi:
	Document impure functions.
	Expand more on what impure predicates/functions can do.
	Explain the concept of worst purity, and use it to explain the
	"inferred purity"/"declared purity" concepts.
	Make it more explicit that only impure goals obey
	strict-sequential like semantics.

tests/invalid/type_inf_loop.err_exp2:
	Fix this test case to reflect the new error message new that we 
	check the purity of this code correctly (or rather, we correctly
	fail to be able to purity check this code).

tests/hard_coded/Mmakefile:
tests/hard_coded/purity.exp:
tests/hard_coded/purity.m:
tests/hard_coded/purity/Mmakefile:
tests/hard_coded/purity/impure_func_t1.m:
tests/hard_coded/purity/purity.m:
tests/hard_coded/purity/runtests:
	Remove purity tests from the hard_coded directory, give it a
	sub-directory of its own.

tests/invalid/Mmakefile:
tests/invalid/purity.err_exp:
tests/invalid/purity.m:
tests/invalid/purity_nonsense.err_exp:
tests/invalid/purity_nonsense.m:
tests/invalid/purity/Mmakefile:
tests/invalid/purity/impure_func_t2.err_exp:
tests/invalid/purity/impure_func_t2.m:
tests/invalid/purity/impure_func_t3.err_exp:
tests/invalid/purity/impure_func_t3.m:
tests/invalid/purity/impure_func_t4.err_exp:
tests/invalid/purity/impure_func_t4.m:
tests/invalid/purity/impure_func_t5.err_exp:
tests/invalid/purity/impure_func_t5.m:
tests/invalid/purity/impure_pred_t1.err_exp:
tests/invalid/purity/impure_pred_t1.m:
tests/invalid/purity/impure_pred_t2.err_exp:
tests/invalid/purity/impure_pred_t2.m:
tests/invalid/purity/purity.err_exp:
tests/invalid/purity/purity.m:
tests/invalid/purity/purity_nonsense.err_exp:
tests/invalid/purity/purity_nonsense.m:
tests/invalid/purity/runtests:
	Remove purity tests from the invalid directory, give it a
	sub-directory of its own.



Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.51
diff -u -r1.51 hlds_module.m
--- compiler/hlds_module.m	2000/03/10 13:37:41	1.51
+++ compiler/hlds_module.m	2000/04/04 05:13:58
@@ -1325,6 +1325,13 @@
 				module_info, pred_id, proc_id).
 :- mode get_pred_id_and_proc_id(in, in, in, in, in, out, out) is det.
 
+	% Get the pred_id matching a higher-order term with
+	% the given argument types, aborting with an error if none is
+	% found.
+:- pred get_pred_id(sym_name, pred_or_func, tvarset, list(type),
+				module_info, pred_id).
+:- mode get_pred_id(in, in, in, in, in, out) is semidet.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -1858,8 +1865,8 @@
 
 %-----------------------------------------------------------------------------%
 
-get_pred_id_and_proc_id(SymName, PredOrFunc, TVarSet, ArgTypes, ModuleInfo,
-			PredId, ProcId) :-
+get_pred_id(SymName, PredOrFunc, TVarSet, ArgTypes, ModuleInfo,
+		PredId) :-
 	module_info_get_predicate_table(ModuleInfo, PredicateTable),
 	list__length(ArgTypes, Arity),
 	(
@@ -1869,21 +1876,34 @@
 		typecheck__find_matching_pred_id(PredIds, ModuleInfo,
 			TVarSet, ArgTypes, PredId0, _PredName)
 	->
-		PredId = PredId0,
-		get_proc_id(PredicateTable, PredId, ProcId)
+		PredId = PredId0
 	;
 		% Undefined/invalid pred or func.
+		fail
+	).
+
+get_pred_id_and_proc_id(SymName, PredOrFunc, TVarSet, ArgTypes, ModuleInfo,
+			PredId, ProcId) :-
+	( 
+		get_pred_id(SymName, PredOrFunc, TVarSet,
+			ArgTypes, ModuleInfo, PredId0)
+	->
+		PredId = PredId0
+	;
+                % Undefined/invalid pred or func.
 		% the type-checker should ensure that this never happens
+		list__length(ArgTypes, Arity),
 		hlds_out__pred_or_func_to_str(PredOrFunc, PredOrFuncStr),
 		prog_out__sym_name_to_string(SymName, Name2),
 		string__int_to_string(Arity, ArityString),
-		string__append_list(
-			["get_pred_id_and_proc_id: ",
+		string__append_list(["get_pred_id_and_proc_id: ", 
 			"undefined/invalid ", PredOrFuncStr,
-			"\n`", Name2, "/", ArityString, "'"],
-			Msg),
+			"\n`", Name2, "/", ArityString, "'"], Msg),
 		error(Msg)
-	).
+
+	),
+	module_info_get_predicate_table(ModuleInfo, PredicateTable),
+	get_proc_id(PredicateTable, PredId, ProcId).
 
 :- pred get_proc_id(predicate_table, pred_id, proc_id).
 :- mode get_proc_id(in, in, out) is det.
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.328
diff -u -r1.328 make_hlds.m
--- compiler/make_hlds.m	2000/03/27 05:07:36	1.328
+++ compiler/make_hlds.m	2000/03/27 07:59:41
@@ -5052,8 +5052,8 @@
 		{ Args0 = [LHS, RHS] }
 	->
 			% `LHS \= RHS' is defined as `not (RHS = RHS)'
-		transform_goal_2(not(unify(LHS, RHS) - Context), Context,
-				VarSet0, Subst, Goal, VarSet, Info0, Info)
+		transform_goal_2(not(unify(LHS, RHS, Purity) - Context),
+			Context, VarSet0, Subst, Goal, VarSet, Info0, Info)
 	;
 		% check for a DCG field access goal:
 		% get:  Field =^ field
@@ -5140,12 +5140,15 @@
 			Goal0, VarSet1, Goal, VarSet, Info0, Info)
 	).
 
-transform_goal_2(unify(A0, B0), Context, VarSet0, Subst, Goal, VarSet,
+transform_goal_2(unify(A0, B0, Purity), Context, VarSet0, Subst, Goal, VarSet,
 		Info0, Info) -->
 	{ term__apply_substitution(A0, Subst, A) },
 	{ term__apply_substitution(B0, Subst, B) },
+	{ Goal0 = GoalBody - GoalInfo0 },
+	{ add_goal_info_purity_feature(GoalInfo0, Purity, GoalInfo) },
+	{ Goal = GoalBody - GoalInfo },
 	unravel_unification(A, B, Context, explicit, [],
-			VarSet0, Goal, VarSet, Info0, Info).
+			VarSet0, Goal0, VarSet, Info0, Info).
 
 :- inst dcg_record_syntax_op = bound("=^"; ":=").
 
Index: compiler/mercury_to_goedel.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_goedel.m,v
retrieving revision 1.69
diff -u -r1.69 mercury_to_goedel.m
--- compiler/mercury_to_goedel.m	2000/01/13 06:16:17	1.69
+++ compiler/mercury_to_goedel.m	2000/03/09 11:44:44
@@ -668,7 +668,14 @@
 	goedel_output_call(term__functor(term__atom(Name0), Term,
 		Context0), VarSet, Indent).
 
-goedel_output_goal_2(unify(A, B), VarSet, _Indent) -->
+goedel_output_goal_2(unify(A, B, Purity), VarSet, _Indent) -->
+	(   { Purity = pure } ->
+		[]
+	;
+		io__write_string("/* "),
+		write_purity(Purity),
+		io__write_string(" */ ")
+	),
 	goedel_output_term(A, VarSet),
 	io__write_string(" = "),
 	goedel_output_term(B, VarSet).
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.167
diff -u -r1.167 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m	2000/03/27 05:07:41	1.167
+++ compiler/mercury_to_mercury.m	2000/03/27 07:59:43
@@ -1888,7 +1888,8 @@
 	write_purity_prefix(Purity),
 	mercury_output_call(Name, Term, VarSet, Indent).
 
-mercury_output_goal_2(unify(A, B), VarSet, _Indent) -->
+mercury_output_goal_2(unify(A, B, Purity), VarSet, _Indent) -->
+	write_purity_prefix(Purity),
 	mercury_output_term(A, VarSet, no),
 	io__write_string(" = "),
 	mercury_output_term(B, VarSet, no, next_to_graphic_token).
Index: compiler/module_qual.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_qual.m,v
retrieving revision 1.54
diff -u -r1.54 module_qual.m
--- compiler/module_qual.m	2000/03/27 05:07:44	1.54
+++ compiler/module_qual.m	2000/03/27 07:59:45
@@ -403,7 +403,7 @@
 	list__append(Symbols0, SymbolsC, Symbols),
 	bool__and(SuccessA, SuccessB, Success0),
 	bool__and(Success0, SuccessC, Success).
-process_assert(call(SymName, Args0, _) - _, Symbols, Success) :-
+process_assert(call(SymName, Args0, _Purity) - _, Symbols, Success) :-
 	(
 		SymName = qualified(_, _)
 	->
@@ -421,7 +421,7 @@
 		Symbols = [],
 		Success = no
 	).
-process_assert(unify(LHS0, RHS0) - _, Symbols, Success) :-
+process_assert(unify(LHS0, RHS0, _Purity) - _, Symbols, Success) :-
 	term__coerce(LHS0, LHS),
 	term__coerce(RHS0, RHS),
 	(
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.53
diff -u -r1.53 prog_data.m
--- compiler/prog_data.m	2000/03/27 05:07:46	1.53
+++ compiler/prog_data.m	2000/03/27 07:59:47
@@ -563,7 +563,7 @@
 
 	% atomic goals
 	;	call(sym_name, list(prog_term), purity)
-	;	unify(prog_term, prog_term).
+	;	unify(prog_term, prog_term, purity).
 
 :- type goals		==	list(goal).
 
Index: compiler/prog_io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io.m,v
retrieving revision 1.188
diff -u -r1.188 prog_io.m
--- compiler/prog_io.m	2000/03/28 03:40:30	1.188
+++ compiler/prog_io.m	2000/03/30 06:13:16
@@ -1893,7 +1893,7 @@
 :- mode process_func_3(in, in, in, in, in, in, in, in, in, out) is det.
 
 process_func_3(ok(F, As0), FuncTerm, ReturnTypeTerm, VarSet0, MaybeDet, Cond,
-		ExistQVars, ClassContext, Attributes, Result) :-
+		ExistQVars, ClassContext, Attributes0, Result) :-
 	( convert_type_and_mode_list(As0, As) ->
 		( \+ verify_type_and_mode_list(As) ->
 			Result = error("some but not all arguments have modes",
@@ -1914,9 +1914,7 @@
 		"function result has mode, but function arguments don't",
 					FuncTerm)
 			;
-				% note: impure or semipure functions are not
-				% allowed
-				Purity = (pure),
+				get_purity(Attributes0, Purity, Attributes),
 				varset__coerce(VarSet0, TVarSet),
 				varset__coerce(VarSet0, IVarSet),
 				Result0 = ok(func(TVarSet, IVarSet, ExistQVars,
Index: compiler/prog_io_dcg.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_dcg.m,v
retrieving revision 1.14
diff -u -r1.14 prog_io_dcg.m
--- compiler/prog_io_dcg.m	2000/01/13 06:16:56	1.14
+++ compiler/prog_io_dcg.m	2000/03/09 12:26:24
@@ -155,7 +155,7 @@
 parse_dcg_goal_2("[]", [], Context, VarSet0, N0, Var0,
 		Goal, VarSet, N, Var) :-
 	new_dcg_var(VarSet0, N0, VarSet, N, Var),
-	Goal = unify(term__variable(Var0), term__variable(Var)) - Context.
+	Goal = unify(term__variable(Var0), term__variable(Var), pure) - Context.
 
 	% Non-empty list of terminals.  Append the DCG output arg
 	% as the new tail of the list, and unify the result with
@@ -166,19 +166,19 @@
 	ConsTerm0 = term__functor(term__atom("."), [X, Xs], Context),
 	term__coerce(ConsTerm0, ConsTerm),
 	term_list_append_term(ConsTerm, term__variable(Var), Term), 
-	Goal = unify(term__variable(Var0), Term) - Context.
+	Goal = unify(term__variable(Var0), Term, pure) - Context.
 
 	% Call to '='/1 - unify argument with DCG input arg.
 parse_dcg_goal_2("=", [A0], Context, VarSet, N, Var, Goal, VarSet, N, Var) :-
 	term__coerce(A0, A),
-	Goal = unify(A, term__variable(Var)) - Context.
+	Goal = unify(A, term__variable(Var), pure) - Context.
 
 	% Call to ':='/1 - unify argument with DCG output arg.
 parse_dcg_goal_2(":=", [A0], Context, VarSet0, N0, _Var0,
 		Goal, VarSet, N, Var) :-
 	new_dcg_var(VarSet0, N0, VarSet, N, Var),
 	term__coerce(A0, A),
-	Goal = unify(A, term__variable(Var)) - Context.
+	Goal = unify(A, term__variable(Var), pure) - Context.
 
 	% If-then (Prolog syntax).
 	% We need to add an else part to unify the DCG args.
@@ -209,7 +209,7 @@
 	( Var = Var0 ->
 		Goal = if_then(SomeVars, Cond, Then) - Context
 	;
-		Unify = unify(term__variable(Var), term__variable(Var0)),
+		Unify = unify(term__variable(Var), term__variable(Var0), pure),
 		Goal = if_then_else(SomeVars, Cond, Then, Unify - Context)
 			- Context
 	).
@@ -244,13 +244,13 @@
 		; VarA = Var0 ->
 			Var = VarB,
 			Unify = unify(term__variable(Var),
-				term__variable(VarA)),
+				term__variable(VarA), pure),
 			append_to_disjunct(A1, Unify, Context, A2),
 			Goal = (A2 ; B1) - Context
 		; VarB = Var0 ->
 			Var = VarA,
 			Unify = unify(term__variable(Var),
-				term__variable(VarB)),
+				term__variable(VarB), pure),
 			append_to_disjunct(B1, Unify, Context, B2),
 			Goal = (A1 ; B2) - Context
 		;
@@ -380,7 +380,7 @@
 		Var2),
 	( Var0 \= Var1, Var1 = Var2 ->
 		new_dcg_var(VarSet2, N2, VarSet, N, Var),
-		Unify = unify(term__variable(Var), term__variable(Var2)),
+		Unify = unify(term__variable(Var), term__variable(Var2), pure),
 		Then = (Then1, Unify - Context) - Context
 	;
 		Then = Then1,
@@ -406,13 +406,15 @@
 		Else = Else1
 	; VarThen = Var0 ->
 		Var = VarElse,
-		Unify = unify(term__variable(Var), term__variable(VarThen)),
+		Unify = unify(term__variable(Var), term__variable(VarThen),
+			pure),
 		Then = (Then1, Unify - Context) - Context,
 		Else = Else1
 	; VarElse = Var0 ->
 		Var = VarThen,
 		Then = Then1,
-		Unify = unify(term__variable(Var), term__variable(VarElse)),
+		Unify = unify(term__variable(Var), term__variable(VarElse),
+			pure),
 		Else = (Else1, Unify - Context) - Context
 	;
 		% We prefer to substitute the then part since it is likely
Index: compiler/prog_io_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_goal.m,v
retrieving revision 1.18
diff -u -r1.18 prog_io_goal.m
--- compiler/prog_io_goal.m	2000/02/16 07:27:17	1.18
+++ compiler/prog_io_goal.m	2000/03/09 12:23:08
@@ -147,7 +147,7 @@
 :- mode parse_goal_2(in, in, in, out, out) is semidet.
 parse_goal_2("true", [], V, true, V).
 parse_goal_2("fail", [], V, fail, V).
-parse_goal_2("=", [A0, B0], V, unify(A, B), V) :-
+parse_goal_2("=", [A0, B0], V, unify(A, B, pure), V) :-
 	term__coerce(A0, A),
 	term__coerce(B0, B).
 /******
@@ -227,7 +227,7 @@
 	% the parser - we ought to handle it in the code generation -
 	% but then `is/2' itself is a bit of a hack
 	%
-parse_goal_2("is", [A0, B0], V, unify(A, B), V) :-
+parse_goal_2("is", [A0, B0], V, unify(A, B, pure), V) :-
 	term__coerce(A0, A),
 	term__coerce(B0, B).
 parse_goal_2("impure", [A0], V0, A, V) :-
@@ -244,6 +244,8 @@
 	parse_goal(A0, V0, A1, V),
 	(   A1 = call(Pred, Args, pure) - _ ->
 		A = call(Pred, Args, Purity)
+	;   A1 = unify(ProgTerm1, ProgTerm2, pure) - _ ->
+		A = unify(ProgTerm1, ProgTerm2, Purity)
 	;
 		% Inappropriate placement of an impurity marker, so we treat
 		% it like a predicate call.  typecheck.m prints out something
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.49
diff -u -r1.49 prog_util.m
--- compiler/prog_util.m	2000/02/16 07:27:19	1.49
+++ compiler/prog_util.m	2000/03/09 12:17:31
@@ -287,8 +287,8 @@
 		call(SymName, Terms, Purity)) :-
 	term__substitute_list(Terms0, OldVar, term__variable(NewVar),
 		Terms).
-prog_util__rename_in_goal_expr(unify(TermA0, TermB0), OldVar, NewVar,
-		unify(TermA, TermB)) :-
+prog_util__rename_in_goal_expr(unify(TermA0, TermB0, Purity), OldVar, NewVar,
+		unify(TermA, TermB, Purity)) :-
 	term__substitute(TermA0, OldVar, term__variable(NewVar),
 		TermA),
 	term__substitute(TermB0, OldVar, term__variable(NewVar),
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.23
diff -u -r1.23 purity.m
--- compiler/purity.m	2000/03/27 05:07:49	1.23
+++ compiler/purity.m	2000/04/04 08:19:13
@@ -5,7 +5,9 @@
 %-----------------------------------------------------------------------------%
 % 
 % File      : purity.m
-% Authors   : pets (Peter Schachte)
+% Authors   : scachte (Peter Schachte) 
+% 		(main author and designer of purity system)
+%	      trd (modifications for impure functions)
 % Purpose   : handle `impure' and `promise_pure' declarations;
 %	      finish off type checking.
 %
@@ -145,7 +147,7 @@
 
 :- implementation.
 
-:- import_module hlds_pred, prog_io_util.
+:- import_module hlds_pred, 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.
@@ -356,6 +358,9 @@
 	{ pred_info_get_promised_pure(PredInfo0, Promised) },
 	( { pred_info_get_goal_type(PredInfo0, pragmas) } ->
 		{ WorstPurity = (impure) },
+		{ IsPragmaCCode = yes },
+			% This is where we assume pragma C code is
+			% pure.
 		{ Purity = pure },
 		{ PredInfo = PredInfo0 },
 		{ NumErrors0 = 0 }
@@ -372,23 +377,28 @@
 				ClausesInfo) },
 		{ pred_info_set_clauses_info(PredInfo1, ClausesInfo,
 				PredInfo) },
-		{ WorstPurity = Purity }
+		{ WorstPurity = Purity },
+		{ IsPragmaCCode = no }
 	),
-	( { DeclPurity \= pure, Promised = yes } ->
+	{ perform_pred_purity_checks(PredInfo, Purity, DeclPurity, Promised,
+		IsPragmaCCode, PurityCheckResult) },
+	( { PurityCheckResult = inconsistent_promise },
 		{ NumErrors is NumErrors0 + 1 },
 		error_inconsistent_promise(ModuleInfo, PredInfo, PredId,
 					  DeclPurity)
-	; { less_pure(DeclPurity, WorstPurity) } ->
+	; { PurityCheckResult = unnecessary_decl },
 		{ NumErrors = NumErrors0 },
 		warn_exaggerated_impurity_decl(ModuleInfo, PredInfo, PredId,
 					     DeclPurity, WorstPurity)
-	; { less_pure(Purity, DeclPurity), Promised = no } ->
+	; { PurityCheckResult = insufficient_decl },
 		{ NumErrors is NumErrors0 + 1 },
 		error_inferred_impure(ModuleInfo, PredInfo, PredId, Purity)
-	; { Purity = pure, Promised = yes } ->
+	; { 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") }
+	; { PurityCheckResult = no_worries },
 		{ NumErrors = NumErrors0 }
 	).
 
@@ -439,29 +449,35 @@
 	{ pred_info_get_purity(CalleePredInfo, ActualPurity) },
 	{ infer_goal_info_purity(GoalInfo, DeclaredPurity) },
 	{ goal_info_get_context(GoalInfo, CallContext) },
-	( { code_util__compiler_generated(PredInfo) } ->
-		% Don't require purity annotations on calls in
-		% compiler-generated code
-		{ NumErrors = NumErrors0 }
-	; { ActualPurity = DeclaredPurity } ->
-		{ NumErrors = NumErrors0 }
-	; { InClosure = yes } ->
-		% Don't report purity errors inside closures:  the whole
-		% closure is an error if it's not pure
-		{ NumErrors = NumErrors0 }
-	; { less_pure(ActualPurity, DeclaredPurity) } ->
+
+	{ 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 }
-	;
-		warn_unnecessary_body_impurity_decl(ModuleInfo, PredInfo,
-						    CalleePredInfo,
+	; { 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 }
 	).
+
+
 compute_expr_purity(generic_call(GenericCall0, Args, Modes0, Det), GoalExpr,
 		GoalInfo, PredInfo0, PredInfo, ModuleInfo, _InClosure, Purity,
 		NumErrors0, NumErrors) -->
@@ -495,9 +511,8 @@
 	compute_cases_purity(Cases0, Cases, PredInfo0, PredInfo, ModuleInfo,
 			     InClosure, pure, Purity, NumErrors0, NumErrors).
 compute_expr_purity(Unif0, GoalExpr, GoalInfo, PredInfo0, PredInfo,
-		ModuleInfo, _, pure, NumErrors0, NumErrors) -->
+		ModuleInfo, InClosure, ActualPurity, NumErrors0, NumErrors) -->
 	{ Unif0 = unify(Var, RHS0, Mode, Unification, UnifyContext) },
-
 	(
 		{ RHS0 = lambda_goal(F, EvalMethod, FixModes, H, Vars,
 			Modes0, K, Goal0 - Info0) }
@@ -508,6 +523,7 @@
 			ModuleInfo, yes, Purity, NumErrors0, NumErrors1),
 		error_if_closure_impure(GoalInfo, Purity,
 					NumErrors1, NumErrors),
+
 		{
 			FixModes = modes_are_ok,
 			Modes = Modes0
@@ -539,18 +555,32 @@
 			fix_aditi_state_modes(StateMode, LambdaVarTypes,
 				Modes0, Modes)
 		},
-		{ GoalExpr = unify(Var, RHS, Mode, Unification, UnifyContext) }
+		{ GoalExpr = unify(Var, RHS, Mode, Unification, UnifyContext) },
+		{ ActualPurity = pure }
 	;
 		{ RHS0 = functor(ConsId, Args) } 
 	->
 		{ post_typecheck__resolve_unify_functor(Var, ConsId, Args,
 			Mode, Unification, UnifyContext, GoalInfo,
-			ModuleInfo, PredInfo0, PredInfo, Goal) },
-		{ Goal = GoalExpr - _ },
-		{ NumErrors = NumErrors0 }
+			ModuleInfo, PredInfo0, PredInfo1, Goal1) },
+		( 
+			{ 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 },
+			{ Goal = Goal1 }
+		),
+		{ Goal = GoalExpr - _ }
 	;
 		{ PredInfo = PredInfo0 },
 		{ GoalExpr = Unif0 },
+		{ ActualPurity = pure },
 		{ NumErrors = NumErrors0 }
 	).
 compute_expr_purity(disj(Goals0,Store), disj(Goals,Store), _,
@@ -600,6 +630,178 @@
 	% 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) },
+	{ map__lookup(VarTypes, Var, TypeOfVar) },
+	( 
+		{ ConsId = cons(PName, _) },
+		{ type_is_higher_order(TypeOfVar, PredOrFunc,
+			_EvalMethod, VarArgTypes) }
+	->
+		{ pred_info_typevarset(PredInfo, TVarSet) },
+		{ map__apply_to_list(Args, VarTypes, ArgTypes0) },
+		{ list__append(ArgTypes0, VarArgTypes, PredArgTypes) },
+		( 
+			{ get_pred_id(PName, PredOrFunc, TVarSet, PredArgTypes,
+				ModuleInfo, CalleePredId) }
+		->
+			{ module_info_pred_info(ModuleInfo,
+				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) },
+			error_unknown_predicate(CallContext),
+			{ Purity = pure },
+			{ NumErrors is NumErrors0 + 1 }
+		),
+		{ ActualPurity = Purity }
+	;
+		{ ActualPurity = pure },
+		{ NumErrors = NumErrors0 }
+	).
+
+	% the possible results of a purity check
+:- type purity_check_result 
+		--->	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
+						% but not required
+		;	unnecessary_decl.	% purity decl is more than is 
+						% required.
+
+	% Peform purity checking of the actual and declared purity,
+	% and check that promises are consistent.
+	%
+	% ActualPurity: The inferred purity of the pred
+	% DeclaredPurity: The declared purity of the pred
+	% 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.
+perform_pred_purity_checks(PredInfo, ActualPurity, DeclaredPurity,
+		Promised, IsPragmaCCode, PurityCheckResult) :-
+	( 
+		% You have to declare pure if a promise is made
+		% (if we implement promise semipure this will change)
+		Promised = yes, DeclaredPurity \= pure
+	->
+		PurityCheckResult = inconsistent_promise
+	;
+		% You shouldn't promise pure unnecessarily.
+		Promised = yes, ActualPurity = pure
+	->
+		PurityCheckResult = unnecessary_promise_pure
+	;
+		% The purity should match the declaration
+		ActualPurity = DeclaredPurity
+	->
+		PurityCheckResult = no_worries
+	; 
+		less_pure(ActualPurity, DeclaredPurity)
+	->
+		( Promised = no ->
+			PurityCheckResult = insufficient_decl
+		;
+			PurityCheckResult = no_worries
+		)
+	;
+			% We don't warn about exaggerated impurity decls in
+			% class methods or instance methods --- it just
+			% means that the predicate provided as an
+			% implementation was more pure than necessary.
+			%
+			% We don't warn about exaggerated impurity
+			% 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),
+		( 
+			IsPragmaCCode = yes
+		;
+			check_marker(Markers, class_method) 
+		;
+			check_marker(Markers, class_instance_method) 
+		)
+	->
+		PurityCheckResult = no_worries
+	;
+		PurityCheckResult = unnecessary_decl
+	).
+
+	% Peform purity checking of the actual and declared purity,
+	% and check that promises are consistent.
+	%
+	% 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) :-
+	( 
+		% The purity should match the declaration
+		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)
+	->
+		PurityCheckResult = no_impure_in_closure
+	; 
+		less_pure(ActualPurity, DeclaredPurity)
+	->
+		PurityCheckResult = insufficient_decl
+	;
+			% We don't warn about exaggerated impurity decls in
+			% class methods or instance methods --- it just
+			% means that the predicate provided as an
+			% implementation was more pure than necessary.
+			%
+			% We don't warn about exaggerated impurity
+			% 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),
+		( 
+			check_marker(Markers, class_method) 
+		;
+			check_marker(Markers, class_instance_method) 
+		)
+	->
+		PurityCheckResult = no_worries
+	;
+		PurityCheckResult = unnecessary_decl
+	).
+
 :- 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,
@@ -709,28 +911,14 @@
 
 warn_exaggerated_impurity_decl(ModuleInfo, PredInfo, PredId,
 		DeclPurity, AcutalPurity) -->
-	(
-			% A class method can't have exaggerated impurity...
-			% the impurity means that implementations are *allowed*
-			% to be impure.
-		{ pred_info_get_markers(PredInfo, Markers) },
-		{ 
-			check_marker(Markers, class_method) 
-		;
-			check_marker(Markers, class_instance_method) 
-		}
-	->
-		[]
-	;
-		{ pred_info_context(PredInfo, Context) },
-		write_context_and_pred_id(ModuleInfo, PredInfo, PredId),
-		prog_out__write_context(Context),
-		report_warning("  warning: declared `"),
-		write_purity(DeclPurity),
-		io__write_string("' but actually "),
-		write_purity(AcutalPurity),
-		io__write_string(".\n")
-	).
+	{ pred_info_context(PredInfo, Context) },
+	write_context_and_pred_id(ModuleInfo, PredInfo, PredId),
+	prog_out__write_context(Context),
+	report_warning("  warning: declared `"),
+	write_purity(DeclPurity),
+	io__write_string("' but actually "),
+	write_purity(AcutalPurity),
+	io__write_string(".\n").
 
 :- pred warn_unnecessary_promise_pure(module_info, pred_info, pred_id,
 				  io__state, io__state).
@@ -787,7 +975,7 @@
 				  prog_context, purity, io__state, io__state).
 :- mode error_missing_body_impurity_decl(in, in, in, in, in, di, uo) is det.
 
-error_missing_body_impurity_decl(ModuleInfo, _, PredId, Context,
+error_missing_body_impurity_decl(ModuleInfo, PredInfo, PredId, Context,
 		Purity) -->
 	prog_out__write_context(Context),
 	io__write_string("In call to "),
@@ -796,47 +984,44 @@
 	hlds_out__write_pred_id(ModuleInfo, PredId),
 	io__write_string(":\n"),
 	prog_out__write_context(Context),
-	io__write_string("  error: call must be preceded by `"),
-	write_purity(Purity),
-	io__write_string("' indicator.\n").
+	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
+	( { PredOrFunc = predicate } ->
+		io__write_string("  error: call must be preceded by `"),
+		write_purity(Purity),
+		io__write_string("' indicator.\n")
+	;
+		io__write_string("  error: call must be in an explicit unification\n"),
+		prog_out__write_context(Context),
+		io__write_string("  which is preceded by `"),
+		write_purity(Purity),
+		io__write_string("' indicator.\n")
 
+	).
 
-:- pred warn_unnecessary_body_impurity_decl(module_info, pred_info, pred_info, 
+:- 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, in, di, uo)
+:- mode warn_unnecessary_body_impurity_decl(in, in, in, in, in, in, di, uo)
 	is det.
 
-warn_unnecessary_body_impurity_decl(ModuleInfo, CallerPredInfo, _PredInfo,
+warn_unnecessary_body_impurity_decl(ModuleInfo, _PredInfo,
 		PredId, Context, ActualPurity, DeclaredPurity) -->
-	(
-			% We don't warn about exaggerated impurity decls in
-			% instance methods --- it just means that the predicate
-			% provided as an implementation was more pure than
-			% necessary.
-		{ pred_info_get_markers(CallerPredInfo, Markers) },
-		{ check_marker(Markers, class_instance_method) }
-	->
-		[]
+	prog_out__write_context(Context),
+	io__write_string("In call to "),
+	hlds_out__write_pred_id(ModuleInfo, PredId),
+	io__write_string(":\n"),
+	prog_out__write_context(Context),
+	io__write_string("  warning: unnecessary `"),
+	write_purity(DeclaredPurity),
+	io__write_string("' indicator.\n"),
+	prog_out__write_context(Context),
+	( { ActualPurity = pure } ->
+		io__write_string("  No purity indicator is necessary.\n")
 	;
-		prog_out__write_context(Context),
-		io__write_string("In call to "),
-		hlds_out__write_pred_id(ModuleInfo, PredId),
-		io__write_string(":\n"),
-		prog_out__write_context(Context),
-		io__write_string("  warning: unnecessary `"),
-		write_purity(DeclaredPurity),
-		io__write_string("' indicator.\n"),
-		prog_out__write_context(Context),
-		( { ActualPurity = pure } ->
-			io__write_string("  No purity indicator is necessary.\n")
-		;
-			io__write_string("  A purity indicator of `"),
-			write_purity(ActualPurity),
-			io__write_string("' is sufficient.\n")
-		)
+		io__write_string("  A purity indicator of `"),
+		write_purity(ActualPurity),
+		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.
@@ -859,6 +1044,19 @@
 			[]
 		)
 	).
+
+:- pred error_unknown_predicate(prog_context, io__state, io__state).
+:- mode error_unknown_predicate(in, di, uo) is det.
+
+error_unknown_predicate(Context) -->
+	prog_out__write_context(Context),
+	io__write_string("Unable to purity check this unification.\n"),
+	prog_out__write_context(Context),
+	io__write_string("  The purity of the higher order term is unknown.\n"),
+	prog_out__write_context(Context),
+	io__write_string("  This can occur if type inference fails.\n"),
+	prog_out__write_context(Context),
+	io__write_string("  You should declare the types explicitly.\n").
 
 
 :- pred write_context_and_pred_id(module_info, pred_info, pred_id,
Index: compiler/notes/authors.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/authors.html,v
retrieving revision 1.3
diff -u -r1.3 authors.html
--- compiler/notes/authors.html	1999/11/03 13:25:19	1.3
+++ compiler/notes/authors.html	2000/03/24 04:00:12
@@ -46,6 +46,8 @@
 <tr>
 <td>petdr	<td>Peter Ross		<td>petdr at cs.mu.oz.au </tr>
 <tr>
+<td>scachte	<td>Peter Schachte	<td>schachte at cs.mu.oz.au </tr>
+<tr>
 <td>squirrel	<td>Jane Langley	<td>jal at cs.mu.oz.au </tr>
 <tr>
 <td>stayl	<td>Simon Taylor	<td>stayl at students.cs.mu.oz.au </tr>
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.178
diff -u -r1.178 reference_manual.texi
--- doc/reference_manual.texi	2000/03/22 14:45:18	1.178
+++ doc/reference_manual.texi	2000/04/04 08:23:01
@@ -4626,10 +4626,10 @@
 unless declared otherwise (@pxref{Impurity}), and they must
 be type-correct and mode-correct.  (Determinism-correctness
 is also required, but it follows from the rules already stated
-above.)  They may perform destructive update on their
+above.)  Pure procedures may perform destructive update on their
 arguments only if those arguments have an appropriate
 unique mode declaration.
-They may perform I/O only if their arguments
+Pure procedures may perform I/O only if their arguments
 include an @samp{io__state} pair (see the @samp{io} chapter
 of the Mercury Library Reference Manual).
 The Mercury implementation is allowed to assume that
@@ -4663,6 +4663,11 @@
 to this procedure, which could effect the behaviour
 of the program in unpredictable ways.
 
+Impure C code relaxes some of these restrictions.  
+Impure C code may perform I/O and although it cannot update its
+arguments directly it may update something pointed to by its arguments.
+Impure C code procedures must still be type correct and mode correct.
+
 @node Including C headers
 @section Including C headers
 
@@ -5336,22 +5341,24 @@
 
 One important aim of Mercury's impurity system is to make the
 distinction between the pure and impure code very clear.  This is done
-by requiring every impure predicate to be so declared, and by requiring
-every call to an impure predicate to be flagged as such.  Predicates
-that are implemented in terms of impure predicates are assumed to be
-impure themselves unless they are explicitly promised to be pure.
+by requiring every impure predicate or function to be so declared, and
+by requiring every call to an impure predicate to be flagged as such.
+Predicates or functions that are implemented in terms of impure predicates
+or functions are assumed to be impure themselves unless they are
+explicitly promised to be pure.
 
 Please note that the facilities described here are needed only very
 rarely.  The main intent is for implementing language primitives such as
-the all solutions predicates.  Any use of @samp{impure} or @samp{semipure}
-probably indicates either a weakness in the Mercury standard library, or
-the programmer's lack of familiarity with the standard library.
-Newcomers to Mercury are hence encouraged to @strong{skip this section}.
-
-
+the all solutions predicates, or for implementing interfaces to C
+libraries using the C interface.  Any other use of @samp{impure} or
+ at samp{semipure} probably indicates either a weakness in the Mercury
+standard library, or the programmer's lack of familiarity with the
+standard library.  Newcomers to Mercury are hence encouraged to
+ at strong{skip this section}.
 
 @menu
 * Purity levels::       Choosing the right level of purity.
+* Purity ordering::     How purity levels are ordered 
 * Impurity semantics::  What impure code means.
 * Declaring impurity::  Declaring predicates impure.
 * Impure calls::        Marking a call as impure.
@@ -5372,13 +5379,15 @@
 input/output) without taking an io__state (@pxref{Types}) as input and
 returning one as output, and do not make any changes to any data
 structure that will not be undone on backtracking (unless the data
-structure would be unreachable on backtracking).  The behaviour of other
-predicates is never affected by the invocation of pure predicates, nor
-is the behaviour of pure predicates ever affected by the invocation of
-other predicates.
+structure would be unreachable on backtracking).  The behaviour of pure
+predicates is never affected by the invocation of pure predicates.
+It is possible for the invocation of pure predicate to affect the
+behaviour of non-pure predicates and vice versa.
+
+By default, Mercury predicates and functions are pure.
+Without using the foreign function interface or calling other impure
+predicates and functions it is impossible to write impure code in Mercury.
 
-The vast majority of Mercury predicates are pure.  
-
 @item semipure
 Semipure predicates are just like pure predicates, except that their
 behaviour may be affected by the invocation of impure predicates.  That
@@ -5387,11 +5396,19 @@
 themselves.
 
 @item impure
-Impure predicates may do anything, including changing the state of the
+Impure predicates may do almost anything, including changing the state of the
 computation.
+They must be type-, mode-, determinism - and uniqueness correct. 
 
 @end table
 
+ at node Purity ordering 
+ at section Purity ordering
+
+The three levels of purity have a total ordering defined upon them
+(which we will simply call the purity), where @code{pure > semipure > impure}.
+It is common to want to find the lowest purity level in a set of purity
+levels; we call the lower bound the @emph{worst purity} of the set.
 
 @node Impurity semantics
 @section Semantics
@@ -5411,16 +5428,17 @@
 it is the @emph{operational} semantics of impure predicates that Mercury
 must specify, and Mercury compilers must respect.
 
-The operational semantics of a Mercury predicate which invokes impure
-code is a modified form of the @emph{strict sequential} semantics
-(@pxref{Semantics}).  @emph{Impure} goals may not be reordered relative
-to any other goals; not even ``minimal'' reordering as implied by the
-modes is permitted.  If any such reordering is needed, this is a mode
-error.  However, @emph{pure} and @emph{semipure} goals may be reordered
-as long as they are not moved across an impure goal.  Execution of
-impure goals is strict: they must be executed if they are reached, even
-if it can be determined that that computation cannot lead to successful
-termination.
+The operational semantics of a Mercury predicate which invokes
+ at emph{impure} code is a modified form of the @emph{strict sequential}
+semantics (@pxref{Semantics}).  @emph{Impure} goals may not be reordered
+relative to any other goals; not even ``minimal'' reordering as implied
+by the modes is permitted.  If any such reordering is needed, this is a
+mode error.  However, @emph{pure} and @emph{semipure} goals may be
+reordered as the compiler desires (within the bounds of the semantics
+the user has specified for the program) as long as they are not moved
+across an impure goal.  Execution of impure goals is strict: they must
+be executed if they are reached, even if it can be determined that that
+computation cannot lead to successful termination.
 
 Semipure goals can be given a ``contextual'' declarative semantics.
 They cannot have any side-effects, so it is expected that, given the
@@ -5433,9 +5451,16 @@
 nature of the semantics of semipure goals; within a single context, a
 compiler may treat a semipure goal as if it were pure.
 
-
 @node Declaring impurity
- at section Declaring predicate impurity
+ at section Declaring impure functions and predicates
+
+Every Mercury predicate or function has exactly two purity values
+associated with it.
+One is the @emph{declared} purity of the predicate or function, which is
+given by the programmer.
+The other value is the @emph{inferred} purity,
+which is calculated from the purity of goals in the body of the
+predicate or function.
 
 A predicate is declared to be impure or semipure by preceding the word
 @code{pred} in its @code{pred} declaration with @code{impure}
@@ -5449,22 +5474,46 @@
 or
 
 @example
-:- semipure pred @var{Pred}(@var{Arguments}@dots{}).
+:- semipure func @var{Pred}(@var{Arguments}@dots{}) = (Result).
 @end example
 
 @noindent
-declares the predicate @var{Pred} to be impure or semipure, respectively.
+declares the predicate @var{Pred} to be impure and the function
+ at var{Func} to be semipure, respectively.
 
+Type class methods may also be declared as @code{impure} or
+ at code{semipure} by preceeding the word @code{pred} or @code{func} with the
+appropriate purity level.  An instance of the type class must provide
+method implementations that are at least as pure as the method
+declaration. 
 
 @node Impure calls
 @section Marking a call as impure
 
+Every call to a Mercury predicate or function also has exactly two
+purity values associated with it.
+One is the declared purity of the call, which is
+given by the programmer as an annotation of the call.
+The other value is the inferred purity,
+which is the purity of the predicate or function.
+
+It is an error for the declared purity of a goal to be more pure than
+the inferred purity, the compiler should flag this as an error.
+The compiler should issue a warning if the declared purity of a goal is
+less pure than its inferred purity.
+
 If a predicate is impure or semipure, all calls to it must be preceded
-with the word @code{impure} or @code{semipure}, respectively.  Note
-that only predicate calls need to (and are permitted to) be prefixed
-with @code{impure} or @code{semipure}, compound goals never need this.
-See @ref{Impurity Example} for an example of this.
+with the word @code{impure} or @code{semipure}, respectively. 
 
+If a function is impure or semipure, it must be called as part of a
+simple unification with a variable, and this unification must be
+prefixed by the word @code{impure} or @code{semipure}, respectively.
+
+Note that only predicate calls and unifications of variables with 
+functions need to (and are permitted to) be prefixed
+with @code{impure} or @code{semipure}.  Compound goals never need this.
+See @ref{Impurity Example} for an example of this syntax.
+
 The requirement that impure or semipure calls be marked with
 @code{impure} or @code{semipure} allows someone 
 reading the code to tell which goals are not pure, making code which
@@ -5476,11 +5525,23 @@
 
 @node Promising purity
 @section Promising that a predicate is pure
+
+Predicates that are implemented in terms of impure or semipure predicates are
+assumed to have the @emph{worst impurity} of the goals in their body.
+The declared purity of a predicate must not be more pure
+than the inferred purity; if it is, the compiler must generate an error.
+If the declared purity is less pure than the inferred purity, the
+compiler should issue a warning (this is similar to the above case for
+goals).
+Because the inferred purity of the predicate is calculated from the
+declared purity of the calls it executes,  the worst impurity 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.
 
-Some predicates which call impure or semipure predicates are themselves
-pure.  In fact, the main purpose of the Mercury impurity system is to
-allow programmers to write pure predicates using impure ones, while protecting
-the procedural implementation from aggressive compiler optimizations.
 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.
@@ -5514,8 +5575,8 @@
         [will_not_call_mercury],
         "if (X > max) max = X;").
 
-:- semipure pred get_max(int::out) is det.
-:- pragma c_code(get_max(X::out),
+:- semipure func get_max = (int::out) is det.
+:- pragma c_code(get_max = (X::out),
         [will_not_call_mercury],
         "X = max;").
 
@@ -5528,7 +5589,7 @@
         (   Generator(X),
             impure set_max(X),
             fail
-        ;   semipure get_max(Max)
+        ;   semipure Max = get_max
         ).
 @end example
 
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.81
diff -u -r1.81 Mmakefile
--- tests/hard_coded/Mmakefile	2000/03/28 12:11:37	1.81
+++ tests/hard_coded/Mmakefile	2000/03/30 06:14:31
@@ -181,7 +181,7 @@
 
 #-----------------------------------------------------------------------------#
 
-SUBDIRS = typeclasses sub-modules exceptions
+SUBDIRS = typeclasses sub-modules exceptions purity
 
 dep_subdirs:
 	for dir in $(SUBDIRS); do \
Index: tests/hard_coded/purity.exp
===================================================================
RCS file: purity.exp
diff -N purity.exp
--- /tmp/cvscgmWOt	Tue Apr  4 18:29:43 2000
+++ /dev/null	Thu Mar  4 04:20:11 1999
@@ -1,10 +0,0 @@
-0
-1
-3
-4
-test4 succeeds
-4
-5
-7
-8
-test4_inline succeeds
Index: tests/hard_coded/purity.m
===================================================================
RCS file: purity.m
diff -N purity.m
--- /tmp/cvsVNd5Xz	Tue Apr  4 18:29:43 2000
+++ /dev/null	Thu Mar  4 04:20:11 1999
@@ -1,164 +0,0 @@
-% Various checks that impurity declarations are treated properly.
-
-:- module purity.
-:- interface.
-:- import_module io.
-:- impure pred main(io__state::di, io__state::uo) is det.
-
-:- implementation.
-:- import_module int, list, string.
-
-main -->
-	impure test1,
-	impure test2,
-	impure test3,
-	impure test4,
-	impure test1_inline,
-	impure test2_inline,
-	impure test3_inline,
-	impure test4_inline.
-
-
-:- impure pred test1(io__state::di, io__state::uo) is det.
-:- impure pred test2(io__state::di, io__state::uo) is det.
-:- impure pred test3(io__state::di, io__state::uo) is det.
-:- impure pred test4(io__state::di, io__state::uo) is det.
-
-:- impure pred test1_inline(io__state::di, io__state::uo) is det.
-:- impure pred test2_inline(io__state::di, io__state::uo) is det.
-:- impure pred test3_inline(io__state::di, io__state::uo) is det.
-:- impure pred test4_inline(io__state::di, io__state::uo) is det.
-
-
-:- impure pred set_x(int::in) is det.
-:- pragma c_code(set_x(X::in), will_not_call_mercury, "x=X;" ).
-:- pragma no_inline(set_x/1).
-
-:- impure pred incr_x is det.
-:- pragma c_code(incr_x, will_not_call_mercury, "++x;" ).
-:- pragma no_inline(incr_x/0).
-
-:- semipure pred get_x(int::out) is det.
-:- pragma c_code(get_x(X::out), will_not_call_mercury, "X=x;").
-:- pragma no_inline(get_x/1).
-
-
-:- impure pred set_x_inline(int::in) is det.
-:- pragma c_code(set_x_inline(X::in), will_not_call_mercury, "x=X;" ).
-:- pragma inline(set_x_inline/1).
-
-:- impure pred incr_x_inline is det.
-:- pragma c_code(incr_x_inline, will_not_call_mercury, "++x;" ).
-:- pragma inline(incr_x_inline/0).
-
-:- semipure pred get_x_inline(int::out) is det.
-:- pragma c_code(get_x_inline(X::out), will_not_call_mercury, "X=x;").
-:- pragma inline(get_x_inline/1).
-
-
-:- pragma c_header_code("int x = 0;").
-
-
-% tempt compiler to optimize away duplicate semipure goals.
-test1 -->
-	{ semipure get_x(X) },
-	io__format("%d\n", [i(X)]),
-	{ impure set_x(X+1) },
-	{ semipure get_x(Y) },
-	io__format("%d\n", [i(Y)]).
-
-
-% tempt compiler to optimize away duplicate impure goals, or to compile away
-% det goals with no outputs.
-test2 -->
-	{ impure incr_x },
-	{ impure incr_x },
-	{ semipure get_x(Y) },
-	io__format("%d\n", [i(Y)]).
-
-% tempt compiler to optimize away impure goal in branch that cannot succeed.
-test3 -->
-	(   { impure incr_x },
-	    { fail }
-	;   { semipure get_x(Y) }
-	),
-	io__format("%d\n", [i(Y)]).
-
-/***
-% This test used to be written as follows, but currently
-% the unique mode analysis is not smart enough to realize
-% that the disjuncts which update the I/O state won't
-% backtrack over I/O if the code is written like that.
-
-% tempt compiler to optimize away impure goal in branch that cannot succeed.
-test3 -->
-	(   { impure incr_x },
-	    { fail }
-	;   { semipure get_x(Y) },
-	    io__format("%d\n", [i(Y)])
-	).
-***/
-
-% regression test for problem with calls to implied modes of impure/semipure
-% preds reporting spurious warnings about impurity markers in the wrong place.
-test4 -->
-	{ semipure get_x(OldX) },
-	{ impure incr_x },
-	(   { semipure get_x(OldX+1) } ->
-		io__write_string("test4 succeeds\n")
-	;   io__write_string("test4 fails\n")
-	),
-	{ impure set_x(OldX) }.
-
-
-%  Now do it all again with inlining requested
-
-% tempt compiler to optimize away duplicate semipure goals.
-test1_inline -->
-	{ semipure get_x_inline(X) },
-	io__format("%d\n", [i(X)]),
-	{ impure set_x_inline(X+1) },
-	{ semipure get_x_inline(Y) },
-	io__format("%d\n", [i(Y)]).
-
-% tempt compiler to optimize away duplicate impure goals, or to compile away
-% det goals with no outputs.
-test2_inline -->
-	{ impure incr_x_inline },
-	{ impure incr_x_inline },
-	{ semipure get_x_inline(Y) },
-	io__format("%d\n", [i(Y)]).
-
-% tempt compiler to optimize away impure goal in branch that cannot succeed.
-test3_inline -->
-	(   { impure incr_x_inline },
-	    { fail }
-	;   { semipure get_x_inline(Y) }
-	),
-	io__format("%d\n", [i(Y)]).
-
-/***
-% This test used to be written as follows, but currently
-% the unique mode analysis is not smart enough to realize
-% that the disjuncts which update the I/O state won't
-% backtrack over I/O if the code is written like that.
-
-% tempt compiler to optimize away impure goal in branch that cannot succeed.
-test3_inline -->
-	(   { impure incr_x_inline },
-	    { fail }
-	;   { semipure get_x_inline(Y) },
-	    io__format("%d\n", [i(Y)])
-	).
-***/
-
-% regression test for problem with calls to implied modes of impure/semipure
-% preds reporting spurious warnings about impurity markers in the wrong place.
-test4_inline -->
-	{ semipure get_x_inline(OldX) },
-	{ impure incr_x_inline },
-	(   { semipure get_x_inline(OldX+1) } ->
-		io__write_string("test4_inline succeeds\n")
-	;   io__write_string("test4_inline fails\n")
-	),
-	{ impure set_x_inline(OldX) }.
Index: tests/hard_coded/purity/Mmakefile
===================================================================
RCS file: Mmakefile
diff -N Mmakefile
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ Mmakefile	Sun Mar 26 18:04:11 2000
@@ -0,0 +1,30 @@
+#-----------------------------------------------------------------------------#
+
+main_target: check
+
+include ../../Mmake.common
+
+#-----------------------------------------------------------------------------#
+
+PROGS=	\
+	purity \
+	impure_func_t1 
+
+#-----------------------------------------------------------------------------#
+
+DEPS=	$(PROGS:%=%.dep)
+DEPENDS=$(PROGS:%=%.depend)
+OUTS=	$(PROGS:%=%.out)
+RESS=	$(PROGS:%=%.res)
+
+#-----------------------------------------------------------------------------#
+
+dep:	$(DEPS)
+
+depend:	$(DEPENDS)
+
+check:	$(OUTS) $(RESS)
+
+all:	$(PROGS)
+
+#-----------------------------------------------------------------------------#
Index: tests/hard_coded/purity/impure_func_t1.m
===================================================================
RCS file: impure_func_t1.m
diff -N impure_func_t1.m
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_func_t1.m	Sun Mar 26 17:50:42 2000
@@ -0,0 +1,26 @@
+
+:- module impure_func_t1.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+:- import_module int, require.
+
+:- pragma promise_pure(main/2).
+
+main -->
+	{ impure X = get_counter },
+	print("X = "), 
+	print(X), 
+	nl.
+
+:- impure func get_counter = int is det.
+
+:- pragma c_header_code("extern Integer counter;").
+:- pragma c_code("Integer counter = 0;").
+:- pragma c_code(get_counter = (X::out), will_not_call_mercury, "X = counter;").
+
Index: tests/hard_coded/purity/purity.m
===================================================================
RCS file: purity.m
diff -N purity.m
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ purity.m	Fri Apr 16 17:52:05 1999
@@ -0,0 +1,164 @@
+% Various checks that impurity declarations are treated properly.
+
+:- module purity.
+:- interface.
+:- import_module io.
+:- impure pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+:- import_module int, list, string.
+
+main -->
+	impure test1,
+	impure test2,
+	impure test3,
+	impure test4,
+	impure test1_inline,
+	impure test2_inline,
+	impure test3_inline,
+	impure test4_inline.
+
+
+:- impure pred test1(io__state::di, io__state::uo) is det.
+:- impure pred test2(io__state::di, io__state::uo) is det.
+:- impure pred test3(io__state::di, io__state::uo) is det.
+:- impure pred test4(io__state::di, io__state::uo) is det.
+
+:- impure pred test1_inline(io__state::di, io__state::uo) is det.
+:- impure pred test2_inline(io__state::di, io__state::uo) is det.
+:- impure pred test3_inline(io__state::di, io__state::uo) is det.
+:- impure pred test4_inline(io__state::di, io__state::uo) is det.
+
+
+:- impure pred set_x(int::in) is det.
+:- pragma c_code(set_x(X::in), will_not_call_mercury, "x=X;" ).
+:- pragma no_inline(set_x/1).
+
+:- impure pred incr_x is det.
+:- pragma c_code(incr_x, will_not_call_mercury, "++x;" ).
+:- pragma no_inline(incr_x/0).
+
+:- semipure pred get_x(int::out) is det.
+:- pragma c_code(get_x(X::out), will_not_call_mercury, "X=x;").
+:- pragma no_inline(get_x/1).
+
+
+:- impure pred set_x_inline(int::in) is det.
+:- pragma c_code(set_x_inline(X::in), will_not_call_mercury, "x=X;" ).
+:- pragma inline(set_x_inline/1).
+
+:- impure pred incr_x_inline is det.
+:- pragma c_code(incr_x_inline, will_not_call_mercury, "++x;" ).
+:- pragma inline(incr_x_inline/0).
+
+:- semipure pred get_x_inline(int::out) is det.
+:- pragma c_code(get_x_inline(X::out), will_not_call_mercury, "X=x;").
+:- pragma inline(get_x_inline/1).
+
+
+:- pragma c_header_code("int x = 0;").
+
+
+% tempt compiler to optimize away duplicate semipure goals.
+test1 -->
+	{ semipure get_x(X) },
+	io__format("%d\n", [i(X)]),
+	{ impure set_x(X+1) },
+	{ semipure get_x(Y) },
+	io__format("%d\n", [i(Y)]).
+
+
+% tempt compiler to optimize away duplicate impure goals, or to compile away
+% det goals with no outputs.
+test2 -->
+	{ impure incr_x },
+	{ impure incr_x },
+	{ semipure get_x(Y) },
+	io__format("%d\n", [i(Y)]).
+
+% tempt compiler to optimize away impure goal in branch that cannot succeed.
+test3 -->
+	(   { impure incr_x },
+	    { fail }
+	;   { semipure get_x(Y) }
+	),
+	io__format("%d\n", [i(Y)]).
+
+/***
+% This test used to be written as follows, but currently
+% the unique mode analysis is not smart enough to realize
+% that the disjuncts which update the I/O state won't
+% backtrack over I/O if the code is written like that.
+
+% tempt compiler to optimize away impure goal in branch that cannot succeed.
+test3 -->
+	(   { impure incr_x },
+	    { fail }
+	;   { semipure get_x(Y) },
+	    io__format("%d\n", [i(Y)])
+	).
+***/
+
+% regression test for problem with calls to implied modes of impure/semipure
+% preds reporting spurious warnings about impurity markers in the wrong place.
+test4 -->
+	{ semipure get_x(OldX) },
+	{ impure incr_x },
+	(   { semipure get_x(OldX+1) } ->
+		io__write_string("test4 succeeds\n")
+	;   io__write_string("test4 fails\n")
+	),
+	{ impure set_x(OldX) }.
+
+
+%  Now do it all again with inlining requested
+
+% tempt compiler to optimize away duplicate semipure goals.
+test1_inline -->
+	{ semipure get_x_inline(X) },
+	io__format("%d\n", [i(X)]),
+	{ impure set_x_inline(X+1) },
+	{ semipure get_x_inline(Y) },
+	io__format("%d\n", [i(Y)]).
+
+% tempt compiler to optimize away duplicate impure goals, or to compile away
+% det goals with no outputs.
+test2_inline -->
+	{ impure incr_x_inline },
+	{ impure incr_x_inline },
+	{ semipure get_x_inline(Y) },
+	io__format("%d\n", [i(Y)]).
+
+% tempt compiler to optimize away impure goal in branch that cannot succeed.
+test3_inline -->
+	(   { impure incr_x_inline },
+	    { fail }
+	;   { semipure get_x_inline(Y) }
+	),
+	io__format("%d\n", [i(Y)]).
+
+/***
+% This test used to be written as follows, but currently
+% the unique mode analysis is not smart enough to realize
+% that the disjuncts which update the I/O state won't
+% backtrack over I/O if the code is written like that.
+
+% tempt compiler to optimize away impure goal in branch that cannot succeed.
+test3_inline -->
+	(   { impure incr_x_inline },
+	    { fail }
+	;   { semipure get_x_inline(Y) },
+	    io__format("%d\n", [i(Y)])
+	).
+***/
+
+% regression test for problem with calls to implied modes of impure/semipure
+% preds reporting spurious warnings about impurity markers in the wrong place.
+test4_inline -->
+	{ semipure get_x_inline(OldX) },
+	{ impure incr_x_inline },
+	(   { semipure get_x_inline(OldX+1) } ->
+		io__write_string("test4_inline succeeds\n")
+	;   io__write_string("test4_inline fails\n")
+	),
+	{ impure set_x_inline(OldX) }.
Index: tests/hard_coded/purity/runtests
===================================================================
RCS file: runtests
diff -N runtests
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ runtests	Mon Mar 27 14:06:19 2000
@@ -0,0 +1,27 @@
+#!/bin/sh
+# Test whether the code generated by the Mercury compiler
+# is producing the expected output.
+# Return a status of 0 (true) if everything is all right, and 1 otherwise.
+
+. ../../handle_options
+. ../../startup
+
+eval mmake $mmakeopts depend || exit 1
+eval mmake -k $mmakeopts check
+checkstatus=$?
+
+cat *.res > .allres
+if test ! -s .allres -a "$checkstatus" = 0
+then
+	echo "the tests in the hard_coded/purity directory succeeded"
+	echo "mmakeopts=$mmakeopts"
+	rm -f .allres
+	. ../../shutdown
+	exit 0
+else
+	echo "the tests in the hard_coded/purity directory failed"
+	echo "mmakeopts=$mmakeopts"
+	echo "the differences are:"
+	cat .allres
+	exit 1
+fi
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.60
diff -u -r1.60 Mmakefile
--- tests/invalid/Mmakefile	2000/03/27 05:08:23	1.60
+++ tests/invalid/Mmakefile	2000/03/29 09:19:01
@@ -141,3 +141,37 @@
 	rm -f *.err *.err_res
 
 #-----------------------------------------------------------------------------#
+
+SUBDIRS = purity
+
+dep_subdirs:
+	for dir in $(SUBDIRS); do \
+		(cd $$dir && $(SUBDIR_MMAKE) dep) || exit 1; \
+	done
+
+depend_subdirs:
+	for dir in $(SUBDIRS); do \
+		(cd $$dir && $(SUBDIR_MMAKE) depend) || exit 1; \
+	done
+
+check_subdirs:
+	for dir in $(SUBDIRS); do \
+		(cd $$dir && $(SUBDIR_MMAKE) check) || exit 1; \
+	done
+
+all_subdirs:
+	for dir in $(SUBDIRS); do \
+		(cd $$dir && $(SUBDIR_MMAKE) all) || exit 1; \
+	done
+
+clean_subdirs:
+	for dir in $(SUBDIRS); do \
+		(cd $$dir && $(SUBDIR_MMAKE) clean) || exit 1; \
+	done
+
+realclean_subdirs:
+	for dir in $(SUBDIRS); do \
+		(cd $$dir && $(SUBDIR_MMAKE) realclean) || exit 1; \
+	done
+
+#-----------------------------------------------------------------------------#
Index: tests/invalid/purity.err_exp
===================================================================
RCS file: purity.err_exp
diff -N purity.err_exp
--- /tmp/cvsvxhdZa	Tue Apr  4 18:29:48 2000
+++ /dev/null	Thu Mar  4 04:20:11 1999
@@ -1,46 +0,0 @@
-purity.m:028: In predicate `purity:w1/0':
-purity.m:028:   warning: declared `impure' but actually pure.
-purity.m:032: In predicate `purity:w2/0':
-purity.m:032:   warning: declared `semipure' but actually pure.
-purity.m:036: In predicate `purity:w3/0':
-purity.m:036:   warning: declared `impure' but actually semipure.
-purity.m:040: In predicate `purity:w4/0':
-purity.m:040:   warning: unnecessary `promise_pure' pragma.
-purity.m:045: In predicate `purity:w5/0':
-purity.m:045:   warning: declared `impure' but promised pure.
-purity.m:050: In predicate `purity:w6/0':
-purity.m:050:   warning: declared `semipure' but promised pure.
-purity.m:059: In predicate `purity:e1/0':
-purity.m:059:   error: predicate is impure.
-purity.m:059:   It must be declared `impure' or promised pure.
-purity.m:064: In predicate `purity:e2/0':
-purity.m:064:   error: predicate is semipure.
-purity.m:064:   It must be declared `semipure' or promised pure.
-purity.m:068: In predicate `purity:e3/0':
-purity.m:068:   error: predicate is impure.
-purity.m:068:   It must be declared `impure' or promised pure.
-purity.m:074: In call to impure predicate `purity:imp/0':
-purity.m:074:   error: call must be preceded by `impure' indicator.
-purity.m:078: In call to semipure predicate `purity:semi/0':
-purity.m:078:   error: call must be preceded by `semipure' indicator.
-purity.m:112: Error in closure: closure is impure.
-purity.m:118: Error in closure: closure is semipure.
-purity.m:093: In unification predicate for type (purity:e8):
-purity.m:093:   error: predicate is impure.
-purity.m:093:   It must be pure.
-purity.m:101: In unification predicate for type (purity:e9):
-purity.m:101:   error: predicate is semipure.
-purity.m:101:   It must be pure.
-purity.m:083: In clause for `e6':
-purity.m:083:   in argument 1 of call to predicate `purity:in/1':
-purity.m:083:   mode error: variable `X' has instantiatedness `free',
-purity.m:083:   expected instantiatedness was `ground'.
-purity.m:083:   The goal could not be reordered, because
-purity.m:083:   it was followed by an impure goal.
-purity.m:084:   This is the location of the impure goal.
-purity.m:090: In clause for `e7':
-purity.m:090:   in argument 1 of call to predicate `purity:imp1/1':
-purity.m:090:   mode error: variable `X' has instantiatedness `free',
-purity.m:090:   expected instantiatedness was `ground'.
-purity.m:090:   The goal could not be reordered, because it was impure.
-For more information, try recompiling with `-E'.
Index: tests/invalid/purity.m
===================================================================
RCS file: purity.m
diff -N purity.m
--- /tmp/cvsvZwbkE	Tue Apr  4 18:29:48 2000
+++ /dev/null	Thu Mar  4 04:20:11 1999
@@ -1,119 +0,0 @@
-:- module purity.
-
-%----------------------------------------------------------------
-%  Needed for later tests.
-
-:- type foo ---> a ; b.
-
-:- impure pred imp is det.
-:- pragma c_code(imp, will_not_call_mercury, ";").
-
-:- semipure pred semi is semidet.
-:- pragma c_code(semi, will_not_call_mercury, "SUCCESS_INDICATOR=0;").
-
-:- pred in(foo).
-:- mode in(in) is semidet.
-in(a).
-
-:- impure pred imp1(foo).
-:- mode imp1(in) is semidet.
-:- pragma c_code(imp1(_X::in), will_not_call_mercury, "SUCCESS_INDICATOR=0;").
-
-
-
-%----------------------------------------------------------------
-%  Warnings
-
-
-:- impure pred w1 is det.
-
-w1.
-
-:- semipure pred w2 is det.
-
-w2.
-
-:- impure pred w3 is semidet.
-
-w3 :- semipure semi.
-
-:- pred w4 is det.
-:- pragma promise_pure(w4/0).
-
-w4.
-
-:- impure pred w5 is det.
-:- pragma promise_pure(w5/0).
-
-w5 :- impure imp.
-
-:- semipure pred w6 is semidet.
-:- pragma promise_pure(w6/0).
-
-w6 :- semipure semi.
-
-
-%----------------------------------------------------------------
-%  Errors
-
-:- pred e1 is det.
-
-e1 :- impure imp.
-
-
-:- pred e2 is semidet.
-
-e2 :- semipure semi.
-
-:- semipure pred e3 is det.
-
-e3 :- impure imp.
-
-:- impure pred e4 is det.
-
-e4 :- imp.
-
-:- semipure pred e5 is semidet.
-
-e5 :- semi.
-
-:- impure pred e6 is semidet.
-
-e6 :-
-	in(X),
-	impure imp,
-	X = a.
-
-:- impure pred e7 is semidet.
-
-e7 :-
-	impure imp1(X),
-	X = a.
-
-:- type e8 ---> e8(foo) where equality is imp2.
-
-:- impure pred imp2(e8, e8).
-:- mode imp2(in, in) is semidet.
-
-:- pragma c_code(imp2(_X::in, _Y::in), will_not_call_mercury,
-	"SUCCESS_INDICATOR=0;").
-
-:- type e9 ---> e9(foo) where equality is semi2.
-
-:- semipure pred semi2(e9, e9).
-:- mode semi2(in, in) is semidet.
-
-:- pragma c_code(semi2(_X::in, _Y::in), will_not_call_mercury,
-	"SUCCESS_INDICATOR=0;").
-
-:- pred e10 is semidet.
-
-e10 :-
-	Goal1 = lambda([] is semidet, imp1(b)),
-	call(Goal1).
-
-:- pred e11 is semidet.
-
-e11 :-
-	Goal2 = lambda([] is semidet, semi),
-	call(Goal2).
Index: tests/invalid/purity_nonsense.err_exp
===================================================================
RCS file: purity_nonsense.err_exp
diff -N purity_nonsense.err_exp
--- /tmp/cvs3atE18	Tue Apr  4 18:29:48 2000
+++ /dev/null	Thu Mar  4 04:20:11 1999
@@ -1,47 +0,0 @@
-purity_nonsense.m:003: Error: invalid impurity declaration: func undefined_func = foo.
-purity_nonsense.m:005: Syntax error at token 'type': unexpected token at start of (sub)term.
-purity_nonsense.m:006: Syntax error at token 'mode': unexpected token at start of (sub)term.
-purity_nonsense.m:010: Error: `promise_pure' pragma for purity_nonsense:undefined2/0
-purity_nonsense.m:010:   without corresponding `pred' or `func' declaration.
-purity_nonsense.m:012: Error: clause for predicate `purity_nonsense:e12/0'
-purity_nonsense.m:012:   without preceding `pred' declaration.
-purity_nonsense.m:013: Error: clause for predicate `purity_nonsense:e13/0'
-purity_nonsense.m:013:   without preceding `pred' declaration.
-purity_nonsense.m:018: Warning: unnecessary `impure' marker.
-purity_nonsense.m:018:   Higher-order goals are always pure.
-purity_nonsense.m:008: Error: no clauses for predicate `purity_nonsense:undefined/0'.
-purity_nonsense.m:012: In clause for predicate `purity_nonsense:e12/0':
-purity_nonsense.m:012:   in argument 1 of call to predicate `impure/1':
-purity_nonsense.m:012:   error: the language construct \+/1 should be
-purity_nonsense.m:012:   used as a goal, not as an expression.
-purity_nonsense.m:012: In clause for predicate `purity_nonsense:e12/0':
-purity_nonsense.m:012:   in argument 1 of call to predicate `impure/1':
-purity_nonsense.m:012:   in argument 1 of functor `\+/1':
-purity_nonsense.m:012:   error: the language construct impure/1 should be
-purity_nonsense.m:012:   used as a goal, not as an expression.
-purity_nonsense.m:012: In clause for predicate `purity_nonsense:e12/0':
-purity_nonsense.m:012:   in argument 1 of call to predicate `impure/1':
-purity_nonsense.m:012:   in argument 1 of functor `\+/1':
-purity_nonsense.m:012:   in argument 1 of functor `impure/1':
-purity_nonsense.m:012:   error: undefined symbol `imp/0'.
-purity_nonsense.m:012: In clause for predicate `purity_nonsense:e12/0':
-purity_nonsense.m:012:   error: `impure' marker in an inappropriate place.
-purity_nonsense.m:013: In clause for predicate `purity_nonsense:e13/0':
-purity_nonsense.m:013:   in argument 1 of call to predicate `semipure/1':
-purity_nonsense.m:013:   error: the language construct \+/1 should be
-purity_nonsense.m:013:   used as a goal, not as an expression.
-purity_nonsense.m:013: In clause for predicate `purity_nonsense:e13/0':
-purity_nonsense.m:013:   in argument 1 of call to predicate `semipure/1':
-purity_nonsense.m:013:   in argument 1 of functor `\+/1':
-purity_nonsense.m:013:   error: the language construct semipure/1 should be
-purity_nonsense.m:013:   used as a goal, not as an expression.
-purity_nonsense.m:013: In clause for predicate `purity_nonsense:e13/0':
-purity_nonsense.m:013:   in argument 1 of call to predicate `semipure/1':
-purity_nonsense.m:013:   in argument 1 of functor `\+/1':
-purity_nonsense.m:013:   in argument 1 of functor `semipure/1':
-purity_nonsense.m:013:   error: undefined symbol `semi/0'.
-purity_nonsense.m:013: In clause for predicate `purity_nonsense:e13/0':
-purity_nonsense.m:013:   error: `semipure' marker in an inappropriate place.
-purity_nonsense.m:015: In predicate `purity_nonsense:e14/1':
-purity_nonsense.m:015:   warning: declared `impure' but actually pure.
-For more information, try recompiling with `-E'.
Index: tests/invalid/purity_nonsense.m
===================================================================
RCS file: purity_nonsense.m
diff -N purity_nonsense.m
--- /tmp/cvsp8g9aF	Tue Apr  4 18:29:48 2000
+++ /dev/null	Thu Mar  4 04:20:11 1999
@@ -1,18 +0,0 @@
-:- module purity_nonsense.
-
-:- impure func undefined_func = foo.		% no impure functions (yet)
-
-:- impure type badtype ---> oops.
-:- impure mode badmode :: free -> free.
-
-:- impure pred undefined.
-:- pragma promise_pure(undefined/0).
-:- pragma promise_pure(undefined2/0).
-
-e12 :- impure (\+ impure imp).
-e13 :- semipure (\+ semipure semi).
-
-:- impure pred e14(pred).
-:- mode e14(((pred) is semidet)) is semidet.
-
-e14(P) :- impure call(P).
Index: tests/invalid/type_inf_loop.err_exp2
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/type_inf_loop.err_exp2,v
retrieving revision 1.2
diff -u -r1.2 type_inf_loop.err_exp2
--- tests/invalid/type_inf_loop.err_exp2	1999/06/30 17:13:44	1.2
+++ tests/invalid/type_inf_loop.err_exp2	2000/04/04 07:58:24
@@ -7,4 +7,8 @@
 (The current limit is 60 iterations.  You can use the
 `--type-inference-iteration-limit' option to increase the limit).
 type_inf_loop.m:004: Inferred :- pred loop((pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred (pred T1))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))).
+type_inf_loop.m:004: Unable to purity check this unification.
+type_inf_loop.m:004:   The purity of the higher order term is unknown.
+type_inf_loop.m:004:   This can occur if type inference fails.
+type_inf_loop.m:004:   You should declare the types explicitly.
 For more information, try recompiling with `-E'.
Index: tests/invalid/purity/Mmakefile
===================================================================
RCS file: Mmakefile
diff -N Mmakefile
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ Mmakefile	Sun Mar 26 19:22:23 2000
@@ -0,0 +1,45 @@
+#-----------------------------------------------------------------------------#
+
+main_target: check
+
+include ../../Mmake.common
+
+#-----------------------------------------------------------------------------#
+
+SOURCES= \
+	impure_func_t2.m \
+	impure_func_t3.m \
+	impure_func_t4.m \
+	impure_func_t5.m \
+	impure_pred_t1.m \
+	impure_pred_t2.m \
+	purity.m \
+	purity_nonsense.m
+
+DEPS=		$(SOURCES:%.m=%.dep)
+DEPENDS=	$(SOURCES:%.m=%.depend)
+ERRS=		$(SOURCES:%.m=%.err)
+ERR_RESS=	$(SOURCES:%.m=%.err_res)
+
+%.err: %.m
+	if $(MC) $(ALL_MCFLAGS) --errorcheck-only $* > $*.err 2>&1; \
+	then false; else true; fi
+
+# Some tests have more than one possible valid output, so
+# we allow the test to pass if it matches *either* the .err_exp
+# or the .err_exp2 file. 
+%.err_res: %.err %.err_exp
+	-rm -f $@
+	diff -c $*.err_exp $*.err > $@ || \
+		{ [ -f $*.err_exp2 ] && diff -c $*.err_exp2 $*.err > $@; }
+
+all:	check
+
+check:	$(ERRS) $(ERR_RESS)
+
+errs:	$(ERRS)
+
+clean_local:
+	rm -f *.err *.err_res
+
+#-----------------------------------------------------------------------------#
Index: tests/invalid/purity/impure_func_t2.err_exp
===================================================================
RCS file: impure_func_t2.err_exp
diff -N impure_func_t2.err_exp
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_func_t2.err_exp	Sun Mar 26 17:53:07 2000
@@ -0,0 +1,4 @@
+impure_func_t2.m:016: In call to impure function `impure_func_t2:get_counter/0':
+impure_func_t2.m:016:   error: call must be in an explicit unification
+impure_func_t2.m:016:   which is preceded by `impure' indicator.
+For more information, try recompiling with `-E'.
Index: tests/invalid/purity/impure_func_t2.m
===================================================================
RCS file: impure_func_t2.m
diff -N impure_func_t2.m
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_func_t2.m	Wed Mar 29 19:20:08 2000
@@ -0,0 +1,26 @@
+
+:- module impure_func_t2.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+:- import_module int, require.
+
+:- pragma promise_pure(main/2).
+
+main -->
+	{ X = get_counter },
+	print("X = "), 
+	print(X), 
+	nl.
+
+:- impure func get_counter = int is det.
+
+:- pragma c_header_code("extern Integer counter;").
+:- pragma c_code("Integer counter = 0;").
+:- pragma c_code(get_counter = (X::out), will_not_call_mercury, "X = counter;").
+
Index: tests/invalid/purity/impure_func_t3.err_exp
===================================================================
RCS file: impure_func_t3.err_exp
diff -N impure_func_t3.err_exp
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_func_t3.err_exp	Sun Mar 26 17:54:15 2000
@@ -0,0 +1,7 @@
+impure_func_t3.m:017: In call to impure function `impure_func_t3:get_counter/0':
+impure_func_t3.m:017:   error: call must be in an explicit unification
+impure_func_t3.m:017:   which is preceded by `impure' indicator.
+impure_func_t3.m:017: In call to predicate `io:print/3':
+impure_func_t3.m:017:   warning: unnecessary `impure' indicator.
+impure_func_t3.m:017:   No purity indicator is necessary.
+For more information, try recompiling with `-E'.
Index: tests/invalid/purity/impure_func_t3.m
===================================================================
RCS file: impure_func_t3.m
diff -N impure_func_t3.m
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_func_t3.m	Sun Mar 26 17:50:42 2000
@@ -0,0 +1,25 @@
+
+:- module impure_func_t3.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+:- import_module int, require.
+
+:- pragma promise_pure(main/2).
+
+main -->
+	print("X = "), 
+	impure print(get_counter), 
+	nl.
+
+:- impure func get_counter = int is det.
+
+:- pragma c_header_code("extern Integer counter;").
+:- pragma c_code("Integer counter = 0;").
+:- pragma c_code(get_counter = (X::out), will_not_call_mercury, "X = counter;").
+
Index: tests/invalid/purity/impure_func_t4.err_exp
===================================================================
RCS file: impure_func_t4.err_exp
diff -N impure_func_t4.err_exp
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_func_t4.err_exp	Sun Mar 26 17:54:23 2000
@@ -0,0 +1,4 @@
+impure_func_t4.m:017: In call to semipure function `impure_func_t4:get_counter/0':
+impure_func_t4.m:017:   error: call must be in an explicit unification
+impure_func_t4.m:017:   which is preceded by `semipure' indicator.
+For more information, try recompiling with `-E'.
Index: tests/invalid/purity/impure_func_t4.m
===================================================================
RCS file: impure_func_t4.m
diff -N impure_func_t4.m
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_func_t4.m	Sun Mar 26 17:50:42 2000
@@ -0,0 +1,26 @@
+
+:- module impure_func_t4.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+:- import_module int, require.
+
+:- pragma promise_pure(main/2).
+
+main -->
+	print("X = "), 
+	{ X = get_counter },
+	print(X), 
+	nl.
+
+:- semipure func get_counter = int is det.
+
+:- pragma c_header_code("extern Integer counter;").
+:- pragma c_code("Integer counter = 0;").
+:- pragma c_code(get_counter = (X::out), will_not_call_mercury, "X = counter;").
+
Index: tests/invalid/purity/impure_func_t5.err_exp
===================================================================
RCS file: impure_func_t5.err_exp
diff -N impure_func_t5.err_exp
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_func_t5.err_exp	Fri Mar 31 13:14:22 2000
@@ -0,0 +1,9 @@
+impure_func_t5.m:018: In call to impure function `impure_func_t5:get_counter/1':
+impure_func_t5.m:018:   error: call must be in an explicit unification
+impure_func_t5.m:018:   which is preceded by `impure' indicator.
+impure_func_t5.m:019: In clause for `main(di, uo)':
+impure_func_t5.m:019:   mode error in unification of `Y' and `impure_func_t5:foo(X)'.
+impure_func_t5.m:019:   Variable `Y' has instantiatedness `free',
+impure_func_t5.m:019:   term `impure_func_t5:foo(X)'
+impure_func_t5.m:019:   has instantiatedness `impure_func_t5:foo(free)'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/purity/impure_func_t5.m
===================================================================
RCS file: impure_func_t5.m
diff -N impure_func_t5.m
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_func_t5.m	Sun Mar 26 17:55:18 2000
@@ -0,0 +1,29 @@
+
+:- module impure_func_t5.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+:- import_module int, require, list.
+
+:- type foo ---> foo((func int) = int).
+
+:- pragma promise_pure(main/2).
+
+main -->
+	{ Y = foo(get_counter) },
+	{ Y = foo(X) },
+	print("X = "), 
+	print(X(4)), 
+	nl.
+
+:- impure func get_counter(int) = int is det.
+
+:- pragma c_header_code("extern Integer counter;").
+:- pragma c_code("Integer counter = 0;").
+:- pragma c_code(get_counter(Y::in) = (X::out), will_not_call_mercury, "X = counter + Y;").
+
Index: tests/invalid/purity/impure_pred_t1.err_exp
===================================================================
RCS file: impure_pred_t1.err_exp
diff -N impure_pred_t1.err_exp
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_pred_t1.err_exp	Fri Mar 31 13:14:50 2000
@@ -0,0 +1,11 @@
+impure_pred_t1.m:020: In call to impure predicate `impure_pred_t1:get_counter/2':
+impure_pred_t1.m:020:   error: call must be preceded by `impure' indicator.
+impure_pred_t1.m:012: In predicate `impure_pred_t1:main/2':
+impure_pred_t1.m:012:   error: predicate is impure.
+impure_pred_t1.m:012:   It must be declared `impure' or promised pure.
+impure_pred_t1.m:021: In clause for `main(di, uo)':
+impure_pred_t1.m:021:   mode error in unification of `Y' and `impure_pred_t1:foo(X)'.
+impure_pred_t1.m:021:   Variable `Y' has instantiatedness `free',
+impure_pred_t1.m:021:   term `impure_pred_t1:foo(X)'
+impure_pred_t1.m:021:   has instantiatedness `impure_pred_t1:foo(free)'.
+For more information, try recompiling with `-E'.
Index: tests/invalid/purity/impure_pred_t1.m
===================================================================
RCS file: impure_pred_t1.m
diff -N impure_pred_t1.m
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_pred_t1.m	Sun Mar 26 17:50:42 2000
@@ -0,0 +1,32 @@
+
+% Subverting the Mercury purity system.
+
+% This should not be possible.
+
+:- module impure_pred_t1.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+:- import_module int, require, list.
+
+:- type foo ---> foo(pred(int,int)).
+
+main -->
+	{ Y = foo(get_counter) },
+	{ Y = foo(X) },
+	{ X(4, Z) },
+	print("X = "), 
+	print(Z), 
+	nl.
+
+:- impure pred get_counter(int::in, int::out) is det.
+
+:- pragma c_header_code("extern Integer counter;").
+:- pragma c_code("Integer counter = 0;").
+:- pragma c_code(get_counter(Y::in, X::out), will_not_call_mercury, "X = counter + Y;").
+
Index: tests/invalid/purity/impure_pred_t2.err_exp
===================================================================
RCS file: impure_pred_t2.err_exp
diff -N impure_pred_t2.err_exp
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_pred_t2.err_exp	Fri Mar 31 13:15:06 2000
@@ -0,0 +1,6 @@
+impure_pred_t2.m:020: In call to impure predicate `impure_pred_t2:get_counter/2':
+impure_pred_t2.m:020:   error: call must be preceded by `impure' indicator.
+impure_pred_t2.m:012: In predicate `impure_pred_t2:main/2':
+impure_pred_t2.m:012:   error: predicate is impure.
+impure_pred_t2.m:012:   It must be declared `impure' or promised pure.
+For more information, try recompiling with `-E'.
Index: tests/invalid/purity/impure_pred_t2.m
===================================================================
RCS file: impure_pred_t2.m
diff -N impure_pred_t2.m
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ impure_pred_t2.m	Sun Mar 26 17:55:34 2000
@@ -0,0 +1,31 @@
+
+% Subverting the Mercury purity system.
+
+% This should not be possible.
+
+:- module impure_pred_t2.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+:- import_module int, require, list.
+
+:- type foo ---> foo(pred(int,int)).
+
+main -->
+	{ Y = get_counter },
+	{ Y(4, Z) },
+	print("X = "), 
+	print(Z), 
+	nl.
+
+:- impure pred get_counter(int::in, int::out) is det.
+
+:- pragma c_header_code("extern Integer counter;").
+:- pragma c_code("Integer counter = 0;").
+:- pragma c_code(get_counter(Y::in, X::out), will_not_call_mercury, "X = counter + Y;").
+
Index: tests/invalid/purity/purity.err_exp
===================================================================
RCS file: purity.err_exp
diff -N purity.err_exp
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ purity.err_exp	Sun Mar 26 18:03:08 2000
@@ -0,0 +1,46 @@
+purity.m:028: In predicate `purity:w1/0':
+purity.m:028:   warning: declared `impure' but actually pure.
+purity.m:032: In predicate `purity:w2/0':
+purity.m:032:   warning: declared `semipure' but actually pure.
+purity.m:036: In predicate `purity:w3/0':
+purity.m:036:   warning: declared `impure' but actually semipure.
+purity.m:040: In predicate `purity:w4/0':
+purity.m:040:   warning: unnecessary `promise_pure' pragma.
+purity.m:045: In predicate `purity:w5/0':
+purity.m:045:   warning: declared `impure' but promised pure.
+purity.m:050: In predicate `purity:w6/0':
+purity.m:050:   warning: declared `semipure' but promised pure.
+purity.m:059: In predicate `purity:e1/0':
+purity.m:059:   error: predicate is impure.
+purity.m:059:   It must be declared `impure' or promised pure.
+purity.m:064: In predicate `purity:e2/0':
+purity.m:064:   error: predicate is semipure.
+purity.m:064:   It must be declared `semipure' or promised pure.
+purity.m:068: In predicate `purity:e3/0':
+purity.m:068:   error: predicate is impure.
+purity.m:068:   It must be declared `impure' or promised pure.
+purity.m:074: In call to impure predicate `purity:imp/0':
+purity.m:074:   error: call must be preceded by `impure' indicator.
+purity.m:078: In call to semipure predicate `purity:semi/0':
+purity.m:078:   error: call must be preceded by `semipure' indicator.
+purity.m:112: Error in closure: closure is impure.
+purity.m:118: Error in closure: closure is semipure.
+purity.m:093: In unification predicate for type (purity:e8):
+purity.m:093:   error: predicate is impure.
+purity.m:093:   It must be pure.
+purity.m:101: In unification predicate for type (purity:e9):
+purity.m:101:   error: predicate is semipure.
+purity.m:101:   It must be pure.
+purity.m:083: In clause for `e6':
+purity.m:083:   in argument 1 of call to predicate `purity:in/1':
+purity.m:083:   mode error: variable `X' has instantiatedness `free',
+purity.m:083:   expected instantiatedness was `ground'.
+purity.m:083:   The goal could not be reordered, because
+purity.m:083:   it was followed by an impure goal.
+purity.m:084:   This is the location of the impure goal.
+purity.m:090: In clause for `e7':
+purity.m:090:   in argument 1 of call to predicate `purity:imp1/1':
+purity.m:090:   mode error: variable `X' has instantiatedness `free',
+purity.m:090:   expected instantiatedness was `ground'.
+purity.m:090:   The goal could not be reordered, because it was impure.
+For more information, try recompiling with `-E'.
Index: tests/invalid/purity/purity.m
===================================================================
RCS file: purity.m
diff -N purity.m
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ purity.m	Mon Apr  3 15:07:37 2000
@@ -0,0 +1,119 @@
+:- module purity.
+:- interface.
+%----------------------------------------------------------------
+%  Needed for later tests.
+:- type foo ---> a ; b.
+:- implementation.
+
+:- impure pred imp is det.
+:- pragma c_code(imp, will_not_call_mercury, ";").
+
+:- semipure pred semi is semidet.
+:- pragma c_code(semi, will_not_call_mercury, "SUCCESS_INDICATOR=0;").
+
+:- pred in(foo).
+:- mode in(in) is semidet.
+in(a).
+
+:- impure pred imp1(foo).
+:- mode imp1(in) is semidet.
+:- pragma c_code(imp1(_X::in), will_not_call_mercury, "SUCCESS_INDICATOR=0;").
+
+
+
+%----------------------------------------------------------------
+%  Warnings
+
+
+:- impure pred w1 is det.
+
+w1.
+
+:- semipure pred w2 is det.
+
+w2.
+
+:- impure pred w3 is semidet.
+
+w3 :- semipure semi.
+
+:- pred w4 is det.
+:- pragma promise_pure(w4/0).
+
+w4.
+
+:- impure pred w5 is det.
+:- pragma promise_pure(w5/0).
+
+w5 :- impure imp.
+
+:- semipure pred w6 is semidet.
+:- pragma promise_pure(w6/0).
+
+w6 :- semipure semi.
+
+
+%----------------------------------------------------------------
+%  Errors
+
+:- pred e1 is det.
+
+e1 :- impure imp.
+
+
+:- pred e2 is semidet.
+
+e2 :- semipure semi.
+
+:- semipure pred e3 is det.
+
+e3 :- impure imp.
+
+:- impure pred e4 is det.
+
+e4 :- imp.
+
+:- semipure pred e5 is semidet.
+
+e5 :- semi.
+
+:- impure pred e6 is semidet.
+
+e6 :-
+	in(X),
+	impure imp,
+	X = a.
+
+:- impure pred e7 is semidet.
+
+e7 :-
+	impure imp1(X),
+	X = a.
+
+:- type e8 ---> e8(foo) where equality is imp2.
+
+:- impure pred imp2(e8, e8).
+:- mode imp2(in, in) is semidet.
+
+:- pragma c_code(imp2(_X::in, _Y::in), will_not_call_mercury,
+	"SUCCESS_INDICATOR=0;").
+
+:- type e9 ---> e9(foo) where equality is semi2.
+
+:- semipure pred semi2(e9, e9).
+:- mode semi2(in, in) is semidet.
+
+:- pragma c_code(semi2(_X::in, _Y::in), will_not_call_mercury,
+	"SUCCESS_INDICATOR=0;").
+
+:- pred e10 is semidet.
+
+e10 :-
+	Goal1 = lambda([] is semidet, imp1(b)),
+	call(Goal1).
+
+:- pred e11 is semidet.
+
+e11 :-
+	Goal2 = lambda([] is semidet, semi),
+	call(Goal2).
Index: tests/invalid/purity/purity_nonsense.err_exp
===================================================================
RCS file: purity_nonsense.err_exp
diff -N purity_nonsense.err_exp
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ purity_nonsense.err_exp	Wed Nov 10 09:40:13 1999
@@ -0,0 +1,47 @@
+purity_nonsense.m:003: Error: invalid impurity declaration: func undefined_func = foo.
+purity_nonsense.m:005: Syntax error at token 'type': unexpected token at start of (sub)term.
+purity_nonsense.m:006: Syntax error at token 'mode': unexpected token at start of (sub)term.
+purity_nonsense.m:010: Error: `promise_pure' pragma for purity_nonsense:undefined2/0
+purity_nonsense.m:010:   without corresponding `pred' or `func' declaration.
+purity_nonsense.m:012: Error: clause for predicate `purity_nonsense:e12/0'
+purity_nonsense.m:012:   without preceding `pred' declaration.
+purity_nonsense.m:013: Error: clause for predicate `purity_nonsense:e13/0'
+purity_nonsense.m:013:   without preceding `pred' declaration.
+purity_nonsense.m:018: Warning: unnecessary `impure' marker.
+purity_nonsense.m:018:   Higher-order goals are always pure.
+purity_nonsense.m:008: Error: no clauses for predicate `purity_nonsense:undefined/0'.
+purity_nonsense.m:012: In clause for predicate `purity_nonsense:e12/0':
+purity_nonsense.m:012:   in argument 1 of call to predicate `impure/1':
+purity_nonsense.m:012:   error: the language construct \+/1 should be
+purity_nonsense.m:012:   used as a goal, not as an expression.
+purity_nonsense.m:012: In clause for predicate `purity_nonsense:e12/0':
+purity_nonsense.m:012:   in argument 1 of call to predicate `impure/1':
+purity_nonsense.m:012:   in argument 1 of functor `\+/1':
+purity_nonsense.m:012:   error: the language construct impure/1 should be
+purity_nonsense.m:012:   used as a goal, not as an expression.
+purity_nonsense.m:012: In clause for predicate `purity_nonsense:e12/0':
+purity_nonsense.m:012:   in argument 1 of call to predicate `impure/1':
+purity_nonsense.m:012:   in argument 1 of functor `\+/1':
+purity_nonsense.m:012:   in argument 1 of functor `impure/1':
+purity_nonsense.m:012:   error: undefined symbol `imp/0'.
+purity_nonsense.m:012: In clause for predicate `purity_nonsense:e12/0':
+purity_nonsense.m:012:   error: `impure' marker in an inappropriate place.
+purity_nonsense.m:013: In clause for predicate `purity_nonsense:e13/0':
+purity_nonsense.m:013:   in argument 1 of call to predicate `semipure/1':
+purity_nonsense.m:013:   error: the language construct \+/1 should be
+purity_nonsense.m:013:   used as a goal, not as an expression.
+purity_nonsense.m:013: In clause for predicate `purity_nonsense:e13/0':
+purity_nonsense.m:013:   in argument 1 of call to predicate `semipure/1':
+purity_nonsense.m:013:   in argument 1 of functor `\+/1':
+purity_nonsense.m:013:   error: the language construct semipure/1 should be
+purity_nonsense.m:013:   used as a goal, not as an expression.
+purity_nonsense.m:013: In clause for predicate `purity_nonsense:e13/0':
+purity_nonsense.m:013:   in argument 1 of call to predicate `semipure/1':
+purity_nonsense.m:013:   in argument 1 of functor `\+/1':
+purity_nonsense.m:013:   in argument 1 of functor `semipure/1':
+purity_nonsense.m:013:   error: undefined symbol `semi/0'.
+purity_nonsense.m:013: In clause for predicate `purity_nonsense:e13/0':
+purity_nonsense.m:013:   error: `semipure' marker in an inappropriate place.
+purity_nonsense.m:015: In predicate `purity_nonsense:e14/1':
+purity_nonsense.m:015:   warning: declared `impure' but actually pure.
+For more information, try recompiling with `-E'.
Index: tests/invalid/purity/purity_nonsense.m
===================================================================
RCS file: purity_nonsense.m
diff -N purity_nonsense.m
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ purity_nonsense.m	Tue Jan  6 17:31:42 1998
@@ -0,0 +1,18 @@
+:- module purity_nonsense.
+
+:- impure func undefined_func = foo.		% no impure functions (yet)
+
+:- impure type badtype ---> oops.
+:- impure mode badmode :: free -> free.
+
+:- impure pred undefined.
+:- pragma promise_pure(undefined/0).
+:- pragma promise_pure(undefined2/0).
+
+e12 :- impure (\+ impure imp).
+e13 :- semipure (\+ semipure semi).
+
+:- impure pred e14(pred).
+:- mode e14(((pred) is semidet)) is semidet.
+
+e14(P) :- impure call(P).
Index: tests/invalid/purity/runtests
===================================================================
RCS file: runtests
diff -N runtests
--- /dev/null	Thu Mar  4 04:20:11 1999
+++ runtests	Sun Mar 26 19:25:45 2000
@@ -0,0 +1,27 @@
+#!/bin/sh
+# Test whether the code generated by the Mercury compiler
+# is producing the expected output.
+# Return a status of 0 (true) if everything is all right, and 1 otherwise.
+
+. ../../handle_options
+. ../../startup
+
+eval mmake $mmakeopts depend || exit 1
+eval mmake -k $mmakeopts check
+checkstatus=$?
+
+cat *.err_res > .allres
+if test ! -s .allres -a "$checkstatus" = 0
+then
+	echo "the tests in the invalid/purity directory succeeded"
+	echo "mmakeopts=$mmakeopts"
+	rm -f .allres
+	. ../../shutdown
+	exit 0
+else
+	echo "the tests in the invalid/purity directory failed"
+	echo "mmakeopts=$mmakeopts"
+	echo "the differences are:"
+	cat .allres
+	exit 1
+fi


-- 
       Tyson Dowd           # 
                            #  Surreal humour isn't eveyone's cup of fur.
     trd at cs.mu.oz.au        # 
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------



More information about the developers mailing list