[m-rev.] for post-commit review: push goals in implicit_parallelism.m
Zoltan Somogyi
zs at csse.unimelb.edu.au
Mon Jan 3 17:39:43 AEDT 2011
For Paul to test, and to review by making changes to the code.
Zoltan.
compiler/implicit_parallelism.m:
Add support for pushing expensive goals in different conjunctions
into the same conjunction, so we can parallelize that conjunction.
This support is not yet tested, but Paul should now be able to test it.
compiler/follow_code.m:
compiler/goal_util.m:
Minor style improvements.
cvs diff: Diffing .
Index: follow_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/follow_code.m,v
retrieving revision 1.101
diff -u -b -r1.101 follow_code.m
--- follow_code.m 2 Jan 2011 16:17:01 -0000 1.101
+++ follow_code.m 3 Jan 2011 04:17:19 -0000
@@ -372,9 +372,8 @@
; MaxSolns0 = at_most_many_cc
),
check_follow_code_detism(FollowGoals, Detism0),
- ( GoalExpr0 = conj(plain_conj, GoalList0) ->
- list.append(GoalList0, FollowGoals, GoalList),
- GoalExpr = conj(plain_conj, GoalList)
+ ( GoalExpr0 = conj(plain_conj, Conjuncts0) ->
+ GoalExpr = conj(plain_conj, Conjuncts0 ++ FollowGoals)
;
GoalExpr = conj(plain_conj, [Goal0 | FollowGoals])
),
Index: goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.178
diff -u -b -r1.178 goal_util.m
--- goal_util.m 30 Dec 2010 11:17:54 -0000 1.178
+++ goal_util.m 3 Jan 2011 04:18:42 -0000
@@ -489,7 +489,7 @@
( instmap_delta_search_var(InstMapDelta, OrigVar, DeltaInst) ->
NewInst = DeltaInst
;
- unexpected(this_file, "create_renaming_2: cannot get new inst")
+ unexpected($module, $pred, "cannot get new inst")
),
Mode = ((NewInst -> NewInst) - (free -> NewInst)),
UnifyInfo = assign(OrigVar, NewVar),
@@ -1249,7 +1249,7 @@
goal_calls_proc_in_list_2(SubGoal, PredProcIds, !CalledSet)
;
ShortHand = bi_implication(_, _),
- unexpected(this_file, "goal_calls_proc_in_list_2: bi_implication")
+ unexpected($module, $pred, "bi_implication")
)
).
@@ -1358,7 +1358,7 @@
->
ArgInsts = ArgInsts1
;
- unexpected(this_file, "case_to_disjunct - get_arg_insts failed")
+ unexpected($module, $pred, "get_arg_insts failed")
),
InstToUniMode = (pred(ArgInst::in, ArgUniMode::out) is det :-
ArgUniMode = ((ArgInst - free) -> (ArgInst - ArgInst))
@@ -1423,28 +1423,28 @@
create_conj(GoalA, GoalB, Type, ConjGoal) :-
create_conj_from_list([GoalA, GoalB], Type, ConjGoal).
-create_conj_from_list(GoalsInConj, Type, ConjGoal) :-
+create_conj_from_list(Conjuncts, ConjType, ConjGoal) :-
(
- GoalsInConj = [ GoalA | GoalsTail ],
+ Conjuncts = [HeadGoal | TailGoals],
(
- GoalsTail = [ _ | _ ],
- ConjGoalExpr = conj(Type, GoalsInConj),
- goal_list_nonlocals(GoalsInConj, NonLocals),
- goal_list_instmap_delta(GoalsInConj, InstMapDelta),
- goal_list_determinism(GoalsInConj, Detism),
- goal_list_purity(GoalsInConj, Purity),
- GoalAInfo = GoalA ^ hlds_goal_info,
- Context = goal_info_get_context(GoalAInfo),
+ TailGoals = [ _ | _ ],
+ ConjGoalExpr = conj(ConjType, Conjuncts),
+ goal_list_nonlocals(Conjuncts, NonLocals),
+ goal_list_instmap_delta(Conjuncts, InstMapDelta),
+ goal_list_determinism(Conjuncts, Detism),
+ goal_list_purity(Conjuncts, Purity),
+ HeadGoal = hlds_goal(_, HeadGoalInfo),
+ Context = goal_info_get_context(HeadGoalInfo),
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
ConjGoalInfo),
ConjGoal = hlds_goal(ConjGoalExpr, ConjGoalInfo)
;
- GoalsTail = [],
- ConjGoal = GoalA
+ TailGoals = [],
+ ConjGoal = HeadGoal
)
;
- GoalsInConj = [],
- unexpected(this_file, "create_conj_from_list: empty conjunction")
+ Conjuncts = [],
+ unexpected($module, $pred, "empty conjunction")
).
%-----------------------------------------------------------------------------%
@@ -1652,7 +1652,7 @@
),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_purity(PredInfo, PredPurity),
- expect(unify(Purity, PredPurity), this_file,
+ expect(unify(Purity, PredPurity), $module,
"generate_simple_call: purity disagreement"),
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
GoalInfo0),
@@ -1685,7 +1685,7 @@
),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_get_purity(PredInfo, PredPurity),
- expect(unify(Purity, PredPurity), this_file,
+ expect(unify(Purity, PredPurity), $module,
"generate_simple_call: purity disagreement"),
goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
GoalInfo0),
@@ -1757,7 +1757,7 @@
GoalIsAtomic = goal_is_nonatomic
;
GoalExpr = shorthand(_),
- unexpected(this_file, "goal_is_atomic/2: shorthand goal")
+ unexpected($module, $pred, "shorthand")
).
%-----------------------------------------------------------------------------%
@@ -1838,8 +1838,7 @@
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
ShortHand0 = bi_implication(_, _),
- unexpected(this_file,
- "maybe_strip_equality_pretest: bi_implication")
+ unexpected($module, $pred, "bi_implication")
)
).
@@ -2035,8 +2034,7 @@
)
;
GoalExpr0 = shorthand(_),
- unexpected(this_file,
- "Shorthand goals should have been eliminated already")
+ unexpected($module, $pred, "shorthand")
)
).
@@ -2221,8 +2219,7 @@
)
;
GoalExpr0 = shorthand(_),
- unexpected(this_file,
- "Shorthand goals should have been eliminated already")
+ unexpected($module, $pred, "shorthand")
)
).
@@ -2273,18 +2270,11 @@
GoalExpr = if_then_else(ExistVars, Cond, Then, Else)
;
GoalExpr0 = shorthand(_),
- unexpected(this_file,
- "Shorthand goals should have been eliminated already")
+ unexpected($module, $pred, "shorthand")
),
Goal1 = Goal0 ^ hlds_goal_expr := GoalExpr,
TransformP(Goal1, Goal).
%-----------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "goal_util.m".
-
-%-----------------------------------------------------------------------------%
:- end_module goal_util.
%-----------------------------------------------------------------------------%
Index: implicit_parallelism.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/implicit_parallelism.m,v
retrieving revision 1.27
diff -u -b -r1.27 implicit_parallelism.m
--- implicit_parallelism.m 30 Dec 2010 11:17:55 -0000 1.27
+++ implicit_parallelism.m 3 Jan 2011 06:09:05 -0000
@@ -42,6 +42,7 @@
:- import_module hlds.goal_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
+:- import_module hlds.hlds_rtti.
:- import_module hlds.instmap.
:- import_module hlds.pred_table.
:- import_module hlds.quantification.
@@ -87,8 +88,9 @@
MaybeModuleInfo = ok(!:ModuleInfo)
;
MaybeModuleInfo = error(Error),
- sorry(this_file, "The old implicit parallelism code is not "
- ++ "supported: " ++ Error)
+ sorry($module,
+ "The old implicit parallelism code is not supported: "
+ ++ Error)
)
;
UseOldImplicitParallelism = no,
@@ -97,7 +99,8 @@
MaybeSourceFileMap = yes(SourceFileMap)
;
MaybeSourceFileMap = no,
- error(this_file ++ "could not retrieve the source file map")
+ unexpected($module, $pred,
+ "could not retrieve the source file map")
),
apply_new_implicit_parallelism_transformation(SourceFileMap, Specs,
!ModuleInfo),
@@ -131,14 +134,14 @@
module_info_get_valid_predids(PredIds, !ModuleInfo),
module_info_get_predicate_table(!.ModuleInfo, PredTable0),
predicate_table_get_preds(PredTable0, PredMap0),
- list.foldl3(maybe_parallelise_pred(!.ModuleInfo, ParallelismInfo),
+ list.foldl4(maybe_parallelise_pred(ParallelismInfo),
PredIds, PredMap0, PredMap,
- have_not_introduced_parallelism, IntroducedParallelism,
- [], Specs),
+ have_not_introduced_parallelism, AnyPredIntroducedParallelism,
+ !ModuleInfo, [], Specs),
(
- IntroducedParallelism = have_not_introduced_parallelism
+ AnyPredIntroducedParallelism = have_not_introduced_parallelism
;
- IntroducedParallelism = introduced_parallelism,
+ AnyPredIntroducedParallelism = introduced_parallelism,
predicate_table_set_preds(PredMap, PredTable0, PredTable),
module_info_set_predicate_table(PredTable, !ModuleInfo),
module_info_set_contains_par_conj(!ModuleInfo)
@@ -225,37 +228,39 @@
%-----------------------------------------------------------------------------%
-:- pred maybe_parallelise_pred(module_info::in, parallelism_info::in,
+:- pred maybe_parallelise_pred(parallelism_info::in,
pred_id::in, pred_table::in, pred_table::out,
introduced_parallelism::in, introduced_parallelism::out,
+ module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-maybe_parallelise_pred(ModuleInfo, ParallelismInfo, PredId, !PredTable,
- !IntroducedParallelism, !Specs) :-
+maybe_parallelise_pred(ParallelismInfo, PredId, !PredTable,
+ !AnyPredIntroducedParallelism, !ModuleInfo, !Specs) :-
map.lookup(!.PredTable, PredId, PredInfo0),
ProcIds = pred_info_non_imported_procids(PredInfo0),
pred_info_get_procedures(PredInfo0, ProcTable0),
- list.foldl3(maybe_parallelise_proc(ModuleInfo, ParallelismInfo, PredId),
- ProcIds, ProcTable0, ProcTable, have_not_introduced_parallelism,
- ProcIntroducedParallelism, !Specs),
+ list.foldl4(maybe_parallelise_proc(ParallelismInfo, PredInfo0, PredId),
+ ProcIds, ProcTable0, ProcTable,
+ have_not_introduced_parallelism, AnyProcIntroducedParallelism,
+ !ModuleInfo, !Specs),
(
- ProcIntroducedParallelism = have_not_introduced_parallelism
+ AnyProcIntroducedParallelism = have_not_introduced_parallelism
;
- ProcIntroducedParallelism = introduced_parallelism,
- !:IntroducedParallelism = introduced_parallelism,
+ AnyProcIntroducedParallelism = introduced_parallelism,
+ !:AnyPredIntroducedParallelism = introduced_parallelism,
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo),
svmap.det_update(PredId, PredInfo, !PredTable)
).
-:- pred maybe_parallelise_proc(module_info::in, parallelism_info::in,
- pred_id::in, proc_id::in, proc_table::in, proc_table::out,
+:- pred maybe_parallelise_proc(parallelism_info::in,
+ pred_info::in, pred_id::in, proc_id::in, proc_table::in, proc_table::out,
introduced_parallelism::in, introduced_parallelism::out,
+ module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-maybe_parallelise_proc(ModuleInfo, ParallelismInfo, PredId, ProcId, !ProcTable,
- !IntroducedParallelism, !Specs) :-
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
- PredInfo, ProcInfo0),
+maybe_parallelise_proc(ParallelismInfo, PredInfo, _PredId, ProcId,
+ !ProcTable, !AnyProcIntroducedParallelism, !ModuleInfo, !Specs) :-
+ map.lookup(!.ProcTable, ProcId, ProcInfo0),
% Lookup the Candidate Parallel Conjunction (CPC) Map for this procedure.
Name = pred_info_name(PredInfo),
@@ -272,49 +277,69 @@
!:Specs = [Spec | !.Specs]
;
HasParallelConj = no,
+ parallelise_proc(CPCProc, PredInfo, ProcInfo0, ProcInfo,
+ ProcIntroducedParallelism, !ModuleInfo, !Specs),
+ (
+ ProcIntroducedParallelism = have_not_introduced_parallelism
+ ;
+ ProcIntroducedParallelism = introduced_parallelism,
+ !:AnyProcIntroducedParallelism = introduced_parallelism,
+ svmap.det_update(ProcId, ProcInfo, !ProcTable)
+ )
+ )
+ ;
+ true
+ ).
- proc_info_get_goal(ProcInfo0, Goal0),
- CPCProc = candidate_par_conjunctions_proc(VarTable, _PushGoals,
+:- pred parallelise_proc(candidate_par_conjunctions_proc::in,
+ pred_info::in, proc_info::in, proc_info::out,
+ introduced_parallelism::out,
+ module_info::in, module_info::out,
+ list(error_spec)::in, list(error_spec)::out) is det.
+
+parallelise_proc(CPCProc, PredInfo, !ProcInfo,
+ IntroducedParallelism, !ModuleInfo, !Specs) :-
+ CPCProc = candidate_par_conjunctions_proc(VarTable, PushGoals,
CPCs0),
- % XXX Obey _PushGoals
+ (
+ PushGoals = []
+ ;
+ PushGoals = [_ | _],
+ push_goals_in_proc(PushGoals, _Result, !ProcInfo, !ModuleInfo)
+ ),
+ proc_info_get_goal(!.ProcInfo, Goal0),
Context = goal_info_get_context(Goal0 ^ hlds_goal_info),
term.context_file(Context, FileName),
- proc_info_get_vartypes(ProcInfo0, VarTypes),
+ proc_info_get_vartypes(!.ProcInfo, VarTypes),
% VarNumRep is not used by goal_to_goal_rep, var_num_1_byte
% is an arbitrary value. XXX zs: I don't think this is true.
VarNumRep = var_num_1_byte,
- proc_info_get_headvars(ProcInfo0, HeadVars),
- proc_info_get_varset(ProcInfo0, VarSet),
+ proc_info_get_headvars(!.ProcInfo, HeadVars),
+ proc_info_get_varset(!.ProcInfo, VarSet),
compute_var_number_map(HeadVars, VarSet, [], Goal0, VarNumMap),
ProgRepInfo = prog_rep_info(FileName, VarTypes, VarNumMap,
- VarNumRep, ModuleInfo),
- proc_info_get_initial_instmap(ProcInfo0, ModuleInfo, Instmap),
+ VarNumRep, !.ModuleInfo),
+ proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, Instmap),
% Sort the candidate parallelisations so that we introduce
% parallelisations in an order that allows us to continue to insert
% parallelisations even as the goal tree changes. In particular,
% insert deeper parallelisations before shallower ones, and later
% ones before earlier ones.
- list.sort_and_remove_dups(compare_candidate_par_conjunctions,
- CPCs0, CPCs),
+ list.sort_and_remove_dups(compare_candidate_par_conjunctions, CPCs0, CPCs),
list.foldl3(
- maybe_parallelise_goal(PredInfo, ProgRepInfo, VarTable,
- Instmap),
- CPCs, Goal0, Goal, !IntroducedParallelism, !Specs),
+ maybe_parallelise_goal(PredInfo, ProgRepInfo, VarTable, Instmap),
+ CPCs, Goal0, Goal,
+ have_not_introduced_parallelism, IntroducedParallelism, !Specs),
(
- !.IntroducedParallelism = introduced_parallelism,
+ IntroducedParallelism = introduced_parallelism,
% In the future we'll specialise the procedure for parallelism,
% We don't do that now so simply replace the procedure's body.
- proc_info_set_goal(Goal, ProcInfo0, ProcInfo1),
- proc_info_set_has_parallel_conj(yes, ProcInfo1, ProcInfo),
- svmap.det_update(ProcId, ProcInfo, !ProcTable)
+ proc_info_set_goal(Goal, !ProcInfo),
+ proc_info_set_has_parallel_conj(yes, !ProcInfo)
;
- !.IntroducedParallelism = have_not_introduced_parallelism
- )
- )
- ;
- true
+ IntroducedParallelism = have_not_introduced_parallelism
).
:- pred compare_candidate_par_conjunctions(candidate_par_conjunction::in,
@@ -350,7 +375,7 @@
;
StepsB = [],
% StepsA is longer than StepsB. Make A 'less than' B so that
- % deeper parallelisations are insearted first.
+ % deeper parallelisations are inserted first.
Result = (<)
)
;
@@ -366,6 +391,834 @@
)
).
+%-----------------------------------------------------------------------------%
+
+:- type push_info
+ ---> push_info(
+ pi_rtti_varmaps :: rtti_varmaps
+ ).
+
+:- type push_result
+ ---> push_failed
+ ; push_succeeded.
+
+ % push_goals_in_proc(PushGoals, OverallResult, !ProcInfo, !ModuleInfo):
+ %
+ % The expensive goals in a procedure are not always in the same
+ % conjunction. However, in some cases, the procedure body can be tranformed
+ % to PUT them into the same conjunction, which can then be parallelised.
+ %
+ % Each PushGoal in PushGoals specifies a transformation that should bring
+ % two or more expensive goals into the same conjunction. This predicate
+ % attempts to perform each of those transformations. It returns
+ % push_succeeded if they all worked, and push_failed if at least one
+ % failed. This can happen because the program has changed since PushGoals
+ % was computed and put into the feedback file, or because PushGoals is
+ % inconsistent (regardless of the date of the file). One example of an
+ % inconsistency would be asking to push a goal into the condition of an
+ % if-then-else.
+ %
+:- pred push_goals_in_proc(list(push_goal)::in, push_result::out,
+ proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
+
+push_goals_in_proc(PushGoals, OverallResult, !ProcInfo, !ModuleInfo) :-
+ proc_info_get_goal(!.ProcInfo, Goal0),
+ proc_info_get_varset(!.ProcInfo, VarSet0),
+ proc_info_get_vartypes(!.ProcInfo, VarTypes0),
+ proc_info_get_rtti_varmaps(!.ProcInfo, RttiVarMaps0),
+ PushInfo = push_info(RttiVarMaps0),
+ do_push_list(PushGoals, PushInfo, OverallResult, Goal0, Goal1),
+ (
+ OverallResult = push_failed
+ ;
+ OverallResult = push_succeeded,
+ % We need to fix up the goal_infos by recalculating the nonlocal sets
+ % and the instmap deltas of the compound goals.
+ proc_info_get_headvars(!.ProcInfo, HeadVars),
+ implicitly_quantify_clause_body_general(ordinary_nonlocals_no_lambda,
+ HeadVars, _Warnings, Goal1, Goal2,
+ VarSet0, VarSet, VarTypes0, VarTypes,
+ RttiVarMaps0, RttiVarMaps),
+ proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo, InstMap0),
+ proc_info_get_inst_varset(!.ProcInfo, InstVarSet),
+ recompute_instmap_delta(do_not_recompute_atomic_instmap_deltas,
+ Goal2, Goal, VarTypes, InstVarSet, InstMap0, !ModuleInfo),
+ proc_info_set_goal(Goal, !ProcInfo),
+ proc_info_set_varset(VarSet, !ProcInfo),
+ proc_info_set_vartypes(VarTypes, !ProcInfo),
+ proc_info_set_rtti_varmaps(RttiVarMaps, !ProcInfo)
+ ).
+
+:- pred do_push_list(list(push_goal)::in, push_info::in,
+ push_result::out, hlds_goal::in, hlds_goal::out) is det.
+
+do_push_list([], _, push_succeeded, !Goal).
+do_push_list([PushGoal | PushGoals], PushInfo, OverallResult, !Goal) :-
+ do_one_push(PushGoal, PushInfo, Result, !Goal),
+ (
+ Result = push_succeeded,
+ do_push_list(PushGoals, PushInfo, OverallResult, !Goal)
+ ;
+ Result = push_failed,
+ OverallResult = push_failed
+ ).
+
+:- pred do_one_push(push_goal::in, push_info::in,
+ push_result::out, hlds_goal::in, hlds_goal::out) is det.
+
+do_one_push(PushGoal, PushInfo, Result, !Goal) :-
+ PushGoal = push_goal(GoalPathStr, _Lo, _Hi, _PushedInto),
+ ( goal_path_from_string(GoalPathStr, GoalPath) ->
+ GoalPath = fgp(GoalPathSteps),
+ do_push_in_goal(GoalPathSteps, PushGoal, PushInfo, Result, !Goal)
+ ;
+ Result = push_failed
+ ).
+
+:- pred do_push_in_goal(list(goal_path_step)::in, push_goal::in, push_info::in,
+ push_result::out, hlds_goal::in, hlds_goal::out) is det.
+
+do_push_in_goal([], PushGoal, PushInfo, Result, !Goal) :-
+ % We have arrives at the goal in which the push should take place.
+ perform_push_transform(PushGoal, PushInfo, Result, !Goal).
+do_push_in_goal([Step | Steps], PushGoal, PushInfo, Result, !Goal) :-
+ !.Goal = hlds_goal(GoalExpr0, GoalInfo0),
+ (
+ Step = step_conj(N),
+ ( GoalExpr0 = conj(ConjType, Goals0) ->
+ do_push_in_goals(N, Steps, PushGoal, PushInfo, Result,
+ Goals0, Goals),
+ GoalExpr = conj(ConjType, Goals),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ Result = push_failed
+ )
+ ;
+ Step = step_disj(N),
+ ( GoalExpr0 = disj(Goals0) ->
+ do_push_in_goals(N, Steps, PushGoal, PushInfo, Result,
+ Goals0, Goals),
+ GoalExpr = disj(Goals),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ Result = push_failed
+ )
+ ;
+ Step = step_switch(N, _),
+ ( GoalExpr0 = switch(Var, CanFail, Cases0) ->
+ do_push_in_cases(N, Steps, PushGoal, PushInfo, Result,
+ Cases0, Cases),
+ GoalExpr = switch(Var, CanFail, Cases),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ Result = push_failed
+ )
+ ;
+ Step = step_ite_cond,
+ ( GoalExpr0 = if_then_else(Vars0, Cond0, Then0, Else0) ->
+ do_push_in_goal(Steps, PushGoal, PushInfo, Result, Cond0, Cond),
+ GoalExpr = if_then_else(Vars0, Cond, Then0, Else0),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ Result = push_failed
+ )
+ ;
+ Step = step_ite_then,
+ ( GoalExpr0 = if_then_else(Vars0, Cond0, Then0, Else0) ->
+ do_push_in_goal(Steps, PushGoal, PushInfo, Result, Then0, Then),
+ GoalExpr = if_then_else(Vars0, Cond0, Then, Else0),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ Result = push_failed
+ )
+ ;
+ Step = step_ite_else,
+ ( GoalExpr0 = if_then_else(Vars0, Cond0, Then0, Else0) ->
+ do_push_in_goal(Steps, PushGoal, PushInfo, Result, Else0, Else),
+ GoalExpr = if_then_else(Vars0, Cond0, Then0, Else),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ Result = push_failed
+ )
+ ;
+ Step = step_neg,
+ ( GoalExpr0 = negation(SubGoal0) ->
+ do_push_in_goal(Steps, PushGoal, PushInfo, Result,
+ SubGoal0, SubGoal),
+ GoalExpr = negation(SubGoal),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ Result = push_failed
+ )
+ ;
+ Step = step_scope(_),
+ ( GoalExpr0 = scope(Reason, SubGoal0) ->
+ do_push_in_goal(Steps, PushGoal, PushInfo, Result,
+ SubGoal0, SubGoal),
+ GoalExpr = scope(Reason, SubGoal),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ Result = push_failed
+ )
+ ;
+ ( Step = step_lambda
+ ; Step = step_try
+ ; Step = step_atomic_main
+ ; Step = step_atomic_orelse(_)
+ ),
+ % The constructs represented by these steps should have been
+ % expanded out by now.
+ Result = push_failed
+ ).
+
+:- pred do_push_in_goals(int::in, list(goal_path_step)::in, push_goal::in,
+ push_info::in, push_result::out,
+ list(hlds_goal)::in, list(hlds_goal)::out) is det.
+
+do_push_in_goals(_N, _Steps, _PushGoal, _PushInfo, push_failed, [], []).
+do_push_in_goals(N, Steps, PushGoal, PushInfo, Result,
+ [Goal0 | Goals0], [Goal | Goals]) :-
+ ( N = 1 ->
+ do_push_in_goal(Steps, PushGoal, PushInfo, Result, Goal0, Goal),
+ Goals = Goals0
+ ;
+ Goal = Goal0,
+ do_push_in_goals(N - 1, Steps, PushGoal, PushInfo, Result,
+ Goals0, Goals)
+ ).
+
+:- pred do_push_in_cases(int::in, list(goal_path_step)::in, push_goal::in,
+ push_info::in, push_result::out, list(case)::in, list(case)::out) is det.
+
+do_push_in_cases(_N, _Steps, _PushGoal, _PushInfo, push_failed, [], []).
+do_push_in_cases(N, Steps, PushGoal, PushInfo, Result,
+ [Case0 | Cases0], [Case | Cases]) :-
+ ( N = 1 ->
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ do_push_in_goal(Steps, PushGoal, PushInfo, Result, Goal0, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal),
+ Cases = Cases0
+ ;
+ Case = Case0,
+ do_push_in_cases(N - 1, Steps, PushGoal, PushInfo, Result,
+ Cases0, Cases)
+ ).
+
+:- pred perform_push_transform(push_goal::in, push_info::in,
+ push_result::out, hlds_goal::in, hlds_goal::out) is det.
+
+perform_push_transform(PushGoal, PushInfo, Result, !Goal) :-
+ PushGoal = push_goal(GoalPathStr, Lo, Hi, PushedInto),
+ goal_path_from_string_det(GoalPathStr, GoalPath),
+ !.Goal = hlds_goal(GoalExpr0, GoalInfo0),
+ (
+ GoalExpr0 = conj(plain_conj, Conjuncts),
+ find_lo_hi_goals(PushInfo, Conjuncts, Lo, Hi, 1, Before0, LoHi, After,
+ pushable),
+ find_relative_paths(GoalPath, PushedInto, RelGoalSteps),
+ RelGoalSteps = [HeadRelGoalSteps | TailRelGoalSteps],
+ HeadRelGoalSteps = [step_conj(PushConjNum) | HeadRestRelSteps],
+ list.map(maybe_steps_after(step_conj(PushConjNum)),
+ TailRelGoalSteps, TailRestRelSteps),
+ list.index1(Before0, PushConjNum, PushIntoGoal0),
+ push_into_goal(LoHi, HeadRestRelSteps, TailRestRelSteps,
+ PushIntoGoal0, PushIntoGoal, pushable),
+ % If PushConjNum specifies a conjunct that is NOT the last conjunct
+ % before Lo, then this transformation reorders the code.
+ % For now, we don't allow that.
+ PushConjNum + 1 = Lo
+ ->
+ list.replace_nth_det(Before0, PushConjNum, PushIntoGoal, Before),
+ GoalExpr = conj(plain_conj, Before ++ After),
+ !:Goal = hlds_goal(GoalExpr, GoalInfo0),
+ Result = push_succeeded
+ ;
+ Result = push_failed
+ ).
+
+:- pred maybe_steps_after(goal_path_step::in,
+ list(goal_path_step)::in, list(goal_path_step)::out) is semidet.
+
+maybe_steps_after(Step, [Step | Tail], Tail).
+
+ % find_lo_hi_goals(PushInfo, Conjuncts, Lo, Hi, Cur, Before, LoHi, After,
+ % Pushable):
+ %
+ % Given a list of conjuncts in which the head conjunct (if it exists)
+ % has index Cur, and a range of integers Lo..Hi, where Cur =< Lo,
+ % return the list of conjuncts with indexes Lo..Hi in LoHi,
+ % the conjuncts before them in Before, and the conjuncts after them
+ % in After, PROVIDED that
+ % - conjuncts with indexes Lo..Hi actually exist, and
+ % - all those conjuncts are pushable.
+ % If either of these conditions isn't met, return Pushable = not_pushable,
+ % and garbage in Before, LoHi and After.
+ %
+:- pred find_lo_hi_goals(push_info::in, list(hlds_goal)::in, int::in, int::in,
+ int::in, list(hlds_goal)::out, list(hlds_goal)::out, list(hlds_goal)::out,
+ maybe_pushable::out) is det.
+
+find_lo_hi_goals(PushInfo, Conjuncts, Lo, Hi, Cur, Before, LoHi, After,
+ Pushable) :-
+ ( Cur = Lo ->
+ find_hi_goals(PushInfo, Conjuncts, Hi, Cur, LoHi, After, Pushable),
+ Before = []
+ ;
+ (
+ Conjuncts = [],
+ Before = [],
+ LoHi = [],
+ After = [],
+ Pushable = not_pushable
+ ;
+ Conjuncts = [Head | Tail],
+ find_lo_hi_goals(PushInfo, Tail, Lo, Hi, Cur + 1,
+ BeforeTail, LoHi, After, Pushable),
+ Before = [Head | BeforeTail]
+ )
+ ).
+
+ % find_hi_goals(PushInfo, Conjuncts, Hi, Cur, LoHi, After, Pushable):
+ %
+ % Given a list of conjuncts in which the head conjunct (if it exists)
+ % has index Cur, and an integer Hi, where Cur =< Hi,
+ % return the list of conjuncts with indexes up to Hi in LoHi,
+ % and the conjuncts after them in After, PROVIDED that
+ % - conjuncts with indexes up to Hi actually exist, and
+ % - all those conjuncts are pushable.
+ % If either of these conditions isn't met, return Pushable = not_pushable,
+ % and garbage in LoHi and After.
+ %
+:- pred find_hi_goals(push_info::in, list(hlds_goal)::in, int::in, int::in,
+ list(hlds_goal)::out, list(hlds_goal)::out, maybe_pushable::out) is det.
+
+find_hi_goals(_PushInfo, [], _Hi, _Cur, [], [], not_pushable).
+find_hi_goals(PushInfo, [Head | Tail], Hi, Cur, LoHi, After, Pushable) :-
+ is_pushable_goal(PushInfo, Head, HeadPushable),
+ (
+ HeadPushable = pushable,
+ ( Cur = Hi ->
+ LoHi = [Head],
+ After = Tail,
+ Pushable = pushable
+ ;
+ find_hi_goals(PushInfo, Tail, Hi, Cur + 1, LoHiTail, After,
+ Pushable),
+ LoHi = [Head | LoHiTail]
+ )
+ ;
+ HeadPushable = not_pushable,
+ LoHi = [],
+ After = [],
+ Pushable = not_pushable
+ ).
+
+:- type maybe_pushable
+ ---> not_pushable
+ ; pushable.
+
+ % Check whether pushing the given goal, which will require duplicating it,
+ % would be ok, or whether it would cause problems by altering the
+ % pushed-into goal's purity, by altering its determinism, or
+ % by screwing up the compiler's record of existentially typed variables.
+ %
+:- pred is_pushable_goal(push_info::in, hlds_goal::in,
+ maybe_pushable::out) is det.
+
+is_pushable_goal(PushInfo, Goal, Pushable) :-
+ Goal = hlds_goal(GoalExpr, GoalInfo),
+ Purity = goal_info_get_purity(GoalInfo),
+ Detism = goal_info_get_determinism(GoalInfo),
+ (
+ Purity = purity_pure,
+ Detism = detism_det
+ ->
+ (
+ GoalExpr = unify(_, _, _, Unification, _),
+ (
+ ( Unification = assign(_, _)
+ ; Unification = simple_test(_, _)
+ ; Unification = construct(_, _, _, _, _, _, _)
+ ),
+ Pushable = pushable
+ ;
+ Unification = deconstruct(_, _, Args, _, _, _),
+ RttiVarMaps = PushInfo ^ pi_rtti_varmaps,
+ ( list.all_true(is_non_rtti_var(RttiVarMaps), Args) ->
+ Pushable = pushable
+ ;
+ Pushable = not_pushable
+ )
+ ;
+ Unification = complicated_unify(_, _, _),
+ unexpected($module, $pred, "complicated_unify")
+ )
+ ;
+ ( GoalExpr = plain_call(_, _, _, _, _, _)
+ ; GoalExpr = generic_call(_, _, _, _)
+ ; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ Pushable = pushable
+ ;
+ ( GoalExpr = conj(_, Goals)
+ ; GoalExpr = disj(Goals)
+ ),
+ is_pushable_goal_list(PushInfo, Goals, Pushable)
+ ;
+ GoalExpr = switch(_, _, Cases),
+ is_pushable_case_list(PushInfo, Cases, Pushable)
+ ;
+ GoalExpr = if_then_else(_, Cond, Then, Else),
+ is_pushable_goal_list(PushInfo, [Cond, Then, Else], Pushable)
+ ;
+ ( GoalExpr = negation(SubGoal)
+ ; GoalExpr = scope(_, SubGoal)
+ ),
+ is_pushable_goal(PushInfo, SubGoal, Pushable)
+ ;
+ GoalExpr = shorthand(Shorthand),
+ (
+ ( Shorthand = atomic_goal(_, _, _, _, _, _, _)
+ ; Shorthand = try_goal(_, _, _)
+ ),
+ % May be too conservative, but better safe than sorry.
+ Pushable = not_pushable
+ ;
+ Shorthand = bi_implication(_, _),
+ unexpected($module, $pred, "bi_implication")
+ )
+ )
+ ;
+ Pushable = not_pushable
+ ).
+
+:- pred is_non_rtti_var(rtti_varmaps::in, prog_var::in) is semidet.
+
+is_non_rtti_var(RttiVarMaps, Arg) :-
+ rtti_varmaps_var_info(RttiVarMaps, Arg, RttiVarInfo),
+ RttiVarInfo = non_rtti_var.
+
+:- pred is_pushable_goal_list(push_info::in, list(hlds_goal)::in,
+ maybe_pushable::out) is det.
+
+is_pushable_goal_list(_PushInfo, [], pushable).
+is_pushable_goal_list(PushInfo, [Goal | Goals], Pushable) :-
+ is_pushable_goal(PushInfo, Goal, GoalPushable),
+ (
+ GoalPushable = not_pushable,
+ Pushable = not_pushable
+ ;
+ GoalPushable = pushable,
+ is_pushable_goal_list(PushInfo, Goals, Pushable)
+ ).
+
+:- pred is_pushable_case_list(push_info::in, list(case)::in,
+ maybe_pushable::out) is det.
+
+is_pushable_case_list(_PushInfo, [], pushable).
+is_pushable_case_list(PushInfo, [Case | Cases], Pushable) :-
+ Case = case(_MainConsId, _OtherConsIds, Goal),
+ is_pushable_goal(PushInfo, Goal, GoalPushable),
+ (
+ GoalPushable = not_pushable,
+ Pushable = not_pushable
+ ;
+ GoalPushable = pushable,
+ is_pushable_case_list(PushInfo, Cases, Pushable)
+ ).
+
+:- pred find_relative_paths(forward_goal_path::in, list(goal_path_string)::in,
+ list(list(goal_path_step))::out) is semidet.
+
+find_relative_paths(_GoalPath, [], []).
+find_relative_paths(GoalPath, [HeadStr | TailStrs],
+ [HeadRelSteps | TailRelSteps]) :-
+ goal_path_from_string(HeadStr, HeadGoalPath),
+ GoalPath = fgp(GoalPathSteps),
+ HeadGoalPath = fgp(HeadGoalPathSteps),
+ list.append(GoalPathSteps, HeadRelSteps, HeadGoalPathSteps),
+ find_relative_paths(GoalPath, TailStrs, TailRelSteps).
+
+ % push_into_goal(LoHi, HeadSteps, TailSteps, Goal0, Goal, Pushable):
+ %
+ % Push the goals LoHi into Goal0, putting them at the ends of the
+ % (possibly implicit) conjunctions holding the expensive goals indicated
+ % by the goal paths [HeadSteps | TailSteps], which are all relative to
+ % Goal0, and at the ends of the branches that are alternatives to these.
+ %
+ % Return Pushable = pushable if the transformation was successful.
+ % Return Pushable = not_pushable and a garbage Goal if it wasn't.
+ %
+ % The returned goal will need to have its nonlocal sets and instmap deltas
+ % recomputed.
+ %
+ % For example, if HeadSteps and TailSteps together specified the two
+ % expensive goals in the original goal below,
+ %
+ % ( Cond ->
+ % (
+ % X = f,
+ % EXPENSIVE GOAL 1,
+ % cheap goal 2
+ % ;
+ % X = g,
+ % cheap goal 3
+ % )
+ % ;
+ % EXPENSIVE GOAL 4
+ % )
+ %
+ % this predicate should return this transformed goal:
+ %
+ % ( Cond ->
+ % (
+ % X = f,
+ % EXPENSIVE GOAL 1,
+ % cheap goal 2,
+ % LoHi
+ % ;
+ % X = g,
+ % cheap goal 3,
+ % LoHi
+ % )
+ % ;
+ % EXPENSIVE GOAL 4,
+ % LoHi
+ % )
+ %
+:- pred push_into_goal(list(hlds_goal)::in,
+ list(goal_path_step)::in, list(list(goal_path_step))::in,
+ hlds_goal::in, hlds_goal::out, maybe_pushable::out) is det.
+
+push_into_goal(LoHi, HeadSteps, TailSteps, Goal0, Goal, Pushable) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+ (
+ HeadSteps = [],
+ expect(unify(TailSteps, []), $module, "TailSteps != []"),
+ add_goals_at_end(LoHi, Goal0, Goal),
+ Pushable = pushable
+ ;
+ HeadSteps = [FirstHeadStep | LaterHeadSteps],
+ (
+ ( GoalExpr0 = unify(_, _, _, _, _)
+ ; GoalExpr0 = plain_call(_, _, _, _, _, _)
+ ; GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ),
+ Goal = Goal0,
+ Pushable = not_pushable
+ ;
+ GoalExpr0 = conj(ConjType, Conjuncts0),
+ (
+ % If the expensive goal is a conjunct in this conjunction,
+ % then put LoHi at the end of this conjunction.
+ FirstHeadStep = step_conj(_),
+ LaterHeadSteps = []
+ ->
+ expect(unify(TailSteps, []), $module, "TailSteps != []"),
+ add_goals_at_end(LoHi, Goal0, Goal),
+ Pushable = pushable
+ ;
+ % If the expensive goal or goals are INSIDE a conjunct
+ % in this conjunction, push LoHi into the selected conjunct.
+ % We insist on all expensive goals being inside the SAME
+ % conjunct, because pushing LoHi into more than one conjunct
+ % would be a mode error.
+ %
+ FirstHeadStep = step_conj(ConjNum),
+ list.map(maybe_steps_after(step_conj(ConjNum)), TailSteps,
+ LaterTailSteps),
+ list.index1(Conjuncts0, ConjNum, SelectedConjunct0),
+
+ % If ConjNum specifies a conjunct that is NOT the last
+ % conjunct, then this transformation reorders the code.
+ % For now, we don't allow that.
+ list.length(Conjuncts0, Length),
+ ConjNum = Length
+ ->
+ push_into_goal(LoHi, LaterHeadSteps, LaterTailSteps,
+ SelectedConjunct0, SelectedConjunct, Pushable),
+ list.replace_nth_det(Conjuncts0, ConjNum, SelectedConjunct,
+ Conjuncts),
+ GoalExpr = conj(ConjType, Conjuncts),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ Goal = Goal0,
+ Pushable = not_pushable
+ )
+ ;
+ GoalExpr0 = disj(Disjuncts0),
+ (
+ build_disj_steps_map([HeadSteps | TailSteps], map.init,
+ StepMap)
+ ->
+ map.to_assoc_list(StepMap, StepList),
+ push_into_disjuncts(LoHi, StepList, 1, Disjuncts0, Disjuncts,
+ Pushable),
+ GoalExpr = disj(Disjuncts),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ Goal = Goal0,
+ Pushable = not_pushable
+ )
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ (
+ build_switch_steps_map([HeadSteps | TailSteps], map.init,
+ StepMap)
+ ->
+ map.to_assoc_list(StepMap, StepList),
+ push_into_cases(LoHi, StepList, 1, Cases0, Cases, Pushable),
+ GoalExpr = switch(Var, CanFail, Cases),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ Goal = Goal0,
+ Pushable = not_pushable
+ )
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond, Then0, Else0),
+ (
+ build_ite_steps_map([HeadSteps | TailSteps],
+ ThenSteps, ElseSteps)
+ ->
+ (
+ ThenSteps = [],
+ add_goals_at_end(LoHi, Then0, Then),
+ ThenPushable = pushable
+ ;
+ ThenSteps = [ThenStepsHead | ThenStepsTail],
+ push_into_goal(LoHi, ThenStepsHead, ThenStepsTail,
+ Then0, Then, ThenPushable)
+ ),
+ (
+ ElseSteps = [],
+ add_goals_at_end(LoHi, Else0, Else),
+ ElsePushable = pushable
+ ;
+ ElseSteps = [ElseStepsHead | ElseStepsTail],
+ push_into_goal(LoHi, ElseStepsHead, ElseStepsTail,
+ Else0, Else, ElsePushable)
+ ),
+ (
+ ThenPushable = pushable,
+ ElsePushable = pushable
+ ->
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ Goal = hlds_goal(GoalExpr, GoalInfo0),
+ Pushable = pushable
+ ;
+ Goal = Goal0,
+ Pushable = not_pushable
+ )
+ ;
+ Goal = Goal0,
+ Pushable = not_pushable
+ )
+ ;
+ GoalExpr0 = negation(_SubGoal0),
+ % Pushing goals into a negation changes the meaning of the program.
+ Goal = Goal0,
+ Pushable = not_pushable
+ ;
+ GoalExpr0 = scope(Reason, SubGoal0),
+ SubGoal0 = hlds_goal(_SubGoalExpr0, SubGoalInfo0),
+ Detism = goal_info_get_determinism(GoalInfo0),
+ SubDetism = goal_info_get_determinism(SubGoalInfo0),
+ (
+ Detism = SubDetism,
+ maybe_steps_after(step_neg, HeadSteps, HeadStepsAfter),
+ list.map(maybe_steps_after(step_neg), TailSteps,
+ TailStepsAfter)
+ ->
+ push_into_goal(LoHi, HeadStepsAfter, TailStepsAfter,
+ SubGoal0, SubGoal, Pushable),
+ GoalExpr = scope(Reason, SubGoal),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ Goal = Goal0,
+ Pushable = not_pushable
+ )
+ ;
+ GoalExpr0 = shorthand(Shorthand),
+ (
+ ( Shorthand = atomic_goal(_, _, _, _, _, _, _)
+ ; Shorthand = try_goal(_, _, _)
+ ),
+ Goal = Goal0,
+ Pushable = not_pushable
+ ;
+ Shorthand = bi_implication(_, _),
+ unexpected($module, $pred, "bi_implication")
+ )
+ )
+ ).
+
+:- pred push_into_case(list(hlds_goal)::in,
+ list(goal_path_step)::in, list(list(goal_path_step))::in,
+ case::in, case::out, maybe_pushable::out) is det.
+
+push_into_case(LoHi, HeadSteps, TailSteps, Case0, Case, Pushable) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ push_into_goal(LoHi, HeadSteps, TailSteps, Goal0, Goal, Pushable),
+ Case = case(MainConsId, OtherConsIds, Goal).
+
+:- pred push_into_disjuncts(list(hlds_goal)::in,
+ assoc_list(int, one_or_more(list(goal_path_step)))::in,
+ int::in, list(hlds_goal)::in, list(hlds_goal)::out, maybe_pushable::out)
+ is det.
+
+push_into_disjuncts(_LoHi, DisjStepList, _Cur, [], [], Pushable) :-
+ (
+ DisjStepList = [],
+ Pushable = pushable
+ ;
+ DisjStepList = [_ | _],
+ Pushable = not_pushable
+ ).
+push_into_disjuncts(LoHi, StepList, Cur, [HeadDisjunct0 | TailDisjuncts0],
+ [HeadDisjunct | TailDisjuncts], Pushable) :-
+ (
+ StepList = [],
+ add_goals_at_end(LoHi, HeadDisjunct0, HeadDisjunct),
+ list.map(add_goals_at_end(LoHi), TailDisjuncts0, TailDisjuncts),
+ Pushable = pushable
+ ;
+ StepList = [StepListHead | StepListTail],
+ (
+ StepListHead = StepListHeadNum - one_or_more(One, More),
+ ( StepListHeadNum = Cur ->
+ push_into_goal(LoHi, One, More, HeadDisjunct0, HeadDisjunct,
+ GoalPushable),
+ (
+ GoalPushable = pushable,
+ push_into_disjuncts(LoHi, StepListTail, Cur + 1,
+ TailDisjuncts0, TailDisjuncts, Pushable)
+ ;
+ GoalPushable = not_pushable,
+ TailDisjuncts = TailDisjuncts0,
+ Pushable = not_pushable
+ )
+ ;
+ add_goals_at_end(LoHi, HeadDisjunct0, HeadDisjunct),
+ push_into_disjuncts(LoHi, StepList, Cur + 1,
+ TailDisjuncts0, TailDisjuncts, Pushable)
+ )
+ )
+ ).
+
+:- pred push_into_cases(list(hlds_goal)::in,
+ assoc_list(int, one_or_more(list(goal_path_step)))::in,
+ int::in, list(case)::in, list(case)::out, maybe_pushable::out) is det.
+
+push_into_cases(_LoHi, StepList, _Cur, [], [], Pushable) :-
+ (
+ StepList = [],
+ Pushable = pushable
+ ;
+ StepList = [_ | _],
+ Pushable = not_pushable
+ ).
+push_into_cases(LoHi, StepList, Cur, [HeadCase0 | TailCases0],
+ [HeadCase | TailCases], Pushable) :-
+ (
+ StepList = [],
+ add_goals_at_end_of_case(LoHi, HeadCase0, HeadCase),
+ list.map(add_goals_at_end_of_case(LoHi), TailCases0, TailCases),
+ Pushable = pushable
+ ;
+ StepList = [StepListHead | StepListTail],
+ (
+ StepListHead = StepListHeadNum - one_or_more(One, More),
+ ( StepListHeadNum = Cur ->
+ push_into_case(LoHi, One, More, HeadCase0, HeadCase,
+ GoalPushable),
+ (
+ GoalPushable = pushable,
+ push_into_cases(LoHi, StepListTail, Cur + 1,
+ TailCases0, TailCases, Pushable)
+ ;
+ GoalPushable = not_pushable,
+ TailCases = TailCases0,
+ Pushable = not_pushable
+ )
+ ;
+ add_goals_at_end_of_case(LoHi, HeadCase0, HeadCase),
+ push_into_cases(LoHi, StepList, Cur + 1,
+ TailCases0, TailCases, Pushable)
+ )
+ )
+ ).
+
+:- pred build_disj_steps_map(list(list(goal_path_step))::in,
+ map(int, one_or_more(list(goal_path_step)))::in,
+ map(int, one_or_more(list(goal_path_step)))::out) is semidet.
+
+build_disj_steps_map([], !DisjStepMap).
+build_disj_steps_map([Head | Tail], !DisjStepMap) :-
+ Head = [step_disj(N) | HeadSteps],
+ ( map.search(!.DisjStepMap, N, one_or_more(One, More)) ->
+ svmap.det_update(N, one_or_more(HeadSteps, [One | More]), !DisjStepMap)
+ ;
+ svmap.det_insert(N, one_or_more(HeadSteps, []), !DisjStepMap)
+ ),
+ build_disj_steps_map(Tail, !DisjStepMap).
+
+:- pred build_switch_steps_map(list(list(goal_path_step))::in,
+ map(int, one_or_more(list(goal_path_step)))::in,
+ map(int, one_or_more(list(goal_path_step)))::out) is semidet.
+
+build_switch_steps_map([], !DisjStepMap).
+build_switch_steps_map([Head | Tail], !DisjStepMap) :-
+ Head = [step_switch(N, _) | HeadSteps],
+ ( map.search(!.DisjStepMap, N, one_or_more(One, More)) ->
+ svmap.det_update(N, one_or_more(HeadSteps, [One | More]), !DisjStepMap)
+ ;
+ svmap.det_insert(N, one_or_more(HeadSteps, []), !DisjStepMap)
+ ),
+ build_switch_steps_map(Tail, !DisjStepMap).
+
+:- pred build_ite_steps_map(list(list(goal_path_step))::in,
+ list(list(goal_path_step))::out, list(list(goal_path_step))::out)
+ is semidet.
+
+build_ite_steps_map([], [], []).
+build_ite_steps_map([Head | Tail], ThenSteps, ElseSteps) :-
+ build_ite_steps_map(Tail, ThenStepsTail, ElseStepsTail),
+ Head = [HeadFirstStep | HeadSteps],
+ ( HeadFirstStep = step_ite_then ->
+ ThenSteps = [HeadSteps | ThenStepsTail],
+ ElseSteps = ElseStepsTail
+ ; HeadFirstStep = step_ite_then ->
+ ThenSteps = ThenStepsTail,
+ ElseSteps = [HeadSteps | ElseStepsTail]
+ ;
+ fail
+ ).
+
+:- pred add_goals_at_end(list(hlds_goal)::in, hlds_goal::in, hlds_goal::out)
+ is det.
+
+add_goals_at_end(AddedGoals, Goal0, Goal) :-
+ Goal0 = hlds_goal(GoalExpr0, _GoalInfo0),
+ ( GoalExpr0 = conj(plain_conj, Conjuncts0) ->
+ create_conj_from_list(Conjuncts0 ++ AddedGoals, plain_conj, Goal)
+ ;
+ create_conj_from_list([Goal0 | AddedGoals], plain_conj, Goal)
+ ).
+
+:- pred add_goals_at_end_of_case(list(hlds_goal)::in, case::in, case::out)
+ is det.
+
+add_goals_at_end_of_case(AddedGoals, Case0, Case) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ add_goals_at_end(AddedGoals, Goal0, Goal),
+ Case = case(MainConsId, OtherConsIds, Goal).
+
+:- type one_or_more(T)
+ ---> one_or_more(T, list(T)).
+
+%-----------------------------------------------------------------------------%
+
% maybe_parallelise_goal(ProgRepInfo, VarTable, CPC, !Goal,
% !IntroducedParallelism).
%
@@ -385,7 +1238,7 @@
( goal_path_from_string(TargetGoalPathString, TargetGoalPathPrime) ->
TargetGoalPath = TargetGoalPathPrime
;
- unexpected(this_file,
+ unexpected($module, $pred,
"Invalid goal path in CPC Feedback Information")
),
maybe_transform_goal_at_goal_path_with_instmap(
@@ -1148,14 +2001,13 @@
;
GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
- unexpected(this_file,
- "process_goal_for_implicit_parallelism: shorthand")
+ unexpected($module, $pred, "shorthand")
).
% Increment the index if we are in a conjunction.
%
-:- pred increment_index_if_in_conj(maybe(hlds_goal_expr)::in, int::in, int::out)
- is det.
+:- pred increment_index_if_in_conj(maybe(hlds_goal_expr)::in,
+ int::in, int::out) is det.
increment_index_if_in_conj(MaybeConj, !IndexInConj) :-
(
@@ -1239,10 +2091,10 @@
Kind = csk_method
;
Details = event_call(_),
- unexpected(this_file, "get_call_kind_and_callee: event_call")
+ unexpected($module, $pred, "event_call")
;
Details = cast(_),
- unexpected(this_file, "get_call_kind_and_callee: cast")
+ unexpected($module, $pred, "cast")
)
;
% XXX Some of our callers can call us with these kinds of goals.
@@ -1255,7 +2107,7 @@
; GoalExpr = scope(_, _)
; GoalExpr = shorthand(_)
),
- unexpected(this_file, "get_call_kind_and_callee")
+ unexpected($module, $pred, "unexpected kind of goal")
).
% Convert a pred_info and a proc_id to the raw procedure id (the same used
@@ -1374,7 +2226,7 @@
:- pred goal_is_conjunction(hlds_goal::in, conj_type::out) is semidet.
goal_is_conjunction(Goal, Type) :-
- GoalExpr = Goal ^ hlds_goal_expr,
+ Goal = hlds_goal(GoalExpr, _),
GoalExpr = conj(Type, _).
% Succeed if Goal is a call or a negated call.
@@ -1494,8 +2346,7 @@
)
)
;
- % Conj is not a conjunction.
- unexpected(this_file, "parallelize_calls")
+ unexpected($module, $pred, "not a conjunction")
).
% Two calls are worth parallelizing if the number of shared variables is
@@ -1522,28 +2373,28 @@
true
;
( goal_is_conjunction(GoalB, parallel_conj) ->
- get_number_args(GoalA, NbArgsA),
+ get_number_of_args(GoalA, NbArgsA),
NbSharedVars < NbArgsA
;
(
- get_number_args(GoalA, NbArgsA),
- get_number_args(GoalB, NbArgsB)
+ get_number_of_args(GoalA, NbArgsA),
+ get_number_of_args(GoalB, NbArgsB)
->
( NbSharedVars < NbArgsA, NbSharedVars < NbArgsB
; NbSharedVars = NbArgsA, NbSharedVars < NbArgsB
; NbSharedVars < NbArgsA, NbSharedVars = NbArgsB
)
;
- unexpected(this_file, "is_worth_parallelizing")
+ unexpected($module, $pred, "could not get arg numbers")
)
)
).
% Give the number of argument variables of a call.
%
-:- pred get_number_args(hlds_goal::in, int::out) is semidet.
+:- pred get_number_of_args(hlds_goal::in, int::out) is semidet.
-get_number_args(Call, NbArgs) :-
+get_number_of_args(Call, NbArgs) :-
CallExpr = Call ^ hlds_goal_expr,
(
CallExpr = plain_call(_, _, Args, _, _, _),
@@ -1568,8 +2419,7 @@
hlds_goal::out) is det.
add_call_to_parallel_conjunction(Call, ParallelGoal0, ParallelGoal) :-
- ParallelGoalExpr0 = ParallelGoal0 ^ hlds_goal_expr,
- ParallelGoalInfo0 = ParallelGoal0 ^ hlds_goal_info,
+ ParallelGoal0 = hlds_goal(ParallelGoalExpr0, ParallelGoalInfo0),
( ParallelGoalExpr0 = conj(parallel_conj, GoalList0) ->
GoalList = [Call | GoalList0],
goal_list_nonlocals(GoalList, NonLocals),
@@ -1586,7 +2436,7 @@
ParallelGoalExpr = conj(parallel_conj, GoalList),
ParallelGoal = hlds_goal(ParallelGoalExpr, ParallelGoalInfo)
;
- unexpected(this_file, "add_call_to_parallel_conjunction")
+ unexpected($module, $pred, "not conjunction")
).
% Succeed if the first goal depends on the second one.
@@ -1628,14 +2478,14 @@
( MaybeConj = yes(GoalExprProcessed) ->
!:GoalExpr = GoalExprProcessed
;
- unexpected(this_file, "process_conj_for_implicit_parallelism")
+ unexpected($module, $pred, "failed")
),
process_conj_for_implicit_parallelism(!GoalExpr, IndexInConj0,
ProcInfo, !ModuleInfo, !CalleesToBeParallelized,
!SiteNumCounter)
)
;
- unexpected(this_file, "process_conj_for_implicit_parallelism")
+ unexpected($module, $pred, "not conjunction")
).
% Process a disjunction for implicit parallelism.
@@ -1693,11 +2543,5 @@
ProcInfo, !ModuleInfo, !CalleesToBeParallelized, !SiteNumCounter).
%-----------------------------------------------------------------------------%
-
-:- func this_file = string.
-
-this_file = "implicit_parallelism.m".
-
-%-----------------------------------------------------------------------------%
:- end_module transform_hlds.implicit_parallelism.
%-----------------------------------------------------------------------------%
cvs diff: Diffing notes
--------------------------------------------------------------------------
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