Diff: Make Mercury cope with impure code (part 2/2)

Peter Schachte pets at cs.mu.oz.au
Fri Nov 28 18:44:45 AEDT 1997


================ begin part 2/2 ================
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/staff/zs/imp/mercury/doc/reference_manual.texi,v
retrieving revision 1.79
diff -u -r1.79 reference_manual.texi
--- reference_manual.texi	1997/10/15 16:31:47	1.79
+++ reference_manual.texi	1997/11/28 05:41:34
@@ -2614,9 +2614,10 @@
 
 There is another operational semantics of Mercury programs called
 the @dfn{strict commutative} operational semantics.  This semantics
-is equivalent to the strict sequential operation semantics except
+is equivalent to the strict sequential operational semantics except
 that there is no requirement that function calls, conjunctions and disjunctions 
 be executed left-to-right; they may be executed in any order.
+ at c XXX May they be interleaved?
 (The order may even be different each time a particular goal
 is entered.)
 
@@ -2700,6 +2701,7 @@
 @menu
 * C interface::                 The C interface allows C code to be called
                                 from Mercury code, and vice versa.
+* Impurity::                    Users can write impure Mercury code
 * Inlining::                    Pragmas can be used to suggest or prevent
                                 procedure inlining.
 * Obsolescence::                Library developers can declare old versions
@@ -3348,6 +3350,203 @@
 @c There is probably little need for user code to call this function,
 @c but it might be needed if you're doing certain low-level things
 @c such as implementing your own exception handling.
+
+ at node Impurity
+ at section Impurity declarations
+
+In order to efficiently implement certain predicates, it is sometimes
+necessary to venture outside pure logic programming.  Other predicates
+cannot be implemented at all within the paradigm of logic programming,
+for example, all solutions predicates.  Such predicates are often
+written using the C interface.  Sometimes, however, it would be more
+convenient, or more efficient, to write such predicates using the
+facilities of Mercury.  For example, it is much more convenient to
+access arguments of compound Mercury terms in Mercury than in C, and the
+ability of the Mercury compiler to specialize code can make higher-order
+predicates written in Mercury significantly more efficient than similar
+C code.
+
+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 predictes are assumed to be
+impure themselves unless they are explicitly promised to be pure.
+
+
+ at menu
+* Purity levels::       Choosing the right level of purity
+* Impurity semantics::  What impure code means
+* Declaring impurity::  Declaring predicates impure
+* Impure calls::        Marking a call as impure
+* Promising purity::    Promising a predicate is pure
+* Impurity Example::    A simple example using impurity
+ at end menu
+
+
+ at node Purity levels
+ at subsection Choosing the right level of purity
+
+Mercury distinguishes three ``levels'' of purity:
+
+ at table @dfn
+ at item pure
+Pure predicates and functions always return the same outputs given the
+same inputs.  They do not interact with the ``real'' world (i.e., do any
+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 behavior of other
+predicates is never affected by the invocation of pure predicates, nor
+is the behavior of pure predicates ever affected by the invocation of
+other predicates.
+
+Most Mercury predicates are pure.  
+
+ at item semipure
+Semipure predicates are just like pure predicates, except that their
+behavior may be affected by the invocation of impure predicates.  That
+is, they are sensitive to the state of the computation other than as
+reflected by their input arguments, though they do not affect the state
+themselves.
+
+ at item impure
+Impure predicates may do anything, including changing the state of the
+computation.
+
+ at end table
+
+
+ at node Impurity semantics
+ at subsection Semantics
+
+It is important to the proper operation of impure and semipure code, to
+the flexibility of the compiler to optimize pure code, and to the
+semantics of the Mercury language, that a clear distinction be drawn
+between ordinary Mercury code and imperative code written with Mercury
+syntax.  How this distinction is drawn will be explained below; the
+purpose of this section is to explain the semantics of programs with
+impure predicates.
+
+A @emph{declarative} semantics of impure Mercury code would be largely
+useless, because the declarative semantics cannot capture the intent of
+the programmer.  Impure predicates are executed for their side-effects,
+which by definition are not part of their declarative semantics.  Thus
+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}).  Firstly, only impure goals may not be reordered
+relative to other goals, pure and semipure goals may be reordered as
+long as they are not moved across an impure goal.  Secondly, not even
+``minimal'' reordering of impure goals is permitted; if such reordering
+is needed, this is an error.  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
+context in which they are called (relative to any impure goals in the
+program), their declarative semantics fully captures the intent of the
+programmer.  Thus a semipure goal has a perfectly consistent declarative
+semantics, until an impure goal is reached.  After that, it has another
+(possibly different) declarative semantics, until the next impure goal
+is executed, and so on.  Mercury compilers must respect this contextual
+nature of the semantics of semipure goals; within a single context, a
+compiler may treat a semipure goal as if it were pure.
+
+
+ at node Declaring impurity
+ at subsection Declaring predicate impurity
+
+A predicate is declared to be impure (semipure) by preceding the word
+ at code{predicate} in its @code{pred} declaration with @code{impure}
+(@code{semipure}).  That is, a declaration of the form:
+
+ at example
+:- impure pred @var{Pred}(@var{Arguments...}).
+ at end example
+
+ at noindent
+or
+
+ at example
+:- semipure pred @var{Pred}(@var{Arguments...}).
+ at end example
+
+ at noindent
+declares the predicate @var{Pred} to be impure or semipure, respectively.
+
+
+ at node Impure calls
+ at subsection Marking a call as impure
+
+If a predicate is impure (semipure), all calls to it must be preceded
+with the word @code{impure} (@code{semipure}).  This allows someone
+reading the code to tell which goals are not pure, making code which
+relies on side effects somewhat less mysterious.  See @ref{Impurity
+Example} for an example of this.  Note that only predicate calls need to
+be prefixed with @code{impure} or @code{semipure}, compound goals never
+need this.
+
+
+ at node Promising purity
+ at subsection Promising a predicate 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 users 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 this is the user's responsibility.
+
+The user may promise that a predicate is pure using the
+ at code{promise_pure} pragma:
+
+ at example
+:- pragma promise_pure(@var{Name}/@var{Arity}).
+ at end example
+
+
+ at node Impurity Example
+ at subsection An example using impurity
+
+The following example illustrates how a pure predicate may be
+implemented using impure code.  Note that this code is not reentrant,
+and so is not useful as is.  It is meant only as an example.
+
+ at example
+:- pragma c_header_code("int max;").
+
+:- impure pred init_max is det.
+:- pragma c_code(init_max,
+        will_not_call_mercury,
+        "max = (int)(~(((unsigned)(~0))>>1));").
+
+:- impure pred set_max(int::in) is det.
+:- pragma c_code(set_max(X::in),
+        will_not_call_mercury,
+        "if (X > max) max = X;").
+
+:- semipure pred get_max(int::out) is det.
+:- pragma c_code(get_max(X::out),
+        will_not_call_mercury,
+        "X = max;").
+
+:- pragma promise_pure(max_solution/2).
+:- pred max_solution(pred(int), int).
+:- mode max_solution(pred(out) is multi, out) is det.
+
+max_solution(Generator, Max) :-
+        impure init_max,
+        (   Generator(X),
+            impure set_max(X),
+            fail
+        ;   semipure get_max(Max)
+        ).
+ at end example
+
 
 @node Inlining
 @section Inlining
