[m-rev.] for review: emit errors about purity mismatches with foreign clauses
Julien Fischer
juliensf at csse.unimelb.edu.au
Sat Jul 8 01:19:15 AEST 2006
On Fri, 7 Jul 2006, Julien Fischer wrote:
>
> On Thu, 6 Jul 2006, Ian MacLarty wrote:
>
> > On Thu, Jul 06, 2006 at 02:14:34PM +1000, Julien Fischer wrote:
> > >
> > > On Thu, 6 Jul 2006, Ian MacLarty wrote:
> > >
> > > > On Thu, Jul 06, 2006 at 12:13:59PM +1000, Julien Fischer wrote:
> > > > >
> > > > > > Actually there seems to be another bug because while the compiler reports a
> > > > > > warning, it doesn't generate an executable and a non-zero exit status is
> > > > > > returned (even with --no-halt-at-warn). Try compiling the following program
> > > > > > to see what I mean:
> > > > > >
> > > > > > :- module pure.
> > > > > >
> > > > > > :- interface.
> > > > > >
> > > > > > :- import_module io.
> > > > > >
> > > > > > :- pred main(io::di, io::uo) is det.
> > > > > >
> > > > > > :- implementation.
> > > > > >
> > > > > > main(!IO) :-
> > > > > > nl(!IO).
> > > > > >
> > > > > > :- pragma promise_pure(p/0).
> > > > > >
> > > > > > :- impure pred p is det.
> > > > > >
> > > > > > :- pragma foreign_proc("C",
> > > > > > p,
> > > > > > [will_not_call_mercury],
> > > > > > "
> > > > > > printf(\"hello\");
> > > > > > ").
> > > > >
> > > > > That is a purity error.
> > > > >
> > > >
> > > > Why does the compiler emit a warning then?
> > > >
> > >
> > > Hmmm ... so it does. It appears that the code for handling that particular
> > > error/warning (in compiler/purity.m) is a bit confused and can't decide which
> > > one it is - it seems to have taken the approach that it is both an error *and*
> > > a warning (at least w.r.t the exit status).
> > >
> > > Any opinions on which it should be?
> > >
> >
> > I'd say it should be an error.
>
> I'll turn it into an error - it's effectively been one anyway.
>
Here is a revised diff:
Estimated hours taken: 6
Branches: main, release
Make it an error for the (promised) purity of a foreign clause to disagree
with the declared purity of the corresponding predicate or function
declaration. We only perform this check in the absence of a
promise_{pure,semipure} pragma for the predicate or function.
Previously this situation was sometimes picked up by purity analysis but not
in all cases. For example, if a predicate was declared impure but the
foreign_proc was promised pure it wasn't reported. In that particular case
it was a problem because if the foreign_proc did not have any outputs, then
simplify.m might have optimised its body away (which is how I noticed this).
compiler/add_pramga.m:
In the absence of promise_{pure,semipure} pragmas emit error messages
about mismatches between the declared purity of a procedure and the
(promised) purity of a foreign clause for it.
compiler/mode_errors.m:
Fix a typo in an error message: s/becaise/because/
compiler/purity.m:
Fix a bug reported by Ian. Inconsistent purity annotation were being
treated as both a warning and an error. Make it into an error.
library/private_builtin.m:
library/solutions.m:
Delete bogus purity promises from foreign_proc attributes reported by
the new check.
tests/invalid/Mmakefile:
tests/invalid/foreign_purity_mismatch.{m,err_exp}:
Test case for the new error.
compiler/simplify.m:
compiler/prog_io_pragma.m:
Fix some formatting.
tests/*/*:
Fix purity errors picked up by the new check.
Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.36
diff -u -r1.36 add_pragma.m
--- compiler/add_pragma.m 5 Jul 2006 08:45:32 -0000 1.36
+++ compiler/add_pragma.m 6 Jul 2006 07:09:40 -0000
@@ -61,7 +61,7 @@
maybe(structure_reuse_domain)::in, prog_context::in,
module_info::in, module_info::out, io::di, io::uo) is det.
- % module_add_pragma_import:
+ % module_add_pragma_import.
%
% Handles `pragma import' declarations, by figuring out which predicate
% the `pragma import' declaration applies to, and adding a clause
@@ -1422,11 +1422,13 @@
PredModule = pred_info_module(!.PredInfo),
pred_info_clauses_info(!.PredInfo, Clauses0),
pred_info_get_purity(!.PredInfo, Purity),
+ pred_info_get_markers(!.PredInfo, Markers),
% Add the code for this `pragma import' to the clauses_info.
- clauses_info_add_pragma_foreign_proc(Purity, Attributes, PredId, ProcId,
+ clauses_info_add_pragma_foreign_proc(pragma_import_foreign_proc,
+ Purity, Attributes, PredId, ProcId,
VarSet, PragmaVars, ArgTypes, PragmaImpl, Context, PredOrFunc,
- qualified(PredModule, PredName), Arity, Clauses0, Clauses,
+ qualified(PredModule, PredName), Arity, Markers, Clauses0, Clauses,
!ModuleInfo, !IO),
% Store the clauses_info etc. back into the pred_info.
@@ -1573,10 +1575,11 @@
pred_info_clauses_info(!.PredInfo, Clauses0),
pred_info_get_arg_types(!.PredInfo, ArgTypes),
pred_info_get_purity(!.PredInfo, Purity),
- clauses_info_add_pragma_foreign_proc(Purity, Attributes,
- PredId, ProcId, ProgVarSet, PVars, ArgTypes,
- PragmaImpl, Context, PredOrFunc, PredName, Arity,
- Clauses0, Clauses, !ModuleInfo, !IO),
+ pred_info_get_markers(!.PredInfo, Markers),
+ clauses_info_add_pragma_foreign_proc(standard_foreign_proc,
+ Purity, Attributes, PredId, ProcId, ProgVarSet, PVars,
+ ArgTypes, PragmaImpl, Context, PredOrFunc, PredName,
+ Arity, Markers, Clauses0, Clauses, !ModuleInfo, !IO),
pred_info_set_clauses_info(Clauses, !PredInfo),
pred_info_update_goal_type(pragmas, !PredInfo),
map.det_update(Preds0, PredId, !.PredInfo, Preds),
@@ -2355,21 +2358,31 @@
PragmaVars0 = []
).
+ % This type is used to distinguish between those foreign_procs that
+ % were created by the transformation for `:- pragma import' and those
+ % that were not.
+ %
+:- type foreign_proc_origin
+ ---> standard_foreign_proc
+ ; pragma_import_foreign_proc.
+
% Add the pragma_foreign_proc goal to the clauses_info for this procedure.
% To do so, we must also insert unifications between the variables in the
% pragma foreign_proc declaration and the head vars of the pred. Also
% return the hlds_goal.
%
-:- pred clauses_info_add_pragma_foreign_proc(purity::in,
- pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
+:- pred clauses_info_add_pragma_foreign_proc(foreign_proc_origin::in,
+ purity::in, pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
prog_varset::in, list(pragma_var)::in, list(mer_type)::in,
pragma_foreign_code_impl::in, prog_context::in, pred_or_func::in,
- sym_name::in, arity::in, clauses_info::in, clauses_info::out,
- module_info::in, module_info::out, io::di, io::uo) is det.
+ sym_name::in, arity::in, pred_markers::in,
+ clauses_info::in, clauses_info::out, module_info::in, module_info::out,
+ io::di, io::uo) is det.
-clauses_info_add_pragma_foreign_proc(Purity, Attributes0, PredId, ProcId,
- PVarSet, PVars, OrigArgTypes, PragmaImpl0, Context,
- PredOrFunc, PredName, Arity, !ClausesInfo, !ModuleInfo, !IO) :-
+clauses_info_add_pragma_foreign_proc(Origin, Purity, Attributes0,
+ PredId, ProcId, PVarSet, PVars, OrigArgTypes, PragmaImpl0,
+ Context, PredOrFunc, PredName, Arity, Markers, !ClausesInfo,
+ !ModuleInfo, !IO) :-
!.ClausesInfo = clauses_info(VarSet0, ExplicitVarTypes, TVarNameMap,
InferredVarTypes, HeadVars, ClauseRep, RttiVarMaps,
@@ -2434,7 +2447,48 @@
% Build the foreign_proc.
goal_info_init(GoalInfo0),
goal_info_set_context(Context, GoalInfo0, GoalInfo1),
+ %
+ % Check that the purity of a predicate/function declaration agrees with
+ % the (promised) purity of the foreign proc. We do not perform this
+ % check there is a promise_{pure,semipure} pragma for the
+ % predicate/function since in that case they will differ anyway. We
+ % also do not perform this check if the foreign_proc was introduced as
+ % a result of a `:- pragma import' declaration since doing so results
+ % in spurious error messages about non-existent foreign_procs. For
+ % that case we assume that the code that constructs the foreign_procs
+ % from the import pragmas sets the purity attributes correctly.
+ %
+ (
+ ( Origin = pragma_import_foreign_proc
+ ; check_marker(Markers, promised_pure)
+ ; check_marker(Markers, promised_semipure)
+ )
+ ->
+ true
+ ;
+ ForeignAttributePurity = purity(Attributes1),
+ (
+ ForeignAttributePurity \= Purity
+ ->
+ purity_name(ForeignAttributePurity, ForeignAttributePurityStr),
+ purity_name(Purity, PurityStr),
+ ErrorMsg = [
+ words("Error: foreign clause for"),
+ pred_or_func(PredOrFunc),
+ sym_name_and_arity(PredName / Arity),
+ words("has purity " ++ ForeignAttributePurityStr),
+ words("but that"), pred_or_func(PredOrFunc),
+ words("has been declared " ++ PurityStr), suffix(".")
+ ],
+ write_error_pieces(Context, 0, ErrorMsg, !IO),
+ io.set_exit_status(1, !IO)
+ ;
+ true
+ )
+ ),
+ %
% Put the purity in the goal_info in case this foreign code is inlined.
+ %
add_goal_info_purity_feature(Purity, GoalInfo1, GoalInfo),
make_foreign_args(HeadVars, ArgInfo, OrigArgTypes, ForeignArgs),
% Perform some renaming in any user annotated sharing information.
Index: compiler/mode_errors.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mode_errors.m,v
retrieving revision 1.102
diff -u -r1.102 mode_errors.m
--- compiler/mode_errors.m 14 Jun 2006 07:42:53 -0000 1.102
+++ compiler/mode_errors.m 7 Jul 2006 15:00:38 -0000
@@ -452,7 +452,7 @@
ImpureGoal = _ - ImpureGoalInfo,
goal_info_get_context(ImpureGoalInfo, ImpureGoalContext),
Pieces1 = [words("The goal could not be reordered,"),
- words("becaise it was followed by an impure goal.")],
+ words("because it was followed by an impure goal.")],
Pieces2 = [words("This is the location of the impure goal.")],
Specs2 = [plain_spec(error_msg_spec(no, Context, 0, Pieces1)),
plain_spec(error_msg_spec(no, ImpureGoalContext, 0, Pieces2))]
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.106
diff -u -r1.106 prog_io_pragma.m
--- compiler/prog_io_pragma.m 5 Jul 2006 08:45:35 -0000 1.106
+++ compiler/prog_io_pragma.m 5 Jul 2006 10:28:31 -0000
@@ -5,12 +5,13 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
+%
% File: prog_io_pragma.m.
% Main authors: fjh, dgj.
-
+%
% This module handles the parsing of pragma directives.
-
+%
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module parse_tree.prog_io_pragma.
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.94
diff -u -r1.94 purity.m
--- compiler/purity.m 29 Mar 2006 08:07:19 -0000 1.94
+++ compiler/purity.m 7 Jul 2006 08:00:32 -0000
@@ -883,7 +883,7 @@
purity_name(Purity, PurityName),
PredContextPieces = pred_context(ModuleInfo, PredInfo, PredId),
Pieces1 = PredContextPieces ++
- [words("warning: declared"), fixed(PurityName),
+ [words("error: declared"), fixed(PurityName),
words("but promised pure.")],
globals.io_lookup_bool_option(verbose_errors, VerboseErrors, !IO),
(
@@ -898,8 +898,7 @@
globals.io_set_extra_error_info(yes, !IO),
Pieces = Pieces1
),
- write_error_pieces(Context, 0, Pieces, !IO),
- record_warning(!IO).
+ write_error_pieces(Context, 0, Pieces, !IO).
:- pred warn_exaggerated_impurity_decl(module_info::in, pred_info::in,
pred_id::in, purity::in, purity::in,
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.178
diff -u -r1.178 simplify.m
--- compiler/simplify.m 28 Jun 2006 04:46:17 -0000 1.178
+++ compiler/simplify.m 5 Jul 2006 05:02:18 -0000
@@ -5,10 +5,10 @@
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
-
+%
% File: simplify.m.
% Main authors: zs, stayl.
-
+%
% The two jobs of the simplification module are
%
% to find and exploit opportunities for simplifying the internal form
@@ -27,6 +27,7 @@
% works properly.
%
%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
:- module check_hlds.simplify.
:- interface.
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.157
diff -u -r1.157 private_builtin.m
--- library/private_builtin.m 28 Jun 2006 04:46:19 -0000 1.157
+++ library/private_builtin.m 5 Jul 2006 06:14:36 -0000
@@ -1006,7 +1006,7 @@
:- pragma foreign_proc("C",
free_heap(Val::di),
- [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
+ [will_not_call_mercury, thread_safe, will_not_modify_trail],
"
MR_free_heap((void *) Val);
").
Index: library/solutions.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/solutions.m,v
retrieving revision 1.4
diff -u -r1.4 solutions.m
--- library/solutions.m 19 Apr 2006 05:17:56 -0000 1.4
+++ library/solutions.m 5 Jul 2006 07:22:15 -0000
@@ -630,26 +630,26 @@
:- pragma foreign_proc("C",
partial_deep_copy(SolutionsHeapPtr::in, OldVal::in, NewVal::out),
- [will_not_call_mercury, thread_safe, promise_pure],
+ [will_not_call_mercury, thread_safe],
"
MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, OldVal, NewVal, TypeInfo_for_T);
").
:- pragma foreign_proc("C",
partial_deep_copy(SolutionsHeapPtr::in, OldVal::mdi, NewVal::muo),
- [will_not_call_mercury, thread_safe, promise_pure],
+ [will_not_call_mercury, thread_safe],
"
MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, OldVal, NewVal, TypeInfo_for_T);
").
:- pragma foreign_proc("C",
partial_deep_copy(SolutionsHeapPtr::in, OldVal::di, NewVal::uo),
- [will_not_call_mercury, thread_safe, promise_pure],
+ [will_not_call_mercury, thread_safe],
"
MR_PARTIAL_DEEP_COPY(SolutionsHeapPtr, OldVal, NewVal, TypeInfo_for_T);
").
:- pragma foreign_proc("C#",
partial_deep_copy(_SolutionsHeapPtr::in, OldVal::in, NewVal::out),
- [will_not_call_mercury, thread_safe, promise_pure],
+ [will_not_call_mercury, thread_safe],
"
//
// For the IL back-end, we don't do heap reclamation on failure,
@@ -660,20 +660,20 @@
").
:- pragma foreign_proc("C#",
partial_deep_copy(_SolutionsHeapPtr::in, OldVal::mdi, NewVal::muo),
- [will_not_call_mercury, thread_safe, promise_pure],
+ [will_not_call_mercury, thread_safe],
"
NewVal = OldVal;
").
:- pragma foreign_proc("C#",
partial_deep_copy(_SolutionsHeapPtr::in, OldVal::di, NewVal::uo),
- [will_not_call_mercury, thread_safe, promise_pure],
+ [will_not_call_mercury, thread_safe],
"
NewVal = OldVal;
").
:- pragma foreign_proc("Java",
partial_deep_copy(_SolutionsHeapPtr::in, OldVal::in, NewVal::out),
- [will_not_call_mercury, thread_safe, promise_pure],
+ [will_not_call_mercury, thread_safe],
"
/*
** For the Java back-end, as for the .NET implementation,
@@ -685,13 +685,13 @@
").
:- pragma foreign_proc("Java",
partial_deep_copy(_SolutionsHeapPtr::in, OldVal::mdi, NewVal::muo),
- [will_not_call_mercury, thread_safe, promise_pure],
+ [will_not_call_mercury, thread_safe],
"
NewVal = OldVal;
").
:- pragma foreign_proc("Java",
partial_deep_copy(_SolutionsHeapPtr::in, OldVal::di, NewVal::uo),
- [will_not_call_mercury, thread_safe, promise_pure],
+ [will_not_call_mercury, thread_safe],
"
NewVal = OldVal;
").
Index: tests/hard_coded/dupcall_impurity.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/dupcall_impurity.m,v
retrieving revision 1.2
diff -u -r1.2 dupcall_impurity.m
--- tests/hard_coded/dupcall_impurity.m 28 Nov 2002 16:33:44 -0000 1.2
+++ tests/hard_coded/dupcall_impurity.m 6 Jul 2006 03:41:06 -0000
@@ -34,12 +34,29 @@
:- impure pred next_x(int::out) is det.
:- impure pred incr_x is det.
-:- pragma c_header_code("extern int my_global;").
-:- pragma c_code("int my_global;").
+:- pragma foreign_decl("C", "extern int my_global;").
+:- pragma foreign_code("C", "int my_global;").
-:- pragma c_code(get_x(X::out), "X = my_global;").
-:- pragma c_code(next_x(X::out), "X = my_global++;").
-:- pragma c_code(incr_x, "my_global++;").
+:- pragma foreign_proc("C",
+ get_x(X::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ X = my_global;
+").
+
+:- pragma foreign_proc("C",
+ next_x(X::out),
+ [will_not_call_mercury],
+"
+ X = my_global++;"
+).
+
+:- pragma foreign_proc("C",
+ incr_x,
+ [will_not_call_mercury],
+"
+ my_global++;
+").
:- pragma foreign_code("C#", "static int my_global;").
Index: tests/hard_coded/ho_solns.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/ho_solns.m,v
retrieving revision 1.6
diff -u -r1.6 ho_solns.m
--- tests/hard_coded/ho_solns.m 5 Apr 2006 05:06:58 -0000 1.6
+++ tests/hard_coded/ho_solns.m 6 Jul 2006 03:42:09 -0000
@@ -33,8 +33,10 @@
:- pred convert_list(list(T), list(T)).
:- mode convert_list(in, out(list_skel(mypred))) is det.
-:- pragma c_code(
- convert_list(L0 :: in, L :: out(list_skel(mypred))), "
+:- pragma foreign_proc("C",
+ convert_list(L0 :: in, L :: out(list_skel(mypred))),
+ [will_not_call_mercury, promise_pure],
+"
{
L = L0;
}
Index: tests/hard_coded/ho_univ_to_type.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/ho_univ_to_type.m,v
retrieving revision 1.5
diff -u -r1.5 ho_univ_to_type.m
--- tests/hard_coded/ho_univ_to_type.m 29 Mar 2006 08:08:01 -0000 1.5
+++ tests/hard_coded/ho_univ_to_type.m 7 Jul 2006 14:51:53 -0000
@@ -47,18 +47,21 @@
foo(X) :- X = (pred(A::in, B::in, C::out) is det :- C = A + B).
-% Some hacky pragma c_code to allow use to change an
+% Some hacky pragma foreign_proc to allow use to change an
% inst from `ground' to `pred(in, in, out) is det'.
:- pred convert_inst(mypred2::in, mypred2::out(mypred)) is det.
-
-:- pragma c_code(convert_inst(Pred1::in, Pred2::out(mypred)), "
+:- pragma foreign_proc("C",
+ convert_inst(Pred1::in, Pred2::out(mypred)),
+ [will_not_call_mercury, promise_pure],
+"
{
Pred2 = Pred1;
}
").
-:- pragma foreign_proc("C#", convert_inst(Pred1::in, Pred2::out(mypred)),
- [promise_pure], "
+:- pragma foreign_proc("C#",
+ convert_inst(Pred1::in, Pred2::out(mypred)),
+ [will_not_call_mercury, promise_pure], "
{
Pred2 = Pred1;
}
Index: tests/hard_coded/impure_prune.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/impure_prune.m,v
retrieving revision 1.3
diff -u -r1.3 impure_prune.m
--- tests/hard_coded/impure_prune.m 28 Nov 2002 16:33:44 -0000 1.3
+++ tests/hard_coded/impure_prune.m 7 Jul 2006 07:56:00 -0000
@@ -33,13 +33,27 @@
:- semipure pred get_counter(int::out) is det.
:- impure pred set_counter(int::in) is det.
-:- pragma c_header_code("extern MR_Integer counter;").
-:- pragma c_code("MR_Integer counter = 0;").
-:- pragma c_code(get_counter(X::out), will_not_call_mercury, "X = counter;").
-:- pragma c_code(set_counter(X::in), will_not_call_mercury, "counter = X;").
+:- pragma foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C", "MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter(X::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ X = counter;
+").
+:- pragma foreign_proc("C",
+ set_counter(X::in),
+ [will_not_call_mercury],
+"
+ counter = X;
+").
:- pragma foreign_code("C#", "static int counter = 0;").
-:- pragma foreign_proc("C#", get_counter(X::out),
- [promise_semipure], "X = counter;").
+:- pragma foreign_proc("C#",
+ get_counter(X::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ X = counter;
+").
:- pragma foreign_proc("C#", set_counter(X::in), [], "counter = X;").
Index: tests/hard_coded/intermod_c_code2.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/intermod_c_code2.m,v
retrieving revision 1.2
diff -u -r1.2 intermod_c_code2.m
--- tests/hard_coded/intermod_c_code2.m 28 Nov 2002 16:33:44 -0000 1.2
+++ tests/hard_coded/intermod_c_code2.m 6 Jul 2006 03:47:20 -0000
@@ -10,7 +10,9 @@
:- some [U] pred c_code_2(T::in, U::out) is det.
-:- pragma c_code(c_code_2(T::in, U::out),
+:- pragma foreign_proc("C",
+ c_code_2(T::in, U::out),
+ [will_not_call_mercury, promise_pure],
"{
U = T;
TypeInfo_for_U = TypeInfo_for_T;
Index: tests/hard_coded/intermod_multimode.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/intermod_multimode.m,v
retrieving revision 1.4
diff -u -r1.4 intermod_multimode.m
--- tests/hard_coded/intermod_multimode.m 28 Nov 2002 16:33:44 -0000 1.4
+++ tests/hard_coded/intermod_multimode.m 6 Jul 2006 03:48:26 -0000
@@ -84,7 +84,12 @@
test2(0::out, 0::out) :-
impure puts("test2(out, out)").
-:- pragma c_code(puts(S::in), [will_not_call_mercury], "puts(S)").
+:- pragma foreign_proc("C",
+ puts(S::in),
+ [will_not_call_mercury],
+"
+ puts(S)
+").
:- pragma foreign_proc("C#", puts(S::in), [], "System.Console.WriteLine(S);").
:- pragma promise_pure(get_determinism/2).
Index: tests/hard_coded/lp.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/lp.m,v
retrieving revision 1.5
diff -u -r1.5 lp.m
--- tests/hard_coded/lp.m 29 Mar 2006 08:08:01 -0000 1.5
+++ tests/hard_coded/lp.m 6 Jul 2006 03:51:45 -0000
@@ -368,7 +368,12 @@
:- pred mkuniq(array(float)::in, array(float)::array_uo) is det.
-:- pragma c_code(mkuniq(A::in, B::array_uo), "B = A;").
+:- pragma foreign_proc("C",
+ mkuniq(A::in, B::array_uo),
+ [will_not_call_mercury, promise_pure],
+"
+ B = A;
+").
:- pragma foreign_proc(il, mkuniq(A::in, B::array_uo),
[will_not_call_mercury, max_stack_size(1), promise_pure],
"
Index: tests/hard_coded/multimode.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/multimode.m,v
retrieving revision 1.3
diff -u -r1.3 multimode.m
--- tests/hard_coded/multimode.m 28 Nov 2002 16:33:44 -0000 1.3
+++ tests/hard_coded/multimode.m 6 Jul 2006 03:49:40 -0000
@@ -86,6 +86,11 @@
impure puts("test2(out, out)").
:- impure pred puts(string::in) is det.
-:- pragma c_code(puts(S::in), [will_not_call_mercury], "puts(S)").
+:- pragma foreign_proc("C",
+ puts(S::in),
+ [will_not_call_mercury],
+"
+ puts(S)
+").
:- pragma foreign_proc("C#", puts(S::in),
[promise_pure], "System.Console.WriteLine(S);").
Index: tests/hard_coded/rnd.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/rnd.m,v
retrieving revision 1.2
diff -u -r1.2 rnd.m
--- tests/hard_coded/rnd.m 28 Nov 2002 16:33:45 -0000 1.2
+++ tests/hard_coded/rnd.m 6 Jul 2006 03:52:46 -0000
@@ -241,12 +241,22 @@
).
:- func rfloat(int) = float.
-:- pragma c_code(rfloat(I::in) = (F::out), "F = I;").
+:- pragma foreign_proc("C",
+ rfloat(I::in) = (F::out),
+ [will_not_call_mercury, promise_pure],
+"
+ F = I;
+").
:- pragma foreign_proc("C#", rfloat(I::in) = (F::out),
[promise_pure], "F = I;").
:- func rint(float) = int.
-:- pragma c_code(rint(F::in) = (I::out), "I = F;").
+:- pragma foreign_proc("C",
+ rint(F::in) = (I::out),
+ [will_not_call_mercury, promise_pure],
+"
+ I = F;
+").
:- pragma foreign_proc("C#", rint(F::in) = (I::out),
[promise_pure], "I = (int) F;").
Index: tests/hard_coded/target_mlobjs.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/target_mlobjs.m,v
retrieving revision 1.2
diff -u -r1.2 target_mlobjs.m
--- tests/hard_coded/target_mlobjs.m 28 Nov 2002 16:33:45 -0000 1.2
+++ tests/hard_coded/target_mlobjs.m 6 Jul 2006 03:50:47 -0000
@@ -9,10 +9,13 @@
main -->
c_write_string("Hello, world\n").
-:- pragma c_header_code("#include ""target_mlobjs_c.h""").
+:- pragma foreign_decl("C", "#include ""target_mlobjs_c.h""").
:- pred c_write_string(string::in, io__state::di, io__state::uo) is det.
-:- pragma c_code(c_write_string(Message::in, IO0::di, IO::uo), "
+:- pragma foreign_proc("C",
+ c_write_string(Message::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
c_write_string(Message);
IO = IO0;
").
Index: tests/hard_coded/purity/impure_func_t1.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/purity/impure_func_t1.m,v
retrieving revision 1.3
diff -u -r1.3 impure_func_t1.m
--- tests/hard_coded/purity/impure_func_t1.m 8 Nov 2002 11:02:58 -0000 1.3
+++ tests/hard_coded/purity/impure_func_t1.m 6 Jul 2006 03:56:17 -0000
@@ -20,7 +20,12 @@
:- impure func get_counter = int is det.
-:- pragma c_header_code("extern MR_Integer counter;").
-:- pragma c_code("MR_Integer counter = 0;").
-:- pragma c_code(get_counter = (X::out), will_not_call_mercury, "X = counter;").
+:- pragma foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C", "MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter = (X::out),
+ [will_not_call_mercury],
+"
+ X = counter;
+").
get_counter = 0.
Index: tests/hard_coded/purity/impure_func_t5_fixed2.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/purity/impure_func_t5_fixed2.m,v
retrieving revision 1.1
diff -u -r1.1 impure_func_t5_fixed2.m
--- tests/hard_coded/purity/impure_func_t5_fixed2.m 27 Jan 2003 09:21:01 -0000 1.1
+++ tests/hard_coded/purity/impure_func_t5_fixed2.m 6 Jul 2006 03:57:51 -0000
@@ -24,8 +24,12 @@
:- impure func get_counter(int) = int is det.
-:- pragma c_header_code("extern Integer counter;").
-:- pragma c_code("Integer counter = 42;").
-:- pragma c_code(get_counter(Y::in) = (X::out), will_not_call_mercury,
- "X = counter + Y; counter++;").
+:- pragma foreign_decl("C", "extern Integer counter;").
+:- pragma foreign_code("C", "Integer counter = 42;").
+:- pragma foreign_proc("C",
+ get_counter(Y::in) = (X::out),
+ [will_not_call_mercury],
+"
+ X = counter + Y; counter++;
+").
get_counter(X) = X.
Index: tests/hard_coded/purity/impure_func_t6.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/purity/impure_func_t6.m,v
retrieving revision 1.3
diff -u -r1.3 impure_func_t6.m
--- tests/hard_coded/purity/impure_func_t6.m 8 Nov 2002 11:02:59 -0000 1.3
+++ tests/hard_coded/purity/impure_func_t6.m 6 Jul 2006 03:59:57 -0000
@@ -23,12 +23,20 @@
:- impure func get_counter(int) = int.
:- impure pred some_pred(int::in, int::out) is det.
-:- pragma c_header_code("extern MR_Integer counter;").
-:- pragma c_code("MR_Integer counter = 0;").
-:- pragma c_code(get_counter(Y::in) = (X::out), will_not_call_mercury,
- "X = counter + Y;").
+:- pragma foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C", "MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter(Y::in) = (X::out),
+ [will_not_call_mercury],
+"
+ X = counter + Y;
+").
get_counter(X) = X.
-:- pragma c_code(some_pred(Y::in, X::out), will_not_call_mercury,
- "X = counter + Y;").
+:- pragma foreign_proc("C",
+ some_pred(Y::in, X::out),
+ [will_not_call_mercury],
+"
+ X = counter + Y;
+").
some_pred(X, X).
Index: tests/hard_coded/purity/impure_pred_t1_fixed3.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/purity/impure_pred_t1_fixed3.m,v
retrieving revision 1.1
diff -u -r1.1 impure_pred_t1_fixed3.m
--- tests/hard_coded/purity/impure_pred_t1_fixed3.m 27 Jan 2003 09:21:01 -0000 1.1
+++ tests/hard_coded/purity/impure_pred_t1_fixed3.m 6 Jul 2006 04:01:37 -0000
@@ -27,7 +27,12 @@
:- 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;").
+:- pragma foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C", "MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter(Y::in, X::out),
+ [will_not_call_mercury],
+"
+ X = counter + Y;
+").
get_counter(X, X).
Index: tests/hard_coded/purity/purity.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/purity/purity.m,v
retrieving revision 1.2
diff -u -r1.2 purity.m
--- tests/hard_coded/purity/purity.m 8 Nov 2002 11:02:59 -0000 1.2
+++ tests/hard_coded/purity/purity.m 7 Jul 2006 07:56:17 -0000
@@ -31,45 +31,99 @@
:- impure pred set_x(int::in) is det.
-:- pragma c_code(set_x(X::in), will_not_call_mercury, "x=X;" ).
-:- pragma foreign_proc("C#", set_x(X::in), will_not_call_mercury, "x=X;" ).
:- pragma no_inline(set_x/1).
+:- pragma foreign_proc("C",
+ set_x(X::in),
+ [will_not_call_mercury],
+"
+ x = X;
+").
+:- pragma foreign_proc("C#",
+ set_x(X::in),
+ [will_not_call_mercury],
+"
+ x = X;
+").
:- impure pred incr_x is det.
-:- pragma c_code(incr_x, will_not_call_mercury, "++x;" ).
-:- pragma foreign_proc("C#", incr_x, will_not_call_mercury, "++x;" ).
:- pragma no_inline(incr_x/0).
+:- pragma foreign_proc("C",
+ incr_x,
+ [will_not_call_mercury],
+"
+ ++x;
+").
+:- pragma foreign_proc("C#",
+ incr_x,
+ [will_not_call_mercury],
+"
+ ++x;
+").
:- semipure pred get_x(int::out) is det.
-:- pragma promise_semipure(get_x/1).
-:- pragma c_code(get_x(X::out), will_not_call_mercury, "X=x;").
-:- pragma foreign_proc("C#", get_x(X::out), will_not_call_mercury, "X=x;").
:- pragma no_inline(get_x/1).
-
+:- pragma foreign_proc("C",
+ get_x(X::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ X = x;
+").
+:- pragma foreign_proc("C#",
+ get_x(X::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ X = x;
+").
:- impure pred set_x_inline(int::in) is det.
-:- pragma c_code(set_x_inline(X::in), will_not_call_mercury, "x=X;" ).
-:- pragma foreign_proc("C#", set_x_inline(X::in),
- will_not_call_mercury, "x=X;" ).
:- pragma inline(set_x_inline/1).
+:- pragma foreign_proc("C",
+ set_x_inline(X::in),
+ [will_not_call_mercury],
+"
+ x = X;
+").
+:- pragma foreign_proc("C#",
+ set_x_inline(X::in),
+ [will_not_call_mercury],
+"
+ x = X;
+").
:- impure pred incr_x_inline is det.
-:- pragma c_code(incr_x_inline, will_not_call_mercury, "++x;" ).
-:- pragma foreign_proc("C#", incr_x_inline, will_not_call_mercury, "++x;" ).
:- pragma inline(incr_x_inline/0).
+:- pragma foreign_proc("C",
+ incr_x_inline,
+ [will_not_call_mercury],
+"
+ ++x;
+").
+:- pragma foreign_proc("C#",
+ incr_x_inline,
+ [will_not_call_mercury],
+"
+ ++x;
+").
:- semipure pred get_x_inline(int::out) is det.
-:- pragma promise_semipure(get_x_inline/1).
-:- pragma c_code(get_x_inline(X::out), will_not_call_mercury, "X=x;").
-:- pragma foreign_proc("C#", get_x_inline(X::out),
- will_not_call_mercury, "X=x;").
:- pragma inline(get_x_inline/1).
+:- pragma foreign_proc("C",
+ get_x_inline(X::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ X=x;
+").
+:- pragma foreign_proc("C#",
+ get_x_inline(X::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ X=x;
+").
-:- pragma c_header_code("int x = 0;").
-:- pragma foreign_code("C#", "
-static int x = 0;
-").
+:- pragma foreign_decl("C", "extern int x;").
+:- pragma foreign_code("C", "int x = 0;").
+:- pragma foreign_code("C#", "static int x = 0;").
% tempt compiler to optimize away duplicate semipure goals.
Index: tests/hard_coded/typeclasses/impure_methods.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/typeclasses/impure_methods.m,v
retrieving revision 1.4
diff -u -r1.4 impure_methods.m
--- tests/hard_coded/typeclasses/impure_methods.m 12 Apr 2005 07:58:17 -0000 1.4
+++ tests/hard_coded/typeclasses/impure_methods.m 6 Jul 2006 03:55:09 -0000
@@ -53,10 +53,20 @@
io__write_int(Y),
io__nl.
-:- pragma c_header_code("int foo_counter = 0;").
-
-:- pragma c_code(foo_m1(_F::in), "foo_counter++;").
-:- pragma c_code(foo_m2(_F::in, Val::out), "Val = foo_counter;").
+:- pragma foreign_decl("C", "extern int foo_counter;").
+:- pragma foreign_code("C", "int foo_counter = 0;").
+:- pragma foreign_proc("C",
+ foo_m1(_F::in),
+ [will_not_call_mercury],
+"
+ foo_counter++;
+").
+:- pragma foreign_proc("C",
+ foo_m2(_F::in, Val::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ Val = foo_counter;
+").
:- pragma foreign_code("C#", "static int foo_counter = 0;").
Index: tests/invalid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/Mmakefile,v
retrieving revision 1.193
diff -u -r1.193 Mmakefile
--- tests/invalid/Mmakefile 16 Jun 2006 07:24:41 -0000 1.193
+++ tests/invalid/Mmakefile 5 Jul 2006 05:49:22 -0000
@@ -80,6 +80,7 @@
ext_type \
ext_type_bug \
field_syntax_error \
+ foreign_purity_mismatch \
foreign_singleton \
foreign_type_2 \
foreign_type_visibility \
Index: tests/invalid/foreign_purity_mismatch.err_exp
===================================================================
RCS file: tests/invalid/foreign_purity_mismatch.err_exp
diff -N tests/invalid/foreign_purity_mismatch.err_exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/foreign_purity_mismatch.err_exp 5 Jul 2006 05:46:26 -0000
@@ -0,0 +1,38 @@
+foreign_purity_mismatch.m:020: Error: foreign clause for predicate
+foreign_purity_mismatch.m:020: `foreign_purity_mismatch.pure_with_impure'/1
+foreign_purity_mismatch.m:020: has purity impure but that predicate has been
+foreign_purity_mismatch.m:020: declared pure.
+foreign_purity_mismatch.m:027: Error: foreign clause for predicate
+foreign_purity_mismatch.m:027: `foreign_purity_mismatch.pure_with_semipure'/1
+foreign_purity_mismatch.m:027: has purity semipure but that predicate has
+foreign_purity_mismatch.m:027: been declared pure.
+foreign_purity_mismatch.m:034: Error: foreign clause for predicate
+foreign_purity_mismatch.m:034: `foreign_purity_mismatch.semipure_with_impure'/1
+foreign_purity_mismatch.m:034: has purity impure but that predicate has been
+foreign_purity_mismatch.m:034: declared semipure.
+foreign_purity_mismatch.m:041: Error: foreign clause for predicate
+foreign_purity_mismatch.m:041: `foreign_purity_mismatch.semipure_with_pure'/1
+foreign_purity_mismatch.m:041: has purity pure but that predicate has been
+foreign_purity_mismatch.m:041: declared semipure.
+foreign_purity_mismatch.m:048: Error: foreign clause for predicate
+foreign_purity_mismatch.m:048: `foreign_purity_mismatch.impure_with_pure'/1
+foreign_purity_mismatch.m:048: has purity pure but that predicate has been
+foreign_purity_mismatch.m:048: declared impure.
+foreign_purity_mismatch.m:055: Error: foreign clause for predicate
+foreign_purity_mismatch.m:055: `foreign_purity_mismatch.impure_with_semipure'/1
+foreign_purity_mismatch.m:055: has purity semipure but that predicate has
+foreign_purity_mismatch.m:055: been declared impure.
+foreign_purity_mismatch.m:006: In predicate
+foreign_purity_mismatch.m:006: `foreign_purity_mismatch.pure_with_impure/1':
+foreign_purity_mismatch.m:006: purity error: predicate is impure.
+foreign_purity_mismatch.m:006: It must be declared `impure' or promised pure.
+foreign_purity_mismatch.m:007: In predicate
+foreign_purity_mismatch.m:007: `foreign_purity_mismatch.pure_with_semipure/1':
+foreign_purity_mismatch.m:007: purity error: predicate is semipure.
+foreign_purity_mismatch.m:007: It must be declared `semipure' or promised
+foreign_purity_mismatch.m:007: pure.
+foreign_purity_mismatch.m:009: In predicate
+foreign_purity_mismatch.m:009: `foreign_purity_mismatch.semipure_with_impure/1':
+foreign_purity_mismatch.m:009: purity error: predicate is impure.
+foreign_purity_mismatch.m:009: It must be declared `impure' or promised
+foreign_purity_mismatch.m:009: semipure.
Index: tests/invalid/foreign_purity_mismatch.m
===================================================================
RCS file: tests/invalid/foreign_purity_mismatch.m
diff -N tests/invalid/foreign_purity_mismatch.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/invalid/foreign_purity_mismatch.m 5 Jul 2006 05:46:26 -0000
@@ -0,0 +1,60 @@
+:- module foreign_purity_mismatch.
+:- interface.
+
+:- import_module string.
+
+:- pred pure_with_impure(string::in) is det.
+:- pred pure_with_semipure(string::in) is det.
+
+:- semipure pred semipure_with_impure(string::in) is det.
+:- semipure pred semipure_with_pure(string::in) is det.
+
+ % This one was particularly bad since the compiler was
+ % optimising away the foreign_proc goal(!).
+ %
+:- impure pred impure_with_pure(string::in) is det.
+:- impure pred impure_with_semipure(string::in) is det.
+
+:- implementation.
+
+:- pragma foreign_proc("C",
+ pure_with_impure(S::in),
+ [will_not_call_mercury],
+"
+ /* S */
+").
+
+:- pragma foreign_proc("C",
+ pure_with_semipure(S::in),
+ [will_not_call_mercury, promise_semipure],
+"
+ /* S */
+").
+
+:- pragma foreign_proc("C",
+ semipure_with_impure(S::in),
+ [will_not_call_mercury],
+"
+ /* S */
+").
+
+:- pragma foreign_proc("C",
+ semipure_with_pure(S::in),
+ [will_not_call_mercury, promise_pure],
+"
+ /* S */
+").
+
+:- pragma foreign_proc("C",
+ impure_with_pure(S::in),
+ [will_not_call_mercury, promise_pure],
+"
+ /* S */
+").
+
+:- pragma foreign_proc("C",
+ impure_with_semipure(S::in),
+ [will_not_call_mercury, promise_semipure],
+"
+ /* S */
+").
Index: tests/invalid/impure_method_impl.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/impure_method_impl.m,v
retrieving revision 1.3
diff -u -r1.3 impure_method_impl.m
--- tests/invalid/impure_method_impl.m 12 Apr 2005 07:58:19 -0000 1.3
+++ tests/invalid/impure_method_impl.m 6 Jul 2006 08:26:07 -0000
@@ -25,9 +25,20 @@
main -->
[].
-:- pragma c_header_code("int foo_counter = 0;").
+:- pragma foreign_decl("C", "extern int foo_counter;").
+:- pragma foreign_code("C", "int foo_counter = 0;").
-:- pragma c_code(foo_m1(_F::in, Val::out), "Val = foo_counter;").
-:- pragma c_code(foo_m2(_F::in, Val::out), "Val = foo_counter++;").
+:- pragma foreign_proc("C",
+ foo_m1(_F::in, Val::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ Val = foo_counter;
+").
+:- pragma foreign_proc("C",
+ foo_m2(_F::in, Val::out),
+ [will_not_call_mercury],
+"
+ Val = foo_counter++;"
+).
foo_m1(_, 0).
foo_m2(_, 0).
Index: tests/invalid/multimode_syntax.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/multimode_syntax.m,v
retrieving revision 1.2
diff -u -r1.2 multimode_syntax.m
--- tests/invalid/multimode_syntax.m 7 Nov 2002 16:17:08 -0000 1.2
+++ tests/invalid/multimode_syntax.m 7 Jul 2006 14:54:59 -0000
@@ -52,5 +52,10 @@
impure puts("test2(out, out)").
:- impure pred puts(string::in) is det.
-:- pragma c_code(puts(S::in), [will_not_call_mercury], "puts(S)").
+:- pragma foreign_proc("C",
+ puts(S::in),
+ [will_not_call_mercury],
+"
+ puts(S);
+").
puts(_).
Index: tests/invalid/pragma_c_code_no_det.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/pragma_c_code_no_det.m,v
retrieving revision 1.2
diff -u -r1.2 pragma_c_code_no_det.m
--- tests/invalid/pragma_c_code_no_det.m 7 Nov 2002 16:17:09 -0000 1.2
+++ tests/invalid/pragma_c_code_no_det.m 7 Jul 2006 14:56:21 -0000
@@ -10,4 +10,9 @@
c_code(Int).
:- pred c_code(int::out).
-:- pragma c_code(c_code(X::out), "X = 1").
+:- pragma foreign_proc("C",
+ c_code(X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = 1
+").
Index: tests/invalid/purity/impure_func_t2.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/impure_func_t2.m,v
retrieving revision 1.2
diff -u -r1.2 impure_func_t2.m
--- tests/invalid/purity/impure_func_t2.m 7 Nov 2002 16:17:09 -0000 1.2
+++ tests/invalid/purity/impure_func_t2.m 7 Jul 2006 04:05:42 -0000
@@ -20,7 +20,11 @@
:- 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;").
+:- pragma foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C", "MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter = (X::out), [will_not_call_mercury],
+"
+ X = counter;
+").
get_counter = 0.
Index: tests/invalid/purity/impure_func_t3.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/impure_func_t3.m,v
retrieving revision 1.2
diff -u -r1.2 impure_func_t3.m
--- tests/invalid/purity/impure_func_t3.m 7 Nov 2002 16:17:09 -0000 1.2
+++ tests/invalid/purity/impure_func_t3.m 7 Jul 2006 04:52:05 -0000
@@ -19,8 +19,13 @@
:- 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;").
+:- pragma foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C" ,"MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter = (X::out),
+ [will_not_call_mercury],
+"
+ X = counter;
+").
get_counter = 0.
Index: tests/invalid/purity/impure_func_t4.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/impure_func_t4.m,v
retrieving revision 1.2
diff -u -r1.2 impure_func_t4.m
--- tests/invalid/purity/impure_func_t4.m 7 Nov 2002 16:17:09 -0000 1.2
+++ tests/invalid/purity/impure_func_t4.m 7 Jul 2006 14:56:55 -0000
@@ -20,7 +20,12 @@
:- 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;").
+:- pragma foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C", "MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter = (X::out),
+ [will_not_call_mercury, promise_semipure],
+"
+ X = counter;
+").
get_counter = 0.
Index: tests/invalid/purity/impure_func_t5.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/impure_func_t5.m,v
retrieving revision 1.2
diff -u -r1.2 impure_func_t5.m
--- tests/invalid/purity/impure_func_t5.m 7 Nov 2002 16:17:09 -0000 1.2
+++ tests/invalid/purity/impure_func_t5.m 7 Jul 2006 07:13:10 -0000
@@ -23,7 +23,12 @@
:- 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;").
+:- pragma foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C", "MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter(Y::in) = (X::out),
+ [will_not_call_mercury],
+"
+ X = counter + Y;
+").
get_counter(X) = X.
Index: tests/invalid/purity/impure_func_t5_fixed.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/impure_func_t5_fixed.m,v
retrieving revision 1.1
diff -u -r1.1 impure_func_t5_fixed.m
--- tests/invalid/purity/impure_func_t5_fixed.m 27 Jan 2003 09:21:03 -0000 1.1
+++ tests/invalid/purity/impure_func_t5_fixed.m 7 Jul 2006 07:14:18 -0000
@@ -25,7 +25,13 @@
:- 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;").
+:- pragma foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C", "MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter(Y::in) = (X::out),
+ [will_not_call_mercury],
+"
+ X = counter + Y;
+").
+
get_counter(X) = X.
Index: tests/invalid/purity/impure_func_t7.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/impure_func_t7.m,v
retrieving revision 1.4
diff -u -r1.4 impure_func_t7.m
--- tests/invalid/purity/impure_func_t7.m 14 Dec 2005 05:14:17 -0000 1.4
+++ tests/invalid/purity/impure_func_t7.m 7 Jul 2006 07:18:09 -0000
@@ -58,12 +58,20 @@
:- 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 foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C", "MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter(Y::in) = (X::out),
+ [will_not_call_mercury],
+"
+ X = counter + Y;
+").
get_counter(X) = X.
-:- pragma c_code(some_pred(Y::in, X::out), will_not_call_mercury,
- "X = counter + Y;").
+:- pragma foreign_proc("C",
+ some_pred(Y::in, X::out),
+ [will_not_call_mercury],
+"
+ X = counter + Y;
+").
some_pred(X, X).
Index: tests/invalid/purity/impure_pred_t1.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/impure_pred_t1.m,v
retrieving revision 1.2
diff -u -r1.2 impure_pred_t1.m
--- tests/invalid/purity/impure_pred_t1.m 7 Nov 2002 16:17:09 -0000 1.2
+++ tests/invalid/purity/impure_pred_t1.m 7 Jul 2006 07:21:05 -0000
@@ -26,7 +26,12 @@
:- 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;").
+:- pragma foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C", "MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter(Y::in, X::out),
+ [will_not_call_mercury],
+"
+ X = counter + Y;
+").
get_counter(X, X).
Index: tests/invalid/purity/impure_pred_t1_fixed.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/impure_pred_t1_fixed.m,v
retrieving revision 1.1
diff -u -r1.1 impure_pred_t1_fixed.m
--- tests/invalid/purity/impure_pred_t1_fixed.m 27 Jan 2003 09:21:03 -0000 1.1
+++ tests/invalid/purity/impure_pred_t1_fixed.m 7 Jul 2006 07:22:14 -0000
@@ -26,7 +26,12 @@
:- 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;").
+:- pragma foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C", "MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter(Y::in, X::out),
+ [will_not_call_mercury],
+"
+ X = counter + Y;
+").
get_counter(X, X).
Index: tests/invalid/purity/impure_pred_t2.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/impure_pred_t2.m,v
retrieving revision 1.2
diff -u -r1.2 impure_pred_t2.m
--- tests/invalid/purity/impure_pred_t2.m 7 Nov 2002 16:17:09 -0000 1.2
+++ tests/invalid/purity/impure_pred_t2.m 7 Jul 2006 07:48:02 -0000
@@ -23,7 +23,12 @@
:- 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;").
+:- pragma foreign_decl("C", "extern MR_Integer counter;").
+:- pragma foreign_code("C", "MR_Integer counter = 0;").
+:- pragma foreign_proc("C",
+ get_counter(Y::in, X::out),
+ [will_not_call_mercury],
+"
+ X = counter + Y;
+").
get_counter(X, X).
Index: tests/invalid/purity/purity.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/purity.err_exp,v
retrieving revision 1.11
diff -u -r1.11 purity.err_exp
--- tests/invalid/purity/purity.err_exp 14 Jun 2006 08:15:00 -0000 1.11
+++ tests/invalid/purity/purity.err_exp 7 Jul 2006 15:08:15 -0000
@@ -1,52 +1,52 @@
-purity.m:035: In predicate `purity.w1/0':
-purity.m:035: warning: declared impure but actually pure.
-purity.m:039: In predicate `purity.w2/0':
-purity.m:039: warning: declared semipure but actually pure.
-purity.m:043: In predicate `purity.w3/0':
-purity.m:043: warning: declared impure but actually semipure.
-purity.m:047: In predicate `purity.w4/0':
-purity.m:047: warning: unnecessary `promise_pure' pragma.
-purity.m:052: In predicate `purity.w5/0':
-purity.m:052: warning: declared impure but promised pure.
-purity.m:057: In predicate `purity.w6/0':
-purity.m:057: warning: declared semipure but promised pure.
-purity.m:066: In predicate `purity.e1/0':
-purity.m:066: purity error: predicate is impure.
-purity.m:066: It must be declared `impure' or promised pure.
-purity.m:071: In predicate `purity.e2/0':
-purity.m:071: purity error: predicate is semipure.
-purity.m:071: It must be declared `semipure' or promised pure.
-purity.m:075: In predicate `purity.e3/0':
-purity.m:075: purity error: predicate is impure.
-purity.m:075: It must be declared `impure' or promised semipure.
-purity.m:081: In call to impure predicate `purity.imp/0':
-purity.m:081: purity error: call must be preceded by `impure' indicator.
-purity.m:085: In call to semipure predicate `purity.semi/0':
-purity.m:085: purity error: call must be preceded by `semipure' indicator.
-purity.m:119: In call to impure predicate `purity.imp1/1':
-purity.m:119: purity error: call must be preceded by `impure' indicator.
-purity.m:119: Purity error in closure: closure body is impure, but closure was
-purity.m:119: not declared impure.
-purity.m:125: In call to semipure predicate `purity.semi/1':
-purity.m:125: purity error: call must be preceded by `semipure' indicator.
-purity.m:125: Purity error in closure: closure body is semipure, but closure
-purity.m:125: was not declared semipure.
-purity.m:100: In unification predicate for type `purity.e8':
-purity.m:100: purity error: predicate is impure.
-purity.m:100: It must be pure.
-purity.m:108: In unification predicate for type `purity.e9':
-purity.m:108: purity error: predicate is semipure.
-purity.m:108: It must be pure.
-purity.m:090: In clause for `e6':
-purity.m:090: in argument 1 of call to predicate `purity.in/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, becaise it was followed by an
-purity.m:090: impure goal.
-purity.m:091: This is the location of the impure goal.
-purity.m:097: In clause for `e7':
-purity.m:097: in argument 1 of call to predicate `purity.imp1/1':
-purity.m:097: mode error: variable `X' has instantiatedness `free',
-purity.m:097: expected instantiatedness was `ground'.
-purity.m:097: The goal could not be reordered, because it was impure.
+purity.m:050: In predicate `purity.w1/0':
+purity.m:050: warning: declared impure but actually pure.
+purity.m:054: In predicate `purity.w2/0':
+purity.m:054: warning: declared semipure but actually pure.
+purity.m:058: In predicate `purity.w3/0':
+purity.m:058: warning: declared impure but actually semipure.
+purity.m:062: In predicate `purity.w4/0':
+purity.m:062: warning: unnecessary `promise_pure' pragma.
+purity.m:067: In predicate `purity.w5/0':
+purity.m:067: error: declared impure but promised pure.
+purity.m:072: In predicate `purity.w6/0':
+purity.m:072: error: declared semipure but promised pure.
+purity.m:081: In predicate `purity.e1/0':
+purity.m:081: purity error: predicate is impure.
+purity.m:081: It must be declared `impure' or promised pure.
+purity.m:086: In predicate `purity.e2/0':
+purity.m:086: purity error: predicate is semipure.
+purity.m:086: It must be declared `semipure' or promised pure.
+purity.m:090: In predicate `purity.e3/0':
+purity.m:090: purity error: predicate is impure.
+purity.m:090: It must be declared `impure' or promised semipure.
+purity.m:096: In call to impure predicate `purity.imp/0':
+purity.m:096: purity error: call must be preceded by `impure' indicator.
+purity.m:100: In call to semipure predicate `purity.semi/0':
+purity.m:100: purity error: call must be preceded by `semipure' indicator.
+purity.m:142: In call to impure predicate `purity.imp1/1':
+purity.m:142: purity error: call must be preceded by `impure' indicator.
+purity.m:142: Purity error in closure: closure body is impure, but closure was
+purity.m:142: not declared impure.
+purity.m:148: In call to semipure predicate `purity.semi/1':
+purity.m:148: purity error: call must be preceded by `semipure' indicator.
+purity.m:148: Purity error in closure: closure body is semipure, but closure
+purity.m:148: was not declared semipure.
+purity.m:115: In unification predicate for type `purity.e8':
+purity.m:115: purity error: predicate is impure.
+purity.m:115: It must be pure.
+purity.m:127: In unification predicate for type `purity.e9':
+purity.m:127: purity error: predicate is semipure.
+purity.m:127: It must be pure.
+purity.m:105: In clause for `e6':
+purity.m:105: in argument 1 of call to predicate `purity.in/1':
+purity.m:105: mode error: variable `X' has instantiatedness `free',
+purity.m:105: expected instantiatedness was `ground'.
+purity.m:105: The goal could not be reordered, because it was followed by an
+purity.m:105: impure goal.
+purity.m:106: This is the location of the impure goal.
+purity.m:112: In clause for `e7':
+purity.m:112: in argument 1 of call to predicate `purity.imp1/1':
+purity.m:112: mode error: variable `X' has instantiatedness `free',
+purity.m:112: expected instantiatedness was `ground'.
+purity.m:112: The goal could not be reordered, because it was impure.
For more information, recompile with `-E'.
Index: tests/invalid/purity/purity.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/purity.m,v
retrieving revision 1.3
diff -u -r1.3 purity.m
--- tests/invalid/purity/purity.m 14 Jul 2004 05:39:13 -0000 1.3
+++ tests/invalid/purity/purity.m 7 Jul 2006 14:58:48 -0000
@@ -6,10 +6,20 @@
:- implementation.
:- impure pred imp is det.
-:- pragma c_code(imp, will_not_call_mercury, ";").
+:- pragma foreign_proc("C",
+ imp,
+ [will_not_call_mercury],
+"
+ ;
+").
:- semipure pred semi is semidet.
-:- pragma c_code(semi, will_not_call_mercury, "SUCCESS_INDICATOR=0;").
+:- pragma foreign_proc("C",
+ semi,
+ [promise_semipure, will_not_call_mercury],
+"
+ SUCCESS_INDICATOR = 0;
+").
:- pred in(foo).
:- mode in(in) is semidet.
@@ -21,12 +31,17 @@
[will_not_call_mercury, promise_semipure],
"
/* X */
- SUCCESS_INDICATOR=0;
+ SUCCESS_INDICATOR = 0;
").
:- impure pred imp1(foo).
:- mode imp1(in) is semidet.
-:- pragma c_code(imp1(_X::in), will_not_call_mercury, "SUCCESS_INDICATOR=0;").
+:- pragma foreign_proc("C",
+ imp1(_X::in),
+ [will_not_call_mercury],
+"
+ SUCCESS_INDICATOR = 0;
+").
%----------------------------------------------------------------
% Warnings
@@ -102,16 +117,24 @@
:- 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;").
+:- pragma foreign_proc("C",
+ 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;").
+:- pragma foreign_proc("C",
+ semi2(_X::in, _Y::in),
+ [promise_semipure, will_not_call_mercury],
+"
+ SUCCESS_INDICATOR = 0;
+").
:- pred e10 is semidet.
@@ -125,7 +148,6 @@
Goal2 = (pred(X::in) is semidet :- semi(X)),
call(Goal2, b).
-:- import_module std_util.
imp.
semi :- semidet_fail.
imp1(_) :- semidet_fail.
Index: tests/valid/intermod_impure2.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/intermod_impure2.m,v
retrieving revision 1.2
diff -u -r1.2 intermod_impure2.m
--- tests/valid/intermod_impure2.m 7 Nov 2002 12:52:58 -0000 1.2
+++ tests/valid/intermod_impure2.m 6 Jul 2006 03:15:31 -0000
@@ -12,15 +12,14 @@
:- impure pred intermod_impure_2(int::out) is det.
-:- pragma c_header_code(
-"
-#include <stdio.h>
-").
+:- pragma foreign_decl("C", "#include <stdio.h>").
-:- pragma c_code(intermod_impure_2(Int::out), will_not_call_mercury,
+:- pragma foreign_proc("C",
+ intermod_impure_2(Int::out),
+ [will_not_call_mercury],
"
-printf(""Output from impure predicate\\n"");
-Int = 2;
+ printf(""Output from impure predicate\\n"");
+ Int = 2;
").
:- pragma foreign_proc(il, intermod_impure_2(Int::out),
[will_not_call_mercury, max_stack_size(1)],
Index: tests/valid/subtype_switch.m
===================================================================
RCS file: /home/mercury1/repository/tests/valid/subtype_switch.m,v
retrieving revision 1.6
diff -u -r1.6 subtype_switch.m
--- tests/valid/subtype_switch.m 25 Aug 2004 08:21:32 -0000 1.6
+++ tests/valid/subtype_switch.m 6 Jul 2006 03:24:43 -0000
@@ -69,7 +69,10 @@
:- pred get_thingy_counter(int::out, io__state::di, io__state::uo) is det.
-:- pragma c_code(get_thingy_counter(Int::out, IO0::di, IO::uo), "
+:- pragma foreign_proc("C",
+ get_thingy_counter(Int::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
Int = tk_direct_thingy_counter;
IO = IO0;
").
@@ -77,7 +80,10 @@
:- pred set_thingy_counter(int::in, io__state::di, io__state::uo) is det.
-:- pragma c_code(set_thingy_counter(Int::in, IO0::di, IO::uo), "
+:- pragma foreign_proc("C",
+ set_thingy_counter(Int::in, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
tk_direct_thingy_counter = Int;
IO = IO0;
").
Index: tests/warnings/purity_warnings.m
===================================================================
RCS file: /home/mercury1/repository/tests/warnings/purity_warnings.m,v
retrieving revision 1.4
diff -u -r1.4 purity_warnings.m
--- tests/warnings/purity_warnings.m 22 Nov 2005 07:55:38 -0000 1.4
+++ tests/warnings/purity_warnings.m 6 Jul 2006 04:49:30 -0000
@@ -80,17 +80,17 @@
").
:- impure pred set_x(int::in) is det.
-:- pragma c_code(set_x(X::in), will_not_call_mercury, "x=X;" ).
-:- pragma foreign_proc("C#", set_x(X::in), will_not_call_mercury, "x=X;" ).
-:- pragma foreign_proc("Java", set_x(X::in), will_not_call_mercury, "x=X;" ).
+:- pragma foreign_proc("C", set_x(X::in), [will_not_call_mercury], "x=X;" ).
+:- pragma foreign_proc("C#", set_x(X::in), [will_not_call_mercury], "x=X;" ).
+:- pragma foreign_proc("Java", set_x(X::in), [will_not_call_mercury], "x=X;" ).
:- impure pred incr_x is det.
-:- pragma c_code(incr_x, will_not_call_mercury, "++x;" ).
-:- pragma foreign_proc("C#", incr_x, will_not_call_mercury, "++x;" ).
-:- pragma foreign_proc("Java", incr_x, will_not_call_mercury, "++x;" ).
+:- pragma foreign_proc("C", incr_x, [will_not_call_mercury], "++x;" ).
+:- pragma foreign_proc("C#", incr_x, [will_not_call_mercury], "++x;" ).
+:- pragma foreign_proc("Java", incr_x, [will_not_call_mercury], "++x;" ).
:- semipure pred get_x(int::out) is det.
:- pragma promise_semipure(get_x/1).
-:- pragma c_code(get_x(X::out), will_not_call_mercury, "X=x;").
-:- pragma foreign_proc("C#", get_x(X::out), will_not_call_mercury, "X=x;").
-:- pragma foreign_proc("Java", get_x(X::out), will_not_call_mercury, "X=x;").
+:- pragma foreign_proc("C", get_x(X::out), [will_not_call_mercury], "X=x;").
+:- pragma foreign_proc("C#", get_x(X::out), [will_not_call_mercury], "X=x;").
+:- pragma foreign_proc("Java", get_x(X::out), [will_not_call_mercury], "X=x;").
Julien.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list