Files
mercury/compiler/dep_par_conj.m
Zoltan Somogyi b560f66ab9 Move four modules from check_hlds.m to hlds.m.
After this, I think all modules in the check_hlds package belong there.

compiler/inst_match.m:
compiler/mode_test.m:
    Move these modules from the check_hlds package to the hlds package
    because most of their uses are outside the semantic analysis passes
    that the check_hlds package is intended to contain.

compiler/inst_merge.m:
    Move this module from the check_hlds package to the hlds package
    because it is imported by only two modules, instmap.m and inst_match.m,
    and after this diff, both are in the hlds package.

compiler/implementation_defined_literals.m:
    Move this module from the check_hlds package to the hlds package
    because it does a straightforward program transformation that
    does not have anything to do with semantic analysis (though its
    invocation does happen between semantic analysis passes).

compiler/notes/compiler_design.html:
    Update the documentation of the goal_path.m module. (I checked the
    documentation of the moved modules, which did not need updates,
    and found the need for this instead.)

compiler/*.m:
    Conform to the changes above. (For many modules, this deletes
    their import of the check_hlds package itself.)
2026-02-27 15:16:44 +11:00

3552 lines
150 KiB
Mathematica

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2006-2012 The University of Melbourne.
% Copyright (C) 2015, 2017, 2025-2026 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: dep_par_conj.m.
% Author: wangp.
%
% This module implements dependent parallel conjunction using HLDS->HLDS
% transformations. The overall process has two main components:
%
% - a synchronization transformation, and
% - a specialization transformation.
%
% 1 The synchronization transformation ensures that consumers do not access
% shared variables before producers generate them. We do this by adding calls
% to the synchronisation primitives defined in library/par_builtin.m.
% In general, we make producers signal the availability of shared variables
% as soon as possible, and we make consumers wait for the shared variables
% as late as possible.
%
% 2 The specialization transformation spots the need for and creates new
% versions of procedures. If some shared variables in a parallel conjunction
% are produced and/or consumed inside a call, we create a specialized version
% of the called procedure that does the signalling of the produced variables
% (as early as possible) and/or the waiting for the consumed variables (as
% late as possible). In the absence of these specialized procedures, we would
% have to assume that all calls consume their inputs immediately and generate
% their outputs only when they return, which in many cases is an excessively
% pessimistic assumption.
%
% To see how the synchronization transformation works, consider this example:
%
% p(A::in, B::in, C::out) :-
% (
% q(A, X),
% r(X, Y)
% )
% &
% (
% s(B, W),
% t(X, W, Z)
% ),
% C = X + Y + Z.
%
% The only variable shared between the parallel conjuncts is X, which is
% produced by the call to q and is used in the call to t. We transform this
% code to
%
% p(A::in, B::in, C::out) :-
% promise_pure(
% par_builtin.new_future(FutureX),
% (
% q(A, X),
% impure par_builtin.signal(FutureX, X)
% r(X, Y)
% )
% &
% (
% s(B, W),
% par_builtin.wait(FutureX, X')
% t(X', W, Z)
% )
% ),
% C = X + Y + Z.
%
% For each shared variable, we create a new future variable, which serves as
% the conduit between the producer and the consumers, both for synchronization
% and for the transmission of the shared variable's value. Note that we
% create a new, distinct name for each shared variable in each consumer,
% so that after the transformation, the only variables that occur in more than
% one conjunct of the parallel conjunction are the variables that were already
% ground before the parallel conjunction is entered. (These include the future
% variables.)
%
% The specialization transformation looks for calls preceded by a contiguous
% sequence of one or more calls to par_builtin.wait and/or followed by a
% contiguous sequence of one or more calls to par_builtin.signal. When it finds
% one, it (a) replaces the sequence with a call to a specialized version of
% the called procedure, a version which will do all the waits and/or signals
% internally, and (b) creates that specialized version of the called procedure,
% pushing the waits as late as possible and the signals as early as possible.
% For example,
%
% wait(FutureX, X),
% p(X, Y),
% impure signal(FutureY, Y)
%
% would be transformed into:
%
% Parallel__p(FutureX, FutureY),
%
% where the wait and signal calls are now in the body of Parallel__p.
%
% - The predicates and functions in this module whose names start with the
% prefixes "sync_dep_par_conjs", "insert_wait_in" and "insert_signal_in"
% implement the synchronization transformation.
%
% - Those whose names start with "find_specialization_requests" or include
% "specialization" implement part (a) of the specialization transformation.
%
% - Those whose names start with "add_requested_specialized" implement part (b)
% of the specialization transformation.
%
%---------------------------------------------------------------------------%
:- module transform_hlds.dep_par_conj.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module io.
%---------------------------------------------------------------------------%
% Transform all the parallel conjunctions in the procedures of this module
% according to the scheme shown above.
%
:- pred impl_dep_par_conjs_in_module(io.text_output_stream::in,
module_info::in, module_info::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.
:- import_module check_hlds.purity.
:- import_module check_hlds.recompute_instmap_deltas.
:- import_module hlds.goal_refs.
:- import_module hlds.goal_reorder.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_dependency_graph.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_markers.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_goal.
:- import_module hlds.hlds_out.hlds_out_util.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_proc_util.
:- import_module hlds.inst_test.
:- import_module hlds.instmap.
:- import_module hlds.mode_test.
:- import_module hlds.pred_name.
:- import_module hlds.pred_table.
:- import_module hlds.quantification.
:- import_module hlds.status.
:- import_module libs.
:- import_module libs.dependency_graph.
:- import_module libs.globals.
:- import_module libs.optimization_options.
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.
:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.parse_tree_out_info.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_data_foreign.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.set_of_var.
:- import_module parse_tree.var_db.
:- import_module parse_tree.var_table.
:- import_module assoc_list.
:- import_module bool.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module std_util.
:- import_module string.
:- import_module term_context.
:- import_module varset.
%---------------------------------------------------------------------------%
impl_dep_par_conjs_in_module(ProgressStream, !ModuleInfo) :-
InitialModuleInfo = !.ModuleInfo,
% Phase one: insert synchronization code into all parallel conjunctions
% in the module.
module_info_get_valid_pred_ids(!.ModuleInfo, PredIds),
module_info_get_ts_rev_string_table(!.ModuleInfo, _, RevTable0),
make_ts_string_table(RevTable0, TSStringTable0),
list.foldl3(maybe_sync_dep_par_conjs_in_pred(ProgressStream), PredIds,
!ModuleInfo, [], ProcsToScan, TSStringTable0, TSStringTable1),
% Phase two: attempt to push the synchronization code inside procedures
% as far as we can. We do this by creating specialized versions of
% procedures. We do this to a fixpoint, since creating a specialized
% version of a procedure may require us to create more specialized versions
% of the other procedures.
DoneParProcs0 = map.init,
PendingParProcs0 = [],
Pushability0 = map.init,
RevProcMap0 = map.init,
list.foldl4(
find_specialization_requests_in_proc(DoneParProcs0, InitialModuleInfo),
ProcsToScan, !ModuleInfo, PendingParProcs0, PendingParProcs,
Pushability0, Pushability, RevProcMap0, RevProcMap),
add_requested_specialized_par_procs(ProgressStream, PendingParProcs,
Pushability, DoneParProcs0, InitialModuleInfo, !ModuleInfo,
RevProcMap, _, TSStringTable1, TSStringTable),
module_info_set_ts_rev_string_table(TSStringTable ^ st_size,
TSStringTable ^ st_rev_table, !ModuleInfo).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%
% The synchronization transformation.
%
% This type holds information relevant to the synchronization
% transformation.
%
:- type sync_info
---> sync_info(
% The current module. This field is read only.
sync_module_info :: module_info,
% Variables which should not be replaced by futures in this
% pass because it has already been done. This field is
% read only.
sync_ignore_vars :: set_of_progvar,
% The value of the --allow-some-paths-only-waits option.
% Read-only.
sync_allow_some_paths_only ::
maybe_allow_some_paths_only_waits,
% The var_table for the procedure being analysed.
% This field is updated when we add new variables.
% XXX We may also need the rtti_var_maps.
sync_var_table :: var_table,
% The current procedure.
sync_this_proc :: pred_proc_id,
% The current threadscope string table.
sync_ts_string_table :: ts_string_table
).
:- pred maybe_sync_dep_par_conjs_in_pred(io.text_output_stream::in,
pred_id::in, module_info::in, module_info::out,
list(pred_proc_id)::in, list(pred_proc_id)::out,
ts_string_table::in, ts_string_table::out) is det.
maybe_sync_dep_par_conjs_in_pred(ProgressStream, PredId,
!ModuleInfo, !ProcsToScan, !TSStringTable) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
ProcIds = pred_info_all_non_imported_procids(PredInfo),
list.foldl3(maybe_sync_dep_par_conjs_in_proc(ProgressStream, PredId),
ProcIds, !ModuleInfo, !ProcsToScan, !TSStringTable).
:- pred maybe_sync_dep_par_conjs_in_proc(io.text_output_stream::in,
pred_id::in, proc_id::in,
module_info::in, module_info::out,
list(pred_proc_id)::in, list(pred_proc_id)::out,
ts_string_table::in, ts_string_table::out) is det.
maybe_sync_dep_par_conjs_in_proc(ProgressStream, PredId, ProcId,
!ModuleInfo, !ProcsToScan, !TSStringTable) :-
module_info_proc_info(!.ModuleInfo, PredId, ProcId, ProcInfo),
proc_info_get_has_parallel_conj(ProcInfo, HasParallelConj),
(
HasParallelConj = has_no_parallel_conj
;
HasParallelConj = has_parallel_conj,
sync_dep_par_conjs_in_proc(ProgressStream, PredId, ProcId,
set_of_var.init, !ModuleInfo, !ProcsToScan, !TSStringTable)
).
:- pred sync_dep_par_conjs_in_proc(io.text_output_stream::in,
pred_id::in, proc_id::in, set_of_progvar::in,
module_info::in, module_info::out,
list(pred_proc_id)::in, list(pred_proc_id)::out,
ts_string_table::in, ts_string_table::out) is det.
sync_dep_par_conjs_in_proc(ProgressStream, PredId, ProcId, IgnoreVars,
!ModuleInfo, !ProcsToScan, !TSStringTable) :-
some [!PredInfo, !ProcInfo, !Goal, !VarTable, !SyncInfo] (
module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
!:PredInfo, !:ProcInfo),
proc_info_get_goal(!.ProcInfo, !:Goal),
proc_info_get_var_table(!.ProcInfo, !:VarTable),
proc_info_get_initial_instmap(!.ModuleInfo, !.ProcInfo, InstMap0),
module_info_get_globals(!.ModuleInfo, Globals),
globals.get_opt_tuple(Globals, OptTuple),
AllowSomePathsOnly = OptTuple ^ ot_allow_some_paths_only_waits,
% We rely on dependency information in order to determine which calls
% are recursive. The information is stored within !ModuleInfo, so it
% doesn't need to be kept here; this call simply forces an update.
module_info_rebuild_dependency_info(!ModuleInfo, _),
GoalBeforeDepParConj = !.Goal,
!:SyncInfo = sync_info(!.ModuleInfo, IgnoreVars, AllowSomePathsOnly,
!.VarTable, proc(PredId, ProcId), !.TSStringTable),
sync_dep_par_conjs_in_goal(!Goal, InstMap0, _, !SyncInfo),
!.SyncInfo = sync_info(_, _, _, !:VarTable, _, !:TSStringTable),
% XXX RTTI varmaps may need to be updated
trace [compile_time(flag("debug-dep-par-conj")), io(!IO)] (
globals.lookup_accumulating_option(Globals, debug_dep_par_conj,
DebugDepParConjWords),
PredIdInt = pred_id_to_int(PredId),
PredIdStr = string.int_to_string(PredIdInt),
( if
some [DebugDepParConjWord] (
list.member(DebugDepParConjWord, DebugDepParConjWords),
DebugDepParConjWord = PredIdStr
)
then
OutInfo = init_hlds_out_info(Globals, output_debug),
pred_info_get_typevarset(!.PredInfo, TVarSet),
proc_info_get_inst_varset(!.ProcInfo, InstVarSet),
io.format(ProgressStream,
"Pred/Proc: %s/%s before dep-par-conj:\n",
[s(string(PredId)), s(string(ProcId))], !IO),
write_goal_nl(OutInfo, ProgressStream, !.ModuleInfo,
vns_var_table(!.VarTable), print_name_and_num,
TVarSet, InstVarSet, 0u, "", GoalBeforeDepParConj, !IO),
io.nl(ProgressStream, !IO),
io.write_string(ProgressStream, "After dep-par-conj:\n", !IO),
write_goal_nl(OutInfo, ProgressStream, !.ModuleInfo,
vns_var_table(!.VarTable), print_name_and_num,
TVarSet, InstVarSet, 0u, "", !.Goal, !IO)
else
true
)
),
% We really only need to run this part if something changed, but we
% only run this predicate on procedures which are likely to have
% parallel conjunctions.
proc_info_set_var_table(!.VarTable, !ProcInfo),
proc_info_set_goal(!.Goal, !ProcInfo),
fixup_and_reinsert_proc(PredId, ProcId, !.PredInfo, !.ProcInfo,
!ModuleInfo),
PredProcId = proc(PredId, ProcId),
!:ProcsToScan = [PredProcId | !.ProcsToScan]
).
% Traverse the goal looking for dependent parallel conjunctions,
% and insert code to synchronize the accesses of the various
% parallel conjuncts to the variables they share.
%
:- pred sync_dep_par_conjs_in_goal(hlds_goal::in, hlds_goal::out,
instmap::in, instmap::out, sync_info::in, sync_info::out) is det.
sync_dep_par_conjs_in_goal(Goal0, Goal, InstMap0, InstMap, !SyncInfo) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
(
GoalExpr0 = conj(ConjType, Goals0),
sync_dep_par_conjs_in_conj(Goals0, Goals, InstMap0, !SyncInfo),
(
ConjType = plain_conj,
conj_list_to_goal(Goals, GoalInfo0, Goal)
;
ConjType = parallel_conj,
Goal0InstmapDelta = goal_info_get_instmap_delta(Goal0 ^ hg_info),
( if instmap_delta_is_unreachable(Goal0InstmapDelta) then
% If the instmap becomes unreachable then calculating the
% produces and consumers for the dependant parallel conjunction
% transformation becomes impossible. Since this probably
% throws an exception anyway there's no point parallelising it.
% This should not be a compiler error. For instance in the
% bug_130 test case a call to a deterministic predicate whose
% body is erroneous is inlined. Generating an error in this
% case would confuse the programmer.
conj_list_to_goal(Goals, GoalInfo0, Goal)
else
maybe_sync_dep_par_conj(Goals, GoalInfo0, Goal, InstMap0,
!SyncInfo)
)
)
;
GoalExpr0 = disj(Goals0),
sync_dep_par_conjs_in_disj(Goals0, Goals, InstMap0, !SyncInfo),
GoalExpr = disj(Goals),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = switch(Var, CanFail, Cases0),
sync_dep_par_conjs_in_cases(Cases0, Cases, InstMap0, !SyncInfo),
GoalExpr = switch(Var, CanFail, Cases),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = if_then_else(QuantVars, Cond0, Then0, Else0),
sync_dep_par_conjs_in_goal(Cond0, Cond, InstMap0, InstMap1,
!SyncInfo),
sync_dep_par_conjs_in_goal(Then0, Then, InstMap1, _, !SyncInfo),
sync_dep_par_conjs_in_goal(Else0, Else, InstMap0, _, !SyncInfo),
GoalExpr = if_then_else(QuantVars, Cond, Then, Else),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = negation(SubGoal0),
sync_dep_par_conjs_in_goal(SubGoal0, SubGoal, InstMap0, _,
!SyncInfo),
GoalExpr = negation(SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
( if
Reason = from_ground_term(_, FGT),
( FGT = from_ground_term_construct
; FGT = from_ground_term_deconstruct
)
then
Goal = Goal0
else
sync_dep_par_conjs_in_goal(SubGoal0, SubGoal, InstMap0, _,
!SyncInfo),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
)
;
( GoalExpr0 = unify(_, _, _, _, _)
; GoalExpr0 = plain_call(_, _, _, _, _, _)
; GoalExpr0 = generic_call(_, _, _, _, _)
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
),
Goal = Goal0
;
GoalExpr0 = shorthand(_),
% These should have been expanded out by now.
unexpected($pred, "shorthand")
),
apply_goal_instmap_delta(Goal, InstMap0, InstMap).
:- pred sync_dep_par_conjs_in_conj(list(hlds_goal)::in, list(hlds_goal)::out,
instmap::in, sync_info::in, sync_info::out) is det.
sync_dep_par_conjs_in_conj([], [], _, !SyncInfo).
sync_dep_par_conjs_in_conj([Goal0 | Goals0], [Goal | Goals], !.InstMap,
!SyncInfo) :-
sync_dep_par_conjs_in_goal(Goal0, Goal, !InstMap, !SyncInfo),
sync_dep_par_conjs_in_conj(Goals0, Goals, !.InstMap, !SyncInfo).
:- pred sync_dep_par_conjs_in_disj(list(hlds_goal)::in, list(hlds_goal)::out,
instmap::in, sync_info::in, sync_info::out) is det.
sync_dep_par_conjs_in_disj([], [], _InstMap0, !SyncInfo).
sync_dep_par_conjs_in_disj([Goal0 | Goals0], [Goal | Goals], InstMap0,
!SyncInfo) :-
sync_dep_par_conjs_in_goal(Goal0, Goal, InstMap0, _InstMap, !SyncInfo),
sync_dep_par_conjs_in_disj(Goals0, Goals, InstMap0, !SyncInfo).
:- pred sync_dep_par_conjs_in_cases(list(case)::in, list(case)::out,
instmap::in, sync_info::in, sync_info::out) is det.
sync_dep_par_conjs_in_cases([], [], _InstMap0, !SyncInfo).
sync_dep_par_conjs_in_cases([Case0 | Cases0], [Case | Cases], InstMap0,
!SyncInfo) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
sync_dep_par_conjs_in_goal(Goal0, Goal, InstMap0, _, !SyncInfo),
Case = case(MainConsId, OtherConsIds, Goal),
sync_dep_par_conjs_in_cases(Cases0, Cases, InstMap0, !SyncInfo).
%---------------------------------------------------------------------------%
% We found a parallel conjunction. Check for any dependencies between
% the conjuncts and, if we find some, insert sychronisation primitives.
%
:- pred maybe_sync_dep_par_conj(list(hlds_goal)::in, hlds_goal_info::in,
hlds_goal::out, instmap::in, sync_info::in, sync_info::out)
is det.
maybe_sync_dep_par_conj(Conjuncts, GoalInfo, NewGoal, InstMap, !SyncInfo) :-
!.SyncInfo = sync_info(ModuleInfo0, IgnoreVars, AllowSomePathsOnly,
VarTable0, PredProcId, TSStringTable0),
% Find the variables that are shared between conjuncts.
SharedVars0 = find_shared_variables(ModuleInfo0, InstMap, Conjuncts),
% Filter out all the variables which have already have associated futures,
% i.e. they were head variables which were replaced by futures; signal and
% wait calls will already have been inserted for them.
SharedVars = set_of_var.filter(isnt(set_of_var.contains(IgnoreVars)),
SharedVars0),
( if set_of_var.is_empty(SharedVars) then
% Independent parallel conjunctions can sometimes be re-ordered to
% generate faster code.
module_info_get_globals(ModuleInfo0, Globals),
globals.lookup_bool_option(Globals, par_loop_control, ParLoopControl),
(
ParLoopControl = no,
reorder_indep_par_conj(PredProcId, VarTable0, InstMap, Conjuncts,
GoalInfo, NewGoal, ModuleInfo0, ModuleInfo),
!:SyncInfo = sync_info(ModuleInfo, IgnoreVars, AllowSomePathsOnly,
VarTable0, PredProcId, TSStringTable0)
;
ParLoopControl = yes,
% Don't swap the conjuncts, parallel loop control can do a better
% job of optimizing this code.
NewGoal = hlds_goal(conj(parallel_conj, Conjuncts), GoalInfo)
)
else
sync_dep_par_conj(ModuleInfo0, AllowSomePathsOnly, SharedVars,
Conjuncts, GoalInfo, NewGoal, InstMap,
VarTable0, VarTable, TSStringTable0, TSStringTable),
!:SyncInfo = sync_info(ModuleInfo0, IgnoreVars, AllowSomePathsOnly,
VarTable, PredProcId, TSStringTable)
).
% Transforming the parallel conjunction.
%
% We insert waits as deeply into the conjunction as possible, and signals
% as early as possible.
%
% Example:
%
% p(A, B, ABA) :-
% ( append(A, B, AB)
% & append(AB, A, ABA)
% ).
%
% becomes:
%
% p(A, B, ABA) :-
% new_future(FutureAB),
% (
% append(A, B, AB_7),
% impure signal(FutureAB, AB_7)
% &
% wait(FutureAB, AB_10),
% append(AB_10, A, ABA)
% ).
%
:- pred sync_dep_par_conj(module_info::in,
maybe_allow_some_paths_only_waits::in, set_of_progvar::in,
list(hlds_goal)::in, hlds_goal_info::in, hlds_goal::out, instmap::in,
var_table::in, var_table::out,
ts_string_table::in, ts_string_table::out) is det.
sync_dep_par_conj(ModuleInfo, AllowSomePathsOnly, SharedVars, Goals, GoalInfo,
NewGoal, InstMap, !VarTable, !TSStringTable) :-
SharedVarsList = set_of_var.to_sorted_list(SharedVars),
list.map_foldl3(allocate_future(ModuleInfo), SharedVarsList,
AllocateFuturesGoals, !VarTable, map.init, FutureMap, !TSStringTable),
list.condense(AllocateFuturesGoals, AllocateFutures),
list.map_foldl2(
sync_dep_par_conjunct(ModuleInfo, AllowSomePathsOnly, SharedVars,
FutureMap),
Goals, NewGoals, InstMap, _, !VarTable),
LastGoal = hlds_goal(conj(parallel_conj, NewGoals), GoalInfo),
Conj = AllocateFutures ++ [LastGoal],
conj_list_to_goal(Conj, GoalInfo, NewGoal0),
% Wrap a purity scope around the goal if purity would have been lessened
% by the addition of signal goals (which are impure) or calls to
% parallelised procs (which may be impure).
Purity = goal_info_get_purity(GoalInfo),
(
Purity = purity_impure,
NewGoal = NewGoal0
;
( Purity = purity_pure
; Purity = purity_semipure
),
Reason = promise_purity(Purity),
NewGoal = hlds_goal(scope(Reason, NewGoal0), GoalInfo)
).
% Add waits and signals into the body of a procedure. This is slightly
% different from adding them to a parallel conjunct. We have to maintain
% the extra invariant that the procedure guarantees that all futures have
% been waited on, For futures that would have been inputs to the procedure
% before the transformation).
%
% XXX: In some cases the pushed variable appears in the head of the
% procedure but not in the body, that is to say it is an unused argument.
% In these cases the specialization creates slower code than the original
% procedure simply to maintain the above invariant. Can an unused argument
% analysis prevent this situation?
%
:- pred sync_dep_par_proc_body(module_info::in,
maybe_allow_some_paths_only_waits::in, set_of_progvar::in,
future_map::in, instmap::in, hlds_goal::in, hlds_goal::out,
var_table::in, var_table::out) is det.
sync_dep_par_proc_body(ModuleInfo, AllowSomePathsOnly, SharedVars, FutureMap,
InstMap, !Goal, !VarTable) :-
Nonlocals = goal_get_nonlocals(!.Goal),
set_of_var.intersect(Nonlocals, SharedVars, NonlocalSharedVars),
( if set_of_var.is_empty(NonlocalSharedVars) then
true
else
GoalInfo0 = !.Goal ^ hg_info,
InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo0),
consumed_and_produced_vars(ModuleInfo, InstMap, InstMapDelta0,
NonlocalSharedVars, ConsumedVarsList, ProducedVarsList),
% Insert waits into the conjunct.
list.foldl2(
insert_wait_in_goal_for_proc(ModuleInfo,
AllowSomePathsOnly, FutureMap),
ConsumedVarsList, !Goal, !VarTable),
% Insert signals into the conjunct, as early as possible.
list.foldl2(insert_signal_in_goal(ModuleInfo, FutureMap),
ProducedVarsList, !Goal, !VarTable)
),
set_of_var.difference(SharedVars, Nonlocals, WaitAfterVars),
( if set_of_var.is_empty(WaitAfterVars) then
true
else
% WaitAfterVars are pushed into this call but not consumed in the body.
% Our caller expects them to be consumed by the time this call returns
% so we must wait for them.
list.foldl(insert_wait_after_goal(ModuleInfo, !.VarTable, FutureMap),
set_of_var.to_sorted_list(WaitAfterVars), !Goal)
).
:- pred sync_dep_par_conjunct(module_info::in,
maybe_allow_some_paths_only_waits::in, set_of_progvar::in, future_map::in,
hlds_goal::in, hlds_goal::out, instmap::in, instmap::out,
var_table::in, var_table::out) is det.
sync_dep_par_conjunct(ModuleInfo, AllowSomePathsOnly, SharedVars, FutureMap,
!Goal, !InstMap, !VarTable) :-
Nonlocals = goal_get_nonlocals(!.Goal),
set_of_var.intersect(Nonlocals, SharedVars, NonlocalSharedVars),
( if set_of_var.is_empty(NonlocalSharedVars) then
true
else
GoalInfo0 = !.Goal ^ hg_info,
InstMapDelta0 = goal_info_get_instmap_delta(GoalInfo0),
consumed_and_produced_vars(ModuleInfo, !.InstMap, InstMapDelta0,
NonlocalSharedVars, ConsumedVarsList, ProducedVarsList),
% Insert waits into the conjunct, as late as possible.
list.map_foldl2(
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly, FutureMap),
ConsumedVarsList, _WaitedOnAllSuccessPaths,
!Goal, !VarTable),
% Insert signals into the conjunct, as early as possible.
list.foldl2(insert_signal_in_goal(ModuleInfo, FutureMap),
ProducedVarsList, !Goal, !VarTable),
% Each consumer will have its own local name for the consumed variable,
% so they can each wait for it when they need to.
clone_variables(ConsumedVarsList, !.VarTable, !VarTable,
map.init, Renaming),
rename_some_vars_in_goal(Renaming, !Goal)
),
apply_goal_instmap_delta(!.Goal, !InstMap).
% Divide the shared variables into
% - those that are consumed by this conjunct, and
% - those that are produced by it.
%
:- pred consumed_and_produced_vars(module_info::in, instmap::in,
instmap_delta::in, set_of_progvar::in,
list(prog_var)::out, list(prog_var)::out) is det.
consumed_and_produced_vars(ModuleInfo, InstMap, InstMapDelta, Vars,
ConsumedVarsList, ProducedVarsList) :-
% XXX We should check that the initial instantiation of each variable
% in ProducedVars in !.InstMap is free. However, at the moment, there
% is nothing useful we can do if it isn't.
IsProducedVar = var_is_bound_in_instmap_delta(ModuleInfo, InstMap,
InstMapDelta),
set_of_var.divide(IsProducedVar, Vars, ProducedVars, ConsumedVars),
ConsumedVarsList = set_of_var.to_sorted_list(ConsumedVars),
ProducedVarsList = set_of_var.to_sorted_list(ProducedVars).
:- pred insert_wait_in_goal_for_proc(module_info::in,
maybe_allow_some_paths_only_waits::in, future_map::in, prog_var::in,
hlds_goal::in, hlds_goal::out,
var_table::in, var_table::out) is det.
insert_wait_in_goal_for_proc(ModuleInfo, AllowSomePathsOnly, FutureMap,
ConsumedVar, !Goal, !VarTable) :-
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly, FutureMap,
ConsumedVar, WaitedOnAllSuccessPaths, !Goal, !VarTable),
% If we did not wait on all success paths, then we must insert a wait here.
% This preserves the invariant that a procedure is called with a future
% that it should wait on, it will actually wait on it in all cases.
% This way, any future_get calls after such a call are safe.
(
WaitedOnAllSuccessPaths = waited_on_all_success_paths
;
WaitedOnAllSuccessPaths = not_waited_on_all_success_paths,
insert_wait_after_goal(ModuleInfo, !.VarTable, FutureMap,
ConsumedVar, !Goal)
).
%---------------------------------------------------------------------------%
:- type waited_on_all_success_paths
---> waited_on_all_success_paths
; not_waited_on_all_success_paths.
:- pred join_branches(waited_on_all_success_paths::in,
waited_on_all_success_paths::in, waited_on_all_success_paths::out) is det.
join_branches(WaitedA, WaitedB, Waited) :-
( if
WaitedA = waited_on_all_success_paths,
WaitedB = waited_on_all_success_paths
then
Waited = waited_on_all_success_paths
else
Waited = not_waited_on_all_success_paths
).
% insert_wait_in_goal(ModuleInfo, FutureMap, ConsumedVar, Goal0, Goal,
% !VarTable):
%
% Insert a wait on the future version of ConsumedVar *just before*
% the first reference to it inside Goal0. If there is no reference to
% ConsumedVar inside Goal0, then insert a wait for ConsumedVar at the
% end of Goal0 (unless Goal0 cannot succeed, in which case the wait
% would never be reached.
%
% Call this predicate if either (a) Goal0 consumes ConsumedVar, or (b)
% some other goal that Goal0 is parallel to consumes ConsumedVar.
% (We must ensure that if one branch of a branched goal inserts a wait
% for a variable, then *all* branches of that goal insert a wait.)
%
:- pred insert_wait_in_goal(module_info::in,
maybe_allow_some_paths_only_waits::in, future_map::in,
prog_var::in, waited_on_all_success_paths::out,
hlds_goal::in, hlds_goal::out, var_table::in, var_table::out) is det.
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly, FutureMap, ConsumedVar,
WaitedOnAllSuccessPaths, Goal0, Goal, !VarTable) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
% InvariantEstablished should be true if AllowSomePathsOnly = no
% implies WaitedOnAllSuccessPaths0 = waited_on_all_success_paths.
( if var_in_nonlocals(Goal0, ConsumedVar) then
(
GoalExpr0 = conj(ConjType, Goals0),
InvariantEstablished = yes,
(
ConjType = plain_conj,
insert_wait_in_plain_conj(ModuleInfo, AllowSomePathsOnly,
FutureMap, ConsumedVar, WaitedOnAllSuccessPaths0,
Goals0, Goals, !VarTable)
;
ConjType = parallel_conj,
insert_wait_in_par_conj(ModuleInfo, AllowSomePathsOnly,
FutureMap, ConsumedVar,
have_not_waited_in_conjunct, WaitedInConjunct,
Goals0, Goals, !VarTable),
(
WaitedInConjunct = have_not_waited_in_conjunct,
WaitedOnAllSuccessPaths0 = not_waited_on_all_success_paths
;
WaitedInConjunct =
waited_in_conjunct(WaitedOnAllSuccessPaths0)
)
),
GoalExpr = conj(ConjType, Goals),
Goal1 = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = disj(Disjuncts0),
InvariantEstablished = yes,
(
Disjuncts0 = [],
% This path ends in failure.
WaitedOnAllSuccessPaths0 = waited_on_all_success_paths,
Goal1 = Goal0
;
Disjuncts0 = [FirstDisjunct0 | LaterDisjuncts0],
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly,
FutureMap, ConsumedVar,
FirstWaitedOnAllSuccessPaths,
FirstDisjunct0, FirstDisjunct, !VarTable),
insert_wait_in_disj(ModuleInfo, AllowSomePathsOnly,
FutureMap, ConsumedVar,
FirstWaitedOnAllSuccessPaths, WaitedOnAllSuccessPaths0,
LaterDisjuncts0, LaterDisjuncts, !VarTable),
Disjuncts = [FirstDisjunct | LaterDisjuncts],
GoalExpr = disj(Disjuncts),
Goal1 = hlds_goal(GoalExpr, GoalInfo0)
)
;
GoalExpr0 = switch(SwitchVar, CanFail, Cases0),
InvariantEstablished = yes,
( if ConsumedVar = SwitchVar then
insert_wait_before_goal(ModuleInfo, !.VarTable, FutureMap,
ConsumedVar, Goal0, Goal1),
WaitedOnAllSuccessPaths0 = waited_on_all_success_paths
else
(
Cases0 = [],
unexpected($pred, "no cases")
;
Cases0 = [FirstCase0 | LaterCases0],
FirstCase0 = case(MainConsId, OtherConsIds, FirstGoal0),
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly,
FutureMap, ConsumedVar,
FirstWaitedOnAllSuccessPaths,
FirstGoal0, FirstGoal, !VarTable),
FirstCase = case(MainConsId, OtherConsIds, FirstGoal),
insert_wait_in_cases(ModuleInfo, AllowSomePathsOnly,
FutureMap, ConsumedVar,
FirstWaitedOnAllSuccessPaths, WaitedOnAllSuccessPaths0,
LaterCases0, LaterCases, !VarTable),
Cases = [FirstCase | LaterCases],
GoalExpr = switch(SwitchVar, CanFail, Cases),
Goal1 = hlds_goal(GoalExpr, GoalInfo0)
)
)
;
GoalExpr0 = if_then_else(Quant, Cond, Then0, Else0),
InvariantEstablished = yes,
( if var_in_nonlocals(Cond, ConsumedVar) then
% XXX We could try to wait for the shared variable only when
% the condition needs it. This would require also waiting
% for the shared variable somewhere in the else branch.
% However, the compiler requires that the conditions of
% if-then-elses bind no variable that is accessible from
% anywhere except the condition and the then-part of that
% if-then-else, so we would have to do tricks like renaming
% the variable waited-for by the condition, and then assigning
% the renamed variable to its original name in the then-part.
WaitedOnAllSuccessPaths0 = waited_on_all_success_paths,
insert_wait_before_goal(ModuleInfo, !.VarTable, FutureMap,
ConsumedVar, Goal0, Goal1)
else
% If ConsumedVar is not in the nonlocals of Cond, then it
% must be in the nonlocals of at least one of Then0 and Else0.
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly,
FutureMap, ConsumedVar,
ThenWaitedOnAllSuccessPaths,
Then0, Then, !VarTable),
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly,
FutureMap, ConsumedVar,
ElseWaitedOnAllSuccessPaths,
Else0, Else, !VarTable),
join_branches(ThenWaitedOnAllSuccessPaths,
ElseWaitedOnAllSuccessPaths, WaitedOnAllSuccessPaths0),
GoalExpr = if_then_else(Quant, Cond, Then, Else),
Goal1 = hlds_goal(GoalExpr, GoalInfo0)
)
;
GoalExpr0 = scope(Reason, SubGoal0),
InvariantEstablished = yes,
( if Reason = from_ground_term(_, from_ground_term_construct) then
% These scopes do not consume anything.
unexpected($pred, "from_ground_term_construct")
else
% XXX If Reason = from_ground_term(X,
% from_ground_term_deconstruct), then the only variable
% that we can wait for is X. We should be able to use that fact
% to avoid processing SubGoal0.
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly,
FutureMap, ConsumedVar, WaitedOnAllSuccessPaths0,
SubGoal0, SubGoal, !VarTable),
GoalExpr = scope(Reason, SubGoal),
Goal1 = hlds_goal(GoalExpr, GoalInfo0)
)
;
GoalExpr0 = negation(_SubGoal0),
InvariantEstablished = yes,
% We treat the negated goal just as we treat the condition of
% an if-then-else.
WaitedOnAllSuccessPaths0 = waited_on_all_success_paths,
insert_wait_before_goal(ModuleInfo, !.VarTable, FutureMap,
ConsumedVar, Goal0, Goal1)
;
( GoalExpr0 = unify(_, _, _, _, _)
; GoalExpr0 = plain_call(_, _, _, _, _, _)
; GoalExpr0 = generic_call(_, _, _, _, _)
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
),
InvariantEstablished = no,
WaitedOnAllSuccessPaths0 = waited_on_all_success_paths,
insert_wait_before_goal(ModuleInfo, !.VarTable, FutureMap,
ConsumedVar, Goal0, Goal1)
;
GoalExpr0 = shorthand(_),
unexpected($pred, "shorthand")
),
(
WaitedOnAllSuccessPaths0 = waited_on_all_success_paths,
Goal2 = Goal1
;
WaitedOnAllSuccessPaths0 = not_waited_on_all_success_paths,
% Some code in this goal may wait on ConsumedVar, and some code
% in later conjoined goals may wait on ConsumedVar. We must
% therefore ensure that the wait operations instantiate different
% variables. We do so by renaming any occurrences of ConsumedVar
% in this goal.
% so we shouldn't update the argument of waited_in_conjunct.
clone_variable(ConsumedVar, !.VarTable, !VarTable,
map.init, Renaming, _CloneVar),
rename_some_vars_in_goal(Renaming, Goal1, Goal2)
)
else
InvariantEstablished = no,
WaitedOnAllSuccessPaths0 = not_waited_on_all_success_paths,
Goal2 = Goal0
),
Detism = goal_info_get_determinism(GoalInfo0),
determinism_components(Detism, _, MaxSolns),
(
MaxSolns = at_most_zero,
WaitedOnAllSuccessPaths = waited_on_all_success_paths,
Goal = Goal2
;
( MaxSolns = at_most_one
; MaxSolns = at_most_many
; MaxSolns = at_most_many_cc
),
(
WaitedOnAllSuccessPaths0 = waited_on_all_success_paths,
WaitedOnAllSuccessPaths = WaitedOnAllSuccessPaths0,
Goal = Goal2
;
WaitedOnAllSuccessPaths0 = not_waited_on_all_success_paths,
(
AllowSomePathsOnly = allow_some_paths_only_waits,
WaitedOnAllSuccessPaths = WaitedOnAllSuccessPaths0,
Goal = Goal2
;
AllowSomePathsOnly = do_not_allow_some_paths_only_waits,
(
InvariantEstablished = no,
WaitedOnAllSuccessPaths = waited_on_all_success_paths,
insert_wait_after_goal(ModuleInfo, !.VarTable, FutureMap,
ConsumedVar, Goal2, Goal)
;
InvariantEstablished = yes,
unexpected($pred,
"not_waited_on_all_success_paths invariant violation")
)
)
)
).
:- pred insert_wait_before_goal(module_info::in, var_table::in, future_map::in,
prog_var::in, hlds_goal::in, hlds_goal::out) is det.
insert_wait_before_goal(ModuleInfo, VarTable, FutureMap, ConsumedVar,
Goal0, Goal) :-
map.lookup(FutureMap, ConsumedVar, FutureVar),
make_wait_goal(ModuleInfo, VarTable, FutureVar, ConsumedVar, WaitGoal),
conjoin_goals_update_goal_infos(Goal0 ^ hg_info, WaitGoal, Goal0, Goal).
:- pred insert_wait_after_goal(module_info::in, var_table::in, future_map::in,
prog_var::in, hlds_goal::in, hlds_goal::out) is det.
insert_wait_after_goal(ModuleInfo, VarTable, FutureMap, ConsumedVar,
Goal0, Goal) :-
map.lookup(FutureMap, ConsumedVar, FutureVar),
make_wait_goal(ModuleInfo, VarTable, FutureVar, ConsumedVar, WaitGoal),
conjoin_goals_update_goal_infos(Goal0 ^ hg_info, Goal0, WaitGoal, Goal).
% Insert a wait for ConsumedVar in the first goal in the conjunction
% that references it. Any later conjuncts will get the waited-for variable
% without having to call wait.
%
:- pred insert_wait_in_plain_conj(module_info::in,
maybe_allow_some_paths_only_waits::in, future_map::in,
prog_var::in, waited_on_all_success_paths::out,
list(hlds_goal)::in, list(hlds_goal)::out,
var_table::in, var_table::out) is det.
insert_wait_in_plain_conj(_, _, _, _,
not_waited_on_all_success_paths, [], [], !VarTable).
insert_wait_in_plain_conj(ModuleInfo, AllowSomePathsOnly, FutureMap,
ConsumedVar, WaitedOnAllSuccessPaths,
[FirstGoal0 | LaterGoals0], Goals, !VarTable) :-
( if var_in_nonlocals(FirstGoal0, ConsumedVar) then
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly,
FutureMap, ConsumedVar, GoalWaitedOnAllSuccessPaths,
FirstGoal0, FirstGoal, !VarTable),
(
GoalWaitedOnAllSuccessPaths = waited_on_all_success_paths,
% We wait for ConsumedVar on all paths in FirstGoal that can lead
% to LaterGoals0, so the code in LaterGoals0 will be able to
% access ConsumedVar without any further waiting.
WaitedOnAllSuccessPaths = waited_on_all_success_paths,
LaterGoals = LaterGoals0
;
GoalWaitedOnAllSuccessPaths = not_waited_on_all_success_paths,
% We waited for ConsumedVar on some but not all paths in FirstGoal
% that can lead to LaterGoals0. LaterGoals may therefore also wait
% for ConsumedVar, and any such waits will also bind ConsumedVar.
% We do not want both FirstGoal and LaterGoals binding ConsumedVar,
% so the call to insert_wait_in_goal above has replaced all
% occurrences of ConsumedVar in FirstGoal0 with a fresh variable.
insert_wait_in_plain_conj(ModuleInfo, AllowSomePathsOnly,
FutureMap, ConsumedVar, WaitedOnAllSuccessPaths,
LaterGoals0, LaterGoals, !VarTable)
),
( if FirstGoal ^ hg_expr = conj(plain_conj, FirstGoalConj) then
Goals = FirstGoalConj ++ LaterGoals
else
Goals = [FirstGoal | LaterGoals]
)
else
% ConsumedVar does not appear in FirstGoal0, so wait for it
% in LaterGoals0.
insert_wait_in_plain_conj(ModuleInfo, AllowSomePathsOnly, FutureMap,
ConsumedVar, WaitedOnAllSuccessPaths, LaterGoals0, LaterGoals1,
!VarTable),
Goals = [FirstGoal0 | LaterGoals1]
).
% Have we inserted waits into any one of the parallel conjuncts yet?
% If yes, say whether the first such conjunct (the one in which we
% do *not* rename the waited for instance of ConsumedVar) waits for
% ConsumedVar on all success paths.
%
:- type waited_in_conjunct
---> waited_in_conjunct(waited_on_all_success_paths)
; have_not_waited_in_conjunct.
% Insert a wait for ConsumedVar in the *every* goal in the conjunction
% that references it. "Later" conjuncts cannot get the variable that
% "earlier" conjuncts waited for, since those waits may not have finished
% yet.
%
:- pred insert_wait_in_par_conj(module_info::in,
maybe_allow_some_paths_only_waits::in, future_map::in, prog_var::in,
waited_in_conjunct::in, waited_in_conjunct::out,
list(hlds_goal)::in, list(hlds_goal)::out,
var_table::in, var_table::out) is det.
insert_wait_in_par_conj(_, _, _, _, !WaitedInConjunct, [], [], !VarTable).
insert_wait_in_par_conj(ModuleInfo, AllowSomePathsOnly, FutureMap, ConsumedVar,
!WaitedInConjunct, [Goal0 | Goals0], [Goal | Goals], !VarTable) :-
( if var_in_nonlocals(Goal0, ConsumedVar) then
% ConsumedVar appears in Goal0, so wait for it in Goal0, but the code
% in Goals0 will *not* be able to access ConsumedVar without waiting,
% since the conjuncts are executed independently.
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly, FutureMap,
ConsumedVar, WaitedOnAllSuccessPaths, Goal0, Goal1, !VarTable),
(
!.WaitedInConjunct = have_not_waited_in_conjunct,
!:WaitedInConjunct = waited_in_conjunct(WaitedOnAllSuccessPaths),
Goal = Goal1
;
!.WaitedInConjunct = waited_in_conjunct(_),
% This is not the first conjunct that waits for ConsumedVar,
% so we shouldn't update the argument of waited_in_conjunct.
clone_variable(ConsumedVar, !.VarTable, !VarTable,
map.init, Renaming, _CloneVar),
rename_some_vars_in_goal(Renaming, Goal1, Goal)
)
else
Goal = Goal0
),
insert_wait_in_par_conj(ModuleInfo, AllowSomePathsOnly, FutureMap,
ConsumedVar, !WaitedInConjunct, Goals0, Goals, !VarTable).
:- pred insert_wait_in_disj(module_info::in,
maybe_allow_some_paths_only_waits::in, future_map::in, prog_var::in,
waited_on_all_success_paths::in, waited_on_all_success_paths::out,
list(hlds_goal)::in, list(hlds_goal)::out,
var_table::in, var_table::out) is det.
insert_wait_in_disj(_, _, _, _, !WaitedOnAllSuccessPaths, [], [], !VarTable).
insert_wait_in_disj(ModuleInfo, AllowSomePathsOnly, FutureMap, ConsumedVar,
!WaitedOnAllSuccessPaths, [Goal0 | Goals0], [Goal | Goals],
!VarTable) :-
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly, FutureMap, ConsumedVar,
FirstWaitedOnAllSuccessPaths,
Goal0, Goal, !VarTable),
join_branches(FirstWaitedOnAllSuccessPaths, !WaitedOnAllSuccessPaths),
insert_wait_in_disj(ModuleInfo, AllowSomePathsOnly, FutureMap, ConsumedVar,
!WaitedOnAllSuccessPaths, Goals0, Goals, !VarTable).
:- pred insert_wait_in_cases(module_info::in,
maybe_allow_some_paths_only_waits::in, future_map::in, prog_var::in,
waited_on_all_success_paths::in, waited_on_all_success_paths::out,
list(case)::in, list(case)::out, var_table::in, var_table::out) is det.
insert_wait_in_cases(_, _, _, _, !WaitedOnAllSuccessPaths, [], [], !VarTable).
insert_wait_in_cases(ModuleInfo, AllowSomePathsOnly, FutureMap, ConsumedVar,
!WaitedOnAllSuccessPaths, [Case0 | Cases0], [Case | Cases],
!VarTable) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
insert_wait_in_goal(ModuleInfo, AllowSomePathsOnly, FutureMap, ConsumedVar,
FirstWaitedOnAllSuccessPaths, Goal0, Goal, !VarTable),
Case = case(MainConsId, OtherConsIds, Goal),
join_branches(FirstWaitedOnAllSuccessPaths, !WaitedOnAllSuccessPaths),
insert_wait_in_cases(ModuleInfo, AllowSomePathsOnly, FutureMap,
ConsumedVar, !WaitedOnAllSuccessPaths, Cases0, Cases, !VarTable).
%---------------------------------------------------------------------------%
% Look for the first instance of the produced variable down every
% branch. The first goal referring to the variable must produce it,
% so insert a signal call right after that goal.
%
% XXX This assumption won't *necessarily* be correct after we start
% supporting partially instantiated data structures. The first occurrence
% of ProducedVar may instantiate it partially, with a second or later
% occurrence instantiating it to ground. We want to execute the signal
% only when ProducedVar is ground.
%
:- pred insert_signal_in_goal(module_info::in, future_map::in, prog_var::in,
hlds_goal::in, hlds_goal::out, var_table::in, var_table::out) is det.
insert_signal_in_goal(ModuleInfo, FutureMap, ProducedVar,
Goal0, Goal, !VarTable) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
Detism = goal_info_get_determinism(GoalInfo0),
determinism_components(Detism, _CanFail, NumSolutions),
(
( NumSolutions = at_most_one
; NumSolutions = at_most_many_cc
; NumSolutions = at_most_many
),
( if var_in_nonlocals(Goal0, ProducedVar) then
(
GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
insert_signal_in_plain_conj(ModuleInfo, FutureMap,
ProducedVar, Goals0, Goals, !VarTable)
;
ConjType = parallel_conj,
insert_signal_in_par_conj(ModuleInfo, FutureMap,
ProducedVar, Goals0, Goals, !VarTable)
),
GoalExpr = conj(ConjType, Goals),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = disj(Goals0),
insert_signal_in_disj(ModuleInfo, FutureMap, ProducedVar,
Goals0, Goals, !VarTable),
GoalExpr = disj(Goals),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = switch(SwitchVar, CanFail, Cases0),
( if ProducedVar = SwitchVar then
unexpected($pred, "switch on unbound shared variable")
else
insert_signal_in_cases(ModuleInfo, FutureMap, ProducedVar,
Cases0, Cases, !VarTable),
GoalExpr = switch(SwitchVar, CanFail, Cases),
Goal = hlds_goal(GoalExpr, GoalInfo0)
)
;
GoalExpr0 = if_then_else(QuantVars, Cond, Then0, Else0),
expect(var_not_in_nonlocals(Cond, ProducedVar), $pred,
"condition binds shared variable"),
insert_signal_in_goal(ModuleInfo, FutureMap, ProducedVar,
Then0, Then, !VarTable),
insert_signal_in_goal(ModuleInfo, FutureMap, ProducedVar,
Else0, Else, !VarTable),
GoalExpr = if_then_else(QuantVars, Cond, Then, Else),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = negation(_),
unexpected($pred, "negation binds shared variable")
;
GoalExpr0 = scope(Reason, SubGoal0),
( if
Reason = from_ground_term(_, from_ground_term_construct)
then
% Pushing the signal into the scope would invalidate the
% invariant that from_ground_term_construct scopes do
% nothing except construct a ground term. It would also be
% pointless, since the code generator will turn the entire
% scope into a single assignment statement. We therefore
% put he signal *after* the scope.
insert_signal_after_goal(ModuleInfo, !.VarTable, FutureMap,
ProducedVar, Goal0, Goal)
else
SubGoal0 = hlds_goal(_, SubGoalInfo0),
Detism0 = goal_info_get_determinism(GoalInfo0),
SubDetism0 = goal_info_get_determinism(SubGoalInfo0),
determinism_components(Detism0, _, MaxSolns0),
determinism_components(SubDetism0, _, SubMaxSolns0),
( if
SubMaxSolns0 = at_most_many,
MaxSolns0 \= at_most_many
then
% The value of ProducedVar is not stable inside
% SubGoal0, i.e. SubGoal0 can generate a value for
% ProducedVar and then backtrack over the goal that
% generated it. In such cases, we can signal the
% availability of ProducedVar only when it has become
% stable, which is when the scope has cut away any
% possibility of further backtracking inside SubGoal0.
insert_signal_after_goal(ModuleInfo, !.VarTable,
FutureMap, ProducedVar, Goal0, Goal)
else
insert_signal_in_goal(ModuleInfo, FutureMap,
ProducedVar, SubGoal0, SubGoal, !VarTable),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
)
)
;
( GoalExpr0 = unify(_, _, _, _, _)
; GoalExpr0 = plain_call(_, _, _, _, _, _)
; GoalExpr0 = generic_call(_, _, _, _, _)
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
),
insert_signal_after_goal(ModuleInfo, !.VarTable, FutureMap,
ProducedVar, Goal0, Goal)
;
GoalExpr0 = shorthand(_),
unexpected($pred, "shorthand")
)
else
% We expected this goal to produce the variable that
% we are looking for.
unexpected($pred, "ProducedVar is not in nonlocals")
)
;
NumSolutions = at_most_zero,
% We don't bother pushing signals into code that has no solutions.
% Note that we can't call unexpected here since we could be trying to
% push a signal into a procedure during specialisation. We must fail
% gracefully.
Goal = Goal0
).
:- pred insert_signal_after_goal(module_info::in, var_table::in,
future_map::in, prog_var::in, hlds_goal::in, hlds_goal::out) is det.
insert_signal_after_goal(ModuleInfo, VarTable, FutureMap, ProducedVar,
Goal0, Goal) :-
make_signal_goal(ModuleInfo, VarTable, FutureMap, ProducedVar,
SignalGoal),
conjoin_goals_update_goal_infos(Goal0 ^ hg_info, Goal0, SignalGoal, Goal).
:- pred insert_signal_in_plain_conj(module_info::in, future_map::in,
prog_var::in, list(hlds_goal)::in, list(hlds_goal)::out,
var_table::in, var_table::out) is det.
insert_signal_in_plain_conj(_ModuleInfo, _FutureMap, _ProducedVar,
[], [], !VarTable).
insert_signal_in_plain_conj(ModuleInfo, FutureMap, ProducedVar,
[Goal0 | Goals0], Goals, !VarTable) :-
( if var_in_nonlocals(Goal0, ProducedVar) then
% The first conjunct that mentions ProducedVar should bind ProducedVar.
% Since we don't recurse in this case, we get here only for the first
% conjunct.
Goal0 = hlds_goal(_, GoalInfo0),
InstMapDelta = goal_info_get_instmap_delta(GoalInfo0),
instmap_delta_changed_vars(InstMapDelta, ChangedVars),
expect(set_of_var.contains(ChangedVars, ProducedVar), $pred,
"ProducedVar not in ChangedVars"),
insert_signal_in_goal(ModuleInfo, FutureMap, ProducedVar,
Goal0, Goal1, !VarTable),
( if Goal1 ^ hg_expr = conj(plain_conj, GoalConjs1) then
Goals = GoalConjs1 ++ Goals0
else
Goals = [Goal1 | Goals0]
)
else
insert_signal_in_plain_conj(ModuleInfo, FutureMap, ProducedVar,
Goals0, Goals1, !VarTable),
Goals = [Goal0 | Goals1]
).
:- pred insert_signal_in_par_conj(module_info::in, future_map::in,
prog_var::in, list(hlds_goal)::in, list(hlds_goal)::out,
var_table::in, var_table::out) is det.
insert_signal_in_par_conj(_ModuleInfo, _FutureMap, _ProducedVar,
[], [], !VarTable).
insert_signal_in_par_conj(ModuleInfo, FutureMap, ProducedVar,
[Goal0 | Goals0], [Goal | Goals], !VarTable) :-
( if var_in_nonlocals(Goal0, ProducedVar) then
% The first conjunct that mentions ProducedVar should bind ProducedVar.
% Since we don't recurse in this case, we get here only for the first
% conjunct.
Goal0 = hlds_goal(_, GoalInfo0),
InstMapDelta = goal_info_get_instmap_delta(GoalInfo0),
instmap_delta_changed_vars(InstMapDelta, ChangedVars),
expect(set_of_var.contains(ChangedVars, ProducedVar), $pred,
"ProducedVar not in ChangedVars"),
insert_signal_in_goal(ModuleInfo, FutureMap, ProducedVar,
Goal0, Goal, !VarTable),
Goals = Goals0
else
Goal = Goal0,
insert_signal_in_par_conj(ModuleInfo, FutureMap, ProducedVar,
Goals0, Goals, !VarTable)
).
:- pred insert_signal_in_disj(module_info::in, future_map::in, prog_var::in,
list(hlds_goal)::in, list(hlds_goal)::out,
var_table::in, var_table::out) is det.
insert_signal_in_disj(_ModuleInfo, _FutureMap, _ProducedVar,
[], [], !VarTable).
insert_signal_in_disj(ModuleInfo, FutureMap, ProducedVar,
[Goal0 | Goals0], [Goal | Goals], !VarTable) :-
insert_signal_in_goal(ModuleInfo, FutureMap, ProducedVar,
Goal0, Goal, !VarTable),
insert_signal_in_disj(ModuleInfo, FutureMap, ProducedVar,
Goals0, Goals, !VarTable).
:- pred insert_signal_in_cases(module_info::in, future_map::in, prog_var::in,
list(case)::in, list(case)::out, var_table::in, var_table::out) is det.
insert_signal_in_cases(_ModuleInfo, _FutureMap, _ProducedVar,
[], [], !VarTable).
insert_signal_in_cases(ModuleInfo, FutureMap, ProducedVar,
[Case0 | Cases0], [Case | Cases], !VarTable) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
insert_signal_in_goal(ModuleInfo, FutureMap, ProducedVar,
Goal0, Goal, !VarTable),
Case = case(MainConsId, OtherConsIds, Goal),
insert_signal_in_cases(ModuleInfo, FutureMap, ProducedVar,
Cases0, Cases, !VarTable).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%
% The independent parallel conjunction re-ordering transformation.
%
:- pred reorder_indep_par_conj(pred_proc_id::in, var_table::in, instmap::in,
list(hlds_goal)::in, hlds_goal_info::in, hlds_goal::out,
module_info::in, module_info::out) is det.
reorder_indep_par_conj(PredProcId, VarTable, InstMapBefore, Conjuncts0,
GoalInfo, Goal, !ModuleInfo) :-
module_info_dependency_info(!.ModuleInfo, DependencyInfo),
Ordering = dependency_info_get_bottom_up_sccs(DependencyInfo),
find_procs_scc(Ordering, PredProcId, SCC),
CallsToSameSCC = goal_list_calls_proc_in_set(Conjuncts0, SCC),
( if set.is_empty(CallsToSameSCC) then
% The conjunction doesn't contain a recursive or mutually-recursive
% call, so this optimisation does not apply.
Conjuncts = Conjuncts0
else
reorder_indep_par_conj_2(SCC, VarTable, InstMapBefore, Conjuncts0,
Conjuncts, !ModuleInfo)
),
GoalExpr = conj(parallel_conj, Conjuncts),
Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred reorder_indep_par_conj_2(scc::in, var_table::in, instmap::in,
list(hlds_goal)::in, list(hlds_goal)::out,
module_info::in, module_info::out) is det.
reorder_indep_par_conj_2(_, _, _, [], [], !ModuleInfo).
reorder_indep_par_conj_2(SCC, VarTable, InstMapBefore, [Goal | Goals0],
Goals, !ModuleInfo) :-
apply_instmap_delta(goal_info_get_instmap_delta(Goal ^ hg_info),
InstMapBefore, InstMapBeforeGoals0),
reorder_indep_par_conj_2(SCC, VarTable, InstMapBeforeGoals0, Goals0,
Goals1, !ModuleInfo),
% These instmaps are equal since they both still apply Goal's instmap
% delta.
InstMapBeforeGoals1 = InstMapBeforeGoals0,
% If Goal is non recursive, try to push it down into the conjunction.
( if
set.member(CallPredProcId, SCC),
goal_calls(Goal, CallPredProcId)
then
% Goal is recursive.
Goals = [Goal | Goals1]
else
% Goal is non-recursive.
push_goal_into_conj(VarTable, InstMapBefore, Goal, InstMapBeforeGoals1,
Goals1, MaybeGoals, !ModuleInfo),
(
MaybeGoals = yes(Goals)
;
MaybeGoals = no,
Goals = [Goal | Goals1]
)
).
:- pred push_goal_into_conj(var_table::in, instmap::in, hlds_goal::in,
instmap::in, list(hlds_goal)::in, maybe(list(hlds_goal))::out,
module_info::in, module_info::out) is det.
push_goal_into_conj(_, _, Goal, _, [], yes([Goal]), !ModuleInfo).
push_goal_into_conj(VarTable, InstMapBeforeGoal, Goal, InstMapBeforePivotGoal,
[PivotGoal | Goals0], MaybeGoals, !ModuleInfo) :-
module_info_get_globals(!.ModuleInfo, Globals),
lookup_bool_option(Globals, fully_strict, FullyStrict),
can_reorder_goals(VarTable, FullyStrict,
InstMapBeforeGoal, Goal, InstMapBeforePivotGoal, PivotGoal,
CanReorderGoals, !ModuleInfo),
(
CanReorderGoals = can_reorder_goals,
% InstMapBeforeGoalAfterPivot represents the inst map before Goal given
% that it has already been swapped with PivotGoal, that is PivotGoal
% occurs before Goal.
PivotInstMapDelta = goal_info_get_instmap_delta(PivotGoal ^ hg_info),
apply_instmap_delta(PivotInstMapDelta,
InstMapBeforeGoal, InstMapBeforeGoalAfterPivot),
GoalInstMapDelta = goal_info_get_instmap_delta(Goal ^ hg_info),
apply_instmap_delta(GoalInstMapDelta,
InstMapBeforeGoalAfterPivot, InstMapAfterPivotAndGoal),
push_goal_into_conj(VarTable, InstMapBeforeGoalAfterPivot, Goal,
InstMapAfterPivotAndGoal, Goals0, MaybeGoals1, !ModuleInfo),
(
MaybeGoals1 = yes(Goals1),
Goals = [PivotGoal | Goals1]
;
MaybeGoals1 = no,
Goals = [Goal, PivotGoal | Goals0]
),
MaybeGoals = yes(Goals)
;
CanReorderGoals = cannot_reorder_goals,
MaybeGoals = no
).
:- pred find_procs_scc(list(scc)::in, pred_proc_id::in, scc::out) is det.
find_procs_scc([], _PredProcId, _) :-
unexpected($pred, "Couldn't find SCC for pred/proc id.").
find_procs_scc([SCC | SCCs], PredProcId, PredProcsSCC) :-
( if set.member(PredProcId, SCC) then
PredProcsSCC = SCC
else
find_procs_scc(SCCs, PredProcId, PredProcsSCC)
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%
% The specialization transformation.
%
% This type holds information relevant to the specialization
% transformation.
%
:- type spec_info
---> spec_info(
% The set of parallelised procedures that we have already
% created. This field is constant: it should never be updated.
% (The set of done procs is updated only between the lifetimes
% of values of this type.)
spec_done_procs :: done_par_procs,
spec_rev_proc_map :: rev_proc_map,
% The version of the module before dep_par_conj.m started
% modifying it. This field is constant; it should never be
% updated.
spec_initial_module :: module_info,
% The procedure that's currently being scanned.
spec_ppid :: pred_proc_id,
% The variable types of the procedure we are scanning.
% This field is constant; it should never be updated.
spec_var_table :: var_table,
% The current module. Updated when requesting a new
% specialization, since to get the pred_id for the specialized
% predicate we need to update the module_info.
spec_module_info :: module_info,
% Parallelised procedures waiting to be added. Updated when
% requesting a new specialization.
spec_pending_procs :: pending_par_procs,
spec_pushability :: pushable_args_map
).
% Parallelised procedures that have been added to the module already.
% The calling pattern is the original pred_proc_id of the procedure
% being called, plus the list of arguments which have been replaced
% by futures.
%
:- type done_par_procs == map(par_proc_call_pattern, new_par_proc).
% A map from specialised pred proc ids back to the pred proc id of the
% procedure that they are based on.
%
:- type rev_proc_map == map(pred_proc_id, pred_proc_id).
% Parallelised procedures that are scheduled to be added.
% One or more procedures in the module will already be making calls
% to the scheduled procedure.
%
:- type pending_par_procs == assoc_list(par_proc_call_pattern, new_par_proc).
:- type par_proc_call_pattern
---> par_proc_call_pattern(
old_ppid :: pred_proc_id,
future_args :: list(arg_pos)
).
:- type new_par_proc
---> new_par_proc(
new_ppid :: pred_proc_id,
new_name :: sym_name
).
:- type arg_pos == int.
% For each procedure we have looked at pushing wait and/or signal
% operations into to create a specialized version, record which arguments
% we know are worth pushing into the procedure, and which we know are *not*
% worth pushing into the procedure (because the input is needed
% immediately, or because an output is generated only at the very end).
%
% If a procedure does not appear in this map, it means it has not been
% looked at before.
%
:- type pushable_args_map == map(pred_proc_id, proc_pushable_args_map).
% If an argument position does not appear in this map, it means no call
% has tried to push that argument before, and therefore we don't yet know
% whether it is worth pushing.
%
:- type proc_pushable_args_map == map(arg_pos, maybe_worth_pushing).
:- type maybe_worth_pushing
---> worth_pushing
; not_worth_pushing.
% A map from a variable to the future object created for that variable.
% If it maps e.g. X to FutureX, then
%
% - after a producer binds X to a value, it will signal FutureX, and
% - before a consumer needs X, it will wait on FutureX.
%
:- type future_map == map(prog_var, prog_var).
%---------------------------------------------------------------------------%
:- pred find_specialization_requests_in_proc(done_par_procs::in,
module_info::in, pred_proc_id::in, module_info::in, module_info::out,
pending_par_procs::in, pending_par_procs::out,
pushable_args_map::in, pushable_args_map::out,
rev_proc_map::in, rev_proc_map::out) is det.
find_specialization_requests_in_proc(DoneProcs, InitialModuleInfo, PredProcId,
!ModuleInfo, !PendingParProcs, !Pushability, !RevProcMap) :-
PredProcId = proc(PredId, ProcId),
some [!PredInfo, !ProcInfo, !Goal, !SpecInfo] (
module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
!:PredInfo, !:ProcInfo),
proc_info_get_var_table(!.ProcInfo, VarTable),
proc_info_get_goal(!.ProcInfo, !:Goal),
!:SpecInfo = spec_info(DoneProcs, !.RevProcMap, InitialModuleInfo,
PredProcId, VarTable, !.ModuleInfo, !.PendingParProcs,
!.Pushability),
trace [compile_time(flag("debug-dep-par-conj")), io(!IO)] (
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_accumulating_option(Globals, debug_dep_par_conj,
DebugDepParConjWords),
PredIdInt = pred_id_to_int(PredId),
PredIdStr = string.int_to_string(PredIdInt),
( if
some [DebugDepParConjWord] (
list.member(DebugDepParConjWord, DebugDepParConjWords),
DebugDepParConjWord = PredIdStr
)
then
io.output_stream(Stream, !IO),
OutInfo = init_hlds_out_info(Globals, output_debug),
pred_info_get_typevarset(!.PredInfo, TVarSet),
proc_info_get_inst_varset(!.ProcInfo, InstVarSet),
io.format(Stream,
"About to search %d/%d for dependant par conjs:\n",
[i(PredIdInt), i(proc_id_to_int(ProcId))], !IO),
write_goal_nl(OutInfo, Stream, !.ModuleInfo,
vns_var_table(VarTable), print_name_and_num,
TVarSet, InstVarSet, 0u, "", !.Goal, !IO)
else
true
)
),
specialize_sequences_in_goal(!Goal, !SpecInfo),
!.SpecInfo = spec_info(_, !:RevProcMap, _, _, _,
!:ModuleInfo, !:PendingParProcs, !:Pushability),
proc_info_set_goal(!.Goal, !ProcInfo),
% Optimization opportunity: we should not fix up the same procedure
% twice, i.e. first in sync_dep_par_conjs_in_proc and then here.
fixup_and_reinsert_proc(PredId, ProcId, !.PredInfo, !.ProcInfo,
!ModuleInfo)
).
:- pred add_requested_specialized_par_procs(io.text_output_stream::in,
pending_par_procs::in, pushable_args_map::in, done_par_procs::in,
module_info::in, module_info::in, module_info::out,
rev_proc_map::in, rev_proc_map::out,
ts_string_table::in, ts_string_table::out) is det.
add_requested_specialized_par_procs(ProgressStream, !.PendingParProcs,
!.Pushability, !.DoneParProcs, InitialModuleInfo,
!ModuleInfo, !RevProcMap, !TSStringTable) :-
(
!.PendingParProcs = []
;
!.PendingParProcs = [CallPattern - NewProc | !:PendingParProcs],
% Move the procedure we are about to parallelise into the list of
% done procedures, in case of recursive calls.
map.det_insert(CallPattern, NewProc, !DoneParProcs),
add_requested_specialized_par_proc(ProgressStream, CallPattern,
NewProc, !PendingParProcs, !Pushability, !.DoneParProcs,
InitialModuleInfo, !ModuleInfo, !RevProcMap, !TSStringTable),
disable_warning [suspicious_recursion] (
add_requested_specialized_par_procs(ProgressStream,
!.PendingParProcs, !.Pushability, !.DoneParProcs,
InitialModuleInfo, !ModuleInfo, !RevProcMap, !TSStringTable)
)
).
:- pred add_requested_specialized_par_proc(io.text_output_stream::in,
par_proc_call_pattern::in, new_par_proc::in,
pending_par_procs::in, pending_par_procs::out,
pushable_args_map::in, pushable_args_map::out, done_par_procs::in,
module_info::in, module_info::in, module_info::out,
rev_proc_map::in, rev_proc_map::out,
ts_string_table::in, ts_string_table::out) is det.
add_requested_specialized_par_proc(ProgressStream, CallPattern, NewProc,
!PendingParProcs, !Pushability, DoneParProcs, InitialModuleInfo,
!ModuleInfo, !RevProcMap, !TSStringTable) :-
CallPattern = par_proc_call_pattern(OldPredProcId, FutureArgs),
NewProc = new_par_proc(NewPredProcId, _Name),
OldPredProcId = proc(OldPredId, OldProcId),
NewPredProcId = proc(NewPredId, NewProcId),
some [!VarTable, !NewProcInfo] (
% Get the proc_info from _before_ the dependent parallel conjunction
% pass was ever run, so we get untransformed procedure bodies.
% Our transformation does not attempt to handle already transformed
% parallel conjunctions.
module_info_proc_info(InitialModuleInfo, OldPredId, OldProcId,
!:NewProcInfo),
proc_info_get_var_table(!.NewProcInfo, !:VarTable),
proc_info_get_headvars(!.NewProcInfo, HeadVars0),
proc_info_get_argmodes(!.NewProcInfo, ArgModes0),
proc_info_get_goal(!.NewProcInfo, Goal0),
proc_info_get_initial_instmap(InitialModuleInfo, !.NewProcInfo,
InstMap0),
% Set up the mapping from head variables to futures.
list.foldl2(map_arg_to_new_future(HeadVars0), FutureArgs,
map.init, FutureMap, !VarTable),
% Replace head variables by their futures.
replace_head_vars(!.ModuleInfo, FutureMap,
HeadVars0, HeadVars, ArgModes0, ArgModes),
% Insert signals and waits into the procedure body. We treat the body
% as it were a conjunct of a parallel conjunction, since it is.
module_info_get_globals(InitialModuleInfo, Globals),
globals.get_opt_tuple(Globals, OptTuple),
AllowSomePathsOnly = OptTuple ^ ot_allow_some_paths_only_waits,
SharedVars = set_of_var.sorted_list_to_set(map.keys(FutureMap)),
sync_dep_par_proc_body(!.ModuleInfo, AllowSomePathsOnly, SharedVars,
FutureMap, InstMap0, Goal0, Goal, !VarTable),
proc_info_set_var_table(!.VarTable, !NewProcInfo),
proc_info_set_headvars(HeadVars, !NewProcInfo),
proc_info_set_argmodes(ArgModes, !NewProcInfo),
proc_info_set_goal(Goal, !NewProcInfo),
module_info_pred_info(!.ModuleInfo, NewPredId, NewPredInfo0),
% Mark this predicate impure if it no longer has any output arguments
% (having been replaced by a future, which is an input argument which
% is destructively updated).
( if any_output_arguments(!.ModuleInfo, ArgModes) then
NewPredInfo = NewPredInfo0
else
pred_info_get_markers(NewPredInfo0, Markers0),
add_marker(marker_is_impure, Markers0, Markers),
pred_info_set_markers(Markers, NewPredInfo0, NewPredInfo)
),
fixup_and_reinsert_proc(NewPredId, NewProcId, NewPredInfo,
!.NewProcInfo, !ModuleInfo),
% Look for and process any dependent parallel conjunctions inside
% the newly created (sort of; the previous version was only a
% placeholder) specialized procedure.
IgnoreVars = set_of_var.sorted_list_to_set(map.keys(FutureMap)),
sync_dep_par_conjs_in_proc(ProgressStream, NewPredId, NewProcId,
IgnoreVars, !ModuleInfo, [], _ProcsToScan, !TSStringTable),
find_specialization_requests_in_proc(DoneParProcs, InitialModuleInfo,
NewPredProcId, !ModuleInfo, !PendingParProcs, !Pushability,
!RevProcMap)
).
:- pred map_arg_to_new_future(list(prog_var)::in, arg_pos::in,
future_map::in, future_map::out, var_table::in, var_table::out) is det.
map_arg_to_new_future(HeadVars, FutureArg, !FutureMap, !VarTable) :-
HeadVar = list.det_index1(HeadVars, FutureArg),
lookup_var_entry(!.VarTable, HeadVar, HeadVarEntry),
HeadVarType = HeadVarEntry ^ vte_type,
HeadVarName = var_entry_name(HeadVar, HeadVarEntry),
make_future_var(HeadVarName, HeadVarType, FutureVar, _FutureVarType,
!VarTable),
map.det_insert(HeadVar, FutureVar, !FutureMap).
:- pred replace_head_vars(module_info::in, future_map::in,
list(prog_var)::in, list(prog_var)::out,
list(mer_mode)::in, list(mer_mode)::out) is det.
replace_head_vars(_ModuleInfo, _FutureMap, [], [], [], []).
replace_head_vars(_, _, [_ | _], _, [], _) :-
unexpected($pred, "length mismatch").
replace_head_vars(_, _, [], _, [_ | _], _) :-
unexpected($pred, "length mismatch").
replace_head_vars(ModuleInfo, FutureMap,
[Var0 | Vars0], [Var | Vars], [Mode0 | Modes0], [Mode | Modes]) :-
( if map.search(FutureMap, Var0, FutureVar) then
Var = FutureVar,
( if mode_is_input(ModuleInfo, Mode0) then
Mode = Mode0
else if mode_is_output(ModuleInfo, Mode0) then
Ground = ground(shared, none_or_default_func),
Mode = from_to_mode(Ground, Ground)
else
sorry($pred,
"the dependent parallel conjunction transformation " ++
"only understands input and output modes")
)
else
Var = Var0,
Mode = Mode0
),
replace_head_vars(ModuleInfo, FutureMap, Vars0, Vars, Modes0, Modes).
:- pred any_output_arguments(module_info::in, list(mer_mode)::in) is semidet.
any_output_arguments(ModuleInfo, [Mode | Modes]) :-
( mode_is_output(ModuleInfo, Mode)
; any_output_arguments(ModuleInfo, Modes)
).
%---------------------------------------------------------------------------%
% Replace contiguous sequences of waits, a call to P, then signals by a
% call to a parallelised procedure P'. Queue P' to be created later,
% if it has not been created already.
%
:- pred specialize_sequences_in_goal(hlds_goal::in, hlds_goal::out,
spec_info::in, spec_info::out) is det.
specialize_sequences_in_goal(Goal0, Goal, !SpecInfo) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
(
GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
NonLocals = goal_get_nonlocals(Goal0),
specialize_sequences_in_conj(Goals0, Goals, NonLocals, !SpecInfo),
conj_list_to_goal(Goals, GoalInfo0, Goal)
;
ConjType = parallel_conj,
specialize_sequences_in_goals(Goals0, Goals, !SpecInfo),
GoalExpr = conj(ConjType, Goals),
Goal = hlds_goal(GoalExpr, GoalInfo0)
)
;
GoalExpr0 = disj(Goals0),
specialize_sequences_in_goals(Goals0, Goals, !SpecInfo),
GoalExpr = disj(Goals),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = switch(SwitchVar, CanFail, Cases0),
specialize_sequences_in_cases(Cases0, Cases, !SpecInfo),
GoalExpr = switch(SwitchVar, CanFail, Cases),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = if_then_else(Quant, Cond0, Then0, Else0),
specialize_sequences_in_goal(Cond0, Cond, !SpecInfo),
specialize_sequences_in_goal(Then0, Then, !SpecInfo),
specialize_sequences_in_goal(Else0, Else, !SpecInfo),
GoalExpr = if_then_else(Quant, Cond, Then, Else),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = negation(SubGoal0),
specialize_sequences_in_goal(SubGoal0, SubGoal, !SpecInfo),
GoalExpr = negation(SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
;
GoalExpr0 = scope(Reason, SubGoal0),
( if Reason = from_ground_term(_, from_ground_term_construct) then
% We don't put either wait or signal operations in such scopes,
% so there is nothing to specialize.
Goal = Goal0
else
specialize_sequences_in_goal(SubGoal0, SubGoal, !SpecInfo),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo0)
)
;
( GoalExpr0 = unify(_, _, _, _, _)
; GoalExpr0 = plain_call(_, _, _, _, _, _)
; GoalExpr0 = generic_call(_, _, _, _, _)
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
),
Goal = Goal0
;
GoalExpr0 = shorthand(_),
unexpected($pred, "shorthand")
).
:- pred specialize_sequences_in_conj(list(hlds_goal)::in, list(hlds_goal)::out,
set_of_progvar::in, spec_info::in, spec_info::out) is det.
specialize_sequences_in_conj(Goals0, Goals, NonLocals, !SpecInfo) :-
% For each call goal, look backwards for as many wait calls as possible
% and forward for as many signal calls as possible. To allow us to look
% backwards, we maintain a stack of the preceding goals.
specialize_sequences_in_conj_2([], Goals0, Goals, NonLocals, !SpecInfo).
:- pred specialize_sequences_in_conj_2(list(hlds_goal)::in,
list(hlds_goal)::in, list(hlds_goal)::out, set_of_progvar::in,
spec_info::in, spec_info::out) is det.
specialize_sequences_in_conj_2(RevGoals, [], list.reverse(RevGoals),
_, !SpecInfo).
specialize_sequences_in_conj_2(RevGoals0, [Goal0 | Goals0], Goals,
NonLocals, !SpecInfo) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
( if
GoalExpr0 = plain_call(_, _, _, _, _, _),
not is_wait_goal(Goal0),
not is_signal_goal(Goal0)
then
CallGoal0 = hlds_goal(GoalExpr0, GoalInfo0), % dumb mode system
maybe_specialize_call_and_goals(RevGoals0, CallGoal0, Goals0,
RevGoals1, Goals1, NonLocals, !SpecInfo),
specialize_sequences_in_conj_2(RevGoals1, Goals1, Goals,
NonLocals, !SpecInfo)
else
specialize_sequences_in_goal(Goal0, Goal, !SpecInfo),
specialize_sequences_in_conj_2([Goal | RevGoals0], Goals0, Goals,
NonLocals, !SpecInfo)
).
:- pred specialize_sequences_in_goals(list(hlds_goal)::in,
list(hlds_goal)::out, spec_info::in, spec_info::out) is det.
specialize_sequences_in_goals([], [], !SpecInfo).
specialize_sequences_in_goals([Goal0 | Goals0], [Goal | Goals], !SpecInfo) :-
specialize_sequences_in_goal(Goal0, Goal, !SpecInfo),
specialize_sequences_in_goals(Goals0, Goals, !SpecInfo).
:- pred specialize_sequences_in_cases(list(case)::in, list(case)::out,
spec_info::in, spec_info::out) is det.
specialize_sequences_in_cases([], [], !SpecInfo).
specialize_sequences_in_cases([Case0 | Cases0], [Case | Cases], !SpecInfo) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
specialize_sequences_in_goal(Goal0, Goal, !SpecInfo),
Case = case(MainConsId, OtherConsIds, Goal),
specialize_sequences_in_cases(Cases0, Cases, !SpecInfo).
%---------------------------------------------------------------------------%
:- pred maybe_specialize_call_and_goals(list(hlds_goal)::in,
hlds_goal::in(goal_plain_call), list(hlds_goal)::in,
list(hlds_goal)::out, list(hlds_goal)::out,
set_of_progvar::in, spec_info::in, spec_info::out) is det.
maybe_specialize_call_and_goals(RevGoals0, Goal0, FwdGoals0,
RevGoals, FwdGoals, NonLocals, !SpecInfo) :-
Goal0 = hlds_goal(GoalExpr0, _),
GoalExpr0 = plain_call(PredId, ProcId, CallVars, _, _, _),
ModuleInfo = !.SpecInfo ^ spec_module_info,
module_info_pred_info(ModuleInfo, PredId, PredInfo),
module_info_proc_info(ModuleInfo, PredId, ProcId, ProcInfo),
PredProcId = proc(PredId, ProcId),
CallerPredProcId = !.SpecInfo ^ spec_ppid,
( if
% We cannot push wait or signal goals into a procedure whose code we
% don't have access to.
% XXX: We have access to opt_imported procedures. The reason why this
% test does not look for them is that we used to run dep_par_conj only
% *after* mercury_compile used to invoke dead_proc_elim to delete
% opt_imported procedures.
list.member(ProcId, pred_info_all_non_imported_procids(PredInfo)),
% This test avoids some problems we have had with pushing signals and
% waits into callees, which could result in incorrect code being
% generated.
% See also a similar check in get_or_create_spec_par_proc/6.
%
% Don't push signals or waits into any procedure that contains a new
% parallel conjunction, unless this is a recursive call.
(
proc_info_get_has_parallel_conj(ProcInfo, has_parallel_conj)
=>
(
PredProcId = CallerPredProcId
;
% Or this call is to the original version of a specialised
% procedure. This occurs for recursive calls in specialised
% procedures.
map.search(!.SpecInfo ^ spec_rev_proc_map, CallerPredProcId,
PredProcId)
)
)
then
% Look for a contiguous sequence of wait goals at the start of
% RevGoals (i.e. the goals immediately before Goal0) and for a
% contiguous sequence of signal goals at the start of FwdGoals0
% (the goals immediately following Goal0).
%
% Partition these wait and signal goals into
% - those that are relevant (i.e. they mention arguments of the call)
% *and* worth pushing into the called procedure, and
% - those that fail either or both of these criteria.
%
% We maintain the invariant that
% RevGoals0 = WaitGoals ++ RevGoals1
% FwdGoals0 = SignalGoals ++ FwdGoals1
% where WaitGoals is some interleaving of UnPushedWaitGoals and
% the wait goals represented by PushedWaitPairs, and similarly
% for SignalGoals.
find_relevant_pushable_wait_goals(RevGoals0, PredProcId,
CallVars, PushedWaitPairs, UnPushedWaitGoals, RevGoals1,
!SpecInfo),
find_relevant_pushable_signal_goals(FwdGoals0, PredProcId,
CallVars, PushedSignalPairs, UnPushedSignalGoals, FwdGoals1,
!SpecInfo),
( if
PushedWaitPairs = [],
PushedSignalPairs = []
then
RevGoals = [Goal0 | RevGoals0],
FwdGoals = FwdGoals0
else
specialize_dep_par_call(PushedWaitPairs, PushedSignalPairs,
Goal0, MaybeGoal, !SpecInfo),
(
MaybeGoal = yes(Goal),
% After the replaced call may be further references to a
% signalled or waited variable. If so, add `get' goals after
% the transformed goal to make sure the variable is bound.
PushedPairs = PushedSignalPairs ++ PushedWaitPairs,
list.filter(should_add_get_goal(NonLocals, FwdGoals1),
PushedPairs, PushedPairsNeedGets),
VarTable = !.SpecInfo ^ spec_var_table,
list.map(
make_get_goal(!.SpecInfo ^ spec_module_info, VarTable),
PushedPairsNeedGets, GetGoals),
RevGoals = GetGoals ++ [Goal] ++ UnPushedWaitGoals
++ RevGoals1,
FwdGoals = UnPushedSignalGoals ++ FwdGoals1
;
MaybeGoal = no,
RevGoals = [Goal0 | RevGoals0],
FwdGoals = FwdGoals0
)
)
else
RevGoals = [Goal0 | RevGoals0],
FwdGoals = FwdGoals0
).
:- type future_var_pair
---> future_var_pair(
fvp_future :: prog_var,
fvp_var :: prog_var
).
:- func fvp_var(future_var_pair) = prog_var.
:- pred find_relevant_pushable_wait_goals(list(hlds_goal)::in,
pred_proc_id::in, list(prog_var)::in, list(future_var_pair)::out,
list(hlds_goal)::out, list(hlds_goal)::out,
spec_info::in, spec_info::out) is det.
find_relevant_pushable_wait_goals([], _, _, [], [], [], !SpecInfo).
find_relevant_pushable_wait_goals([Goal | Goals], PredProcId, CallVars,
PushedWaitPairs, UnPushedWaitGoals, RemainingGoals, !SpecInfo) :-
Goal = hlds_goal(GoalExpr, _),
( if
GoalExpr = plain_call(_, _, WaitArgs, _, _, SymName),
SymName = qualified(mercury_par_builtin_module, wait_future_pred_name),
WaitArgs = [FutureVar, ConsumedVar]
then
% This is a wait goal.
find_relevant_pushable_wait_goals(Goals, PredProcId, CallVars,
PushedWaitPairsTail, UnPushedWaitGoalsTail, RemainingGoals,
!SpecInfo),
( if
list.index1_of_first_occurrence(CallVars, ConsumedVar, ArgPos)
then
% This wait goal waits for one of the variables consumed by the
% following call, so we must consider whether to push the wait
% into the called procedure.
should_we_push(PredProcId, ArgPos, push_wait, IsWorthPushing,
!SpecInfo),
(
IsWorthPushing = worth_pushing,
PushedWaitPair = future_var_pair(FutureVar, ConsumedVar),
PushedWaitPairs = [PushedWaitPair | PushedWaitPairsTail],
UnPushedWaitGoals = UnPushedWaitGoalsTail
;
IsWorthPushing = not_worth_pushing,
% ConsumedVar is needed immediately by the called procedure,
% so there is no point in pushing the wait operation into its
% code.
PushedWaitPairs = PushedWaitPairsTail,
UnPushedWaitGoals = [Goal | UnPushedWaitGoalsTail]
)
else
% This wait goal waits for a variable that is *not* consumed by the
% following call, so we cannot push the wait into the called
% procedure.
PushedWaitPairs = PushedWaitPairsTail,
UnPushedWaitGoals = [Goal | UnPushedWaitGoalsTail]
)
else
% The sequence of wait goals (if any) has ended.
PushedWaitPairs = [],
UnPushedWaitGoals = [],
RemainingGoals = [Goal | Goals]
).
:- pred find_relevant_pushable_signal_goals(list(hlds_goal)::in,
pred_proc_id::in, list(prog_var)::in, list(future_var_pair)::out,
list(hlds_goal)::out, list(hlds_goal)::out,
spec_info::in, spec_info::out) is det.
find_relevant_pushable_signal_goals([], _, _, [], [], [], !SpecInfo).
find_relevant_pushable_signal_goals([Goal | Goals], PredProcId, CallVars,
PushedSignalPairs, UnPushedSignalGoals, RemainingGoals, !SpecInfo) :-
Goal = hlds_goal(GoalExpr, _),
( if
GoalExpr = plain_call(_, _, SignalArgs, _, _, SymName),
SymName = qualified(mercury_par_builtin_module,
signal_future_pred_name),
SignalArgs = [FutureVar, ProducedVar]
then
% This is a signal goal.
find_relevant_pushable_signal_goals(Goals, PredProcId, CallVars,
PushedSignalPairsTail, UnPushedSignalGoalsTail, RemainingGoals,
!SpecInfo),
( if
list.index1_of_first_occurrence(CallVars, ProducedVar, ArgPos)
then
% This signal goal signals one of the variables produced by the
% preceding call, so we must consider whether to push the signal
% into the called procedure.
should_we_push(PredProcId, ArgPos, push_signal, IsWorthPushing,
!SpecInfo),
(
IsWorthPushing = worth_pushing,
PushedSignalPair = future_var_pair(FutureVar, ProducedVar),
PushedSignalPairs = [PushedSignalPair | PushedSignalPairsTail],
UnPushedSignalGoals = UnPushedSignalGoalsTail
;
IsWorthPushing = not_worth_pushing,
% ProducedVar is generated just before the called procedure
% returns, so there is no point in pushing the signal operation
% into its code.
PushedSignalPairs = PushedSignalPairsTail,
UnPushedSignalGoals = [Goal | UnPushedSignalGoalsTail]
)
else
% This signal goal signals a variable that is *not* produced by the
% preceding call, so we cannot push the signal into the called
% procedure.
PushedSignalPairs = PushedSignalPairsTail,
UnPushedSignalGoals = [Goal | UnPushedSignalGoalsTail]
)
else
% The sequence of signal goals (if any) has ended.
PushedSignalPairs = [],
UnPushedSignalGoals = [],
RemainingGoals = [Goal | Goals]
).
:- pred specialize_dep_par_call(
list(future_var_pair)::in, list(future_var_pair)::in,
hlds_goal::in(goal_plain_call), maybe(hlds_goal)::out,
spec_info::in, spec_info::out) is det.
specialize_dep_par_call(WaitPairs, SignalPairs, Goal0, MaybeGoal, !SpecInfo) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
GoalExpr0 = plain_call(PredId, ProcId, CallVars, _Builtin, Context, _Name),
OrigPPId = proc(PredId, ProcId),
WaitVars = list.map(fvp_var, WaitPairs),
SignalVars = list.map(fvp_var, SignalPairs),
number_future_args(1, CallVars, WaitVars ++ SignalVars, [], FutureArgs),
CallPattern = par_proc_call_pattern(OrigPPId, FutureArgs),
get_or_create_spec_par_proc(FutureArgs, CallPattern, OrigPPId,
MaybeSpecProc, !SpecInfo),
(
MaybeSpecProc = spec_proc(SpecPPId, SpecName),
% Replace the call with a call to the parallelised procedure.
list.map(replace_args_with_futures(WaitPairs ++ SignalPairs),
CallVars, NewCallVars),
SpecPPId = proc(SpecPredId, SpecProcId),
GoalExpr = plain_call(SpecPredId, SpecProcId, NewCallVars, not_builtin,
Context, SpecName),
MaybeGoal = yes(hlds_goal(GoalExpr, GoalInfo0))
;
MaybeSpecProc = will_not_specialise,
MaybeGoal = no
).
:- type maybe_spec_proc
---> will_not_specialise
; spec_proc(
sp_ppid :: pred_proc_id,
sp_name :: sym_name
).
:- pred get_or_create_spec_par_proc(list(arg_pos)::in,
par_proc_call_pattern::in, pred_proc_id::in, maybe_spec_proc::out,
spec_info::in, spec_info::out) is det.
get_or_create_spec_par_proc(FutureArgs, CallPattern, OrigPPId, MaybeSpecProc,
!SpecInfo) :-
( if
find_spec_par_proc_for_call_pattern(!.SpecInfo ^ spec_done_procs,
!.SpecInfo ^ spec_pending_procs, CallPattern, SpecNewParProc)
then
SpecNewParProc = new_par_proc(SpecPPId, SpecSymName),
MaybeSpecProc = spec_proc(SpecPPId, SpecSymName)
else if
% This check prevents invalid code from being generated. See also
% a similar check in maybe_specialize_call_and_goals/6
%
% Don't push signals or waits into any procedure that has
% already been specialised but doesn't match our specialisation.
(
some [DoneParProc] (
map.member(!.SpecInfo ^ spec_done_procs, _, DoneParProc),
OrigPPId = DoneParProc ^ new_ppid
)
;
some [PendingParProc] (
list.member(_ - PendingParProc,
!.SpecInfo ^ spec_pending_procs),
OrigPPId = PendingParProc ^ new_ppid
)
)
then
MaybeSpecProc = will_not_specialise
else
% Queue a new parallel procedure to be made. We add the new specialized
% predicate and procedure to the module_info now; its final body
% will be set later.
ModuleInfo0 = !.SpecInfo ^ spec_module_info,
PendingParProcs0 = !.SpecInfo ^ spec_pending_procs,
RevProcMap0 = !.SpecInfo ^ spec_rev_proc_map,
create_new_spec_parallel_pred(FutureArgs, OrigPPId, SpecPPId, SpecName,
ModuleInfo0, ModuleInfo),
module_info_get_name(ModuleInfo, ModuleName),
SpecSymName = qualified(ModuleName, SpecName),
MaybeSpecProc = spec_proc(SpecPPId, SpecSymName),
queue_par_proc(CallPattern, new_par_proc(SpecPPId, SpecSymName),
PendingParProcs0, PendingParProcs),
RevProcMap = map.det_insert(RevProcMap0, SpecPPId, OrigPPId),
!SpecInfo ^ spec_module_info := ModuleInfo,
!SpecInfo ^ spec_pending_procs := PendingParProcs,
!SpecInfo ^ spec_rev_proc_map := RevProcMap
).
:- pred find_spec_par_proc_for_call_pattern(done_par_procs::in,
pending_par_procs::in, par_proc_call_pattern::in,
new_par_proc::out) is semidet.
find_spec_par_proc_for_call_pattern(DoneParProcs, PendingProcs, CallPattern,
SpecProc) :-
( if search(DoneParProcs, CallPattern, SpecProcPrime) then
SpecProc = SpecProcPrime
else if search(PendingProcs, CallPattern, SpecProcPrime) then
SpecProc = SpecProcPrime
else
fail
).
:- pred queue_par_proc(par_proc_call_pattern::in, new_par_proc::in,
pending_par_procs::in, pending_par_procs::out) is det.
queue_par_proc(CallPattern, NewProc, !PendingParProcs) :-
!:PendingParProcs = [CallPattern - NewProc | !.PendingParProcs].
:- pred replace_args_with_futures(list(future_var_pair)::in,
prog_var::in, prog_var::out) is det.
replace_args_with_futures([], Var, Var).
replace_args_with_futures([H | T], Var0, Var) :-
H = future_var_pair(Future, X),
( if X = Var0 then
Var = Future
else
replace_args_with_futures(T, Var0, Var)
).
:- pred number_future_args(arg_pos::in, list(prog_var)::in, list(prog_var)::in,
list(arg_pos)::in, list(arg_pos)::out) is det.
number_future_args(_, [], _, RevAcc, reverse(RevAcc)).
number_future_args(ArgNo, [Arg | Args], WaitSignalVars, !RevAcc) :-
( if list.member(Arg, WaitSignalVars) then
list.cons(ArgNo, !RevAcc)
else
true
),
number_future_args(ArgNo+1, Args, WaitSignalVars, !RevAcc).
% should_add_get_goal(NonLocals, FwdGoals, FutureVarPair).
%
% True the variable wrapped in the FutureVarPair is needed by a another
% goal, as indicated by NonLocals (of the conjuction) or FwdGoals (the
% remaining goals in the conjunction).
%
:- pred should_add_get_goal(set_of_progvar::in, list(hlds_goal)::in,
future_var_pair::in) is semidet.
should_add_get_goal(NonLocals, FwdGoals, future_var_pair(_, Var)) :-
(
% If the variable is in the nonlocals set of the entire conjunction
% then we need to add a get goal, because that means that a goal
% outside the conjunction also uses the variable.
set_of_var.contains(NonLocals, Var)
;
% If any of the other goals in the conjunction mention the variable,
% then we should also add a get_future variable call. We don't need to
% check RevGoals, the only reason the variable might be mentioned there
% would be because it was previously partially instantiated. But since
% we are adding a get_future call that does not make sense. I [who?]
% am assuming that only free -> ground instantiation state changes
% are allowed for these variables.
member(Goal, FwdGoals),
GoalNonLocals = goal_get_nonlocals(Goal),
set_of_var.contains(GoalNonLocals, Var)
).
%---------------------------------------------------------------------------%
:- pred create_new_spec_parallel_pred(list(arg_pos)::in, pred_proc_id::in,
pred_proc_id::out, string::out, module_info::in, module_info::out) is det.
create_new_spec_parallel_pred(FutureArgs, OrigPPId, NewPPId,
NewPredName, !ModuleInfo) :-
module_info_pred_proc_info(!.ModuleInfo, OrigPPId,
OrigPredInfo, OrigProcInfo),
PredStatus = pred_status(status_local),
make_new_spec_parallel_pred_info(FutureArgs, PredStatus, OrigPPId,
OrigPredInfo, NewPredInfo0),
NewPredName = pred_info_name(NewPredInfo0),
% Assign the old procedure to a new predicate, which will be modified
% in a later pass.
OrigPPId = proc(_, ProcId),
pred_info_get_proc_table(NewPredInfo0, NewProcs0),
map.set(ProcId, OrigProcInfo, NewProcs0, NewProcs),
pred_info_set_proc_table(NewProcs, NewPredInfo0, NewPredInfo),
% Add the new predicate to the pred table.
module_info_get_predicate_table(!.ModuleInfo, PredTable0),
predicate_table_insert(NewPredInfo, NewPredId, PredTable0, PredTable),
module_info_set_predicate_table(PredTable, !ModuleInfo),
NewPPId = proc(NewPredId, ProcId).
% The comments in this predicate are from unused_args.m
%
:- pred make_new_spec_parallel_pred_info(list(arg_pos)::in, pred_status::in,
pred_proc_id::in, pred_info::in, pred_info::out) is det.
make_new_spec_parallel_pred_info(FutureArgs, PredStatus, PPId, !PredInfo) :-
PPId = proc(PredId, ProcId),
PredModule = pred_info_module(!.PredInfo),
Name0 = pred_info_name(!.PredInfo),
PredOrFunc = pred_info_is_pred_or_func(!.PredInfo),
pred_info_get_arg_types(!.PredInfo, Tvars, ExistQVars, ArgTypes0),
pred_info_get_origin(!.PredInfo, OrigOrigin),
% The mode number is included because we want to avoid the creation of
% more than one predicate with the same name if more than one mode of
% a predicate is parallelised. Since the names of e.g. deep profiling
% proc_static structures are derived from the names of predicates,
% duplicate predicate names lead to duplicate global variable names
% and hence to link errors.
Transform =
tn_dep_par_conj(PredOrFunc, proc_id_to_int(ProcId), FutureArgs),
make_transformed_pred_name(Name0, Transform, TransformedName),
PredFormArity = pred_info_pred_form_arity(!.PredInfo),
pred_info_get_typevarset(!.PredInfo, TypeVars),
futurise_argtypes(1, FutureArgs, ArgTypes0, ArgTypes),
pred_info_get_context(!.PredInfo, Context),
pred_info_get_clauses_info(!.PredInfo, ClausesInfo),
pred_info_get_markers(!.PredInfo, Markers),
pred_info_get_goal_type(!.PredInfo, GoalType),
pred_info_get_class_context(!.PredInfo, ClassContext),
pred_info_get_var_name_remap(!.PredInfo, VarNameRemap),
% Since this pred_info isn't built until after the polymorphism
% transformation is complete, we just use dummy maps for the class
% constraints.
map.init(EmptyProofs),
map.init(EmptyConstraintMap),
ProcTransform = proc_transform_dep_par_conj(FutureArgs),
Origin = origin_proc_transform(ProcTransform, OrigOrigin, PredId, ProcId),
CurUserDecl = maybe.no,
pred_info_init(PredOrFunc, PredModule, TransformedName, PredFormArity,
Context, Origin, PredStatus, CurUserDecl, GoalType, Markers, ArgTypes,
Tvars, ExistQVars, ClassContext, EmptyProofs, EmptyConstraintMap,
ClausesInfo, VarNameRemap, !:PredInfo),
pred_info_set_typevarset(TypeVars, !PredInfo).
:- pred futurise_argtypes(arg_pos::in, list(arg_pos)::in, list(mer_type)::in,
list(mer_type)::out) is det.
futurise_argtypes(_, [], ArgTypes, ArgTypes).
futurise_argtypes(_, [_ | _], [], _) :-
unexpected($pred, "more future arguments than argument types").
futurise_argtypes(ArgNo, [FutureArg | FutureArgs], [ArgType | ArgTypes],
[FuturisedArgType | FuturisedArgTypes]) :-
( if ArgNo = FutureArg then
FuturisedArgType = future_type(ArgType),
futurise_argtypes(ArgNo + 1, FutureArgs,
ArgTypes, FuturisedArgTypes)
else
FuturisedArgType = ArgType,
futurise_argtypes(ArgNo + 1, [FutureArg | FutureArgs],
ArgTypes, FuturisedArgTypes)
).
%---------------------------------------------------------------------------%
:- type push_op
---> push_wait
; push_signal.
:- pred should_we_push(pred_proc_id::in, int::in, push_op::in,
maybe_worth_pushing::out, spec_info::in, spec_info::out) is det.
should_we_push(PredProcId, ArgPos, PushOp, IsWorthPushing, !SpecInfo) :-
Pushability0 = !.SpecInfo ^ spec_pushability,
( if map.search(Pushability0, PredProcId, ProcPushMap0) then
( if map.search(ProcPushMap0, ArgPos, KnownWorthPushing) then
IsWorthPushing = KnownWorthPushing
else
should_we_push_test(PredProcId, ArgPos, PushOp, IsWorthPushing,
!.SpecInfo),
map.det_insert(ArgPos, IsWorthPushing, ProcPushMap0, ProcPushMap),
map.det_update(PredProcId, ProcPushMap, Pushability0, Pushability),
!SpecInfo ^ spec_pushability := Pushability
)
else
InitialModuleInfo = !.SpecInfo ^ spec_initial_module,
module_info_get_globals(InitialModuleInfo, Globals),
globals.get_opt_tuple(Globals, OptTuple),
AlwaysSpecialize = OptTuple ^ ot_spec_in_all_dep_par_conjs,
(
AlwaysSpecialize = spec_in_all_dep_par_conjs,
IsWorthPushing = worth_pushing
;
AlwaysSpecialize = do_not_spec_in_all_dep_par_conjs,
should_we_push_test(PredProcId, ArgPos, PushOp, IsWorthPushing,
!.SpecInfo)
),
ProcPushMap = map.singleton(ArgPos, IsWorthPushing),
map.det_insert(PredProcId, ProcPushMap, Pushability0, Pushability),
!SpecInfo ^ spec_pushability := Pushability
).
:- pred should_we_push_test(pred_proc_id::in, int::in, push_op::in,
maybe_worth_pushing::out, spec_info::in) is det.
should_we_push_test(PredProcId, ArgPos, PushOp, IsWorthPushing, SpecInfo) :-
InitialModuleInfo = SpecInfo ^ spec_initial_module,
module_info_proc_info(InitialModuleInfo, PredProcId, ProcInfo),
proc_info_get_headvars(ProcInfo, HeadVars),
list.det_index1(HeadVars, ArgPos, Var),
proc_info_get_goal(ProcInfo, Goal),
(
PushOp = push_wait,
should_we_push_wait(Var, Goal, CostBeforeWait),
(
CostBeforeWait = seen_wait_negligible_cost_before,
IsWorthPushing = not_worth_pushing
;
( CostBeforeWait = not_seen_wait_non_negligible_cost_so_far
; CostBeforeWait = seen_wait_non_negligible_cost_before
),
IsWorthPushing = worth_pushing
;
CostBeforeWait = not_seen_wait_negligible_cost_so_far,
% This should not happen unless (a) the procedure ignores its
% input, or (b) we made an incorrect approximation in
% should_we_push_wait.
IsWorthPushing = worth_pushing
)
;
PushOp = push_signal,
should_we_push_signal(Var, Goal, not_seen_signal, CostAfterSignal),
(
CostAfterSignal = not_seen_signal,
% This should not happen, since it is a mode error.
unexpected($pred, "not_seen_signal")
;
CostAfterSignal = seen_signal_negligible_cost_after,
IsWorthPushing = not_worth_pushing
;
CostAfterSignal = seen_signal_non_negligible_cost_after,
IsWorthPushing = worth_pushing
;
CostAfterSignal = code_has_no_solutions,
% The signal will never be executed no matter where we put it,
% don't bother specialising code.
IsWorthPushing = not_worth_pushing
)
).
%---------------------------------------------------------------------------%
:- type cost_before_wait
---> not_seen_wait_negligible_cost_so_far
; not_seen_wait_non_negligible_cost_so_far
; seen_wait_negligible_cost_before
; seen_wait_non_negligible_cost_before.
% Separate cost_before_wait into its components: seen (yes/no) and
% non-negligible cost (yes/no), or put it back together. The fact that
% the costs are the costs of different things for different values of seen
% is just something we have to live with.
:- pred cost_before_wait_components(cost_before_wait, bool, bool).
:- mode cost_before_wait_components(in, out, out) is det.
:- mode cost_before_wait_components(out, in, in) is det.
cost_before_wait_components(not_seen_wait_negligible_cost_so_far, no, no).
cost_before_wait_components(not_seen_wait_non_negligible_cost_so_far, no, yes).
cost_before_wait_components(seen_wait_negligible_cost_before, yes, no).
cost_before_wait_components(seen_wait_non_negligible_cost_before, yes, yes).
:- pred should_we_push_wait(prog_var::in, hlds_goal::in, cost_before_wait::out)
is det.
should_we_push_wait(Var, Goal, Wait) :-
Goal = hlds_goal(GoalExpr, GoalInfo),
NonLocals = goal_info_get_nonlocals(GoalInfo),
% When handling calls, we could use profiling data to decide whether
% a call site has negligible cost or not. In the absence of such data,
% we have to assume that all call sites have non-negligible cost, because
% if we assumed that they have negligible cost, then we would have to infer
% that *all* goals have negligible cost, which besides being incorrect,
% would mean that there is never any point in pushing waits, rendering
% this entire code useless.
(
GoalExpr = unify(_, _, _, _, _),
( if set_of_var.member(NonLocals, Var) then
Wait = seen_wait_negligible_cost_before
else
Wait = not_seen_wait_negligible_cost_so_far
)
;
GoalExpr = plain_call(_, _, _, BuiltinStatus, _, _),
(
BuiltinStatus = inline_builtin,
( if set_of_var.member(NonLocals, Var) then
Wait = seen_wait_negligible_cost_before
else
Wait = not_seen_wait_negligible_cost_so_far
)
;
BuiltinStatus = not_builtin,
( if set_of_var.member(NonLocals, Var) then
Wait = seen_wait_non_negligible_cost_before
else
Wait = not_seen_wait_non_negligible_cost_so_far
)
)
;
( GoalExpr = generic_call(_, _, _, _, _)
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
),
( if set_of_var.member(NonLocals, Var) then
Wait = seen_wait_non_negligible_cost_before
else
Wait = not_seen_wait_non_negligible_cost_so_far
)
;
GoalExpr = conj(ConjType, Conjuncts),
(
ConjType = plain_conj,
should_we_push_wait_in_conj(Var, Conjuncts, Wait)
;
ConjType = parallel_conj,
list.map(should_we_push_wait(Var), Conjuncts, Waits),
( if
list.member(seen_wait_non_negligible_cost_before, Waits)
then
% At least one of the parallel conjuncts can benefit from not
% waiting for Var at the start.
Wait = seen_wait_non_negligible_cost_before
else if
list.member(not_seen_wait_non_negligible_cost_so_far, Waits)
then
% At least one of the parallel conjuncts does not need to wait
% for Var at all, and has non-negligible cost. That conjunct
% can also benefit from not waiting for Var at the start.
Wait = not_seen_wait_non_negligible_cost_so_far
else if
list.member(seen_wait_negligible_cost_before, Waits)
then
Wait = seen_wait_negligible_cost_before
else
Wait = not_seen_wait_negligible_cost_so_far
)
)
;
GoalExpr = disj(Disjuncts),
Detism = goal_info_get_determinism(GoalInfo),
determinism_components(Detism, _, SolnCount),
(
SolnCount = at_most_many,
(
Disjuncts = [FirstDisjunct | _LaterDisjuncts],
should_we_push_wait(Var, FirstDisjunct, WaitFirst),
(
( WaitFirst = seen_wait_negligible_cost_before
; WaitFirst = seen_wait_non_negligible_cost_before
),
% If FirstDisjunct waits for Var, the cost before that
% wait in FirstDisjunct tells us the cost before the wait
% in Goal.
Wait = WaitFirst
;
( WaitFirst = not_seen_wait_negligible_cost_so_far
; WaitFirst = not_seen_wait_non_negligible_cost_so_far
),
% If FirstDisjunct does not wait for Var, then we may
% execute an arbitrary initial subsequence of the code
% following the disjunct before execution backtracks
% to the later disjuncts. We therefore want this following
% code to decide whether we push the wait.
Wait = not_seen_wait_negligible_cost_so_far
)
;
Disjuncts = [],
Wait = not_seen_wait_negligible_cost_so_far
)
;
( SolnCount = at_most_zero
; SolnCount = at_most_one
; SolnCount = at_most_many_cc
),
% The most expensive thing we can do is to execute one disjunct
% after another, with all disjuncts except possibly the last
% all failing at the last moment. This is like a conjunction
% in which we execute only some of the goals.
should_we_push_wait_in_conj(Var, Disjuncts, Wait)
)
;
GoalExpr = switch(SwitchVar, _, Cases),
( if Var = SwitchVar then
Wait = seen_wait_negligible_cost_before
else
should_we_push_wait_in_cases(Var, Cases, no, Wait)
)
;
GoalExpr = if_then_else(_Vars, Cond, Then, Else),
should_we_push_wait(Var, Cond, WaitCond),
(
( WaitCond = seen_wait_negligible_cost_before
; WaitCond = seen_wait_non_negligible_cost_before
),
% If Cond waits for Var, the cost before that wait in Cond
% tells us the cost before the wait in Goal if Cond succeeds.
% The cost when Cond fails could be the opposite, and we have
% no certain way of deciding right at compile time, though we could
% in principle we could come close by analyzing the determinism of
% Cond's component goals. The following code is a very simple
% guess.
Wait = WaitCond
;
WaitCond = not_seen_wait_non_negligible_cost_so_far,
% Execution paths on which the condition succeeds would definitely
% benefit from pushing the wait.
Wait = not_seen_wait_non_negligible_cost_so_far
;
WaitCond = not_seen_wait_negligible_cost_so_far,
% Execution will reach the start of either the then or the else
% branch without waiting or incurring non-negligible cost.
should_we_push_wait(Var, Then, WaitThen),
should_we_push_wait(Var, Else, WaitElse),
cost_before_wait_components(WaitThen, ThenSeen, ThenCost),
cost_before_wait_components(WaitElse, ElseSeen, ElseCost),
bool.or(ThenSeen, ElseSeen, Seen),
% If ThenSeen != ElseSeen, then this mixes two kinds of cost:
% the cost so far before seeing a wait, and the cost before a wait.
% However, the result we get here is should still be a reasonable
% approximation, and that is all we need.
bool.or(ThenCost, ElseCost, Cost),
cost_before_wait_components(Wait, Seen, Cost)
)
;
GoalExpr = negation(SubGoal),
should_we_push_wait(Var, SubGoal, Wait)
;
GoalExpr = scope(Reason, SubGoal),
( if Reason = from_ground_term(_, from_ground_term_construct) then
% The SubGoal may be huge, but since the code generator will
% turn it all into a single assignment of a pointer to a large
% static data structure, its cost in execution time is negligible.
Wait = not_seen_wait_negligible_cost_so_far
else
% XXX If Reason = from_ground_term(X,
% from_ground_term_deconstruct), then the only variable
% that we can wait for is X. We should be able to use that fact
% to avoid processing SubGoal.
should_we_push_wait(Var, SubGoal, Wait)
)
;
GoalExpr = shorthand(_),
unexpected($pred, "shorthand")
).
:- pred should_we_push_wait_in_conj(prog_var::in, list(hlds_goal)::in,
cost_before_wait::out) is det.
should_we_push_wait_in_conj(_, [], not_seen_wait_negligible_cost_so_far).
should_we_push_wait_in_conj(Var, [Goal | Goals], CostBeforeWait) :-
should_we_push_wait(Var, Goal, CostBeforeWaitHead),
(
CostBeforeWaitHead = not_seen_wait_negligible_cost_so_far,
% Nothing significant has happened so far; whether we want to push
% the wait depends on the rest of the conjunction.
should_we_push_wait_in_conj(Var, Goals, CostBeforeWait)
;
CostBeforeWaitHead = not_seen_wait_non_negligible_cost_so_far,
% We already know that we will want to push the wait, since doing
% the wait after the non-negligible cost of Goal will be a win.
CostBeforeWait = not_seen_wait_non_negligible_cost_so_far
;
CostBeforeWaitHead = seen_wait_negligible_cost_before,
% We already know that along this execution path, we don't want
% to push the wait.
CostBeforeWait = seen_wait_negligible_cost_before
;
CostBeforeWaitHead = seen_wait_non_negligible_cost_before,
% We already know that we will want to push the wait, since doing
% the wait after the non-negligible cost of part of Goal will be a win.
CostBeforeWait = seen_wait_non_negligible_cost_before
).
:- pred should_we_push_wait_in_cases(prog_var::in, list(case)::in,
bool::in, cost_before_wait::out) is det.
should_we_push_wait_in_cases(_, [], SeenWait, CostBeforeWait) :-
(
SeenWait = no,
CostBeforeWait = not_seen_wait_negligible_cost_so_far
;
SeenWait = yes,
CostBeforeWait = seen_wait_negligible_cost_before
).
should_we_push_wait_in_cases(Var, [Case | Cases], SeenWait, CostBeforeWait) :-
Case = case(_MainConsId, _OtherConsIds, Goal),
should_we_push_wait(Var, Goal, CostBeforeWaitHead),
(
CostBeforeWaitHead = not_seen_wait_negligible_cost_so_far,
% Nothing significant happens in this switch arm; whether we want
% to push the wait depends on the rest of the arms.
should_we_push_wait_in_cases(Var, Cases, SeenWait, CostBeforeWait)
;
CostBeforeWaitHead = not_seen_wait_non_negligible_cost_so_far,
% We already know that we will want to push the wait, since doing
% the wait after the non-negligible cost of Goal will be a win.
CostBeforeWait = not_seen_wait_non_negligible_cost_so_far
;
CostBeforeWaitHead = seen_wait_negligible_cost_before,
% There is no benefit along this execution path to pushing the wait,
% but there may be benefit along execution paths involving other switch
% arms.
NewSeenWait = yes,
should_we_push_wait_in_cases(Var, Cases, NewSeenWait, CostBeforeWait)
;
CostBeforeWaitHead = seen_wait_non_negligible_cost_before,
% We already know that we will want to push the wait, since doing
% the wait after the non-negligible cost of part of Goal will be a win.
CostBeforeWait = seen_wait_non_negligible_cost_before
).
%---------------------------------------------------------------------------%
:- type cost_after_signal
---> not_seen_signal
; code_has_no_solutions
% The goal has no solutions and therefore does not produce
% the result.
; seen_signal_negligible_cost_after
; seen_signal_non_negligible_cost_after.
% The should we signal code only makes sense when its input is one of
% these values for !.Signal.
%
:- inst cost_after_signal_in for cost_after_signal/0
---> not_seen_signal
; seen_signal_negligible_cost_after.
:- pred seen_produced_var(cost_after_signal::in(cost_after_signal_in),
cost_after_signal::out) is det.
seen_produced_var(!Signal) :-
(
!.Signal = not_seen_signal,
!:Signal = seen_signal_negligible_cost_after
;
!.Signal = seen_signal_negligible_cost_after
).
:- pred seen_nontrivial_cost(cost_after_signal::in(cost_after_signal_in),
cost_after_signal::out) is det.
seen_nontrivial_cost(!Signal) :-
(
!.Signal = not_seen_signal
% We are not interested in costs before the signal.
;
!.Signal = seen_signal_negligible_cost_after,
!:Signal = seen_signal_non_negligible_cost_after
).
:- pred should_we_push_signal(prog_var::in, hlds_goal::in,
cost_after_signal::in(cost_after_signal_in), cost_after_signal::out)
is det.
should_we_push_signal(Var, Goal, !Signal) :-
Goal = hlds_goal(GoalExpr, GoalInfo),
Detism = goal_info_get_determinism(GoalInfo),
determinism_components(Detism, _CanFail, NumSolutions),
(
( NumSolutions = at_most_one
; NumSolutions = at_most_many_cc
; NumSolutions = at_most_many
),
NonLocals = goal_info_get_nonlocals(GoalInfo),
% When handling calls, we could use profiling data to decide whether a
% call site has negligible cost or not. In the absence of such data, we
% have to assume that all call sites have non-negligible cost, because
% if we assumed that they have negligible cost, then we would have to
% infer that *all* goals have negligible cost, which besides being
% incorrect, would mean that there is never any point in pushing
% signals, rendering this entire code useless.
(
GoalExpr = unify(_, _, _, _, _),
( if set_of_var.member(NonLocals, Var) then
seen_produced_var(!Signal)
else
true
)
;
% With generic calls, the only safe assumption is that they produce
% Var just before return. With foreign code, the signal is done
% after the return to Mercury execution.
( GoalExpr = generic_call(_, _, _, _, _)
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
),
( if set_of_var.member(NonLocals, Var) then
seen_produced_var(!Signal)
else
seen_nontrivial_cost(!Signal)
)
;
GoalExpr = plain_call(_, _, _, _, _, _),
% XXX We should invoke should_we_push recursively on the called
% procedure, though that would require safeguards against infinite
% recursion.
( if set_of_var.member(NonLocals, Var) then
seen_produced_var(!Signal)
else
seen_nontrivial_cost(!Signal)
)
;
GoalExpr = conj(ConjType, Conjuncts),
(
ConjType = plain_conj,
should_we_push_signal_in_plain_conj(Var, Conjuncts, !Signal)
;
ConjType = parallel_conj,
should_we_push_signal_in_par_conj(Var, Conjuncts, !.Signal,
!Signal)
)
;
GoalExpr = disj(Disjuncts),
% What we do in this case doesn't usually matter. Semidet
% disjunctions cannot bind any nonlocal variables (and thus cannot
% bind Var). Nondet disjunctions can bind variables, but we want
% to parallelize only model_det code. The only case where what we
% do here matters is when a nondet disjunction is inside a scope
% that commits to the first success.
should_we_push_signal_in_disj(Var, Disjuncts, !Signal)
;
GoalExpr = switch(SwitchVar, _, Cases),
( if Var = SwitchVar then
% !.Signal must show that we have already seen a signal.
expect(negate(unify(!.Signal, not_seen_signal)), $pred,
"not seen switch var")
else
should_we_push_signal_in_cases(Var, Cases, !Signal)
)
;
GoalExpr = if_then_else(_Vars, _Cond, Then, Else),
% The condition cannot produce a nonlocal variable such as Var.
should_we_push_signal(Var, Then, !.Signal, SignalThen),
should_we_push_signal(Var, Else, !.Signal, SignalElse),
(
SignalThen = not_seen_signal,
(
( SignalElse = not_seen_signal
; SignalElse = code_has_no_solutions
),
!:Signal = not_seen_signal
;
( SignalElse = seen_signal_non_negligible_cost_after
; SignalElse = seen_signal_negligible_cost_after
),
unexpected($pred, "ITE is not mode safe")
)
;
SignalThen = code_has_no_solutions,
!:Signal = SignalElse
;
SignalThen = seen_signal_non_negligible_cost_after,
(
SignalElse = not_seen_signal,
unexpected($pred, "ITE is not mode safe")
;
( SignalElse = code_has_no_solutions
; SignalElse = seen_signal_non_negligible_cost_after
; SignalElse = seen_signal_negligible_cost_after
),
!:Signal = seen_signal_non_negligible_cost_after
)
;
SignalThen = seen_signal_negligible_cost_after,
(
SignalElse = not_seen_signal,
unexpected($pred, "ITE is not mode safe")
;
( SignalElse = code_has_no_solutions
; SignalElse = seen_signal_negligible_cost_after
),
!:Signal = seen_signal_negligible_cost_after
;
SignalElse = seen_signal_non_negligible_cost_after,
!:Signal = seen_signal_non_negligible_cost_after
)
)
;
GoalExpr = negation(SubGoal),
(
!.Signal = not_seen_signal
% A negated goal cannot produce a nonlocal variable
% such as Var, and we don't care about the cost of computations
% before the signal.
;
!.Signal = seen_signal_negligible_cost_after,
% We do care whether the cost of SubGoal is negligible or not.
should_we_push_signal(Var, SubGoal, !Signal)
)
;
GoalExpr = scope(Reason, SubGoal),
( if
Reason = from_ground_term(TermVar, from_ground_term_construct)
then
( if Var = TermVar then
seen_produced_var(!Signal)
else
true
)
else
should_we_push_signal(Var, SubGoal, !Signal)
)
;
GoalExpr = shorthand(_),
unexpected($pred, "shorthand")
)
;
NumSolutions = at_most_zero,
% The goal can never complete, which means that it can never produce
% the future and has an 'unreachable' instmap. Note that we haven't
% checked that this goal or a goal after it definitely produce the
% variable.
!:Signal = code_has_no_solutions
).
:- pred should_we_push_signal_in_plain_conj(prog_var::in, list(hlds_goal)::in,
cost_after_signal::in(cost_after_signal_in), cost_after_signal::out)
is det.
should_we_push_signal_in_plain_conj(_Var, [], !Signal).
should_we_push_signal_in_plain_conj(Var, [Conjunct | Conjuncts], !Signal) :-
should_we_push_signal(Var, Conjunct, !Signal),
(
!.Signal = seen_signal_non_negligible_cost_after
% There is no point in looking at Conjuncts; we already know
% we want to push the signal.
;
!.Signal = code_has_no_solutions
% We don't bother checking if the signal occurs in unreachable code.
;
( !.Signal = not_seen_signal
; !.Signal = seen_signal_negligible_cost_after
),
should_we_push_signal_in_plain_conj(Var, Conjuncts, !Signal)
).
:- pred should_we_push_signal_in_par_conj(prog_var::in, list(hlds_goal)::in,
cost_after_signal::in(cost_after_signal_in),
cost_after_signal::in, cost_after_signal::out) is det.
should_we_push_signal_in_par_conj(_Var, [], _OrigSignal, !FinalSignal).
should_we_push_signal_in_par_conj(Var, [Conjunct | Conjuncts],
OrigSignal, !FinalSignal) :-
FinalSignal0 = !.FinalSignal,
should_we_push_signal(Var, Conjunct, OrigSignal, ConjunctSignal),
(
ConjunctSignal = not_seen_signal,
% Neither the goal before the parallel conjunction nor the parallel
% conjuncts we have looked at so far produce Var.
should_we_push_signal_in_par_conj(Var, Conjuncts,
OrigSignal, !FinalSignal)
;
ConjunctSignal = code_has_no_solutions,
!:FinalSignal = code_has_no_solutions
;
ConjunctSignal = seen_signal_negligible_cost_after,
(
Conjuncts = [],
% There are no more conjuncts after this one, so Var is produced
% just before the end of the final conjunct.
!:FinalSignal = seen_signal_negligible_cost_after
;
Conjuncts = [_ | _],
% There are more conjuncts after this one, and since negligible
% cost goals are not worth parallelizing, we can assume that
% at least on some executions, the signal of Var will be followed
% by the nontrivial execution of some of Conjuncts.
!:FinalSignal = seen_signal_non_negligible_cost_after
)
;
ConjunctSignal = seen_signal_non_negligible_cost_after,
% There is no point in looking at Conjuncts; we already know
% we want to push the signal.
!:FinalSignal = seen_signal_non_negligible_cost_after
),
FinalSignal = !.FinalSignal,
expect(we_have_seen_more_signal(FinalSignal0, FinalSignal), $pred,
"final signal goes backwards").
:- pred should_we_push_signal_in_disj(prog_var::in, list(hlds_goal)::in,
cost_after_signal::in(cost_after_signal_in),
cost_after_signal::out) is det.
should_we_push_signal_in_disj(_Var, [], _OrigSignal, code_has_no_solutions).
should_we_push_signal_in_disj(Var, [FirstGoal | LaterGoals],
OrigSignal, Signal) :-
should_we_push_signal(Var, FirstGoal, OrigSignal, SignalFirst),
(
SignalFirst = not_seen_signal,
% If FirstGoal does not signal Var, the rest of the disjuncts
% shouldn't either.
Signal = SignalFirst
;
SignalFirst = seen_signal_non_negligible_cost_after,
% We already know we want to push the signal.
Signal = SignalFirst
;
( SignalFirst = seen_signal_negligible_cost_after
; SignalFirst = code_has_no_solutions
),
% We want to push the signal only if it is worth pushing
% into one of the rest of the disjuncts.
should_we_push_signal_in_disj(Var, LaterGoals, OrigSignal, Signal0),
(
SignalFirst = seen_signal_negligible_cost_after,
(
Signal0 = not_seen_signal,
unexpected($pred, "The program doesn't seem mode correct")
;
Signal0 = code_has_no_solutions,
Signal = SignalFirst
;
( Signal0 = seen_signal_negligible_cost_after
; Signal0 = seen_signal_non_negligible_cost_after
),
Signal = Signal0
)
;
SignalFirst = code_has_no_solutions,
Signal = Signal0
)
).
:- pred should_we_push_signal_in_cases(prog_var::in, list(case)::in,
cost_after_signal::in(cost_after_signal_in),
cost_after_signal::out) is det.
should_we_push_signal_in_cases(_Var, [], _OrigSignal, code_has_no_solutions).
should_we_push_signal_in_cases(Var, [FirstCase | LaterCases],
OrigSignal, Signal) :-
FirstCase = case(_, _, FirstGoal),
should_we_push_signal(Var, FirstGoal, OrigSignal, SignalFirst),
(
SignalFirst = not_seen_signal,
% If FirstCase does not signal Var, the rest of the cases
% shouldn't either.
Signal = SignalFirst
;
SignalFirst = seen_signal_non_negligible_cost_after,
% We already know we want to push the signal.
Signal = SignalFirst
;
( SignalFirst = seen_signal_negligible_cost_after
; SignalFirst = code_has_no_solutions
),
% We want to push the signal only if it is worth pushing
% into one of the rest of the cases.
should_we_push_signal_in_cases(Var, LaterCases, OrigSignal, Signal0),
(
SignalFirst = seen_signal_negligible_cost_after,
(
Signal0 = not_seen_signal,
unexpected($pred, "The program doesn't seem mode correct")
;
Signal0 = code_has_no_solutions,
Signal = SignalFirst
;
( Signal0 = seen_signal_negligible_cost_after
; Signal0 = seen_signal_non_negligible_cost_after
),
Signal = Signal0
)
;
SignalFirst = code_has_no_solutions,
Signal = Signal0
)
).
:- pred we_have_seen_more_signal(cost_after_signal::in, cost_after_signal::in)
is semidet.
we_have_seen_more_signal(SignalA, SignalB) :-
seen_more_signal(SignalA, SignalB) = yes.
:- func seen_more_signal(cost_after_signal, cost_after_signal) = bool.
seen_more_signal(FinalSignal0, FinalSignal) = SeenMoreSignal :-
(
FinalSignal0 = not_seen_signal,
SeenMoreSignal = yes
;
FinalSignal0 = code_has_no_solutions,
(
( FinalSignal = not_seen_signal
; FinalSignal = seen_signal_negligible_cost_after
; FinalSignal = seen_signal_non_negligible_cost_after
),
SeenMoreSignal = no
;
FinalSignal = code_has_no_solutions,
SeenMoreSignal = yes
)
;
FinalSignal0 = seen_signal_negligible_cost_after,
(
FinalSignal = not_seen_signal,
SeenMoreSignal = no
;
( FinalSignal = code_has_no_solutions
; FinalSignal = seen_signal_negligible_cost_after
; FinalSignal = seen_signal_non_negligible_cost_after
),
SeenMoreSignal = yes
)
;
FinalSignal0 = seen_signal_non_negligible_cost_after,
(
( FinalSignal = not_seen_signal
; FinalSignal = seen_signal_negligible_cost_after
),
SeenMoreSignal = no
;
( FinalSignal = code_has_no_solutions
; FinalSignal = seen_signal_non_negligible_cost_after
),
SeenMoreSignal = yes
)
).
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
%
% Utilities for working with par_builtin.
%
% Given a variable SharedVar of type SharedVarType, add a new variable
% FutureVar of type future(SharedVarType), add the mapping from SharedVar
% to FutureVar to FutureMap, and generate the goal AllocGoal that calls
% `par_builtin.new_future/1' to allocate FutureVar.
%
:- pred allocate_future(module_info::in, prog_var::in, list(hlds_goal)::out,
var_table::in, var_table::out, future_map::in, future_map::out,
ts_string_table::in, ts_string_table::out) is det.
allocate_future(ModuleInfo, SharedVar, Goals, !VarTable,
!FutureMap, !TSStringTable) :-
lookup_var_entry(!.VarTable, SharedVar, SharedVarEntry),
SharedVarType = SharedVarEntry ^ vte_type,
SharedVarName = var_entry_name(SharedVar, SharedVarEntry),
make_future_var(SharedVarName, SharedVarType, FutureVar, FutureVarType,
!VarTable),
make_future_name_var_and_goal(SharedVarName, FutureNameVar, SetNameGoal,
!VarTable, !TSStringTable),
map.det_insert(SharedVar, FutureVar, !FutureMap),
ModuleName = mercury_par_builtin_module,
PredName = new_future_pred_name,
Features = [],
InstMapDelta = instmap_delta_bind_var(FutureVar),
Context = dummy_context,
ShouldInline = should_inline_par_builtin_calls(ModuleInfo),
(
ShouldInline = do_not_inline_par_builtins,
ArgVars = [FutureNameVar, FutureVar],
generate_plain_call(ModuleInfo, pf_predicate, ModuleName, PredName,
[], ArgVars, InstMapDelta, only_mode, detism_det, purity_pure,
Features, Context, AllocGoal)
;
ShouldInline = inline_par_builtins,
ForeignAttrs = par_builtin_foreign_proc_attributes(purity_pure,
no_request_for_call_std_out_regs),
ArgName = foreign_arg(FutureNameVar,
yes(foreign_arg_name_mode("Name", in_mode)),
builtin_type(builtin_type_int(int_type_int)),
bp_native_if_possible),
ArgFuture = foreign_arg(FutureVar,
yes(foreign_arg_name_mode("Future", out_mode)),
FutureVarType, bp_native_if_possible),
Args = [ArgName, ArgFuture],
ExtraArgs = [],
Code = new_future_code,
generate_call_foreign_proc(ModuleInfo, pf_predicate,
ModuleName, PredName, [], Args, ExtraArgs, InstMapDelta,
only_mode, detism_det, purity_pure, Features, ForeignAttrs,
no, Code, Context, AllocGoal)
),
Goals = [SetNameGoal, AllocGoal].
% Given a variable SharedVar of type SharedVarType, add a new variable
% FutureVar of type future(SharedVarType).
%
:- pred make_future_var(string::in, mer_type::in,
prog_var::out, mer_type::out, var_table::in, var_table::out) is det.
make_future_var(SharedVarName, SharedVarType, FutureVar, FutureVarType,
!VarTable) :-
FutureVarType = future_type(SharedVarType),
FutureVarName = "Future" ++ SharedVarName,
FutureVarEntry = vte(FutureVarName, FutureVarType, is_not_dummy_type),
add_var_entry(FutureVarEntry, FutureVar, !VarTable).
:- pred make_future_name_var_and_goal(string::in,
prog_var::out, hlds_goal::out, var_table::in, var_table::out,
ts_string_table::in, ts_string_table::out) is det.
make_future_name_var_and_goal(Name, FutureNameVar, Goal,
!VarTable, !TSStringTable) :-
FutureNameVarName = "FutureName" ++ Name,
FutureNameVarEntry = vte(FutureNameVarName, int_type, is_not_dummy_type),
add_var_entry(FutureNameVarEntry, FutureNameVar, !VarTable),
allocate_ts_string(Name, NameId, !TSStringTable),
NameIdConsId = some_int_const(int_const(NameId)),
RHS = rhs_functor(NameIdConsId, is_not_exist_constr, []),
Ground = ground(unique, none_or_default_func),
UnifyMode = unify_modes_li_lf_ri_rf(free, Ground, Ground, Ground),
Unification = construct(FutureNameVar, NameIdConsId, [], [],
construct_statically(born_static), cell_is_unique,
no_construct_sub_info),
UnifyContext =
unify_context(umc_implicit("dep_par_conj transformation"), []),
GoalExpr = unify(FutureNameVar, RHS, UnifyMode, Unification, UnifyContext),
InstmapDelta = instmap_delta_from_assoc_list([FutureNameVar - Ground]),
goal_info_init(set_of_var.make_singleton(FutureNameVar), InstmapDelta,
detism_det, purity_pure, GoalInfo),
Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred make_wait_goal(module_info::in, var_table::in,
prog_var::in, prog_var::in, hlds_goal::out) is det.
make_wait_goal(ModuleInfo, VarTable, FutureVar, WaitVar, WaitGoal) :-
make_wait_or_get(ModuleInfo, VarTable, FutureVar, WaitVar, wait_pred,
WaitGoal).
:- pred make_get_goal(module_info::in, var_table::in, future_var_pair::in,
hlds_goal::out) is det.
make_get_goal(ModuleInfo, VarTable, future_var_pair(FutureVar, WaitVar),
WaitGoal) :-
make_wait_or_get(ModuleInfo, VarTable, FutureVar, WaitVar, get_pred,
WaitGoal).
:- type wait_or_get_pred
---> wait_pred
; get_pred.
:- pred make_wait_or_get(module_info::in, var_table::in,
prog_var::in, prog_var::in, wait_or_get_pred::in, hlds_goal::out) is det.
make_wait_or_get(ModuleInfo, VarTable, FutureVar, ConsumedVar, WaitOrGetPred,
WaitGoal) :-
ModuleName = mercury_par_builtin_module,
(
WaitOrGetPred = wait_pred,
PredName = wait_future_pred_name,
Purity = purity_impure,
Code = "MR_par_builtin_wait_future(Future, Value);"
;
WaitOrGetPred = get_pred,
PredName = get_future_pred_name,
Purity = purity_pure,
Code = "MR_par_builtin_get_future(Future, Value);"
),
Features = [],
InstMapDelta = instmap_delta_bind_var(ConsumedVar),
Context = dummy_context,
ShouldInline = should_inline_par_builtin_calls(ModuleInfo),
(
ShouldInline = do_not_inline_par_builtins,
ArgVars = [FutureVar, ConsumedVar],
generate_plain_call(ModuleInfo, pf_predicate, ModuleName, PredName,
[], ArgVars, InstMapDelta, only_mode, detism_det, Purity,
Features, Context, WaitGoal)
;
ShouldInline = inline_par_builtins,
ForeignAttrs = par_builtin_foreign_proc_attributes(Purity,
no_request_for_call_std_out_regs),
lookup_var_type(VarTable, FutureVar, FutureVarType),
lookup_var_type(VarTable, ConsumedVar, ConsumedVarType),
Arg1 = foreign_arg(FutureVar,
yes(foreign_arg_name_mode("Future", in_mode)),
FutureVarType, bp_native_if_possible),
Arg2 = foreign_arg(ConsumedVar,
yes(foreign_arg_name_mode("Value", out_mode)),
ConsumedVarType, bp_native_if_possible),
Args = [Arg1, Arg2],
ExtraArgs = [],
generate_call_foreign_proc(ModuleInfo, pf_predicate,
ModuleName, PredName, [], Args, ExtraArgs, InstMapDelta, only_mode,
detism_det, Purity, Features, ForeignAttrs,
no, Code, Context, WaitGoal)
).
:- pred make_signal_goal(module_info::in, var_table::in, future_map::in,
prog_var::in, hlds_goal::out) is det.
make_signal_goal(ModuleInfo, VarTable, FutureMap, ProducedVar, SignalGoal) :-
FutureVar = map.lookup(FutureMap, ProducedVar),
ModuleName = mercury_par_builtin_module,
PredName = signal_future_pred_name,
Features = [],
InstMapDelta = instmap_delta_bind_no_var,
Context = dummy_context,
ShouldInline = should_inline_par_builtin_calls(ModuleInfo),
(
ShouldInline = do_not_inline_par_builtins,
ArgVars = [FutureVar, ProducedVar],
generate_plain_call(ModuleInfo, pf_predicate, ModuleName, PredName,
[], ArgVars, InstMapDelta, only_mode, detism_det, purity_impure,
Features, Context, SignalGoal)
;
ShouldInline = inline_par_builtins,
ForeignAttrs = par_builtin_foreign_proc_attributes(purity_impure,
needs_call_std_out_regs),
lookup_var_type(VarTable, FutureVar, FutureVarType),
lookup_var_type(VarTable, ProducedVar, ProducedVarType),
Arg1 = foreign_arg(FutureVar,
yes(foreign_arg_name_mode("Future", in_mode)),
FutureVarType, bp_native_if_possible),
Arg2 = foreign_arg(ProducedVar,
yes(foreign_arg_name_mode("Value", in_mode)),
ProducedVarType, bp_native_if_possible),
Args = [Arg1, Arg2],
ExtraArgs = [],
Code = "MR_par_builtin_signal_future(Future, Value);",
generate_call_foreign_proc(ModuleInfo, pf_predicate,
ModuleName, PredName, [], Args, ExtraArgs, InstMapDelta,
only_mode, detism_det, purity_impure, Features, ForeignAttrs,
no, Code, Context, SignalGoal)
).
:- pred is_wait_goal(hlds_goal::in) is semidet.
is_wait_goal(hlds_goal(plain_call(_, _, _, _, _, SymName), _GoalInfo)) :-
SymName = qualified(mercury_par_builtin_module, wait_future_pred_name).
:- pred is_signal_goal(hlds_goal::in) is semidet.
is_signal_goal(hlds_goal(plain_call(_, _, _, _, _, SymName), _GoalInfo)) :-
SymName = qualified(mercury_par_builtin_module, signal_future_pred_name).
:- func new_future_pred_name = string.
:- func wait_future_pred_name = string.
:- func get_future_pred_name = string.
:- func signal_future_pred_name = string.
new_future_pred_name = "new_future".
wait_future_pred_name = "wait_future".
get_future_pred_name = "get_future".
signal_future_pred_name = "signal_future".
:- func new_future_code = string.
new_future_code = "
#ifdef MR_THREADSCOPE
MR_par_builtin_new_future(Name, Future);
#else
MR_par_builtin_new_future(Future);
#endif
".
:- func should_inline_par_builtin_calls(module_info) =
maybe_inline_par_builtins.
should_inline_par_builtin_calls(ModuleInfo) = ShouldInline :-
module_info_get_globals(ModuleInfo, Globals),
globals.get_opt_tuple(Globals, OptTuple),
ShouldInline = OptTuple ^ ot_inline_par_builtins.
:- func par_builtin_foreign_proc_attributes(purity, maybe_call_std_out_regs)
= foreign_proc_attributes.
par_builtin_foreign_proc_attributes(Purity, CallStdOutRegs) = !:Attrs :-
!:Attrs = default_attributes(lang_c),
set_may_call_mercury(proc_will_not_call_mercury, !Attrs),
% Even signal is thread safe, since it does its own locking.
set_thread_safe(proc_thread_safe, !Attrs),
set_purity(Purity, !Attrs),
set_terminates(proc_terminates, !Attrs),
set_may_throw_exception(proc_will_not_throw_exception, !Attrs),
set_may_modify_trail(proc_will_not_modify_trail, !Attrs),
set_affects_liveness(proc_does_not_affect_liveness, !Attrs),
set_allocates_memory(proc_allocates_bounded_memory, !Attrs),
set_registers_roots(proc_does_not_register_roots, !Attrs),
set_call_std_out_regs(CallStdOutRegs, !Attrs),
set_may_duplicate(yes(proc_may_duplicate), !Attrs).
%---------------------------------------------------------------------------%
:- pred conjoin_goal_and_goal_list_update_goal_infos(hlds_goal_info::in,
hlds_goal::in, list(hlds_goal)::in, hlds_goal::out) is det.
conjoin_goal_and_goal_list_update_goal_infos(!.GoalInfo, GoalA, GoalsB,
Goal) :-
GoalA = hlds_goal(GoalExprA, _),
( if GoalExprA = conj(plain_conj, GoalListA) then
GoalList = GoalListA ++ GoalsB
else
GoalList = [GoalA | GoalsB]
),
GoalExpr = conj(plain_conj, GoalList),
goal_list_determinism(GoalList, Detism),
goal_list_instmap_delta(GoalList, InstMapDelta),
goal_list_nonlocals(GoalList, NonLocals),
goal_info_set_nonlocals(NonLocals, !GoalInfo),
goal_info_set_determinism(Detism, !GoalInfo),
goal_info_set_instmap_delta(InstMapDelta, !GoalInfo),
Goal = hlds_goal(GoalExpr, !.GoalInfo).
:- pred conjoin_goals_update_goal_infos(hlds_goal_info::in,
hlds_goal::in, hlds_goal::in, hlds_goal::out) is det.
conjoin_goals_update_goal_infos(GoalInfo, GoalA, GoalB, Goal) :-
( if GoalB = hlds_goal(conj(plain_conj, GoalsB), _) then
GoalListB = GoalsB
else
GoalListB = [GoalB]
),
conjoin_goal_and_goal_list_update_goal_infos(GoalInfo, GoalA, GoalListB,
Goal).
%---------------------------------------------------------------------------%
% Given the conjunct goals in a parallel conjunction and the instmap before
% it, return the set of variables that need synchronization, i.e. the
% variables that are produced in one conjunct and consumed in one or more
% other conjuncts.
%
:- func find_shared_variables(module_info, instmap, list(hlds_goal))
= set_of_progvar.
find_shared_variables(ModuleInfo, InstMap, Goals) = SharedVars :-
% If a variable is nonlocal to a conjunct, and appears in the instmap_delta
% of a _different_ conjunct, then we say that variable is shared.
%
% (1) A variable must be nonlocal to a conjunct if it is shared.
% (2) If the variable does not appear in the instmap_delta
% of any of the conjuncts of the parallel conjunction
% then it could not have been further instantiated within
% by the conjunction as a whole.
%
% XXX This code is probably too complicated. I think Thomas already had a
% more elegant way to find the shared variables somewhere, using multisets.
%
list.map2(get_nonlocals_and_instmaps, Goals, Nonlocals, InstMapDeltas),
find_shared_variables_2(ModuleInfo, 0, Nonlocals, InstMap, InstMapDeltas,
set_of_var.init, SharedVars).
:- pred get_nonlocals_and_instmaps(hlds_goal::in,
set_of_progvar::out, instmap_delta::out) is det.
get_nonlocals_and_instmaps(hlds_goal(_, GoalInfo), Nonlocals, InstMapDelta) :-
Nonlocals = goal_info_get_nonlocals(GoalInfo),
InstMapDelta = goal_info_get_instmap_delta(GoalInfo).
:- pred find_shared_variables_2(module_info::in, int::in,
list(set_of_progvar)::in, instmap::in, list(instmap_delta)::in,
set_of_progvar::in, set_of_progvar::out) is det.
find_shared_variables_2(_ModuleInfo, _ConjunctIndex,
[], _InstMap, _InstMapDeltas, !SharedVars).
find_shared_variables_2(ModuleInfo, ConjunctIndex,
[Nonlocals | MoreNonlocals], InstMap, InstMapDeltas, !SharedVars) :-
det_delete_nth(ConjunctIndex, InstMapDeltas, InstMapDeltasB),
% Keep only nonlocals which were not already bound at the start of the
% parallel conjunction.
Filter =
( pred(Var::in) is semidet :-
instmap_lookup_var(InstMap, Var, VarInst),
not inst_is_bound(ModuleInfo, VarInst)
),
UnboundNonlocals = set_of_var.filter(Filter, Nonlocals),
Changed =
set_of_var.filter(changed_var(ModuleInfo, InstMapDeltasB),
UnboundNonlocals),
set_of_var.union(Changed, !SharedVars),
find_shared_variables_2(ModuleInfo, ConjunctIndex+1, MoreNonlocals,
InstMap, InstMapDeltas, !SharedVars).
:- pred changed_var(module_info::in, list(instmap_delta)::in, prog_var::in)
is semidet.
changed_var(ModuleInfo, InstMapDeltas, UnboundVar) :-
% Is the unbound nonlocal bound in one of the conjuncts?
list.member(InstMapDelta, InstMapDeltas),
instmap_delta_search_var(InstMapDelta, UnboundVar, Inst),
inst_is_bound(ModuleInfo, Inst).
%---------------------------------------------------------------------------%
:- pred fixup_and_reinsert_proc(pred_id::in, proc_id::in,
pred_info::in, proc_info::in, module_info::in, module_info::out) is det.
fixup_and_reinsert_proc(PredId, ProcId, !.PredInfo, !.ProcInfo, !ModuleInfo) :-
requantify_proc_general(ord_nl_no_lambda, !ProcInfo),
recompute_instmap_delta_proc(no_recomp_atomics, !ProcInfo, !ModuleInfo),
pred_info_set_proc_info(ProcId, !.ProcInfo, !PredInfo),
repuritycheck_proc(!.ModuleInfo, proc(PredId, ProcId), !PredInfo),
module_info_set_pred_info(PredId, !.PredInfo, !ModuleInfo).
:- pred det_delete_nth(int::in, list(T)::in, list(T)::out) is det.
det_delete_nth(N, List0, List) :-
list.det_split_list(N, List0, Left, Right),
List = Left ++ det_tail(Right).
:- pred var_in_nonlocals(hlds_goal::in, prog_var::in) is semidet.
var_in_nonlocals(Goal, Var) :-
set_of_var.member(goal_get_nonlocals(Goal), Var).
:- pred var_not_in_nonlocals(hlds_goal::in, prog_var::in) is semidet.
var_not_in_nonlocals(Goal, Var) :-
not var_in_nonlocals(Goal, Var).
%---------------------------------------------------------------------------%
%
% Threadscope support used in this module.
%
:- type ts_string_table
---> ts_string_table(
st_lookup_map :: map(string, int),
st_rev_table :: list(string),
st_size :: int
).
:- pred allocate_ts_string(string::in, int::out,
ts_string_table::in, ts_string_table::out) is det.
allocate_ts_string(String, Id, !Table) :-
!.Table = ts_string_table(Map0, RevTable0, Size0),
( if map.search(Map0, String, ExistingId) then
Id = ExistingId
else
Id = Size0,
Size = Size0 + 1,
RevTable = [String | RevTable0],
map.det_insert(String, Id, Map0, Map),
!:Table = ts_string_table(Map, RevTable, Size)
).
:- pred make_ts_string_table(list(string)::in, ts_string_table::out) is det.
make_ts_string_table(RevTable, ts_string_table(Map, RevTable, Size)) :-
make_ts_string_table_2(RevTable, Size, map.init, Map).
:- pred make_ts_string_table_2(list(string)::in, int::out,
map(string, int)::in, map(string, int)::out) is det.
make_ts_string_table_2([], 0, !Map).
make_ts_string_table_2([Str | Strs], Size, !Map) :-
make_ts_string_table_2(Strs, Size0, !Map),
Size = Size0 + 1,
map.det_insert(Str, Size0, !Map).
%---------------------------------------------------------------------------%
:- end_module transform_hlds.dep_par_conj.
%---------------------------------------------------------------------------%