Index: doc/transition_guide.texi
===================================================================
RCS file: /home/staff/zs/imp/mercury/doc/transition_guide.texi,v
retrieving revision 1.22
diff -u -r1.22 transition_guide.texi
--- transition_guide.texi	1997/09/20 09:17:02	1.22
+++ transition_guide.texi	1997/10/01 00:53:09
@@ -154,6 +154,7 @@
 end_module      fx              1199
 if              fx              1160
 import_module   fx              1199
+impure          fy              1199
 inst            fx              1199
 is              xfx             700
 mod             xfx             300
@@ -163,6 +164,7 @@
 or              xfy             740
 pred            fx              1180
 rule            fx              1199
+semipure        fy              1199
 some            fxy             950
 then            xfx             1150
 type            fx              1180
Index: library/nc_builtin.nl
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/nc_builtin.nl,v
retrieving revision 1.15
diff -u -r1.15 nc_builtin.nl
--- nc_builtin.nl	1997/07/27 15:06:59	1.15
+++ nc_builtin.nl	1997/11/19 00:52:00
@@ -41,8 +41,6 @@
 % :- op(1199, fx, (use_op)).
 
 % :- op(1199, fx, (rule)).
-% :- op(1199, fx, (pred)).
-:- op(1199, fx, (func)).
 
 :- op(1199, fx, (pragma)).
 :- op(1199, fx, (mode)).
@@ -51,6 +49,13 @@
 :- op(1175, xfx, (::)).
 
 :- op(950, fxy, (lambda)).
