[m-rev.] For review: more fixes to purity checking for inst any vars

Ralph Becket rafe at cs.mu.OZ.AU
Mon Nov 14 19:17:00 AEDT 2005


Estimated hours taken: 7
Branches: main

Fix a bug introduced in my recent change to purity checking for inst any
non-locals in negated contexts, where the compiler was not correctly
reporting purity errors to do with unifications or mismatches between
clause body purity and declared purity.

compiler/hlds_goal.m:
compiler/qual_info.m:
compiler/superhomogeneous.m:
compiler/unique_modes.m:
	Unification goals are no longer automatically pure.

compiler/purity.m:
	When inferring the purity of a goal, use the worst purity of
	what was inferred vs. what was declared.

extras/solver_types/library/any_assoc_list.m:
extras/solver_types/library/any_list.m:
extras/solver_types/library/any_map.m:
extras/solver_types/library/any_tree234.m:
	Fix impurity errors that are now detected by the compiler: before
	it was correctly only repored non-declared-impure uses of
	inst any non-locals in negated contexts; now it also reports
	when a clause body's purity differs from the declared purity.

Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.143
diff -u -r1.143 hlds_goal.m
--- compiler/hlds_goal.m	4 Nov 2005 03:40:46 -0000	1.143
+++ compiler/hlds_goal.m	14 Nov 2005 03:40:49 -0000
@@ -1183,6 +1183,12 @@
     %
 :- pred create_atomic_complicated_unification(prog_var::in, unify_rhs::in,
     prog_context::in, unify_main_context::in, unify_sub_contexts::in,
+    purity::in, hlds_goal::out) is det.
+
+    % As above, but with default purity pure.
+    %
+:- pred create_atomic_complicated_unification(prog_var::in, unify_rhs::in,
+    prog_context::in, unify_main_context::in, unify_sub_contexts::in,
     hlds_goal::out) is det.
 
     % Create the hlds_goal for a unification that tests the equality of two
@@ -2150,11 +2156,17 @@
 
 create_atomic_complicated_unification(LHS, RHS, Context,
         UnifyMainContext, UnifySubContext, Goal) :-
+    create_atomic_complicated_unification(LHS, RHS, Context,
+            UnifyMainContext, UnifySubContext, purity_pure, Goal).
+
+create_atomic_complicated_unification(LHS, RHS, Context,
+        UnifyMainContext, UnifySubContext, Purity, Goal) :-
     UMode = ((free - free) -> (free - free)),
     Mode = ((free -> free) - (free -> free)),
     Unification = complicated_unify(UMode, can_fail, []),
     UnifyContext = unify_context(UnifyMainContext, UnifySubContext),
-    goal_info_init(Context, GoalInfo),
+    goal_info_init(Context, GoalInfo0),
+    add_goal_info_purity_feature(Purity, GoalInfo0, GoalInfo),
     Goal = unify(LHS, RHS, Mode, Unification, UnifyContext) - GoalInfo.
 
 %-----------------------------------------------------------------------------%
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.83
diff -u -r1.83 purity.m
--- compiler/purity.m	7 Nov 2005 07:47:09 -0000	1.83
+++ compiler/purity.m	14 Nov 2005 07:51:54 -0000
@@ -296,7 +296,7 @@
     module_info::in, int::out, io::di, io::uo) is det.
 
 puritycheck_pred(PredId, !PredInfo, ModuleInfo, NumErrors, !IO) :-
-    pred_info_get_purity(!.PredInfo, DeclPurity) ,
+    pred_info_get_purity(!.PredInfo, DeclPurity),
     pred_info_get_promised_purity(!.PredInfo, PromisedPurity),
     some [!ClausesInfo] (
         pred_info_clauses_info(!.PredInfo, !:ClausesInfo),
@@ -423,8 +423,8 @@
 compute_purity(GoalType, [Clause0 | Clauses0], [Clause | Clauses], ProcIds,
         !Purity, !Info) :-
     Clause0 = clause(Ids, Body0 - Info0, Lang, Context),
-    compute_expr_purity(Body0, Body, Info0, Bodypurity0, !Info),
-    add_goal_info_purity_feature(Bodypurity0, Info0, Info),
+    compute_expr_purity(Body0, Body, Info0, Bodypurity, !Info),
+    add_goal_info_purity_feature(Bodypurity, Info0, Info),
     % If this clause doesn't apply to all modes of this procedure,
     % i.e. the procedure has different clauses for different modes,
     % then we must treat it as impure.
@@ -440,8 +440,7 @@
     ;
         Clausepurity = purity_impure
     ),
