[m-rev.] For review: more fixes to impurity

Ralph Becket rafe at cs.mu.OZ.AU
Fri Nov 18 11:43:56 AEDT 2005


Estimated hours taken: 2
Branches: main

Remove now incorrect errors of the form "unification with expression was
declared impure, but expression was not a function call."

compiler/purity.m:
	Prevent purity.m from reporting unifications marked with
	impure as errors: unifications *can* be impure if they
	unify two inst any variables in a negated context.  Purity
	error reporting for unifications is now handled in modecheck_unify.m.

compiler/field_access.m:
compiler/superhomogeneous.m:
	Include unification impurity annotations in the corresponding goal
	infos, rather than discarding them or reporting an error.

tests/invalid/purity/impure_func_t7.err_exp:
tests/invalid/purity/impure_func_t7.m:
	Break the test cases into separate predicates.
	Update the expected error output.

Index: compiler/field_access.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/field_access.m,v
retrieving revision 1.3
diff -u -r1.3 field_access.m
--- compiler/field_access.m	28 Oct 2005 02:10:05 -0000	1.3
+++ compiler/field_access.m	17 Nov 2005 06:48:33 -0000
@@ -75,7 +75,7 @@
     %
 :- pred expand_get_field_function_call(prog_context::in,
     unify_main_context::in, unify_sub_contexts::in, field_list::in,
-    prog_var::in, prog_var::in, prog_varset::in, prog_varset::out,
+    prog_var::in, prog_var::in, purity::in, prog_varset::in, prog_varset::out,
     cons_id::out, pair(cons_id, unify_sub_contexts)::out, hlds_goal::out,
     module_info::in, module_info::out, qual_info::in, qual_info::out,
     svar_info::in, svar_info::out, io::di, io::uo) is det.
@@ -130,12 +130,12 @@
             [TermInputVar, SubTermOutputVar]),
         construct_field_access_function_call(set, Context,
             MainContext, SubContext0, FieldName, TermOutputVar,
-            SetArgs, Functor, UpdateGoal, !QualInfo),
+            SetArgs, purity_pure, Functor, UpdateGoal, !QualInfo),
 
         % Extract the field containing the field to update.
         construct_field_access_function_call(get, Context,
             MainContext, SubContext0, FieldName, SubTermInputVar,
-            list__append(FieldArgVars, [TermInputVar]), _,
+            list__append(FieldArgVars, [TermInputVar]), purity_pure, _,
             GetSubFieldGoal, !QualInfo),
 
         % Recursively update the field.
@@ -153,7 +153,7 @@
         SetArgs = list__append(FieldArgVars, [TermInputVar, FieldValueVar]),
         construct_field_access_function_call(set, Context,
             MainContext, SubContext0, FieldName, TermOutputVar,
-            SetArgs, Functor, Goal, !QualInfo),
+            SetArgs, purity_pure, Functor, Goal, !QualInfo),
         FieldSubContext = Functor - SubContext0,
         Goals1 = [Goal]
 
