[m-rev.] diff: fix bug with trail usage opt and model_non disjunctions
Julien Fischer
juliensf at csse.unimelb.edu.au
Tue Sep 5 18:16:01 AEST 2006
Estimated hours taken: 10
Branches: main, release
Fix a bug with trail usage optimization that was causing it to break the G12
fd tests. The problem was that the optimization we were applying to model_non
disjunctions was incorrect - instead of considering trail updates along all
forward execution paths from the creation of a choicepoint to the commit, it
was only considering updates along parts of those paths.
The fix (for now) is to remove that particular part of the optimization.
(It will be possible to reinstate part of the optimization but doing so
requires creating trail specialized versions of procedures -
something that we don't currently have support for.)
compiler/trailing_analysis.m:
Treat any goal that creates a choicepoint as potentially modifying
the trail.
compiler/add_trail_ops.m:
Modify the MLDS code generator to conform to the above.
compiler/code_model.m:
compiler/disj_gen.m:
compiler/ite_gen.m:
Do the same for the LLDS code generator.
tests/trailing/tu_test1.{m,exp}:
Test case for the above bug.
tests/trailing/tu_test2.{m,exp}:
Test that trail usage optimization of semidet if-then-else
conditions still works.
tests/trailing/Makefile:
tests/trailing/Mercury.options:
Enable the new test cases.
Julien.
Index: compiler/add_trail_ops.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/add_trail_ops.m,v
retrieving revision 1.41
diff -u -r1.41 add_trail_ops.m
--- compiler/add_trail_ops.m 20 Aug 2006 08:20:51 -0000 1.41
+++ compiler/add_trail_ops.m 22 Aug 2006 02:54:04 -0000
@@ -137,18 +137,8 @@
trail_ops_info::in, trail_ops_info::out) is det.
goal_add_trail_ops(!Goal, !Info) :-
- OptTrailUsage = !.Info ^ opt_trail_usage,
!.Goal = GoalExpr0 - GoalInfo,
- (
- OptTrailUsage = yes,
- goal_cannot_modify_trail(GoalInfo) = yes
- ->
- % Don't add trail ops if the goal cannot modify the trail
- % and we are optimizing trail usage.
- true
- ;
- goal_expr_add_trail_ops(GoalExpr0, GoalInfo, !:Goal, !Info)
- ).
+ goal_expr_add_trail_ops(GoalExpr0, GoalInfo, !:Goal, !Info).
:- pred goal_expr_add_trail_ops(hlds_goal_expr::in, hlds_goal_info::in,
hlds_goal::out, trail_ops_info::in, trail_ops_info::out) is det.
@@ -160,15 +150,15 @@
goal_expr_add_trail_ops(disj([]), GI, disj([]) - GI, !Info).
goal_expr_add_trail_ops(disj(Goals0), GoalInfo, Goal - GoalInfo, !Info) :-
Goals0 = [_ | _],
-
goal_info_get_context(GoalInfo, Context),
goal_info_get_code_model(GoalInfo, CodeModel),
-
+ %
% Allocate a new trail ticket so that we can restore things on
% back-tracking.
+ %
new_ticket_var(TicketVar, !Info),
gen_store_ticket(TicketVar, Context, StoreTicketGoal, !.Info),
- disj_add_trail_ops(Goals0, yes, no, CodeModel, TicketVar, Goals, !Info),
+ disj_add_trail_ops(Goals0, yes, CodeModel, TicketVar, Goals, !Info),
Goal = conj(plain_conj, [StoreTicketGoal, disj(Goals) - GoalInfo]).
goal_expr_add_trail_ops(switch(A, B, Cases0), GI, switch(A, B, Cases) - GI,
@@ -259,41 +249,56 @@
Goal = scope(Reason, Goal1)
).
-goal_expr_add_trail_ops(if_then_else(A, Cond0, Then0, Else0), GoalInfo,
+goal_expr_add_trail_ops(if_then_else(ExistQVars, Cond0, Then0, Else0), GoalInfo,
Goal - GoalInfo, !Info) :-
goal_add_trail_ops(Cond0, Cond, !Info),
goal_add_trail_ops(Then0, Then1, !Info),
goal_add_trail_ops(Else0, Else1, !Info),
-
- % Allocate a new trail ticket so that we can restore things
- % if the condition fails.
- new_ticket_var(TicketVar, !Info),
- goal_info_get_context(GoalInfo, Context),
- gen_store_ticket(TicketVar, Context, StoreTicketGoal, !.Info),
-
- % Commit the trail ticket entries if the condition succeeds.
- Then1 = _ - Then1GoalInfo,
+ %
+ % If the condition does not modify the trail and does not create
+ % any choicepoints then we can omit the trailing code around it.
+ %
+ OptTrailUsage = !.Info ^ opt_trail_usage,
Cond = _ - CondGoalInfo,
goal_info_get_code_model(CondGoalInfo, CondCodeModel),
- ( CondCodeModel = model_non ->
- gen_reset_ticket_solve(TicketVar, Context, ResetTicketSolveGoal,
- !.Info),
- Then = conj(plain_conj, [ResetTicketSolveGoal, Then1]) - Then1GoalInfo
+ (
+ OptTrailUsage = yes,
+ CondCodeModel \= model_non,
+ goal_cannot_modify_trail(CondGoalInfo) = yes
+ ->
+ Goal = if_then_else(ExistQVars, Cond, Then1, Else1)
;
- gen_reset_ticket_commit(TicketVar, Context, ResetTicketCommitGoal,
- !.Info),
- gen_prune_ticket(Context, PruneTicketGoal, !.Info),
- Then = conj(plain_conj,
- [ResetTicketCommitGoal, PruneTicketGoal, Then1])
- - Then1GoalInfo
- ),
- gen_reset_ticket_undo(TicketVar, Context, ResetTicketUndoGoal, !.Info),
- gen_discard_ticket(Context, DiscardTicketGoal, !.Info),
- Else1 = _ - Else1GoalInfo,
- Else = conj(plain_conj, [ResetTicketUndoGoal, DiscardTicketGoal, Else1])
- - Else1GoalInfo,
- IfThenElse = if_then_else(A, Cond, Then, Else) - GoalInfo,
- Goal = conj(plain_conj, [StoreTicketGoal, IfThenElse]).
+ % Allocate a new trail ticket so that we can restore things if the
+ % condition fails.
+ %
+ new_ticket_var(TicketVar, !Info),
+ goal_info_get_context(GoalInfo, Context),
+ gen_store_ticket(TicketVar, Context, StoreTicketGoal, !.Info),
+ %
+ % Commit the trail ticket entries if the condition succeeds.
+ %
+ Then1 = _ - Then1GoalInfo,
+ ( CondCodeModel = model_non ->
+ gen_reset_ticket_solve(TicketVar, Context, ResetTicketSolveGoal,
+ !.Info),
+ Then =
+ conj(plain_conj, [ResetTicketSolveGoal, Then1]) - Then1GoalInfo
+ ;
+ gen_reset_ticket_commit(TicketVar, Context, ResetTicketCommitGoal,
+ !.Info),
+ gen_prune_ticket(Context, PruneTicketGoal, !.Info),
+ Then = conj(plain_conj,
+ [ResetTicketCommitGoal, PruneTicketGoal, Then1])
+ - Then1GoalInfo
+ ),
+ gen_reset_ticket_undo(TicketVar, Context, ResetTicketUndoGoal, !.Info),
+ gen_discard_ticket(Context, DiscardTicketGoal, !.Info),
+ Else1 = _ - Else1GoalInfo,
+ Else = conj(plain_conj, [ResetTicketUndoGoal, DiscardTicketGoal, Else1])
+ - Else1GoalInfo,
+ IfThenElse = if_then_else(ExistQVars, Cond, Then, Else) - GoalInfo,
+ Goal = conj(plain_conj, [StoreTicketGoal, IfThenElse])
+ ).
goal_expr_add_trail_ops(Goal @ plain_call(_, _, _, _, _, _), GI, Goal - GI,
!Info).
@@ -304,7 +309,8 @@
goal_expr_add_trail_ops(PragmaForeign, GoalInfo, Goal, !Info) :-
PragmaForeign = call_foreign_proc(_, _, _, _, _, _, Impl),
- ( Impl = fc_impl_model_non(_, _, _, _, _, _, _, _, _) ->
+ (
+ Impl = fc_impl_model_non(_, _, _, _, _, _, _, _, _),
% XXX Implementing trailing for nondet pragma foreign_code via
% transformation is difficult, because there's nowhere in the HLDS
% pragma_foreign_code goal where we can insert trailing operations.
@@ -318,6 +324,9 @@
SorryNotImplementedCode),
Goal = SorryNotImplementedCode
;
+ ( Impl = fc_impl_ordinary(_, _)
+ ; Impl = fc_impl_import(_, _, _, _)
+ ),
Goal = PragmaForeign - GoalInfo
).
@@ -331,39 +340,24 @@
conj_add_trail_ops(Goals0, Goals, !Info) :-
list.map_foldl(goal_add_trail_ops, Goals0, Goals, !Info).
-:- pred disj_add_trail_ops(hlds_goals::in, bool::in, bool::in,
- code_model::in, prog_var::in, hlds_goals::out,
- trail_ops_info::in, trail_ops_info::out) is det.
-
-disj_add_trail_ops([], _, _, _, _, [], !Info).
-disj_add_trail_ops([Goal0 | Goals0], IsFirstBranch, PrevDisjunctModifiesTrail,
- CodeModel, TicketVar, [Goal | Goals], !Info) :-
+:- pred disj_add_trail_ops(hlds_goals::in, bool::in, code_model::in,
+ prog_var::in, hlds_goals::out, trail_ops_info::in, trail_ops_info::out)
+ is det.
+
+disj_add_trail_ops([], _, _, _, [], !Info).
+disj_add_trail_ops([Goal0 | Goals0], IsFirstBranch, CodeModel, TicketVar,
+ [Goal | Goals], !Info) :-
Goal0 = _ - GoalInfo0,
goal_info_get_context(GoalInfo0, Context),
% First undo the effects of any earlier branches.
(
IsFirstBranch = yes,
- UndoList = [],
- expect(unify(PrevDisjunctModifiesTrail, no), this_file,
- "PrevDisjunctModifiesTrail = yes for initial disjunct.")
+ UndoList = []
;
IsFirstBranch = no,
- %
- % We only need to undo the changes from the last disjunction if it
- % actually modified the trail. We only do this if
- % `--optimize-trail-usage' is set.
- %
- (
- PrevDisjunctModifiesTrail = no,
- !.Info ^ opt_trail_usage = yes
- ->
- UndoList0 = []
- ;
- gen_reset_ticket_undo(TicketVar, Context, ResetTicketUndoGoal,
- !.Info),
- UndoList0 = [ResetTicketUndoGoal]
- ),
+ gen_reset_ticket_undo(TicketVar, Context, ResetTicketUndoGoal, !.Info),
+ UndoList0 = [ResetTicketUndoGoal],
(
Goals0 = [],
% Once we've reached the last disjunct, we can discard
@@ -375,29 +369,19 @@
UndoList = UndoList0
)
),
- %
- % Add trailing code to the disjunct itself. We can omit the trailing code
- % if the disjunct doesn't modify the trail and `--optimize-trail-usage' is
- % set.
- %
- ThisDisjunctModifiesTrail = goal_may_modify_trail(GoalInfo0),
- CanOmitTrailOps =
- not(ThisDisjunctModifiesTrail) `and` !.Info ^ opt_trail_usage,
- (
- CanOmitTrailOps = yes,
- Goal1 = Goal0
- ;
- CanOmitTrailOps = no,
- goal_add_trail_ops(Goal0, Goal1, !Info)
- ),
+ goal_add_trail_ops(Goal0, Goal1, !Info),
%
% For model_semi and model_det disjunctions, once we reach the end of
% the disjunct goal, we're committing to this disjunct, so we need to
% prune the trail ticket.
%
- ( CodeModel = model_non ->
+ (
+ CodeModel = model_non,
PruneList = []
;
+ ( CodeModel = model_det
+ ; CodeModel = model_semi
+ ),
gen_reset_ticket_commit(TicketVar, Context, ResetTicketCommitGoal,
!.Info),
gen_prune_ticket(Context, PruneTicketGoal, !.Info),
@@ -411,8 +395,7 @@
%
% Recursively handle the remaining disjuncts.
%
- disj_add_trail_ops(Goals0, no, ThisDisjunctModifiesTrail, CodeModel,
- TicketVar, Goals, !Info).
+ disj_add_trail_ops(Goals0, no, CodeModel, TicketVar, Goals, !Info).
:- pred cases_add_trail_ops(list(case)::in, list(case)::out,
trail_ops_info::in, trail_ops_info::out) is det.
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.329
diff -u -r1.329 code_info.m
--- compiler/code_info.m 22 Aug 2006 05:03:39 -0000 1.329
+++ compiler/code_info.m 5 Sep 2006 07:47:15 -0000
@@ -205,6 +205,8 @@
:- pred set_used_env_vars(set(string)::in, code_info::in, code_info::out)
is det.
+:- pred get_opt_trail_ops(code_info::in, bool::out) is det.
+
%---------------------------------------------------------------------------%
:- implementation.
@@ -216,8 +218,6 @@
:- pred get_opt_no_return_calls(code_info::in, bool::out) is det.
-:- pred get_opt_trail_ops(code_info::in, bool::out) is det.
-
:- pred get_zombies(code_info::in, set(prog_var)::out) is det.
:- pred set_zombies(set(prog_var)::in, code_info::in, code_info::out) is det.
@@ -2855,12 +2855,9 @@
:- pred maybe_discard_and_release_ticket(maybe(lval)::in, code_tree::out,
code_info::in, code_info::out) is det.
- % Tests if we should add trail ops to the code we generate for the goal
- % with the given goalinfo. This will be 'no' unless we are compiling
- % in trailing grade. It may also be 'no' in trailing grades if we are
- % optimizing trail usage and trail usage analysis tells us that it is safe
- % to omit the trail ops.
- %
+ % Should we add trail ops to the code we generate for the goal with the
+ % given goal_info. This will be 'no' unless we are in a trailing grade.
+ %
:- func should_add_trail_ops(code_info, hlds_goal_info) = add_trail_ops.
%---------------------------------------------------------------------------%
@@ -3051,21 +3048,16 @@
Code = empty
).
-should_add_trail_ops(CodeInfo, GoalInfo) = AddTrailOps :-
+ % XXX We will eventually need to pass GoalInfo here.
+ %
+should_add_trail_ops(CodeInfo, _GoalInfo) = AddTrailOps :-
get_emit_trail_ops(CodeInfo, EmitTrailOps),
(
EmitTrailOps = no,
AddTrailOps = no
;
EmitTrailOps = yes,
- get_opt_trail_ops(CodeInfo, OptTrailOps),
- (
- OptTrailOps = no,
- AddTrailOps = yes
- ;
- OptTrailOps = yes,
- AddTrailOps = goal_may_modify_trail(GoalInfo)
- )
+ AddTrailOps = yes
).
%---------------------------------------------------------------------------%
Index: compiler/disj_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/disj_gen.m,v
retrieving revision 1.95
diff -u -r1.95 disj_gen.m
--- compiler/disj_gen.m 22 Aug 2006 05:03:43 -0000 1.95
+++ compiler/disj_gen.m 23 Aug 2006 06:27:53 -0000
@@ -133,11 +133,9 @@
code_info.get_next_label(EndLabel, !CI),
code_info.remember_position(!.CI, BranchStart),
- PrevBranchModifiesTrail = no,
generate_disjuncts(Goals, CodeModel, ResumeMap, no, HijackInfo,
- DisjGoalInfo, EndLabel, ReclaimHeap, PrevBranchModifiesTrail,
- MaybeHpSlot, MaybeTicketSlot, BranchStart, no, MaybeEnd, GoalsCode,
- !CI),
+ DisjGoalInfo, EndLabel, ReclaimHeap, MaybeHpSlot, MaybeTicketSlot,
+ BranchStart, no, MaybeEnd, GoalsCode, !CI),
goal_info_get_store_map(DisjGoalInfo, StoreMap),
code_info.after_all_branches(StoreMap, MaybeEnd, !CI),
@@ -153,17 +151,17 @@
:- pred generate_disjuncts(list(hlds_goal)::in, code_model::in,
resume_map::in, maybe(resume_point_info)::in, disj_hijack_info::in,
- hlds_goal_info::in, label::in, bool::in, bool::in, maybe(lval)::in,
+ hlds_goal_info::in, label::in, bool::in, maybe(lval)::in,
maybe(lval)::in, position_info::in, maybe(branch_end_info)::in,
maybe(branch_end_info)::out, code_tree::out, code_info::in,
code_info::out) is det.
-generate_disjuncts([], _, _, _, _, _, _, _, _, _, _, _, _, _, _, !CI) :-
+generate_disjuncts([], _, _, _, _, _, _, _, _, _, _, _, _, _, !CI) :-
unexpected(this_file, "generate_disjuncts: empty disjunction!").
generate_disjuncts([Goal0 | Goals], CodeModel, FullResumeMap,
MaybeEntryResumePoint, HijackInfo, DisjGoalInfo, EndLabel, ReclaimHeap,
- PrevBranchModifiesTrail, MaybeHpSlot0, MaybeTicketSlot, BranchStart0,
- MaybeEnd0, MaybeEnd, Code, !CI) :-
+ MaybeHpSlot0, MaybeTicketSlot, BranchStart0, MaybeEnd0, MaybeEnd,
+ Code, !CI) :-
code_info.reset_to_position(BranchStart0, !CI),
%
@@ -192,16 +190,8 @@
code_info.maybe_restore_hp(MaybeHpSlot0, RestoreHpCode),
% Reset the solver state if necessary.
- (
- PrevBranchModifiesTrail = yes,
- code_info.maybe_reset_ticket(MaybeTicketSlot,
- reset_reason_undo, RestoreTicketCode)
- ;
- % Don't bother if the previous branch is known not to modify
- % the trail.
- PrevBranchModifiesTrail = no,
- RestoreTicketCode = empty
- )
+ code_info.maybe_reset_ticket(MaybeTicketSlot,
+ reset_reason_undo, RestoreTicketCode)
;
MaybeEntryResumePoint = no,
RestoreHpCode = empty,
@@ -296,15 +286,10 @@
goto(label(EndLabel)) - "skip to end of nondet disj"
]),
- % Check if this branch modifies the trail. If it doesn't then the next
- % branch can avoid resetting it.
- %
- ThisBranchModifiesTrail = goal_may_modify_trail(GoalInfo),
-
disj_gen.generate_disjuncts(Goals, CodeModel, FullResumeMap,
yes(NextResumePoint), HijackInfo, DisjGoalInfo,
- EndLabel, ReclaimHeap, ThisBranchModifiesTrail, MaybeHpSlot,
- MaybeTicketSlot, BranchStart, MaybeEnd1, MaybeEnd, RestCode, !CI),
+ EndLabel, ReclaimHeap, MaybeHpSlot, MaybeTicketSlot, BranchStart,
+ MaybeEnd1, MaybeEnd, RestCode, !CI),
Code = tree_list([EntryResumePointCode, RestoreHpCode,
RestoreTicketCode, SaveHpCode, ModContCode, TraceCode,
@@ -317,15 +302,8 @@
%
code_info.maybe_restore_and_release_hp(MaybeHpSlot0, RestoreHpCode,
!CI),
- (
- PrevBranchModifiesTrail = yes,
- code_info.maybe_reset_discard_and_release_ticket(MaybeTicketSlot,
- reset_reason_undo, RestoreTicketCode, !CI)
- ;
- PrevBranchModifiesTrail = no,
- code_info.maybe_discard_and_release_ticket(MaybeTicketSlot,
- RestoreTicketCode, !CI)
- ),
+ code_info.maybe_reset_discard_and_release_ticket(MaybeTicketSlot,
+ reset_reason_undo, RestoreTicketCode, !CI),
code_info.undo_disj_hijack(HijackInfo, UndoCode, !CI),
Index: compiler/ite_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/ite_gen.m,v
retrieving revision 1.92
diff -u -r1.92 ite_gen.m
--- compiler/ite_gen.m 22 Aug 2006 05:03:49 -0000 1.92
+++ compiler/ite_gen.m 23 Aug 2006 07:18:41 -0000
@@ -112,7 +112,26 @@
code_info.maybe_save_hp(ReclaimHeap, SaveHpCode, MaybeHpSlot, !CI),
% Maybe save the current trail state before the condition.
- code_info.maybe_save_ticket(AddTrailOps, SaveTicketCode, MaybeTicketSlot,
+ % NOTE: this code should be kept up-to-date with the corresponding
+ % code for the MLDS backend in add_trail_ops.m.
+ (
+ AddTrailOps = no,
+ IteTrailOps = no
+ ;
+ AddTrailOps = yes,
+ get_opt_trail_ops(!.CI, OptTrailOps),
+ (
+ OptTrailOps = yes,
+ goal_cannot_modify_trail(CondInfo0) = yes,
+ CondCodeModel \= model_non
+ ->
+ IteTrailOps = no
+ ;
+ IteTrailOps = yes
+ )
+ ),
+
+ code_info.maybe_save_ticket(IteTrailOps, SaveTicketCode, MaybeTicketSlot,
!CI),
code_info.remember_position(!.CI, BranchStart),
Index: compiler/trailing_analysis.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trailing_analysis.m,v
retrieving revision 1.21
diff -u -r1.21 trailing_analysis.m
--- compiler/trailing_analysis.m 5 Sep 2006 06:21:32 -0000 1.21
+++ compiler/trailing_analysis.m 5 Sep 2006 07:36:56 -0000
@@ -466,38 +466,35 @@
Result, MaybeAnalysisStatus, !ModuleInfo, !IO).
check_goal_for_trail_mods_2(SCC, VarTypes, Goal, _,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
- Goal = if_then_else(_, If, Then, Else),
- check_goals_for_trail_mods(SCC, VarTypes, [If, Then, Else],
+ Goal = if_then_else(_, Cond, Then, Else),
+ check_goals_for_trail_mods(SCC, VarTypes, [Cond, Then, Else],
Result0, MaybeAnalysisStatus, !ModuleInfo, !IO),
(
- % If none of the disjuncts can modify the trail then we don't need
- % to emit trailing code around this disjunction.
- Result0 = trail_will_not_modify,
- Result = trail_will_not_modify
- ;
- % If some of the goals modify the trail then we need to emit trailing
- % code around the if-then-else. If the if-then-else has status
- % `trail_conditional' then we also need to emit trailing code around it
- % because we cannot be sure that calls to builtin.{unify,compare}
- % won't call user-defined equality/comparison predicates that modify
- % the trail.
- %
- % XXX We change the status from `trail_conditional' to
- % `trail_may_modify' here because `trail_conditional' currently means
- % that the code for a procedure does not modify the state of the trail
- % at all. Since we emit trailing code for this if-then-else then
- % by this definition it does modify the trail. We may be able to relax
- % this restriction in future, but at the moment doing this helps keep
- % the contents of the .opt/.trans_opt/.analysis files consistent
- % with the actual code we generate.
+ % If the condition of an if-then-else does not modify the trail
+ % and is not model_non then we can omit the trailing ops around
+ % the condition.
+ %
+ % NOTE: any changes here may need to be relected in the clause
+ % of add_trail_ops.goal_expr_add_trail_ops that handles if_then_elses.
%
+ Result0 = trail_will_not_modify,
+ Cond = _CondGoalExpr - CondGoalInfo,
+ goal_info_get_code_model(CondGoalInfo, CondCodeModel),
+ CondCodeModel \= model_non
+ ->
+ Result = trail_will_not_modify
+ ;
+ % If the condition modifies the trail, is model_non or both then
+ % we need to emit trailing ops around the conditoin. If the
+ % if-then-else has status `trail_conditional' then we also need
+ % to emit the trail ops because we cannot be sure that calls to
+ % builtin.{unify,compare} won't call user-defined equality or
+ % comparison predicates that modify the trail.
+ %
% NOTE: conditional procedures whose status is changed here are
% candidates for generating specialized versions that omit
% the trailing code.
%
- ( Result0 = trail_conditional
- ; Result0 = trail_may_modify
- ),
Result = trail_may_modify
).
check_goal_for_trail_mods_2(SCC, VarTypes, conj(_, Goals), _,
@@ -507,20 +504,11 @@
check_goal_for_trail_mods_2(SCC, VarTypes, disj(Goals), _,
Result, MaybeAnalysisStatus, !ModuleInfo, !IO) :-
check_goals_for_trail_mods(SCC, VarTypes, Goals,
- Result0, MaybeAnalysisStatus, !ModuleInfo, !IO),
- (
- % If none of the disjuncts can modify the trail then we don't need
- % to emit trailing code around this disjunction.
- Result0 = trail_will_not_modify,
- Result = trail_will_not_modify
- ;
- % See the comment regarding if-then-elses above for the reason
- % we treat `conditional' procedures like this.
- ( Result0 = trail_conditional
- ; Result0 = trail_may_modify
- ),
- Result = trail_may_modify
- ).
+ _Result0, MaybeAnalysisStatus, !ModuleInfo, !IO),
+ % XXX Currently we have to put trailing code around disjunctions.
+ % If we introduce trail specialisation it may be possible to
+ % omit it.
+ Result = trail_may_modify.
:- pred check_goals_for_trail_mods(scc::in, vartypes::in,
hlds_goals::in, trailing_status::out, maybe(analysis_status)::out,
@@ -558,8 +546,7 @@
% If we're at a commit for a goal that might modify the trail
% then we need to emit some trailing code around the scope goal.
InnerCodeModel = model_non,
- OuterCodeModel \= model_non,
- InnerStatus \= trail_will_not_modify
+ OuterCodeModel \= model_non
->
trail_may_modify
;
Index: tests/trailing/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/trailing/Mercury.options,v
retrieving revision 1.1
diff -u -r1.1 Mercury.options
--- tests/trailing/Mercury.options 11 Jan 2006 05:12:21 -0000 1.1
+++ tests/trailing/Mercury.options 29 Aug 2006 08:25:50 -0000
@@ -0,0 +1,5 @@
+# Turn on trail usage optimization for these tests since that is
+# what they are testing.
+#
+MCFLAGS-tu_test1 = --analyse-trail-usage
+MCFLAGS-tu_test2 = --analyse-trail-usage
Index: tests/trailing/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/trailing/Mmakefile,v
retrieving revision 1.2
diff -u -r1.2 Mmakefile
--- tests/trailing/Mmakefile 27 Jan 2006 05:19:02 -0000 1.2
+++ tests/trailing/Mmakefile 23 Aug 2006 08:45:49 -0000
@@ -9,7 +9,9 @@
else
TRAIL_PROGS = \
func_trail_test \
- func_trail_test_2
+ func_trail_test_2 \
+ tu_test1 \
+ tu_test2
endif
#-----------------------------------------------------------------------------#
Index: tests/trailing/tu_test1.exp
===================================================================
RCS file: tests/trailing/tu_test1.exp
diff -N tests/trailing/tu_test1.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/trailing/tu_test1.exp 23 Aug 2006 08:45:28 -0000
@@ -0,0 +1,13 @@
+undo 1
+undo 2
+undo 3
+undo 4
+solve (soft commit) 5
+undo 5
+undo 6
+solve (soft commit) 7
+undo 7
+undo 8
+undo 9
+undo 10
+[5, 7]
Index: tests/trailing/tu_test1.m
===================================================================
RCS file: tests/trailing/tu_test1.m
diff -N tests/trailing/tu_test1.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/trailing/tu_test1.m 23 Aug 2006 08:45:28 -0000
@@ -0,0 +1,101 @@
+:- module tu_test1.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module solutions.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ solutions(test(1), Solns),
+ io.write(Solns, !IO),
+ io.nl(!IO).
+
+:- pred test(int::in, int::out) is nondet.
+
+test(X, Y) :-
+ promise_pure (
+ between(X, 10, Y),
+ impure save_ref_on_trail(Y),
+ is_correct(Y)
+ ).
+
+:- pred is_correct(int::in) is semidet.
+
+is_correct(5).
+is_correct(7).
+
+:- pred between(int::in, int::in, int::out) is multi.
+
+between(N, _, N).
+between(L, U, N) :-
+ L < U,
+ between(L + 1, U, N).
+
+:- impure pred save_ref_on_trail(int::in) is det.
+:- pragma foreign_proc("C",
+ save_ref_on_trail(I::in),
+ [will_not_call_mercury, may_modify_trail],
+"
+ MR_trail_function(print_entry, (void *)I);
+").
+
+:- pragma foreign_decl("C", "
+ #include <stdio.h>
+ #include <stdlib.h>
+ extern void print_entry(void *, MR_untrail_reason);
+").
+
+:- pragma foreign_code("C", "
+void
+print_entry(void *value, MR_untrail_reason reason)
+{
+ switch (reason) {
+ case MR_undo:
+ printf(
+ \"undo %\" MR_INTEGER_LENGTH_MODIFIER \"d\\n\",
+ (MR_Integer)value);
+ break;
+
+ case MR_solve:
+ printf(
+ \"solve (soft commit) %\" MR_INTEGER_LENGTH_MODIFIER \"d\\n\",
+ (MR_Integer)value);
+ break;
+
+ case MR_commit:
+ printf(
+ \"*** unexpected (hard) commit %\" MR_INTEGER_LENGTH_MODIFIER \"d\\n\",
+ (MR_Integer)value);
+ break;
+
+ case MR_retry:
+ printf(
+ \"*** unexpected retry %\" MR_INTEGER_LENGTH_MODIFIER \"d\\n\",
+ (MR_Integer)value);
+ break;
+
+ case MR_exception:
+ printf(
+ \"*** unexpected exception %\" MR_INTEGER_LENGTH_MODIFIER \"d\\n\",
+ (MR_Integer)value);
+ break;
+
+ default:
+ printf(\"*** Unexpected call to print_entry\");
+ }
+}
+").
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
Index: tests/trailing/tu_test2.m
===================================================================
RCS file: tests/trailing/tu_test2.m
diff -N tests/trailing/tu_test2.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/trailing/tu_test2.m 5 Sep 2006 08:13:37 -0000
@@ -0,0 +1,71 @@
+% Test removal of trailing primitives around semidet if-then-else conditions.
+%
+% The following test case checks that trail usage optimization really does
+% optimize trailing primitives from if-then-elses with semidet conditions that
+% do not modify the trail. The test works by calling a predicate that adds a
+% function entry to the trail in the condition of an if_then_else. We lie
+% to the compiler about the trailing status of that predicate and pretend
+% that it does not modify the trail. If the trail usage optimization is
+% working the function placed on the trail should never be called when
+% we commit to a solution.
+
+:- module tu_test2.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module string.
+
+%----------------------------------------------------------------------------%
+
+main(!IO) :-
+ test(10, X),
+ io.format("X = %d\n", [i(X)], !IO).
+
+:- pragma promise_pure(test/2).
+:- pred test(int::in, int::out) is det.
+
+test(X, Y) :-
+ (
+ impure store_stuff_on_trail,
+ X = 3
+ ->
+ Y = -100
+ ;
+ Y = 100
+ ).
+
+ % `will_not_modify_trail' is a lie.
+ %
+:- impure pred store_stuff_on_trail is det.
+:- pragma foreign_proc("C",
+ store_stuff_on_trail,
+ [will_not_call_mercury, will_not_modify_trail],
+"
+ MR_trail_function(print_entry, NULL);
+").
+
+:- pragma foreign_decl("C", "
+ #include <stdio.h>
+ #include <stdlib.h>
+ extern void print_entry(void *, MR_untrail_reason);
+").
+
+:- pragma foreign_code("C", "
+void
+print_entry(void *value, MR_untrail_reason reason)
+{
+ printf(\"Trail function called.\\n\");
+}").
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list