+
+:- $setOpField((pred), []).			% remove `pred' as an operator
+:- op(800, fx, (pred)).				% and then replace it with
+						% lower precedence.
+:- op(800, fx, (func)).
+:- op(800, fy, (impure)).
+:- op(800, fy, (semipure)).
 
 :- op(400, yfx, (rem)).
 :- op(400, yfx, (div)).
Index: library/ops.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/ops.m,v
retrieving revision 1.18
diff -u -r1.18 ops.m
--- ops.m	1997/07/27 15:07:00	1.18
+++ ops.m	1997/11/19 00:52:38
@@ -177,7 +177,7 @@
 ops__op_table("export_pred", before, fx, 1199).	% Mercury extension (NYI)
 ops__op_table("export_sym", before, fx, 1199).	% Mercury extension (NYI)
 ops__op_table("export_type", before, fx, 1199).	% Mercury extension (NYI)
-ops__op_table("func", before, fx, 1180).	% Mercury extension
+ops__op_table("func", before, fx, 800).		% Mercury extension
 ops__op_table("if", before, fx, 1160).		% Mercury/NU-Prolog extension
 ops__op_table("import_adt", before, fx, 1199).	% Mercury extension (NYI)
 ops__op_table("import_cons", before, fx, 1199).	% Mercury extension (NYI)
@@ -186,6 +186,7 @@
 ops__op_table("import_pred", before, fx, 1199).	% Mercury extension (NYI)
 ops__op_table("import_sym", before, fx, 1199).	% Mercury extension (NYI)
 ops__op_table("import_type", before, fx, 1199).	% Mercury extension (NYI)
+ops__op_table("impure", before, fy, 800).	% Mercury extension
 ops__op_table("inst", before, fx, 1199).	% Mercury extension
 ops__op_table("is", after, xfx, 701).		% ISO Prolog says prec 700
 ops__op_table("lambda", before, fxy, 950).	% Mercury extension
@@ -195,9 +196,10 @@
 ops__op_table("not", before, fy, 900).		% Mercury/NU-Prolog extension
 ops__op_table("or", after, xfy, 740).		% NU-Prolog extension
 ops__op_table("pragma", before, fx, 1199).	% Mercury extension
-ops__op_table("pred", before, fx, 1180).	% Mercury/NU-Prolog extension
+ops__op_table("pred", before, fx, 800).		% Mercury/NU-Prolog extension
 ops__op_table("rem", after, xfx, 400).		% Standard ISO Prolog
 ops__op_table("rule", before, fx, 1199).	% NU-Prolog extension
+ops__op_table("semipure", before, fy, 800).	% Mercury extension
 ops__op_table("some", before, fxy, 950).	% Mercury/NU-Prolog extension
 ops__op_table("then", after, xfx, 1150).	% Mercury/NU-Prolog extension
 ops__op_table("type", before, fx, 1180).	% Mercury extension
Index: library/sp_builtin.nl
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/sp_builtin.nl,v
retrieving revision 1.13
diff -u -r1.13 sp_builtin.nl
--- sp_builtin.nl	1997/07/27 15:07:13	1.13
+++ sp_builtin.nl	1997/10/02 05:46:12
@@ -48,8 +48,6 @@
 :- op(1199, fx, (pragma)).
 
 :- op(1199, fx, (type)).
-:- op(1199, fx, (pred)).
-:- op(1199, fx, (func)).
 :- op(1199, fx, (mode)).
 :- op(1199, fx, (inst)).
 :- op(1179, xfy, (--->)).
@@ -63,6 +61,13 @@
 :- op(900, fy, (not)).
 
 :- op(900, xfx, (when)).
+
+:- op(800, fx, (pred)).
+:- op(800, fx, (func)).
+:- op(800, fy, (impure)).
+:- op(800, fy, (semipure)).
+
+
 :- op(740, xfy, (or)).
 :- op(720, xfy, (and)).
 
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/Mmakefile,v
retrieving revision 1.2
diff -u -r1.2 Mmakefile
--- Mmakefile	1997/10/15 07:46:32	1.2
+++ Mmakefile	1997/11/14 00:35:29
@@ -47,6 +47,7 @@
 	nullary_ho_func \
 	pragma_c_code \
 	pragma_inline \
+	purity \
 	qual_adv_test \
 	qual_basic_test \
 	qual_is_test \
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/invalid/Mmakefile,v
retrieving revision 1.5
diff -u -r1.5 Mmakefile
--- Mmakefile	1997/11/23 05:18:39	1.5
+++ Mmakefile	1997/11/25 01:02:51
@@ -31,6 +31,8 @@
 	occurs.m \
 	pragma_c_code_and_clauses1.m \
 	pragma_c_code_and_clauses2.m \
+	purity.m \
+	purity_nonsense.m \
 	pragma_c_code_no_det.m \
 	qual_basic_test2.m \
 	type_loop.m \

New File: compiler/purity.m
===================================================================
%-----------------------------------------------------------------------------%
% Copyright (C) 1997 University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
% 
% File      : purity.m
% Authors   : pets (Peter Schachte)
% Purpose   : handle `impure' and `promise_pure' declarations
%
%  The purpose of this module is to allow one to declare certain parts of
%  one's program to be impure, thereby forbidding the compiler from making
%  certain optimizations to that part of the code.  Since one can often
%  implement a perfectly pure predicate or function in terms of impure
%  predicates and functions, one is also allowed to promise to the compiler
%  that a predicate *is* pure, despite calling impure predicates and
%  functions.
%
%  To keep purity/impurity consistent, it is required that every impure
%  predicate/function be declared so.  A predicate is impure if:
%
%	1.  It's declared impure, or
%	2a. It's not promised pure, and
%	2b. It calls some impure predicates or functions.
%
%  A predicate or function is declared impure by preceding the `pred' or
%  `func' in its declaration with `impure'.  It is promised to be pure with a
%
%	:- pragma promise_pure(Name/Arity).
%
%  directive.
%
%  Calls to impure predicates may not be optimized away.  Neither may they be
%  reodered relative to any other goals in a given conjunction; ie, an impure
%  goal cleaves a conjunction into the stuff before it and the stuff after it.
%  Both of these groups may be reordered separately, but no goal from either
%  group may move into the other.  Similarly for disjunctions.
%
%  Semipure goals are goals that are sensitive to the effects of impure goals.
%  They may be reordered and optimized away just like pure goals, except that
%  a semipure goal may behave differently after a call to an impure goal than
%  before.  This means that semipure (as well as impure) predicates must not
%  be tabled.  Further, duplicate semipure goals on different sides of an
%  impure goal must not be optimized away.  In the current implementation, we
%  simply do not optimize away duplicate semipure (or impure) goals at all.
%
%  A predicate either has no purity declaration and so is assumed pure, or is
%  declared semipure or impure, or is promised to be pure despite calling
%  semipure or impure predicates.  This promise cannot be checked, so we must
%  trust the programmer.
%
%  XXX The current implementation doesn't handle impure functions.  The main
%      reason is that handling of nested functions is likely to get pretty 
%      confusing.  Because impure functions can't be reordered, the execution
%      order would have to be strictly innermost-first, left-to-right, and 
%      predicate arguments would always have to be evaluated before the
%      predicate call.  Implied modes are right out.  All in all, they just
%      won't be as natural as one might think at first.


:- module purity.
:- interface.

:- import_module hlds_module.
:- import_module io.

:- type purity		--->	pure
			;	(semipure)
			;	(impure).


%  Purity check a whole module.
:- pred puritycheck(module_info, module_info, io__state, io__state).
:- mode puritycheck(in, out, di, uo) is det.

%  Sort of a "maximum" for impurity.
:- pred worst_purity(purity, purity, purity).
:- mode worst_purity(in, in, out) is det.

%  Compare two purities.
:- pred less_pure(purity, purity).
:- mode less_pure(in, in) is semidet.

%  Print out a purity name.
:- pred write_purity(purity, io__state, io__state).
:- mode write_purity(in, di, uo) is det.

%  Get a purity name as a string.
:- pred purity_name(purity, string).
:- mode purity_name(in, out) is det.

%  Update a goal info to reflect the specified purity
:- pred add_goal_info_purity_feature(hlds_goal_info, purity, hlds_goal_info).
:- mode add_goal_info_purity_feature(in, in, out) is det.