@@ -174,34 +174,34 @@
 
     % Process the access function as a get function on the output DCG variable.
     expand_get_field_function_call_2(Context, MainContext, SubContext,
-        FieldNames, FieldValueVar, TermOutputVar, !VarSet,
+        FieldNames, FieldValueVar, TermOutputVar, purity_pure, !VarSet,
         Functor, FieldSubContext, Goals1, !ModuleInfo, !QualInfo, !SInfo, !IO),
     Goals = [UnifyDCG | Goals1],
     goal_info_init(Context, GoalInfo),
     conj_list_to_goal(Goals, GoalInfo, Goal).
 
 expand_get_field_function_call(Context, MainContext, SubContext0,
-        FieldNames, FieldValueVar, TermInputVar, !VarSet,
+        FieldNames, FieldValueVar, TermInputVar, Purity, !VarSet,
         Functor, FieldSubContext, Goal, !ModuleInfo, !QualInfo, !SInfo, !IO) :-
     expand_get_field_function_call_2(Context, MainContext, SubContext0,
-        FieldNames, FieldValueVar, TermInputVar, !VarSet,
+        FieldNames, FieldValueVar, TermInputVar, Purity, !VarSet,
         Functor, FieldSubContext, Goals, !ModuleInfo, !QualInfo, !SInfo, !IO),
     goal_info_init(Context, GoalInfo),
     conj_list_to_goal(Goals, GoalInfo, Goal).
 
 :- pred expand_get_field_function_call_2(prog_context::in,
     unify_main_context::in, unify_sub_contexts::in, field_list::in,
-    prog_var::in, prog_var::in, prog_varset::in, prog_varset::out,
+    prog_var::in, prog_var::in, purity::in, prog_varset::in, prog_varset::out,
     cons_id::out, pair(cons_id, unify_sub_contexts)::out, list(hlds_goal)::out,
     module_info::in, module_info::out, qual_info::in, qual_info::out,
     svar_info::in, svar_info::out, io::di, io::uo) is det.
 
-expand_get_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _,
+expand_get_field_function_call_2(_, _, _, [], _, _, _, _, _, _, _, _,
         !ModuleInfo, !QualInfo, !Sinfo, !IO) :-
     error("expand_get_field_function_call_2: empty list of field names").
 expand_get_field_function_call_2(Context, MainContext, SubContext0,
         [FieldName - FieldArgs | FieldNames], FieldValueVar,
-        TermInputVar, !VarSet, Functor, FieldSubContext, Goals,
+        TermInputVar, Purity, !VarSet, Functor, FieldSubContext, Goals,
         !ModuleInfo, !QualInfo, !SInfo, !IO) :-
     make_fresh_arg_vars(FieldArgs, FieldArgVars, !VarSet, !SInfo, !IO),
     GetArgVars = list__append(FieldArgVars, [TermInputVar]),
@@ -209,15 +209,15 @@
         FieldNames = [_ | _],
         varset__new_var(!.VarSet, SubTermInputVar, !:VarSet),
         construct_field_access_function_call(get, Context, MainContext,
-            SubContext0, FieldName, SubTermInputVar, GetArgVars, Functor, Goal,
-            !QualInfo),
+            SubContext0, FieldName, SubTermInputVar, GetArgVars, Purity,
+            Functor, Goal, !QualInfo),
 
         % recursively extract until we run out of field names
         TermInputArgNumber = 1 + list__length(FieldArgVars),
         TermInputContext = Functor - TermInputArgNumber,
         SubContext = [TermInputContext | SubContext0],
         expand_get_field_function_call_2(Context, MainContext,
-            SubContext, FieldNames, FieldValueVar, SubTermInputVar,
+            SubContext, FieldNames, FieldValueVar, SubTermInputVar, Purity,
             !VarSet, _, FieldSubContext, Goals1, !ModuleInfo, !QualInfo,
             !SInfo, !IO),
         Goals2 = [Goal | Goals1]
@@ -226,7 +226,7 @@
         FieldSubContext = Functor - SubContext0,
         construct_field_access_function_call(get, Context,
             MainContext, SubContext0, FieldName, FieldValueVar,
-            GetArgVars, Functor, Goal, !QualInfo),
+            GetArgVars, Purity, Functor, Goal, !QualInfo),
         Goals2 = [Goal]
     ),
     ArgContext = functor(Functor, MainContext, SubContext0),
