[m-rev.] for review: emit errors about purity mismatches with foreign clauses

Julien Fischer juliensf at csse.unimelb.edu.au
Wed Jul 5 17:54:08 AEST 2006


For review by anyone.

Estimated hours taken: 4
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.

library/private_builtin.m:
library/solutions.m:
	Delete bogus purity promises from foreign_proc attributes reported by
	the new error.

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.

Julien.

Index: compiler/add_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_pragma.m,v
retrieving revision 1.35
diff -u -r1.35 add_pragma.m
--- compiler/add_pragma.m	15 Jun 2006 19:36:57 -0000	1.35
+++ compiler/add_pragma.m	5 Jul 2006 07:15:37 -0000
@@ -1422,11 +1422,12 @@
     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,
         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 +1574,11 @@
                 pred_info_clauses_info(!.PredInfo, Clauses0),
                 pred_info_get_arg_types(!.PredInfo, ArgTypes),
                 pred_info_get_purity(!.PredInfo, Purity),
+                pred_info_get_markers(!.PredInfo, Markers),
                 clauses_info_add_pragma_foreign_proc(Purity, Attributes,
                     PredId, ProcId, ProgVarSet, PVars, ArgTypes, PragmaImpl,
-                    Context, PredOrFunc, PredName, Arity, Clauses0, Clauses,
-                    !ModuleInfo, !IO),
+                    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),
@@ -2364,12 +2366,13 @@
     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) :-
+        PredName, Arity, Markers, !ClausesInfo, !ModuleInfo, !IO) :-

     !.ClausesInfo = clauses_info(VarSet0, ExplicitVarTypes, TVarNameMap,
         InferredVarTypes, HeadVars, ClauseRep, RttiVarMaps,
@@ -2434,7 +2437,43 @@
         % Build the foreign_proc.
         goal_info_init(GoalInfo0),
         goal_info_set_context(Context, GoalInfo0, GoalInfo1),
+        %
+        % Check that the purity of the predicate/function declaration agrees
+        % with the (promised) purity of the foreign_proc.  It is only okay for
+        % them to disagree if there is a `:- pragma promise_pure' or
+        % `:- pramga promise_semipure' declaration for the predicate or
+        % function.
+        %
+        (
+            ( check_marker(Markers, promised_pure)
+            ; check_marker(Markers, promised_semipure)
+            )
+        ->
+            true
+        ;
+            ForeignAttributePurity = purity(Attributes),
+            (
+                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),
         HldsGoal0 = foreign_proc(Attributes, PredId, ProcId, ForeignArgs, [],
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.105
diff -u -r1.105 prog_io_pragma.m
--- compiler/prog_io_pragma.m	15 Jun 2006 19:37:10 -0000	1.105
+++ compiler/prog_io_pragma.m	5 Jul 2006 06:15:28 -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/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/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 */
+").

--------------------------------------------------------------------------
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