[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