-    worst_purity(Bodypurity0, Clausepurity) = Bodypurity,
-    !:Purity = worst_purity(!.Purity, Bodypurity),
+    !:Purity = worst_purity(!.Purity, worst_purity(Bodypurity, Clausepurity)),
     Clause = clause(Ids, Body - Info, Lang, Context),
     compute_purity(GoalType, Clauses0, Clauses, ProcIds, !Purity, !Info).
 
@@ -461,11 +460,20 @@
 :- pred compute_expr_purity(hlds_goal_expr::in, hlds_goal_expr::out,
     hlds_goal_info::in, purity::out, purity_info::in, purity_info::out) is det.
 
-compute_expr_purity(conj(Goals0), conj(Goals), _, Purity, !Info) :-
+compute_expr_purity(GoalExpr0, GoalExpr, GoalInfo0, ActualPurity, !Info) :-
+    compute_expr_purity_2(GoalExpr0, GoalExpr, GoalInfo0, InferredPurity,
+        !Info),
+    infer_goal_info_purity(GoalInfo0, DeclPurity),
+    ActualPurity = worst_purity(DeclPurity, InferredPurity).
+
+:- pred compute_expr_purity_2(hlds_goal_expr::in, hlds_goal_expr::out,
+    hlds_goal_info::in, purity::out, purity_info::in, purity_info::out) is det.
+
+compute_expr_purity_2(conj(Goals0), conj(Goals), _, Purity, !Info) :-
     compute_goals_purity(Goals0, Goals, purity_pure, Purity, !Info).
-compute_expr_purity(par_conj(Goals0), par_conj(Goals), _, Purity, !Info) :-
+compute_expr_purity_2(par_conj(Goals0), par_conj(Goals), _, Purity, !Info) :-
     compute_goals_purity(Goals0, Goals, purity_pure, Purity, !Info).
-compute_expr_purity(Goal0, Goal, GoalInfo, ActualPurity, !Info) :-
+compute_expr_purity_2(Goal0, Goal, GoalInfo, ActualPurity, !Info) :-
     Goal0 = call(PredId0, ProcId, Vars, BIState, UContext, Name0),
     RunPostTypecheck = !.Info ^ run_post_typecheck,
     PredInfo = !.Info ^ pred_info,
@@ -495,7 +503,7 @@
     goal_info_get_context(GoalInfo, CallContext),
     perform_goal_purity_checks(CallContext, PredId,
         DeclaredPurity, ActualPurity, !Info).
-compute_expr_purity(generic_call(GenericCall0, Args, Modes0, Det),
+compute_expr_purity_2(generic_call(GenericCall0, Args, Modes0, Det),
         GoalExpr, GoalInfo, Purity, !Info) :-
     (
         GenericCall0 = higher_order(_, Purity, _, _),
@@ -535,10 +543,10 @@
         ),
         GoalExpr = generic_call(GenericCall, Args, Modes, Det)
     ).
-compute_expr_purity(switch(Var, Canfail, Cases0),
+compute_expr_purity_2(switch(Var, Canfail, Cases0),
         switch(Var, Canfail, Cases), _, Purity, !Info) :-
     compute_cases_purity(Cases0, Cases, purity_pure, Purity, !Info).
-compute_expr_purity(Unif0, GoalExpr, GoalInfo, ActualPurity, !Info) :-
+compute_expr_purity_2(Unif0, GoalExpr, GoalInfo, ActualPurity, !Info) :-
     Unif0 = unify(Var, RHS0, Mode, Unification, UnifyContext),
     (
         RHS0 = lambda_goal(LambdaPurity, F, EvalMethod,
@@ -557,7 +565,7 @@
             FixModes = modes_need_fixing,
             (
                 EvalMethod = lambda_normal,
-                error("compute_expr_purity: modes need " ++
+                error("compute_expr_purity_2: modes need " ++
                     "fixing for normal lambda_goal")
             ;
                 EvalMethod = lambda_aditi_bottom_up,
@@ -607,9 +615,9 @@
         GoalExpr = Unif0,
         ActualPurity = purity_pure
     ).
-compute_expr_purity(disj(Goals0), disj(Goals), _, Purity, !Info) :-
+compute_expr_purity_2(disj(Goals0), disj(Goals), _, Purity, !Info) :-
     compute_goals_purity(Goals0, Goals, purity_pure, Purity, !Info).
-compute_expr_purity(not(Goal0), NotGoal, GoalInfo0, Purity, !Info) :-
+compute_expr_purity_2(not(Goal0), NotGoal, GoalInfo0, Purity, !Info) :-
     % Eliminate double negation.
     negate_goal(Goal0, GoalInfo0, NotGoal0),
     ( NotGoal0 = not(Goal1) - _GoalInfo1 ->
@@ -622,7 +630,7 @@
         compute_goal_purity(NotGoal0, NotGoal1, Purity, !Info),
         NotGoal1 = NotGoal - _
     ).
-compute_expr_purity(scope(Reason, Goal0), scope(Reason, Goal),
+compute_expr_purity_2(scope(Reason, Goal0), scope(Reason, Goal),
         _, Purity, !Info) :-
     (
         Reason = exist_quant(_),
@@ -652,7 +660,7 @@
         Reason = from_ground_term(_),
         compute_goal_purity(Goal0, Goal, Purity, !Info)
     ).
-compute_expr_purity(if_then_else(Vars, Cond0, Then0, Else0),
+compute_expr_purity_2(if_then_else(Vars, Cond0, Then0, Else0),
         if_then_else(Vars, Cond, Then, Else), _, Purity, !Info) :-
         % The condition is in a negated context.
         %
@@ -666,7 +674,7 @@
     compute_goal_purity(Else0, Else, Purity3, !Info),
     worst_purity(Purity1, Purity2) = Purity12,
     worst_purity(Purity12, Purity3) = Purity.
-compute_expr_purity(ForeignProc0, ForeignProc, _, Purity, !Info) :-
+compute_expr_purity_2(ForeignProc0, ForeignProc, _, Purity, !Info) :-
     ForeignProc0 = foreign_proc(_, _, _, _, _, _),
     Attributes = ForeignProc0 ^ foreign_attr,
     PredId = ForeignProc0 ^ foreign_pred_id,
@@ -684,9 +692,9 @@
         Purity = purity(Attributes)
     ).
 
-compute_expr_purity(shorthand(_), _, _, _, !Info) :-
+compute_expr_purity_2(shorthand(_), _, _, _, !Info) :-
     % These should have been expanded out by now.
-    error("compute_expr_purity: unexpected shorthand").
+    error("compute_expr_purity_2: unexpected shorthand").
 
 :- pred check_higher_order_purity(hlds_goal_info::in, cons_id::in,
     prog_var::in, list(prog_var)::in, purity::out,
Index: compiler/qual_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/qual_info.m,v
retrieving revision 1.6
diff -u -r1.6 qual_info.m
--- compiler/qual_info.m	4 Nov 2005 03:40:55 -0000	1.6
+++ compiler/qual_info.m	14 Nov 2005 03:29:41 -0000
@@ -64,6 +64,12 @@
     qual_info::in, qual_info::out, io::di, io::uo) is det.
 
 :- pred make_atomic_unification(prog_var::in, unify_rhs::in, prog_context::in,
+    unify_main_context::in, unify_sub_contexts::in, purity::in, hlds_goal::out,
+    qual_info::in, qual_info::out) is det.
+
+    % As above, except with default purity pure.
+    %
+:- pred make_atomic_unification(prog_var::in, unify_rhs::in, prog_context::in,
     unify_main_context::in, unify_sub_contexts::in, hlds_goal::out,
     qual_info::in, qual_info::out) is det.
 
@@ -226,6 +232,11 @@
 
 make_atomic_unification(Var, Rhs, Context, MainContext, SubContext,
         Goal, !QualInfo) :-
+    make_atomic_unification(Var, Rhs, Context, MainContext, SubContext,
+            purity_pure, Goal, !QualInfo).
+
+make_atomic_unification(Var, Rhs, Context, MainContext, SubContext, Purity,
+        Goal, !QualInfo) :-
     (
         Rhs = var(_)
     ;
@@ -235,7 +246,7 @@
         record_used_functor(ConsId, !QualInfo)
     ),
     create_atomic_complicated_unification(Var, Rhs, Context,
-        MainContext, SubContext, Goal).
+        MainContext, SubContext, Purity, Goal).
 
 record_called_pred_or_func(PredOrFunc, SymName, Arity, !QualInfo) :-
     Id = SymName - Arity,
Index: compiler/superhomogeneous.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/superhomogeneous.m,v
retrieving revision 1.8
diff -u -r1.8 superhomogeneous.m
--- compiler/superhomogeneous.m	28 Oct 2005 02:10:37 -0000	1.8
+++ compiler/superhomogeneous.m	14 Nov 2005 03:26:25 -0000
@@ -380,9 +380,8 @@
 unravel_unification_2(term__variable(X), term__variable(Y), Context,
         MainContext, SubContext, Purity, Goal, !VarSet,
         !ModuleInfo, !QualInfo, !SInfo, !IO) :-
-    make_atomic_unification(X, var(Y), Context, MainContext, SubContext, Goal,
-        !QualInfo),
-    check_expr_purity(Purity, Context, !ModuleInfo, !IO).
+    make_atomic_unification(X, var(Y), Context, MainContext, SubContext,
+        Purity, Goal, !QualInfo).
 
     % If we find a unification of the form
     %   X = f(A1, A2, A3)
@@ -465,7 +464,6 @@
             PredOrFunc = function
         )
     ->
-        check_expr_purity(Purity, Context, !ModuleInfo, !IO),
         add_clause__qualify_lambda_mode_list(Modes1, Modes, Context,
             !QualInfo, !IO),
         Det = Det1,
@@ -517,7 +515,6 @@
         BeforeSInfo = !.SInfo,
         prepare_for_if_then_else_expr(StateVars, !VarSet, !SInfo),
 
-        check_expr_purity(Purity, Context, !ModuleInfo, !IO),
         map__init(EmptySubst),
         transform_goal(IfParseTree, EmptySubst, IfGoal, !VarSet,
             !ModuleInfo, !QualInfo, !SInfo, !IO),
@@ -545,7 +542,6 @@
         parse_field_list(FieldNameTerm, FieldNameResult),
         FieldNameResult = ok(FieldNames)
     ->
-        check_expr_purity(Purity, Context, !ModuleInfo, !IO),
         make_fresh_arg_var(InputTerm, InputTermVar, [], !VarSet, !SInfo, !IO),
         expand_get_field_function_call(Context, MainContext, SubContext,
             FieldNames, X, InputTermVar, !VarSet, Functor, _, Goal0,
@@ -564,7 +560,6 @@
         parse_field_list(FieldNameTerm, FieldNameResult),
         FieldNameResult = ok(FieldNames)
     ->
-        check_expr_purity(Purity, Context, !ModuleInfo, !IO),
         make_fresh_arg_var(InputTerm, InputTermVar, [], !VarSet, !SInfo, !IO),
         make_fresh_arg_var(FieldValueTerm, FieldValueVar, [InputTermVar],
             !VarSet, !SInfo, !IO),
@@ -903,17 +898,6 @@
             )
         ).
 
-:- pred check_expr_purity(purity::in, prog_context::in,
-    module_info::in, module_info::out, io::di, io::uo) is det.
-
-check_expr_purity(Purity, Context, !ModuleInfo, !IO) :-
-    ( Purity \= purity_pure ->
-        impure_unification_expr_error(Context, Purity, !IO),
-        module_info_incr_errors(!ModuleInfo)
-    ;
-        true
-    ).
-
 %-----------------------------------------------------------------------------%
 
 :- func this_file = string.
Index: compiler/unique_modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unique_modes.m,v
retrieving revision 1.99
diff -u -r1.99 unique_modes.m
--- compiler/unique_modes.m	7 Nov 2005 07:47:09 -0000	1.99
+++ compiler/unique_modes.m	14 Nov 2005 06:34:50 -0000
@@ -357,7 +357,10 @@
     mode_info_remove_live_vars(Else_Vars, !ModeInfo),
 
     mode_info_add_live_vars(Then_Vars, !ModeInfo),
+    mode_info_get_in_negated_context(!.ModeInfo, InNegatedContext0),
+    mode_info_set_in_negated_context(yes, !ModeInfo),
     check_goal(Cond0, Cond, !ModeInfo, !IO),
+    mode_info_set_in_negated_context(InNegatedContext0, !ModeInfo),
     mode_info_remove_live_vars(Then_Vars, !ModeInfo),
     mode_info_unlock_vars(if_then_else, NonLocals, !ModeInfo),
     mode_info_get_instmap(!.ModeInfo, InstMapCond),
Index: extras/solver_types/library/any_assoc_list.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/solver_types/library/any_assoc_list.m,v
retrieving revision 1.2
diff -u -r1.2 any_assoc_list.m
--- extras/solver_types/library/any_assoc_list.m	10 Nov 2005 03:08:36 -0000	1.2
+++ extras/solver_types/library/any_assoc_list.m	14 Nov 2005 07:56:58 -0000
@@ -89,7 +89,9 @@
 :- import_module string.
 
 any_assoc_list__from_corresponding_lists(Ks, Vs, KVs) :-
-    ( impure any_assoc_list__from_corresponding_2(Ks, Vs, KVs0) ->
+    promise_pure (
+    	impure any_assoc_list__from_corresponding_2(Ks, Vs, KVs0)
+    ->
         KVs = KVs0
     ;
         KeyType = type_name(type_of(Ks)),
@@ -175,7 +177,8 @@
     any_assoc_list__search(AL, K, V).
 
 AL ^ det_elem(K) = V :-
-    ( if   impure any_assoc_list__search(AL, K, V0)
+    promise_pure (
+      if   impure any_assoc_list__search(AL, K, V0)
       then V = V0
       else report_lookup_error("any_assoc_list__det_elem: key not found", K)
     ).
Index: extras/solver_types/library/any_list.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/solver_types/library/any_list.m,v
retrieving revision 1.2
diff -u -r1.2 any_list.m
--- extras/solver_types/library/any_list.m	10 Nov 2005 03:08:37 -0000	1.2
+++ extras/solver_types/library/any_list.m	14 Nov 2005 07:59:36 -0000
@@ -739,7 +739,9 @@
 %-----------------------------------------------------------------------------%
 
 index0_det(List, N) = Elem :-
-    ( impure index0(List, N, Elem0) ->
+    promise_pure (
+        impure index0(List, N, Elem0)
+    ->
         Elem = Elem0
     ;
         error("index: index out of range")
@@ -781,7 +783,9 @@
     replace_nth_2(Xs, P, R, L).
 
 replace_nth_det(Xs, P, R) = L :-
-    ( P > 0 ->
+    promise_pure (
+        P > 0
+    ->
         ( impure replace_nth_2(Xs, P, R, L0) ->
             L = L0
         ;
@@ -878,7 +882,9 @@
     ).
 
 take_upto(N, As) = Bs :-
-    ( impure take(N, As, Bs0) ->
+    promise_pure (
+        impure take(N, As, Bs0)
+    ->
         Bs = Bs0
     ;
         Bs = As
@@ -960,7 +966,9 @@
     ).
 
 det_last(List) = Last :-
-    ( impure last(List, LastPrime) ->
+    promise_pure (
+        impure last(List, LastPrime)
+    ->
         Last = LastPrime
     ;
         error("last_det: empty list")
@@ -978,7 +986,9 @@
     ).
 
 split_last_det(List, AllButLast, Last) :-
-    ( impure split_last(List, AllButLastPrime, LastPrime) ->
+    promise_pure (
+        impure split_last(List, AllButLastPrime, LastPrime)
+    ->
         AllButLast = AllButLastPrime,
         Last = LastPrime
     ;
Index: extras/solver_types/library/any_map.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/solver_types/library/any_map.m,v
retrieving revision 1.3
diff -u -r1.3 any_map.m
--- extras/solver_types/library/any_map.m	10 Nov 2005 03:08:37 -0000	1.3
+++ extras/solver_types/library/any_map.m	14 Nov 2005 08:03:25 -0000
@@ -553,7 +553,9 @@
     any_tree234__search(Map, K, V).
 
 any_map__lookup(Map, K, V) :-
-    ( impure any_tree234__search(Map, K, V1) ->
+    promise_pure (
+        impure any_tree234__search(Map, K, V1)
+    ->
         V = V1
     ;
         report_lookup_error("any_map__lookup: key not found", K, V)
@@ -563,7 +565,9 @@
     any_tree234__lower_bound_search(Map, SearchK, K, V).
 
 any_map__lower_bound_lookup(Map, SearchK, K, V) :-
-    ( impure any_tree234__lower_bound_search(Map, SearchK, K1, V1) ->
+    promise_pure (
+        impure any_tree234__lower_bound_search(Map, SearchK, K1, V1)
+    ->
         K = K1,
         V = V1
     ;
@@ -575,7 +579,9 @@
     any_tree234__upper_bound_search(Map, SearchK, K, V).
 
 any_map__upper_bound_lookup(Map, SearchK, K, V) :-
-    ( impure any_tree234__upper_bound_search(Map, SearchK, K1, V1) ->
+    promise_pure (
+        impure any_tree234__upper_bound_search(Map, SearchK, K1, V1)
+    ->
         K = K1,
         V = V1
     ;
@@ -591,7 +597,9 @@
     any_tree234__insert(Map0, K, V, Map).
 
 any_map__det_insert(Map0, K, V, Map) :-
-    ( impure any_tree234__insert(Map0, K, V, Map1) ->
+    promise_pure (
+        impure any_tree234__insert(Map0, K, V, Map1)
+    ->
         Map = Map1
     ;
         report_lookup_error("any_map__det_insert: key already present",
@@ -649,7 +657,9 @@
     any_tree234__update(Map0, K, V, Map).
 
 any_map__det_update(Map0, K, V, Map) :-
-    ( impure any_tree234__update(Map0, K, V, Map1) ->
+    promise_pure (
+        impure any_tree234__update(Map0, K, V, Map1)
+    ->
         Map = Map1
     ;
         report_lookup_error("any_map__det_update: key not found", K, V)
@@ -659,7 +669,7 @@
     any_tree234__transform_value(P, K, !Map).
 
 any_map__det_transform_value(P, K, !Map) :-
-    (
+    promise_pure (
         impure any_map__transform_value(P, K, !.Map, NewMap)
     ->
         !:Map = NewMap
@@ -710,7 +720,9 @@
     any_tree234__remove(Map0, Key, Value, Map).
 
 any_map__det_remove(Map0, Key, Value, Map) :-
-    ( impure any_tree234__remove(Map0, Key, Value1, Map1) ->
+    promise_pure (
+        impure any_tree234__remove(Map0, Key, Value1, Map1)
+    ->
         Value = Value1,
         Map = Map1
     ;
@@ -766,7 +778,9 @@
 any_map__overlay_large_map_2([], Map, Map).
 any_map__overlay_large_map_2([K - V | AssocList], Map0, Map) :-
     unsafe_cast_to_ground(K),
-    ( impure any_map__insert(Map0, K, V, Map1) ->
+    promise_pure (
+        impure any_map__insert(Map0, K, V, Map1)
+    ->
         Map2 = Map1
     ;
         Map2 = Map0
@@ -785,7 +799,9 @@
 
 any_map__select_2([], _Original, New, New).
 any_map__select_2([K|Ks], Original, New0, New) :-
-    ( impure any_map__search(Original, K, V) ->
+    promise_pure (
+        impure any_map__search(Original, K, V)
+    ->
         any_map__set(New0, K, V, New1)
     ;
         New1 = New0
@@ -878,7 +894,9 @@
     ).
 
 any_map__det_intersect(CommonPred, Map1, Map2, Common) :-
-    ( impure any_map__intersect(CommonPred, Map1, Map2, CommonPrime) ->
+    promise_pure (
+        impure any_map__intersect(CommonPred, Map1, Map2, CommonPrime)
+    ->
         Common = CommonPrime
     ;
         error("any_map__det_intersect: any_map__intersect failed")
@@ -938,7 +956,9 @@
     ).
 
 any_map__det_union(CommonPred, Map1, Map2, Union) :-
-    ( impure any_map__union(CommonPred, Map1, Map2, UnionPrime) ->
+    promise_pure (
+        impure any_map__union(CommonPred, Map1, Map2, UnionPrime)
+    ->
         Union = UnionPrime
     ;
         error("any_map__det_union: any_map__union failed")
Index: extras/solver_types/library/any_tree234.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/solver_types/library/any_tree234.m,v
retrieving revision 1.2
diff -u -r1.2 any_tree234.m
--- extras/solver_types/library/any_tree234.m	10 Nov 2005 03:08:37 -0000	1.2
+++ extras/solver_types/library/any_tree234.m	14 Nov 2005 08:06:07 -0000
@@ -391,7 +391,7 @@
     ).
 
 any_tree234__lookup(T, K, V) :-
-    ( impure any_tree234__search(T, K, V0) ->
+    promise_pure ( impure any_tree234__search(T, K, V0) ->
         V = V0
     ;
         report_lookup_error("any_tree234__lookup: key not found.", K, V)
@@ -400,7 +400,7 @@
 %------------------------------------------------------------------------------%
 
 any_tree234__lower_bound_search(T, SearchK, K, V) :-
-    (
+    promise_pure (
         T = empty,
         fail
     ;
@@ -535,7 +535,9 @@
     ).
 
 any_tree234__lower_bound_lookup(T, SearchK, K, V) :-
-    ( impure any_tree234__lower_bound_search(T, SearchK, K0, V0) ->
+    promise_pure (
+        impure any_tree234__lower_bound_search(T, SearchK, K0, V0)
+    ->
         K = K0,
         V = V0
     ;
@@ -546,7 +548,7 @@
 %------------------------------------------------------------------------------%
 
 any_tree234__upper_bound_search(T, SearchK, K, V) :-
-    (
+    promise_pure (
         T = empty,
         fail
     ;
@@ -678,7 +680,9 @@
     ).
 
 any_tree234__upper_bound_lookup(T, SearchK, K, V) :-
-    ( impure any_tree234__upper_bound_search(T, SearchK, K0, V0) ->
+    promise_pure (
+        impure any_tree234__upper_bound_search(T, SearchK, K0, V0)
+    ->
         K = K0,
         V = V0
     ;
@@ -693,7 +697,9 @@
     ; T0 = three(_, _, NodeMaxKey, _, _, _, NodeMaxSubtree)
     ; T0 = four(_, _, _, _, NodeMaxKey, _, _, _, _, NodeMaxSubtree)
     ),
-    ( impure MaxSubtreeKey = any_tree234__max_key(NodeMaxSubtree) ->
+    promise_pure (
+        impure MaxSubtreeKey = any_tree234__max_key(NodeMaxSubtree)
+    ->
         MaxKey = MaxSubtreeKey
     ;
         MaxKey = NodeMaxKey
@@ -705,7 +711,9 @@
     ; T0 = three(NodeMinKey, _, _, _, NodeMinSubtree, _, _)
     ; T0 = four(NodeMinKey, _, _, _, _, _, NodeMinSubtree, _, _, _)
     ),
-    ( impure MinSubtreeKey = any_tree234__min_key(NodeMinSubtree) ->
+    promise_pure (
+        impure MinSubtreeKey = any_tree234__min_key(NodeMinSubtree)
+    ->
         MinKey = MinSubtreeKey
     ;
         MinKey = NodeMinKey
@@ -1569,7 +1577,7 @@
         any_tree234(K, V)::oa, bool::out) is det.
 
 any_tree234__delete_2(Tin, K, Tout, RH) :-
-    (
+    promise_pure (
         Tin = empty,
         Tout = empty,
         RH = no
@@ -1831,7 +1839,7 @@
         any_tree234(K, V)::oa, bool::out) is semidet.
 
 any_tree234__remove_2(Tin, K, V, Tout, RH) :-
-    (
+    promise_pure (
         Tin = empty,
         fail
     ;
--------------------------------------------------------------------------
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