@@ -238,16 +238,17 @@
 
 :- pred construct_field_access_function_call(field_access_type::in,
     prog_context::in, unify_main_context::in, unify_sub_contexts::in,
-    ctor_field_name::in, prog_var::in, list(prog_var)::in, cons_id::out,
-    hlds_goal::out, qual_info::in, qual_info::out) is det.
+    ctor_field_name::in, prog_var::in, list(prog_var)::in, purity::in,
+    cons_id::out, hlds_goal::out, qual_info::in, qual_info::out) is det.
 
 construct_field_access_function_call(AccessType, Context, MainContext,
-        SubContext, FieldName, RetArg, Args, Functor, Goal, !QualInfo) :-
+        SubContext, FieldName, RetArg, Args, Purity, Functor, Goal,
+        !QualInfo) :-
     field_access_function_name(AccessType, FieldName, FuncName),
     list__length(Args, Arity),
     Functor = cons(FuncName, Arity),
     make_atomic_unification(RetArg, functor(Functor, no, Args),
-        Context, MainContext, SubContext, Goal, !QualInfo).
+        Context, MainContext, SubContext, Purity, Goal, !QualInfo).
 
 parse_field_list(Term, MaybeFieldNames) :-
     (
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.84
diff -u -r1.84 purity.m
--- compiler/purity.m	15 Nov 2005 03:37:56 -0000	1.84
+++ compiler/purity.m	17 Nov 2005 02:10:36 -0000
@@ -135,7 +135,6 @@
 
 :- import_module hlds.hlds_module.
 :- import_module hlds.hlds_pred.
-:- import_module parse_tree.prog_data.
 
 :- import_module bool.
 :- import_module io.
@@ -163,12 +162,6 @@
 :- pred repuritycheck_proc(module_info::in, pred_proc_id::in, pred_info::in,
     pred_info::out) is det.
 
-    % Give an error message for unifications marked impure/semipure
-    % that are not function calls (e.g. impure X = 4)
-    %
-:- pred impure_unification_expr_error(prog_context::in, purity::in,
-    io::di, io::uo) is det.
-
 :- implementation.
 
 :- import_module check_hlds.clause_to_proc.
@@ -734,22 +727,9 @@
         true
     ),
 
-    % The unification itself is always pure,
-    % even if it is a unification with an impure higher-order term.
-    ActualPurity = purity_pure,
-
-    % Check for a bogus purity annotation on the unification.
-    infer_goal_info_purity(GoalInfo, DeclaredPurity),
-    (
-        DeclaredPurity \= purity_pure,
-        !.Info ^ implicit_purity = dont_make_implicit_promises
-    ->
-        goal_info_get_context(GoalInfo, Context),
-        Message = impure_unification_expr_error(Context, DeclaredPurity),
-        purity_info_add_message(error(Message), !Info)
-    ;
-        true
-    ).
+    % We take the annotated purity (if any) as the actual purity.
+    % This is checked for validity in modecheck_unify.m
+    infer_goal_info_purity(GoalInfo, ActualPurity).
 
     % The possible results of a purity check.
 :- type purity_check_result
@@ -1105,7 +1085,6 @@
     --->    missing_body_impurity_error(prog_context, pred_id)
     ;       closure_purity_error(prog_context, purity, purity)
             % closure_purity_error(Context, DeclaredPurity, ActualPurity)
-    ;       impure_unification_expr_error(prog_context, purity)
     ;       aditi_builtin_error(aditi_builtin_error).
 
 :- type post_typecheck_warning
@@ -1124,9 +1103,6 @@
         Message = closure_purity_error(Context, DeclaredPurity, ActualPurity),
         report_error_closure_purity(Context, DeclaredPurity, ActualPurity, !IO)
     ;
-        Message = impure_unification_expr_error(Context, Purity),
-        impure_unification_expr_error(Context, Purity, !IO)
-    ;
         Message = aditi_builtin_error(AditiError),
         report_aditi_builtin_error(AditiError, !IO)
     ).
@@ -1233,13 +1209,6 @@
         fixed(ActualPurityName ++ ".")],
     write_error_pieces(Context, 0, Pieces, !IO).
 
