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

[Ian MacLarty]

On Wed, Jul 05, 2006 at 05:54:08PM +1000, Julien Fischer wrote:
> 
> 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.
> 

What happens if the predicate is declared impure, but there is a pragma
promise_pure on the predicate?  Is that allowed?  If so what does it
mean?

> 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.
> +        %

Could you explain why it's okay for them to disagree in this case?  In
fact I did a test and the compiler issues a warning if the pred is
declared impure, but there is a pragma promise_pure.  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\");
").

> +        (
> +            ( 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 */
> +").
> 

Otherwise that looks fine.

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