mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-16 09:53:36 +00:00
Code Issues Projects Releases Wiki Activity
Files
faffe6c42ceb7dbc19a33529035529f29f04ada6
mercury/compiler/loop_inv.m
Zoltan Somogyi 62ec97d443 Report imports shadowed by other imports. 
If a module has two or more import_module or use_module declarations
for the same module, (typically, but not always, one being in its interface
and one in its implementation), generate an informational message about
each redundant declaration if --warn-unused-imports is enabled.

compiler/hlds_module.m:
    We used to record the set of imported/used modules, and the set of
    modules imported/used in the interface of the current module. However,
    these sets

    - did not record the distinction between imports and uses;
    - did not allow distinction between single and multiple imports/uses;
    - did not record the locations of the imports/uses.

    The first distinction was needed only by module_qual.m, which *did*
    pay attention to it; the other two were not needed at all.

    To generate messages for imports/uses shadowing other imports/uses,
    we need all three, so change the data structure storing such information
    for *direct* imports to one that records all three of the above kinds
    of information. (For imports made by read-in interface and optimization
    files, the old set of modules approach is fine, and this diff leaves
    the set of thus *indirectly* imported module names alone.)

compiler/unused_imports.m:
    Use the extra information now available to generate a
    severity_informational message about any import or use that is made
    redundant by an earlier, more general import or use.

    Fix two bugs in the code that generated warnings for just plain unused
    modules.

    (1) It did not consider that a use of the builtin type char justified
    an import of char.m, but without that import, the type is not visible.

    (2) It scanned cons_ids in goals in procedure bodies, but did not scan
    cons_ids that have been put into the const_struct_db. (I did not update
    the code here when I added the const_struct_db.)

    Also, add a (hopefully temporary) workaround for a bug in
    make_hlds_passes.m, which is noted below.

    However, there are at least three problems that prevent us from enabling
    --warn-unused-imports by default.

    (1) In some places, the import of a module is used only by clauses for
    a predicate that also has foreign procs. When compiled in a grade that
    selects one of those foreign_procs as the implementation of the predicate,
    the clauses are discarded *without* being added to the HLDS at all.
    This leads unused_imports.m to generate an uncalled-for warning in such
    cases. To fix this, we would need to preserve the Mercury clauses for
    *all* predicates, even those with foreign procs, and do all the semantic
    checks on them before throwing them away. (I tried to do this once, and
    failed, but the task should be easier after the item list change.)

    (2) We have two pieces of code to generate import warnings. The one in
    unused_imports.m operates on the HLDS after type and mode checking,
    while module_qual.m operates on the parse tree before the creation of
    the HLDS. The former is more powerful, since it knows e.g. what types and
    modes are used in the bodies of predicates, and hence can generate warnings
    about an import being unused *anywhere* in a module, as opposed to just
    unused in its interface.

    If --warn-unused-imports is enabled, we will get two separate set of
    reports about an interface import being unused in the interface,
    *unless* we get a type or mode error, in which case unused_imports.m
    won't be invoked. But in case we do get such errors, we don't want to
    throw away the warnings from module_qual.m. We could store them and
    throw them away only after we know we won't need them, or just get
    the two modules to generate identical error_specs for each warning,
    so that the sort_and_remove_dups of the error specs will do the
    throwing away for us for free, if we get that far.

    (3) The valid/bug100.m test case was added as a regression test for a bug
    that was fixed in module_qual.m. However the bug is still present in
    unused_imports.m.

compiler/make_hlds_passes.m:
    Give hlds_module.m the extra information it now needs for each item_avail.

    Add an XXX for a bug that cannot be fixed right now: the setting of
    the status of abstract instances to abstract_imported. (The "abstract"
    part is correct; the "imported" part may not be.)

compiler/intermod.m:
compiler/try_expand.m:
compiler/xml_documentation.m:
    Conform to the change in hlds_module.m.

compiler/module_qual.m:
    Update the documentation of the relationship of this module
    with unused_imports.m.

compiler/hlds_data.m:
    Document a problem with the status of instance definitions.

compiler/hlds_out_module.m:
    Update the code that prints out the module_info to conform to the change
    to hlds_module.m.

    Print status information about instances, which was needed to diagnose
    one of the bugs in unused_imports.m. Format the output for instances
    nicer.

compiler/prog_item.m:
    Add a convenience predicate.

compiler/prog_data.m:
    Remove a type synonym that makes things harder to understand, not easier.

compiler/modules.m:
    Delete an XXX that asks for the feature this diff implements.
    Add another XXX about how that feature could be improved.

compiler/Mercury.options.m:
    Add some more modules to the list of modules on which the compiler
    should be invoked with --no-warn-unused-imports.

compiler/*.m:
library/*.m:
mdbcomp/*.m:
browser/*.m:
deep_profiler/*.m:
mfilterjavac/*.m:
    Delete unneeded imports. Many of these shadow other imports, and some
    are just plain unneeded, as shown by --warn-unused-imports. In a few
    modules, there were a *lot* of unneeded imports, but most had just
    one or two.

    In a few cases, removing an import from a module, because it *itself*
    does not need it, required adding that same import to those of its
    submodules which *do* need it.

    In a few cases, conform to other changes above.

tests/invalid/Mercury.options:
    Test the generation of messages about import shadowing on the existing
    import_in_parent.m test case (although it was also tested very thoroughly
    when giving me the information needed for the deletion of all the
    unneeded imports above).

tests/*/*.{m,*exp}:
    Delete unneeded imports, and update any expected error messages
    to expect the now-smaller line numbers.
2015-08-25 00:38:49 +10:00