-impure_unification_expr_error(Context, Purity, !IO) :-
-    purity_name(Purity, PurityName),
-    Pieces = [words("Purity error: unification with expression"),
-        words("was declared"), fixed(PurityName ++ ","),
-        words("but expression was not a function call.")],
-    write_error_pieces(Context, 0, Pieces, !IO).
-
 %-----------------------------------------------------------------------------%
 
 :- type purity_info
Index: compiler/superhomogeneous.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/superhomogeneous.m,v
retrieving revision 1.9
diff -u -r1.9 superhomogeneous.m
--- compiler/superhomogeneous.m	15 Nov 2005 03:37:56 -0000	1.9
+++ compiler/superhomogeneous.m	18 Nov 2005 00:32:00 -0000
@@ -469,8 +469,8 @@
         Det = Det1,
         term__coerce(GoalTerm1, GoalTerm),
         parse_goal(GoalTerm, ParsedGoal, !VarSet),
-        build_lambda_expression(X, LambdaPurity, PredOrFunc, EvalMethod,
-            Vars1, Modes, Det, ParsedGoal, Context, MainContext,
+        build_lambda_expression(X, Purity, LambdaPurity, PredOrFunc,
+            EvalMethod, Vars1, Modes, Det, ParsedGoal, Context, MainContext,
             SubContext, Goal, !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !IO)
     ;
         % handle higher-order dcg pred expressions -
@@ -489,9 +489,9 @@
         parse_dcg_pred_goal(GoalTerm, ParsedGoal, DCG0, DCGn, !VarSet),
         list__append(Vars0, [term__variable(DCG0), term__variable(DCGn)],
             Vars1),
-        build_lambda_expression(X, DCGLambdaPurity, predicate, EvalMethod,
-            Vars1, Modes, Det, ParsedGoal, Context, MainContext, SubContext,
-            Goal0, !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !IO),
+        build_lambda_expression(X, Purity, DCGLambdaPurity, predicate,
+            EvalMethod, Vars1, Modes, Det, ParsedGoal, Context, MainContext,
+            SubContext, Goal0, !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !IO),
         Goal0 = GoalExpr - GoalInfo0,
         add_goal_info_purity_feature(Purity, GoalInfo0, GoalInfo),
         Goal = GoalExpr - GoalInfo
@@ -522,13 +522,13 @@
         finish_if_then_else_expr_condition(BeforeSInfo, !SInfo),
 
         unravel_unification(term__variable(X), ThenTerm,
-            Context, MainContext, SubContext, purity_pure, ThenGoal,
+            Context, MainContext, SubContext, Purity, ThenGoal,
             !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
 
         finish_if_then_else_expr_then_goal(StateVars, BeforeSInfo, !SInfo),
 
         unravel_unification(term__variable(X), ElseTerm,
-            Context, MainContext, SubContext, purity_pure,
+            Context, MainContext, SubContext, Purity,
             ElseGoal, !VarSet, !ModuleInfo, !QualInfo, !SInfo, !IO),
 
         IfThenElse = if_then_else(StateVars ++ Vars, IfGoal, ThenGoal,
@@ -544,7 +544,7 @@
     ->
         make_fresh_arg_var(InputTerm, InputTermVar, [], !VarSet, !SInfo, !IO),
         expand_get_field_function_call(Context, MainContext, SubContext,
-            FieldNames, X, InputTermVar, !VarSet, Functor, _, Goal0,
+            FieldNames, X, InputTermVar, Purity, !VarSet, Functor, _, Goal0,
             !ModuleInfo, !QualInfo, !SInfo, !IO),
 
         ArgContext = functor(Functor, MainContext, SubContext),
@@ -597,7 +597,7 @@
         (
             FunctorArgs = [],
             make_atomic_unification(X, functor(ConsId, no, []), Context,
-                MainContext, SubContext, Goal0, !QualInfo),
+                MainContext, SubContext, Purity, Goal0, !QualInfo),
             Goal0 = GoalExpr - GoalInfo0,
             add_goal_info_purity_feature(Purity, GoalInfo0, GoalInfo),
             % We could attach the from_ground_term feature to Goal,
@@ -609,7 +609,7 @@
             FunctorArgs = [_ | _],
             make_fresh_arg_vars(FunctorArgs, HeadVars, !VarSet, !SInfo, !IO),
             make_atomic_unification(X, functor(ConsId, no, HeadVars), Context,
-                MainContext, SubContext, Goal0, !QualInfo),
+                MainContext, SubContext, Purity, Goal0, !QualInfo),
             ArgContext = functor(ConsId, MainContext, SubContext),
             % Should this be insert_... rather than append_...?
             % No, because that causes efficiency problems
@@ -697,17 +697,17 @@
 % Code for building lambda expressions
 %
 
-:- pred build_lambda_expression(prog_var::in, purity::in, pred_or_func::in,
-    lambda_eval_method::in, list(prog_term)::in, list(mer_mode)::in,
-    determinism::in, goal::in, prog_context::in, unify_main_context::in,
-    unify_sub_contexts::in, hlds_goal::out,
+:- pred build_lambda_expression(prog_var::in, purity::in, purity::in,
+    pred_or_func::in, lambda_eval_method::in, list(prog_term)::in,
+    list(mer_mode)::in, determinism::in, goal::in, prog_context::in,
+    unify_main_context::in, unify_sub_contexts::in, hlds_goal::out,
     prog_varset::in, prog_varset::out,
     module_info::in, module_info::out, qual_info::in, qual_info::out,
     svar_info::in, io::di, io::uo) is det.
 
-build_lambda_expression(X, Purity, PredOrFunc, EvalMethod, Args0, Modes, Det,
-        ParsedGoal, Context, MainContext, SubContext, Goal, !VarSet,
-        !ModuleInfo, !QualInfo, !.SInfo, !IO) :-
+build_lambda_expression(X, UnificationPurity, LambdaPurity, PredOrFunc,
+        EvalMethod, Args0, Modes, Det, ParsedGoal, Context, MainContext,
+        SubContext, Goal, !VarSet, !ModuleInfo, !QualInfo, !.SInfo, !IO) :-
     %
     % In the parse tree, the lambda arguments can be any terms, but
     % in the HLDS they must be distinct variables.  So we introduce
@@ -850,10 +850,10 @@
             LambdaNonLocals = set.to_sorted_list(!.LambdaGoalVars)
         ),
 
-        make_atomic_unification(X,
-            lambda_goal(Purity, PredOrFunc, EvalMethod, modes_are_ok,
-                LambdaNonLocals, LambdaVars, Modes, Det, HLDS_Goal),
-            Context, MainContext, SubContext, Goal, !QualInfo)
+        LambdaGoal = lambda_goal(LambdaPurity, PredOrFunc, EvalMethod,
+            modes_are_ok, LambdaNonLocals, LambdaVars, Modes, Det, HLDS_Goal),
+        make_atomic_unification(X, LambdaGoal, Context, MainContext,
+            SubContext, UnificationPurity, Goal, !QualInfo)
     ).
 
     % Partition the lists of arguments and variables into lists
Index: tests/invalid/purity/impure_func_t7.err_exp
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/impure_func_t7.err_exp,v
retrieving revision 1.3
diff -u -r1.3 impure_func_t7.err_exp
--- tests/invalid/purity/impure_func_t7.err_exp	14 Sep 2005 05:27:09 -0000	1.3
+++ tests/invalid/purity/impure_func_t7.err_exp	18 Nov 2005 00:42:03 -0000
@@ -1,8 +1,12 @@
-impure_func_t7.m:021: Purity error: unification with expression was declared
-impure_func_t7.m:021:   impure, but expression was not a function call.
-impure_func_t7.m:024: Purity error: unification with expression was declared
-impure_func_t7.m:024:   impure, but expression was not a function call.
-impure_func_t7.m:028: Purity error: unification with expression was declared
-impure_func_t7.m:028:   impure, but expression was not a function call.
-impure_func_t7.m:031: Purity error: unification with expression was declared
-impure_func_t7.m:031:   impure, but expression was not a function call.
+impure_func_t7.m:029: In clause for `bad_impure_if_then_else_expr(di, uo)':
+impure_func_t7.m:029:   purity error: goal is marked as impure, but is actually
+impure_func_t7.m:029:   pure
+impure_func_t7.m:037: In clause for `bad_impure_lambda_unification(di, uo)':
+impure_func_t7.m:037:   purity error: goal is marked as impure, but is actually
+impure_func_t7.m:037:   pure
+impure_func_t7.m:046: In clause for `bad_impure_field_access(di, uo)':
+impure_func_t7.m:046:   purity error: goal is marked as impure, but is actually
+impure_func_t7.m:046:   pure
+impure_func_t7.m:054: In clause for `bad_impure_assignment(di, uo)':
+impure_func_t7.m:054:   purity error: goal is marked as impure, but is actually
+impure_func_t7.m:054:   pure
Index: tests/invalid/purity/impure_func_t7.m
===================================================================
RCS file: /home/mercury1/repository/tests/invalid/purity/impure_func_t7.m,v
retrieving revision 1.2
diff -u -r1.2 impure_func_t7.m
--- tests/invalid/purity/impure_func_t7.m	7 Nov 2002 16:17:09 -0000	1.2
+++ tests/invalid/purity/impure_func_t7.m	18 Nov 2005 00:36:47 -0000
@@ -14,23 +14,46 @@
 
 :- type blah ---> blah(foo :: int).
 
-main -->
-	{ impure X = get_counter(4) },
-	print("X = "), 
-	print(X), 
-	{ impure Z = ( X = 3 -> 4 ; 5 ) },
-	print("Z = "), 
-	print(Z), 
-	{ impure L = (pred(X5::out) is det :- X5 = 4) },
-	{ L(P) },
-	print("P = "), 
-	print(P), 
-	{ impure M = blah(7) ^ foo },
-	print("M = "), 
-	print(M), 
-	{ impure B = 4 },
-	print(B), 
-	nl.
+main(!IO) :-
+	impure bad_impure_if_then_else_expr(!IO),
+	impure bad_impure_lambda_unification(!IO),
+	impure bad_impure_field_access(!IO),
+	impure bad_impure_assignment(!IO).
+
+:- impure pred bad_impure_if_then_else_expr(io::di, io::uo) is det.
+
+bad_impure_if_then_else_expr(!IO) :-
+	impure X = get_counter(4),
+	print("X = ", !IO), 
+	print(X, !IO), 
+	impure Z = ( X = 3 -> 4 ; 5 ),
+	print("Z = ", !IO), 
+	print(Z, !IO), 
+	nl(!IO).
+
+:- impure pred bad_impure_lambda_unification(io::di, io::uo) is det.
+
+bad_impure_lambda_unification(!IO) :-
+	impure L = (pred(X5::out) is det :- X5 = 4),
+	L(P),
+	print("P = ", !IO), 
+	print(P, !IO), 
+	nl(!IO).
+
+:- impure pred bad_impure_field_access(io::di, io::uo) is det.
+
+bad_impure_field_access(!IO) :-
+	impure M = blah(7) ^ foo,
+	print("M = ", !IO), 
+	print(M, !IO), 
+	nl(!IO).
+
+:- impure pred bad_impure_assignment(io::di, io::uo) is det.
+
+bad_impure_assignment(!IO) :-
+	impure B = 4,
+	print(B, !IO), 
+	nl(!IO).
 
 :- impure func get_counter(int) = int.
 :- impure pred some_pred(int::in, int::out) is det.
--------------------------------------------------------------------------
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