[m-rev.] for review: implicit_parallelism and distance_granularity (new modules)
Jerome Tannier
jerome.tannier at student.fundp.ac.be
Wed Jan 10 15:58:37 AEDT 2007
Hi,
Estimated hours taken: 80
Branches: main
This change adds two new passes to the compiler. The first one, implicit_parallelism, uses
deep profiling feedback information, generated by mdprof_feedback, to introduce parallel
conjunctions where it could be worthwhile. It deals with both independent and dependent
parallelism.
The second new pass, distance_granularity, applies a transformation that controls the
granularity of parallelism for recursive procedures using the distance metric.
This change also fixes a bug in mdprof_feedback regarding the construction of the list of
CSSs.
compiler/implicit_parallelism.m:
New module which uses the profiling feedback file generated by mdprof_feedback to
introduce parallel conjunction where it could be useful.
compiler/distance_granularity.m:
New module. A program transformation that implements granularity control of
parallel execution using the distance metric.
compiler/dep_par_conj.m:
Moved find_shared_variables in the interface (needed for implicit_parallelism.m).
compiler/goal_util.m:
Add two new predicates: flatten_conj and create_conj.
compiler/hhf.m:
Delete flatten_conj and use the one of goal_util instead.
compiler/hlds_pred.m:
Add a predicate to set the arity of a predicate (needed for distance_granularity).
compiler/mercury_compile.m:
Add the calls to apply implicit parallelism and to control granularity using the
distance metric.
compiler/options:
Add implicit-parallelism, feedback-file and distance-granularity options.
compiler/pred_table.m:
Add a predicate to get the next pred_id available (needed for
distance_granularity).
compiler/prog_util.m:
Extend the predicate make_pred_name and the type new_pred_id for
creating a predicate name for distance_granularity.
compiler/transform_hlds.m:
Include transform_paralellism and distance_granularity in the included modules.
deep_profiler/mdprof_feedback.m:
Rename distribution to measure.
Add handling of dump_stages and dump_options.
Insert elements into the list of CSSs in the correct order.
deep_profiler/dump.m:
Add "all" option to dump everything out of the Deep.data file.
doc/user_guide.texi:
Add the following options: --distance-granularity, --implicit-parallelism and
--feedback-file.
/tests/par_conj:
Add two test cases for the distance_granularity module:dg_fib and dg_fib_func. As
things are, we do not check whether the granularity control transformation using
the distance metric is applied correctly or not. We only check the output of these
test cases.
tests/par_conj/Mercury.options:
Add "--parallel --distance-granularity 10" options for the new test cases.
> On Wed, 6 Dec 2006, Jerome Tannier wrote:
>
>> Estimated hours taken: 80
>> Branches: main
>>
>> This change adds two new passes to the compiler. The first one,
>> implicit_parallelism, uses deep profiling feedback information, generated
>> by mdprof_feedback, to introduce parallel conjunctions where it could be
>> worthwhile. It deals with both independent and dependent parallelism.
>
>> The second one, distance_granularity, apply a transformation to control the
>> granularity of parallelism of recursive procedures using the distance
>> metric.
>
> I suggest:
>
> The second new pass, distance_granularity, applies a transformation
> that controls the granularity of parallelism for recursive procedures
> using the distance metric.
Done.
>
> Briefly mention the third major change in this diff - it fixes a bug in
> mdprof_feedback.
Done.
Also, the list of file specific changes should be
> reorderd so that the major ones are mentioned first.
Done.
>
>> compiler/dep_par_conj.m:
>> Moved find_shared_variables in the interface (needed for
>> implicit_parallelism.m).
>>
>> compiler/distance_granularity.m:
>> New module which controls the granularity of parallelism using the
>> distance
>> metric.
>
> I suggest
>
> New module. A program transformation that implements granularity
> control of parallel execution using the distance metric.
>
Done.
>> compiler/goal_util.m:
>> Add two new predicates: flatten_conj and create_conj.
>>
>> compiler/hhf.m:
>> Delete flatten_conj and use the one of goal_util instead.
>>
>> compiler/hlds_pred.m:
>> Add a predicate to set the arity of a predicate (needed for
>> distance_granularity).
>>
>> compiler/implicit_parallelism.m:
>> New module which reads the profiling feedback file and decides where
>> parallelism should be introduced.
>
> Specifically, it uses profiling feedback to introduce parallel conjunction.
>
Done.
>> compiler/mercury_compile.m:
>> Add the calls to apply implicit parallelism and to control
>> granularity using the
>> distance metric.
>>
>> compiler/options:
>> Add implicit-parallelism, feedback-file and distance-granularity
>> options.
>
> These also need to be documented in the user's guide.
>
Done.
>> compiler/pred_table.m:
>> Add a predicate to get the next pred_id available (needed for
>> distance_granularity).
>>
>> compiler/prog_util.m:
>> Extend the predicate make_pred_name and the type new_pred_id for
>> creating a predicate name for distance_granularity.
>>
>> compiler/transform_hlds.m:
>> Add transform_paralellism and distance_granularity in the included
>> modules.
>
> s/Add/Include/
>
Done.
>> deep_profiler/dump.m:
>> Add "all" option to dump everything out of the Deep.data file.
>>
>> deep_profiler/mdprof_feedback.m:
>> Rename distribution to measure.
>> Add handling of dump_stages and dump_options.
>> Correct the way the list of CSS is built (elems were put in the wrong
>> order).
>
> Insert elements into the list of CSSs in the correct order.
>
Done.
> Can you also please add some test cases that use the distance granularity
> transformation to the test suite?
I have included two test cases:fibonacci as a predicate and as a function. Is that sufficient?
>
> ...
>
>> Index: compiler/dep_par_conj.m
>> ===================================================================
>> RCS file: /home/mercury1/repository/mercury/compiler/dep_par_conj.m,v
>> retrieving revision 1.15
>> diff -u -r1.15 dep_par_conj.m
>> --- compiler/dep_par_conj.m 5 Dec 2006 03:50:49 -0000 1.15
>> +++ compiler/dep_par_conj.m 6 Dec 2006 05:57:34 -0000
>> @@ -64,15 +64,23 @@
>> :- module transform_hlds.dep_par_conj.
>> :- interface.
>>
>
> ...
>
>> :- pred dependent_par_conj(module_info::in, module_info::out, io::di,
>> io::uo)
>> is det.
>>
>> + %Used by transform_hlds.implicit_parallelism.
>
> I suggest:
>
> Exported for use by the implicit_parallism pass.
>
Done.
> ...
>
>> Index: compiler/distance_granularity.m
>> ===================================================================
>> RCS file: compiler/distance_granularity.m
>> diff -N compiler/distance_granularity.m
>> --- /dev/null 1 Jan 1970 00:00:00 -0000
>> +++ compiler/distance_granularity.m 6 Dec 2006 05:57:34 -0000
>
> ...
>
>> +% File: distance_granularity.m.
>> +% Author: tannier.
>> +%
>> +% This module controls the granularity of parallelism at compile time using
>> the
>> +% distance metric.
>
> I suggest:
>
> This module contains a program transformation that adds a
> mechanism that controls the granularity of parallel execution
> using the distance metric.
Done.
>
>> For more information, see:
>> +% K. Shen, V. Santos Costa, and A. King.
>> +% Distance: a New Metric for Controlling Granularity for Parallel Execution.
>> +% In Proceedings of the Joint International Conference and Symposium on
>> Logic
>> +% Programming.
>> +% MIT Press, 1998.
>> +% http://www.cs.ukc.ac.uk/pubs/1998/588.
>> +% http://citeseer.ist.psu.edu/shen98distance.html.
>> +%
>> +% Example of the transformation:
>> +%
>> +% From the originial version of fibonacci:
>
> s/originial/original/
Done.
>
>> +%
>> +% :- pred fibonacci(int::in, int::out) is det.
>> +%
>> +% fibonacci(X, Y) :-
>> +% ( X = 0 ->
>> +% Y = 0
>> +% ;
>> +% ( X = 1 ->
>> +% Y = 1
>> +% ;
>> +% ( X > 1 ->
>> +% J = X - 1,
>> +% K = X - 2,
>> +% (
>> +% fibonacci(J, Jout)
>> +% &
>> +% fibonacci(K, Kout)
>> +% ),
>> +% Y = Jout + Kout
>> +% ;
>> +% error("fibonacci: wrong value")
>> +% )
>> +% )
>> +% ).
>> +%
>> +% we create a specialized/cloned version (we assume that the distance which
>
> Choose one of "specialized" or "cloned" and stick with it rather than
> continually writing specialized/cloned. (I suggest specialized.)
Done.
>
>> was
>> +% given during compilation is 10):
>> +%
>> +% :- pred ditance_granularity_fibonacci(int::in, int::out, int::in) is det.
>
> s/ditance_/distance_/
Done.
>
>> +%
>> +% distance_granularity_fibonacci(X, Y, Distance) :-
>> +% ( X = 0 ->
>> +% Y = 0
>> +% ;
>> +% ( X = 1 ->
>> +% Y = 1
>> +% ;
>> +% ( X > 1 ->
>> +% J = X - 1,
>> +% K = X - 2,
>> +% ( Distance = 0 ->
>> +% (
>> +% distance_granularity_fibonacci(J, Jout, 10)
>> +% &
>> +% distance_granularity_fibonacci(K, Kout, 10)
>> +% )
>> +% ;
>> +% distance_granularity_fibonacci(J, Jout, Distance - 1),
>> +% distance_granularity_fibonacci(K, Kout, Distance - 1)
>> +% ),
>> +% Y = Jout + Kout
>> +% ;
>> +% error("fibonacci: wrong value")
>> +% )
>> +% )
>> +% ).
>> +%
>> +% After wich, the original version becomes:
>
> s/wich/which/
Done.
>
>> +%
>> +% :- pred fibonacci(int::in, int::out) is det.
>> +%
>> +% fibonacci(X, Y) :-
>> +% ( X = 0 ->
>> +% Y = 0
>> +% ;
>> +% ( X = 1 ->
>> +% Y = 1
>> +% ;
>> +% ( X > 1 ->
>> +% J = X - 1,
>> +% K = X - 2,
>> +% (
>> +% distance_granularity_fibonacci(J, Jout, 10)
>> +% %
>> +% distance_granularity_fibonacci(K, Kout, 10)
>> +% ),
>> +% Y = Jout + Kout
>> +% ;
>> +% error("fibonacci: wrong value")
>> +% )
>> +% )
>> +% ).
>> +%
>> +% The second part of the transformation makes the granularity control
>> +% transparent to the user (there is no need to call explicitly the specified
>> +% version of the recursive predicate).
>
> I suggest:
>
> The second part of the transformation makes the granularity control
> transparent to the original procedure's callers by replacing the
> recursive calls in the body of the original procedure with calls to
> the specialized version. The original procedure's callers should
> never need to call the specialized version directly.
>
Done.
>> +% XXX For the time being, we assume that the int module was imported in the
>> +% source code of the program for which we apply the distance granularity
>> +% transformation.
>
> That's easily fixed but can be done as part of separate change.
>
>> +%-----------------------------------------------------------------------------%
>> +
>> +:- module transform_hlds.distance_granularity.
>> +:- interface.
>> +
>> +:- import_module hlds.hlds_module.
>> +
>> +%-----------------------------------------------------------------------------%
>> +
>> + % control_distance_granularity(!ModuleInfo, Distance)
>> + %
>> + % Control the granularity of parallelism of a module using the distance
>> + % metric.
>> + %
>> +:- pred control_distance_granularity(module_info::in, module_info::out,
>> + int::in) is det.
>
> ...
>
>> + % This section contains predicates which apply the first part of the
>> + % transformation i.e. creating the specialized/cloned version of the
>> + % original predicate.
>> +
>> +
>> +control_distance_granularity(!ModuleInfo, Distance) :-
>> + module_info_predids(!.ModuleInfo, PredIds),
>> + apply_dg_to_preds(PredIds, Distance, !ModuleInfo).
>> +
>> + % Apply the distance granularity transformation to a each predicate in
>> the
>> + % list.
>
> s/to a each/to each/
Done.
>
>> + %
>> +:- pred apply_dg_to_preds(list(pred_id)::in, int::in,
>> + module_info::in, module_info::out) is det.
>> +
>> +apply_dg_to_preds([], _Distance, !ModuleInfo).
>> +apply_dg_to_preds([PredId | PredIdList], Distance, !ModuleInfo) :-
>> + module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
>> + % We need to know what the pred_id will be for the cloned predicate
>> before
>> + % we actually clone it (this avoid doing one more pass to update the
>
> s/avoid/avoids/
Done.
>
>> pred_id
>> + % in the recursive plain calls).
>> + module_info_get_predicate_table(!.ModuleInfo, PredicateTable),
>> + get_next_pred_id(PredicateTable, NewPredId),
>> +
>> + % Create the new sym_name for the recursive plain calls.
>> + ModuleName = pred_info_module(PredInfo),
>> + Prefix = granularity_prefix,
>> + PredOrFunc = pred_info_is_pred_or_func(PredInfo),
>> + MaybePredOrFunc = yes(PredOrFunc),
>> + NewPredIdGranularity = newpred_distance_granularity(Distance),
>> + PredName0 = pred_info_name(PredInfo),
>> + make_pred_name(ModuleName, Prefix, MaybePredOrFunc, PredName0,
>> + NewPredIdGranularity, NewCallSymName),
>> +
>> + ProcIds = pred_info_non_imported_procids(PredInfo),
>> + apply_dg_to_procs(PredId, ProcIds, Distance, PredOrFunc, NewPredId,
>> + NewCallSymName, PredInfo, PredInfoClone0, no, Cloned, !ModuleInfo),
>> + (
>> + Cloned = yes,
>> + % The predicate has been cloned as it contains recursive calls.
>> +
>> + % Update the name of the predicate.
>
> You're not actually updating anything are you? You're creating the name
> of the specialised version of the predicate out of the name of the original
> one.
s/update_pred_name/create_specialized_pred_name
>
>> + update_pred_name(Prefix, PredOrFunc, Distance, PredName0, PredName),
>> + pred_info_set_name(PredName, PredInfoClone0, PredInfoClone1),
>> +
>> + % The arity and the argument types of the cloned procedure must be
>> + % modified.
>> + Arity = pred_info_orig_arity(PredInfoClone1),
>> + pred_info_set_orig_arity(Arity + 1, PredInfoClone1, PredInfoClone2),
>> + pred_info_get_arg_types(PredInfoClone2, ListMerType0),
>
> s/ListMerType/ArgTypes/
Done.
>
>> + (
>> + PredOrFunc = predicate,
>> + % The argument controlling the granularity is the last one.
>> + list.append(ListMerType0, [int_type], ListMerType)
>> + ;
>> + PredOrFunc = function,
>> + % The argument controlling the granularity is the second last
>> one.
>> + list.length(ListMerType0, LengthListMerType),
>> + list.det_split_list(LengthListMerType - 1, ListMerType0,
>> + StartListMerType0, EndListMerType),
>> + list.append(StartListMerType0, [int_type], StartListMerType),
>> + list.append(StartListMerType, EndListMerType, ListMerType)
>
> As we discussed in person all this mucking around with function return
> values can be avoided by just making sure that the specialized version of
> the procedure is always a predicate, even if the original was a function.
> Since all calls to the specialised procedure are going to be made via the
> (transformed version of) the original procedure it doesn't matter if the
> specialised procedure is a function or a predicate. Restricting it to
> always be a predicate should simplify matters.
Oups I posted an old diff. That was already fixed.
>
>> + pred_info_get_typevarset(PredInfoClone2, Tvarset),
>> + pred_info_get_exist_quant_tvars(PredInfoClone2, ExistqTvars),
>> + pred_info_set_arg_types(Tvarset, ExistqTvars, ListMerType,
>> + PredInfoClone2, PredInfoClone),
>> +
>> + % Add the cloned predicate to the predicate table.
>> + module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
>> + predicate_table_insert(PredInfoClone, _, PredicateTable0,
>> + PredicateTable1),
>> + module_info_set_predicate_table(PredicateTable1, !ModuleInfo),
>> +
>> + update_original_predicate_procs(PredId, ProcIds, Distance,
>> PredOrFunc,
>> + NewPredId, NewCallSymName, PredInfo, PredInfoUpdated,
>> !ModuleInfo),
>> + module_info_set_pred_info(PredId, PredInfoUpdated, !ModuleInfo)
>> + ;
>> + Cloned = no,
>> + % The predicate has not been cloned.
>> + true
>> + ),
>> + apply_dg_to_preds(PredIdList, Distance, !ModuleInfo).
>> +
>> + % Apply the distance granularity transformation to each procedure in the
>> + % list.
>> + % PredIdSpecialized is the pred_id of the predicate to be cloned.
>> + % SymNameSpecialized is the sym_name of the predicate to be cloned.
>> + %
>> +:- pred apply_dg_to_procs(pred_id::in, list(proc_id)::in, int::in,
>> + pred_or_func::in, pred_id::in, sym_name::in, pred_info::in,
>> pred_info::out,
>> + bool::in, bool::out, module_info::in, module_info::out) is det.
>> +
>> +apply_dg_to_procs(_PredId, [], _Distance, _PredOrFunc, _PredIdSpecialized,
>> + _SymNameSpecialized, !PredInfo, !Cloned, !ModuleInfo).
>> +apply_dg_to_procs(PredId, [ProcId | ProcIds], Distance, PredOrFunc,
>> + PredIdSpecialized, SymNameSpecialized, !PredInfo, !Cloned,
>> + !ModuleInfo) :-
>> + module_info_proc_info(!.ModuleInfo, proc(PredId, ProcId), ProcInfo0),
>> + proc_info_get_has_parallel_conj(ProcInfo0, HasParallelConj),
>> + (
>> + HasParallelConj = yes,
>> + % The procedure contains parallel conjunction(s).
>> +
>> + proc_info_get_goal(ProcInfo0, Body),
>> + apply_dg_to_goal(Body, BodyClone, PredId, ProcId, PredIdSpecialized,
>> + SymNameSpecialized, ProcInfo0, ProcInfo1, !ModuleInfo, Distance,
>> + PredOrFunc, no, no, GranularityVar, _),
>
> s/GranularityVar/MaybeGranularityVar/
Done.
>
>> + (
>> + GranularityVar = yes(_),
>> + % The granularity variable has been created while the procedure
>> was
>> + % processed. That means that the predicate must be cloned.
>> + !:Cloned = yes,
>> + proc_info_set_goal(BodyClone, ProcInfo1, ProcInfo2),
>> + requantify_proc(ProcInfo2, ProcInfo3),
>> + RecomputeAtomic = no,
>> + recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo3,
>> + ProcInfo, !ModuleInfo),
>> + pred_info_set_proc_info(ProcId, ProcInfo, !PredInfo)
>> + ;
>> + GranularityVar = no
>> + )
>> + ;
>> + HasParallelConj = no
>> + % No need to apply the distance granularity transformation to this
>> + % procedure as it does not contain any parallel conjunctions.
>> + ),
>> + apply_dg_to_procs(PredId, ProcIds, Distance, PredOrFunc,
>> PredIdSpecialized,
>> + SymNameSpecialized, !PredInfo, !Cloned, !ModuleInfo).
>> +
>> + % Apply the distance granularity transformation to a goal.
>> + % CallerPredId and CallerProcId are those of the original predicate.
>> + %
>> +:- pred apply_dg_to_goal(hlds_goal::in, hlds_goal::out, pred_id::in,
>> + proc_id::in, pred_id::in, sym_name::in, proc_info::in, proc_info::out,
>> + module_info::in, module_info::out, int::in, pred_or_func::in, bool::in,
>> + maybe(prog_var)::in, maybe(prog_var)::out, bool::out) is det.
>> +
>> +apply_dg_to_goal(!Goal, CallerPredId, CallerProcId, PredIdSpecialized,
>> + SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance, PredOrFunc,
>> + IsInParallelConj, !MaybeGranularityVar,
>> + IsRecursiveCallInParallelConj) :-
>> + !.Goal = GoalExpr0 - GoalInfo,
>> + (
>> + GoalExpr0 = unify(_, _, _, _, _),
>> + IsRecursiveCallInParallelConj = no
>> + ;
>> + GoalExpr0 = plain_call(_, _, _, _, _, _),
>> + apply_dg_to_plain_call(GoalExpr0, GoalExpr, CallerPredId,
>> + PredIdSpecialized, SymNameSpecialized, CallerProcId, !ProcInfo,
>> + !ModuleInfo, PredOrFunc, IsInParallelConj, !MaybeGranularityVar,
>> + IsRecursiveCallInParallelConj),
>> + !:Goal = GoalExpr - GoalInfo
>> + ;
>> + GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
>> + IsRecursiveCallInParallelConj = no
>> + ;
>> + GoalExpr0 = generic_call(_, _, _, _),
>> + IsRecursiveCallInParallelConj = no
>> + ;
>> + GoalExpr0 = conj(Type, Goals0),
>> + apply_dg_to_conj(Goals0, [], Goals, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> + Distance, PredOrFunc, yes, !MaybeGranularityVar, no,
>> + ContainRecursiveCalls),
>> + (
>> + Type = plain_conj,
>> + GoalExpr = conj(plain_conj, Goals),
>> + !:Goal = GoalExpr - GoalInfo
>> + ;
>> + Type = parallel_conj,
>> + (
>> + ContainRecursiveCalls = yes,
>> + create_if_then_else_goal(Goals, GoalInfo,
>> !.MaybeGranularityVar,
>> + PredIdSpecialized, CallerProcId, Distance, PredOrFunc,
>> + !:Goal, !ProcInfo, !.ModuleInfo)
>> + ;
>> + ContainRecursiveCalls = no,
>> + true
>> + )
>> + ),
>> + IsRecursiveCallInParallelConj = no
>> + ;
>> + GoalExpr0 = disj(Goals0),
>> + apply_dg_to_disj(Goals0, [], Goals, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> + Distance, PredOrFunc, !MaybeGranularityVar),
>> + GoalExpr = disj(Goals),
>> + !:Goal = GoalExpr - GoalInfo,
>> + IsRecursiveCallInParallelConj = no
>> + ;
>> + GoalExpr0 = switch(Var, CanFail, Cases0),
>> + apply_dg_to_switch(Cases0, [], Cases, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> + Distance, PredOrFunc, !MaybeGranularityVar),
>> + GoalExpr = switch(Var, CanFail, Cases),
>> + !:Goal = GoalExpr - GoalInfo,
>> + IsRecursiveCallInParallelConj = no
>> + ;
>> + GoalExpr0 = negation(Goal0),
>> + apply_dg_to_goal(Goal0, Goal, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> + Distance, PredOrFunc, IsInParallelConj, !MaybeGranularityVar,
>> + IsRecursiveCallInParallelConj),
>> + GoalExpr = negation(Goal),
>> + !:Goal = GoalExpr - GoalInfo
>> + ;
>> + GoalExpr0 = scope(_, _),
>> + IsRecursiveCallInParallelConj = no
>
> Why is the transformation not applied to the goal inside the scope?
Done. I have also fixed that in the implicit_parallelism module.
>
>> + ;
>> + GoalExpr0 = if_then_else(Vars, If0, Then0, Else0),
>
> s/If0/Cond0/ and likewise below.
Done. I have also fixed that in the implicit_parallelism module.
>
>> + apply_dg_to_goal(If0, If, CallerPredId, CallerProcId,
>> PredIdSpecialized,
>> + SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance,
>> PredOrFunc,
>> + no, !MaybeGranularityVar, _),
>> + apply_dg_to_goal(Then0, Then, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> + Distance, PredOrFunc, no, !MaybeGranularityVar, _),
>> + apply_dg_to_goal(Else0, Else, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> + Distance, PredOrFunc, no, !MaybeGranularityVar, _),
>> + GoalExpr = if_then_else(Vars, If, Then, Else),
>> + !:Goal = GoalExpr - GoalInfo,
>> + IsRecursiveCallInParallelConj = no
>
> ...
>
>> + % Apply the distance granularity transformation to a plain call.
>> + %
>> +:- pred apply_dg_to_plain_call(hlds_goal_expr::in, hlds_goal_expr::out,
>> + pred_id::in, pred_id::in, sym_name::in, proc_id::in, proc_info::in,
>> + proc_info::out, module_info::in, module_info::out, pred_or_func::in,
>> + bool::in, maybe(prog_var)::in, maybe(prog_var)::out,
>> + bool::out) is det.
>> +
>> +apply_dg_to_plain_call(!CallExpr, CallerPredId, PredIdSpecialized,
>> + SymNameSpecialized, CallerProcId, !ProcInfo, !ModuleInfo,
>> PredOrFunc,
>> + IsInParallelConj, !MaybeGranularityVar,
>> + IsRecursiveCallInParallelConj) :-
>> + ( !.CallExpr = plain_call(CalleePredId, CalleeProcId, CallArgs,
>> CallBuiltin,
>> + CallUnifyContext, _) ->
>> + ( IsInParallelConj = yes, CalleePredId = CallerPredId,
>> + CalleeProcId = CallerProcId
>> + ->
>> + % That is a recursive plain call in a parallel conjunction.
>> + (
>> + !.MaybeGranularityVar = yes(_GranularityVar),
>> + % The variable Granularity has already been added to
>> ProcInfo.
>> + true
>> + ;
>> + !.MaybeGranularityVar = no,
>> + % Add the variable Granularity to ProcInfo.
>> + proc_info_create_var_from_type(int_type, no, GranularityVar,
>> + !ProcInfo),
>> + !:MaybeGranularityVar = yes(GranularityVar),
>> +
>> + % XXX Check if the int module is imported (that is why
>> + % ModuleInfo can be modified).
>> +
>> + % Add the int variable to the head variables of the
>
> s/int variable/granularity variable/ for consistency with the terminology
> you use elsewhere.
Done.
>
>> procedure
>> + % and adapt the mode.
>
> s/adapt the mode/and update the argmodes/
Done.
>
>> + proc_info_get_argmodes(!.ProcInfo, ArgsModes0),
>> + proc_info_get_headvars(!.ProcInfo, HeadVars0),
>> + (
>> + PredOrFunc = predicate,
>> + % The argument controlling the granularity is the last
>> one.
>> + list.append(ArgsModes0, [in_mode], ArgsModes),
>> + list.append(HeadVars0, [GranularityVar], HeadVars)
>> + ;
>> + PredOrFunc = function,
>> + % The argument controlling the granularity is the second
>> + % last one.
>> + list.length(ArgsModes0, LengthArgsModes),
>> + list.det_split_list(LengthArgsModes - 1, ArgsModes0,
>> + StartArgsModes0, EndArgsModes),
>> + list.append(StartArgsModes0, [in_mode], StartArgsModes),
>> + list.append(StartArgsModes, EndArgsModes, ArgsModes),
>> +
>> + list.length(HeadVars0, LengthHeadVars),
>> + list.det_split_list(LengthHeadVars - 1, HeadVars0,
>> + StartHeadVars0, EndHeadVars),
>> + list.append(StartHeadVars0, [GranularityVar],
>> + StartHeadVars),
>> + list.append(StartHeadVars, EndHeadVars, HeadVars)
>> + ),
>> + proc_info_set_argmodes(ArgsModes, !ProcInfo),
>> + proc_info_set_headvars(HeadVars, !ProcInfo)
>> + ),
>> +
>> + % Change the pred_id and the sym_name. We will deal with the
>> + % arguments later as they are not identical for the then and the
>> + % else part of the if_then_else goal introduced by the
>> + % transformation.
>> + !:CallExpr = plain_call(PredIdSpecialized, CallerProcId,
>> + CallArgs, CallBuiltin, CallUnifyContext,
>> SymNameSpecialized),
>> + IsRecursiveCallInParallelConj = yes
>> + ;
>> + IsRecursiveCallInParallelConj = no
>> + )
>
> ...
>
>> + % Apply the distance granularity transformation to a conjunction.
>> + %
>> +:- pred apply_dg_to_conj(hlds_goals::in, hlds_goals::in, hlds_goals::out,
>> + pred_id::in, proc_id::in, pred_id::in, sym_name::in,
>> + proc_info::in, proc_info::out, module_info::in, module_info::out,
>> int::in,
>> + pred_or_func::in, bool::in, maybe(prog_var)::in, maybe(prog_var)::out,
>> + bool::in, bool::out) is det.
>> +
>> +apply_dg_to_conj([], !GoalsAcc, _CallerPredId, _CallerProcId,
>> + _PredIdSpecialized, _SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> + _Distance, _PredOrFunc, _IsInParallelConj,
>> + !MaybeGranularityVar, !HasRecursiveCallsInParallelConj).
>> +apply_dg_to_conj([Goal0 | Goals], !GoalsAcc, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> + Distance, PredOrFunc, IsInParallelConj, !MaybeGranularityVar,
>> + !HasRecursiveCallsInParallelConj) :-
>> + apply_dg_to_goal(Goal0, Goal, CallerPredId, CallerProcId,
>> PredIdSpecialized,
>> + SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance, PredOrFunc,
>> + IsInParallelConj, !MaybeGranularityVar, IsRecursiveCall),
>> + list.append(!.GoalsAcc, [Goal], !:GoalsAcc),
>> + (
>> + IsRecursiveCall = yes,
>> + % The goal we just processed is a recursive call in a parallel
>> + % conjunction. Therefore, the conjunction contains recursive calls.
>> + !:HasRecursiveCallsInParallelConj = yes
>> + ;
>> + IsRecursiveCall = no,
>> + !:HasRecursiveCallsInParallelConj =
>> !.HasRecursiveCallsInParallelConj
>> + ),
>> + apply_dg_to_conj(Goals, !GoalsAcc, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> Distance,
>> + PredOrFunc, IsInParallelConj, !MaybeGranularityVar,
>> + !HasRecursiveCallsInParallelConj).
>> +
>> + % Create the if_then_else goal surrounding the recursive plain call as
>> + % showed in the example.
>
> s/showed/shown/
Done.
>
>> + %
>> +:- pred create_if_then_else_goal(hlds_goals::in, hlds_goal_info::in,
>> + maybe(prog_var)::in, pred_id::in, proc_id::in, int::in,
>> pred_or_func::in,
>> + hlds_goal::out, proc_info::in, proc_info::out, module_info::in) is det.
>> +
>> +create_if_then_else_goal(GoalsInConj, ConjInfo, MaybeGranularityVar,
>> + PredIdSpecialized, CallerProcId, Distance, PredOrFunc,
>> IfThenElseGoal,
>> + !ProcInfo, ModuleInfo) :-
>> + proc_info_create_var_from_type(int_type, no, Var, !ProcInfo),
>> + make_int_const_construction(Var, 0, UnifyGoal),
>> + (
>> + MaybeGranularityVar = yes(GranularityVar),
>> + % Create the if.
>
> s/if./condition./
Done.
>
>> + make_simple_test(GranularityVar, Var,
>> + umc_implicit("distance_granularity"), [], Test),
>> + create_conj(UnifyGoal, Test, plain_conj ,If),
>> +
>> + % Create the then.
>> + Then0 = conj(parallel_conj, GoalsInConj) - ConjInfo,
>> + apply_dg_to_then(Then0, Then, GranularityVar, PredIdSpecialized,
>> + CallerProcId, Distance, PredOrFunc, !ProcInfo),
>> +
>> + % Create the else.
>> + Else0 = conj(plain_conj, GoalsInConj) - ConjInfo,
>> + apply_dg_to_else(Else0, Else, GranularityVar, PredIdSpecialized,
>> + CallerProcId, ModuleInfo, PredOrFunc, !ProcInfo),
>> +
>> + % The non locals of the hlds_goal_info of the if_then_else goal must
>
> s/non locals/non-locals/
Done.
>
>> + % contain the variable controlling the granularity.
>> + goal_info_get_nonlocals(ConjInfo, NonLocals0),
>> + set.insert(NonLocals0, GranularityVar, NonLocals),
>> + goal_info_set_nonlocals(NonLocals, ConjInfo, IfThenElseInfo),
>> + IfThenElseGoal = if_then_else([], If, Then, Else) - IfThenElseInfo
>> + ;
>> + MaybeGranularityVar = no,
>> + % The conjunction contains recursive calls so the
>> + % granularity variable must have been created.
>> + unexpected(this_file, "apply_dg_to_goal")
>> + ).
>> +
>> + % Update the then part of the new if_then_else goal introduced by the
>> + % transformation as showed in the example. It creates a variable
>
> s/showed/shown/
Done.
>
>> Granularity
>> + % containing the value Distance and uses it as the last argument of the
>> + % recursive calls.
>> + %
>> +:- pred apply_dg_to_then(hlds_goal::in, hlds_goal::out, prog_var::in,
>> + pred_id::in, proc_id::in, int::in, pred_or_func::in,
>> + proc_info::in, proc_info::out) is det.
>> +
>> +apply_dg_to_then(!Goal, GranularityVar, CallerPredId, CallerProcId,
>> Distance,
>> + PredOrFunc, !ProcInfo) :-
>> + !.Goal = GoalExpr0 - GoalInfo,
>> + apply_dg_to_then2(GoalExpr0, GoalExpr, 1, _, GranularityVar,
>> CallerPredId,
>> + CallerProcId, Distance, PredOrFunc, !ProcInfo),
>> + Goal0 = GoalExpr - GoalInfo,
>> + recompute_conj_info(Goal0, !:Goal).
>> +
>> +:- pred apply_dg_to_then2(hlds_goal_expr::in, hlds_goal_expr::out,
>> + int::in, int::out, prog_var::in, pred_id::in, proc_id::in, int::in,
>> + pred_or_func::in, proc_info::in, proc_info::out) is det.
>> +
>> +apply_dg_to_then2(!GoalExpr, !IndexInConj, GranularityVar, CallerPredId,
>> + CallerProcId, Distance, PredOrFunc, !ProcInfo) :-
>> + ( !.GoalExpr = conj(parallel_conj, Goals0) ->
>> + list.length(Goals0, Length),
>> + ( !.IndexInConj > Length ->
>> + true
>> + ;
>> + list.index1_det(Goals0, !.IndexInConj, Goal0),
>> + Goal0 = GoalExpr0 - GoalInfo0,
>> + ( GoalExpr0 = plain_call(CalleePredId, CalleeProcId, CallArgs0,
>> + CallBuiltin, CallUnifyContext, CallSymName)
>> + ->
>> + ( CalleePredId = CallerPredId, CalleeProcId = CallerProcId
>> ->
>> + % That is a recursive plain call.
>> +
>> + % Create int variable containing value Distance.
>
> Likewise: s/int variable/granularity variable/
>
> ...
Done.
>
>> +:- pred recompute_conj_info(hlds_goal::in, hlds_goal::out) is det.
>> +
>> +recompute_conj_info(!Conj) :-
>> + ( !.Conj = conj(Type, Goals) - ConjInfo0 ->
>> + goal_list_nonlocals(Goals, NonLocals),
>> + goal_list_instmap_delta(Goals, InstMapDelta),
>> + goal_list_determinism(Goals, Detism),
>> + goal_list_purity(Goals, Purity),
>> + goal_info_set_nonlocals(NonLocals, ConjInfo0, ConjInfo1),
>> + goal_info_set_instmap_delta(InstMapDelta, ConjInfo1, ConjInfo2),
>> + goal_info_set_determinism(Detism, ConjInfo2, ConjInfo3),
>> + goal_info_set_purity(Purity, ConjInfo3, ConjInfo),
>> + !:Conj = conj(Type, Goals) - ConjInfo
>> + ;
>> + % Not a conjunction.
>> + unexpected(this_file, "recompute_conj_info")
>> + ).
>> +
>> + % Update the else part of the new if_then_else goal introduced by the
>> + % transformation as showed in the example. It decrements the value of
>
> s/showed/shown/
Done.
>
>> + % Granularity and uses the decremented value as the last argument of the
>> + % recursive calls.
>
> That comment doesn't make sense.
Fixed. Hope it makes sense now...
>
>> +:- pred apply_dg_to_else(hlds_goal::in, hlds_goal::out, prog_var::in,
>> + pred_id::in, proc_id::in, module_info::in, pred_or_func::in,
>> + proc_info::in, proc_info::out) is det.
>> +
>> +apply_dg_to_else(!Goal, GranularityVar, CallerPredId, CallerProcId,
>> + ModuleInfo, PredOrFunc, !ProcInfo) :-
>> + !.Goal = GoalExpr0 - GoalInfo,
>> + apply_dg_to_else2(GoalExpr0, GoalExpr, 1, _, GranularityVar,
>> CallerPredId,
>> + CallerProcId, ModuleInfo, PredOrFunc, !ProcInfo),
>> + Goal0 = GoalExpr - GoalInfo,
>> + recompute_conj_info(Goal0, !:Goal).
>> +
>> +:- pred apply_dg_to_else2(hlds_goal_expr::in, hlds_goal_expr::out,
>> + int::in, int::out, prog_var::in, pred_id::in, proc_id::in,
>> + module_info::in, pred_or_func::in, proc_info::in, proc_info::out) is
>> det.
>> +
>> +apply_dg_to_else2(!GoalExpr, !IndexInConj, GranularityVar, CallerPredId,
>> + CallerProcId, ModuleInfo, PredOrFunc, !ProcInfo) :-
>> + ( !.GoalExpr = conj(plain_conj, Goals0) ->
>> + list.length(Goals0, Length),
>> + ( !.IndexInConj > Length ->
>> + true
>> + ;
>> + list.index1_det(Goals0, !.IndexInConj, Goal0),
>> + Goal0 = GoalExpr0 - GoalInfo0,
>> + ( GoalExpr0 = plain_call(CalleePredId, CalleeProcId, CallArgs0,
>> + CallBuiltin, CallUnifyContext, CallSymName)
>> + ->
>> + ( CalleePredId = CallerPredId, CalleeProcId = CallerProcId
>> ->
>> + % That is a recursive plain call.
>> +
>> + % Create an int variable containing the value 1.
>>
>> + proc_info_create_var_from_type(int_type, no,
>> + Var, !ProcInfo),
>> + make_int_const_construction(Var, 1, UnifyGoal),
>> +
>> + % Create int variable which will contain the result of
>> the
>> + % decrementation.
>
> I suggest:
>
> Create a variable that will contain the decremented
> granularity distance.
>
> ...
Done.
>
>> + % Apply the distance granularity transformation to a disjunction.
>> + %
>> +:- pred apply_dg_to_disj(list(hlds_goal)::in,
>> + list(hlds_goal)::in, list(hlds_goal)::out, pred_id::in, proc_id::in,
>> + pred_id::in, sym_name::in, proc_info::in, proc_info::out,
>> + module_info::in, module_info::out, int::in, pred_or_func::in,
>> + maybe(prog_var)::in, maybe(prog_var)::out) is det.
>> +
>> +apply_dg_to_disj([], !GoalsAcc, _CallerPredId, _CallerProcId,
>> + _PredIdSpecialized, _SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> + _Distance, _PredOrFunc, !MaybeGranularityVar).
>> +apply_dg_to_disj([Goal0 | Goals], !GoalsAcc, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> + Distance, PredOrFunc, !MaybeGranularityVar) :-
>> + apply_dg_to_goal(Goal0, Goal, CallerPredId, CallerProcId,
>> PredIdSpecialized,
>> + SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance, PredOrFunc,
>> no,
>> + !MaybeGranularityVar, _),
>> + list.append( !.GoalsAcc, [Goal], !:GoalsAcc),
>> + apply_dg_to_disj(Goals, !GoalsAcc, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> Distance,
>> + PredOrFunc, !MaybeGranularityVar).
>> +
>> + % Apply the distance granularity transformation to a switch.
>> + %
>> +:- pred apply_dg_to_switch(
>> + list(case)::in, list(case)::in, list(case)::out, pred_id::in,
>> + proc_id::in, pred_id::in, sym_name::in, proc_info::in, proc_info::out,
>> + module_info::in, module_info::out, int::in, pred_or_func::in,
>> + maybe(prog_var)::in, maybe(prog_var)::out) is det.
>> +
>> +apply_dg_to_switch([], !CasesAcc, _CallerPredId, _CallerProcId,
>> + _PredIdSpecialized, _SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> + _Distance, _PredOrFunc, !MaybeGranularityVar).
>> +apply_dg_to_switch([Case | Cases], !CasesAcc, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> + Distance, PredOrFunc, !MaybeGranularityVar) :-
>> + Case = case(Functor, Goal0),
>> + apply_dg_to_goal(Goal0, Goal, CallerPredId, CallerProcId,
>> PredIdSpecialized,
>> + SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance, PredOrFunc,
>> no,
>> + !MaybeGranularityVar, _),
>> + !:CasesAcc = [case(Functor, Goal) | !.CasesAcc],
>> + apply_dg_to_switch(Cases, !CasesAcc, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
>> Distance,
>> + PredOrFunc, !MaybeGranularityVar).
>> +
>> +%-----------------------------------------------------------------------------%
>> +
>> + % This section contains predicates which will apply the second part of
>> the
>
> s/which will/that/
Done.
>
>> + % transformation i.e. updating the recursive plain calls in the original
>> + % predicate to call the specialized version of the predicate.
>> +
>> +
>> + % Update the recursive calls in each procedure in the list so that the
>> + % pred_id called is the one of the specialized procedure.
>> + %
>> +:- pred update_original_predicate_procs(pred_id::in, list(proc_id)::in,
>> int::in,
>> + pred_or_func::in, pred_id::in, sym_name::in, pred_info::in,
>> pred_info::out,
>> + module_info::in, module_info::out) is det.
>> +
>> +update_original_predicate_procs(_PredId, [], _Distance, _PredOrFunc,
>> + _PredIdSpecialized, _SymNameSpecialized, !PredInfo, !ModuleInfo).
>> +update_original_predicate_procs(PredId, [ProcId | ProcIds], Distance,
>> + PredOrFunc, PredIdSpecialized, SymNameSpecialized, !PredInfo,
>> + !ModuleInfo) :-
>> + module_info_proc_info(!.ModuleInfo, proc(PredId, ProcId), ProcInfo0),
>> + proc_info_get_goal(ProcInfo0, Body0),
>> + update_original_predicate_goal(Body0, Body, PredId, ProcId,
>> + PredIdSpecialized, SymNameSpecialized, ProcInfo0, ProcInfo1,
>> Distance,
>> + PredOrFunc),
>> + proc_info_set_goal(Body, ProcInfo1, ProcInfo2),
>> + requantify_proc(ProcInfo2, ProcInfo3),
>> + RecomputeAtomic = no,
>> + recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo3,
>> + ProcInfo, !ModuleInfo),
>> + pred_info_set_proc_info(ProcId, ProcInfo, !PredInfo),
>> + update_original_predicate_procs(PredId, ProcIds, Distance, PredOrFunc,
>> + PredIdSpecialized, SymNameSpecialized, !PredInfo, !ModuleInfo).
>> +
>> + % Update the recursive calls of a goal so that the pred_id called is the
>> one
>> + % of the specialized procedure.
>> + %
>> +:- pred update_original_predicate_goal(hlds_goal::in, hlds_goal::out,
>> + pred_id::in, proc_id::in, pred_id::in, sym_name::in,
>> + proc_info::in, proc_info::out, int::in, pred_or_func::in) is det.
>> +
>> +update_original_predicate_goal(!Goal, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance,
>> + PredOrFunc) :-
>> + !.Goal = GoalExpr0 - GoalInfo,
>> + (
>> + GoalExpr0 = unify(_, _, _, _, _)
>> + ;
>> + GoalExpr0 = plain_call(_, _, _, _, _, _),
>> + update_original_predicate_plain_call(!Goal, CallerPredId,
>> CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance,
>> + PredOrFunc)
>> + ;
>> + GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
>> + ;
>> + GoalExpr0 = generic_call(_, _, _, _)
>> + ;
>> + GoalExpr0 = conj(Type, Goals0),
>> + update_original_predicate_goals(Goals0, [], Goals1, CallerPredId,
>> + CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
>> + Distance, PredOrFunc),
>> + (
>> + Type = plain_conj,
>> + flatten_conj(Goals1, Goals)
>> + ;
>> + Type = parallel_conj,
>> + % No need to flatten parallel conjunctions as the transformation
>> may
>> + % only create plain conjunctions
>> + % (see update_original_predicate_plain_call).
>> + Goals = Goals1
>> + ),
>> + GoalExpr = conj(Type, Goals),
>> + !:Goal = GoalExpr - GoalInfo
>> + ;
>> + GoalExpr0 = disj(Goals0),
>> + update_original_predicate_goals(Goals0, [], Goals, CallerPredId,
>> + CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
>> + Distance, PredOrFunc),
>> + GoalExpr = disj(Goals),
>> + !:Goal = GoalExpr - GoalInfo
>> + ;
>> + GoalExpr0 = switch(Var, CanFail, Cases0),
>> + update_original_predicate_switch(Cases0, [], Cases, CallerPredId,
>> + CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
>> + Distance, PredOrFunc),
>> + GoalExpr = switch(Var, CanFail, Cases),
>> + !:Goal = GoalExpr - GoalInfo
>> + ;
>> + GoalExpr0 = negation(Goal0),
>> + update_original_predicate_goal(Goal0, Goal, CallerPredId,
>> CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance,
>> + PredOrFunc),
>> + GoalExpr = negation(Goal),
>> + !:Goal = GoalExpr - GoalInfo
>> + ;
>> + GoalExpr0 = scope(_, _)
>
> Don't you need to update the goal inside the scope here?
Done.
>
>> + ;
>> + GoalExpr0 = if_then_else(Vars, If0, Then0, Else0),
>> + update_original_predicate_goal(If0, If, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance,
>> + PredOrFunc),
>> + update_original_predicate_goal(Then0, Then, CallerPredId,
>> CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance,
>> + PredOrFunc),
>> + update_original_predicate_goal(Else0, Else, CallerPredId,
>> CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance,
>> + PredOrFunc),
>> + GoalExpr = if_then_else(Vars, If, Then, Else),
>> + !:Goal = GoalExpr - GoalInfo
>> + ;
>> + GoalExpr0 = shorthand(_),
>> + % Shorthand is not supposed to occur here.
>
> s/is not/are not/
Done.
>
> ...
>
>> + % Update the plain call so that the pred_id called is the one of the
>> + % specialized procedure.
>> + %
>> +:- pred update_original_predicate_plain_call(hlds_goal::in, hlds_goal::out,
>> + pred_id::in, proc_id::in, pred_id::in, sym_name::in,
>> + proc_info::in, proc_info::out, int::in, pred_or_func::in) is det.
>> +
>> +update_original_predicate_plain_call(!Call, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance,
>> + PredOrFunc) :-
>> + !.Call = CallExpr0 - CallInfo0,
>> + ( CallExpr0 = plain_call(CalleePredId, CalleeProcId, CallArgs0,
>> + CallBuiltin, CallUnifyContext, _) ->
>> + ( CalleePredId = CallerPredId, CalleeProcId = CallerProcId ->
>> + % That is a recursive plain call.
>> +
>> + % Create the int variable which will be used as the last
>> argument of
>> + % the call for a predicate and as the second last argument for a
>> + % function.
>> + proc_info_create_var_from_type(int_type, no, Var, !ProcInfo),
>> + make_int_const_construction(Var, Distance, UnifyGoal),
>> + (
>> + PredOrFunc = predicate,
>> + % Use the decremented value of GranularityVar as the
>> + % last argument of the call.
>> + list.append(CallArgs0, [Var], CallArgs)
>> + ;
>> + PredOrFunc = function,
>> + % Use the decremented value of GranularityVar as the
>> + % second last argument of the call.
>> + list.length(CallArgs0, LengthCallArgs),
>> + list.det_split_list(LengthCallArgs - 1, CallArgs0,
>> + StartCallArgs0, EndCallArgs),
>> + list.append(StartCallArgs0, [Var], StartCallArgs),
>> + list.append(StartCallArgs, EndCallArgs, CallArgs)
>> + ),
>> +
>> + % Update the pred_id to the pred_id of the cloned pred.
>> + CallExpr = plain_call(PredIdSpecialized, CalleeProcId, CallArgs,
>> + CallBuiltin, CallUnifyContext, SymNameSpecialized),
>> +
>> + % Update the nonlocals and the instmap_delta of the
>> hlds_goal_info
>> + % of the recursive plain call for Var.
>> + goal_info_get_nonlocals(CallInfo0, NonLocals0),
>> + set.insert(NonLocals0, Var, NonLocals),
>> + goal_info_set_nonlocals(NonLocals, CallInfo0, CallInfo1),
>> + goal_info_get_instmap_delta(CallInfo1, InstMapDelta0),
>> + MerInst = ground(shared, none),
>> + instmap_delta_insert(Var, MerInst, InstMapDelta0, InstMapDelta),
>> + goal_info_set_instmap_delta(InstMapDelta, CallInfo1, CallInfo),
>> + Call = CallExpr - CallInfo,
>> +
>> + % That might unflatten the parent conjunction. We deal with that
>> + % after the conjunction has been processed
>> + % (see update_original_predicate_goal).
>
> I suggest:
>
> The resuling conjunction may not be flat. We deal with that ...
Done.
>
>> + create_conj(UnifyGoal, Call, plain_conj, !:Call)
>> + ;
>> + true
>> + )
>> + ;
>> + % Not a plain call.
>> + unexpected(this_file, "update_original_predicate_plain_call")
>> + ).
>> +
>> + % Update the recursive calls of each goal in the list so that the
>> pred_id
>> + % called is the one of the specialized procedure.
>> + %
>> +:- pred update_original_predicate_goals(list(hlds_goal)::in,
>> + list(hlds_goal)::in, list(hlds_goal)::out, pred_id::in, proc_id::in,
>> + pred_id::in, sym_name::in, proc_info::in, proc_info::out, int::in,
>> + pred_or_func::in) is det.
>> +
>> +update_original_predicate_goals([], !GoalsAcc, _CallerPredId,
>> + _CallerProcId, _PredIdSpecialized, _SymNameSpecialized, !ProcInfo,
>> + _Distance, _PredOrFunc).
>> +update_original_predicate_goals([Goal0 | Goals], !GoalsAcc, CallerPredId,
>> + CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
>> + Distance, PredOrFunc) :-
>> + update_original_predicate_goal(Goal0, Goal, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance,
>> PredOrFunc),
>> + list.append(!.GoalsAcc, [Goal], !:GoalsAcc),
>> + update_original_predicate_goals(Goals, !GoalsAcc, CallerPredId,
>> + CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
>> + Distance, PredOrFunc).
>> +
>> + % Update the recursive calls of a switch so that the pred_id called is
>> the
>> + % one of the specialized procedure.
>> + %
>> +:- pred update_original_predicate_switch(
>> + list(case)::in, list(case)::in, list(case)::out, pred_id::in,
>> + proc_id::in, pred_id::in, sym_name::in, proc_info::in, proc_info::out,
>> + int::in, pred_or_func::in) is det.
>> +
>> +update_original_predicate_switch([], !CasesAcc, _CallerPredId,
>> _CallerProcId,
>> + _PredIdSpecialized, _SymNameSpecialized, !ProcInfo, _Distance,
>> + _PredOrFunc).
>> +update_original_predicate_switch([Case | Cases], !CasesAcc, CallerPredId,
>> + CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
>> + Distance, PredOrFunc) :-
>> + Case = case(Functor, Goal0),
>> + update_original_predicate_goal(Goal0, Goal, CallerPredId, CallerProcId,
>> + PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance,
>> PredOrFunc),
>> + !:CasesAcc = [ case(Functor, Goal) | !.CasesAcc ],
>> + update_original_predicate_switch(Cases, !CasesAcc, CallerPredId,
>> + CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
>> + Distance, PredOrFunc).
>> +
>> +%-----------------------------------------------------------------------------%
>> +
>> + % This section contains predicate which are used by the two parts of the
>> + % transformation.
>
> s/the two/both/
Done.
>
>> +
>> +
>> + % Update the string name of a predicate (same format as make_pred_name
>> in
>> + % prog_util).
>> +
>
> Is there a reason why you cannot use make_pred_name to do this?
As said before, I have renamed update_pred_name to create_specialized_pred_name. We can
not use make_pred_name here because the output needs to be a string and not a sym_name as
make_pred_name creates.
>
>> +:- pred update_pred_name(string::in, pred_or_func::in, int::in,
>> + string::in, string::out) is det.
>> +
>> +update_pred_name(Prefix, PredOrFunc, Distance, !PredName) :-
>> + (
>> + PredOrFunc = predicate,
>> + PFS = "pred"
>> + ;
>> + PredOrFunc = function,
>> + PFS = "func"
>> + ),
>> + int_to_string(Distance, PredIdStr),
>> + string.format("%s__%s__%s__%s",
>> + [s(Prefix), s(PFS), s(!.PredName), s(PredIdStr)], !:PredName).
>> +
>> +:-func granularity_prefix = string.
>> +
>> +granularity_prefix = "distance_granularity".
>
> That name could potentially clash with user predicates. I suggest:
>
> granularity_prefix = "DistanceGranularityFor".
Done.
>
> To be continued ...
>
> Julien.
Thanks Julien.
Here is the new diff:
Index: compiler/dep_par_conj.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dep_par_conj.m,v
retrieving revision 1.15
diff -u -r1.15 dep_par_conj.m
--- compiler/dep_par_conj.m 5 Dec 2006 03:50:49 -0000 1.15
+++ compiler/dep_par_conj.m 10 Jan 2007 04:54:27 -0000
@@ -64,15 +64,23 @@
:- module transform_hlds.dep_par_conj.
:- interface.
+:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
+:- import_module hlds.instmap.
+:- import_module parse_tree.prog_data.
:- import_module io.
+:- import_module set.
%-----------------------------------------------------------------------------%
:- pred dependent_par_conj(module_info::in, module_info::out, io::di, io::uo)
is det.
+ % Exported for use by the implicit_parallelism pass.
+:- func find_shared_variables(module_info, instmap, hlds_goals)
+ = set(prog_var).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -82,16 +90,13 @@
:- import_module check_hlds.mode_util.
:- import_module check_hlds.purity.
:- import_module hlds.goal_util.
-:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
-:- import_module hlds.instmap.
:- import_module hlds.pred_table.
:- import_module hlds.quantification.
:- import_module libs.compiler_util.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
-:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.prog_util.
@@ -102,7 +107,6 @@
:- import_module map.
:- import_module maybe.
:- import_module pair.
-:- import_module set.
:- import_module std_util.
:- import_module string.
:- import_module svmap.
@@ -678,9 +682,6 @@
% XXX this code is probably too complicated. I think Thomas already had a
% more elegant way to find the shared variables somewhere, using multisets.
%
-:- func find_shared_variables(module_info, instmap, hlds_goals)
- = set(prog_var).
-
find_shared_variables(ModuleInfo, InstMap, Goals) = SharedVars :-
list.map2(get_nonlocals_and_instmaps, Goals, Nonlocals, InstMapDeltas),
find_shared_variables_2(ModuleInfo, 0, Nonlocals, InstMap, InstMapDeltas,
Index: compiler/distance_granularity.m
===================================================================
RCS file: compiler/distance_granularity.m
diff -N compiler/distance_granularity.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/distance_granularity.m 10 Jan 2007 04:54:27 -0000
@@ -0,0 +1,1032 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2006 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: distance_granularity.m.
+% Author: tannier.
+%
+% This module contains a program transformation that adds a mechanism that
+% controls the granularity of parallel execution using the distance metric. For
+% more information, see:
+% K. Shen, V. Santos Costa, and A. King.
+% Distance: a New Metric for Controlling Granularity for Parallel Execution.
+% In Proceedings of the Joint International Conference and Symposium on Logic
+% Programming.
+% MIT Press, 1998.
+% http://www.cs.ukc.ac.uk/pubs/1998/588.
+% http://citeseer.ist.psu.edu/shen98distance.html.
+%
+% Example of the transformation:
+%
+% From the original version of fibonacci:
+%
+% :- pred fibonacci(int::in, int::out) is det.
+%
+% fibonacci(X, Y) :-
+% ( X = 0 ->
+% Y = 0
+% ;
+% ( X = 1 ->
+% Y = 1
+% ;
+% ( X > 1 ->
+% J = X - 1,
+% K = X - 2,
+% (
+% fibonacci(J, Jout)
+% &
+% fibonacci(K, Kout)
+% ),
+% Y = Jout + Kout
+% ;
+% error("fibonacci: wrong value")
+% )
+% )
+% ).
+%
+% we create a specialized version (we assume that the distance which was
+% given during compilation is 10):
+%
+% :- pred DistanceGranularityFor__pred__fibonacci__10(int::in, int::out,
+% int::in) is det.
+%
+% DistanceGranularityFor__pred__fibonacci__10(X, Y, Distance) :-
+% ( X = 0 ->
+% Y = 0
+% ;
+% ( X = 1 ->
+% Y = 1
+% ;
+% ( X > 1 ->
+% J = X - 1,
+% K = X - 2,
+% ( Distance = 0 ->
+% (
+% DistanceGranularityFor__pred__fibonacci__10i(J, Jout,
+% 10)
+% &
+% DistanceGranularityFor__pred__fibonacci__10(K, Kout,
+% 10)
+% )
+% ;
+% DistanceGranularityFor__pred__fibonacci__10(J, Jout,
+% Distance - 1),
+% DistanceGranularityFor__pred__fibonacci__10(K, Kout,
+% Distance - 1)
+% ),
+% Y = Jout + Kout
+% ;
+% error("fibonacci: wrong value")
+% )
+% )
+% ).
+%
+% After which, the original version becomes:
+%
+% :- pred fibonacci(int::in, int::out) is det.
+%
+% fibonacci(X, Y) :-
+% ( X = 0 ->
+% Y = 0
+% ;
+% ( X = 1 ->
+% Y = 1
+% ;
+% ( X > 1 ->
+% J = X - 1,
+% K = X - 2,
+% (
+% DistanceGranularityFor__pred__fibonacci__10(J, Jout, 10)
+% &
+% DistanceGranularityFor__pred__fibonacci__10(K, Kout, 10)
+% ),
+% Y = Jout + Kout
+% ;
+% error("fibonacci: wrong value")
+% )
+% )
+% ).
+%
+% The second part of the transformation makes the granularity control
+% transparent to the original procedure's callers by replacing the recursive
+% calls in the body of the original procedure with calls to the specialized
+% version. The original procedure's callers should never need to call the
+% specialized version directly.
+%
+% XXX For the time being, we assume that the int module was imported in the
+% source code of the program for which we apply the distance granularity
+% transformation.
+%
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds.distance_granularity.
+:- interface.
+
+:- import_module hlds.hlds_module.
+
+%-----------------------------------------------------------------------------%
+
+ % control_distance_granularity(!ModuleInfo, Distance)
+ %
+ % Control the granularity of parallelism of a module using the distance
+ % metric.
+ %
+:- pred control_distance_granularity(module_info::in, module_info::out,
+ int::in) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.mode_util.
+:- import_module hlds.goal_util.
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.pred_table.
+:- import_module hlds.quantification.
+:- import_module hlds.instmap.
+:- import_module libs.compiler_util.
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_mode.
+:- import_module parse_tree.prog_type.
+:- import_module parse_tree.prog_util.
+:- import_module term.
+:- import_module transform_hlds.implicit_parallelism.
+
+:- import_module bool.
+:- import_module int.
+:- import_module io.
+:- import_module list.
+:- import_module pair.
+:- import_module map.
+:- import_module maybe.
+:- import_module require.
+:- import_module string.
+:- import_module set.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+
+ % This section contains predicates which apply the first part of the
+ % transformation i.e. creating the specialized version of the
+ % original predicate.
+
+
+control_distance_granularity(!ModuleInfo, Distance) :-
+ module_info_predids(!.ModuleInfo, PredIds),
+ apply_dg_to_preds(PredIds, Distance, !ModuleInfo).
+
+ % Apply the distance granularity transformation to each predicate in the
+ % list.
+ %
+:- pred apply_dg_to_preds(list(pred_id)::in, int::in,
+ module_info::in, module_info::out) is det.
+
+apply_dg_to_preds([], _Distance, !ModuleInfo).
+apply_dg_to_preds([PredId | PredIdList], Distance, !ModuleInfo) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+ % We need to know what the pred_id will be for the specified predicate
+ % before we actually clone it (this avoids doing one more pass to update the
+ % pred_id in the recursive plain calls).
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable),
+ get_next_pred_id(PredicateTable, NewPredId),
+
+ % Create the new sym_name for the recursive plain calls.
+ ModuleName = pred_info_module(PredInfo),
+ Prefix = granularity_prefix,
+ MaybePredOrFunc = yes(predicate),
+ NewPredIdGranularity = newpred_distance_granularity(Distance),
+ PredName0 = pred_info_name(PredInfo),
+ make_pred_name(ModuleName, Prefix, MaybePredOrFunc, PredName0,
+ NewPredIdGranularity, NewCallSymName),
+
+ ProcIds = pred_info_non_imported_procids(PredInfo),
+ apply_dg_to_procs(PredId, ProcIds, Distance, NewPredId, NewCallSymName,
+ PredInfo, PredInfoClone0, no, Specialized, !ModuleInfo),
+ (
+ Specialized = yes,
+ % The predicate has been specialized as it contains recursive calls.
+
+ % Create the name of the specialized predicate out of the name of the
+ % original one.
+ create_specialized_pred_name(Prefix, Distance, PredName0, PredName),
+ pred_info_set_name(PredName, PredInfoClone0, PredInfoClone1),
+
+ % If the original predicate was a function then the specialized version
+ % is a predicate.
+ pred_info_set_is_pred_or_func(predicate, PredInfoClone1,
+ PredInfoClone2),
+
+ % The arity and the argument types of the specialized predicate must be
+ % modified.
+ Arity = pred_info_orig_arity(PredInfoClone2),
+ pred_info_set_orig_arity(Arity + 1, PredInfoClone2, PredInfoClone3),
+ pred_info_get_arg_types(PredInfoClone3, ArgTypes0),
+ list.append(ArgTypes0, [int_type], ArgTypes),
+ pred_info_get_typevarset(PredInfoClone3, Tvarset),
+ pred_info_get_exist_quant_tvars(PredInfoClone3, ExistqTvars),
+ pred_info_set_arg_types(Tvarset, ExistqTvars, ArgTypes,
+ PredInfoClone3, PredInfoClone),
+
+ % Add the specialized predicate to the predicate table.
+ module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
+ predicate_table_insert(PredInfoClone, _, PredicateTable0,
+ PredicateTable1),
+ module_info_set_predicate_table(PredicateTable1, !ModuleInfo),
+
+ update_original_predicate_procs(PredId, ProcIds, Distance, NewPredId,
+ NewCallSymName, PredInfo, PredInfoUpdated, !ModuleInfo),
+ module_info_set_pred_info(PredId, PredInfoUpdated, !ModuleInfo)
+ ;
+ Specialized = no,
+ % The predicate has not been specialized.
+ true
+ ),
+ apply_dg_to_preds(PredIdList, Distance, !ModuleInfo).
+
+ % Apply the distance granularity transformation to each procedure in the
+ % list.
+ % PredIdSpecialized is the pred_id of the predicate to be specialized.
+ % SymNameSpecialized is the sym_name of the predicate to be specialized.
+ %
+:- pred apply_dg_to_procs(pred_id::in, list(proc_id)::in, int::in,
+ pred_id::in, sym_name::in, pred_info::in, pred_info::out,
+ bool::in, bool::out, module_info::in, module_info::out) is det.
+
+apply_dg_to_procs(_PredId, [], _Distance, _PredIdSpecialized,
+ _SymNameSpecialized, !PredInfo, !Specialized, !ModuleInfo).
+apply_dg_to_procs(PredId, [ProcId | ProcIds], Distance, PredIdSpecialized,
+ SymNameSpecialized, !PredInfo, !Specialized, !ModuleInfo) :-
+ module_info_proc_info(!.ModuleInfo, proc(PredId, ProcId), ProcInfo0),
+ proc_info_get_has_parallel_conj(ProcInfo0, HasParallelConj),
+ (
+ HasParallelConj = yes,
+ % The procedure contains parallel conjunction(s).
+
+ proc_info_get_goal(ProcInfo0, Body),
+ apply_dg_to_goal(Body, BodyClone, PredId, ProcId, PredIdSpecialized,
+ SymNameSpecialized, ProcInfo0, ProcInfo1, !ModuleInfo, Distance, no,
+ no, MaybeGranularityVar, _),
+ (
+ MaybeGranularityVar = yes(_),
+ % The granularity variable has been created while the procedure was
+ % processed. That means that the predicate must be specialized.
+ !:Specialized = yes,
+ proc_info_set_goal(BodyClone, ProcInfo1, ProcInfo2),
+ requantify_proc(ProcInfo2, ProcInfo3),
+ RecomputeAtomic = no,
+ recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo3,
+ ProcInfo, !ModuleInfo),
+ pred_info_set_proc_info(ProcId, ProcInfo, !PredInfo)
+ ;
+ MaybeGranularityVar = no
+ )
+ ;
+ HasParallelConj = no
+ % No need to apply the distance granularity transformation to this
+ % procedure as it does not contain any parallel conjunctions.
+ ),
+ apply_dg_to_procs(PredId, ProcIds, Distance, PredIdSpecialized,
+ SymNameSpecialized, !PredInfo, !Specialized, !ModuleInfo).
+
+ % Apply the distance granularity transformation to a goal.
+ % CallerPredId and CallerProcId are those of the original predicate.
+ %
+:- pred apply_dg_to_goal(hlds_goal::in, hlds_goal::out, pred_id::in,
+ proc_id::in, pred_id::in, sym_name::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, int::in, bool::in,
+ maybe(prog_var)::in, maybe(prog_var)::out, bool::out) is det.
+
+apply_dg_to_goal(!Goal, CallerPredId, CallerProcId, PredIdSpecialized,
+ SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance, IsInParallelConj,
+ !MaybeGranularityVar, IsRecursiveCallInParallelConj) :-
+ !.Goal = GoalExpr0 - GoalInfo,
+ (
+ GoalExpr0 = unify(_, _, _, _, _),
+ IsRecursiveCallInParallelConj = no
+ ;
+ GoalExpr0 = plain_call(_, _, _, _, _, _),
+ apply_dg_to_plain_call(GoalExpr0, GoalExpr, CallerPredId,
+ PredIdSpecialized, SymNameSpecialized, CallerProcId, !ProcInfo,
+ !ModuleInfo, IsInParallelConj, !MaybeGranularityVar,
+ IsRecursiveCallInParallelConj),
+ !:Goal = GoalExpr - GoalInfo
+ ;
+ GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
+ IsRecursiveCallInParallelConj = no
+ ;
+ GoalExpr0 = generic_call(_, _, _, _),
+ IsRecursiveCallInParallelConj = no
+ ;
+ GoalExpr0 = conj(Type, Goals0),
+ apply_dg_to_conj(Goals0, [], Goals, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ Distance, yes, !MaybeGranularityVar, no, ContainRecursiveCalls),
+ (
+ Type = plain_conj,
+ GoalExpr = conj(plain_conj, Goals),
+ !:Goal = GoalExpr - GoalInfo
+ ;
+ Type = parallel_conj,
+ (
+ ContainRecursiveCalls = yes,
+ create_if_then_else_goal(Goals, GoalInfo, !.MaybeGranularityVar,
+ PredIdSpecialized, CallerProcId, Distance, !:Goal,
+ !ProcInfo, !.ModuleInfo)
+ ;
+ ContainRecursiveCalls = no,
+ true
+ )
+ ),
+ IsRecursiveCallInParallelConj = no
+ ;
+ GoalExpr0 = disj(Goals0),
+ apply_dg_to_disj(Goals0, [], Goals, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ Distance, !MaybeGranularityVar),
+ GoalExpr = disj(Goals),
+ !:Goal = GoalExpr - GoalInfo,
+ IsRecursiveCallInParallelConj = no
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ apply_dg_to_switch(Cases0, [], Cases, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ Distance, !MaybeGranularityVar),
+ GoalExpr = switch(Var, CanFail, Cases),
+ !:Goal = GoalExpr - GoalInfo,
+ IsRecursiveCallInParallelConj = no
+ ;
+ GoalExpr0 = negation(Goal0),
+ apply_dg_to_goal(Goal0, Goal, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ Distance, IsInParallelConj, !MaybeGranularityVar,
+ IsRecursiveCallInParallelConj),
+ GoalExpr = negation(Goal),
+ !:Goal = GoalExpr - GoalInfo
+ ;
+ GoalExpr0 = scope(Reason, Goal0),
+ apply_dg_to_goal(Goal0, Goal, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ Distance, IsInParallelConj, !MaybeGranularityVar,
+ IsRecursiveCallInParallelConj),
+ GoalExpr = scope(Reason, Goal),
+ !:Goal = GoalExpr - GoalInfo
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ apply_dg_to_goal(Cond0, Cond, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ Distance, no, !MaybeGranularityVar, _),
+ apply_dg_to_goal(Then0, Then, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ Distance, no, !MaybeGranularityVar, _),
+ apply_dg_to_goal(Else0, Else, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ Distance, no, !MaybeGranularityVar, _),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ !:Goal = GoalExpr - GoalInfo,
+ IsRecursiveCallInParallelConj = no
+ ;
+ GoalExpr0 = shorthand(_),
+ % Shorthand are not supposed to occur here.
+ unexpected(this_file, "apply_dg_to_goal")
+ ).
+
+ % Apply the distance granularity transformation to a plain call.
+ %
+:- pred apply_dg_to_plain_call(hlds_goal_expr::in, hlds_goal_expr::out,
+ pred_id::in, pred_id::in, sym_name::in, proc_id::in, proc_info::in,
+ proc_info::out, module_info::in, module_info::out, bool::in,
+ maybe(prog_var)::in, maybe(prog_var)::out, bool::out) is det.
+
+apply_dg_to_plain_call(!CallExpr, CallerPredId, PredIdSpecialized,
+ SymNameSpecialized, CallerProcId, !ProcInfo, !ModuleInfo,
+ IsInParallelConj, !MaybeGranularityVar,
+ IsRecursiveCallInParallelConj) :-
+ ( !.CallExpr = plain_call(CalleePredId, CalleeProcId, CallArgs, CallBuiltin,
+ CallUnifyContext, _) ->
+ ( IsInParallelConj = yes, CalleePredId = CallerPredId,
+ CalleeProcId = CallerProcId
+ ->
+ % That is a recursive plain call in a parallel conjunction.
+ (
+ !.MaybeGranularityVar = yes(_GranularityVar),
+ % The variable Granularity has already been added to ProcInfo.
+ true
+ ;
+ !.MaybeGranularityVar = no,
+ % Add the variable Granularity to ProcInfo.
+ proc_info_create_var_from_type(int_type, no, GranularityVar,
+ !ProcInfo),
+ !:MaybeGranularityVar = yes(GranularityVar),
+
+ % XXX Check if the int module is imported (that is why
+ % ModuleInfo can be modified).
+
+ % Add the granularity variable to the head variables of the
+ % procedure and update the argmodes.
+ proc_info_get_argmodes(!.ProcInfo, ArgsModes0),
+ proc_info_get_headvars(!.ProcInfo, HeadVars0),
+ list.append(ArgsModes0, [in_mode], ArgsModes),
+ list.append(HeadVars0, [GranularityVar], HeadVars),
+ proc_info_set_argmodes(ArgsModes, !ProcInfo),
+ proc_info_set_headvars(HeadVars, !ProcInfo)
+ ),
+
+ % Change the pred_id and the sym_name. We will deal with the
+ % arguments later as they are not identical for the then and the
+ % else part of the if_then_else goal introduced by the
+ % transformation.
+ !:CallExpr = plain_call(PredIdSpecialized, CallerProcId,
+ CallArgs, CallBuiltin, CallUnifyContext, SymNameSpecialized),
+ IsRecursiveCallInParallelConj = yes
+ ;
+ IsRecursiveCallInParallelConj = no
+ )
+ ;
+ % Not a plain call.
+ unexpected(this_file, "apply_dg_to_plain_call")
+ ).
+
+ % Apply the distance granularity transformation to a conjunction.
+ %
+:- pred apply_dg_to_conj(hlds_goals::in, hlds_goals::in, hlds_goals::out,
+ pred_id::in, proc_id::in, pred_id::in, sym_name::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out, int::in,
+ bool::in, maybe(prog_var)::in, maybe(prog_var)::out,
+ bool::in, bool::out) is det.
+
+apply_dg_to_conj([], !GoalsAcc, _CallerPredId, _CallerProcId,
+ _PredIdSpecialized, _SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ _Distance, _IsInParallelConj,
+ !MaybeGranularityVar, !HasRecursiveCallsInParallelConj).
+apply_dg_to_conj([Goal0 | Goals], !GoalsAcc, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ Distance, IsInParallelConj, !MaybeGranularityVar,
+ !HasRecursiveCallsInParallelConj) :-
+ apply_dg_to_goal(Goal0, Goal, CallerPredId, CallerProcId, PredIdSpecialized,
+ SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance, IsInParallelConj,
+ !MaybeGranularityVar, IsRecursiveCall),
+ list.append(!.GoalsAcc, [Goal], !:GoalsAcc),
+ (
+ IsRecursiveCall = yes,
+ % The goal we just processed is a recursive call in a parallel
+ % conjunction. Therefore, the conjunction contains recursive calls.
+ !:HasRecursiveCallsInParallelConj = yes
+ ;
+ IsRecursiveCall = no,
+ !:HasRecursiveCallsInParallelConj = !.HasRecursiveCallsInParallelConj
+ ),
+ apply_dg_to_conj(Goals, !GoalsAcc, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance,
+ IsInParallelConj, !MaybeGranularityVar,
+ !HasRecursiveCallsInParallelConj).
+
+ % Create the if_then_else goal surrounding the recursive plain call as
+ % shown in the example.
+ %
+:- pred create_if_then_else_goal(hlds_goals::in, hlds_goal_info::in,
+ maybe(prog_var)::in, pred_id::in, proc_id::in, int::in, hlds_goal::out,
+ proc_info::in, proc_info::out, module_info::in) is det.
+
+create_if_then_else_goal(GoalsInConj, ConjInfo, MaybeGranularityVar,
+ PredIdSpecialized, CallerProcId, Distance, IfThenElseGoal, !ProcInfo,
+ ModuleInfo) :-
+ proc_info_create_var_from_type(int_type, no, Var, !ProcInfo),
+ make_int_const_construction(Var, 0, UnifyGoal),
+ (
+ MaybeGranularityVar = yes(GranularityVar),
+ % Create the condition.
+ make_simple_test(GranularityVar, Var,
+ umc_implicit("distance_granularity"), [], Test),
+ create_conj(UnifyGoal, Test, plain_conj , Cond),
+
+ % Create the then.
+ Then0 = conj(parallel_conj, GoalsInConj) - ConjInfo,
+ apply_dg_to_then(Then0, Then, GranularityVar, PredIdSpecialized,
+ CallerProcId, Distance, !ProcInfo),
+
+ % Create the else.
+ Else0 = conj(plain_conj, GoalsInConj) - ConjInfo,
+ apply_dg_to_else(Else0, Else, GranularityVar, PredIdSpecialized,
+ CallerProcId, ModuleInfo, !ProcInfo),
+
+ % The non-locals of the hlds_goal_info of the if_then_else goal must
+ % contain the variable controlling the granularity.
+ goal_info_get_nonlocals(ConjInfo, NonLocals0),
+ set.insert(NonLocals0, GranularityVar, NonLocals),
+ goal_info_set_nonlocals(NonLocals, ConjInfo, IfThenElseInfo),
+ IfThenElseGoal = if_then_else([], Cond, Then, Else) - IfThenElseInfo
+ ;
+ MaybeGranularityVar = no,
+ % The conjunction contains recursive calls so the
+ % granularity variable must have been created.
+ unexpected(this_file, "apply_dg_to_goal")
+ ).
+
+ % Update the then part of the new if_then_else goal introduced by the
+ % transformation as shown in the example. It creates a variable Granularity
+ % containing the value Distance and uses it as the last argument of the
+ % calls of the recursive procedure.
+ %
+:- pred apply_dg_to_then(hlds_goal::in, hlds_goal::out, prog_var::in,
+ pred_id::in, proc_id::in, int::in, proc_info::in, proc_info::out) is det.
+
+apply_dg_to_then(!Goal, GranularityVar, CallerPredId, CallerProcId, Distance,
+ !ProcInfo) :-
+ !.Goal = GoalExpr0 - GoalInfo,
+ apply_dg_to_then2(GoalExpr0, GoalExpr, 1, _, GranularityVar, CallerPredId,
+ CallerProcId, Distance, !ProcInfo),
+ Goal0 = GoalExpr - GoalInfo,
+ recompute_conj_info(Goal0, !:Goal).
+
+:- pred apply_dg_to_then2(hlds_goal_expr::in, hlds_goal_expr::out,
+ int::in, int::out, prog_var::in, pred_id::in, proc_id::in, int::in,
+ proc_info::in, proc_info::out) is det.
+
+apply_dg_to_then2(!GoalExpr, !IndexInConj, GranularityVar, CallerPredId,
+ CallerProcId, Distance, !ProcInfo) :-
+ ( !.GoalExpr = conj(parallel_conj, Goals0) ->
+ list.length(Goals0, Length),
+ ( !.IndexInConj > Length ->
+ true
+ ;
+ list.index1_det(Goals0, !.IndexInConj, Goal0),
+ Goal0 = GoalExpr0 - GoalInfo0,
+ ( GoalExpr0 = plain_call(CalleePredId, CalleeProcId, CallArgs0,
+ CallBuiltin, _, CallSymName)
+ ->
+ ( CalleePredId = CallerPredId, CalleeProcId = CallerProcId ->
+ % That is a recursive plain call.
+
+ % Create granularity variable containing value Distance.
+ proc_info_create_var_from_type(int_type, no,
+ Var, !ProcInfo),
+ make_int_const_construction(Var, Distance, UnifyGoal),
+
+ % Use that variable as the last argument of the call.
+ list.append(CallArgs0, [Var], CallArgs),
+
+ % If the original predicate is a function then the
+ % specialized version is a predicate. Therefore, there is no
+ % need for the unify context anymore.
+ CallUnifyContext = no,
+
+ GoalExpr = plain_call(CalleePredId, CalleeProcId, CallArgs,
+ CallBuiltin, CallUnifyContext, CallSymName),
+
+ % Var has instmap bound(Distance).
+ goal_info_get_instmap_delta(GoalInfo0, InstMapDelta0),
+ MerInst = bound(shared, [bound_functor(int_const(Distance),
+ [])]),
+ instmap_delta_insert(Var, MerInst, InstMapDelta0,
+ InstMapDelta),
+ goal_info_set_instmap_delta(InstMapDelta, GoalInfo0,
+ GoalInfo),
+
+ Goal = GoalExpr - GoalInfo,
+
+ create_conj(UnifyGoal, Goal, plain_conj, PlainConj),
+
+ % Replace the call by the newly created conjunction.
+ list.replace_nth_det(Goals0, !.IndexInConj, PlainConj,
+ Goals),
+ !:GoalExpr = conj(parallel_conj, Goals)
+ ;
+ % Not a recursive call.
+ true
+ ),
+ !:IndexInConj = !.IndexInConj + 1
+ ;
+ !:IndexInConj = !.IndexInConj + 1
+ ),
+ apply_dg_to_then2(!GoalExpr, !IndexInConj, GranularityVar,
+ CallerPredId, CallerProcId, Distance, !ProcInfo)
+ )
+ ;
+ % Not a parallel conjunction.
+ unexpected(this_file, "apply_dg_to_then2")
+ ).
+
+ % Recompute the hlds_goal_info of a conjunction.
+ %
+:- pred recompute_conj_info(hlds_goal::in, hlds_goal::out) is det.
+
+recompute_conj_info(!Conj) :-
+ ( !.Conj = conj(Type, Goals) - ConjInfo0 ->
+ goal_list_nonlocals(Goals, NonLocals),
+ goal_list_instmap_delta(Goals, InstMapDelta),
+ goal_list_determinism(Goals, Detism),
+ goal_list_purity(Goals, Purity),
+ goal_info_set_nonlocals(NonLocals, ConjInfo0, ConjInfo1),
+ goal_info_set_instmap_delta(InstMapDelta, ConjInfo1, ConjInfo2),
+ goal_info_set_determinism(Detism, ConjInfo2, ConjInfo3),
+ goal_info_set_purity(Purity, ConjInfo3, ConjInfo),
+ !:Conj = conj(Type, Goals) - ConjInfo
+ ;
+ % Not a conjunction.
+ unexpected(this_file, "recompute_conj_info")
+ ).
+
+ % Update the else part of the new if_then_else goal introduced by the
+ % transformation as shown in the example. It decrements the value of
+ % GranularityVar and uses it as the last argument of the calls of the
+ % recursive procedure.
+ %
+:- pred apply_dg_to_else(hlds_goal::in, hlds_goal::out, prog_var::in,
+ pred_id::in, proc_id::in, module_info::in,
+ proc_info::in, proc_info::out) is det.
+
+apply_dg_to_else(!Goal, GranularityVar, CallerPredId, CallerProcId,
+ ModuleInfo, !ProcInfo) :-
+ !.Goal = GoalExpr0 - GoalInfo,
+ apply_dg_to_else2(GoalExpr0, GoalExpr, 1, _, GranularityVar, CallerPredId,
+ CallerProcId, ModuleInfo, !ProcInfo),
+ Goal0 = GoalExpr - GoalInfo,
+ recompute_conj_info(Goal0, !:Goal).
+
+:- pred apply_dg_to_else2(hlds_goal_expr::in, hlds_goal_expr::out,
+ int::in, int::out, prog_var::in, pred_id::in, proc_id::in,
+ module_info::in, proc_info::in, proc_info::out) is det.
+
+apply_dg_to_else2(!GoalExpr, !IndexInConj, GranularityVar, CallerPredId,
+ CallerProcId, ModuleInfo, !ProcInfo) :-
+ ( !.GoalExpr = conj(plain_conj, Goals0) ->
+ list.length(Goals0, Length),
+ ( !.IndexInConj > Length ->
+ true
+ ;
+ list.index1_det(Goals0, !.IndexInConj, Goal0),
+ Goal0 = GoalExpr0 - GoalInfo0,
+ ( GoalExpr0 = plain_call(CalleePredId, CalleeProcId, CallArgs0,
+ CallBuiltin, _, CallSymName)
+ ->
+ ( CalleePredId = CallerPredId, CalleeProcId = CallerProcId ->
+ % That is a recursive plain call.
+
+ % Create an int variable containing the value 1.
+ proc_info_create_var_from_type(int_type, no,
+ Var, !ProcInfo),
+ make_int_const_construction(Var, 1, UnifyGoal),
+
+ % Create a variable which will contain the decremented
+ % granularity distance.
+ proc_info_create_var_from_type(int_type, no,
+ VarResult, !ProcInfo),
+
+ % Decrement GranularityVar before the call.
+ lookup_builtin_pred_proc_id(ModuleInfo,
+ unqualified("int"), "minus", function, 2, only_mode,
+ MinusPredId, MinusProcId),
+ MinusCallArgs = [GranularityVar, Var, VarResult],
+ MinusCallBuiltin = inline_builtin,
+ MinusCallSymName = qualified(unqualified("int"),"-"),
+ Rhs = rhs_functor(cons(MinusCallSymName, 2) , no,
+ [GranularityVar, Var]),
+ MinusCallUnifyContext = yes(call_unify_context(VarResult,
+ Rhs, unify_context(
+ umc_implicit("distance_granularity"), []))),
+ DecrementGoalExpr = plain_call(MinusPredId, MinusProcId,
+ MinusCallArgs, MinusCallBuiltin, MinusCallUnifyContext,
+ MinusCallSymName),
+ set.list_to_set([GranularityVar, Var, VarResult],
+ NonLocals),
+ VarResultDelta = VarResult - ground(unique, none),
+ VarDelta = Var - bound(shared, [bound_functor(int_const(1),
+ [])]),
+ instmap_delta_from_assoc_list([VarDelta, VarResultDelta],
+ InstMapDeltaDecrement),
+ Detism = detism_det,
+ Purity = purity_pure,
+ % Take the context of the first goal of the conjunction.
+ list.index1_det(Goals0, 1, FirstGoal),
+ FirstGoal = _ - FirstGoalInfo,
+ goal_info_get_context(FirstGoalInfo, Context),
+ goal_info_init(NonLocals, InstMapDeltaDecrement, Detism,
+ Purity, Context, DecrementGoalInfo),
+ DecrementGoal = DecrementGoalExpr - DecrementGoalInfo,
+
+ % Use the decremented value of GranularityVar as the
+ % last argument of the call.
+ list.append(CallArgs0, [VarResult], CallArgs),
+
+ % If the original predicate is a function then the
+ % specialized version is a predicate. Therefore, there is no
+ % need for the unify context anymore.
+ CallUnifyContext = no,
+
+ GoalExpr = plain_call(CalleePredId, CalleeProcId, CallArgs,
+ CallBuiltin, CallUnifyContext, CallSymName),
+ goal_info_get_instmap_delta(GoalInfo0, InstMapDelta0),
+ MerInst = ground(shared, none),
+ instmap_delta_insert(Var, MerInst, InstMapDelta0,
+ InstMapDelta),
+ goal_info_set_instmap_delta(InstMapDelta, GoalInfo0,
+ GoalInfo),
+ Goal = GoalExpr - GoalInfo,
+ list.replace_nth_det(Goals0, !.IndexInConj, Goal, Goals1),
+
+ % Append the goals in the right order.
+ list.det_split_list(!.IndexInConj - 1, Goals1, StartGoals,
+ EndGoals),
+ list.append(StartGoals, [UnifyGoal], GoalsAppend0),
+ list.append(GoalsAppend0, [DecrementGoal],
+ GoalsAppend1),
+ list.append(GoalsAppend1, EndGoals, Goals),
+ !:GoalExpr = conj(plain_conj, Goals)
+ ;
+ % Not a recursive call.
+ true
+ ),
+ !:IndexInConj = !.IndexInConj + 3
+ ;
+ !:IndexInConj = !.IndexInConj + 1
+ ),
+ apply_dg_to_else2(!GoalExpr, !IndexInConj, GranularityVar,
+ CallerPredId, CallerProcId, ModuleInfo, !ProcInfo)
+ )
+ ;
+ unexpected(this_file, "apply_dg_to_else2")
+ ).
+
+ % Apply the distance granularity transformation to a disjunction.
+ %
+:- pred apply_dg_to_disj(list(hlds_goal)::in,
+ list(hlds_goal)::in, list(hlds_goal)::out, pred_id::in, proc_id::in,
+ pred_id::in, sym_name::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, int::in,
+ maybe(prog_var)::in, maybe(prog_var)::out) is det.
+
+apply_dg_to_disj([], !GoalsAcc, _CallerPredId, _CallerProcId,
+ _PredIdSpecialized, _SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ _Distance, !MaybeGranularityVar).
+apply_dg_to_disj([Goal0 | Goals], !GoalsAcc, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ Distance, !MaybeGranularityVar) :-
+ apply_dg_to_goal(Goal0, Goal, CallerPredId, CallerProcId, PredIdSpecialized,
+ SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance, no,
+ !MaybeGranularityVar, _),
+ list.append( !.GoalsAcc, [Goal], !:GoalsAcc),
+ apply_dg_to_disj(Goals, !GoalsAcc, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance,
+ !MaybeGranularityVar).
+
+ % Apply the distance granularity transformation to a switch.
+ %
+:- pred apply_dg_to_switch(
+ list(case)::in, list(case)::in, list(case)::out, pred_id::in,
+ proc_id::in, pred_id::in, sym_name::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, int::in,
+ maybe(prog_var)::in, maybe(prog_var)::out) is det.
+
+apply_dg_to_switch([], !CasesAcc, _CallerPredId, _CallerProcId,
+ _PredIdSpecialized, _SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ _Distance, !MaybeGranularityVar).
+apply_dg_to_switch([Case | Cases], !CasesAcc, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo,
+ Distance, !MaybeGranularityVar) :-
+ Case = case(Functor, Goal0),
+ apply_dg_to_goal(Goal0, Goal, CallerPredId, CallerProcId, PredIdSpecialized,
+ SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance, no,
+ !MaybeGranularityVar, _),
+ !:CasesAcc = [case(Functor, Goal) | !.CasesAcc],
+ apply_dg_to_switch(Cases, !CasesAcc, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, !ModuleInfo, Distance,
+ !MaybeGranularityVar).
+
+ % Create the string name of the specialized predicate (same format as
+ % make_pred_name in prog_util) out of the name of the original one.
+ %
+:- pred create_specialized_pred_name(string::in, int::in,
+ string::in, string::out) is det.
+
+create_specialized_pred_name(Prefix, Distance, !PredName) :-
+ PFS = "pred",
+ int_to_string(Distance, PredIdStr),
+ string.format("%s__%s__%s__%s",
+ [s(Prefix), s(PFS), s(!.PredName), s(PredIdStr)], !:PredName).
+
+:-func granularity_prefix = string.
+
+granularity_prefix = "DistanceGranularityFor".
+
+%-----------------------------------------------------------------------------%
+
+ % This section contains predicates that make the granularity control
+ % transparent to the original procedure's callers by replacing the recursive
+ % calls in the body of the original procedure with calls to the specialized
+ % version.
+
+
+ % Update the recursive calls in each procedure in the list so that the
+ % pred_id called is the one of the specialized procedure.
+ %
+:- pred update_original_predicate_procs(pred_id::in, list(proc_id)::in, int::in,
+ pred_id::in, sym_name::in, pred_info::in, pred_info::out,
+ module_info::in, module_info::out) is det.
+
+update_original_predicate_procs(_PredId, [], _Distance, _PredIdSpecialized,
+ _SymNameSpecialized, !PredInfo, !ModuleInfo).
+update_original_predicate_procs(PredId, [ProcId | ProcIds], Distance,
+ PredIdSpecialized, SymNameSpecialized, !PredInfo,
+ !ModuleInfo) :-
+ module_info_proc_info(!.ModuleInfo, proc(PredId, ProcId), ProcInfo0),
+ proc_info_get_goal(ProcInfo0, Body0),
+ update_original_predicate_goal(Body0, Body, PredId, ProcId,
+ PredIdSpecialized, SymNameSpecialized, ProcInfo0, ProcInfo1, Distance),
+ proc_info_set_goal(Body, ProcInfo1, ProcInfo2),
+ requantify_proc(ProcInfo2, ProcInfo3),
+ RecomputeAtomic = no,
+ recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo3,
+ ProcInfo, !ModuleInfo),
+ pred_info_set_proc_info(ProcId, ProcInfo, !PredInfo),
+ update_original_predicate_procs(PredId, ProcIds, Distance,
+ PredIdSpecialized, SymNameSpecialized, !PredInfo, !ModuleInfo).
+
+ % Update the recursive calls of a goal so that the pred_id called is the one
+ % of the specialized procedure.
+ %
+:- pred update_original_predicate_goal(hlds_goal::in, hlds_goal::out,
+ pred_id::in, proc_id::in, pred_id::in, sym_name::in,
+ proc_info::in, proc_info::out, int::in) is det.
+
+update_original_predicate_goal(!Goal, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance) :-
+ !.Goal = GoalExpr0 - GoalInfo,
+ (
+ GoalExpr0 = unify(_, _, _, _, _)
+ ;
+ GoalExpr0 = plain_call(_, _, _, _, _, _),
+ update_original_predicate_plain_call(!Goal, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance)
+ ;
+ GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ;
+ GoalExpr0 = generic_call(_, _, _, _)
+ ;
+ GoalExpr0 = conj(Type, Goals0),
+ update_original_predicate_goals(Goals0, [], Goals1, CallerPredId,
+ CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
+ Distance),
+ (
+ Type = plain_conj,
+ flatten_conj(Goals1, Goals)
+ ;
+ Type = parallel_conj,
+ % No need to flatten parallel conjunctions as the transformation may
+ % only create plain conjunctions
+ % (see update_original_predicate_plain_call).
+ Goals = Goals1
+ ),
+ GoalExpr = conj(Type, Goals),
+ !:Goal = GoalExpr - GoalInfo
+ ;
+ GoalExpr0 = disj(Goals0),
+ update_original_predicate_goals(Goals0, [], Goals, CallerPredId,
+ CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
+ Distance),
+ GoalExpr = disj(Goals),
+ !:Goal = GoalExpr - GoalInfo
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ update_original_predicate_switch(Cases0, [], Cases, CallerPredId,
+ CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
+ Distance),
+ GoalExpr = switch(Var, CanFail, Cases),
+ !:Goal = GoalExpr - GoalInfo
+ ;
+ GoalExpr0 = negation(Goal0),
+ update_original_predicate_goal(Goal0, Goal, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance),
+ GoalExpr = negation(Goal),
+ !:Goal = GoalExpr - GoalInfo
+ ;
+ GoalExpr0 = scope(Reason, Goal0),
+ update_original_predicate_goal(Goal0, Goal, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance),
+ GoalExpr = scope(Reason, Goal),
+ !:Goal = GoalExpr - GoalInfo
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ update_original_predicate_goal(Cond0, Cond, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance),
+ update_original_predicate_goal(Then0, Then, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance),
+ update_original_predicate_goal(Else0, Else, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ !:Goal = GoalExpr - GoalInfo
+ ;
+ GoalExpr0 = shorthand(_),
+ % Shorthand are not supposed to occur here.
+ unexpected(this_file, "update_original_predicate_goal")
+ ).
+
+ % Update the plain call so that the pred_id called is the one of the
+ % specialized procedure.
+ %
+:- pred update_original_predicate_plain_call(hlds_goal::in, hlds_goal::out,
+ pred_id::in, proc_id::in, pred_id::in, sym_name::in,
+ proc_info::in, proc_info::out, int::in) is det.
+
+update_original_predicate_plain_call(!Call, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance) :-
+ !.Call = CallExpr0 - CallInfo0,
+ ( CallExpr0 = plain_call(CalleePredId, CalleeProcId, CallArgs0,
+ CallBuiltin, _, _) ->
+ ( CalleePredId = CallerPredId, CalleeProcId = CallerProcId ->
+ % That is a recursive plain call.
+
+ % Create the int variable which will be used as the last argument of
+ % the call.
+ proc_info_create_var_from_type(int_type, no, Var, !ProcInfo),
+ make_int_const_construction(Var, Distance, UnifyGoal),
+ list.append(CallArgs0, [Var], CallArgs),
+
+ % If the original predicate is a function then the specialized
+ % version is a predicate. Therefore, there is no need for the unify
+ % context anymore.
+ CallUnifyContext = no,
+
+ % Update the pred_id to the pred_id of the specialized pred.
+ CallExpr = plain_call(PredIdSpecialized, CalleeProcId, CallArgs,
+ CallBuiltin, CallUnifyContext, SymNameSpecialized),
+
+ % Update the nonlocals and the instmap_delta of the hlds_goal_info
+ % of the recursive plain call for Var.
+ goal_info_get_nonlocals(CallInfo0, NonLocals0),
+ set.insert(NonLocals0, Var, NonLocals),
+ goal_info_set_nonlocals(NonLocals, CallInfo0, CallInfo1),
+ goal_info_get_instmap_delta(CallInfo1, InstMapDelta0),
+ MerInst = ground(shared, none),
+ instmap_delta_insert(Var, MerInst, InstMapDelta0, InstMapDelta),
+ goal_info_set_instmap_delta(InstMapDelta, CallInfo1, CallInfo),
+ Call = CallExpr - CallInfo,
+
+ % The resuling conjunction may not be flat. We deal with that after
+ % the conjunction has been processed
+ % (see update_original_predicate_goal).
+ create_conj(UnifyGoal, Call, plain_conj, !:Call)
+ ;
+ true
+ )
+ ;
+ % Not a plain call.
+ unexpected(this_file, "update_original_predicate_plain_call")
+ ).
+
+ % Update the recursive calls of each goal in the list so that the pred_id
+ % called is the one of the specialized procedure.
+ %
+:- pred update_original_predicate_goals(list(hlds_goal)::in,
+ list(hlds_goal)::in, list(hlds_goal)::out, pred_id::in, proc_id::in,
+ pred_id::in, sym_name::in, proc_info::in, proc_info::out, int::in) is det.
+
+update_original_predicate_goals([], !GoalsAcc, _CallerPredId,
+ _CallerProcId, _PredIdSpecialized, _SymNameSpecialized, !ProcInfo,
+ _Distance).
+update_original_predicate_goals([Goal0 | Goals], !GoalsAcc, CallerPredId,
+ CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
+ Distance) :-
+ update_original_predicate_goal(Goal0, Goal, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance),
+ list.append(!.GoalsAcc, [Goal], !:GoalsAcc),
+ update_original_predicate_goals(Goals, !GoalsAcc, CallerPredId,
+ CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
+ Distance).
+
+ % Update the recursive calls of a switch so that the pred_id called is the
+ % one of the specialized procedure.
+ %
+:- pred update_original_predicate_switch(
+ list(case)::in, list(case)::in, list(case)::out, pred_id::in,
+ proc_id::in, pred_id::in, sym_name::in, proc_info::in, proc_info::out,
+ int::in) is det.
+
+update_original_predicate_switch([], !CasesAcc, _CallerPredId, _CallerProcId,
+ _PredIdSpecialized, _SymNameSpecialized, !ProcInfo, _Distance).
+update_original_predicate_switch([Case | Cases], !CasesAcc, CallerPredId,
+ CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
+ Distance) :-
+ Case = case(Functor, Goal0),
+ update_original_predicate_goal(Goal0, Goal, CallerPredId, CallerProcId,
+ PredIdSpecialized, SymNameSpecialized, !ProcInfo, Distance),
+ !:CasesAcc = [ case(Functor, Goal) | !.CasesAcc ],
+ update_original_predicate_switch(Cases, !CasesAcc, CallerPredId,
+ CallerProcId, PredIdSpecialized, SymNameSpecialized, !ProcInfo,
+ Distance).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "distance_granularity.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module transform_hlds.distance_granularity.
+%-----------------------------------------------------------------------------%
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.143
diff -u -r1.143 goal_util.m
--- compiler/goal_util.m 1 Dec 2006 15:03:57 -0000 1.143
+++ compiler/goal_util.m 10 Jan 2007 04:54:27 -0000
@@ -260,6 +260,16 @@
%-----------------------------------------------------------------------------%
+ % Flatten a list of goals of a conjunction.
+ %
+:- pred flatten_conj(hlds_goals::in, hlds_goals::out) is det.
+
+ % Create a conjunction of the specified type using the specified two goals.
+ % This fills in the hlds_goal_info.
+ %
+:- pred create_conj(hlds_goal::in, hlds_goal::in, conj_type::in,
+ hlds_goal::out) is det.
+
% can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
% InstmapBeforeGoal1, Goal1, InstmapBeforeGoal2, Goal2).
%
@@ -1578,6 +1588,31 @@
CombinedDetism, CombinedPurity, CombinedInfo).
%-----------------------------------------------------------------------------%
+
+flatten_conj([], []).
+flatten_conj([Goal | Goals0], Goals) :-
+ flatten_conj(Goals0, Goals1),
+ ( Goal = conj(plain_conj, SubGoals) - _ ->
+ list.append(SubGoals, Goals1, Goals)
+ ;
+ Goals = [Goal | Goals1]
+ ).
+
+%-----------------------------------------------------------------------------%
+
+create_conj(GoalA, GoalB, Type, ConjGoal) :-
+ GoalsInConj = [ GoalA, GoalB ],
+ 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 = snd(GoalA),
+ goal_info_get_context(GoalAInfo, Context),
+ goal_info_init(NonLocals, InstMapDelta, Detism, Purity, Context,
+ ConjGoalInfo),
+ ConjGoal = ConjGoalExpr - ConjGoalInfo.
+
%-----------------------------------------------------------------------------%
can_reorder_goals_old(ModuleInfo, VarTypes, FullyStrict,
Index: compiler/hhf.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hhf.m,v
retrieving revision 1.27
diff -u -r1.27 hhf.m
--- compiler/hhf.m 1 Dec 2006 15:03:57 -0000 1.27
+++ compiler/hhf.m 10 Jan 2007 04:54:27 -0000
@@ -43,6 +43,7 @@
:- implementation.
:- import_module check_hlds.type_util.
+:- import_module hlds.goal_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.passes_aux.
:- import_module libs.compiler_util.
@@ -367,17 +368,6 @@
;
V = A,
Goals = Goals0
- ).
-
-:- pred flatten_conj(hlds_goals::in, hlds_goals::out) is det.
-
-flatten_conj([], []).
-flatten_conj([Goal | Goals0], Goals) :-
- flatten_conj(Goals0, Goals1),
- ( Goal = conj(plain_conj, SubGoals) - _ ->
- list.append(SubGoals, Goals1, Goals)
- ;
- Goals = [Goal | Goals1]
).
:- pred complete_inst_graph(module_info::in, hhf_info::in, hhf_info::out)
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.214
diff -u -r1.214 hlds_pred.m
--- compiler/hlds_pred.m 5 Dec 2006 03:50:52 -0000 1.214
+++ compiler/hlds_pred.m 10 Jan 2007 04:54:27 -0000
@@ -595,6 +595,10 @@
:- pred pred_info_set_name(string::in,
pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_orig_arity(arity::in,
+ pred_info::in, pred_info::out) is det.
+:- pred pred_info_set_is_pred_or_func(pred_or_func::in,
+ pred_info::in, pred_info::out) is det.
:- pred pred_info_set_origin(pred_origin::in,
pred_info::in, pred_info::out) is det.
:- pred pred_info_set_import_status(import_status::in,
@@ -1184,6 +1188,8 @@
pred_info_get_procedures(PI, PI ^ procedures).
pred_info_set_name(X, PI, PI ^ name := X).
+pred_info_set_orig_arity(X, PI, PI ^ orig_arity := X).
+pred_info_set_is_pred_or_func(X, PI, PI ^ is_pred_or_func := X).
pred_info_set_origin(X, PI, PI ^ pred_origin := X).
pred_info_set_import_status(X, PI, PI ^ import_status := X).
pred_info_set_goal_type(X, PI, PI ^ goal_type := X).
Index: compiler/implicit_parallelism.m
===================================================================
RCS file: compiler/implicit_parallelism.m
diff -N compiler/implicit_parallelism.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/implicit_parallelism.m 10 Jan 2007 04:54:27 -0000
@@ -0,0 +1,957 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2006 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File : implicit_parallelism.m.
+% Author: tannier.
+%
+% This module uses deep profiling feedback information generated by
+% mdprof_feedback to introduce parallel conjunctions where it could be
+% worthwhile (implicit parallelism). It deals with both independent and
+% dependent parallelism.
+%
+% TODO
+% - Once a call which is a candidate for implicit parallelism is found,
+% search forward AND backward for the closest goal which is also a
+% candidate for implicit parallelism/parallel conjunction and determine
+% which side is the best (on the basis of the number of shared variables).
+%
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds.implicit_parallelism.
+:- interface.
+
+:- import_module hlds.hlds_module.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+ % apply_implicit_parallelism_transformation(!ModuleInfo, FeedbackFile, !IO)
+ %
+ % Apply the implicit parallelism transformation using the specified feedback
+ % file.
+ %
+:- pred apply_implicit_parallelism_transformation(module_info::in,
+ module_info::out, string::in, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.inst_match.
+:- import_module hlds.hlds_goal.
+:- import_module check_hlds.mode_util.
+:- import_module hlds.goal_util.
+:- import_module hlds.hlds_pred.
+:- import_module hlds.instmap.
+:- import_module hlds.quantification.
+:- import_module libs.compiler_util.
+:- import_module mdbcomp.prim_data.
+:- import_module parse_tree.error_util.
+:- import_module parse_tree.prog_data.
+:- import_module transform_hlds.dep_par_conj.
+
+:- import_module bool.
+:- import_module char.
+:- import_module counter.
+:- import_module int.
+:- import_module list.
+:- import_module maybe.
+:- import_module pair.
+:- import_module require.
+:- import_module set.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+ % Represent a call site static which is a candidate for introducing implicit
+ % parallelism.
+ %
+:- type candidate_call_site
+ ---> candidate_call_site(
+ caller :: string, % The caller of the call.
+ slot_number :: int, % The slot number of the call.
+ kind :: call_site_kind, % The kind of the call.
+ callee :: string % The callee of the call.
+ ).
+
+ % Represent the kind of a call site.
+ %
+:- type call_site_kind
+ ---> csk_normal
+ ; csk_special
+ ; csk_higher_order
+ ; csk_method
+ ; csk_callback.
+
+ % Construct a call_site_kind from its string representation.
+ %
+:- pred construct_call_site_kind(string::in, call_site_kind::out) is semidet.
+
+construct_call_site_kind("normal_call", csk_normal).
+construct_call_site_kind("special_call", csk_special).
+construct_call_site_kind("higher_order_call", csk_higher_order).
+construct_call_site_kind("method_call", csk_method).
+construct_call_site_kind("callback", csk_callback).
+
+%-----------------------------------------------------------------------------%
+
+apply_implicit_parallelism_transformation(!ModuleInfo, FeedbackFile, !IO) :-
+ parse_feedback_file(FeedbackFile, MaybeListCandidateCallSite, !IO),
+ (
+ MaybeListCandidateCallSite = error(Err),
+ io.stderr_stream(Stderr, !IO),
+ io.write_string(Stderr, Err ++ "\n", !IO)
+ ;
+ MaybeListCandidateCallSite = ok(ListCandidateCallSite),
+ module_info_predids(!.ModuleInfo, PredIds),
+ process_preds_for_implicit_parallelism(PredIds,
+ ListCandidateCallSite, !ModuleInfo)
+ ).
+
+ % Process predicates for implicit parallelism.
+ %
+:- pred process_preds_for_implicit_parallelism(list(pred_id)::in,
+ list(candidate_call_site)::in, module_info::in, module_info::out)
+ is det.
+
+process_preds_for_implicit_parallelism([], _ListCandidateCallSite,
+ !ModuleInfo).
+process_preds_for_implicit_parallelism([ PredId | PredIdList ],
+ ListCandidateCallSite, !ModuleInfo) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+ ProcIds = pred_info_non_imported_procids(PredInfo),
+ process_procs_for_implicit_parallelism(PredId, ProcIds,
+ ListCandidateCallSite, !ModuleInfo),
+ process_preds_for_implicit_parallelism(PredIdList,
+ ListCandidateCallSite, !ModuleInfo).
+
+ % Process procedures for implicit parallelism.
+ %
+:- pred process_procs_for_implicit_parallelism(pred_id::in,
+ list(proc_id)::in, list(candidate_call_site)::in,
+ module_info::in, module_info::out) is det.
+
+process_procs_for_implicit_parallelism(_PredId, [],
+ _ListCandidateCallSite, !ModuleInfo).
+process_procs_for_implicit_parallelism(PredId, [ ProcId | ProcIds ],
+ ListCandidateCallSite, !ModuleInfo) :-
+ module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
+ PredInfo0, ProcInfo0),
+ % Initialize the counter for the slot number.
+ SiteNumCounter = counter.init(0),
+ pred_proc_id_to_raw_id(PredInfo0, ProcId, CallerRawId),
+ get_callees_feedback(CallerRawId, ListCandidateCallSite, [],
+ CallSites),
+ list.length(CallSites, NumCallSites),
+ ( NumCallSites = 0 ->
+ % No candidate calls for implicit parallelism in this procedure.
+ process_procs_for_implicit_parallelism(PredId, ProcIds,
+ ListCandidateCallSite, !ModuleInfo)
+ ;
+ proc_info_get_goal(ProcInfo0, Body0),
+ process_goal_for_implicit_parallelism(Body0, Body, ProcInfo0,
+ !ModuleInfo, no, _, 0, _, CallSites, _, SiteNumCounter, _),
+ proc_info_set_goal(Body, ProcInfo0, ProcInfo1),
+ proc_info_set_has_parallel_conj(yes, ProcInfo1, ProcInfo2),
+ requantify_proc(ProcInfo2, ProcInfo3),
+ RecomputeAtomic = no,
+ recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo3, ProcInfo,
+ !ModuleInfo),
+ pred_info_set_proc_info(ProcId, ProcInfo, PredInfo0, PredInfo),
+ module_info_set_pred_info(PredId, PredInfo, !ModuleInfo),
+ process_procs_for_implicit_parallelism(PredId, ProcIds,
+ ListCandidateCallSite, !ModuleInfo)
+ ).
+
+ % Filter the list of call site information from the feedback file so that
+ % the resulting list only contains those call sites that belong to the first
+ % argument, e.g. the caller.
+ %
+:- pred get_callees_feedback(string::in, list(candidate_call_site)::in,
+ list(candidate_call_site)::in, list(candidate_call_site)::out) is det.
+
+get_callees_feedback(_Caller, [], !ResultAcc).
+get_callees_feedback(Caller, [ CandidateCallSite | ListCandidateCallSite ],
+ !ResultAcc) :-
+ CandidateCallSite = candidate_call_site(CSSCaller, _, _, _),
+ ( Caller = CSSCaller ->
+ !:ResultAcc = [ CandidateCallSite | !.ResultAcc ],
+ get_callees_feedback(Caller, ListCandidateCallSite, !ResultAcc)
+ ;
+ get_callees_feedback(Caller, ListCandidateCallSite, !ResultAcc)
+ ).
+
+ % Process a goal for implicit parallelism.
+ % MaybeConj is the conjunction which contains Goal.
+ %
+:- pred process_goal_for_implicit_parallelism(hlds_goal::in, hlds_goal::out,
+ proc_info::in, module_info::in, module_info::out,
+ maybe(hlds_goal_expr)::in, maybe(hlds_goal_expr)::out, int ::in, int::out,
+ list(candidate_call_site)::in, list(candidate_call_site)::out,
+ counter::in, counter::out) is det.
+
+process_goal_for_implicit_parallelism(!Goal, ProcInfo, !ModuleInfo,
+ !MaybeConj, !IndexInConj, !CalleeListToBeParallelized, !SiteNumCounter) :-
+ !.Goal = GoalExpr0 - GoalInfo,
+ (
+ GoalExpr0 = unify(_, _, _, _, _),
+ increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ ;
+ GoalExpr0 = plain_call(_, _, _, _, _, _),
+ process_call_for_implicit_parallelism(!.Goal, ProcInfo, !ModuleInfo,
+ !IndexInConj, !MaybeConj, !CalleeListToBeParallelized,
+ !SiteNumCounter)
+ % We deal with the index in the conjunction in
+ % process_call_for_implicit_parallelism.
+ ;
+ GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
+ process_call_for_implicit_parallelism(!.Goal, ProcInfo, !ModuleInfo,
+ !IndexInConj, !MaybeConj, !CalleeListToBeParallelized,
+ !SiteNumCounter)
+ ;
+ GoalExpr0 = generic_call(Details, _, _, _),
+ (
+ Details = higher_order(_, _, _, _),
+ process_call_for_implicit_parallelism(!.Goal, ProcInfo,
+ !ModuleInfo, !IndexInConj, !MaybeConj,
+ !CalleeListToBeParallelized, !SiteNumCounter)
+ ;
+ Details = class_method(_, _, _, _),
+ process_call_for_implicit_parallelism(!.Goal, ProcInfo,
+ !ModuleInfo, !IndexInConj, !MaybeConj,
+ !CalleeListToBeParallelized, !SiteNumCounter)
+ ;
+ Details = event_call(_),
+ increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ ;
+ Details = cast(_),
+ increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ )
+ ;
+ % No distinction is made between plain conjunctions and parallel
+ % conjunctions. We have to process the parallel conjunction for the
+ % slot number.
+ GoalExpr0 = conj(_, _),
+ process_conj_for_implicit_parallelism(GoalExpr0, GoalExpr, 1,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized,
+ !SiteNumCounter),
+ % A plain conjunction will never be contained in an other plain
+ % conjunction. As for parallel conjunctions, they will not
+ % be modified. Therefore, incrementing the index suffices (no need to
+ % call update_conj_and_index).
+ !:Goal = GoalExpr - GoalInfo,
+ increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ ;
+ GoalExpr0 = disj(Goals0),
+ process_disj_for_implicit_parallelism(Goals0, [], Goals,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized,
+ !SiteNumCounter),
+ GoalProcessed = disj(Goals) - GoalInfo,
+ update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
+ % If we are not in a conjunction, then we need to return the modified
+ % value of Goal. In we are in a conjunction, that information is not
+ % read (see process_conj_for_implicit_parallelism).
+ !:Goal = GoalProcessed
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ process_switch_cases_for_implicit_parallelism(Cases0, [], Cases,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized,
+ !SiteNumCounter),
+ GoalProcessed = switch(Var, CanFail, Cases) - GoalInfo,
+ update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
+ !:Goal = GoalProcessed
+ ;
+ GoalExpr0 = negation(Goal0),
+ process_goal_for_implicit_parallelism(Goal0, Goal, ProcInfo,
+ !ModuleInfo, !MaybeConj, !IndexInConj, !CalleeListToBeParallelized,
+ !SiteNumCounter),
+ GoalProcessed = negation(Goal) - GoalInfo,
+ update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
+ !:Goal = GoalProcessed
+ ;
+ GoalExpr0 = scope(Reason, Goal0),
+ % 0 is the default value when we are not in a conjunction (in this case
+ % a scope).
+ process_goal_for_implicit_parallelism(Goal0, Goal, ProcInfo,
+ !ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized,
+ !SiteNumCounter),
+ GoalProcessed = scope(Reason, Goal) - GoalInfo,
+ update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
+ !:Goal = GoalProcessed
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
+ process_goal_for_implicit_parallelism(Cond0, Cond, ProcInfo,
+ !ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized,
+ !SiteNumCounter),
+ process_goal_for_implicit_parallelism(Then0, Then, ProcInfo, !ModuleInfo
+ , no, _, 0, _, !CalleeListToBeParallelized, !SiteNumCounter),
+ process_goal_for_implicit_parallelism(Else0, Else, ProcInfo, !ModuleInfo
+ , no, _, 0, _, !CalleeListToBeParallelized, !SiteNumCounter),
+ GoalProcessed = if_then_else(Vars, Cond, Then, Else) - GoalInfo,
+ update_conj_and_index(!MaybeConj, GoalProcessed, !IndexInConj),
+ !:Goal = GoalProcessed
+ ;
+ GoalExpr0 = shorthand(_),
+ increment_index_if_in_conj(!.MaybeConj, !IndexInConj)
+ ).
+
+ % 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.
+
+increment_index_if_in_conj(MaybeConj, !IndexInConj) :-
+ (
+ MaybeConj = yes(_),
+ !:IndexInConj = !.IndexInConj + 1
+ ;
+ MaybeConj = no
+ ).
+
+ % Process a call for implicit parallelism.
+ %
+:- pred process_call_for_implicit_parallelism(hlds_goal::in, proc_info::in,
+ module_info::in, module_info::out, int::in, int::out,
+ maybe(hlds_goal_expr)::in, maybe(hlds_goal_expr)::out,
+ list(candidate_call_site)::in, list(candidate_call_site)::out,
+ counter::in, counter::out) is det.
+
+process_call_for_implicit_parallelism(Call, ProcInfo, !ModuleInfo, !IndexInConj
+ , !MaybeConj, !CalleeListToBeParallelized, !SiteNumCounter) :-
+ counter.allocate(SlotNumber, !SiteNumCounter),
+ get_call_kind_and_callee(!.ModuleInfo, Call, Kind, CalleeRawId),
+ ( !.MaybeConj = yes(Conj0), Conj0 = conj(plain_conj, ConjGoals0)
+ ->
+ (is_in_css_list_to_be_parallelized(Kind, SlotNumber, CalleeRawId,
+ !.CalleeListToBeParallelized, [], !:CalleeListToBeParallelized)
+ ->
+ ( build_goals_surrounded_by_calls_to_be_parallelized(ConjGoals0,
+ !.ModuleInfo, [ Call ], Goals, !.IndexInConj + 1, End,
+ !SiteNumCounter, !CalleeListToBeParallelized)
+ ->
+ parallelize_calls(Goals, !.IndexInConj, End, Conj0, Conj,
+ ProcInfo, !ModuleInfo),
+ !:IndexInConj = End,
+ !:MaybeConj = yes(Conj)
+ ;
+ % The next call is not in the feedback file or we've hit a
+ % plain conjunction/disjunction/switch/if then else.
+ !:IndexInConj = !.IndexInConj + 1
+ )
+ ;
+ % Not to be parallelized.
+ !:IndexInConj = !.IndexInConj + 1
+ )
+ ;
+ % Call is not in a conjunction or the call is already in a parallel
+ % conjunction.
+ true
+ ).
+
+ % Give the raw id (the same as in the deep profiler) of a callee contained
+ % in a call.
+ %
+:- pred get_call_kind_and_callee(module_info::in, hlds_goal::in,
+ call_site_kind::out, string::out) is det.
+
+get_call_kind_and_callee(ModuleInfo, Call, Kind, CalleeRawId) :-
+ GoalExpr = fst(Call),
+ ( GoalExpr = plain_call(PredId, ProcId, _, _, _, _)
+ ->
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ PredInfo, _),
+ pred_proc_id_to_raw_id(PredInfo, ProcId, CalleeRawId),
+ Kind = csk_normal
+ ;
+ ( GoalExpr = call_foreign_proc(_, PredId, ProcId, _, _, _, _)
+ ->
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ PredInfo, _),
+ pred_proc_id_to_raw_id(PredInfo, ProcId, CalleeRawId),
+ Kind = csk_special
+ ;
+ ( GoalExpr = generic_call(Details, _, _, _)
+ ->
+ (
+ Details = higher_order(_, _, _, _),
+ CalleeRawId = "",
+ Kind = csk_higher_order
+ ;
+ Details = class_method(_, _, _, _),
+ CalleeRawId = "",
+ Kind = csk_method
+ ;
+ Details = event_call(_),
+ unexpected(this_file, "get_call_kind_and_callee")
+ ;
+ Details = cast(_),
+ unexpected(this_file, "get_call_kind_and_callee")
+ )
+ ;
+ unexpected(this_file, "get_call_kind_and_callee")
+ )
+ )
+ ).
+
+ % Convert a pred_info and a proc_id to the raw procedure id (the same used
+ % in the deep profiler).
+ %
+:- pred pred_proc_id_to_raw_id(pred_info::in, proc_id::in, string::out) is det.
+
+pred_proc_id_to_raw_id(PredInfo, ProcId, RawId) :-
+ Module = pred_info_module(PredInfo),
+ Name = pred_info_name(PredInfo),
+ OrigArity = pred_info_orig_arity(PredInfo),
+ IsPredOrFunc = pred_info_is_pred_or_func(PredInfo),
+ ModuleString = sym_name_to_string(Module),
+ ProcIdInt = proc_id_to_int(ProcId),
+ RawId = string.append_list([ ModuleString, ".", Name, "/",
+ string.int_to_string(OrigArity),
+ ( IsPredOrFunc = function -> "+1" ; ""), "-",
+ string.from_int(ProcIdInt) ]).
+
+ % Succeed if the caller, slot number and callee correspond to a
+ % candidate_call_site in the list given as a parameter.
+ % Fail otherwise.
+ %
+:- pred is_in_css_list_to_be_parallelized(call_site_kind::in, int::in,
+ string::in, list(candidate_call_site)::in,
+ list(candidate_call_site)::in, list(candidate_call_site)::out)
+ is semidet.
+
+is_in_css_list_to_be_parallelized(Kind, SlotNumber, CalleeRawId,
+ ListCandidateCallSite, !ResultAcc) :-
+ (
+ ListCandidateCallSite = [],
+ fail
+ ;
+ ListCandidateCallSite = [ CandidateCallSite |
+ ListCandidateCallSite0 ],
+ CandidateCallSite = candidate_call_site(_, CSSSlotNumber, CSSKind,
+ CSSCallee),
+ % =< because there is not a one to one correspondance with the source
+ % code. New calls might have been added by the previous passes of the
+ % compiler.
+ ( CSSSlotNumber =< SlotNumber, CSSKind = Kind, CSSCallee = CalleeRawId
+ ->
+ list.append(!.ResultAcc, ListCandidateCallSite0, !:ResultAcc)
+ ;
+ list.append(!.ResultAcc, [ CandidateCallSite ], !:ResultAcc),
+ is_in_css_list_to_be_parallelized(Kind, SlotNumber, CalleeRawId,
+ ListCandidateCallSite0, !ResultAcc)
+ )
+ ).
+
+ % Build a list of goals surrounded by two calls which are in the feedback
+ % file or by a call which is in the feedback file and a parallel
+ % conjunction.
+ %
+ % Succeed if we can build that list of goals.
+ % Fail otherwise.
+ %
+:- pred build_goals_surrounded_by_calls_to_be_parallelized(list(hlds_goal)::in,
+ module_info::in, list(hlds_goal)::in, list(hlds_goal)::out,
+ int::in, int::out, counter::in, counter::out,
+ list(candidate_call_site)::in, list(candidate_call_site)::out)
+ is semidet.
+
+build_goals_surrounded_by_calls_to_be_parallelized(ConjGoals, ModuleInfo,
+ !ResultAcc, !Index, !SiteNumCounter, !CalleeListToBeParallelized) :-
+ list.length(ConjGoals, Length),
+ ( !.Index > Length
+ ->
+ fail
+ ;
+ list.index1_det(ConjGoals, !.Index, Goal),
+ GoalExpr = fst(Goal),
+ ( ( GoalExpr = disj(_)
+ ; GoalExpr = switch(_, _, _)
+ ; GoalExpr = if_then_else(_, _, _, _)
+ ; GoalExpr = conj(plain_conj, _)
+ ) ->
+ fail
+ ;
+ ( goal_is_conjunction(Goal, parallel_conj) ->
+ list.append(!.ResultAcc, [ Goal ], !:ResultAcc)
+ ;
+ ( goal_is_call_or_negated_call(Goal)
+ ->
+ counter.allocate(SlotNumber, !SiteNumCounter),
+ get_call_kind_and_callee(ModuleInfo, Goal, Kind,
+ CalleeRawId),
+ ( is_in_css_list_to_be_parallelized(Kind, SlotNumber,
+ CalleeRawId, !.CalleeListToBeParallelized, [],
+ !:CalleeListToBeParallelized)
+ ->
+ list.append(!.ResultAcc, [ Goal ], !:ResultAcc)
+ ;
+ list.append(!.ResultAcc, [ Goal ], !:ResultAcc),
+ !:Index = !.Index + 1,
+ build_goals_surrounded_by_calls_to_be_parallelized(
+ ConjGoals, ModuleInfo, !ResultAcc, !Index,
+ !SiteNumCounter, !CalleeListToBeParallelized)
+ )
+ ;
+ list.append(!.ResultAcc, [ Goal ], !:ResultAcc),
+ !:Index = !.Index + 1,
+ build_goals_surrounded_by_calls_to_be_parallelized(
+ ConjGoals, ModuleInfo, !ResultAcc, !Index,
+ !SiteNumCounter, !CalleeListToBeParallelized)
+ )
+ )
+ )
+ ).
+
+ % Succeeds if Goal is a conjunction (of any type).
+ % Fail otherwise.
+ %
+:- pred goal_is_conjunction(hlds_goal::in, conj_type::out) is semidet.
+
+goal_is_conjunction(Goal, Type) :-
+ GoalExpr = fst(Goal),
+ GoalExpr = conj(Type, _).
+
+ % Succeed if Goal is a call or a call inside a negation.
+ % Fail otherwise.
+ %
+:- pred goal_is_call_or_negated_call(hlds_goal::in) is semidet.
+
+goal_is_call_or_negated_call(Goal) :-
+ GoalExpr = fst(Goal),
+ (
+ GoalExpr = plain_call(_, _, _, _, _, _)
+ ;
+ GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ;
+ GoalExpr = generic_call(Details, _, _, _),
+ (
+ Details = class_method(_, _, _, _)
+ ;
+ Details = higher_order(_, _, _, _)
+ )
+ ;
+ GoalExpr = negation(GoalNeg),
+ GoalNegExpr = fst(GoalNeg),
+ (
+ GoalNegExpr = plain_call(_, _, _, _, _, _)
+ ;
+ GoalNegExpr = call_foreign_proc(_, _, _, _, _, _, _)
+ ;
+ GoalNegExpr = generic_call(Details, _, _, _),
+ (
+ Details = class_method(_, _, _, _)
+ ;
+ Details = higher_order(_, _, _, _)
+ )
+ )
+ ).
+
+ % Parallelize two calls/a call and a parallel conjunction which might have
+ % goals between them. If these have no dependencies with the first call then
+ % we move them before the first call and parallelize the two calls/call and
+ % parallel conjunction.
+ %
+ % Goals is contained in Conj.
+ %
+:- pred parallelize_calls(list(hlds_goal)::in, int::in, int::in,
+ hlds_goal_expr::in, hlds_goal_expr::out, proc_info::in,
+ module_info::in, module_info::out) is det.
+
+parallelize_calls(Goals, Start, End, !Conj, ProcInfo, !ModuleInfo) :-
+ ( !.Conj = conj(plain_conj, ConjGoals0) ->
+ ( ConjGoals0 = [ FirstGoal, LastGoal ] ->
+ ( is_worth_parallelizing(FirstGoal, LastGoal, ProcInfo,
+ !.ModuleInfo)
+ ->
+ ( goal_is_conjunction(LastGoal, parallel_conj) ->
+ % The parallel conjunction has to remain flatened.
+ add_call_to_parallel_conjunction(FirstGoal, LastGoal,
+ ParallelGoal),
+ !:Conj = fst(ParallelGoal)
+ ;
+ !:Conj = conj(parallel_conj, ConjGoals0)
+ )
+ ;
+ % Not worth parallelizing.
+ true
+ )
+ ;
+ % There are more than two goals in the conjunction.
+ list.length(Goals, Length),
+ list.index1_det(Goals, 1, FirstGoal),
+ list.index1_det(Goals, Length, LastGoal),
+ ( is_worth_parallelizing(FirstGoal, LastGoal, ProcInfo,
+ !.ModuleInfo)
+ ->
+ GoalsInBetweenAndLast = list.det_tail(Goals),
+ list.delete_all(GoalsInBetweenAndLast, LastGoal,
+ GoalsInBetween),
+ % Check the dependencies of GoalsInBetween with FirstGoal.
+ list.filter(goal_depends_on_goal(FirstGoal),
+ GoalsInBetween, GoalsFiltered),
+ ( list.is_empty(GoalsFiltered) ->
+ ( goal_is_conjunction(LastGoal, parallel_conj) ->
+ add_call_to_parallel_conjunction(FirstGoal, LastGoal,
+ ParallelGoal)
+ ;
+ create_conj(FirstGoal, LastGoal, parallel_conj,
+ ParallelGoal)
+ ),
+ ( Start = 1 ->
+ GoalsFront = []
+ ;
+ list.det_split_list(Start - 1, ConjGoals0,
+ GoalsFront, _)
+ ),
+ list.length(ConjGoals0, ConjLength),
+ ( End = ConjLength ->
+ GoalsBack = []
+ ;
+ list.det_split_list(End, ConjGoals0, _,
+ GoalsBack)
+ ),
+ list.append(GoalsFront, GoalsInBetween,
+ GoalsFrontWithBetween),
+ list.append(GoalsFrontWithBetween, [ ParallelGoal ],
+ GoalsWithoutBack),
+ list.append(GoalsWithoutBack, GoalsBack, ConjGoals),
+ !:Conj = conj(plain_conj, ConjGoals)
+ ;
+ % The goals between the two calls/call and parallel
+ % conjunction can't be moved before the first call.
+ true
+ )
+ ;
+ % Not worth parallelizing.
+ true
+ )
+ )
+ ;
+ % Conj is not a conjunction.
+ unexpected(this_file, "parallelize_calls")
+ ).
+
+ % Two calls are worth parallelizing if the number of shared variables is
+ % smaller than the number of argument variables of at least one of the two
+ % calls.
+ %
+ % A call and a parallel conjunction are worth parallelizing if the number of
+ % shared variables is smaller than the number of argument variables of the
+ % call.
+ %
+ % Succeed if it is worth parallelizing the two goals.
+ % Fail otherwise.
+ %
+ %
+:- pred is_worth_parallelizing(hlds_goal::in, hlds_goal::in, proc_info::in,
+ module_info::in) is semidet.
+
+is_worth_parallelizing(GoalA, GoalB, ProcInfo, ModuleInfo) :-
+ proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap),
+ SharedVars = find_shared_variables(ModuleInfo, InstMap, [ GoalA, GoalB ]),
+ set.to_sorted_list(SharedVars, SharedVarsList),
+ list.length(SharedVarsList, NbSharedVars),
+ ( NbSharedVars = 0 ->
+ % No shared vars between the goals.
+ true
+ ;
+ ( goal_is_conjunction(GoalB, parallel_conj) ->
+ get_number_args(GoalA, NbArgsA),
+ NbSharedVars < NbArgsA
+ ;
+ ( get_number_args(GoalA, NbArgsA), get_number_args(GoalB, NbArgsB)
+ ->
+ ( ( NbSharedVars < NbArgsA, NbSharedVars < NbArgsB
+ ; NbSharedVars = NbArgsA, NbSharedVars < NbArgsB
+ ; NbSharedVars < NbArgsA, NbSharedVars = NbArgsB
+ )
+ ->
+ true
+ ;
+ fail
+ )
+ ;
+ unexpected(this_file, "is_worth_parallelizing")
+ )
+ )
+ ).
+
+ % Give the number of argument variables of a call.
+ %
+:- pred get_number_args(hlds_goal::in, int::out) is semidet.
+
+get_number_args(Call, NbArgs) :-
+ CallExpr = fst(Call),
+ (
+ CallExpr = plain_call(_, _, Args, _, _, _),
+ list.length(Args, NbArgs)
+ ;
+ CallExpr = generic_call(Details, Args, _, _),
+ (
+ Details = higher_order(_, _, _, _),
+ list.length(Args, NbArgs)
+ ;
+ Details = class_method(_, _, _, _),
+ list.length(Args, NbArgs)
+ )
+ ;
+ CallExpr = call_foreign_proc(_, _, _, Args, _, _, _),
+ list.length(Args, NbArgs)
+ ).
+
+ % Add a call to an existing parallel conjunction.
+ %
+:- pred add_call_to_parallel_conjunction(hlds_goal::in, hlds_goal::in,
+ hlds_goal::out) is det.
+
+add_call_to_parallel_conjunction(Call, ParallelGoal0, ParallelGoal) :-
+ ParallelGoalExpr0 = fst(ParallelGoal0),
+ ParallelGoalInfo0 = snd(ParallelGoal0),
+ ( ParallelGoalExpr0 = conj(parallel_conj, GoalList0) ->
+ GoalList = [ Call | GoalList0 ],
+ goal_list_nonlocals(GoalList, NonLocals),
+ goal_list_instmap_delta(GoalList, InstMapDelta),
+ goal_list_determinism(GoalList, Detism),
+ goal_list_purity(GoalList, Purity),
+ goal_info_set_nonlocals(NonLocals, ParallelGoalInfo0,
+ ParallelGoalInfo1),
+ goal_info_set_instmap_delta(InstMapDelta, ParallelGoalInfo1,
+ ParallelGoalInfo2),
+ goal_info_set_determinism(Detism, ParallelGoalInfo2, ParallelGoalInfo3),
+ goal_info_set_purity(Purity, ParallelGoalInfo3, ParallelGoalInfo),
+ ParallelGoalExpr = conj(parallel_conj, GoalList),
+ ParallelGoal = ParallelGoalExpr - ParallelGoalInfo
+ ;
+ unexpected(this_file, "add_call_to_parallel_conjunction")
+ ).
+
+ % Succeed if the first goal depends on the second one.
+ % Fail otherwise.
+ %
+:- pred goal_depends_on_goal(hlds_goal::in, hlds_goal::in) is semidet.
+
+goal_depends_on_goal(_ - GoalInfo1, _ - GoalInfo2) :-
+ goal_info_get_instmap_delta(GoalInfo1, InstmapDelta1),
+ instmap_delta_changed_vars(InstmapDelta1, ChangedVars1),
+ goal_info_get_nonlocals(GoalInfo2, NonLocals2),
+ set.intersect(ChangedVars1, NonLocals2, Intersection),
+ \+ set.empty(Intersection).
+
+ % Process a conjunction for implicit parallelism.
+ %
+:- pred process_conj_for_implicit_parallelism(
+ hlds_goal_expr::in, hlds_goal_expr::out, int::in,
+ proc_info::in, module_info::in, module_info::out,
+ list(candidate_call_site)::in, list(candidate_call_site)::out,
+ counter::in, counter::out) is det.
+
+process_conj_for_implicit_parallelism(!GoalExpr, IndexInConj, ProcInfo,
+ !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter) :-
+ ( !.GoalExpr = conj(_, GoalsConj) ->
+ list.length(GoalsConj, Length),
+ ( IndexInConj > Length ->
+ true
+ ;
+ MaybeConj0 = yes(!.GoalExpr),
+ list.index1_det(GoalsConj, IndexInConj, GoalInConj),
+ % We are not interested in the return value of GoalInConj, only
+ % MaybeConj matters.
+ process_goal_for_implicit_parallelism(GoalInConj, _, ProcInfo,
+ !ModuleInfo, MaybeConj0, MaybeConj, IndexInConj, IndexInConj0,
+ !CalleeListToBeParallelized, !SiteNumCounter),
+ ( MaybeConj = yes(GoalExprProcessed) ->
+ !:GoalExpr = GoalExprProcessed
+ ;
+ unexpected(this_file, "process_conj_for_implicit_parallelism")
+ ),
+ process_conj_for_implicit_parallelism(!GoalExpr, IndexInConj0,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized,
+ !SiteNumCounter)
+ )
+ ;
+ unexpected(this_file, "process_conj_for_implicit_parallelism")
+ ).
+
+ % Process a disjunction for implicit parallelism.
+ %
+:- pred process_disj_for_implicit_parallelism(
+ list(hlds_goal)::in, list(hlds_goal)::in, list(hlds_goal)::out,
+ proc_info::in, module_info::in, module_info::out,
+ list(candidate_call_site)::in, list(candidate_call_site)::out,
+ counter::in, counter::out) is det.
+
+process_disj_for_implicit_parallelism([], !GoalsAcc, _ProcInfo,
+ !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter).
+process_disj_for_implicit_parallelism([ Goal0 | Goals ], !GoalsAcc,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter) :-
+ process_goal_for_implicit_parallelism(Goal0, Goal, ProcInfo,
+ !ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized, !SiteNumCounter),
+ list.append(!.GoalsAcc, [ Goal ], !:GoalsAcc),
+ process_disj_for_implicit_parallelism(Goals, !GoalsAcc, ProcInfo,
+ !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter).
+
+ % If we are in a conjunction, update it by replacing the goal at index by
+ % Goal and increment the index.
+ %
+:- pred update_conj_and_index(
+ maybe(hlds_goal_expr)::in, maybe(hlds_goal_expr)::out,
+ hlds_goal::in, int::in, int::out) is det.
+
+update_conj_and_index(!MaybeConj, Goal, !IndexInConj) :-
+ ( !.MaybeConj = yes(conj(Type, Goals0)) ->
+ list.replace_nth_det(Goals0, !.IndexInConj, Goal, Goals),
+ !:IndexInConj = !.IndexInConj + 1,
+ !:MaybeConj = yes(conj(Type, Goals))
+ ;
+ true
+ ).
+
+ % Process a switch for implicit parallelism.
+ %
+:- pred process_switch_cases_for_implicit_parallelism(
+ list(case)::in, list(case)::in, list(case)::out, proc_info::in,
+ module_info::in, module_info::out,
+ list(candidate_call_site)::in, list(candidate_call_site)::out,
+ counter::in, counter::out) is det.
+
+process_switch_cases_for_implicit_parallelism([], !CasesAcc, _ProcInfo,
+ !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter).
+process_switch_cases_for_implicit_parallelism([ Case0 | Cases ], !CasesAcc,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter) :-
+ Case0 = case(Functor, Goal0),
+ process_goal_for_implicit_parallelism(Goal0, Goal, ProcInfo,
+ !ModuleInfo, no, _, 0, _, !CalleeListToBeParallelized, !SiteNumCounter),
+ list.append(!.CasesAcc, [ case(Functor, Goal) ], !:CasesAcc),
+ process_switch_cases_for_implicit_parallelism(Cases, !CasesAcc,
+ ProcInfo, !ModuleInfo, !CalleeListToBeParallelized, !SiteNumCounter).
+
+%-----------------------------------------------------------------------------%
+
+ % Parse the feedback file (header and body).
+ %
+:- pred parse_feedback_file(string::in,
+ maybe_error(list(candidate_call_site))::out, io::di, io::uo) is det.
+
+parse_feedback_file(InputFile, MaybeListCandidateCallSite, !IO) :-
+ io.open_input(InputFile, Result, !IO),
+ (
+ Result = io.error(ErrInput),
+ MaybeListCandidateCallSite = error(io.error_message(ErrInput))
+ ;
+ Result = ok(Stream),
+ io.read_file_as_string(Stream, MaybeFileAsString, !IO),
+ (
+ MaybeFileAsString = ok(FileAsString),
+ LineList = string.words_separator(is_carriage_return,
+ FileAsString),
+ process_header(LineList, MaybeBodyFileAsListString, !IO),
+ (
+ MaybeBodyFileAsListString = error(ErrProcessHeader),
+ MaybeListCandidateCallSite = error(ErrProcessHeader)
+ ;
+ MaybeBodyFileAsListString = ok(BodyFileAsListString),
+ process_body(BodyFileAsListString, MaybeListCandidateCallSite)
+ )
+ ;
+ MaybeFileAsString = error(_, ErrReadFileAsString),
+ MaybeListCandidateCallSite =
+ error(io.error_message(ErrReadFileAsString))
+ ),
+ io.close_input(Stream, !IO)
+ ).
+
+:- pred is_carriage_return(char::in) is semidet.
+
+is_carriage_return(Char) :- Char = '\n'.
+
+ % Process the header of the feedback file.
+ %
+:- pred process_header(list(string)::in, maybe_error(list(string))::out,
+ io::di, io::uo) is det.
+
+process_header(FileAsListString, MaybeFileAsListStringWithoutHeader, !IO) :-
+ ( list.index0(FileAsListString, 0, Type) ->
+ ( Type = "Profiling feedback file" ->
+ (list.index0(FileAsListString, 1, Version) ->
+ ( Version = "Version = 1.0" ->
+ list.det_split_list(4, FileAsListString, _,
+ FileAsListStringWithoutHeader),
+ MaybeFileAsListStringWithoutHeader =
+ ok(FileAsListStringWithoutHeader)
+ ;
+ MaybeFileAsListStringWithoutHeader = error("Profiling" ++
+ " feedback file version incorrect")
+ )
+ ;
+ MaybeFileAsListStringWithoutHeader = error("Not a profiling"
+ ++ " feedback file")
+ )
+ ;
+ MaybeFileAsListStringWithoutHeader = error("Not a profiling" ++
+ " feedback file")
+ )
+ ;
+ MaybeFileAsListStringWithoutHeader = error("Not a profiling feedback"
+ ++ " file")
+ ).
+
+ % Process the body of the feedback file.
+ %
+:- pred process_body(list(string)::in,
+ maybe_error(list(candidate_call_site))::out) is det.
+
+process_body(CoreFileAsListString, MaybeListCandidateCallSite) :-
+ ( process_body2(CoreFileAsListString, [], ListCandidateCallSite) ->
+ MaybeListCandidateCallSite = ok(ListCandidateCallSite)
+ ;
+ MaybeListCandidateCallSite = error("Profiling feedback file is not"
+ ++ " well-formed")
+ ).
+
+:- pred process_body2(list(string)::in, list(candidate_call_site)::in,
+ list(candidate_call_site)::out) is semidet.
+
+process_body2([], !ListCandidateCallSiteAcc).
+process_body2([ Line | Lines ], !ListCandidateCallSiteAcc) :-
+ Words = string.words_separator(is_whitespace, Line),
+ list.index0_det(Words, 0, Caller),
+ ( Caller = "Mercury" ->
+ process_body2(Lines, !ListCandidateCallSiteAcc)
+ ;
+ list.index0_det(Words, 1, SlotNumber),
+ string.to_int(SlotNumber, IntSlotNumber),
+ list.index0_det(Words, 2, KindAsString),
+ ( construct_call_site_kind(KindAsString, Kind) ->
+ ( Kind = csk_normal ->
+ list.index0_det(Words, 3, Callee),
+ CandidateCallSite = candidate_call_site(Caller, IntSlotNumber,
+ Kind, Callee)
+ ;
+ CandidateCallSite = candidate_call_site(Caller, IntSlotNumber,
+ Kind, "")
+ )
+ ;
+ % Unexpected call site kind.
+ unexpected(this_file, "process_body2")
+ ),
+ !:ListCandidateCallSiteAcc = [ CandidateCallSite |
+ !.ListCandidateCallSiteAcc ],
+ process_body2(Lines, !ListCandidateCallSiteAcc)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "implicit_parallelism.m".
+
+%-----------------------------------------------------------------------------%
+:- end_module transform_hlds.implicit_parallelism.
+%-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.417
diff -u -r1.417 mercury_compile.m
--- compiler/mercury_compile.m 5 Dec 2006 03:50:54 -0000 1.417
+++ compiler/mercury_compile.m 10 Jan 2007 04:54:27 -0000
@@ -79,6 +79,7 @@
:- import_module transform_hlds.trailing_analysis.
:- import_module transform_hlds.tabling_analysis.
:- import_module transform_hlds.higher_order.
+:- import_module transform_hlds.implicit_parallelism.
:- import_module transform_hlds.accumulator.
:- import_module transform_hlds.tupling.
:- import_module transform_hlds.untupling.
@@ -90,6 +91,7 @@
:- import_module transform_hlds.unused_args.
:- import_module transform_hlds.unneeded_code.
:- import_module transform_hlds.lco.
+:- import_module transform_hlds.distance_granularity.
:- import_module transform_hlds.ctgc.
:- import_module transform_hlds.ctgc.structure_reuse.
:- import_module transform_hlds.ctgc.structure_reuse.analysis.
@@ -2443,7 +2445,7 @@
module_info_get_globals(!.HLDS, Globals),
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, statistics, Stats),
-
+
maybe_read_experimental_complexity_file(!HLDS, !IO),
tabling(Verbose, Stats, !HLDS, !IO),
@@ -2510,6 +2512,9 @@
maybe_higher_order(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 135, "higher_order", !DumpInfo, !IO),
+ maybe_implicit_parallelism(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 139, "implicit_parallelism", !DumpInfo, !IO),
+
maybe_introduce_accumulators(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 140, "accum", !DumpInfo, !IO),
@@ -2555,6 +2560,9 @@
maybe_control_granularity(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 200, "granularity", !DumpInfo, !IO),
+ maybe_control_distance_granularity(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 201, "distance_granularity", !DumpInfo, !IO),
+
maybe_dependent_par_conj(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 205, "dependent_par_conj", !DumpInfo, !IO),
@@ -3859,6 +3867,55 @@
Sharing = no
).
+:- pred maybe_implicit_parallelism(bool::in, bool::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+maybe_implicit_parallelism(Verbose, Stats, !HLDS, !IO) :-
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, parallel, Parallel),
+ globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
+ globals.lookup_bool_option(Globals, implicit_parallelism,
+ ImplicitParallelism),
+ globals.lookup_string_option(Globals, feedback_file,
+ FeedbackFile),
+ ( FeedbackFile = "" ->
+ % No feedback file has been specified.
+ true
+ ;
+ (
+ % If this is false, no implicit parallelism is to be introduced.
+ Parallel = yes,
+
+ % If this is false, then the user hasn't asked for implicit
+ % parallelism.
+ ImplicitParallelism = yes,
+
+ % Our mechanism for implicit parallelism only works for the low
+ % level backend.
+ HighLevelCode = no
+ ->
+ globals.get_target(Globals, Target),
+ (
+ Target = target_c,
+ maybe_write_string(Verbose, "% Applying implicit parallelism...\n"
+ , !IO),
+ maybe_flush_output(Verbose, !IO),
+ apply_implicit_parallelism_transformation(!HLDS,
+ FeedbackFile, !IO),
+ maybe_write_string(Verbose, "% done.\n", !IO),
+ maybe_report_stats(Stats, !IO)
+ ;
+ ( Target = target_il
+ ; Target = target_java
+ ; Target = target_asm
+ )
+ % Leave the HLDS alone. We cannot implement parallelism.
+ )
+ ;
+ true
+ )
+ ).
+
:- pred maybe_control_granularity(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
@@ -3887,6 +3944,49 @@
"% Granularity control transformation...\n", !IO),
maybe_flush_output(Verbose, !IO),
control_granularity(!HLDS),
+ maybe_write_string(Verbose, "% done.\n", !IO),
+ maybe_report_stats(Stats, !IO)
+ ;
+ ( Target = target_il
+ ; Target = target_java
+ ; Target = target_asm
+ )
+ % Leave the HLDS alone. We cannot implement parallelism,
+ % so there is not point in controlling its granularity.
+ )
+ ;
+ true
+ ).
+
+:- pred maybe_control_distance_granularity(bool::in, bool::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+maybe_control_distance_granularity(Verbose, Stats, !HLDS, !IO) :-
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, parallel, Parallel),
+ globals.lookup_bool_option(Globals, highlevel_code, HighLevelCode),
+ globals.lookup_int_option(Globals, distance_granularity, Distance),
+ module_info_get_contains_par_conj(!.HLDS, ContainsParConj),
+ (
+ % If either of these is false, there is no parallelism to control.
+ Parallel = yes,
+ ContainsParConj = yes,
+
+ % Our mechanism for granularity control only works for the low level
+ % backend.
+ HighLevelCode = no,
+
+ % Distance must be greater than 0 to apply the distance granularity
+ % transformation.
+ Distance > 0
+ ->
+ globals.get_target(Globals, Target),
+ (
+ Target = target_c,
+ maybe_write_string(Verbose,
+ "% Distance granularity transformation...\n", !IO),
+ maybe_flush_output(Verbose, !IO),
+ control_distance_granularity(!HLDS, Distance),
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO)
;
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.541
diff -u -r1.541 options.m
--- compiler/options.m 5 Dec 2006 03:50:56 -0000 1.541
+++ compiler/options.m 10 Jan 2007 04:54:28 -0000
@@ -548,7 +548,9 @@
; tuple_costs_ratio
; tuple_min_args
; control_granularity
+ ; distance_granularity
; parallelism_target
+ ; implicit_parallelism
% Stuff for the CTGC system (structure sharing / structure reuse).
; structure_sharing_analysis
@@ -791,7 +793,7 @@
% recent when no other test can easily be constructed in
% configure.in.
- ; experiment.
+ ; experiment
% This option is provided for use by implementors who want to
% compare a new way of doing something with the old way. The idea
% is that the code that switches between the two ways should
@@ -804,6 +806,7 @@
% option to control their code, but adding an option requires
% recompiling most of the modules in the compiler. Having this
% option permanently here should reduce the need for that.
+ ; feedback_file.
%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
@@ -1297,7 +1300,9 @@
tuple_costs_ratio - int(100),
tuple_min_args - int(4),
control_granularity - bool(no),
+ distance_granularity - int(0),
parallelism_target - int(4),
+ implicit_parallelism - bool(no),
% HLDS -> LLDS
smart_indexing - bool(no),
@@ -1536,7 +1541,8 @@
fullarch - string(""),
local_module_id - accumulating([]),
compiler_sufficiently_recent - bool(no),
- experiment - string("")
+ experiment - string(""),
+ feedback_file - string("")
]).
% please keep this in alphabetic order
@@ -2050,7 +2056,9 @@
long_option("tuple-costs-ratio", tuple_costs_ratio).
long_option("tuple-min-args", tuple_min_args).
long_option("control-granularity", control_granularity).
+long_option("distance-granularity", distance_granularity).
long_option("parallelism-target", parallelism_target).
+long_option("implicit-parallelism", implicit_parallelism).
% CTGC related options.
long_option("structure-sharing", structure_sharing_analysis).
@@ -2311,6 +2319,7 @@
long_option("no-noncompact-ho-call-2004-01-15", compiler_sufficiently_recent).
long_option("trace-io-builtins-2006-08-14", compiler_sufficiently_recent).
long_option("experiment", experiment).
+long_option("feedback-file", feedback_file).
%-----------------------------------------------------------------------------%
@@ -4220,7 +4229,15 @@
"\thandle, which is specified using --parallelism-target.",
"--parallelism-target N",
"\tSpecified the number of CPUs of the target machine, for use by",
- "\tthe --control-granularity option."
+ "\tthe --control-granularity option.",
+ "--distance-granularity <int value>",
+ "\tControl the granularity of parallel execution using the specified",
+ "\tdistance value",
+ "--implicit-parallelism",
+ "\tIntroduce parallel conjunctions where it could be worthwhile",
+ "\t(implicit parallelism) using deep profiling feedback information",
+ "\tgenerated by mdprof_feedback. The profiling feedback file needs to",
+ "\be specified using the --feedback-file option."
]).
:- pred options_help_hlds_llds_optimization(io::di, io::uo) is det.
@@ -4717,12 +4734,15 @@
"\tcompile several modules without the overhead of process",
"\tcreation for each one.)",
"--version",
- "\tDisplay the compiler version."
+ "\tDisplay the compiler version.",
% The `--fullarch' option is reserved for
% use by the `Mercury.config' file.
% The `--local-module-id' option is used by `mmc --make'.
+ "--feedback-file",
+ "\tUse the specified profiling feedback file which may currently only",
+ "\tbe processed for implicit parallelism."
]).
:- pred write_tabbed_lines(list(string)::in, io::di, io::uo) is det.
Index: compiler/pred_table.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pred_table.m,v
retrieving revision 1.6
diff -u -r1.6 pred_table.m
--- compiler/pred_table.m 1 Dec 2006 15:04:15 -0000 1.6
+++ compiler/pred_table.m 10 Jan 2007 04:54:28 -0000
@@ -299,6 +299,8 @@
string::in, pred_or_func::in, arity::in, mode_no::in,
pred_id::out, proc_id::out) is det.
+:-pred get_next_pred_id(predicate_table::in, pred_id::out) is det.
+
%-----------------------------------------------------------------------------%
:- implementation.
@@ -1168,6 +1170,9 @@
[i(N), s(ProcName), i(Arity)]))
)
).
+
+get_next_pred_id(PredTable, NextPredId) :-
+ NextPredId = PredTable ^ next_pred_id.
%-----------------------------------------------------------------------------%
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.97
diff -u -r1.97 prog_util.m
--- compiler/prog_util.m 1 Dec 2006 15:04:18 -0000 1.97
+++ compiler/prog_util.m 10 Jan 2007 04:54:28 -0000
@@ -142,7 +142,8 @@
---> newpred_counter(int, int) % Line number, Counter
; newpred_type_subst(tvarset, type_subst)
; newpred_unused_args(list(int))
- ; newpred_parallel_args(list(int)).
+ ; newpred_parallel_args(list(int))
+ ; newpred_distance_granularity(int). % Distance
%-----------------------------------------------------------------------------%
@@ -581,11 +582,14 @@
;
NewPredId = newpred_parallel_args(Args),
list_to_string(int_to_string, Args, PredIdStr)
+ ;
+ NewPredId = newpred_distance_granularity(Distance),
+ int_to_string(Distance, PredIdStr)
),
string.format("%s__%s__%s__%s",
[s(Prefix), s(PFS), s(PredName), s(PredIdStr)], Name),
- SymName = qualified(ModuleName, Name).
+ SymName = qualified(ModuleName, Name).
:- pred list_to_string(pred(T, string)::in(pred(in, out) is det),
list(T)::in, string::out) is det.
Index: compiler/transform_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/transform_hlds.m,v
retrieving revision 1.25
diff -u -r1.25 transform_hlds.m
--- compiler/transform_hlds.m 3 Nov 2006 08:31:12 -0000 1.25
+++ compiler/transform_hlds.m 10 Jan 2007 04:54:28 -0000
@@ -83,8 +83,10 @@
:- include_module size_prof.
:- include_module tupling.
:- include_module untupling.
+:- include_module distance_granularity.
:- include_module granularity.
:- include_module dep_par_conj.
+:- include_module implicit_parallelism.
:- include_module mmc_analysis.
Index: deep_profiler/dump.m
===================================================================
RCS file: /home/mercury1/repository/mercury/deep_profiler/dump.m,v
retrieving revision 1.9
diff -u -r1.9 dump.m
--- deep_profiler/dump.m 1 Dec 2006 15:03:46 -0000 1.9
+++ deep_profiler/dump.m 10 Jan 2007 04:54:28 -0000
@@ -743,6 +743,7 @@
should_dump(DumpOptions, What) :-
( list.member(What, DumpOptions)
+ ; list.member("all", DumpOptions)
; DumpOptions = []
).
Index: deep_profiler/mdprof_feedback.m
===================================================================
RCS file: /home/mercury1/repository/mercury/deep_profiler/mdprof_feedback.m,v
retrieving revision 1.1
diff -u -r1.1 mdprof_feedback.m
--- deep_profiler/mdprof_feedback.m 19 Oct 2006 06:20:20 -0000 1.1
+++ deep_profiler/mdprof_feedback.m 10 Jan 2007 04:54:28 -0000
@@ -64,17 +64,22 @@
write_help_message(ProgName, !IO)
;
( Args = [Input, Output] ->
- lookup_string_option(Options, distribution, Distribution),
- ( construct_distribution(Distribution, DistributionType) ->
+ lookup_string_option(Options, measure, Measure),
+ ( construct_measure(Measure, MeasureType) ->
lookup_int_option(Options, threshold, Threshold),
lookup_bool_option(Options, verbose, Verbose),
- read_deep_file(Input, Verbose, MaybeProfile, !IO),
+ lookup_accumulating_option(Options, dump_stages,
+ DumpStages),
+ lookup_accumulating_option(Options, dump_options,
+ DumpOptions),
+ read_deep_file(Input, Verbose, DumpStages, DumpOptions,
+ MaybeProfile, !IO),
(
MaybeProfile = ok(Deep),
compute_css_list_above_threshold(0, Deep, Threshold,
- DistributionType, [], CSSListAboveThreshold),
+ MeasureType, [], CSSListAboveThreshold),
generate_feedback_file(CSSListAboveThreshold, Deep,
- DistributionType, Threshold, Output, !IO)
+ MeasureType, Threshold, Output, !IO)
;
MaybeProfile = error(Error),
io.stderr_stream(Stderr, !IO),
@@ -111,7 +116,7 @@
io.format("--verbose Generate progress messages.\n", []),
io.format("--threshold <value>\n", []),
io.format(" Set the threshold to <value>.\n",[]),
- io.format("--distrib average|median\n",[]),
+ io.format("--measure average|median\n",[]),
io.format(" average : Write to <output> the call sites\n",[]),
io.format(" static whose call sites dynamic's average\n",[]),
io.format(" call sequence counts exceed the given\n",[]),
@@ -135,10 +140,11 @@
% Read a deep profiling data file.
%
-:- pred read_deep_file(string::in, bool::in, maybe_error(deep)::out,
- io::di, io::uo) is det.
+:- pred read_deep_file(string::in, bool::in,
+ list(string)::in, list(string)::in,
+ maybe_error(deep)::out, io::di, io::uo) is det.
-read_deep_file(Input, Verbose, MaybeProfile, !IO) :-
+read_deep_file(Input, Verbose, DumpStages, DumpOptions, MaybeProfile, !IO) :-
server_name(Machine, !IO),
(
Verbose = yes,
@@ -148,17 +154,17 @@
Verbose = no,
MaybeOutput = no
),
- read_and_startup(Machine, [Input], no, MaybeOutput, [], [], MaybeProfile,
- !IO).
+ read_and_startup(Machine, [Input], no, MaybeOutput,
+ DumpStages, DumpOptions, MaybeProfile, !IO).
% Determine those CSSs whose CSDs' average/median call sequence counts
% exceed the given threshold.
%
:- pred compute_css_list_above_threshold(int::in, deep::in, int::in,
- distribution_type::in, list(call_site_static)::in,
+ measure_type::in, list(call_site_static)::in,
list(call_site_static)::out) is det.
-compute_css_list_above_threshold(Index, Deep, Threshold, Distribution,
+compute_css_list_above_threshold(Index, Deep, Threshold, Measure,
!CSSAcc) :-
array.size(Deep ^ call_site_statics, Size),
( Index = Size ->
@@ -173,13 +179,13 @@
Callseqs = 0
;
(
- Distribution = average,
+ Measure = average,
list.foldr(sum_callseqs_csd_ptr(Deep), CSDList,
0, SumCallseqs),
% NOTE: we have checked that NumCSD is not zero above.
Callseqs = SumCallseqs // NumCSD
;
- Distribution = median,
+ Measure = median,
list.sort(compare_csd_ptr(Deep), CSDList, CSDListSorted),
IndexMedian = NumCSD // 2,
list.index0_det(CSDListSorted, IndexMedian, MedianPtr),
@@ -188,12 +194,12 @@
),
( Callseqs >= Threshold ->
CSS = array.lookup(Deep ^ call_site_statics, Index),
- !:CSSAcc = [ CSS | !.CSSAcc ],
+ list.append(!.CSSAcc, [CSS], !:CSSAcc),
compute_css_list_above_threshold(Index + 1, Deep, Threshold,
- Distribution, !CSSAcc)
+ Measure, !CSSAcc)
;
compute_css_list_above_threshold(Index + 1, Deep, Threshold,
- Distribution, !CSSAcc)
+ Measure, !CSSAcc)
)
).
@@ -223,9 +229,9 @@
% threshold.
%
:- pred generate_feedback_file(list(call_site_static)::in, deep::in,
- distribution_type::in, int::in, string::in, io::di, io::uo) is det.
+ measure_type::in, int::in, string::in, io::di, io::uo) is det.
-generate_feedback_file(CSSList, Deep, Distribution, Threshold, Output, !IO) :-
+generate_feedback_file(CSSList, Deep, Measure, Threshold, Output, !IO) :-
io.open_output(Output, Result, !IO),
(
Result = io.error(Err),
@@ -236,11 +242,11 @@
io.write_string(Stream, "Profiling feedback file\n", !IO),
io.write_string(Stream, "Version = 1.0\n", !IO),
(
- Distribution = average,
- io.write_string(Stream, "Distribution = average\n", !IO)
+ Measure = average,
+ io.write_string(Stream, "Measure = average\n", !IO)
;
- Distribution = median,
- io.write_string(Stream, "Distribution = median\n", !IO)
+ Measure = median,
+ io.write_string(Stream, "Measure = median\n", !IO)
),
io.format(Stream, "Threshold = %i\n", [i(Threshold)], !IO),
write_css_list(CSSList, Deep, Stream, !IO),
@@ -290,9 +296,11 @@
; help
; verbose
; version
- ; distribution.
+ ; measure
+ ; dump_stages
+ ; dump_options.
-:- type distribution_type
+:- type measure_type
---> average
; median.
@@ -304,7 +312,9 @@
short('t', threshold).
short('h', help).
short('v', version).
-short('d', distribution).
+short('m', measure).
+short('d', dump_stages).
+short('D', dump_options).
:- pred long(string::in, option::out) is semidet.
@@ -313,8 +323,9 @@
long("help", help).
long("verbose", verbose).
long("version", version).
-long("distrib", distribution).
-long("distribution", distribution).
+long("measure", measure).
+long("dump-stages", dump_stages).
+long("dump-options", dump_options).
:- pred defaults(option::out, option_data::out) is multi.
@@ -322,12 +333,14 @@
defaults(help, bool(no)).
defaults(verbose, bool(no)).
defaults(version, bool(no)).
-defaults(distribution, string("average")).
+defaults(measure, string("average")).
+defaults(dump_stages, accumulating([])).
+defaults(dump_options, accumulating([])).
-:- pred construct_distribution(string::in, distribution_type::out) is semidet.
+:- pred construct_measure(string::in, measure_type::out) is semidet.
-construct_distribution("average", average).
-construct_distribution("median", median).
+construct_measure("average", average).
+construct_measure("median", median).
%-----------------------------------------------------------------------------%
:- end_module mdprof_feedback.
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.501
diff -u -r1.501 user_guide.texi
--- doc/user_guide.texi 5 Dec 2006 03:51:12 -0000 1.501
+++ doc/user_guide.texi 10 Jan 2007 04:54:28 -0000
@@ -7819,6 +7819,20 @@
Specifies the number of CPUs of the target machine,
for use by --control-granularity option.
+ at sp 1
+ at item --distance-granularity @var{distance_value}
+ at findex --distance-granularity
+Control the granularity of parallel execution using the specified distance
+value.
+
+ at sp 1
+ at item --implicit-parallelism
+ at findex --implicit-parallelism
+Introduce parallel conjunctions where it could be worthwhile (implicit
+parallelism) using deep profiling feedback information generated by
+mdprof_feedback. The profiling feedback file needs to be specified using the
+--feedback-file option.
+
@end table
@node MLDS backend (MLDS -> MLDS) optimization options
@@ -8289,6 +8303,12 @@
standard input. Repeat this until EOF is reached. (This allows a program
or user to interactively compile several modules without the overhead of
process creation for each one.)
+
+ at sp 1
+ at item --feedback-file
+ at findex --feedback-file
+Use the specified profiling feedback file which may currently only be processed
+for implicit parallelism.
@end table
Index: tests/par_conj/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/tests/par_conj/Mercury.options,v
retrieving revision 1.3
diff -u -r1.3 Mercury.options
--- tests/par_conj/Mercury.options 9 Aug 2006 03:17:16 -0000 1.3
+++ tests/par_conj/Mercury.options 10 Jan 2007 04:54:28 -0000
@@ -5,3 +5,6 @@
# tracing.
MCFLAGS-par_ddeath = --trace deep
MCFLAGS-par_ddeath_2 = --trace deep
+
+MCFLAGS-dg_fib = --parallel --distance-granularity 10
+MCFLAGS-dg_fib_func = --parallel --distance-granularity 10
Index: tests/par_conj/dg_fib.exp
===================================================================
RCS file: tests/par_conj/dg_fib.exp
diff -N tests/par_conj/dg_fib.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/par_conj/dg_fib.exp 10 Jan 2007 04:54:28 -0000
@@ -0,0 +1 @@
+832040
Index: tests/par_conj/dg_fib.m
===================================================================
RCS file: tests/par_conj/dg_fib.m
diff -N tests/par_conj/dg_fib.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/par_conj/dg_fib.m 10 Jan 2007 04:54:28 -0000
@@ -0,0 +1,39 @@
+:- module dg_fib.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module int.
+:- import_module maybe.
+:- import_module require.
+
+main(!IO) :-
+ fibonacci(30, Result),
+ io.write_int(Result, !IO),
+ io.nl(!IO).
+
+:- pred fibonacci(int::in, int::out) is det.
+
+fibonacci(X, Y) :-
+ ( X = 0 ->
+ Y = 0
+ ;
+ ( X = 1 ->
+ Y = 1
+ ;
+ ( X > 1 ->
+ J = X - 1,
+ K = X - 2,
+ (
+ fibonacci(J, Jout)
+ &
+ fibonacci(K, Kout)
+ ),
+ Y = Jout + Kout
+ ;
+ error("fibonacci: wrong value")
+ )
+ )
+ ).
Index: tests/par_conj/dg_fib_func.exp
===================================================================
RCS file: tests/par_conj/dg_fib_func.exp
diff -N tests/par_conj/dg_fib_func.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/par_conj/dg_fib_func.exp 10 Jan 2007 04:54:28 -0000
@@ -0,0 +1 @@
+832040
Index: tests/par_conj/dg_fib_func.m
===================================================================
RCS file: tests/par_conj/dg_fib_func.m
diff -N tests/par_conj/dg_fib_func.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/par_conj/dg_fib_func.m 10 Jan 2007 04:54:28 -0000
@@ -0,0 +1,39 @@
+:- module dg_fib_func.
+:- interface.
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+:- import_module int.
+:- import_module maybe.
+:- import_module require.
+
+main(!IO) :-
+ Result = fibonacci(30),
+ io.write_int(Result, !IO),
+ io.nl(!IO).
+
+:- func fibonacci(int) = int.
+
+fibonacci(X) = Y :-
+ ( X = 0 ->
+ Y = 0
+ ;
+ ( X = 1 ->
+ Y = 1
+ ;
+ ( X > 1 ->
+ J = X - 1,
+ K = X - 2,
+ (
+ Jout = fibonacci(J)
+ &
+ Kout = fibonacci(K)
+ ),
+ Y = Jout + Kout
+ ;
+ error("fibonacci: wrong value")
+ )
+ )
+ ).
--------------------------------------------------------------------------
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