1344 lines
51 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ts=4 sw=4 et ft=mercury
%-----------------------------------------------------------------------------%
% Copyright (C) 2002-2012 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: loop_inv.m.
% Main author: rafe.
%
% This module implements conservative loop invariant hoisting.
% The basic idea can be outlined as a transformation on functions.
% We want to convert
%
% f(X, Y) = if p(X, Y) then g(X, Y) else f(X, h(i(X), Y))
%
% to
%
% f(X, Y) = if p(X, Y) then g(X, Y) else f2(X, i(X), h(i(X), Y))
%
% f2(X, W, Y) = if p(X, Y) then g(X, Y) else f2(X, W, h(W, Y))
%
% where W, X, Y may each stand for one or more program variables.
% X stands for the loop invariant original arguments,
% W stands for the loop invariant variables that originally were not arguments,
% and Y stands for the original arguments that are not loop invariant.
%
% In the HLDS, functions are converted to predicates, hence the above
% will look like this:
%
% f(X, Y, R) :-
% if p(X, Y) then g(X, Y, R)
% else i(X, W), h(W, Y, V), f(X, V, R).
%
% and will be translated by the optimization into
%
% f(X, Y, R) :-
% if p(X, Y) then g(X, Y, R)
% else i(X, W), h(W, Y, V), f2(X, W, V, R).
%
% f2(X, W, Y, R) :-
% if p(X, Y) then g(X, Y, R)
% else h(W, Y, V), f2(X, W, V, R).
%
% We proceed as follows:
%
% 1. Identify the invariant args to f (that is, all input args that
% are identical across all calls to f at the end of recursive paths.
% (A recursive path is a path from the start of the definition of f
% to a recursive call to f comprised entirely of model det goals,
% other than in the conditions of if-then-elses or switch
% unifications.)
%
% 2. Identify the set of invariant goals and vars in the body of f:
% - A var is invariant iff it is an invariant arg or it is the output
% of an invariant goal.
% - A goal is invariant iff
% - it is model det,
% - it is invoked on all recursive paths, and
% - all of its input args are invariant vars.
%
% In the example above, X is an invariant arg, i(X, W) is an
% invariant goal, X and W are invariant vars, and
%
% /* if */ p(X, Y), /* else */ i(X, W), h(W, Y, V), f(X, V, R)
%
% is a recursive path.
%
% At this point we construct f2, which is a copy of f taking the
% invariant vars as extra args, in which the invariant goals
% appearing on the recursive paths have been deleted, and in
% which the recursive calls to f at the end of the recursive paths
% have been replaced with calls to f2.
%
% We adjust the definition of f such that the recursive calls to f
% at the end of the recursive paths are replaced with calls to f2.
%
%
%
% NOTE that this version of the optimization does not perform
% variable renaming, so the two calls to i/1 in the code below
% will not be hoisted because they have different output variables:
%
% f(X, Y, R) :-
% if p(X, Y) then g(X, Y, R)
% else if q(X, Y) then i(X, W1), h1(W1, Y, V), f(X, V, R)
% else i(X, W2), h1(W2, Y, V), f(X, V, R)
%
% In general this means that currently the optimization will only be
% effective if there is a single recursive call.
%
% This may be the subject of a future improvement of the optimization.
% Similarly for broadening the scope of the optimization to include non
% model_det recursive paths.
%
%-----------------------------------------------------------------------------%
:- module transform_hlds.loop_inv.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_module.
%-----------------------------------------------------------------------------%
% hoist_loop_invariants(PredProcId, PredInfo,
% ProcInfo0, ProcInfo, ModuleInfo0, ModuleInfo)
%
% Analyze the procedure identified by PredProcId and, if appropriate,
% split it into two applying the loop invariant hoisting optimization.
%
:- pred hoist_loop_invariants(pred_proc_id::in, pred_info::in,
proc_info::in, proc_info::out, module_info::in, module_info::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.
:- import_module check_hlds.inst_match.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_util.
:- import_module hlds.code_model.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.instmap.
:- import_module hlds.make_goal.
:- import_module hlds.quantification.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_util.
:- import_module parse_tree.set_of_var.
:- import_module assoc_list.
:- import_module cord.
:- import_module list.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module term.
%-----------------------------------------------------------------------------%
hoist_loop_invariants(PredProcId, PredInfo, !ProcInfo, !ModuleInfo) :-
(
% We only want to apply this optimization to pure preds (e.g.
% not benchmark_det_loop).
pred_info_get_purity(PredInfo, purity_pure),
% Next, work out whether this predicate is optimizable and
% compute some auxiliary results along the way.
proc_info_get_goal(!.ProcInfo, Body),
proc_info_get_headvars(!.ProcInfo, HeadVars),
proc_info_get_argmodes(!.ProcInfo, HeadVarModes),
% Find the set of variables that are used as (partly) unique inputs
% to calls. These variables are not safe candidates for hoisting.
% (A variable whose initial bound inst is inferred as unique may be
% hoistable if it is not used as a unique input to any call.)
UniquelyUsedVars = uniquely_used_vars(!.ModuleInfo, Body),
% Find the set of candidate goals that may be invariant
% and the set of recursive calls involved.
%
% A goal must appear on all recursive paths to be a candidate.
%
% The recursive calls are the set of calls at the end of each
% recursive path.
invariant_goal_candidates_in_proc(!.ModuleInfo, PredProcId, Body,
InvGoals0, RecCalls),
% We can calculate the set of invariant args from the set of
% recursive calls.
InvArgs0 = inv_args(!.ModuleInfo, HeadVars, HeadVarModes, RecCalls),
InvArgs = InvArgs0 `delete_elems` UniquelyUsedVars,
% Given the invariant args, we can calculate the set of
% invariant goals and vars.
inv_goals_vars(!.ModuleInfo, UniquelyUsedVars,
InvGoals0, InvGoals1, InvArgs, InvVars1),
% We don't want to hoist out unifications with constants (i.e.
% constructions where the RHS has no arguments) or deconstructions
% (it is probably cheaper to do the dereference than pass an extra
% argument).
%
% We also don't want to hoist out goals that can't succeed,
% e.g. calls to error/1, and in fact we MUST NOT hoist out
% such goals, because if we hoisted out such goals, later
% passes might think that the code which follows is actually
% reachable, which may lead to internal errors because code
% after a call to error/1 does NOT need to be determinism-correct.
%
% We also must not hoist impure goals.
%
% So here we compute the subset of InvGoals (and the corresponding
% InvVars) that should not be hoisted.
do_not_hoist(!.ModuleInfo, InvGoals1, DontHoistGoals, DontHoistVars),
list.delete_elems(InvGoals1, DontHoistGoals, InvGoals),
list.delete_elems(InvVars1, DontHoistVars, InvVars),
% We only apply the optimization if the set of invariant goals
% is non-empty.
InvGoals = [_ | _]
% NOTE! At this point it is vital that
% - none of the InvVars are used as (partially) unique inputs
% in any goals;
% - all of the InvVars are either head vars or constructed by one of
% the InvGoals;
% - all non-local vars in InvGoals are also in InvVars.
->
% The set of computed invariant vars is the difference between
% the whole invariant var set and the set of invariant args.
%
% Some of these variables may only appear in the invariant goals,
% and would be unused in the auxiliary procedure. Head variables may
% become unused as well. We rely on the unused argument elimination
% pass to remove both.
list.delete_elems(InvVars, InvArgs, ComputedInvVars),
% We need to calculate the initial instmap for the aux proc by applying
% the instmap_deltas from the InvGoals to InitialInstMap.
proc_info_get_initial_instmap(!.ProcInfo, !.ModuleInfo,
InitialInstMap),
InitialAuxInstMap =
compute_initial_aux_instmap(InvGoals, InitialInstMap),
% Create the pred for the aux proc. This is initially a copy of the
% in proc with the head vars extended with the list of computed
% inv vars. The body is adjusted appropriately in the next step.
create_aux_pred(PredProcId, HeadVars, ComputedInvVars,
InitialAuxInstMap, AuxPredProcId, CallAux,
AuxPredInfo, AuxProcInfo, !ModuleInfo),
% We update the body of AuxProc by replacing adding the set of
% computed invariant vars to the argument list, replacing invariant
% goals in InProc with `true', and recursive calls at the end of
% recursive paths with calls to the auxiliary procedure.
gen_aux_proc(InvGoals, PredProcId, AuxPredProcId, CallAux, Body,
AuxPredInfo, AuxProcInfo, !ModuleInfo),
% We construct OutProc by replacing recursive calls to the InProc
% at the end of recursive paths with calls to the auxiliary procedure.
gen_out_proc(PredProcId, PredInfo, !ProcInfo, CallAux, Body,
!ModuleInfo)
;
true
).
%-----------------------------------------------------------------------------%
:- type rec_call ==
pair(
hlds_goal, % The recursive call.
list(hlds_goal) % The candidate invariant goal list
% for this recursive call.
).
:- type igc_info
---> igc_info(
igc_module_info :: module_info,
% path_candidates is the list of accumulated invariant
% goal candidates.
igc_path_candidates :: cord(hlds_goal),
% rec_calls pairs each recursive call with the list of
% path_candidates up to that call. We extend this list
% whenever we identify a new recursive call.
igc_rec_calls :: list(rec_call)
).
% invariant_goal_candidates_in_proc(PredProcId, Body, CandidateInvGoals,
% RecCallGoals):
%
% Computes (a conservative approximation to) the set of candidate
% invariant atomic goals in Body and the set of recursive calls
% in Body identified via PredProcId.
%
:- pred invariant_goal_candidates_in_proc(module_info::in, pred_proc_id::in,
hlds_goal::in, hlds_goals::out, hlds_goals::out) is det.
invariant_goal_candidates_in_proc(ModuleInfo, PredProcId, Body,
CandidateInvGoals, RecCallGoals) :-
GoalCandidates0 = igc_info(ModuleInfo, cord.empty, []),
invariant_goal_candidates_in_goal(PredProcId, Body,
GoalCandidates0, GoalCandidates),
GoalCandidates = igc_info(_, _, RecCalls),
assoc_list.keys_and_values(RecCalls, RecCallGoals, CandidateInvGoalsList),
CandidateInvGoals = intersect_candidate_inv_goals(CandidateInvGoalsList).
%-----------------------------------------------------------------------------%
:- pred invariant_goal_candidates_in_goal(pred_proc_id::in, hlds_goal::in,
igc_info::in, igc_info::out) is det.
invariant_goal_candidates_in_goal(PPId, Goal, !IGCs) :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
( proc(PredId, ProcId) = PPId ->
add_recursive_call(Goal, !IGCs)
;
invariant_goal_candidates_handle_primitive_goal(Goal, !IGCs)
)
;
( GoalExpr = generic_call(_, _, _, _, _)
; GoalExpr = unify(_, _, _, _, _)
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
),
invariant_goal_candidates_handle_primitive_goal(Goal, !IGCs)
;
GoalExpr = conj(ConjType, Conjuncts),
(
ConjType = plain_conj,
invariant_goal_candidates_in_plain_conj(PPId, Conjuncts, !IGCs)
;
ConjType = parallel_conj,
invariant_goal_candidates_in_parallel_conj(PPId, Conjuncts, !IGCs)
)
;
GoalExpr = disj(Disjuncts),
invariant_goal_candidates_in_disj(PPId, Disjuncts, !IGCs)
;
GoalExpr = switch(_, _, Cases),
invariant_goal_candidates_in_switch(PPId, Cases, !IGCs)
;
GoalExpr = negation(SubGoal),
invariant_goal_candidates_keeping_path_candidates(PPId, SubGoal, !IGCs)
;
GoalExpr = scope(_Reason, SubGoal),
% XXX We should specialize the handling of from_ground_term_construct
% scopes here.
invariant_goal_candidates_keeping_path_candidates(PPId, SubGoal, !IGCs)
;
GoalExpr = if_then_else(_XVs, Cond, Then, Else),
PathCandidates0 = !.IGCs ^ igc_path_candidates,
invariant_goal_candidates_in_goal(PPId, Cond, !IGCs),
invariant_goal_candidates_in_goal(PPId, Then, !IGCs),
!IGCs ^ igc_path_candidates := PathCandidates0,
invariant_goal_candidates_keeping_path_candidates(PPId, Else, !IGCs)
;
GoalExpr = shorthand(_),
% These should have been expanded out by now.
unexpected($module, $pred, "shorthand")
).
%-----------------------------------------------------------------------------%
:- pred invariant_goal_candidates_keeping_path_candidates(pred_proc_id::in,
hlds_goal::in, igc_info::in, igc_info::out) is det.
invariant_goal_candidates_keeping_path_candidates(PPId, Goal, !IGCs) :-
PathCandidates0 = !.IGCs ^ igc_path_candidates,
invariant_goal_candidates_in_goal(PPId, Goal, !IGCs),
!IGCs ^ igc_path_candidates := PathCandidates0.
%-----------------------------------------------------------------------------%
:- pred invariant_goal_candidates_in_plain_conj(pred_proc_id::in,
list(hlds_goal)::in, igc_info::in, igc_info::out) is det.
invariant_goal_candidates_in_plain_conj(_, [], !IGCs).
invariant_goal_candidates_in_plain_conj(PPId, [Goal | Goals], !IGCs) :-
invariant_goal_candidates_in_goal(PPId, Goal, !IGCs),
invariant_goal_candidates_in_plain_conj(PPId, Goals, !IGCs).
:- pred invariant_goal_candidates_in_parallel_conj(pred_proc_id::in,
list(hlds_goal)::in, igc_info::in, igc_info::out) is det.
invariant_goal_candidates_in_parallel_conj(_, [], !IGCs).
invariant_goal_candidates_in_parallel_conj(PPId, [Goal | Goals], !IGCs) :-
invariant_goal_candidates_keeping_path_candidates(PPId, Goal, !IGCs),
invariant_goal_candidates_in_parallel_conj(PPId, Goals, !IGCs).
:- pred invariant_goal_candidates_in_disj(pred_proc_id::in,
list(hlds_goal)::in, igc_info::in, igc_info::out) is det.
invariant_goal_candidates_in_disj(_, [], !IGCs).
invariant_goal_candidates_in_disj(PPId, [Goal | Goals], !IGCs) :-
invariant_goal_candidates_keeping_path_candidates(PPId, Goal, !IGCs),
invariant_goal_candidates_in_disj(PPId, Goals, !IGCs).
:- pred invariant_goal_candidates_in_switch(pred_proc_id::in,
list(case)::in, igc_info::in, igc_info::out) is det.
invariant_goal_candidates_in_switch(_, [], !IGCs).
invariant_goal_candidates_in_switch(PPId, [Case | Cases], !IGCs) :-
Case = case(_, _, Goal),
invariant_goal_candidates_keeping_path_candidates(PPId, Goal, !IGCs),
invariant_goal_candidates_in_switch(PPId, Cases, !IGCs).
%-----------------------------------------------------------------------------%
:- pred add_recursive_call(hlds_goal::in,
igc_info::in, igc_info::out) is det.
add_recursive_call(Goal, !IGCs) :-
RecCall = Goal - cord.list(!.IGCs ^ igc_path_candidates),
!IGCs ^ igc_rec_calls := [RecCall | !.IGCs ^ igc_rec_calls].
%-----------------------------------------------------------------------------%
% NOTE: We could hoist semipure goals that have no preceeding impure goals,
% but that is a very low-level optimization that is not entirely trivial
% to implement.
%
:- pred invariant_goal_candidates_handle_primitive_goal(hlds_goal::in,
igc_info::in, igc_info::out) is det.
invariant_goal_candidates_handle_primitive_goal(Goal, !IGCs) :-
Goal = hlds_goal(_GoalExpr, GoalInfo),
(
Detism = hlds_goal.goal_info_get_determinism(GoalInfo),
code_model.determinism_to_code_model(Detism, CodeModel),
( CodeModel = model_det
; CodeModel = model_semi
),
goal_info_get_purity(GoalInfo) = purity_pure,
InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
instmap_delta_to_assoc_list(InstMapDelta, InstMapDeltaPairs),
ModuleInfo = !.IGCs ^ igc_module_info,
all_instmap_deltas_are_ground(ModuleInfo, InstMapDeltaPairs)
->
!IGCs ^ igc_path_candidates :=
snoc(!.IGCs ^ igc_path_candidates, Goal)
;
true
).
%-----------------------------------------------------------------------------%
:- pred all_instmap_deltas_are_ground(module_info::in,
assoc_list(prog_var, mer_inst)::in) is semidet.
all_instmap_deltas_are_ground(_, []).
all_instmap_deltas_are_ground(ModuleInfo, [_Var - Inst | VarInsts]) :-
inst_is_ground(ModuleInfo, Inst),
all_instmap_deltas_are_ground(ModuleInfo, VarInsts).
%-----------------------------------------------------------------------------%
:- func intersect_candidate_inv_goals(list(hlds_goals)) = hlds_goals.
intersect_candidate_inv_goals([]) = [].
intersect_candidate_inv_goals([Goals | Goalss]) =
list.filter(common_goal(Goalss), Goals).
%-----------------------------------------------------------------------------%
:- pred common_goal(list(hlds_goals)::in, hlds_goal::in) is semidet.
common_goal(Goalss, Goal) :-
all [Gs] (
list.member(Gs, Goalss)
=>
(
list.member(G, Gs),
equivalent_goals(G, Goal)
)
).
%-----------------------------------------------------------------------------%
:- pred equivalent_goals(hlds_goal::in, hlds_goal::in) is semidet.
equivalent_goals(hlds_goal(GoalExprX, _), hlds_goal(GoalExprY, _)) :-
(
GoalExprX = GoalExprY
;
GoalExprX =
plain_call(PredId, ProcId, Args, _BuiltinX, _ContextX, _SymNameX),
GoalExprY =
plain_call(PredId, ProcId, Args, _BuiltinY, _ContextY, _SymNameY)
).
%-----------------------------------------------------------------------------%
:- func inv_args(module_info, prog_vars, list(mer_mode), hlds_goals)
= prog_vars.
inv_args(ModuleInfo, HeadVars, HeadVarModes, RecCalls) = InvArgs :-
MaybeInvArgs0 =
list.map_corresponding(arg_to_maybe_inv_arg(ModuleInfo),
HeadVars, HeadVarModes),
MaybeInvArgs =
list.foldl(refine_candidate_inv_args, RecCalls, MaybeInvArgs0),
InvArgs =
list.filter_map(func(yes(Arg)) = Arg is semidet, MaybeInvArgs).
%-----------------------------------------------------------------------------%
% Maps an Arg in HeadVars to yes(Arg) if Arg is an input
% or to no otherwise.
%
:- func arg_to_maybe_inv_arg(module_info, prog_var, mer_mode)
= maybe(prog_var).
arg_to_maybe_inv_arg(ModuleInfo, Arg, Mode) =
( if input_arg(ModuleInfo, Arg, Mode) = InvArg then yes(InvArg) else no ).
%-----------------------------------------------------------------------------%
:- func refine_candidate_inv_args(hlds_goal, list(maybe(prog_var))) =
list(maybe(prog_var)).
refine_candidate_inv_args(hlds_goal(RecCall, _RecCallInfo), MaybeInvArgs) =
( RecCall = plain_call(_, _, CallArgs, _, _, _) ->
list.map_corresponding(refine_candidate_inv_args_2,
MaybeInvArgs, CallArgs)
;
unexpected($module, $pred, "non call/6 found in argument 1")
).
:- func refine_candidate_inv_args_2(maybe(prog_var), prog_var) =
maybe(prog_var).
refine_candidate_inv_args_2(no, _) = no.
refine_candidate_inv_args_2(yes(X), Y) = ( if X = Y then yes(X) else no ).
%-----------------------------------------------------------------------------%
% A goal is invariant if all its input args are invariant.
% The outputs of an invariant goal are also invariant.
%
% Since mode reordering has already been applied at this point,
% we know that if goal A precedes goal B in the candidate list,
% goal A will not depend upon the results of goal B (although B
% may depend on A).
%
% The list returned will not contain duplicate goals judged
% to be the same by equivalent_goals/2.
%
% We do not hoist goals with unique outputs that are elsewhere
% used as unique inputs since the user may clobber the variable
% in question.
%
:- pred inv_goals_vars(module_info::in, prog_vars::in,
hlds_goals::in, hlds_goals::out, prog_vars::in, prog_vars::out) is det.
inv_goals_vars(ModuleInfo, UniquelyUsedVars,
InvGoals0, InvGoals, InvVars0, InvVars) :-
list.foldl2(
inv_goals_vars_2(ModuleInfo, UniquelyUsedVars),
InvGoals0,
[], InvGoals,
InvVars0, InvVars
).
%-----------------------------------------------------------------------------%
:- pred inv_goals_vars_2(module_info::in, prog_vars::in, hlds_goal::in,
hlds_goals::in, hlds_goals::out, prog_vars::in, prog_vars::out) is det.
inv_goals_vars_2(ModuleInfo, UUVs, Goal, IGs0, IGs, IVs0, IVs) :-
(
not invariant_goal(IGs0, Goal),
not has_uniquely_used_arg(UUVs, Goal),
input_args_are_invariant(ModuleInfo, Goal, IVs0)
->
IGs = [Goal | IGs0],
add_outputs(ModuleInfo, UUVs, Goal, IVs0, IVs)
;
IGs = IGs0,
IVs = IVs0
).
%-----------------------------------------------------------------------------%
:- pred has_uniquely_used_arg(prog_vars::in, hlds_goal::in) is semidet.
has_uniquely_used_arg(UUVs, hlds_goal(_GoalExpr, GoalInfo)) :-
NonLocals = goal_info_get_nonlocals(GoalInfo),
list.member(UUV, UUVs),
set_of_var.member(NonLocals, UUV).
%-----------------------------------------------------------------------------%
:- pred invariant_goal(hlds_goals::in, hlds_goal::in) is semidet.
invariant_goal(InvariantGoals, Goal) :-
list.member(InvariantGoal, InvariantGoals),
equivalent_goals(InvariantGoal, Goal).
%-----------------------------------------------------------------------------%
:- pred input_args_are_invariant(module_info::in, hlds_goal::in, prog_vars::in)
is semidet.
input_args_are_invariant(ModuleInfo, Goal, InvVars) :-
Inputs = goal_inputs(ModuleInfo, Goal),
all [V] (
list.member(V, Inputs)
=>
list.member(V, InvVars)
).
%-----------------------------------------------------------------------------%
:- pred do_not_hoist(module_info::in, hlds_goals::in,
hlds_goals::out, prog_vars::out) is det.
do_not_hoist(ModuleInfo, InvGoals, DontHoistGoals, DontHoistVars) :-
list.foldl2(do_not_hoist_2(ModuleInfo), InvGoals,
[], DontHoistGoals, [], DontHoistVars).
:- pred do_not_hoist_2(module_info::in, hlds_goal::in,
hlds_goals::in, hlds_goals::out, prog_vars::in, prog_vars::out) is det.
do_not_hoist_2(ModuleInfo, Goal, !DHGs, !DHVs) :-
(
( const_construction(Goal)
; deconstruction(Goal)
; impure_goal(Goal)
; cannot_succeed(Goal)
; call_has_inst_any(ModuleInfo, Goal)
)
->
list.cons(Goal, !DHGs),
add_outputs(ModuleInfo, [], Goal, !DHVs)
;
true
).
%-----------------------------------------------------------------------------%
% A constant construction is a construction unification with no
% arguments or which is constructed from a statically initialized
% constant.
%
:- pred const_construction(hlds_goal::in) is semidet.
const_construction(hlds_goal(GoalExpr, _GoalInfo)) :-
Construction = GoalExpr ^ unify_kind,
( Construction ^ construct_args = []
; Construction ^ construct_how = construct_statically
).
%-----------------------------------------------------------------------------%
:- pred deconstruction(hlds_goal::in) is semidet.
deconstruction(hlds_goal(GoalExpr, _GoalInfo)) :-
GoalExpr ^ unify_kind = deconstruct(_, _, _, _, _, _).
%-----------------------------------------------------------------------------%
:- pred impure_goal(hlds_goal::in) is semidet.
impure_goal(Goal) :-
goal_get_purity(Goal) = purity_impure.
%-----------------------------------------------------------------------------%
:- pred cannot_succeed(hlds_goal::in) is semidet.
cannot_succeed(hlds_goal(_GoalExpr, GoalInfo)) :-
Detism = goal_info_get_determinism(GoalInfo),
determinism_components(Detism, _CanFail, MaxSolns),
MaxSolns = at_most_zero.
%-----------------------------------------------------------------------------%
% Succeeds if any of the components of the insts of the modes of a
% (generic) call is inst any.
%
:- pred call_has_inst_any(module_info::in, hlds_goal::in) is semidet.
call_has_inst_any(ModuleInfo, Goal) :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = generic_call(_, _, Modes, _, _)
;
GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
Modes = argmodes(ModuleInfo, PredId, ProcId)
),
some [Mode] (
list.member(Mode, Modes),
mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
(
inst_contains_any(ModuleInfo, InitialInst)
;
inst_contains_any(ModuleInfo, FinalInst)
)
).
%-----------------------------------------------------------------------------%
:- type inst_info == {module_info, instmap}.
:- pred arg_is_input(inst_info::in, prog_var::in) is semidet.
arg_is_input(InstInfo, Arg) :-
InstInfo = {_ModuleInfo, InstMap},
instmap_lookup_var(InstMap, Arg, Inst),
inst_is_input(InstInfo, Inst).
%-----------------------------------------------------------------------------%
% We take an initial inst to be an input if it is fully ground
% and not unique.
%
:- pred inst_is_input(inst_info::in, mer_inst::in) is semidet.
inst_is_input({ModuleInfo, _InstMap}, Inst) :-
inst_is_ground(ModuleInfo, Inst),
inst_is_not_partly_unique(ModuleInfo, Inst).
%-----------------------------------------------------------------------------%
:- pred add_outputs(module_info::in, prog_vars::in, hlds_goal::in,
prog_vars::in, prog_vars::out) is det.
add_outputs(ModuleInfo, UUVs, Goal, !InvVars) :-
list.foldl(add_output(UUVs), goal_outputs(ModuleInfo, Goal), !InvVars).
:- pred add_output(prog_vars::in, prog_var::in,
prog_vars::in, prog_vars::out) is det.
add_output(UniquelyUsedVars, X, !InvVars) :-
(
not list.member(X, !.InvVars),
not list.member(X, UniquelyUsedVars)
->
!:InvVars = [X | !.InvVars]
;
true
).
%-----------------------------------------------------------------------------%
:- func compute_initial_aux_instmap(hlds_goals, instmap) = instmap.
compute_initial_aux_instmap(Gs, IM) = list.foldl(ApplyGoalInstMap, Gs, IM) :-
ApplyGoalInstMap =
( func(hlds_goal(_GoalExpr, GoalInfo), IM0) = IM1 :-
IMD = goal_info_get_instmap_delta(GoalInfo),
apply_instmap_delta(IM0, IMD, IM1)
).
%-----------------------------------------------------------------------------%
:- pred create_aux_pred(pred_proc_id::in, prog_vars::in, prog_vars::in,
instmap::in, pred_proc_id::out, hlds_goal::out, pred_info::out,
proc_info::out, module_info::in, module_info::out) is det.
create_aux_pred(PredProcId, HeadVars, ComputedInvArgs,
InitialAuxInstMap, AuxPredProcId, CallAux,
AuxPredInfo, AuxProcInfo, ModuleInfo0, ModuleInfo) :-
PredProcId = proc(PredId, ProcId),
AuxHeadVars = HeadVars ++ ComputedInvArgs,
module_info_pred_proc_info(ModuleInfo0, PredId, ProcId,
PredInfo, ProcInfo),
proc_info_get_goal(ProcInfo, Goal @ hlds_goal(_GoalExpr, GoalInfo)),
pred_info_get_typevarset(PredInfo, TVarSet),
proc_info_get_vartypes(ProcInfo, VarTypes),
pred_info_get_class_context(PredInfo, ClassContext),
proc_info_get_rtti_varmaps(ProcInfo, RttiVarMaps),
proc_info_get_varset(ProcInfo, VarSet),
proc_info_get_inst_varset(ProcInfo, InstVarSet),
pred_info_get_markers(PredInfo, Markers),
pred_info_get_origin(PredInfo, OrigOrigin),
proc_info_get_has_parallel_conj(ProcInfo, HasParallelConj),
pred_info_get_var_name_remap(PredInfo, VarNameRemap),
PredModule = pred_info_module(PredInfo),
PredName = pred_info_name(PredInfo),
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
Context = goal_info_get_context(GoalInfo),
term.context_line(Context, Line),
( Line = 0 ->
% Use the predicate number to distinguish between similarly named
% generated predicates, e.g. special predicates.
Counter = pred_id_to_int(PredId)
;
Counter = 1
),
make_pred_name_with_context(PredModule, "loop_inv",
PredOrFunc, PredName, Line, Counter, AuxPredSymName0),
hlds_pred.proc_id_to_int(ProcId, ProcNo),
Suffix = string.format("_%d", [i(ProcNo)]),
add_sym_name_suffix(AuxPredSymName0, Suffix, AuxPredSymName),
Origin = origin_transformed(transform_loop_invariant(ProcNo),
OrigOrigin, PredId),
hlds_pred.define_new_pred(
Origin, % in - The origin of this new predicate
Goal, % in - The goal for the new aux proc.
CallAux, % out - How we can call the new aux proc.
AuxHeadVars, % in - The args for the new aux proc.
_ExtraArgs, % out - Extra args prepended to Args for typeinfo
% liveness purposes.
InitialAuxInstMap,
% in - The initial instmap for the new aux proc.
AuxPredSymName, % in - The name of the new aux proc.
TVarSet, % in - ???
VarTypes, % in - The var -> type mapping for the new aux proc.
ClassContext, % in - Typeclass constraints on the new aux proc.
RttiVarMaps, % in - type_info and typeclass_info locations.
VarSet, % in - ???
InstVarSet, % in - ???
Markers, % in - Markers for the new aux proc.
address_is_not_taken,
% in - The address of the new aux proc is not taken.
HasParallelConj, % in
VarNameRemap, % in
ModuleInfo0,
ModuleInfo,
AuxPredProcId % out - The pred_proc_id for the new aux proc.
),
% Note on CallAux:
% - we change the call args as necessary in gen_aux_call;
% - we handle the changes to nonlocals by requantifying
% over the entire goal after we've transformed it.
AuxPredProcId = proc(AuxPredId, AuxProcId),
module_info_pred_proc_info(ModuleInfo, AuxPredId, AuxProcId, AuxPredInfo,
AuxProcInfo).
%-----------------------------------------------------------------------------%
:- type gen_aux_proc_info
---> gen_aux_proc_info(
gapi_module_info :: module_info,
gapi_inv_goals :: hlds_goals,
gapi_pred_proc_id :: pred_proc_id,
gapi_call_aux_goal :: hlds_goal
).
% Replace the invariant goals in the original Body
% with just `true' in the new AuxBody.
%
:- pred gen_aux_proc(hlds_goals::in, pred_proc_id::in, pred_proc_id::in,
hlds_goal::in, hlds_goal::in, pred_info::in, proc_info::in,
module_info::in, module_info::out) is det.
gen_aux_proc(InvGoals, PredProcId, AuxPredProcId, CallAux, Body,
AuxPredInfo, !.AuxProcInfo, !ModuleInfo) :-
% Compute the aux proc body.
GapInfo = gen_aux_proc_info(!.ModuleInfo, InvGoals, PredProcId, CallAux),
AuxBody = gen_aux_proc_goal(GapInfo, Body),
% Put the new proc body and instmap into the module_info.
AuxPredProcId = proc(AuxPredId, AuxProcId),
hlds_pred.proc_info_set_goal(AuxBody, !AuxProcInfo),
requantify_proc_general(ordinary_nonlocals_no_lambda, !AuxProcInfo),
recompute_instmap_delta_proc(do_not_recompute_atomic_instmap_deltas,
!AuxProcInfo, !ModuleInfo),
module_info_set_pred_proc_info(AuxPredId, AuxProcId,
AuxPredInfo, !.AuxProcInfo, !ModuleInfo).
%-----------------------------------------------------------------------------%
:- func gen_aux_proc_goal(gen_aux_proc_info, hlds_goal) = hlds_goal.
gen_aux_proc_goal(Info, Goal) = AuxGoal :-
Goal = hlds_goal(GoalExpr, GoalInfo),
(
GoalExpr = plain_call(PredId, ProcId, _,_,_,_),
( proc(PredId, ProcId) = Info ^ gapi_pred_proc_id ->
AuxGoal = gen_aux_call(Info ^ gapi_call_aux_goal, Goal)
;
AuxGoal = gen_aux_proc_handle_non_recursive_call(Info, Goal)
)
;
( GoalExpr = generic_call(_, _, _, _, _)
; GoalExpr = unify(_, _, _, _, _)
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
),
AuxGoal = gen_aux_proc_handle_non_recursive_call(Info, Goal)
;
GoalExpr = conj(ConjType, Conjuncts),
AuxConjuncts = list.map(gen_aux_proc_goal(Info), Conjuncts),
AuxGoalExpr = conj(ConjType, AuxConjuncts),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = disj(Disjuncts),
AuxDisjuncts = list.map(gen_aux_proc_goal(Info), Disjuncts),
AuxGoalExpr = disj(AuxDisjuncts),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = switch(Var, CanFail, Cases),
AuxCases = list.map(gen_aux_proc_case(Info), Cases),
AuxGoalExpr = switch(Var, CanFail, AuxCases),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = negation(SubGoal),
AuxSubGoal = gen_aux_proc_goal(Info, SubGoal),
AuxGoalExpr = negation(AuxSubGoal),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = scope(Reason, SubGoal),
% XXX We should consider special casing the handling of
% from_ground_term_construct scopes.
AuxSubGoal = gen_aux_proc_goal(Info, SubGoal),
AuxGoalExpr = scope(Reason, AuxSubGoal),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = if_then_else(Vars, Cond, Then, Else),
AuxCond = gen_aux_proc_goal(Info, Cond),
AuxThen = gen_aux_proc_goal(Info, Then),
AuxElse = gen_aux_proc_goal(Info, Else),
AuxGoalExpr = if_then_else(Vars, AuxCond, AuxThen, AuxElse),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = shorthand(_),
unexpected($module, $pred, "shorthand")
).
:- func gen_aux_proc_case(gen_aux_proc_info, case) = case.
gen_aux_proc_case(Info, Case) = AuxCase :-
Case = case(MainConsId, OtherConsIds, Goal),
AuxGoal = gen_aux_proc_goal(Info, Goal),
AuxCase = case(MainConsId, OtherConsIds, AuxGoal).
%-----------------------------------------------------------------------------%
:- func gen_aux_proc_handle_non_recursive_call(gen_aux_proc_info, hlds_goal) =
hlds_goal.
gen_aux_proc_handle_non_recursive_call(Info, Goal0) =
( invariant_goal(Info ^ gapi_inv_goals, Goal0) ->
true_goal
;
Goal0
).
%-----------------------------------------------------------------------------%
% We construct OutProc by replacing recursive calls to the InProc at the
% end of recursive paths with calls to the auxiliary procedure.
%
:- pred gen_out_proc(pred_proc_id::in, pred_info::in,
proc_info::in, proc_info::out, hlds_goal::in, hlds_goal::in,
module_info::in, module_info::out) is det.
gen_out_proc(PredProcId, PredInfo0, ProcInfo0, ProcInfo, CallAux, Body0,
ModuleInfo0, ModuleInfo) :-
% Compute the new procedure body.
Body = gen_out_proc_goal(PredProcId, CallAux, Body0),
% Put the new procedure body into the module_info.
PredProcId = proc(PredId, ProcId),
proc_info_get_varset(ProcInfo0, VarSet),
proc_info_get_vartypes(ProcInfo0, VarTypes),
proc_info_get_headvars(ProcInfo0, HeadVars),
proc_info_get_rtti_varmaps(ProcInfo0, RttiVarMaps),
proc_info_set_body(VarSet, VarTypes, HeadVars, Body,
RttiVarMaps, ProcInfo0, ProcInfo1),
requantify_proc_general(ordinary_nonlocals_no_lambda,
ProcInfo1, ProcInfo2),
recompute_instmap_delta_proc(do_not_recompute_atomic_instmap_deltas,
ProcInfo2, ProcInfo, ModuleInfo0, ModuleInfo1),
module_info_set_pred_proc_info(PredId, ProcId,
PredInfo0, ProcInfo, ModuleInfo1, ModuleInfo).
%-----------------------------------------------------------------------------%
% gen_out_proc_goal(PredProcId, CallAux, Goal0) = Goal:
%
% Goal is Goal0 with calls to PredProcId replaced with CallAux.
%
:- func gen_out_proc_goal(pred_proc_id, hlds_goal, hlds_goal) = hlds_goal.
gen_out_proc_goal(PPId, CallAux, Goal) = AuxGoal :-
Goal = hlds_goal(GoalExpr, GoalInfo),
(
GoalExpr = plain_call(PredId, ProcId, _, _, _, _),
( proc(PredId, ProcId) = PPId ->
AuxGoal = gen_aux_call(CallAux, Goal)
;
AuxGoal = Goal
)
;
( GoalExpr = generic_call(_, _, _, _, _)
; GoalExpr = unify(_, _, _, _, _)
; GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
),
AuxGoal = Goal
;
GoalExpr = conj(ConjType, Conjuncts),
AuxConjuncts = list.map(gen_out_proc_goal(PPId, CallAux), Conjuncts),
AuxGoalExpr = conj(ConjType, AuxConjuncts),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = disj(Disjuncts),
AuxDisjuncts = list.map(gen_out_proc_goal(PPId, CallAux), Disjuncts),
AuxGoalExpr = disj(AuxDisjuncts),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = switch(Var, CanFail, Cases),
AuxCases = list.map(gen_out_proc_case(PPId, CallAux), Cases),
AuxGoalExpr = switch(Var, CanFail, AuxCases),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = negation(SubGoal),
AuxSubGoal = gen_out_proc_goal(PPId, CallAux, SubGoal),
AuxGoalExpr = negation(AuxSubGoal),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = scope(Reason, SubGoal),
% XXX We should consider special casing the handling of
% from_ground_term_construct scopes.
AuxSubGoal = gen_out_proc_goal(PPId, CallAux, SubGoal),
AuxGoalExpr = scope(Reason, AuxSubGoal),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = if_then_else(Vars, Cond, Then, Else),
AuxCond = gen_out_proc_goal(PPId, CallAux, Cond),
AuxThen = gen_out_proc_goal(PPId, CallAux, Then),
AuxElse = gen_out_proc_goal(PPId, CallAux, Else),
AuxGoalExpr = if_then_else(Vars, AuxCond, AuxThen, AuxElse),
AuxGoal = hlds_goal(AuxGoalExpr, GoalInfo)
;
GoalExpr = shorthand(_),
unexpected($module, $pred, "shorthand")
).
:- func gen_out_proc_case(pred_proc_id, hlds_goal, case) = case.
gen_out_proc_case(PPId, CallAux, Case) = AuxCase :-
Case = case(MainConsId, OtherConsIds, Goal),
AuxGoal = gen_out_proc_goal(PPId, CallAux, Goal),
AuxCase = case(MainConsId, OtherConsIds, AuxGoal).
%-----------------------------------------------------------------------------%
:- func gen_aux_call(hlds_goal, hlds_goal) = hlds_goal.
gen_aux_call(hlds_goal(CallAux0, _CallAuxInfo0), hlds_goal(Call, CallInfo)) =
(
AuxArgs0 = CallAux0 ^ call_args,
Args0 = Call ^ call_args,
Args = replace_initial_args(Args0, AuxArgs0),
CallAux = ( CallAux0 ^ call_args := Args )
% Note that one might expect instmap_delta to change, however the
% invariant arguments are just that -invariant- hence their insts
% are not changed by the recursive call and there is no need
% to adjust the instmap_delta. All other fields are correct for
% CallInfo.
->
hlds_goal(CallAux, CallInfo)
;
unexpected($module, $pred, "args not both ordinary calls")
).
%-----------------------------------------------------------------------------%
:- func replace_initial_args(list(T), list(T)) = list(T).
replace_initial_args([], Ys ) = Ys.
replace_initial_args([X | Xs], [_ | Ys]) = [X | replace_initial_args(Xs, Ys)].
replace_initial_args([_ | _], [] ) = _ :-
unexpected($module, $pred, "first arg longer than second").
%-----------------------------------------------------------------------------%
% This predicate computes the set of variables that are used as (partly)
% unique inputs to goals. This information is needed because unique local
% values for which uniqueness is important cannot be hoisted, although
% those for which uniqueness is inferred, but not important, can be
% hoisted.
%
% TODO: get this to handle unification properly. See the XXX below.
%
:- func uniquely_used_vars(module_info, hlds_goal) = prog_vars.
uniquely_used_vars(ModuleInfo, Goal) =
list.sort_and_remove_dups(used_vars(ModuleInfo, Goal)).
%-----------------------------------------------------------------------------%
:- func used_vars(module_info, hlds_goal) = prog_vars.
used_vars(ModuleInfo, Goal) = UsedVars :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = plain_call(PredId, ProcId, Args, _, _, _),
UsedVars = list.filter_map_corresponding(
uniquely_used_args(ModuleInfo),
Args, argmodes(ModuleInfo, PredId, ProcId))
;
GoalExpr = generic_call(_, Args, Modes, _, _),
UsedVars = list.filter_map_corresponding(
uniquely_used_args(ModuleInfo),
Args, Modes)
;
GoalExpr = call_foreign_proc(_, PredId, ProcId,
ForeignArgs, ExtraForeignArgs, _, _),
% XXX `Extras' should be empty for pure calls. We cannot apply LIO
% to non-pure goals so we shouldn't need to consider `Extras'.
% However, we currently don't deal with the situation where we may be
% trying to apply LIO to a non-pure goal until *after* we have called
% this predicate, so `Extras' may not be empty. As a work-around,
% we just add any variables in `Extras' to the set of variables
% that cannot be hoisted.
UsedArgVars = list.filter_map_corresponding(
uniquely_used_args(ModuleInfo),
list.map(foreign_arg_var, ForeignArgs),
argmodes(ModuleInfo, PredId, ProcId)),
UsedExtraArgVars = list.map(foreign_arg_var, ExtraForeignArgs),
UsedVars = UsedArgVars ++ UsedExtraArgVars
;
GoalExpr = unify(_LHS, _RHS, _UMode, _UKind, _),
% XXX This is very conservative!
UsedVars = []
;
GoalExpr = conj(_, Conjuncts),
UsedVars = list.condense(list.map(used_vars(ModuleInfo), Conjuncts))
;
GoalExpr = disj(Disjuncts),
UsedVars = list.condense(list.map(used_vars(ModuleInfo), Disjuncts))
;
GoalExpr = switch(_, _, Cases),
UsedVars = list.condense(list.map(used_vars(ModuleInfo),
case_goals(Cases)))
;
GoalExpr = if_then_else(_, Cond, Then, Else),
UsedVars = used_vars(ModuleInfo, Cond) ++
used_vars(ModuleInfo, Then) ++ used_vars(ModuleInfo, Else)
;
GoalExpr = negation(SubGoal),
UsedVars = used_vars(ModuleInfo, SubGoal)
;
GoalExpr = scope(_Reason, SubGoal),
% XXX We should consider special casing the handling of
% from_ground_term_construct scopes.
UsedVars = used_vars(ModuleInfo, SubGoal)
;
GoalExpr = shorthand(_),
unexpected($module, $pred, "shorthand")
).
:- func case_goals(list(case)) = list(hlds_goal).
case_goals(Cases) =
list.map(func(case(_MainConsId, _OtherConsIds, Goal)) = Goal, Cases).
%-----------------------------------------------------------------------------%
:- func uniquely_used_args(module_info, prog_var, mer_mode) = prog_var
is semidet.
uniquely_used_args(ModuleInfo, X, M) = X :-
mode_get_insts(ModuleInfo, M, InInst, _OutInst),
not inst_is_not_partly_unique(ModuleInfo, InInst).
%-----------------------------------------------------------------------------%
:- func argmodes(module_info, pred_id, proc_id) = list(mer_mode).
argmodes(ModuleInfo, PredId, ProcId) = ArgModes :-
module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo),
proc_info_get_argmodes(ProcInfo, ArgModes).
%-----------------------------------------------------------------------------%
% Find the list of vars for a goal that are free before the call.
% This only applies to calls and unifications.
%
:- func goal_inputs(module_info, hlds_goal) = prog_vars.
goal_inputs(ModuleInfo, Goal) = Inputs :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = plain_call(PredId, ProcId, Args, _, _, _),
Inputs = list.filter_map_corresponding(input_arg(ModuleInfo),
Args, argmodes(ModuleInfo, PredId, ProcId))
;
GoalExpr = generic_call(GenericCall, Args, ArgModes, _, _),
generic_call_vars(GenericCall, GenericCallVars),
Inputs0 = list.filter_map_corresponding(input_arg(ModuleInfo),
Args, ArgModes),
Inputs = GenericCallVars ++ Inputs0
;
GoalExpr = call_foreign_proc(_, PredId, ProcId, ForeignArgs, _, _, _),
Inputs = list.filter_map_corresponding(input_arg(ModuleInfo),
list.map(foreign_arg_var, ForeignArgs),
argmodes(ModuleInfo, PredId, ProcId))
;
GoalExpr = unify(LHS, UnifyRHS, _, Kind, _),
(
% The LHS is always an output var in constructions.
Kind = construct(_, _, RHSArgs, ArgUniModes, _, _, _),
Inputs = list.filter_map_corresponding(input_arg(ModuleInfo),
RHSArgs, rhs_modes(ArgUniModes))
;
% The LHS is always in input var in deconstructions.
Kind = deconstruct(_, _, RHSArgs, ArgUniModes, _, _),
RHSInputs = list.filter_map_corresponding(input_arg(ModuleInfo),
RHSArgs, rhs_modes(ArgUniModes)),
Inputs = [LHS | RHSInputs]
;
% The RHS is the only input in an assignment.
Kind = assign(_, RHS),
Inputs = [RHS]
;
% Both sides of a simple test are inputs.
Kind = simple_test(_, RHS),
Inputs = [LHS, RHS]
;
% Both sides of a complicated unification are inputs.
Kind = complicated_unify(_, _, _),
(
UnifyRHS = rhs_var(RHS),
Inputs = [LHS, RHS]
;
UnifyRHS = rhs_functor(_, _, _),
Inputs = [LHS]
;
UnifyRHS = rhs_lambda_goal(_, _, _, _, _, _, _, _, _),
% These should have been expanded out by now.
unexpected($module, $pred, "lambda goal")
)
)
;
( GoalExpr = conj(_, _)
; GoalExpr = disj(_)
; GoalExpr = switch(_, _, _)
; GoalExpr = if_then_else(_, _, _, _)
; GoalExpr = negation(_)
; GoalExpr = scope(_, _)
; GoalExpr = shorthand(_)
),
unexpected($module, $pred, "compound goal")
).
%-----------------------------------------------------------------------------%
% An input arg is one whose pre-call inst is not free.
%
:- func input_arg(module_info, prog_var, mer_mode) = prog_var is semidet.
input_arg(ModuleInfo, X, M) = X :-
mode_get_insts(ModuleInfo, M, InInst, _OutInst),
not inst_is_free(ModuleInfo, InInst).
%-----------------------------------------------------------------------------%
% Find the list of vars for a goal that are free before the call and bound
% afterwards. This only applies to calls and unifications.
%
:- func goal_outputs(module_info, hlds_goal) = prog_vars.
goal_outputs(ModuleInfo, Goal) = Outputs :-
Goal = hlds_goal(GoalExpr, _GoalInfo),
(
GoalExpr = plain_call(PredId, ProcId, Args, _, _, _),
Outputs = list.filter_map_corresponding(output_arg(ModuleInfo),
Args, argmodes(ModuleInfo, PredId, ProcId))
;
GoalExpr = generic_call(_, Args, ArgModes, _, _),
Outputs = list.filter_map_corresponding(output_arg(ModuleInfo),
Args, ArgModes)
;
GoalExpr = call_foreign_proc(_, PredId, ProcId, ForeignArgs, _, _, _),
Outputs = list.filter_map_corresponding(output_arg(ModuleInfo),
list.map(foreign_arg_var, ForeignArgs),
argmodes(ModuleInfo, PredId, ProcId))
;
GoalExpr = unify(LHS, _RHS, _, Kind, _),
(
% The LHS is the only output in a construction.
Kind = construct(_, _, _, _, _, _, _),
Outputs = [LHS]
;
% The LHS is always in input in deconstructions.
Kind = deconstruct(_, _, RHSArgs, ArgUniModes, _, _),
Outputs = list.filter_map_corresponding(output_arg(ModuleInfo),
RHSArgs, rhs_modes(ArgUniModes))
;
% The LHS is the only output in an assignment.
Kind = assign(_, _),
Outputs = [LHS]
;
% Both sides of a simple test are inputs.
Kind = simple_test(_, _),
Outputs = []
;
% Both sides of a complicated unification are inputs.
Kind = complicated_unify(_, _, _),
Outputs = []
)
;
( GoalExpr = conj(_, _)
; GoalExpr = disj(_)
; GoalExpr = switch(_, _, _)
; GoalExpr = if_then_else(_, _, _, _)
; GoalExpr = negation(_)
; GoalExpr = scope(_, _)
; GoalExpr = shorthand(_)
),
unexpected($module, $pred, "compound goal")
).
%-----------------------------------------------------------------------------%
% An output arg is one whose pre-call inst is free and ground after.
%
:- func output_arg(module_info, prog_var, mer_mode) = prog_var is semidet.
output_arg(ModuleInfo, X, M) = X :-
mode_is_fully_output(ModuleInfo, M).
%-----------------------------------------------------------------------------%
:- func rhs_modes(list(uni_mode)) = list(mer_mode).
rhs_modes(UniModes) =
list.map(func((_ - Pre) -> (_ - Post)) = (Pre -> Post), UniModes).
%-----------------------------------------------------------------------------%
:- func lhs_modes(list(uni_mode)) = list(mer_mode).
lhs_modes(UniModes) =
list.map(func((Pre - _) -> (Post - _)) = (Pre -> Post), UniModes).
%-----------------------------------------------------------------------------%
:- end_module transform_hlds.loop_inv.
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink