[m-dev.] for review: impure functions
Tyson Dowd
trd at cs.mu.OZ.AU
Wed Apr 12 15:24:24 AEST 2000
On 06-Apr-2000, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> On 04-Apr-2000, Tyson Dowd <trd at cs.mu.OZ.AU> wrote:
> > 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)
>
> It would be much nicer if that syntax could be
>
> X = impure some_impure_func(Y, Z)
I like the idea that only goals can be impure, and impurity
declarations come before the goal. (of course, not *all* sorts of
goals can be impure).
That way there is only one thing to look for and one place to look
for it. It jumps out at you because it's always on the left-hand-side
of the goal.
With any other feature I would agree that your placement of the
annotation is a nicer place. But this one has some other goals
that conflict with the "correct" placement.
I'm open to further discussion. It's possible this could be an
alternate syntax in future.
> > +++ 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.
>
> That change is wrong; this restriction applies to *all* procedures, not just
> pure ones.
Sorry, I intended to write more than that. I wanted to add that impure
procedures may destructively update things pointed to by C pointer
arguments, even without unique modes. But they cannot destructively
update their arguments.
(The distinction being that pure predicates can't do *either* without
using unique modes).
I think the way it was worded previously left this issue (can impure
preds to any destructive update) open to intepretation.
> > -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).
>
> This is correct, but it applies to semipure procedures too.
> I suggest you change that to
>
> They 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), or if they
> are declared impure (@pxref{Impurity}).
Done. Except s/They/Procedures/
> > 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.
>
> Saying that it "cannot update its arguments directly"
> is not correct; it _can_ update its arguments directly,
> if they have mode `di'.
Fixed.
>
> > @@ -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.
>
> Shouldn't calls to impure functions be flagged too?
Yes, done.
>
> > @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.
>
> That change misses the point. The sentence "The behaviour of pure predicates
> is never affected by the invocation of pure predicates" is not correct.
> For pure procedures with determinism `cc_nondet' or `cc_multi',
> the invocation of other pure predicates can affect which solution
> you get.
Hmmm...
I view the committed choice determinisms as a statement about the
semantics of the order of results.
In the strict sequential semantics the statement "The behaviour of pure
predicates is never affected by the invocation of pure predicates"
should be true (without qualification).
In other semantics, it is permissible for the results of these
operations to be non-deterministic. The fact that operationally
some pure predicates might affect the operation of cc_* predicates is
irrelevant -- declaratively these predicates are non-deterministic,
anything at all can affect them. So the declarative "behaviour" of pure
predicates is unaffected by the invocation of pure predicates.
(this makes me think that perhaps benchmarking requires an I/O state
after all, since in strict sequential semantics an I/O state is the only
way you can account for different timing results brought about by the
external environment).
Am I completely off target here? Are we really disputing the word
"behaviour"? (I'd prefer to use something else).
> For pure procedures with determinism `nondet' or `multi',
> the invocation of other pure predicates can affect the order in
> which the solutions are returned. And for all pure procedures,
> the invocation of other pure procedures can affect whether you
> get a solution at all, or whether you get non-termination,
> an exception, or a run-time abort.
Is this relevant to predicates?
Pure predicates can affect the behaviour of the *program* through
non-termination, exceptions or run-time aborts. However they don't
affect the behaviour of other predicates.
Not calling a predicate has nothing to do with its behaviour if it were
called.
I think the word "behaviour" is the problem.
>
> I'm not sure if there is any way of salvaging that text;
> perhaps it would be best to just delete it.
>
> Also the sentence at the start of the paragraph
>
> Pure predicates and functions always return the same outputs given
> the same inputs.
>
> is not correct for procedures with determinism `cc_nondet' or `cc_multi'.
>
> I suggest changing that sentence to
>
> For pure procedures, the set of solutions depends only on the
> values of the input arguments.
That's a good idea.
"Set of solutions" might be a good starting point for replacing
"behaviour" above.
> > @@ -5449,22 +5474,46 @@
> > or
> >
> > @example
> > -:- semipure pred @var{Pred}(@var{Arguments}@dots{}).
> > +:- semipure func @var{Pred}(@var{Arguments}@dots{}) = (Result).
> > @end example
>
> I think that should be @var{Func} not @var{Pred}.
Done.
>
> Why the parentheses around `Result'?
Fixed.
>
> > @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.
>
> Since the text says "That is, a declaration of the form ...", you should
> either give all four possible such forms (pure pred, pure func, semipure
> pred, semipure func), rather than just giving two of them,
> or change "This is" to "For example". Of these two alternatives,
> I think the former is the better one.
I've given all four forms.
(PS You spend way too much time on standards committees).
>
> > +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.
>
> In the section earlier, you say that you describe purity ordering
> as "worse"/"better", but here and elsewhere you just talk about it as
> "more pure" or "less pure". I think you should delete the description
>
of "worst impurity" order?
It is only used in two spots, I have replaced it with the "lowest bound
of the purity of ...."
> > +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.
>
> s/,/;/
>
> Or alternatively s/,.*/./
>
> > +++ 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.
>
> The extra error message here is just confusing; it does not help the
> programmer at all, IMHO. I agree with DJ: it would be better to not
> report errors during purity analysis in such cases.
Ok, this is removed.
>
> > +++ 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.
>
> It might be nicer if the error message specified which of these
> two conditions was not satisfied.
The impure indicator is *always* the problem.
It is possible that in addition to having an impure indicator, the impure
call occurs somewhere where it is not in an explicit unification.
It *would* be nice to give this as a separate error message.
Unfortunately flattening makes this a little difficult.
I can wish-list this, but currently I don't know an easy way to tell the
difference between user-written unifications and introduced ones after
unravel_unifications is called.
>
> > +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.
>
> I suggest s/error:/purity error:/g
>
> > +purity.m:112: Error in closure: closure is impure.
> > +purity.m:118: Error in closure: closure is semipure.
>
> I suggest s/Error:/Purity error:/g
>
That's a good idea, done.
There are still some bugs I've found in further testing, however.
make_hlds now checks for impure indicators on unifications with
expressions other than function calls (before we unravel_unification
them), and correctly handles impure functions with arguments.
One outstanding open issue is that we don't specify what happens
when you put an impure call such as
impure some_pred(foo(42), bar(17))
Where do the extra unifications get scheduled?
I have some ideas on this but I won't address the issue just yet.
Here's a relative diff or the compiler and doc directories, and a new
full diff of the tests:
--- make_hlds.m 2000/04/05 08:23:42 1.1
+++ make_hlds.m 2000/04/11 04:54:43
@@ -3501,11 +3565,12 @@
->
pred_add_pragma_import(PredInfo2, PredId, ProcId,
Attributes, C_Function, Context,
- ModuleInfo1, PredInfo, Info0, Info),
+ PredInfo, ModuleInfo1, ModuleInfo2,
+ Info0, Info),
{ map__det_update(Preds0, PredId, PredInfo, Preds) },
{ predicate_table_set_preds(PredicateTable2, Preds,
PredicateTable) },
- { module_info_set_predicate_table(ModuleInfo1,
+ { module_info_set_predicate_table(ModuleInfo2,
PredicateTable, ModuleInfo) }
;
{ module_info_incr_errors(ModuleInfo1, ModuleInfo) },
@@ -3528,12 +3593,13 @@
% the c_code for a `pragma import' declaration to a pred_info.
:- pred pred_add_pragma_import(pred_info, pred_id, proc_id,
- pragma_c_code_attributes, string, prog_context, module_info,
- pred_info, qual_info, qual_info, io__state, io__state).
-:- mode pred_add_pragma_import(in, in, in, in, in, in, in, out, in, out,
+ pragma_c_code_attributes, string, prog_context, pred_info,
+ module_info, module_info, qual_info, qual_info,
+ io__state, io__state).
+:- mode pred_add_pragma_import(in, in, in, in, in, in, out, in, out, in, out,
di, uo) is det.
pred_add_pragma_import(PredInfo0, PredId, ProcId, Attributes, C_Function,
- Context, ModuleInfo, PredInfo, Info0, Info) -->
+ Context, PredInfo, ModuleInfo0, ModuleInfo, Info0, Info) -->
%
% lookup some information we need from the pred_info and proc_info
%
@@ -3568,10 +3634,10 @@
% assigns the return value (if any) to the appropriate place.
%
{ handle_return_value(CodeModel, PredOrFunc, PragmaVarsAndTypes,
- ModuleInfo, ArgPragmaVarsAndTypes, C_Code0) },
+ ModuleInfo0, ArgPragmaVarsAndTypes, C_Code0) },
{ string__append_list([C_Code0, C_Function, "("], C_Code1) },
{ assoc_list__keys(ArgPragmaVarsAndTypes, ArgPragmaVars) },
- { create_pragma_import_c_code(ArgPragmaVars, ModuleInfo,
+ { create_pragma_import_c_code(ArgPragmaVars, ModuleInfo0,
C_Code1, C_Code2) },
{ string__append(C_Code2, ");", C_Code) },
@@ -3582,7 +3648,7 @@
clauses_info_add_pragma_c_code(Clauses0, Purity, Attributes,
PredId, ProcId, VarSet, PragmaVars, ArgTypes, PragmaImpl,
Context, PredOrFunc, qualified(PredModule, PredName),
- Arity, Clauses, Info0, Info),
+ Arity, Clauses, ModuleInfo0, ModuleInfo, Info0, Info),
%
% Store the clauses_info etc. back into the pred_info
@@ -3811,7 +3877,7 @@
Attributes, PredId, ProcId, VarSet,
PVars, ArgTypes, PragmaImpl, Context,
PredOrFunc, PredName, Arity,
- Clauses, Info0, Info),
+ Clauses, ModuleInfo1, ModuleInfo2, Info0, Info),
{ pred_info_set_clauses_info(PredInfo1, Clauses,
PredInfo2) },
{ pred_info_set_goal_type(PredInfo2, pragmas,
@@ -3819,7 +3885,7 @@
{ map__det_update(Preds0, PredId, PredInfo, Preds) },
{ predicate_table_set_preds(PredicateTable1, Preds,
PredicateTable) },
- { module_info_set_predicate_table(ModuleInfo1,
+ { module_info_set_predicate_table(ModuleInfo2,
PredicateTable, ModuleInfo) },
{ pragma_get_var_infos(PVars, ArgInfo) },
maybe_warn_pragma_singletons(PragmaImpl, ArgInfo,
@@ -4768,7 +4834,8 @@
{ varset__merge_subst(VarSet0, CVarSet, VarSet1, Subst) },
transform(Subst, HeadVars, Args, Body, VarSet1, Context, PredOrFunc,
Arity, IsAssertion, Goal0, VarSet, Warnings,
- Module0, Module, Info1, Info2),
+ transform_info(Module0, Info1),
+ transform_info(Module, Info2)),
{ qual_info_get_found_syntax_error(Info2, FoundError) },
{ qual_info_set_found_syntax_error(no, Info2, Info) },
(
@@ -4803,14 +4870,15 @@
:- pred clauses_info_add_pragma_c_code(clauses_info, purity,
pragma_c_code_attributes, pred_id, proc_id, prog_varset,
list(pragma_var), list(type), pragma_c_code_impl, prog_context,
- pred_or_func, sym_name, arity, clauses_info, qual_info,
- qual_info, io__state, io__state) is det.
+ pred_or_func, sym_name, arity, clauses_info, module_info,
+ module_info, qual_info, qual_info, io__state, io__state) is det.
:- mode clauses_info_add_pragma_c_code(in, in, in, in, in, in, in, in, in, in,
- in, in, in, out, in, out, di, uo) is det.
+ in, in, in, out, in, out, in, out, di, uo) is det.
clauses_info_add_pragma_c_code(ClausesInfo0, Purity, Attributes, PredId,
ModeId, PVarSet, PVars, OrigArgTypes, PragmaImpl, Context,
- PredOrFunc, PredName, Arity, ClausesInfo, Info0, Info) -->
+ PredOrFunc, PredName, Arity, ClausesInfo, ModuleInfo0,
+ ModuleInfo, Info0, Info) -->
{
ClausesInfo0 = clauses_info(VarSet0, VarTypes, VarTypes1,
HeadVars, ClauseList, TI_VarMap, TCI_VarMap),
@@ -4833,6 +4901,7 @@
( { MultipleArgs = [_ | _] } ->
{ ClausesInfo = ClausesInfo0 },
+ { ModuleInfo = ModuleInfo0 },
{ Info = Info0 },
prog_out__write_context(Context),
io__write_string("In `:- pragma c_code' declaration for "),
@@ -4879,7 +4948,8 @@
% implemented as substitutions, and they will be.
insert_arg_unifications(HeadVars, TermArgs, Context,
head(PredOrFunc, Arity), yes, HldsGoal0, VarSet1,
- HldsGoal1, VarSet2, Info0, Info),
+ HldsGoal1, VarSet2, transform_info(ModuleInfo0, Info0),
+ transform_info(ModuleInfo, Info)),
{
map__init(Empty),
implicitly_quantify_clause_body(HeadVars, HldsGoal1,
@@ -4904,17 +4974,22 @@
%-----------------------------------------------------------------------------
+:- type transform_info --->
+ transform_info(
+ module_info :: module_info,
+ qual_info :: qual_info
+ ).
+
:- pred transform(prog_substitution, list(prog_var), list(prog_term), goal,
prog_varset, prog_context, pred_or_func, arity, bool,
hlds_goal, prog_varset, list(quant_warning),
- module_info, module_info, qual_info, qual_info,
+ transform_info, transform_info,
io__state, io__state).
:- mode transform(in, in, in, in, in, in, in, in, in, out, out, out,
- in, out, in, out, di, uo) is det.
+ in, out, di, uo) is det.
transform(Subst, HeadVars, Args0, Body, VarSet0, Context, PredOrFunc,
- Arity, IsAssertion, Goal, VarSet, Warnings,
- Module0, Module, Info0, Info) -->
+ Arity, IsAssertion, Goal, VarSet, Warnings, Info0, Info) -->
transform_goal(Body, VarSet0, Subst, Goal1, VarSet1, Info0, Info1),
{ term__apply_substitution_to_list(Args0, Subst, Args) },
{ map__init(Empty) },
@@ -4924,12 +4999,10 @@
(
{ IsAssertion = yes }
->
- { Module = Module0 },
{ VarSet2 = VarSet1 },
{ Goal2 = Goal1 },
{ Info = Info0 }
;
- { Module = Module0 },
{ ArgContext = head(PredOrFunc, Arity) },
insert_arg_unifications(HeadVars, Args, Context, ArgContext,
no, Goal1, VarSet1, Goal2, VarSet2, Info1, Info)
@@ -4948,7 +5021,8 @@
% the goal, to rename it apart from the other clauses.
:- pred transform_goal(goal, prog_varset, prog_substitution, hlds_goal,
- prog_varset, qual_info, qual_info, io__state, io__state).
+ prog_varset, transform_info, transform_info,
+ io__state, io__state).
:- mode transform_goal(in, in, in, out, out, in, out, di, uo) is det.
transform_goal(Goal0 - Context, VarSet0, Subst, Goal1 - GoalInfo1, VarSet,
@@ -4959,7 +5033,7 @@
:- pred transform_goal_2(goal_expr, prog_context, prog_varset,
prog_substitution, hlds_goal, prog_varset,
- qual_info, qual_info, io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode transform_goal_2(in, in, in, in, out, out, in, out, di, uo) is det.
transform_goal_2(fail, _, VarSet, _, disj([], Empty) - GoalInfo, VarSet,
@@ -5051,7 +5125,7 @@
{ Name = unqualified("\\=") },
{ Args0 = [LHS, RHS] }
->
- % `LHS \= RHS' is defined as `not (RHS = RHS)'
+ % `LHS \= RHS' is defined as `not (LHS = RHS)'
transform_goal_2(not(unify(LHS, RHS, Purity) - Context),
Context, VarSet0, Subst, Goal, VarSet, Info0, Info)
;
@@ -5144,17 +5218,15 @@
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, Goal0, VarSet, Info0, Info).
+ VarSet0, Purity, Goal, VarSet, Info0, Info).
+
:- inst dcg_record_syntax_op = bound("=^"; ":=").
:- pred transform_dcg_record_syntax(string, list(prog_term), prog_context,
- prog_varset, hlds_goal, prog_varset, qual_info, qual_info,
- io__state, io__state).
+ prog_varset, hlds_goal, prog_varset, transform_info,
+ transform_info, io__state, io__state).
:- mode transform_dcg_record_syntax(in(dcg_record_syntax_op),
in, in, in, out, out, in, out, di, uo) is det.
@@ -5191,7 +5263,9 @@
{ MaybeFieldNames = error(Msg, ErrorTerm) },
{ invalid_goal("^", ArgTerms0, GoalInfo,
Goal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ { qual_info_set_found_syntax_error(yes,
+ Info0 ^ qual_info, QualInfo) },
+ { Info = Info0 ^ qual_info := QualInfo },
io__set_exit_status(1),
prog_out__write_context(Context),
io__write_string("In DCG field "),
@@ -5213,7 +5287,9 @@
;
{ invalid_goal("^", ArgTerms0, GoalInfo,
Goal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ { qual_info_set_found_syntax_error(yes, Info0 ^ qual_info,
+ QualInfo) },
+ { Info = Info0 ^ qual_info := QualInfo },
io__set_exit_status(1),
prog_out__write_context(Context),
io__write_string(
@@ -5227,7 +5303,7 @@
:- pred transform_dcg_record_syntax_2(field_access_type,
list(ctor_field_name), list(prog_term), prog_context,
prog_varset, hlds_goal, prog_varset,
- qual_info, qual_info, io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode transform_dcg_record_syntax_2(in, in, in, in, in, out, out,
in, out, di, uo) is det.
@@ -5561,7 +5637,7 @@
% Mercury Language Reference Manual.
:- pred transform_aditi_builtin(string, list(prog_term), prog_context,
prog_varset, hlds_goal, prog_varset,
- qual_info, qual_info, io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode transform_aditi_builtin(in(aditi_update_str), in,
in, in, out, out, in, out, di, uo) is det.
@@ -5619,7 +5695,9 @@
;
{ invalid_goal("aditi_insert",
Args0, GoalInfo, Goal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ { qual_info_set_found_syntax_error(yes,
+ Info0 ^ qual_info, QualInfo) },
+ { Info = Info0 ^ qual_info := QualInfo },
io__set_exit_status(1),
prog_out__write_context(Context),
io__write_string(
@@ -5628,7 +5706,9 @@
;
{ invalid_goal("aditi_insert", Args0, GoalInfo,
Goal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ { qual_info_set_found_syntax_error(yes, Info0 ^ qual_info,
+ QualInfo) },
+ { Info = Info0 ^ qual_info := QualInfo },
{ list__length(Args0, Arity) },
aditi_update_arity_error(Context, "aditi_insert", Arity, [3])
).
@@ -5654,7 +5734,7 @@
% Parse an `aditi_delete' or `aditi_modify' goal.
:- pred transform_delete_or_modify(string, list(prog_term), prog_context,
prog_varset, hlds_goal, prog_varset,
- qual_info, qual_info, io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode transform_delete_or_modify(in(aditi_del_or_mod_str), in,
in, in, out, out, in, out, di, uo) is det.
@@ -5668,7 +5748,9 @@
->
{ invalid_goal(DelOrMod, Args0, GoalInfo,
UpdateGoal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ { qual_info_set_found_syntax_error(yes, Info0 ^ qual_info,
+ QualInfo) },
+ { Info = Info0 ^ qual_info := QualInfo },
aditi_update_arity_error(Context, DelOrMod, Arity, [3, 4])
;
@@ -5855,7 +5937,9 @@
;
{ invalid_goal(DelOrMod, Args0, GoalInfo,
UpdateGoal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ { qual_info_set_found_syntax_error(yes, Info0 ^ qual_info,
+ QualInfo) },
+ { Info = Info0 ^ qual_info := QualInfo },
io__set_exit_status(1),
(
{ DelOrMod = "aditi_delete" },
@@ -5888,7 +5972,7 @@
% Parse an `aditi_bulk_insert' or `aditi_bulk_delete' goal.
:- pred transform_bulk_update(string, aditi_bulk_operation, list(prog_term),
term__context, prog_varset, hlds_goal, prog_varset,
- qual_info, qual_info, io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode transform_bulk_update(in, in, in, in, in, out, out,
in, out, di, uo) is det.
@@ -5929,7 +6013,9 @@
;
{ invalid_goal(UpdateStr,
Args0, GoalInfo, Goal, VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ { qual_info_set_found_syntax_error(yes,
+ Info0 ^ qual_info, QualInfo) },
+ { Info = Info0 ^ qual_info := QualInfo },
io__set_exit_status(1),
prog_out__write_context(Context),
io__write_string(
@@ -5940,7 +6026,9 @@
;
{ invalid_goal(UpdateStr, Args0, GoalInfo, Goal,
VarSet0, VarSet) },
- { qual_info_set_found_syntax_error(yes, Info0, Info) },
+ { qual_info_set_found_syntax_error(yes, Info0 ^ qual_info,
+ QualInfo) },
+ { Info = Info0 ^ qual_info := QualInfo },
{ list__length(Args0, Arity) },
aditi_update_arity_error(Context, UpdateStr, Arity, [4])
).
@@ -6015,7 +6103,7 @@
:- pred insert_arg_unifications(list(prog_var), list(prog_term),
prog_context, arg_context, bool, hlds_goal, prog_varset,
- hlds_goal, prog_varset, qual_info, qual_info,
+ hlds_goal, prog_varset, transform_info, transform_info,
io__state, io__state).
:- mode insert_arg_unifications(in, in, in, in, in, in, in, out,
out, in, out, di, uo) is det.
@@ -6039,7 +6127,7 @@
:- pred insert_arg_unifications_2(list(prog_var), list(prog_term),
prog_context, arg_context, bool, int, list(hlds_goal),
prog_varset, list(hlds_goal), prog_varset,
- qual_info, qual_info, io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode insert_arg_unifications_2(in, in, in, in, in, in, in, in,
out, out, in, out, di, uo) is det.
@@ -6071,7 +6159,7 @@
:- pred insert_arg_unifications_with_supplied_contexts(list(prog_var),
list(prog_term), assoc_list(int, arg_context), prog_context,
hlds_goal, prog_varset, hlds_goal, prog_varset,
- qual_info, qual_info, io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode insert_arg_unifications_with_supplied_contexts(in, in, in, in, in, in,
out, out, in, out, di, uo) is det.
@@ -6095,7 +6183,7 @@
:- pred insert_arg_unifications_with_supplied_contexts_2(list(prog_var),
list(prog_term), assoc_list(int, arg_context), prog_context,
list(hlds_goal), prog_varset, list(hlds_goal), prog_varset,
- qual_info, qual_info, io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode insert_arg_unifications_with_supplied_contexts_2(in, in, in, in, in,
in, out, out, in, out, di, uo) is det.
@@ -6126,7 +6214,8 @@
:- pred insert_arg_unification(prog_var, prog_term,
prog_context, arg_context, bool, int,
list(hlds_goal), prog_varset, list(hlds_goal), prog_varset,
- list(hlds_goal), qual_info, qual_info, io__state, io__state).
+ list(hlds_goal), transform_info, transform_info,
+ io__state, io__state).
:- mode insert_arg_unification(in, in, in, in, in, in,
in, in, out, out, out, in, out, di, uo) is det.
@@ -6162,7 +6251,7 @@
UnifyMainContext, UnifySubContext) },
unravel_unification(term__variable(Var), Arg,
Context, UnifyMainContext, UnifySubContext,
- VarSet0, Goal, VarSet1, Info0, Info),
+ VarSet0, pure, Goal, VarSet1, Info0, Info),
{ goal_to_conj_list(Goal, ArgUnifyConj) },
{ List1 = List0 }
).
@@ -6173,7 +6262,8 @@
:- pred append_arg_unifications(list(prog_var), list(prog_term),
prog_context, arg_context, hlds_goal, prog_varset, hlds_goal,
- prog_varset, qual_info, qual_info, io__state, io__state).
+ prog_varset, transform_info, transform_info,
+ io__state, io__state).
:- mode append_arg_unifications(in, in, in, in, in, in,
out, out, in, out, di, uo) is det.
@@ -6193,7 +6283,7 @@
:- pred append_arg_unifications_2(list(prog_var), list(prog_term),
prog_context, arg_context, int, list(hlds_goal), prog_varset,
- list(hlds_goal), prog_varset, qual_info, qual_info,
+ list(hlds_goal), prog_varset, transform_info, transform_info,
io__state, io__state).
:- mode append_arg_unifications_2(in, in, in, in, in, in, in,
out, out, in, out, di, uo) is det.
@@ -6215,7 +6305,7 @@
:- pred append_arg_unification(prog_var, prog_term, prog_context, arg_context,
int, list(hlds_goal), prog_varset, prog_varset,
- qual_info, qual_info, io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode append_arg_unification(in, in, in, in, in, out, in,
out, in, out, di, uo) is det.
@@ -6231,7 +6321,7 @@
UnifyMainContext, UnifySubContext) },
unravel_unification(term__variable(Var), Arg,
Context, UnifyMainContext, UnifySubContext,
- VarSet0, Goal, VarSet, Info0, Info),
+ VarSet0, pure, Goal, VarSet, Info0, Info),
{ goal_to_conj_list(Goal, ConjList) }
).
@@ -6302,18 +6392,20 @@
% lambda expressions and field extraction and update expressions.
%
:- pred unravel_unification(prog_term, prog_term, prog_context,
- unify_main_context, unify_sub_contexts, prog_varset, hlds_goal,
- prog_varset, qual_info, qual_info, io__state, io__state).
-:- mode unravel_unification(in, in, in, in, in, in, out, out,
+ unify_main_context, unify_sub_contexts, prog_varset,
+ purity, hlds_goal, prog_varset, transform_info, transform_info,
+ io__state, io__state).
+:- mode unravel_unification(in, in, in, in, in, in, in, out, out,
in, out, di, uo) is det.
% `X = Y' needs no unravelling.
unravel_unification(term__variable(X), term__variable(Y), Context,
- MainContext, SubContext, VarSet0, Goal, VarSet, Info, Info)
+ MainContext, SubContext, VarSet0, Purity, Goal, VarSet, Info0, Info)
-->
{ create_atomic_unification(X, var(Y), Context, MainContext,
SubContext, Goal) },
+ check_expr_purity(Purity, Context, Info0, Info),
{ VarSet0 = VarSet }.
% If we find a unification of the form
@@ -6326,7 +6418,7 @@
% In the trivial case `X = c', no unravelling occurs.
unravel_unification(term__variable(X), RHS,
- Context, MainContext, SubContext, VarSet0,
+ Context, MainContext, SubContext, VarSet0, Purity,
Goal, VarSet, Info0, Info) -->
{ RHS = term__functor(F, Args, FunctorContext) },
(
@@ -6341,7 +6433,7 @@
Context, Info0, Info1),
unravel_unification(term__variable(X), RVal,
Context, MainContext, SubContext, VarSet0,
- Goal, VarSet, Info1, Info)
+ Purity, Goal, VarSet, Info1, Info)
;
{
% handle lambda expressions
@@ -6375,17 +6467,20 @@
)
}
->
- { qual_info_get_mq_info(Info0, MQInfo0) },
+ check_expr_purity(Purity, Context, Info0, Info1),
+ { qual_info_get_mq_info(Info1 ^ qual_info, MQInfo0) },
module_qual__qualify_lambda_mode_list(Modes1, Modes, Context,
MQInfo0, MQInfo1),
- { qual_info_set_mq_info(Info0, MQInfo1, Info1) },
+ { qual_info_set_mq_info(Info1 ^ qual_info, MQInfo1,
+ QualInfo1) },
+ { Info2 = Info1 ^ qual_info := QualInfo1 },
{ Det = Det1 },
{ term__coerce(GoalTerm1, GoalTerm) },
{ parse_goal(GoalTerm, VarSet0, ParsedGoal, VarSet1) },
build_lambda_expression(X, PredOrFunc, EvalMethod, Vars1,
Modes, Det, ParsedGoal, VarSet1,
Context, MainContext, SubContext, Goal, VarSet,
- Info1, Info)
+ Info2, Info)
;
{
% handle higher-order dcg pred expressions -
@@ -6399,10 +6494,12 @@
Vars0, Modes0, Det)
}
->
- { qual_info_get_mq_info(Info0, MQInfo0) },
+ { qual_info_get_mq_info(Info0 ^ qual_info, MQInfo0) },
module_qual__qualify_lambda_mode_list(Modes0, Modes, Context,
MQInfo0, MQInfo1),
- { qual_info_set_mq_info(Info0, MQInfo1, Info1) },
+ { qual_info_set_mq_info(Info0 ^ qual_info, MQInfo1,
+ QualInfo1) },
+ { Info1 = Info0 ^ qual_info := QualInfo1 },
{ term__coerce(GoalTerm0, GoalTerm) },
{ parse_dcg_pred_goal(GoalTerm, VarSet0,
ParsedGoal, DCG0, DCGn, VarSet1) },
@@ -6410,8 +6507,11 @@
term__variable(DCGn)], Vars1) },
build_lambda_expression(X, predicate, EvalMethod, Vars1,
Modes, Det, ParsedGoal, VarSet1,
- Context, MainContext, SubContext, Goal, VarSet,
- Info1, Info)
+ Context, MainContext, SubContext, Goal0, VarSet,
+ Info1, Info),
+ { Goal0 = GoalExpr - GoalInfo0 },
+ { add_goal_info_purity_feature(GoalInfo0, Purity, GoalInfo) },
+ { Goal = GoalExpr - GoalInfo }
;
% handle if-then-else expressions
{ F = term__atom("else"),
@@ -6429,15 +6529,16 @@
{ parse_some_vars_goal(IfTerm, VarSet0, Vars,
IfParseTree, VarSet11) }
->
+ check_expr_purity(Purity, Context, Info0, Info1),
{ map__init(Subst) },
transform_goal(IfParseTree, VarSet11, Subst, IfGoal, VarSet22,
- Info0, Info1),
+ Info1, Info2),
unravel_unification(term__variable(X), ThenTerm,
- Context, MainContext, SubContext, VarSet22, ThenGoal,
- VarSet33, Info1, Info2),
+ Context, MainContext, SubContext, VarSet22,
+ pure, ThenGoal, VarSet33, Info2, Info3),
unravel_unification(term__variable(X), ElseTerm,
- Context, MainContext, SubContext, VarSet33, ElseGoal,
- VarSet, Info2, Info),
+ Context, MainContext, SubContext, VarSet33, pure,
+ ElseGoal, VarSet, Info3, Info),
{ map__init(Empty) },
{ IfThenElse = if_then_else(Vars, IfGoal, ThenGoal, ElseGoal,
Empty) },
@@ -6450,6 +6551,7 @@
{ parse_field_name_list(FieldNameTerm, FieldNameResult) },
{ FieldNameResult = ok(FieldNames) }
->
+ check_expr_purity(Purity, Context, Info0, Info1),
{ make_fresh_arg_var(InputTerm, InputTermVar, [],
VarSet0, VarSet1) },
{ expand_get_field_function_call(Context, MainContext,
@@ -6459,7 +6561,7 @@
{ ArgContext = functor(Functor, MainContext, SubContext) },
append_arg_unifications([InputTermVar], [InputTerm],
FunctorContext, ArgContext, Goal0,
- VarSet2, Goal, VarSet, Info0, Info)
+ VarSet2, Goal, VarSet, Info1, Info)
;
% handle field update expressions
{ F = term__atom(":=") },
@@ -6469,6 +6571,7 @@
{ parse_field_name_list(FieldNameTerm, FieldNameResult) },
{ FieldNameResult = ok(FieldNames) }
->
+ check_expr_purity(Purity, Context, Info0, Info1),
{ make_fresh_arg_var(InputTerm, InputTermVar, [],
VarSet0, VarSet1) },
{ make_fresh_arg_var(FieldValueTerm, FieldValueVar,
@@ -6483,14 +6586,14 @@
{ TermArgNumber = 1 },
append_arg_unification(InputTermVar, InputTerm,
FunctorContext, TermArgContext, TermArgNumber,
- TermUnifyConj, VarSet3, VarSet4, Info0, Info1),
+ TermUnifyConj, VarSet3, VarSet4, Info1, Info2),
{ FieldArgContext = functor(InnerFunctor,
MainContext, FieldSubContext) },
{ FieldArgNumber = 2 },
append_arg_unification(FieldValueVar, FieldValueTerm,
FunctorContext, FieldArgContext, FieldArgNumber,
- FieldUnifyConj, VarSet4, VarSet, Info1, Info),
+ FieldUnifyConj, VarSet4, VarSet, Info2, Info),
{ Goal0 = _ - GoalInfo0 },
{ goal_to_conj_list(Goal0, GoalList0) },
@@ -6513,7 +6616,11 @@
),
( { FunctorArgs = [] } ->
{ create_atomic_unification(X, functor(ConsId, []),
- Context, MainContext, SubContext, Goal) },
+ Context, MainContext, SubContext, Goal0) },
+ { Goal0 = GoalExpr - GoalInfo0 },
+ { add_goal_info_purity_feature(GoalInfo0, Purity,
+ GoalInfo) },
+ { Goal = GoalExpr - GoalInfo },
{ VarSet = VarSet0 },
{ Info = Info0 }
;
@@ -6527,19 +6634,34 @@
% Should this be insert_... rather than append_...?
% No, because that causes efficiency problems
% with type-checking :-(
+ % But for impure unifications, we should do
+ % this, because we can't reorder around the
+ % functor unification.
+ ( { Purity = pure } ->
append_arg_unifications(HeadVars, FunctorArgs,
FunctorContext, ArgContext, Goal0,
VarSet1, Goal, VarSet, Info0, Info)
+ ;
+ { Goal0 = GoalExpr - GoalInfo0 },
+ { add_goal_info_purity_feature(GoalInfo0,
+ Purity, GoalInfo) },
+ { Goal1 = GoalExpr - GoalInfo },
+ insert_arg_unifications(HeadVars, FunctorArgs,
+ FunctorContext, ArgContext, no, Goal1,
+ VarSet1, Goal, VarSet, Info0,
+ Info)
+ )
)
).
+
% Handle `f(...) = X' in the same way as `X = f(...)'.
unravel_unification(term__functor(F, As, FC), term__variable(Y),
- C, MC, SC, VarSet0, Goal, VarSet, Info0, Info) -->
+ C, MC, SC, VarSet0, Purity, Goal, VarSet, Info0, Info) -->
unravel_unification(term__variable(Y),
term__functor(F, As, FC),
- C, MC, SC, VarSet0, Goal, VarSet, Info0, Info).
+ C, MC, SC, VarSet0, Purity, Goal, VarSet, Info0, Info).
% If we find a unification of the form `f1(...) = f2(...)',
% then we replace it with `Tmp = f1(...), Tmp = f2(...)',
@@ -6550,18 +6672,18 @@
unravel_unification(term__functor(LeftF, LeftAs, LeftC),
term__functor(RightF, RightAs, RightC),
Context, MainContext, SubContext, VarSet0,
- Goal, VarSet, Info0, Info) -->
+ Purity, Goal, VarSet, Info0, Info) -->
{ varset__new_var(VarSet0, TmpVar, VarSet1) },
unravel_unification(
term__variable(TmpVar),
term__functor(LeftF, LeftAs, LeftC),
Context, MainContext, SubContext,
- VarSet1, Goal0, VarSet2, Info0, Info1),
+ VarSet1, Purity, Goal0, VarSet2, Info0, Info1),
unravel_unification(
term__variable(TmpVar),
term__functor(RightF, RightAs, RightC),
Context, MainContext, SubContext,
- VarSet2, Goal1, VarSet, Info1, Info),
+ VarSet2, Purity, Goal1, VarSet, Info1, Info),
{ goal_info_init(GoalInfo) },
{ goal_to_conj_list(Goal0, ConjList0) },
{ goal_to_conj_list(Goal1, ConjList1) },
@@ -6570,6 +6692,20 @@
%-----------------------------------------------------------------------------%
+:- pred check_expr_purity(purity, prog_context, transform_info,
+ transform_info, io__state, io__state).
+:- mode check_expr_purity(in, in, in, out, di, uo) is det.
+check_expr_purity(Purity, Context, Info0, Info) -->
+ ( { Purity \= pure } ->
+ impure_unification_expr_error(Context, Purity),
+ { module_info_incr_errors(Info0 ^ module_info,
+ ModuleInfo) },
+ { Info = Info0 ^ module_info := ModuleInfo }
+ ;
+ { Info = Info0 }
+ ).
+%-----------------------------------------------------------------------------%
+
% Parse a term of the form `Head :- Body', treating
% a term not in that form as `Head :- true'.
:- pred parse_rule_term(term__context, term(T), term(T), term(T)).
@@ -6592,7 +6728,7 @@
:- pred build_lambda_expression(prog_var, pred_or_func, lambda_eval_method,
list(prog_term), list(mode), determinism, goal, prog_varset,
prog_context, unify_main_context, unify_sub_contexts,
- hlds_goal, prog_varset, qual_info, qual_info,
+ hlds_goal, prog_varset, transform_info, transform_info,
io__state, io__state).
:- mode build_lambda_expression(in, in, in, in, in, in, in, in,
in, in, in, out, out, in, out, di, uo) is det.
@@ -6681,11 +6817,11 @@
% Process an explicit type qualification.
:- pred process_type_qualification(prog_var, type, tvarset, prog_context,
- qual_info, qual_info, io__state, io__state).
+ transform_info, transform_info, io__state, io__state).
:- mode process_type_qualification(in, in, in, in, in, out, di, uo) is det.
process_type_qualification(Var, Type0, VarSet, Context, Info0, Info) -->
- { Info0 = qual_info(EqvMap, TVarSet0, TVarRenaming0, Index0,
+ { Info0 ^ qual_info = qual_info(EqvMap, TVarSet0, TVarRenaming0, Index0,
VarTypes0, PredId, MQInfo0, FoundError) },
module_qual__qualify_type_qualification(Type0, Type1,
@@ -6705,7 +6841,7 @@
equiv_type__replace_in_type(Type2, TVarSet1, EqvMap, Type, TVarSet)
},
update_var_types(VarTypes0, Var, Type, Context, VarTypes),
- { Info = qual_info(EqvMap, TVarSet, TVarRenaming,
+ { Info = Info0 ^ qual_info := qual_info(EqvMap, TVarSet, TVarRenaming,
Index, VarTypes, PredId, MQInfo, FoundError) }.
:- pred update_var_types(map(prog_var, type), prog_var, type, prog_context,
@@ -6785,7 +6921,7 @@
% append Conj0, and return the result in Conj.
:- pred get_conj(goal, prog_substitution, list(hlds_goal), prog_varset,
- list(hlds_goal), prog_varset, qual_info, qual_info,
+ list(hlds_goal), prog_varset, transform_info, transform_info,
io__state, io__state).
:- mode get_conj(in, in, in, in, out, out, in, out, di, uo) is det.
@@ -6808,7 +6944,7 @@
% append ParConj0, and return the result in ParConj.
:- pred get_par_conj(goal, prog_substitution, list(hlds_goal), prog_varset,
- list(hlds_goal), prog_varset, qual_info, qual_info,
+ list(hlds_goal), prog_varset, transform_info, transform_info,
io__state, io__state).
:- mode get_par_conj(in, in, in, in, out, out, in, out, di, uo) is det.
@@ -6832,7 +6968,7 @@
% append Disj0, and return the result in Disj.
:- pred get_disj(goal, prog_substitution, list(hlds_goal), prog_varset,
- list(hlds_goal), prog_varset, qual_info, qual_info,
+ list(hlds_goal), prog_varset, transform_info, transform_info,
io__state, io__state).
:- mode get_disj(in, in, in, in, out, out, in, out, di, uo) is det.
--- prog_io_dcg.m 2000/04/05 08:23:42 1.1
+++ prog_io_dcg.m 2000/04/07 05:22:52
@@ -308,6 +308,8 @@
parse_dcg_goal(G, VarSet0, N0, Var0, Goal1, VarSet, N, Var),
( Goal1 = call(Pred, Args, pure) - Context ->
Goal = call(Pred, Args, Purity) - Context
+ ; Goal1 = unify(ProgTerm1, ProgTerm2, pure) - Context ->
+ Goal = unify(ProgTerm1, ProgTerm2, Purity) - Context
;
% Inappropriate placement of an impurity marker, so we treat
% it like a predicate call. typecheck.m prints out something
--- purity.m 2000/04/05 08:23:42 1.1
+++ purity.m 2000/04/11 04:28:47
@@ -75,13 +75,35 @@
% 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.
+% See the language reference manual for more information on syntax and
+% semantics.
+%
+% The current implementation now handles impure functions.
+% They are limited to being used as part of an explicit unification
+% with a purity indicator before the goal.
+%
+% impure X = some_impure_func(Arg1, Arg2, ....)
+%
+% Any non-variable arguments to the function are flattened into
+% unification goals (see make_hlds__unravel_unifications) which are
+% placed as pure goals before the function call itself.
+% This eliminates any need to define some order of evaluation of nested
+% impure functions.
+% Of course it also eliminates the benefits of using functions to
+% cut down on the number of variables introduced. The main use of
+% impure functions is to interface nicely with foreign language
+% functions.
+%
+% Wishlist:
+% It would be nice to use impure functions in DCG goals as well as
+% normal unifications.
+%
+% We could give better error messages for impure calls inside
+% closures. It's possible to give the context of these calls,
+% although we should be careful to pinpoint these as the source of
+% the error (no impurity allowed in closures) rather than as
+% errors to be corrected.
+%
:- module purity.
@@ -145,6 +167,12 @@
:- pred goal_info_is_impure(hlds_goal_info).
:- mode goal_info_is_impure(in) is semidet.
+% Give an error message for unifications marked impure/semipure that are
+% not function calls (e.g. impure X = 4)
+:- pred impure_unification_expr_error(prog_context, purity,
+ io__state, io__state).
+:- mode impure_unification_expr_error(in, in, di, uo) is det.
+
:- implementation.
:- import_module hlds_pred, hlds_data, prog_io_util.
@@ -666,15 +694,24 @@
{ NumErrors is NumErrors0 + 1 }
)
;
- { goal_info_get_context(GoalInfo, CallContext) },
- error_unknown_predicate(CallContext),
+ % If we can't find the type of the function,
+ % it's because typecheck couldn't give it one.
+ % Typechecking gives an error in this case, we
+ % just keep silent.
{ Purity = pure },
- { NumErrors is NumErrors0 + 1 }
+ { NumErrors = NumErrors0 }
),
{ ActualPurity = Purity }
;
- { ActualPurity = pure },
+ { infer_goal_info_purity(GoalInfo, DeclaredPurity) },
+ ( { DeclaredPurity \= pure } ->
+ { goal_info_get_context(GoalInfo, Context) },
+ impure_unification_expr_error(Context, DeclaredPurity),
+ { NumErrors = NumErrors0 + 1 }
+ ;
{ NumErrors = NumErrors0 }
+ ),
+ { ActualPurity = pure }
).
% the possible results of a purity check
@@ -956,7 +993,7 @@
{ 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: "),
+ io__write_string(" purity error: "),
hlds_out__write_pred_or_func(PredOrFunc),
io__write_string(" is "),
write_purity(Purity),
@@ -986,11 +1023,11 @@
prog_out__write_context(Context),
{ pred_info_get_is_pred_or_func(PredInfo, PredOrFunc) },
( { PredOrFunc = predicate } ->
- io__write_string(" error: call must be preceded by `"),
+ io__write_string(" purity 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"),
+ io__write_string(" purity error: call must be in an explicit unification\n"),
prog_out__write_context(Context),
io__write_string(" which is preceded by `"),
write_purity(Purity),
@@ -1033,7 +1070,7 @@
{ NumErrors is NumErrors0 + 1 },
{ goal_info_get_context(GoalInfo, Context) },
prog_out__write_context(Context),
- io__write_string("Error in closure: closure is "),
+ io__write_string("Purity error in closure: closure is "),
write_purity(Purity),
io__write_string(".\n"),
globals__io_lookup_bool_option(verbose_errors, VerboseErrors),
@@ -1045,20 +1082,6 @@
)
).
-:- 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,
io__state, io__state).
:- mode write_context_and_pred_id(in, in, in, di, uo) is det.
@@ -1070,5 +1093,13 @@
hlds_out__write_pred_id(ModuleInfo, PredId),
io__write_string(":\n").
+impure_unification_expr_error(Context, Purity) -->
+ io__set_exit_status(1),
+ prog_out__write_context(Context),
+ io__write_string("Purity error: unification with expression was\n"),
+ prog_out__write_context(Context),
+ io__write_string(" "),
+ write_purity(Purity),
+ io__write_string(", but expression was not a function call.\n").
%-----------------------------------------------------------------------------%
--- reference_manual.texi 2000/04/05 08:24:13 1.1
+++ reference_manual.texi 2000/04/07 03:47:25
@@ -4626,12 +4626,16 @@
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.) Pure procedures may perform destructive update on their
+above.) Pure or semipure procedures may perform destructive update on their
arguments only if those arguments have an appropriate
unique mode declaration.
-Pure procedures may perform I/O only if their arguments
+Impure predicates may perform destructive update on data pointed to by
+C pointer arguments, even without unique modes. But they cannot
+destructively update the arguments themselves.
+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).
+of the Mercury Library Reference Manual), or if they are declared impure
+(@pxref{Impurity}).
The Mercury implementation is allowed to assume that
these rules are followed, and to optimize accordingly.
If the C code is not type-correct, mode-correct,
@@ -4665,7 +4669,8 @@
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.
+arguments directly (unless they have mode @samp{di}) 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
@@ -5342,7 +5347,8 @@
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 or function to be so declared, and
-by requiring every call to an impure predicate to be flagged as such.
+by requiring every call to an impure predicate or function 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.
@@ -5374,14 +5380,15 @@
@table @dfn
@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
+For pure procedures, the set of solutions depends only on the
+values of the input arguments.
+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 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
+It is possible for the invocation of pure predicates to affect the
behaviour of non-pure predicates and vice versa.
By default, Mercury predicates and functions are pure.
@@ -5407,8 +5414,6 @@
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
@@ -5464,17 +5469,23 @@
A predicate is declared to be impure or semipure by preceding the word
@code{pred} in its @code{pred} declaration with @code{impure}
-or @code{semipure}, respectively. That is, a declaration of the form:
+or @code{semipure}, respectively.
+Similarly, a function is declared impure or semipure by preceding the
+word @code{func} in its @code{func} declaration with @code{impure} or
+ at code{semipure}.
+That is, a declaration of the form:
@example
:- impure pred @var{Pred}(@var{Arguments}@dots{}).
+:- semimpure pred @var{Pred}(@var{Arguments}@dots{}).
@end example
@noindent
or
@example
-:- semipure func @var{Pred}(@var{Arguments}@dots{}) = (Result).
+:- impure func @var{Func}(@var{Arguments}@dots{}) = Result.
+:- semipure func @var{Func}(@var{Arguments}@dots{}) = Result.
@end example
@noindent
@@ -5498,7 +5509,7 @@
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 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.
@@ -5527,14 +5538,14 @@
@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.
+assumed to have the lowest bound of the purity 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
+declared purity of the calls it executes, the lowest purity bound is
propagated up from callee to caller through the program.
However, some predicates which call impure or semipure predicates are
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.82
diff -u -r1.82 Mmakefile
--- tests/hard_coded/Mmakefile 2000/04/05 06:11:33 1.82
+++ tests/hard_coded/Mmakefile 2000/04/06 05:27:55
@@ -182,7 +182,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/cvsPyvleu Wed Apr 12 14:41:14 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/cvsxI8YQh Wed Apr 12 14:41:14 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 Tue Apr 11 13:28:58 2000
@@ -0,0 +1,31 @@
+#-----------------------------------------------------------------------------#
+
+main_target: check
+
+include ../../Mmake.common
+
+#-----------------------------------------------------------------------------#
+
+PROGS= \
+ purity \
+ impure_func_t1 \
+ impure_func_t6
+
+#-----------------------------------------------------------------------------#
+
+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/impure_func_t6.exp
===================================================================
RCS file: impure_func_t6.exp
diff -N impure_func_t6.exp
--- /dev/null Thu Mar 4 04:20:11 1999
+++ impure_func_t6.exp Tue Apr 11 18:40:50 2000
@@ -0,0 +1 @@
+X = 4
Index: tests/hard_coded/purity/impure_func_t6.m
===================================================================
RCS file: impure_func_t6.m
diff -N impure_func_t6.m
--- /dev/null Thu Mar 4 04:20:11 1999
+++ impure_func_t6.m Tue Apr 11 13:28:12 2000
@@ -0,0 +1,34 @@
+
+:- module impure_func_t6.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+:- import_module int, require.
+
+:- pragma promise_pure(main/2).
+
+
+ % A test of functions with arguments.
+main -->
+ { impure X = get_counter(4) },
+ print("X = "),
+ print(X),
+ nl.
+
+:- impure func get_counter(int) = int.
+:- impure pred some_pred(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;").
+
+:- pragma c_code(some_pred(Y::in, X::out), will_not_call_mercury,
+ "X = counter + Y;").
+
+
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.61
diff -u -r1.61 Mmakefile
--- tests/invalid/Mmakefile 2000/04/05 06:11:33 1.61
+++ tests/invalid/Mmakefile 2000/04/06 05:28:10
@@ -142,3 +142,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/impure_method_impl.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/impure_method_impl.err_exp,v
retrieving revision 1.1
diff -u -r1.1 impure_method_impl.err_exp
--- tests/invalid/impure_method_impl.err_exp 2000/03/27 05:08:26 1.1
+++ tests/invalid/impure_method_impl.err_exp 2000/04/12 04:39:32
@@ -1,11 +1,11 @@
impure_method_impl.m:017: In call to impure predicate `impure_method_impl:foo_m2/2':
-impure_method_impl.m:017: error: call must be preceded by `impure' indicator.
+impure_method_impl.m:017: purity error: call must be preceded by `impure' indicator.
impure_method_impl.m:017: In type class method implementation:
-impure_method_impl.m:017: error: predicate is impure.
+impure_method_impl.m:017: purity error: predicate is impure.
impure_method_impl.m:017: It must be declared `impure' or promised pure.
impure_method_impl.m:016: In call to semipure predicate `impure_method_impl:foo_m1/2':
-impure_method_impl.m:016: error: call must be preceded by `semipure' indicator.
+impure_method_impl.m:016: purity error: call must be preceded by `semipure' indicator.
impure_method_impl.m:016: In type class method implementation:
-impure_method_impl.m:016: error: predicate is semipure.
+impure_method_impl.m:016: purity error: predicate is semipure.
impure_method_impl.m:016: It must be declared `semipure' or promised pure.
For more information, try recompiling with `-E'.
Index: tests/invalid/purity.err_exp
===================================================================
RCS file: purity.err_exp
diff -N purity.err_exp
--- /tmp/cvsmhsQt4 Wed Apr 12 14:41:31 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/cvsjaVcIA Wed Apr 12 14:41:31 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/cvsqoEp9a Wed Apr 12 14:41:31 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/cvsVQqlhS Wed Apr 12 14:41:31 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/purity/Mmakefile
===================================================================
RCS file: Mmakefile
diff -N Mmakefile
--- /dev/null Thu Mar 4 04:20:11 1999
+++ Mmakefile Tue Apr 11 13:29:42 2000
@@ -0,0 +1,46 @@
+#-----------------------------------------------------------------------------#
+
+main_target: check
+
+include ../../Mmake.common
+
+#-----------------------------------------------------------------------------#
+
+SOURCES= \
+ impure_func_t2.m \
+ impure_func_t3.m \
+ impure_func_t4.m \
+ impure_func_t5.m \
+ impure_func_t7.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 Wed Apr 12 14:35:10 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: purity 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 Wed Apr 12 14:35:20 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: purity 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 Wed Apr 12 14:35:29 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: purity 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 Wed Apr 12 14:35:39 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: purity 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_func_t7.m
===================================================================
RCS file: impure_func_t7.m
diff -N impure_func_t7.m
--- /dev/null Thu Mar 4 04:20:11 1999
+++ impure_func_t7.m Tue Apr 11 14:28:28 2000
@@ -0,0 +1,46 @@
+
+:- module impure_func_t7.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(state::di, state::uo) is det.
+
+:- implementation.
+:- import_module int, require.
+
+:- pragma promise_pure(main/2).
+
+:- type blah ---> blah(foo :: int).
+
+main -->
+ { impure X = get_counter(4) },
+ print("X = "),
+ print(X),
+ { impure Z = ( X = 3 -> 4 ; 5 ) },
+ print("Z = "),
+ print(Z),
+ { impure L = (pred(X5::out) is det :- X5 = 4) },
+ { L(P) },
+ print("P = "),
+ print(P),
+ { impure M = blah(7) ^ foo },
+ print("M = "),
+ print(M),
+ { impure B = 4 },
+ print(B),
+ nl.
+
+:- impure func get_counter(int) = int.
+:- impure pred some_pred(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;").
+
+:- pragma c_code(some_pred(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 Wed Apr 12 14:38:07 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: purity 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: purity 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 Wed Apr 12 14:37:58 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: purity 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: purity 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 Thu Apr 6 00:51:13 2000
@@ -0,0 +1,29 @@
+
+% 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.
+
+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 Wed Apr 12 14:37:15 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: purity 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: purity 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: purity 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: purity error: call must be preceded by `impure' indicator.
+purity.m:078: In call to semipure predicate `purity:semi/0':
+purity.m:078: purity error: call must be preceded by `semipure' indicator.
+purity.m:112: Purity error in closure: closure is impure.
+purity.m:118: Purity error in closure: closure is semipure.
+purity.m:093: In unification predicate for type (purity:e8):
+purity.m:093: purity error: predicate is impure.
+purity.m:093: It must be pure.
+purity.m:101: In unification predicate for type (purity:e9):
+purity.m:101: purity 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 Tue Apr 11 15:36:52 2000
@@ -0,0 +1,47 @@
+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: `:- pragma promise_pure' declaration 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
+purity_nonsense.m:008: 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 Apr 11 15:35:23 2000
@@ -0,0 +1,18 @@
+:- module purity_nonsense.
+:- interface.
+:- type foo == int.
+:- implementation.
+:- 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 everyone'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