%  Determine the purity of a goal from its hlds_goal_info.
:- pred infer_goal_info_purity(hlds_goal_info, purity).
:- mode infer_goal_info_purity(in, out) is det.

%  Check if a hlds_goal_info is for a pure goal
:- pred goal_info_is_pure(hlds_goal_info).
:- mode goal_info_is_pure(in) is semidet.

%  Check if a hlds_goal_info is for an impure goal.  Fails if the goal is
%  semipure, so this isn't the same as \+ goal_info_is_pure.
:- pred goal_info_is_impure(hlds_goal_info).
:- mode goal_info_is_impure(in) is semidet.

:- implementation.

:- import_module make_hlds, hlds_data, hlds_pred, hlds_goal, prog_io_util.
:- import_module type_util, mode_util, code_util, prog_data, unify_proc.
:- import_module globals, options, mercury_to_mercury, hlds_out, int, set.
:- import_module passes_aux, typecheck, module_qual, clause_to_proc.
:- import_module modecheck_unify, modecheck_call, inst_util.
:- import_module list, map, varset, term, prog_out, string, require, std_util.
:- import_module assoc_list, bool.

%-----------------------------------------------------------------------------%
%				Public Predicates


puritycheck(HLDS0, HLDS) -->
	globals__io_lookup_bool_option(statistics, Statistics),
	globals__io_lookup_bool_option(verbose, Verbose),
	io__stderr_stream(StdErr),
	io__set_output_stream(StdErr, OldStream),

	maybe_write_string(Verbose, "% Mode-checking clauses...\n"),
	check_preds_purity(HLDS0, HLDS),
	maybe_report_stats(Statistics),

	io__set_output_stream(OldStream, _).


%  worst_purity/3 could be written more compactly, but this definition
%  guarantees us a determinism error if we add to type `purity'.  We also
%  define less_pure/2 in terms of worst_purity/3 rather than the other way
%  around for the same reason.

worst_purity(pure, pure, pure).
worst_purity(pure, (semipure), (semipure)).
worst_purity(pure, (impure), (impure)).
worst_purity((semipure), pure, (semipure)).
worst_purity((semipure), (semipure), (semipure)).
worst_purity((semipure), (impure), (impure)).
worst_purity((impure), pure, (impure)).
worst_purity((impure), (semipure), (impure)).
worst_purity((impure), (impure), (impure)).


less_pure(P1, P2) :-
	\+ worst_purity(P1, P2, P2).


add_goal_info_purity_feature(GoalInfo0, pure, GoalInfo) :-
	goal_info_remove_feature(GoalInfo0, (semipure), GoalInfo1),
	goal_info_remove_feature(GoalInfo1, (impure), GoalInfo).
add_goal_info_purity_feature(GoalInfo0, (semipure), GoalInfo) :-
	goal_info_add_feature(GoalInfo0, (semipure), GoalInfo).
add_goal_info_purity_feature(GoalInfo0, (impure), GoalInfo) :-
	goal_info_add_feature(GoalInfo0, (impure), GoalInfo).


infer_goal_info_purity(GoalInfo, Purity) :-
	(
	    goal_info_has_feature(GoalInfo, (impure)) ->
		Purity = (impure)
	;
	    goal_info_has_feature(GoalInfo, (semipure)) ->
		Purity = (semipure)
	;
		Purity = pure
	).


goal_info_is_pure(GoalInfo) :-
	\+ goal_info_has_feature(GoalInfo, (impure)),
	\+ goal_info_has_feature(GoalInfo, (semipure)).
	

goal_info_is_impure(GoalInfo) :-
	goal_info_has_feature(GoalInfo, (impure)).
	

write_purity(Purity) -->
	{ purity_name(Purity, String) },
	io__write_string(String).

purity_name(pure, "pure").
purity_name((semipure), "semipure").
purity_name((impure), "impure").



%-----------------------------------------------------------------------------%
%	 Purity-check the code for all the predicates in a module

:- pred check_preds_purity(module_info, module_info, io__state, io__state).
:- mode check_preds_purity(in, out, di, uo) is det.

check_preds_purity(ModuleInfo0, ModuleInfo) -->
	{ module_info_predids(ModuleInfo0, PredIds) },
	check_preds_purity_2(PredIds, ModuleInfo0, ModuleInfo1, 0, NumErrors),
	{ module_info_num_errors(ModuleInfo1, Errs0) },
	{ Errs is Errs0 + NumErrors },
	{ module_info_set_num_errors(ModuleInfo1, Errs, ModuleInfo) }.


:- pred check_preds_purity_2(list(pred_id), module_info, module_info,
			int, int, io__state, io__state).
:- mode check_preds_purity_2(in, in, out, in, out, di, uo) is det.

check_preds_purity_2([], ModuleInfo, ModuleInfo,
		NumErrors, NumErrors) --> [].
check_preds_purity_2([PredId | PredIds], ModuleInfo0, ModuleInfo,
		NumErrors0, NumErrors) -->
	{ module_info_preds(ModuleInfo0, Preds0) },
	{ map__lookup(Preds0, PredId, PredInfo0) },
	(   { pred_info_is_imported(PredInfo0)
	    ; pred_info_is_pseudo_imported(PredInfo0)} ->
		{ ModuleInfo1 = ModuleInfo0 },
		{ NumErrors1 = NumErrors0 }
	;
		write_pred_progress_message("% Purity-checking ", PredId,
					    ModuleInfo0),
		puritycheck_pred(PredId, PredInfo0, PredInfo1, ModuleInfo0,
				 ErrsInThisPred),
		{ map__det_update(Preds0, PredId, PredInfo1, Preds) },
		{ module_info_get_predicate_table(ModuleInfo0, PredTable0) },
		{ predicate_table_set_preds(PredTable0, Preds, PredTable) },
		{ module_info_set_predicate_table(ModuleInfo0, PredTable,
						  ModuleInfo1) },
		{ NumErrors1 is NumErrors0 + ErrsInThisPred }
	),
	check_preds_purity_2(PredIds, ModuleInfo1, ModuleInfo,
				  NumErrors1, NumErrors).

	% Purity-check the code for single predicate, reporting any errors.


%-----------------------------------------------------------------------------%
%			Check purity of a single predicate
%
%  Purity checking is quite simple.  Since impurity /must/ be declared, we can
%  perform a single pass checking that the actual purity of each predicate
%  matches the declared (or implied) purity.  A predicate is just as pure as
%  its least pure goal.  While we're doing this, we attach a `feature' to each
%  goal that is not pure, including non-atomic goals, indicating its purity.
%  This information must be maintained by later compilation passes, at least
%  until after the last pass that may perform transformations that would not
%  be correct for impure code.  As we check purity and attach impurity
%  features, we also check that impure (semipure) atomic goals were marked in
%  the source code as impure (semipure).  At this stage in the computation,
%  this is indicated by already having the appropriate goal feature.  (During
%  the translation from term to goal, calls have their purity attached to
%  them, and in the translation from goal to hlds_goal, the attached purity is
%  turned into the appropriate feature in the hlds_goal_info.

:- pred puritycheck_pred(pred_id, pred_info, pred_info, module_info, int,
		io__state, io__state).
:- mode puritycheck_pred(in, in, out, in, out, di, uo) is det.

puritycheck_pred(PredId, PredInfo0, PredInfo, ModuleInfo, NumErrors) -->
	{ pred_info_get_purity(PredInfo0, DeclPurity)} ,
	{ pred_info_get_promised_pure(PredInfo0, Promised) },
	(   { pred_info_get_goal_type(PredInfo0, pragmas) } ->
		{ WorstPurity = (impure) },
		{ Purity = pure },
		{ PredInfo = PredInfo0 },
		{ NumErrors0 = 0 }
	;   
		{ pred_info_clauses_info(PredInfo0, ClausesInfo0) },
		{ ClausesInfo0 = clauses_info(A, B, C, D, Clauses0) },
		{ ClausesInfo = clauses_info(A, B, C, D, Clauses) },
		{ pred_info_set_clauses_info(PredInfo0, ClausesInfo,
					     PredInfo) },
		compute_purity(Clauses0, Clauses, PredInfo0, ModuleInfo,
			       pure, Purity, 0, NumErrors0),
		{ WorstPurity = Purity }
	),
	(
	    { DeclPurity \= pure, Promised = yes } ->
		{ NumErrors is NumErrors0 + 1 },
		error_inconsistent_promise(ModuleInfo, PredInfo, PredId,
					  DeclPurity)
	;   { less_pure(DeclPurity, WorstPurity) } ->
		{ NumErrors = NumErrors0 },
		warn_exaggerated_impurity_decl(ModuleInfo, PredInfo, PredId,
					     DeclPurity, WorstPurity)
	;   { less_pure(Purity, DeclPurity), Promised = no } ->
		{ NumErrors is NumErrors0 + 1 },
		error_inferred_impure(ModuleInfo, PredInfo, PredId, Purity)
	;   { Purity = pure, Promised = yes } ->
		{ NumErrors = NumErrors0 },
		warn_unnecessary_promise_pure(ModuleInfo, PredInfo, PredId)
	;
		{ NumErrors = NumErrors0 }
	).


% Infer the purity of a single (non-pragma c_code) predicate

:- pred compute_purity(list(clause), list(clause), pred_info, module_info,
	purity, purity, int, int, io__state, io__state).
:- mode compute_purity(in, out, in, in, in, out, in, out, di, uo) is det.

compute_purity([], [], _, _, Purity, Purity, NumErrors, NumErrors) -->
	[].
compute_purity([Clause0|Clauses0], [Clause|Clauses], PredInfo, ModuleInfo,
		Purity0, Purity, NumErrors0, NumErrors) -->
	{ Clause0 = clause(Ids, Body0-Info0, Context) },
	compute_expr_purity(Body0, Body, Info0, PredInfo, ModuleInfo,
			    no, Bodypurity, NumErrors0, NumErrors1),
	{ add_goal_info_purity_feature(Info0, Bodypurity, Info) },
	{ worst_purity(Purity0, Bodypurity, Purity1) },
	{ Clause = clause(Ids, Body-Info, Context) },
	compute_purity(Clauses0, Clauses, PredInfo, ModuleInfo,
		       Purity1, Purity, NumErrors1, NumErrors).

:- pred compute_expr_purity(hlds_goal_expr, hlds_goal_expr, hlds_goal_info,
	pred_info, module_info, bool, purity, int, int, io__state, io__state).
:- mode compute_expr_purity(in, out, in, in, in, in, out, in, out, di, uo)
	is det.

compute_expr_purity(conj(Goals0), conj(Goals), GoalInfo, PredInfo, ModuleInfo,
		InClosure, Purity, NumErrors0, NumErrors) -->
	warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure),
	compute_goals_purity(Goals0, Goals, PredInfo, ModuleInfo,
			     InClosure, pure, Purity, NumErrors0, NumErrors).
compute_expr_purity(call(PredId0,ProcId,Vars,BIState,UContext,Name0),
		call(PredId,ProcId,Vars,BIState,UContext,Name), GoalInfo,
		PredInfo, ModuleInfo, InClosure, ActualPurity,
		NumErrors0, NumErrors) -->
	{ resolve_pred_overloading(PredId0, Vars, PredInfo, ModuleInfo,
				   Name0, Name, PredId) },
	{ module_info_preds(ModuleInfo, Preds) },
	{ map__lookup(Preds, PredId, CalleePredInfo) },
	{ pred_info_get_purity(CalleePredInfo, ActualPurity) },
	{ 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) } ->
		error_missing_body_impurity_decl(ModuleInfo, CalleePredInfo,
						 PredId, CallContext,
						 ActualPurity),
		{ NumErrors is NumErrors0 + 1 }
	;
		warn_unnecessary_body_impurity_decl(ModuleInfo, CalleePredInfo,
						    PredId, CallContext,
						    ActualPurity,
						    DeclaredPurity),
		{ NumErrors = NumErrors0 }
	).
compute_expr_purity(HOCall, HOCall, GoalInfo, _, _, InClosure, pure,
		NumErrors0, NumErrors) -->
	{ HOCall = higher_order_call(_,_,_,_,_,_) },
	error_if_body_purity_indicated(GoalInfo, NumErrors0, NumErrors,
				       InClosure, "higher order goal").
compute_expr_purity(switch(Var,Canfail,Cases0,Storemap),
		switch(Var,Canfail,Cases,Storemap), GoalInfo, PredInfo,
		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
	warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure),
	compute_cases_purity(Cases0, Cases, PredInfo, ModuleInfo,
			     InClosure, pure, Purity, NumErrors0, NumErrors).
compute_expr_purity(Unif0, Unif, GoalInfo, PredInfo, ModuleInfo, InClosure,
		pure, NumErrors0, NumErrors) -->
	{ Unif0 = unify(A,RHS0,C,D,E) },
	{ Unif  = unify(A,RHS,C,D,E) },
	error_if_body_purity_indicated(GoalInfo, NumErrors0, NumErrors1,
				       InClosure, "unification"),
	(   { RHS0 = lambda_goal(F, G, H, I, Goal0-Info0) } ->
		{ RHS = lambda_goal(F, G, H, I, Goal-Info0) },
		compute_expr_purity(Goal0, Goal, Info0, PredInfo, ModuleInfo,
				    yes, Purity, NumErrors1, NumErrors2),
		error_if_closure_impure(GoalInfo, Purity,
					NumErrors2, NumErrors)
	;
		{ RHS = RHS0 },
		{ NumErrors = NumErrors0 }
	).
compute_expr_purity(disj(Goals0,Store), disj(Goals,Store), GoalInfo, PredInfo,
		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
	warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure),
	compute_goals_purity(Goals0, Goals, PredInfo, ModuleInfo,
			     InClosure, pure, Purity, NumErrors0, NumErrors).
compute_expr_purity(not(Goal0), not(Goal), GoalInfo, PredInfo, ModuleInfo,
		InClosure, Purity, NumErrors0, NumErrors) -->
	warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure),
	compute_goal_purity(Goal0, Goal, PredInfo, ModuleInfo, 
			    InClosure, Purity, NumErrors0, NumErrors).
compute_expr_purity(some(Vars,Goal0), some(Vars,Goal), GoalInfo, PredInfo,
		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
	warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure),
	compute_goal_purity(Goal0, Goal, PredInfo, ModuleInfo, 
			    InClosure, Purity, NumErrors0, NumErrors).
compute_expr_purity(if_then_else(Vars,Goali0,Goalt0,Goale0,Store),
		if_then_else(Vars,Goali,Goalt,Goale,Store), GoalInfo, PredInfo,
		ModuleInfo, InClosure, Purity, NumErrors0, NumErrors) -->
	warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure),
	compute_goal_purity(Goali0, Goali, PredInfo, ModuleInfo,
			    InClosure, Purity1, NumErrors0, NumErrors1),
	compute_goal_purity(Goalt0, Goalt, PredInfo, ModuleInfo,
			    InClosure, Purity2, NumErrors1, NumErrors2),
	compute_goal_purity(Goale0, Goale, PredInfo, ModuleInfo,
			    InClosure, Purity3, NumErrors2, NumErrors),
	{ worst_purity(Purity1, Purity2, Purity12) },
	{ worst_purity(Purity12, Purity3, Purity) }.
compute_expr_purity(Ccode, Ccode, _, _, _, _, pure, NumErrors, NumErrors) -->
	{ Ccode = pragma_c_code(_,_,_,_,_,_,_,_) }.


:- pred compute_goal_purity(hlds_goal, hlds_goal, pred_info,
	module_info, bool, purity, int, int, io__state, io__state).
:- mode compute_goal_purity(in, out, in, in, in, out, in, out, di, uo) is det.

compute_goal_purity(Goal0-GoalInfo0, Goal-GoalInfo, PredInfo, ModuleInfo,
		InClosure, Purity, NumErrors0, NumErrors) -->
	compute_expr_purity(Goal0, Goal, GoalInfo0, PredInfo, ModuleInfo,
			    InClosure, Purity, NumErrors0, NumErrors),
	{ add_goal_info_purity_feature(GoalInfo0, Purity, GoalInfo) }.


%  Compute the purity of a list of hlds_goals.  Since the purity of a
%  disjunction is computed the same way as the purity of a conjunction, we use
%  the same code for both

:- pred compute_goals_purity(list(hlds_goal), list(hlds_goal), pred_info,
	module_info, bool, purity, purity, int, int, io__state, io__state).
:- mode compute_goals_purity(in, out, in, in, in, in, out, in, out, di, uo)
	is det.

compute_goals_purity([], [], _, _, _, Purity, Purity, NumErrors, NumErrors) -->
	[].
compute_goals_purity([Goal0|Goals0], [Goal|Goals], PredInfo, ModuleInfo,
		InClosure, Purity0, Purity, NumErrors0, NumErrors) -->
	compute_goal_purity(Goal0, Goal, PredInfo, ModuleInfo, 
			    InClosure, Purity1, NumErrors0, NumErrors1),
	{ worst_purity(Purity0, Purity1, Purity2) },
	compute_goals_purity(Goals0, Goals, PredInfo, ModuleInfo, InClosure,
			     Purity2, Purity, NumErrors1, NumErrors).



:- pred compute_cases_purity(list(case), list(case), pred_info, module_info,
	bool, purity, purity, int, int, io__state, io__state).
:- mode compute_cases_purity(in, out, in, in, in, in, out, in, out, di, uo)
	is det.

compute_cases_purity([], [], _, _, _, Purity, Purity, NumErrors, NumErrors) -->
	[].
compute_cases_purity([case(Ctor,Goal0)|Goals0], [case(Ctor,Goal)|Goals],
		PredInfo, ModuleInfo, InClosure, Purity0, Purity,
		NumErrors0, NumErrors) -->
	compute_goal_purity(Goal0, Goal, PredInfo, ModuleInfo, 
			    InClosure, Purity1, NumErrors0, NumErrors1),
	{ worst_purity(Purity0, Purity1, Purity2) },
	compute_cases_purity(Goals0, Goals, PredInfo, ModuleInfo, InClosure,
			     Purity2, Purity, NumErrors1, NumErrors).



%-----------------------------------------------------------------------------%
%				Print error messages


:- pred error_inconsistent_promise(module_info, pred_info, pred_id, purity,
				  io__state, io__state).
:- mode error_inconsistent_promise(in, in, in, in, di, uo) is det.

error_inconsistent_promise(ModuleInfo, PredInfo, PredId, Purity) -->
	{ pred_info_context(PredInfo, Context) },
	write_context_and_pred_id(ModuleInfo, PredInfo, PredId),
	prog_out__write_context(Context),
	report_warning("  warning: declared "),
	write_purity(Purity),
	io__write_string(" but promised pure.\n"),
	globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
	( { VerboseErrors = yes } ->
		{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
		prog_out__write_context(Context),
		io__write_string("  A pure "),
		hlds_out__write_pred_or_func(PredOrFunc),
		io__write_string(" that invokes non-pure code should be\n"),
		prog_out__write_context(Context),
		io__write_string(
		    "  promised pure and should have no impurity declaration.\n"
		)
	;
		[]
	).


:- pred warn_exaggerated_impurity_decl(module_info, pred_info, pred_id,
				       purity, purity, io__state, io__state).
:- mode warn_exaggerated_impurity_decl(in, in, in, in, in, di, uo) is det.

warn_exaggerated_impurity_decl(ModuleInfo, PredInfo, PredId,
		DeclPurity, AcutalPurity) -->
	{ 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).
:- mode warn_unnecessary_promise_pure(in, in, in, di, uo) is det.

warn_unnecessary_promise_pure(ModuleInfo, PredInfo, PredId) -->
	{ pred_info_context(PredInfo, Context) },
	write_context_and_pred_id(ModuleInfo, PredInfo, PredId),
	prog_out__write_context(Context),
	report_warning("  warning: unnecessary `promise_pure' pragma.\n"),
	globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
	( { VerboseErrors = yes } ->
		prog_out__write_context(Context),
		{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
		io__write_string("  This "),
		hlds_out__write_pred_or_func(PredOrFunc),
		io__write_string(
		    " does not invoke any non-pure code,\n"
		),
		prog_out__write_context(Context),
		io__write_string(
		    "  so there is no need for a `promise_pure' pragma.\n"
		)
	;
		[]
	).


:- pred error_inferred_impure(module_info, pred_info, pred_id, purity,
	io__state, io__state).
:- mode error_inferred_impure(in, in, in, in, di, uo) is det.

error_inferred_impure(ModuleInfo, PredInfo, PredId, Purity) -->
	{ pred_info_context(PredInfo, Context) },
	{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
	write_context_and_pred_id(ModuleInfo, PredInfo, PredId),
	prog_out__write_context(Context),
	io__write_string("  error: "),
	hlds_out__write_pred_or_func(PredOrFunc),
	io__write_string(" is "),
	write_purity(Purity),
	io__write_string(".\n"),
	prog_out__write_context(Context),
	(   { code_util__compiler_generated(PredInfo) } ->
		io__write_string("  It must be pure.\n")
	;
		io__write_string("  It must be declared `"),
		write_purity(Purity),
		io__write_string("' or promised pure.\n")
	).


:- pred error_missing_body_impurity_decl(module_info, pred_info, pred_id,
				  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,
		Purity) -->
	prog_out__write_context(Context),
	io__write_string("In call to "),
	write_purity(Purity),
	io__write_string(" "),
	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 warn_unnecessary_body_impurity_decl(module_info, pred_info, pred_id,
	context, purity, purity, io__state, io__state).
:- mode warn_unnecessary_body_impurity_decl(in, in, in, in, in, in, di, uo)
	is det.

warn_unnecessary_body_impurity_decl(ModuleInfo, _, PredId, Context,
		ActualPurity, DeclaredPurity) -->
	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")
	).
	

:- pred warn_if_body_purity_indicated(hlds_goal_info, pred_info, bool,
	io__state, io__state).
:- mode warn_if_body_purity_indicated(in, in, in, di, uo) is det.

warn_if_body_purity_indicated(GoalInfo, PredInfo, InClosure) -->
	(   { InClosure = yes } ->
		[]
	;   { code_util__compiler_generated(PredInfo) } ->
		[]
	;   { infer_goal_info_purity(GoalInfo, Purity) },
	    (   { Purity = pure } ->
		    []
	    ;	
		    { goal_info_get_context(GoalInfo, Context) },
		    prog_out__write_context(Context),
		    io__write_string("Warning: inappropriate placement of `"),
		    write_purity(Purity),
		    io__write_string("' indicator.\n"),
		    globals__io_lookup_bool_option(verbose_errors,
						   VerboseErrors),
		    (   { VerboseErrors = yes } ->
			    prog_out__write_context(Context),
			    io__write_string(
	    "  Impurity indicators only belong before predicate calls.\n")
		    ;   
			    []
		    )
	    )
	).



:- pred error_if_body_purity_indicated(hlds_goal_info, int, int, bool,
	string, io__state, io__state).
:- mode error_if_body_purity_indicated(in, in, out, in, in, di, uo) is det.

error_if_body_purity_indicated(GoalInfo, NumErrors0, NumErrors, InClosure,
		Kind) -->
	{ infer_goal_info_purity(GoalInfo, Purity) },
	(   { Purity = pure } ->
		{ NumErrors = NumErrors0 }
	;   { InClosure = yes } ->
		% Don't report purity errors inside a closure
		{ NumErrors = NumErrors0 }
	;
		{ NumErrors is NumErrors0 + 1 },
		{ goal_info_get_context(GoalInfo, Context) },
		prog_out__write_context(Context),
		io__write_string("Error: inappropriate placement of `"),
		write_purity(Purity),
		io__write_string("' indicator.\n"),
		prog_out__write_context(Context),
		io__write_string("  A "),
		io__write_string(Kind),
		io__write_string(" can never be "),
		write_purity(Purity),
		io__write_string(".\n"),
		globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
		(   { VerboseErrors = yes } ->
			prog_out__write_context(Context),
			io__write_string("  Impurity indicators only belong before predicate calls.\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.

error_if_closure_impure(GoalInfo, Purity, NumErrors0, NumErrors) -->
	(   { Purity = pure } ->
		{ NumErrors = NumErrors0 }
	;
		{ NumErrors is NumErrors0 + 1 },
		{ goal_info_get_context(GoalInfo, Context) },
		prog_out__write_context(Context),
		io__write_string("Error in closure: closure is "),
		write_purity(Purity),
		io__write_string(".\n"),
		globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
		(   { VerboseErrors = yes } ->
			prog_out__write_context(Context),
			io__write_string("  All closures must be pure.\n")
		;   
			[]
		)
	).


:- pred write_context_and_pred_id(module_info, pred_info, pred_id,
				  io__state, io__state).
:- mode write_context_and_pred_id(in, in, in, di, uo) is det.

write_context_and_pred_id(ModuleInfo, PredInfo, PredId) -->
	{ pred_info_context(PredInfo, Context) },
	prog_out__write_context(Context),
	io__write_string("In "),
	hlds_out__write_pred_id(ModuleInfo, PredId),
	io__write_string(":\n").
	



%-----------------------------------------------------------------------------%
%			resolve predicate overloading

:- pred resolve_pred_overloading(pred_id, list(var), pred_info, module_info,
	sym_name, sym_name, pred_id).
:- mode resolve_pred_overloading(in, in, in, in, in, out, out)
	is det.

% In the case of a call to an overloaded predicate, typecheck.m
% does not figure out the correct pred_id.  We must do that here.

resolve_pred_overloading(PredId0, Args0, CallerPredInfo, ModuleInfo,
		PredName0, PredName, PredId) :-
        (   invalid_pred_id(PredId0) ->
		%
		% Find the set of candidate pred_ids for predicates which
		% have the specified name and arity
		% 
		pred_info_typevarset(CallerPredInfo, TVarSet),
		pred_info_clauses_info(CallerPredInfo, ClausesInfo),
		ClausesInfo = clauses_info(_, _, VarTypes, _, _),
		typecheck__resolve_pred_overloading(ModuleInfo, Args0,
			VarTypes, TVarSet, PredName0, PredName, PredId)
        ;
                PredId = PredId0,
                PredName = PredName0
        ).


New File: tests/hard_coded/purity.exp
===================================================================
0
1
3
4

New File: tests/hard_coded/purity.m
===================================================================
% 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 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 set_x(int::in) is det.
:- pragma c_code(set_x(X::in), will_not_call_mercury, "x=X;" ).

:- impure pred incr_x is det.
:- pragma c_code(incr_x, will_not_call_mercury, "++x;" ).

:- semipure pred get_x(int::out) is det.
:- pragma c_code(get_x(X::out), will_not_call_mercury, "X=x;").


:- 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)])
	).


New File: tests/invalid/purity.err_exp
===================================================================
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:040:   This predicate does not invoke any non-pure code,
purity.m:040:   so there is no need for a `promise_pure' pragma.
purity.m:045: In predicate `purity:w5/0':
purity.m:045:   warning: declared impure but promised pure.
purity.m:045:   A pure predicate that invokes non-pure code should be
purity.m:045:   promised pure and should have no impurity declaration.
purity.m:050: In predicate `purity:w6/0':
purity.m:050:   warning: declared semipure but promised pure.
purity.m:050:   A pure predicate that invokes non-pure code should be
purity.m:050:   promised pure and should have no impurity declaration.
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:112:   All closures must be pure.
purity.m:118: Error in closure: closure is semipure.
purity.m:118:   All closures must be pure.
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.

New File: tests/invalid/purity.m
===================================================================
:- 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).

New File: tests/invalid/purity_nonsense.err_exp
===================================================================
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 preceding `pred' or `func' declaration
purity_nonsense.m:008: Error: no clauses for predicate `purity_nonsense:undefined/0'
For more information, try recompiling with `-E'.

New File: tests/invalid/purity_nonsense.m
===================================================================
:- 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).


================ end part 2/2 ================



More information about the developers mailing list