mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-14 13:23:53 +00:00
Code Issues Projects Releases Wiki Activity
Files
1c3bc03415740d648e99d0a34389767d76f8808a
mercury/compiler/mode_constraints.m
Zoltan Somogyi 1c3bc03415 Make the system compiler with --warn-unused-imports. 
Estimated hours taken: 2
Branches: main, release

Make the system compiler with --warn-unused-imports.

browser/*.m:
library/*.m:
compiler/*.m:
	Remove unnecesary imports as flagged by --warn-unused-imports.

	In some files, do some minor cleanup along the way.
2010-12-30 11:18:04 +00:00

2189 lines
86 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2010 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: mode_constraints.m.
% Main author: dmo.
%
% This module implements the top level of the algorithm described in the
% paper "Constraint-based mode analysis of Mercury" by David Overton,
% Zoltan Somogyi and Peter Stuckey. That paper is the main documentation
% of the concepts behind the algorithm as well as the algorithm itself.
%
%-----------------------------------------------------------------------------%
:- module check_hlds.mode_constraints.
:- interface.
:- import_module check_hlds.abstract_mode_constraints.
:- import_module check_hlds.prop_mode_constraints.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module io.
%-----------------------------------------------------------------------------%
:- pred mc_process_module(module_info::in, module_info::out,
io::di, io::uo) is det.
% dump_abstract_constraints(ModuleInfo, Varset, PredConstraintsMap, !IO)
%
% Dumps the constraints in the PredConstraintsMap to file
% modulename.mode_constraints
%
:- pred dump_abstract_constraints(module_info::in, mc_varset::in,
pred_constraints_map::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module transform_hlds. % for pd_cost, etc.
:- import_module check_hlds.build_mode_constraints.
:- import_module check_hlds.ordering_mode_constraints.
:- import_module check_hlds.mode_constraint_robdd.
:- import_module check_hlds.mode_ordering.
:- import_module check_hlds.mode_util.
:- import_module hlds.goal_path.
:- import_module hlds.hhf.
:- import_module hlds.hlds_clauses.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_rtti.
:- import_module hlds.inst_graph.
:- import_module hlds.passes_aux.
:- import_module hlds.quantification.
:- import_module libs.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.program_representation.
:- import_module mode_robdd.
% :- import_module mode_robdd.check.
% :- import_module mode_robdd.tfeir.
:- import_module mode_robdd.tfeirn.
:- import_module parse_tree.
:- import_module parse_tree.file_names.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_mode.
:- import_module transform_hlds.dependency_graph.
:- import_module assoc_list.
:- import_module bool.
:- import_module list.
:- import_module map.
:- import_module maybe.
:- import_module multi_map.
:- import_module pair.
:- import_module require.
:- import_module robdd.
:- import_module set.
:- import_module solutions.
:- import_module sparse_bitset.
:- import_module string.
:- import_module term.
:- import_module varset.
% :- import_module unsafe.
%-----------------------------------------------------------------------------%
:- typeclass has_mc_info(T) where [
func mc_info(T) = mode_constraint_info,
func 'mc_info :='(T, mode_constraint_info) = T
].
:- typeclass has_module_info(T) where [
func module_info(T) = module_info,
func 'module_info :='(T, module_info) = T
].
:- typeclass has_ho_modes(T) where [
func ho_modes(T) = ho_modes,
func 'ho_modes :='(T, ho_modes) = T
].
mc_process_module(!ModuleInfo, !IO) :-
module_info_get_valid_predids(PredIds, !ModuleInfo),
module_info_get_globals(!.ModuleInfo, Globals),
globals.lookup_bool_option(Globals, simple_mode_constraints, Simple),
globals.lookup_bool_option(Globals, prop_mode_constraints, New),
(
New = no,
list.foldl2(hhf.process_pred(Simple), PredIds, !ModuleInfo, !IO),
get_predicate_sccs(!ModuleInfo, SCCs),
% Stage 1: Process SCCs bottom-up to determine variable producers.
list.foldl2(mc_process_scc(Simple), SCCs,
map.init, PredConstraintMap, !ModuleInfo),
% Stage 2: Process SCCs top-down to determine execution order of
% conjuctions and which modes are needed for each predicate.
mode_ordering(PredConstraintMap, list.reverse(SCCs), !ModuleInfo, !IO),
% Stage 3, which would turn the results of the mode analysis
% into goal annotations that the rest of the compiler can
% understand, doesn't exist yet.The whole point of this way of
% doing mode analysis is to gain extra expressive power (e.g.
% partially instantiated data structures), and the rest of the
% compiler doesn't handle the extra expressive power yet.
clear_caches(!IO)
;
New = yes,
get_predicate_sccs(!ModuleInfo, SCCs),
% Preprocess to accommodate implied modes.
% XXX The following transformation adds more unifications than is
% necessary; for example, for arguments that will eventually have `in'
% modes anyway. The resulting loosening of constraints makes analysis
% take up to twice as long. Therefore, a more subtle approach would
% likely be a significant optimization.
list.foldl(ensure_unique_arguments, PredIds, !ModuleInfo),
% Requantify to avoid the appearance of variables in nonlocal sets
% that don't appear in the goal. (This makes it appear that the goal
% consumes the variable.)
list.foldl(correct_nonlocals_in_pred, PredIds, !ModuleInfo),
% Stage 1: Process SCCs bottom-up to determine constraints on
% variable producers and consumers.
list.foldl3(prop_mode_constraints_in_scc,
SCCs, !ModuleInfo, var_info_init, VarInfo,
map.init, AbstractModeConstraints),
globals.lookup_bool_option(Globals, debug_mode_constraints, Debug),
(
Debug = yes,
ConstraintVarset = mc_varset(VarInfo),
trace [io(!IO)] (
pretty_print_pred_constraints_map(!.ModuleInfo,
ConstraintVarset, AbstractModeConstraints, !IO)
)
;
Debug = no
),
% Stage 2: Order conjunctions based on solutions to
% the producer-consumer constraints.
ConstraintVarMap = rep_var_map(VarInfo),
mode_reordering(AbstractModeConstraints, ConstraintVarMap, SCCs,
!ModuleInfo),
(
Debug = yes,
trace [io(!IO)] (
list.foldl(
ordering_mode_constraints.dump_goal_paths(!.ModuleInfo),
SCCs, !IO)
)
;
Debug = no
)
).
dump_abstract_constraints(ModuleInfo, ConstraintVarset, ModeConstraints,
!IO) :-
module_info_get_globals(ModuleInfo, Globals),
module_info_get_name(ModuleInfo, ModuleName),
module_name_to_file_name(Globals, ModuleName, ".mode_constraints",
do_create_dirs, FileName, !IO),
OutputFile = FileName,
io.open_output(OutputFile, IOResult, !IO),
(
IOResult = ok(OutputStream),
io.set_output_stream(OutputStream, OldOutStream, !IO),
pretty_print_pred_constraints_map(ModuleInfo, ConstraintVarset,
ModeConstraints, !IO),
io.set_output_stream(OldOutStream, _, !IO),
io.close_output(OutputStream, !IO)
;
IOResult = error(_),
unexpected(this_file,
"failed to open " ++ FileName ++ " for output.")
).
% correct_nonlocals_in_pred(PredId, !ModuleInfo) requantifies
% the clause_body of PredId. This is to ensure that no variable
% appears in the nonlocal set of a goal that doesn't also appear
% in that goal.
%
:- pred correct_nonlocals_in_pred(pred_id::in, module_info::in,
module_info::out) is det.
correct_nonlocals_in_pred(PredId, !ModuleInfo) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
some [!ClausesInfo, !Varset, !Vartypes, !Clauses, !Goals, !RttiVarMaps] (
pred_info_get_clauses_info(PredInfo0, !:ClausesInfo),
clauses_info_clauses(!:Clauses, ItemNumbers, !ClausesInfo),
clauses_info_get_headvar_list(!.ClausesInfo, HeadVars),
clauses_info_get_varset(!.ClausesInfo, !:Varset),
clauses_info_get_vartypes(!.ClausesInfo, !:Vartypes),
clauses_info_get_rtti_varmaps(!.ClausesInfo, !:RttiVarMaps),
!:Goals = list.map(func(X) = clause_body(X), !.Clauses),
list.map_foldl3(correct_nonlocals_in_clause_body(HeadVars), !Goals,
!Varset, !Vartypes, !RttiVarMaps),
!:Clauses = list.map_corresponding(
func(Clause, Goal) = 'clause_body :='(Clause, Goal),
!.Clauses, !.Goals),
set_clause_list(!.Clauses, ClausesRep),
clauses_info_set_clauses_rep(ClausesRep, ItemNumbers, !ClausesInfo),
clauses_info_set_varset(!.Varset, !ClausesInfo),
clauses_info_set_vartypes(!.Vartypes, !ClausesInfo),
clauses_info_set_rtti_varmaps(!.RttiVarMaps, !ClausesInfo),
pred_info_set_clauses_info(!.ClausesInfo, PredInfo0, PredInfo)
),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
% correct_nonlocals_in_clause_body(Headvars, !Goals, !Varset, !Vartypes,
% RttiVarMaps)
% requantifies the clause body Goal. This is to ensure that no variable
% appears in the nonlocal set of a goal that doesn't also appear
% in that goal.
%
:- pred correct_nonlocals_in_clause_body(list(prog_var)::in,
hlds_goal::in, hlds_goal::out, prog_varset::in, prog_varset::out,
vartypes::in, vartypes::out, rtti_varmaps::in, rtti_varmaps::out) is det.
correct_nonlocals_in_clause_body(Headvars, !Goals, !Varset, !Vartypes,
!RttiVarMaps) :-
implicitly_quantify_clause_body_general(ordinary_nonlocals_maybe_lambda,
Headvars, Warnings, !Goals, !Varset,
!Vartypes, !RttiVarMaps),
(
Warnings = []
;
Warnings = [_ | _],
unexpected(this_file, "Quantification error during constraints" ++
" based mode analysis")
).
:- pred mc_process_scc(bool::in, list(pred_id)::in,
pred_constraint_map::in, pred_constraint_map::out,
module_info::in, module_info::out) is det.
mc_process_scc(Simple, SCC, !PredConstraintMap, !ModuleInfo) :-
some [!ModeConstraint, !MCI] (
!:ModeConstraint = one,
!:MCI = init_mode_constraint_info(Simple),
list.foldl2(number_robdd_variables_in_pred, SCC, !ModuleInfo, !MCI),
save_threshold(!.MCI, Threshold),
mc_process_scc_pass_1(SCC, SCC, !ModeConstraint, !MCI, !ModuleInfo),
!:ModeConstraint = restrict_threshold(Threshold, !.ModeConstraint),
!:ModeConstraint = ensure_normalised(!.ModeConstraint),
mc_process_scc_pass_2(SCC, !.ModeConstraint, !.MCI, !ModuleInfo),
Insert = (pred(PredId::in, PCM0::in, PCM::out) is det :-
NewPCI = pci(!.ModeConstraint,
mci_set_pred_id(!.MCI, PredId)),
map.det_insert(PCM0, PredId, NewPCI, PCM)
),
list.foldl(Insert, SCC, !PredConstraintMap)
% clear_caches(!IO).
).
:- type number_robdd_info
---> number_robdd_info(
n_mc_info :: mode_constraint_info,
n_module_info :: module_info,
n_vartypes :: vartypes
).
:- instance has_mc_info(number_robdd_info) where [
func(mc_info/1) is n_mc_info,
func('mc_info :='/2) is 'n_mc_info :='
].
:- instance has_module_info(number_robdd_info) where [
func(module_info/1) is n_module_info,
func('module_info :='/2) is 'n_module_info :='
].
:- pred update_mc_info_t(pred(T, mode_constraint_info, mode_constraint_info),
T, C, C) <= has_mc_info(C).
:- mode update_mc_info_t(pred(out, in, out) is det, out, in, out) is det.
update_mc_info_t(P, R, !C) :-
MCInfo0 = !.C ^ mc_info,
P(R, MCInfo0, MCInfo),
!C ^ mc_info := MCInfo.
:- pred update_mc_info(pred(mode_constraint_info, mode_constraint_info),
C, C) <= has_mc_info(C).
:- mode update_mc_info(pred(in, out) is det, in, out) is det.
:- mode update_mc_info(pred(in, out) is semidet, in, out) is semidet.
update_mc_info(P, !C) :-
MCInfo0 = !.C ^ mc_info,
P(MCInfo0, MCInfo),
!C ^ mc_info := MCInfo.
:- pred update_md_info(pred(T, mode_decl_info, mode_decl_info), T, C, C)
<= (has_mc_info(C), has_ho_modes(C)).
:- mode update_md_info(pred(out, in, out) is det, out, in, out) is det.
update_md_info(P, R, !C) :-
MCInfo0 = !.C ^ mc_info,
HOModes0 = !.C ^ ho_modes,
MDInfo0 = mode_decl_info(MCInfo0, HOModes0),
P(R, MDInfo0, MDInfo),
!C ^ mc_info := MDInfo ^ mc_info,
!C ^ ho_modes := MDInfo ^ ho_modes.
% Assign a number to all the ROBDD variables that we want to keep at
% the end of the analysis.
% This allows us to use `restrict_threshold' during the analysis
% to remove all unwanted variables.
% `Restrict_threshold' is much faster than using `robdd.filter'
% or `robdd.restrict'.
%
:- pred number_robdd_variables_in_pred(pred_id::in,
module_info::in, module_info::out,
mode_constraint_info::in, mode_constraint_info::out) is det.
number_robdd_variables_in_pred(PredId, !ModuleInfo, !MCI) :-
!:MCI = mci_set_pred_id(!.MCI, PredId),
save_min_var_for_pred(PredId, !MCI),
% Variables in each branch of a branched goal are always equivalent.
% Likewise, a variable in a negated or existentially quantified goal
% will always be equivalent to the variable in the parent goal. This
% means we can use the same mode_constraint_var for each of these
% equivalent variables, avoiding adding lots of equivalence constraints
% to the ROBDD. This is a good thing since equivalence constraints tend
% to cause exponential explosions in ROBDDs. We achieve this by passing
% `OmitModeEquivPrefix = yes' to `goal_path.fill_slots_in_clauses'.
% XXX We do not actually do that anymore, since this (a) that capability
% has not yet been implemented for the new goal_id system, and (b)
% this mode analysis system is obsolete.
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
clauses_info_get_headvar_list(ClausesInfo0, HeadVars),
clauses_info_get_vartypes(ClausesInfo0, VarTypes),
pred_info_get_clauses_info(PredInfo0, ClausesInfo0),
fill_goal_id_slots_in_clauses(!.ModuleInfo, ContainingGoalMap,
ClausesInfo0, ClausesInfo1),
pred_info_set_clauses_info(ClausesInfo1, PredInfo0, PredInfo1),
ForwardGoalPathMap = create_forward_goal_path_map(ContainingGoalMap),
add_forward_goal_path_map(PredId, ForwardGoalPathMap, !MCI),
pred_info_get_inst_graph_info(PredInfo1, InstGraphInfo),
InstGraph = InstGraphInfo ^ implementation_inst_graph,
inst_graph.foldl_reachable_from_list(
( pred(V::in, S0::in, S::out) is det :-
mode_constraint_var(in(V), _, S0, S1),
mode_constraint_var(out(V), _, S1, S2),
mode_constraint_var(V `at` goal_id(0), _, S2, S)
), InstGraph, HeadVars, !MCI),
( pred_info_is_imported(PredInfo1) ->
true
;
clauses_info_clauses(Clauses2, ItemNumbers,
ClausesInfo1, ClausesInfo2),
NRInfo0 = number_robdd_info(!.MCI, !.ModuleInfo, VarTypes),
list.map_foldl(
(pred(Clause0::in, Clause::out, S0::in, S::out) is det :-
Clause0 = clause(A, Goal0, C, D),
number_robdd_variables_in_goal(InstGraph,
set.init, _, Goal0, Goal, S0, S),
Clause = clause(A, Goal, C, D)
), Clauses2, Clauses, NRInfo0, NRInfo),
!:MCI = NRInfo ^ mc_info,
set_clause_list(Clauses, ClausesRep),
clauses_info_set_clauses_rep(ClausesRep, ItemNumbers,
ClausesInfo2, ClausesInfo),
pred_info_set_clauses_info(ClausesInfo, PredInfo1, PredInfo),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo)
),
save_max_var_for_pred(PredId, !MCI).
:- pred number_robdd_variables_in_goal(inst_graph::in,
set(prog_var)::in, set(prog_var)::out, hlds_goal::in, hlds_goal::out,
number_robdd_info::in, number_robdd_info::out) is det.
number_robdd_variables_in_goal(InstGraph, ParentNonLocals, Occurring,
Goal0, Goal, !RInfo) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
NonLocals = goal_info_get_nonlocals(GoalInfo0),
GoalId = goal_info_get_goal_id(GoalInfo0),
number_robdd_variables_in_goal_2(InstGraph, GoalId, ParentNonLocals,
NonLocals, Occurring, GoalExpr0, GoalExpr, !RInfo),
goal_info_set_occurring_vars(Occurring, GoalInfo0, GoalInfo),
Goal = hlds_goal(GoalExpr, GoalInfo).
:- pred number_robdd_variables_in_goal_2(inst_graph::in, goal_id::in,
set(prog_var)::in, set(prog_var)::in, set(prog_var)::out,
hlds_goal_expr::in, hlds_goal_expr::out,
number_robdd_info::in, number_robdd_info::out) is det.
number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
conj(ConjType, Goals0), conj(ConjType, Goals), !RInfo) :-
number_robdd_variables_in_goals(InstGraph, NonLocals, Occurring,
Goals0, Goals, !RInfo).
number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
disj(Goals0), disj(Goals), !RInfo) :-
number_robdd_variables_in_goals(InstGraph, NonLocals, Occurring,
Goals0, Goals, !RInfo).
number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
switch(V, CF, Cases0), switch(V, CF, Cases), !RInfo) :-
number_robdd_variables_in_cases(InstGraph, NonLocals, Occurring,
Cases0, Cases, !RInfo).
number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
negation(Goal0), negation(Goal), !RInfo) :-
number_robdd_variables_in_goal(InstGraph, NonLocals, Occurring,
Goal0, Goal, !RInfo).
number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
scope(Reason, Goal0), scope(Reason, Goal), !RInfo) :-
number_robdd_variables_in_goal(InstGraph, NonLocals, Occurring,
Goal0, Goal, !RInfo).
number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
if_then_else(Vs, Cond0, Then0, Else0),
if_then_else(Vs, Cond, Then, Else), !RInfo) :-
number_robdd_variables_in_goal(InstGraph, NonLocals, OccCond,
Cond0, Cond, !RInfo),
number_robdd_variables_in_goal(InstGraph, NonLocals, OccThen,
Then0, Then, !RInfo),
number_robdd_variables_in_goal(InstGraph, NonLocals, OccElse,
Else0, Else, !RInfo),
Occurring = OccCond `set.union` OccThen `set.union` OccElse.
number_robdd_variables_in_goal_2(_, _, _, _, _, shorthand(_), _, !RInfo) :-
unexpected(this_file, "number_robdd_variables_in_goal_2: shorthand").
% number_robdd_variables_in_goal_2(InstGraph, _, _, NonLocals, Occurring,
% atomic_goal(GoalType, Inner, Outer, Vars, MainGoal0, OrElseGoals0),
% atomic_goal(GoalType, Inner, Outer, Vars, MainGoal, OrElseGoals),
% !RInfo) :-
% number_robdd_variables_in_goal(InstGraph, NonLocals, OccMain,
% MainGoal0, MainGoal, !RInfo),
% number_robdd_variables_in_goals(InstGraph, NonLocals, OccOrElse,
% OrElseGoals0, OrElseGoals, !RInfo),
% Occurring = OccMain `set.union` OccOrElse.
number_robdd_variables_in_goal_2(InstGraph, GoalId, ParentNonLocals, _,
Occurring, GoalExpr, GoalExpr, !RInfo) :-
GoalExpr = plain_call(_, _, Args, _, _, _),
number_robdd_variables_at_goal_path(InstGraph, GoalId,
ParentNonLocals, Args, Occurring, !RInfo).
number_robdd_variables_in_goal_2(InstGraph, GoalId, ParentNonLocals, _,
Occurring, GoalExpr, GoalExpr, !RInfo) :-
GoalExpr = generic_call(_, Args, _, _),
number_robdd_variables_at_goal_path(InstGraph, GoalId,
ParentNonLocals, Args, Occurring, !RInfo).
number_robdd_variables_in_goal_2(InstGraph, GoalId, ParentNonLocals, _,
Occurring, GoalExpr0, GoalExpr, !RInfo) :-
GoalExpr0 = unify(VarL, RHS0, _, _, _),
number_robdd_variables_in_rhs(InstGraph, GoalId, Vars, RHS0, RHS,
!RInfo),
GoalExpr = GoalExpr0 ^ unify_rhs := RHS,
number_robdd_variables_at_goal_path(InstGraph, GoalId,
ParentNonLocals, [VarL | Vars], Occurring, !RInfo).
number_robdd_variables_in_goal_2(InstGraph, GoalId, ParentNonLocals, _,
Occurring, GoalExpr, GoalExpr, !RInfo) :-
GoalExpr = call_foreign_proc(_, _, _, Args, _, _, _),
ArgVars = list.map(foreign_arg_var, Args),
number_robdd_variables_at_goal_path(InstGraph, GoalId,
ParentNonLocals, ArgVars, Occurring, !RInfo).
:- pred number_robdd_variables_in_rhs(inst_graph::in, goal_id::in,
list(prog_var)::out, unify_rhs::in, unify_rhs::out,
number_robdd_info::in, number_robdd_info::out) is det.
number_robdd_variables_in_rhs(_, _, Vars, !RHS, !NRInfo) :-
!.RHS = rhs_var(VarR),
Vars = [VarR].
number_robdd_variables_in_rhs(_, _, Vars, !RHS, !NRInfo) :-
!.RHS = rhs_functor(_, _, Args),
Vars = Args.
number_robdd_variables_in_rhs(InstGraph, GoalId, Vars, !RHS, !NRInfo) :-
!.RHS = rhs_lambda_goal(_, _, _, _, LambdaNonLocals, LambdaVars, _, _,
LambdaGoal0),
Vars = LambdaNonLocals,
update_mc_info(enter_lambda_goal(GoalId), !NRInfo),
% Number arguments to the lambda goal, i.e. the nonlocals and the
% lambda-quantified variables.
LambdaHeadVars = LambdaNonLocals ++ LambdaVars,
update_mc_info(pred(in, out) is det -->
inst_graph.foldl_reachable_from_list(
( pred(V::in, in, out) is det -->
mode_constraint_var(in(V), _),
mode_constraint_var(out(V), _),
mode_constraint_var(V `at` whole_body_goal_id, _)
), InstGraph, LambdaHeadVars), !NRInfo),
% Number variables within the lambda goal.
number_robdd_variables_in_goal(InstGraph, set.init, _Occurring,
LambdaGoal0, LambdaGoal, !NRInfo),
update_mc_info(leave_lambda_goal, !NRInfo),
!RHS ^ rhs_lambda_goal := LambdaGoal.
:- pred number_robdd_variables_at_goal_path(inst_graph::in, goal_id::in,
set(prog_var)::in, list(prog_var)::in, set(prog_var)::out,
number_robdd_info::in, number_robdd_info::out) is det.
number_robdd_variables_at_goal_path(InstGraph, GoalId, ParentNonLocals,
Vars0, Occurring, !NRInfo) :-
solutions.solutions_set(inst_graph.reachable_from_list(InstGraph, Vars0),
Occurring),
Vars = set.to_sorted_list(ParentNonLocals `set.union`
set.list_to_set(Vars0)),
% XXX We may be able to make this more efficient.
inst_graph.foldl_reachable_from_list(
(pred(V::in, S0::in, S::out) is det :-
update_mc_info_t(mode_constraint_var(V `at` GoalId), _, S0, S)
), InstGraph, Vars, !NRInfo).
:- pred number_robdd_variables_in_goals(inst_graph::in, set(prog_var)::in,
set(prog_var)::out, hlds_goals::in, hlds_goals::out,
number_robdd_info::in, number_robdd_info::out) is det.
number_robdd_variables_in_goals(_, _, Occurring, [], [], !RInfo) :-
set.init(Occurring).
number_robdd_variables_in_goals(InstGraph, NonLocals, Occurring,
[Goal0 | Goals0], [Goal | Goals], !RInfo) :-
number_robdd_variables_in_goal(InstGraph, NonLocals, Occurring0,
Goal0, Goal, !RInfo),
number_robdd_variables_in_goals(InstGraph, NonLocals, Occurring1,
Goals0, Goals, !RInfo),
Occurring = Occurring0 `set.union` Occurring1.
:- pred number_robdd_variables_in_cases(inst_graph::in, set(prog_var)::in,
set(prog_var)::out, list(case)::in, list(case)::out,
number_robdd_info::in, number_robdd_info::out) is det.
number_robdd_variables_in_cases(_, _, Occurring, [], [], !RInfo) :-
set.init(Occurring).
number_robdd_variables_in_cases(InstGraph, NonLocals, Occurring,
[Case0 | Cases0], [Case | Cases], !RInfo) :-
Case0 = case(MainConsId, OtherConsIds, Goal0),
number_robdd_variables_in_goal(InstGraph, NonLocals, Occurring0,
Goal0, Goal, !RInfo),
Case = case(MainConsId, OtherConsIds, Goal),
number_robdd_variables_in_cases(InstGraph, NonLocals, Occurring1,
Cases0, Cases, !RInfo),
Occurring = Occurring0 `set.union` Occurring1.
%-----------------------------------------------------------------------------%
:- pred mc_process_scc_pass_1(list(pred_id)::in,
list(pred_id)::in,
mode_constraint::in, mode_constraint::out,
mode_constraint_info::in, mode_constraint_info::out,
module_info::in, module_info::out) is det.
mc_process_scc_pass_1([], _, !ModeConstraint, !MCI, !ModuleInfo).
mc_process_scc_pass_1([PredId | PredIds], SCC,
!ModeConstraint, !MCI, !ModuleInfo) :-
!:MCI = mci_set_pred_id(!.MCI, PredId),
mc_process_pred(PredId, SCC, !ModeConstraint, !MCI, !ModuleInfo),
mc_process_scc_pass_1(PredIds, SCC, !ModeConstraint,
!MCI, !ModuleInfo).
:- pred mc_process_scc_pass_2(list(pred_id)::in,
mode_constraint::in, mode_constraint_info::in,
module_info::in, module_info::out) is det.
mc_process_scc_pass_2([], _, _, !ModuleInfo).
mc_process_scc_pass_2([PredId | PredIds], ModeConstraint, MCI,
!ModuleInfo) :-
mc_process_pred_2(PredId, ModeConstraint,
mci_set_pred_id(MCI, PredId), !ModuleInfo),
mc_process_scc_pass_2(PredIds, ModeConstraint,
MCI, !ModuleInfo).
:- pred mc_process_pred(pred_id::in, list(pred_id)::in,
mode_constraint::in, mode_constraint::out,
mode_constraint_info::in, mode_constraint_info::out,
module_info::in, module_info::out) is det.
mc_process_pred(PredId, SCC, !ModeConstraint, !MCI,
!ModuleInfo) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
trace [io(!IO)] (
write_pred_progress_message("% Calculating mode constraints for ",
PredId, !.ModuleInfo, !IO),
io.flush_output(!IO)
),
pred_info_get_inst_graph_info(PredInfo0, InstGraphInfo),
InstGraph = InstGraphInfo ^ implementation_inst_graph,
pred_info_get_procedures(PredInfo0, ProcTable0),
pred_info_get_clauses_info(PredInfo0, ClausesInfo0),
clauses_info_get_headvar_list(ClausesInfo0, HeadVars),
HOModes0 = map.init,
(
( map.is_empty(ProcTable0)
; pred_info_infer_modes(PredInfo0)
)
->
DeclConstraint = one,
HOModes = HOModes0,
PredInfo1 = PredInfo0
;
ModeDeclInfo0 = mode_decl_info(!.MCI, HOModes0),
map.map_foldl2(
mode_decl_to_constraint(!.ModuleInfo, InstGraph, HeadVars,
PredInfo0),
ProcTable0, ProcTable,
zero, DeclConstraint, ModeDeclInfo0, ModeDeclInfo),
!:MCI = ModeDeclInfo ^ mc_info,
HOModes = ModeDeclInfo ^ ho_modes,
pred_info_set_procedures(ProcTable, PredInfo0, PredInfo1)
),
!:ModeConstraint = !.ModeConstraint * DeclConstraint,
set_input_nodes(!ModeConstraint, !MCI),
% clauses_info_get_varset(ClausesInfo0, ProgVarSet),
% pred_id_to_int(PredId, PredIdInt),
% robdd_to_dot(DeclConstraint, ProgVarSet, MCI,
% format("mode_decl_%d.dot", [i(PredIdInt)]), !IO),
% robdd_to_dot(ModeConstraint1, ProgVarSet, MCI,
% format("mode_constraint1_%d.dot", [i(PredIdInt)]), !IO),
% io.flush_output(!IO),
( pred_info_is_imported(PredInfo1) ->
PredInfo = PredInfo1
;
process_clauses_info(!.ModuleInfo, SCC, ClausesInfo0, ClausesInfo,
InstGraph, HOModes, !ModeConstraint, !MCI),
pred_info_set_clauses_info(ClausesInfo, PredInfo1, PredInfo)
),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
:- pred mc_process_pred_2(pred_id::in, mode_constraint::in,
mode_constraint_info::in, module_info::in, module_info::out) is det.
mc_process_pred_2(PredId, ModeConstraint, MCI0, !ModuleInfo) :-
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
pred_info_get_inst_graph_info(PredInfo0, InstGraphInfo),
InstGraph = InstGraphInfo ^ implementation_inst_graph,
pred_info_get_clauses_info(PredInfo0, ClausesInfo),
clauses_info_get_headvar_list(ClausesInfo, HeadVars),
% DMO document this better
% XXX Needed for analysing calls. May want to store the constraint
% as an ROBDD instead.
solutions(arg_modes_map(HeadVars, InstGraph, ModeConstraint, MCI0), Modes),
pred_info_set_arg_modes_maps(Modes, PredInfo0, PredInfo),
% PredInfo = PredInfo0,
% DEBUGGING CODE
% dump_mode_constraints(!.ModuleInfo, PredInfo0, InstGraph,
% ModeConstraint, MCI0),
% io.flush_output(!IO),
%
% list.foldl((pred(M - _::in, di, uo) is det -->
% map.foldl((pred(_MV::in, Val::in, di, uo) is det -->
% io.write_string(Val = yes -> "1 " ; "0 ")
% ), M),
% io.nl
% ), Modes),
%
% io.nl(!IO),
%
% solutions(inst_graph.reachable_from_list(InstGraph, HeadVars),
% ReachVars),
% list.map_foldl((pred(PV::in, MV::out, in, out) is det -->
% mode_constraint_var(in(PV), MV)
% ), ReachVars, InVars, MCI0, MCI),
%
% InVarConstraint = restrict_filter((pred(in(V)::in) is semidet :-
% list.member(V, ReachVars)),
% MCI, ModeConstraint),
% aggregate(fundamental_mode(set.list_to_set(InVars), InVarConstraint),
% (pred(M::in, di, uo) is det -->
% map.foldl((pred(_MV::in, Val::in, di, uo) is det -->
% io.write_string(Val = yes -> "1 " ; "0 ")
% ), M),
% io.nl
% ), !IO),
% DMO justify or delete
% split_constraint_into_modes(PredId, HeadVars, InstGraph,
% ModeConstraint, _ProcConstraints, MCI0, MCI),
% DEBUGGING CODE
% clauses_info_get_varset(ClausesInfo, ProgVarSet),
% pred_info_name(PredInfo, Name),
% robdd_to_dot(ModeConstraint, ProgVarSet, MCI, Name ++ ".dot", !IO),
% io.flush_output(!IO),
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
:- type goal_constraints_info
---> goal_constraints_info(
g_module_info :: module_info,
scc :: list(pred_id),
inst_graph :: inst_graph,
headvars :: list(prog_var),
prog_varset :: prog_varset,
atomic_goals :: set(goal_id),
g_mc_info :: mode_constraint_info,
g_ho_modes :: ho_modes,
ho_calls :: ho_calls
).
:- instance has_mc_info(goal_constraints_info) where [
func(mc_info/1) is g_mc_info,
func('mc_info :='/2) is 'g_mc_info :='
].
:- instance has_module_info(goal_constraints_info) where [
func(module_info/1) is g_module_info,
func('module_info :='/2) is 'g_module_info :='
].
:- instance has_ho_modes(goal_constraints_info) where [
func(ho_modes/1) is g_ho_modes,
func('ho_modes :='/2) is 'g_ho_modes :='
].
:- type ho_modes ==
multi_map(prog_var_and_level, list(mer_mode)).
:- type ho_calls ==
multi_map(prog_var_and_level, pair(goal_id, list(prog_var))).
:- pred get_var(rep_var::in, mode_constraint_var::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
get_var(RepVar, MCVar, !GCInfo) :-
update_mc_info_t(mode_constraint_var(RepVar), MCVar, !GCInfo).
:- pred get_var_in_pred(pred_id::in, rep_var::in, mode_constraint_var::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
get_var_in_pred(PredId, RepVar, MCVar, !GCInfo) :-
update_mc_info_t(mode_constraint_var(PredId, RepVar), MCVar, !GCInfo).
:- pred add_atomic_goal(goal_id::in,
goal_constraints_info::in, goal_constraints_info::out) is det.
add_atomic_goal(GoalId, !GCInfo) :-
AtomicGoals = !.GCInfo ^ atomic_goals,
!GCInfo ^ atomic_goals := AtomicGoals `set.insert` GoalId.
:- type mode_decl_info
---> mode_decl_info(
d_mc_info :: mode_constraint_info,
d_ho_modes :: ho_modes
).
:- instance has_mc_info(mode_decl_info) where [
func(mc_info/1) is d_mc_info,
func('mc_info :='/2) is 'd_mc_info :='
].
:- instance has_ho_modes(mode_decl_info) where [
func(ho_modes/1) is d_ho_modes,
func('ho_modes :='/2) is 'd_ho_modes :='
].
% Convert a procedure's arg_modes to a constraint.
%
:- pred mode_decl_to_constraint(module_info::in,
inst_graph::in, list(prog_var)::in, pred_info::in, proc_id::in,
proc_info::in, proc_info::out,
mode_constraint::in, mode_constraint::out,
mode_decl_info::in, mode_decl_info::out) is det.
mode_decl_to_constraint(ModuleInfo, InstGraph, HeadVars,
_PredInfo, _ProcId, !ProcInfo, !Constraint, !MDI) :-
process_mode_decl_for_proc(ModuleInfo,
InstGraph, HeadVars,
false_var(initial), true_var(initial), yes,
false_var(final), true_var(final), no,
!.ProcInfo, zero, DeclConstraint, !MDI),
% proc_id_to_int(ProcId, ProcIdInt),
% pred_info_name(PredInfo, Name),
% pred_info_clauses_info(PredInfo, ClausesInfo),
% clauses_info_get_varset(ClausesInfo, ProgVarSet),
% unsafe_perform_io(robdd_to_dot(DeclConstraint, ProgVarSet,
% !.MDI ^ mc_info, Name ++ int_to_string(ProcIdInt) ++ ".dot")),
!:Constraint = !.Constraint + DeclConstraint,
proc_info_set_head_modes_constraint(DeclConstraint, !ProcInfo).
:- pred process_mode_decl_for_proc(module_info::in,
inst_graph::in, list(prog_var)::in,
constrain_var::in(constrain_var), constrain_var::in(constrain_var),
bool::in,
constrain_var::in(constrain_var), constrain_var::in(constrain_var),
bool::in,
proc_info::in, mode_constraint::in, mode_constraint::out,
mode_decl_info::in, mode_decl_info::out) is det.
process_mode_decl_for_proc(ModuleInfo, InstGraph, HeadVars,
InitialFree, InitialBound, InitialHO, FinalFree, FinalBound, FinalHO,
ProcInfo, !Constraint, !MDI) :-
% proc_info_declared_argmodes(ProcInfo, ArgModes),
proc_info_get_argmodes(ProcInfo, ArgModes),
process_mode_decl(ModuleInfo, InstGraph, HeadVars,
InitialFree, InitialBound, InitialHO, FinalFree, FinalBound, FinalHO,
ArgModes, !Constraint, !MDI).
:- pred process_mode_decl(module_info::in,
inst_graph::in, list(prog_var)::in, constrain_var::in(constrain_var),
constrain_var::in(constrain_var), bool::in,
constrain_var::in(constrain_var), constrain_var::in(constrain_var),
bool::in, list(mer_mode)::in, mode_constraint::in, mode_constraint::out,
mode_decl_info::in, mode_decl_info::out) is det.
process_mode_decl(ModuleInfo, InstGraph, HeadVars,
InitialFree, InitialBound, InitialHO,
FinalFree, FinalBound, FinalHO, ArgModes, !Constraint, !MDI) :-
assoc_list.from_corresponding_lists(HeadVars, ArgModes, VarModes),
list.foldl2(process_arg_modes(ModuleInfo, InstGraph,
InitialFree, InitialBound, InitialHO, FinalFree, FinalBound, FinalHO),
VarModes, one, NewConstraint, !MDI),
!:Constraint = !.Constraint + NewConstraint.
:- pred process_arg_modes(module_info::in, inst_graph::in,
constrain_var::in(constrain_var), constrain_var::in(constrain_var),
bool::in,
constrain_var::in(constrain_var), constrain_var::in(constrain_var),
bool::in,
pair(prog_var, mer_mode)::in,
mode_constraint::in, mode_constraint::out,
mode_decl_info::in, mode_decl_info::out) is det.
process_arg_modes(ModuleInfo, InstGraph,
InitialFree, InitialBound, InitialHO,
FinalFree, FinalBound, FinalHO,
Var - Mode, !Constraint, !MDI) :-
mode_get_insts(ModuleInfo, Mode, InitialInst, FinalInst),
process_inst(ModuleInfo, InstGraph,
InitialFree, InitialBound, InitialHO, InitialInst,
set.init, Var, !Constraint, !MDI),
process_inst(ModuleInfo, InstGraph,
FinalFree, FinalBound, FinalHO, FinalInst,
set.init, Var, !Constraint, !MDI).
:- func initial(prog_var) = rep_var.
initial(Var) = in(Var).
:- func final(prog_var) = rep_var.
final(Var) = out(Var).
:- func var_at_goal_id(goal_id, prog_var) = rep_var.
var_at_goal_id(GoalId, Var) = Var `at` GoalId.
:- func var_at_goal(hlds_goal, prog_var) = rep_var.
var_at_goal(Goal, Var) = Var `at` GoalId :-
Goal = hlds_goal(_, GoalInfo),
GoalId = goal_info_get_goal_id(GoalInfo).
:- pred true_var((func(prog_var) = rep_var)::in(func(in) = out is det),
prog_var::in, mode_constraint::in, mode_constraint::out,
mode_constraint_info::in, mode_constraint_info::out) is det.
true_var(F, V, !C, !MCI) :-
mode_constraint_var(F(V), CV, !MCI),
!:C = !.C ^ var(CV).
:- pred false_var((func(prog_var) = rep_var)::in(func(in) = out is det),
prog_var::in, mode_constraint::in, mode_constraint::out,
mode_constraint_info::in, mode_constraint_info::out) is det.
false_var(F, V, !C, !MCI) :-
mode_constraint_var(F(V), CV, !MCI),
!:C = !.C ^ not_var(CV).
:- pred ignore(prog_var::in, mode_constraint::in, mode_constraint::out,
mode_constraint_info::in, mode_constraint_info::out) is det.
ignore(_, !C, !MCI).
:- pred call_in(goal_id::in, prog_var::in,
mode_constraint::in, mode_constraint::out,
mode_constraint_info::in, mode_constraint_info::out) is det.
call_in(Path, Var, !C, !MCI) :-
mode_constraint_var(Var `at` Path, VarGP, !MCI),
mode_constraint_var(out(Var), VarOut, !MCI),
!:C = !.C ^ not_var(VarGP) ^ var(VarOut).
:- pred call_out(goal_id::in, prog_var::in,
mode_constraint::in, mode_constraint::out,
mode_constraint_info::in, mode_constraint_info::out) is det.
call_out(Path, Var, C0, C, !MCI) :-
mode_constraint_var(Var `at` Path, VarGP, !MCI),
C1 = C0 ^ var(VarGP),
( C1 \= zero ->
C = C1
;
C = C0
).
:- type constrain_var == pred(prog_var, mode_constraint, mode_constraint,
mode_constraint_info, mode_constraint_info).
:- inst constrain_var == (pred(in, in, out, in, out) is det).
:- pred process_inst(module_info::in, inst_graph::in,
constrain_var::in(constrain_var), constrain_var::in(constrain_var),
bool::in, mer_inst::in, set(prog_var)::in, prog_var::in,
mode_constraint::in, mode_constraint::out,
mode_decl_info::in, mode_decl_info::out) is det.
process_inst(ModuleInfo, InstGraph, Free, Bound, DoHO, Inst,
Seen, Var, !Constraint, !MDI) :-
( Var `set.member` Seen ->
true
;
( Inst = defined_inst(InstName) ->
inst_lookup(ModuleInfo, InstName, Inst1),
process_inst(ModuleInfo, InstGraph,
Free, Bound, DoHO, Inst1, Seen, Var, !Constraint, !MDI)
;
do_process_inst(ModuleInfo, InstGraph,
Free, Bound, DoHO, Inst, Seen, Var, !Constraint, !MDI)
)
).
:- pred do_process_inst(module_info::in, inst_graph::in,
constrain_var::in(constrain_var), constrain_var::in(constrain_var),
bool::in, mer_inst::in, set(prog_var)::in, prog_var::in,
mode_constraint::in, mode_constraint::out,
mode_decl_info::in, mode_decl_info::out) is det.
do_process_inst(ModuleInfo, InstGraph, Free, Bound, DoHO,
Inst, Seen, Var, !Constraint, !MDI) :-
update_mc_info_t((pred(C::out, S0::in, S::out) is det :-
(
( Inst = any(_, _)
; Inst = bound(_, _)
; Inst = ground(_, _)
)
->
Bound(Var, !.Constraint, C, S0, S)
;
( Inst = free
; Inst = free(_)
)
->
Free(Var, !.Constraint, C, S0, S)
;
C = !.Constraint,
S = S0
)), !:Constraint, !MDI),
map.lookup(InstGraph, Var, node(Functors, _)),
map.foldl2(
(pred(ConsId::in, Vs::in, C0::in, C::out, S0::in, S::out)
is det :-
( Inst = bound(_, BIs) ->
( cons_id_in_bound_insts(ConsId, BIs, Insts) ->
assoc_list.from_corresponding_lists(Vs,
Insts, VarInsts),
list.foldl2((pred((V - I)::in, C1::in, C2::out,
T0::in, T::out) is det :-
process_inst(ModuleInfo, InstGraph,
Free, Bound, DoHO, I, Seen `set.insert` Var,
V, C1, C2, T0, T)
), VarInsts, C0, C, S0, S)
;
C = C0,
S = S0
)
;
list.foldl2(
process_inst(ModuleInfo, InstGraph,
Free, Bound, DoHO, Inst, Seen `set.insert` Var),
Vs, C0, C, S0, S)
)), Functors, !Constraint, !MDI),
(
DoHO = yes,
Inst = ground(_, higher_order(pred_inst_info(_, ArgModes, _)))
->
HoModes0 = !.MDI ^ ho_modes,
MCI = !.MDI ^ mc_info,
get_prog_var_level(MCI, Var, VarLevel),
multi_map.set(HoModes0, VarLevel, ArgModes, HoModes),
!MDI ^ ho_modes := HoModes
;
true
).
:- pred process_clauses_info(module_info::in,
list(pred_id)::in, clauses_info::in, clauses_info::out, inst_graph::in,
ho_modes::in, mode_constraint::in, mode_constraint::out,
mode_constraint_info::in, mode_constraint_info::out) is det.
process_clauses_info(ModuleInfo, SCC, !ClausesInfo,
InstGraph, HOModes0, !Constraint, !MCI) :-
clauses_info_get_varset(!.ClausesInfo, VarSet0),
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
(
VeryVerbose = yes,
trace [io(!IO)] (
inst_graph.dump(InstGraph, VarSet0, !IO)
)
;
VeryVerbose = no
),
clauses_info_get_headvar_list(!.ClausesInfo, HeadVars),
map.foldl2(input_output_constraints(HeadVars, InstGraph),
InstGraph, !Constraint, !MCI),
clauses_info_clauses(Clauses, _ItemNumbers, !ClausesInfo),
list.map(pred(clause(_, Goal, _, _)::in, Goal::out) is det,
Clauses, Goals),
DisjGoal = disj(Goals),
AtomicGoals0 = set.init,
GCInfo0 = goal_constraints_info(ModuleInfo, SCC, InstGraph, HeadVars,
VarSet0, AtomicGoals0, !.MCI, HOModes0, map.init),
NonLocals = set.list_to_set(HeadVars),
GoalVars = set.sorted_list_to_set(map.sorted_keys(InstGraph)),
goal_constraints_2(whole_body_goal_id, NonLocals, GoalVars, _CanSucceed,
DisjGoal, _, !Constraint, GCInfo0, GCInfo1),
% DMO justify this or eliminate it
% constrict_to_vars(HeadVars, GoalVars, [], !Constraint,
% Info1, Info2),
GCInfo2 = GCInfo1,
% robdd_to_dot(!.Constraint, Info2 ^ prog_varset,
% Info2 ^ mc_info, "before_higher_order.dot, !IO"),
% io.flush_output(!IO),
higher_order_call_constraints(!Constraint, GCInfo2, GCInfo),
% robdd_to_dot(!.Constraint, GCInfo ^ prog_varset,
% GCInfo ^ mc_info, "after_higher_order.dot", !IO),
% io.flush_output(!IO),
clauses_info_set_varset(GCInfo ^ prog_varset, !ClausesInfo),
!:MCI = GCInfo ^ mc_info.
% 1.2.1 Input output constraints.
% These constraints relate the relationships between the above
% variables and relationships of boundedness on input and output.
%
:- pred input_output_constraints(list(prog_var)::in, inst_graph::in,
prog_var::in, inst_graph.node::in,
mode_constraint::in, mode_constraint::out,
mode_constraint_info::in, mode_constraint_info::out) is det.
input_output_constraints(HeadVars, InstGraph, V, Node, !Constraint, !MCI) :-
% For each node V not reachable from an argument node, add Vin = 0.
inst_graph.top_level_node(InstGraph, V, TopLevel),
mode_constraint_var(in(V), V_in, !MCI),
mode_constraint_var(out(V), V_out, !MCI),
mode_constraint_var(V `at` whole_body_goal_id, V_, !MCI),
( TopLevel `list.member` HeadVars ->
% For each variable V in the instantiation graph, add
% (Vout = Vin + V), ~(Vin * V).
!:Constraint = !.Constraint ^ io_constraint(V_in, V_out, V_)
;
!:Constraint = !.Constraint ^ not_var(V_in) ^ eq_vars(V_out, V_)
),
% For each node V in the graph with child f with child W, add
% Wout -> Vout, Win -> Vin.
Node = node(Functors, _),
map.values(Functors, Children0),
list.condense(Children0, Children),
list.foldl2(add_in_and_out_implications(V, V_in, V_out), Children,
!Constraint, !MCI).
:- pred add_in_and_out_implications(prog_var::in,
mode_constraint_var::in, mode_constraint_var::in, prog_var::in,
mode_constraint::in, mode_constraint::out,
mode_constraint_info::in, mode_constraint_info::out) is det.
add_in_and_out_implications(V, V_in, V_out, W, !Cs, !MCI) :-
( W = V ->
true
;
mode_constraint_var(in(W), W_in, !MCI),
mode_constraint_var(out(W), W_out, !MCI),
!:Cs = !.Cs ^ imp_vars(W_out, V_out) ^ imp_vars(W_in, V_in)
).
:- type can_succeed == bool.
:- pred goal_constraints(set(prog_var)::in, can_succeed::out, hlds_goal::in,
hlds_goal::out, mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
goal_constraints(ParentNonLocals, CanSucceed, Goal0, Goal,
!Constraint, !GCInfo) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
HasSubGoals = goal_expr_has_subgoals(GoalExpr0),
(
HasSubGoals = has_subgoals
;
HasSubGoals = does_not_have_subgoals,
add_atomic_goal(GoalId, !GCInfo)
),
GoalId = goal_info_get_goal_id(GoalInfo0),
goal_info_get_occurring_vars(GoalInfo0, Vars),
% Number the vars we want to keep for this goal.
% XXX
list.foldl((pred(V::in, S0::in, S::out) is det :-
get_var(V `at` GoalId, _, S0, S)
), set.to_sorted_list(Vars), !GCInfo),
save_threshold(!.GCInfo ^ mc_info, Threshold),
NonLocals = goal_info_get_nonlocals(GoalInfo0),
InstGraph = !.GCInfo ^ inst_graph,
NonLocalReachable = solutions.solutions_set(inst_graph.reachable_from_list(
InstGraph, to_sorted_list(NonLocals))),
LocalVars = Vars `difference` NonLocalReachable,
( using_simple_mode_constraints(!.GCInfo ^ g_mc_info) ->
% With simple mode constraints, it is more efficient to do this
% constraint before doing the goal constraints.
constrain_local_vars(LocalVars, GoalId, !Constraint, !GCInfo),
goal_constraints_2(GoalId, NonLocals, Vars, CanSucceed, GoalExpr0,
GoalExpr, !Constraint, !GCInfo)
;
goal_constraints_2(GoalId, NonLocals, Vars, CanSucceed, GoalExpr0,
GoalExpr, !Constraint, !GCInfo),
% Without simple mode constraints, it is more efficient to do this
% constraint after doing the goal constraints.
constrain_local_vars(LocalVars, GoalId, !Constraint, !GCInfo)
),
% DEBUGGING CODE
% ModuleInfo = !GCInfo ^ module_info,
% ProgVarset = !GCInfo ^ prog_varset,
% functor(GoalExpr, Functor, _),
% unsafe_perform_io(io.format("\nFunctor: %s\n", [s(Functor)])),
% unsafe_perform_io(dump_constraints(ModuleInfo, ProgVarset,
% !.Constraint)),
% DMO document
% constrict_to_vars(set.to_sorted_list(NonLocals), Vars,
% GoalId, !Constraint, !GCInfo)
% DEBUGGING CODE
% size(Constraint1, NumNodes1, Depth1),
% unsafe_perform_io(io.format(
% "Pre restrict Size: %d, Depth: %d\n",
% [i(NumNodes1), i(Depth1)])),
% unsafe_perform_io(io.flush_output),
!:Constraint = restrict_threshold(Threshold, !.Constraint),
% DEBUGGING CODE
% size(Constraint2, NumNodes2, Depth2),
% unsafe_perform_io(io.format(
% "Post restrict Size: %d, Depth: %d\n",
% [i(NumNodes2), i(Depth2)])),
% unsafe_perform_io(io.flush_output),
constrain_non_occurring_vars(CanSucceed, ParentNonLocals, Vars,
GoalId, !Constraint, !GCInfo),
% DEBUGGING CODE
% unsafe_perform_io(dump_constraints(ModuleInfo, ProgVarset,
% !.Constraint)),
% goal_info_set_mode_constraint(GoalInfo0, !.Constraint, GoalInfo).
Goal = hlds_goal(GoalExpr, GoalInfo0).
:- pred goal_constraints_2(goal_id::in, set(prog_var)::in,
set(prog_var)::in, can_succeed::out, hlds_goal_expr::in,
hlds_goal_expr::out, mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
goal_constraints_2(GoalId, NonLocals, Vars, CanSucceed, GoalExpr0, GoalExpr,
!Constraint, !GCInfo) :-
(
GoalExpr0 = conj(ConjType, Goals0),
(
ConjType = plain_conj,
multi_map.init(Usage0),
Usage = list.foldl(func(G, U0) =
list.foldl((func(V, U1) = U :-
multi_map.set(U1, V, get_goal_id(G), U)),
set.to_sorted_list(vars(G)), U0),
Goals0, Usage0),
known_vars(ensure_normalised(!.Constraint), KnownTrue, KnownFalse),
% Generate conj constraints for known vars first since these
% should be more efficient and provide lots of useful information
% for the subgoal constraints.
conj_constraints(yes, KnownTrue, KnownFalse, GoalId, Usage,
!Constraint, !GCInfo),
conj_subgoal_constraints(NonLocals, CanSucceed, !Constraint,
Goals0, Goals, !GCInfo),
% Generate the rest of the constraints.
conj_constraints(no, KnownTrue, KnownFalse, GoalId, Usage,
!Constraint, !GCInfo)
;
ConjType = parallel_conj,
sorry(this_file, "goal_constraints_2: par_conj NYI")
),
GoalExpr = conj(ConjType, Goals)
;
GoalExpr0 = disj(Goals0),
disj_constraints(NonLocals, CanSucceed, !Constraint, Goals0, Goals,
[], DisjunctPaths, !GCInfo),
list.foldl2((pred(V::in, Cons0::in, Cons::out, in, out) is det -->
get_var(V `at` GoalId, Vgp),
list.foldl2((pred(I::in, C0::in, C::out, in, out) is det -->
get_var(V `at` I, VI),
{ C = C0 ^ eq_vars(Vgp, VI) }
), DisjunctPaths, Cons0, Cons)
), set.to_sorted_list(Vars), !Constraint, !GCInfo),
GoalExpr = disj(Goals)
;
GoalExpr0 = unify(Var, RHS0, _, _, _),
unify_constraints(Var, GoalId, RHS0, RHS, !Constraint, !GCInfo),
GoalExpr = GoalExpr0 ^ unify_rhs := RHS,
CanSucceed = yes % XXX Can we be more precise here?
;
GoalExpr0 = plain_call(PredId, _, Args, _, _, _),
SCC = !.GCInfo ^ scc,
InstGraph = !.GCInfo ^ inst_graph,
ModuleInfo = !.GCInfo ^ module_info,
module_info_pred_info(ModuleInfo, PredId, PredInfo),
CanSucceed = ( pred_can_succeed(PredInfo) -> yes ; no ),
( PredId `list.member` SCC ->
% This is a recursive call.
% XXX we currently assume that all recursive calls are to the
% same mode of the predicate.
pred_info_get_clauses_info(PredInfo, ClausesInfo),
clauses_info_get_headvar_list(ClausesInfo, HeadVars),
call_constraints(GoalId, PredId, HeadVars, Args,
!Constraint, !GCInfo)
;
% This is a non-recursive call.
( pred_has_mode_decl(ModuleInfo, PredId) ->
% The predicate has mode declarations so use them
% to obtain the constraints for the call.
pred_info_get_procedures(PredInfo, ProcTable),
map.values(ProcTable, ProcInfos),
update_md_info((pred(C::out, S0::in, S::out) is det :-
list.foldl2(
process_mode_decl_for_proc(ModuleInfo,
InstGraph, Args, ignore, call_in(GoalId), no,
false_var(var_at_goal_id(GoalId)),
call_out(GoalId), yes),
ProcInfos, zero, C, S0, S)),
CallConstraint, !GCInfo)
;
% The called predicate is from a lower (i.e. already
% mode-analysed) SCC, but does not have any mode declarations.
pred_info_get_arg_modes_maps(PredInfo, ArgModes),
pred_info_get_inst_graph_info(PredInfo, InstGraphInfo),
PredInstGraph = InstGraphInfo ^ interface_inst_graph,
pred_info_get_clauses_info(PredInfo, PredClausesInfo),
clauses_info_get_headvar_list(PredClausesInfo, PredHeadVars),
solutions((pred((V - W)::out) is nondet :-
inst_graph.corresponding_nodes_from_lists(
PredInstGraph, InstGraph, PredHeadVars, Args, V, W)
), CorrespondingNodes),
list.foldl2((pred(ArgMap::in, Cn0::in, Cn::out,
S0::in, S::out) is det :-
ArgMap = InArgs - OutArgs,
list.foldl2((pred((V - W)::in, C0::in, C::out,
T0::in, T::out) is det :-
get_var(W `at` GoalId, Wgp, T0, T1),
get_var(out(W), Wout, T1, T),
( map.lookup(InArgs, V, yes) ->
C = C0 ^ var(Wout) ^ not_var(Wgp)
; map.lookup(OutArgs, V, yes) ->
C = C0 ^ var(Wgp)
;
C = C0 ^ not_var(Wgp)
)
), CorrespondingNodes, one, Cn1, S0, S),
Cn = Cn0 + Cn1
), ArgModes, zero, CallConstraint, !GCInfo)
% XXX ArgModes is [] for `odd' - why?
),
!:Constraint = !.Constraint * CallConstraint
),
GoalExpr = GoalExpr0
;
GoalExpr0 = generic_call(GenericCall, Args, _Modes, _Det),
% Note: `_Modes' is invalid for higher-order calls at this point.
(
GenericCall = higher_order(Var, _, _, _),
generic_call_constrain_var(Var, GoalId, !Constraint, !GCInfo),
% Record that the argument vars need to be constrained
% once we know the higher order mode of the Var we are calling.
HoCalls0 = !.GCInfo ^ ho_calls,
get_prog_var_level(!.GCInfo ^ mc_info, Var, VarLevel),
multi_map.set(HoCalls0, VarLevel, GoalId - Args, HoCalls),
!GCInfo ^ ho_calls := HoCalls,
CanSucceed = yes % XXX should check this
;
GenericCall = class_method(Var, _, _, _),
generic_call_constrain_var(Var, GoalId, !Constraint, !GCInfo),
unexpected(this_file, "class_method call in clause")
;
GenericCall = event_call(_),
sorry(this_file, "event_call NYI")
;
GenericCall = cast(_),
sorry(this_file, "type/inst cast call NYI")
),
GoalExpr = GoalExpr0
;
GoalExpr0 = switch(_, _, _),
unexpected(this_file, "goal_constraints_2: switch (should be disj)")
;
GoalExpr0 = negation(SubGoal0),
goal_constraints(NonLocals, _, SubGoal0, SubGoal,
!Constraint, !GCInfo),
CanSucceed = yes,
list.foldl2((pred(V::in, C0::in, C::out, in, out) is det -->
get_var(V `at` GoalId, Vgp),
get_var(V `at` get_goal_id(SubGoal), Vneg),
{ C = C0 ^ eq_vars(Vgp, Vneg) }
), set.to_sorted_list(Vars), !Constraint, !GCInfo),
% Make sure the negation doesn't bind any nonlocal variables.
negation_constraints(GoalId, NonLocals, !Constraint, !GCInfo),
GoalExpr = negation(SubGoal)
;
GoalExpr0 = scope(Reason, SubGoal0),
goal_constraints(NonLocals, CanSucceed, SubGoal0, SubGoal, !Constraint,
!GCInfo),
list.foldl2((pred(V::in, C0::in, C::out, in, out) is det -->
get_var(V `at` GoalId, Vgp),
get_var(V `at` get_goal_id(SubGoal), Vexist),
{ C = C0 ^ eq_vars(Vgp, Vexist) }
), set.to_sorted_list(Vars), !Constraint, !GCInfo),
GoalExpr = scope(Reason, SubGoal)
;
GoalExpr0 = if_then_else(IteNonLocals, Cond0, Then0, Else0),
% Make sure that the condition doesn't bind any variables that are
% non-local to the if-then-else.
negation_constraints(get_goal_id(Cond0), NonLocals, !Constraint,
!GCInfo),
goal_constraints(NonLocals, CanSucceedC, Cond0, Cond, !Constraint,
!GCInfo),
goal_constraints(NonLocals, CanSucceedT, Then0, Then, !Constraint,
!GCInfo),
goal_constraints(NonLocals, CanSucceedE, Else0, Else, !Constraint,
!GCInfo),
CanSucceed = (CanSucceedC `and` CanSucceedT) `or` CanSucceedE,
InstGraph = !.GCInfo ^ inst_graph,
NonLocalReachable = solutions.solutions(inst_graph.reachable_from_list(
InstGraph, to_sorted_list(NonLocals))),
% Make sure variables have the same bindings in both the then and else
% branches.
list.foldl2((pred(V::in, C0::in, C::out, S0::in, S::out) is det :-
get_var(V `at` GoalId, Vgp, S0, S1),
get_var(V `at` get_goal_id(Then0), Vthen, S1, S2),
get_var(V `at` get_goal_id(Else0), Velse, S2, S),
C = C0 ^ eq_vars(Vgp, Vthen) ^ eq_vars(Vgp, Velse)
), NonLocalReachable, !Constraint, !GCInfo),
% Make sure variables are bound in at most one of the cond and then
% goals.
list.foldl2((pred(V::in, C0::in, C::out, S0::in, S::out) is det :-
get_var(V `at` get_goal_id(Cond0), Vcond, S0, S1),
get_var(V `at` get_goal_id(Then0), Vthen, S1, S),
C = C0 ^ not_both(Vcond, Vthen)
), set.to_sorted_list(vars(Cond0) `set.union` vars(Then0)),
!Constraint, !GCInfo),
% Local variables bound in cond, then or else should be treated as
% though they are bound in the ite as well. (Although all such
% variables will be local to the ite, the _out constraints still
% need to be satisfied.)
Locals = to_sorted_list(
Vars `difference` sorted_list_to_set(NonLocalReachable)),
list.foldl2((pred(V::in, C0::in, C::out, S0::in, S::out) is det :-
get_var(V `at` get_goal_id(Cond), Vcond, S0, S1),
get_var(V `at` get_goal_id(Then), Vthen, S1, S2),
get_var(V `at` get_goal_id(Else), Velse, S2, S3),
get_var(V `at` GoalId, Vgp, S3, S),
Vs = list_to_set([Vcond, Vthen, Velse]),
C = C0 ^ disj_vars_eq(Vs, Vgp)
), Locals, !Constraint, !GCInfo),
GoalExpr = if_then_else(IteNonLocals, Cond, Then, Else)
;
GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
sorry(this_file, "goal_constraints_2: foreign_proc NYI")
;
GoalExpr0 = shorthand(_),
sorry(this_file, "goal_constraints_2: shorthand")
).
% goal_constraints_2(GoalId, NonLocals, Vars, CanSucceed,
% atomic_goal(GoalType, Outer, Inner, OutVars, MainGoal0, OrElseGoals0),
% atomic_goal(GoalType, Outer, Inner, OutVars, MainGoal, OrElseGoals),
% !Constraint, !GCInfo) :-
% Goals0 = [MainGoal0 | OrElseGoals0],
% disj_constraints(NonLocals, CanSucceed, !Constraint, Goals0, Goals,
% [], DisjunctPaths, !GCInfo),
% list.foldl2((pred(V::in, Cons0::in, Cons::out, in, out) is det -->
% get_var(V `at` GoalId, Vgp),
% list.foldl2((pred(Path::in, C0::in, C::out, in, out) is det -->
% get_var(V `at` Path, VPath),
% { C = C0 ^ eq_vars(Vgp, VPath) }
% ), DisjunctPaths, Cons0, Cons)
% ), set.to_sorted_list(Vars), !Constraint, !GCInfo),
% MainGoal = list.det_head(Goals),
% OrElseGoals = list.det_tail(Goals).
% Constraints for the conjunction. If UseKnownVars = yes, generate
% constraints only for the vars in KnownVars, otherwise generate
% constraints only for the vars _not_ is KnownVars.
%
:- pred conj_constraints(bool::in, mode_constraint_vars::in,
mode_constraint_vars::in, goal_id::in, multi_map(prog_var, goal_id)::in,
mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
conj_constraints(UseKnownVars, KnownTrue, KnownFalse, GoalId, UsageMap,
!Constraint, !GCInfo) :-
UsageList = map.to_assoc_list(UsageMap), % XXX needed for deep profiler
list.foldl2(
conj_constraints_process_var(UseKnownVars, KnownTrue, KnownFalse,
GoalId),
UsageList, !Constraint, !GCInfo).
:- pred conj_constraints_process_var(bool::in, mode_constraint_vars::in,
mode_constraint_vars::in, goal_id::in, pair(prog_var, list(goal_id))::in,
mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
conj_constraints_process_var(UseKnownVars, KnownTrue, KnownFalse, GoalId,
Var - Ids, !Constraint, !GCInfo) :-
list.map_foldl((pred(I::in, CV::out, in, out) is det -->
get_var(Var `at` I, CV)
), Ids, ConstraintVars, !GCInfo),
get_var(Var `at` GoalId, VConj, !GCInfo),
ConstraintVarSet = list_to_set(ConstraintVars),
% If UseKnownVars = yes we want to only generate the constraints
% which are 2-sat. If UseKnownVars = no, we generate the other
% constraints.
( KnownFalse `contains` VConj ->
(
UseKnownVars = yes,
!:Constraint = !.Constraint ^ conj_not_vars(ConstraintVarSet)
;
UseKnownVars = no
)
; KnownTrue `contains` VConj ->
( ConstraintVars = [] ->
!:Constraint = zero
; ConstraintVars = [ConstraintVar] ->
(
UseKnownVars = yes,
!:Constraint = !.Constraint ^ var(ConstraintVar)
;
UseKnownVars = no
)
; ConstraintVars = [ConstraintVar1, ConstraintVar2] ->
(
UseKnownVars = yes,
!:Constraint = !.Constraint
^ neq_vars(ConstraintVar1, ConstraintVar2)
;
UseKnownVars = no
)
;
(
UseKnownVars = yes
;
UseKnownVars = no,
!:Constraint = !.Constraint
^ at_most_one_of(ConstraintVarSet)
^ disj_vars_eq(ConstraintVarSet, VConj)
)
)
;
(
UseKnownVars = yes
;
UseKnownVars = no,
!:Constraint = !.Constraint
^ at_most_one_of(ConstraintVarSet)
^ disj_vars_eq(ConstraintVarSet, VConj)
)
).
:- pred conj_subgoal_constraints(set(prog_var)::in, can_succeed::out,
mode_constraint::in, mode_constraint::out,
hlds_goals::in, hlds_goals::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
conj_subgoal_constraints(_, yes, !Constraint, [], [], !GCInfo).
conj_subgoal_constraints(NonLocals, CanSucceed, !Constraint,
[Goal0 | Goals0], [Goal | Goals], !GCInfo) :-
goal_constraints(NonLocals, CanSucceed0, Goal0, Goal, !Constraint,
!GCInfo),
conj_subgoal_constraints(NonLocals, CanSucceed1, !Constraint,
Goals0, Goals, !GCInfo),
CanSucceed = CanSucceed0 `bool.and` CanSucceed1.
:- pred disj_constraints(set(prog_var)::in, can_succeed::out,
mode_constraint::in, mode_constraint::out,
hlds_goals::in, hlds_goals::out,
list(goal_id)::in, list(goal_id)::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
disj_constraints(_, no, !Constraint, [], [], Ids, Ids, !GCInfo).
disj_constraints(NonLocals, CanSucceed, !Constraint,
[Goal0 | Goals0], [Goal | Goals], Ids0, Ids, !GCInfo) :-
goal_constraints(NonLocals, CanSucceed0, Goal0, Goal,
!Constraint, !GCInfo),
disj_constraints(NonLocals, CanSucceed1, !Constraint, Goals0, Goals,
[get_goal_id(Goal) | Ids0], Ids, !GCInfo),
CanSucceed = CanSucceed0 `bool.or` CanSucceed1.
% See 1.2.3 The literals themselves
%
:- pred unify_constraints(prog_var::in, goal_id::in, unify_rhs::in,
unify_rhs::out, mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
unify_constraints(LHSVar, GoalId, RHS0, RHS, !Constraint, !GCInfo) :-
(
RHS0 = rhs_var(RHSVar),
InstGraph = !.GCInfo ^ inst_graph,
Generator =
(pred((V - W)::out) is multi :-
inst_graph.same_graph_corresponding_nodes(InstGraph,
LHSVar, RHSVar, V, W)
),
Accumulator =
(pred((V - W)::in, C0::in, C::out, S0::in, S::out) is det :-
get_var(out(V), Vout, S0, S1),
get_var(out(W), Wout, S1, S2),
get_var(V `at` GoalId, Vgi, S2, S3),
get_var(W `at` GoalId, Wgi, S3, S),
C = C0 ^ eq_vars(Vout, Wout) ^ not_both(Vgi, Wgi)
),
solutions.aggregate2(Generator, Accumulator, !Constraint, !GCInfo),
get_var(out(LHSVar), LHSVarOut, !GCInfo),
!:Constraint = !.Constraint ^ var(LHSVarOut),
HoModes0 = !.GCInfo ^ ho_modes,
update_mc_info_t(share_ho_modes(LHSVar, RHSVar, HoModes0), HoModes,
!GCInfo),
!GCInfo ^ ho_modes := HoModes,
RHS = RHS0
;
RHS0 = rhs_functor(_ConsId, _IsExistConstruct, Args),
get_var(out(LHSVar), LHSVarOut, !GCInfo),
!:Constraint = !.Constraint ^ var(LHSVarOut),
( using_simple_mode_constraints(!.GCInfo ^ g_mc_info) ->
% In the simple system a var-functor unification must be either
% a construction or a deconstruction.
list.map_foldl(
( pred(ProgVar::in, RepVar::out, S0::in, S::out) is det :-
get_var(ProgVar `at` GoalId, RepVar, S0, S)
), Args, ArgsGi0, !GCInfo),
ArgsGi = list_to_set(ArgsGi0),
get_var(LHSVar `at` GoalId, LHSVargi, !GCInfo),
( remove_least(ArgsGi, Arg1gi, ArgsGi1) ->
!:Constraint = !.Constraint
^ neq_vars(Arg1gi, LHSVargi)
^ fold(eq_vars(Arg1gi), ArgsGi1)
;
!:Constraint = !.Constraint
)
% Constraint = Constraint1 *
% ( one ^ var(Agp) ^ conj_not_vars(ArgsGp)
% + one ^ not_var(Agp) ^ conj_vars(ArgsGp)
% )
;
InstGraph = !.GCInfo ^ inst_graph,
inst_graph.foldl_reachable_from_list2(
( pred(V::in, C0::in, C::out, S0::in, S::out) is det :-
( V \= LHSVar ->
get_var(V `at` GoalId, Vgp, S0, S),
C = C0 ^ not_var(Vgp)
;
C = C0,
S = S0
)
), InstGraph, Args, !Constraint, !GCInfo)
),
RHS = RHS0
;
RHS0 = rhs_lambda_goal(_, _, _, _, NonLocals, LambdaVars, Modes,
_, Goal0),
InstGraph = !.GCInfo ^ inst_graph,
% Variable Var is made ground by this goal.
inst_graph.foldl_reachable2(
( pred(V::in, Cn0::in, Cn::out, in, out) is det -->
get_var(V `at` GoalId, Vgp),
{ Cn = Cn0 ^ var(Vgp) }
), InstGraph, LHSVar, !Constraint, !GCInfo),
% The lambda NonLocals are not bound by this goal.
inst_graph.foldl_reachable_from_list2(
( pred(V::in, Cn0::in, Cn::out, in, out) is det -->
get_var(V `at` GoalId, Vgp),
{ Cn = Cn0 ^ not_var(Vgp) }
), InstGraph, NonLocals, !Constraint, !GCInfo),
% Record the higher-order mode of this lambda goal.
HoModes0 = !.GCInfo ^ ho_modes,
get_prog_var_level(!.GCInfo ^ mc_info, LHSVar, LHSVarLevel),
multi_map.set(HoModes0, LHSVarLevel, Modes, HoModes),
!GCInfo ^ ho_modes := HoModes,
% Analyse the lambda goal.
update_mc_info(enter_lambda_goal(GoalId), !GCInfo),
% XXX Rather than adding `in' modes for lambda nonlocals we should just
% place a constraint `V_prod = 0' for all nodes reachable from these
% variables in the lambda goal.
ArgModes = list.duplicate(length(NonLocals), in_mode) ++ Modes,
LambdaHeadVars = NonLocals ++ LambdaVars,
ModuleInfo = !.GCInfo ^ module_info,
update_md_info(process_mode_decl(ModuleInfo,
InstGraph, LambdaHeadVars, false_var(initial),
true_var(initial), yes, false_var(final), true_var(final), no,
ArgModes, zero), DeclConstraint, !GCInfo),
!:Constraint = !.Constraint * DeclConstraint,
% XXX This will put constraints on variables that do not occur in
% the lambda goal. These constraints will be removed at the next
% restrict, but it would be more efficient not to put them in in the
% first place.
% DEBUGGING CODE
% size(!.Constraint, NumNodes3, Depth3, _),
% unsafe_perform_io(io.format(
% "Pre lambda Size: %d, Depth: %d\n",
% [i(NumNodes3), i(Depth3)])),
update_mc_info_t((pred(C::out, S0::in, S::out) is det :-
map.foldl2(input_output_constraints(LambdaHeadVars, InstGraph),
InstGraph, !.Constraint, C, S0, S)
), !:Constraint, !GCInfo),
% DEBUGGING CODE
% size(!.Constraint, NumNodes5, Depth5, _),
% unsafe_perform_io(io.format(
% "lambda io_constraints Size: %d, Depth: %d\n",
% [i(NumNodes5), i(Depth5)])),
goal_constraints(set.init, _CanSucceed, Goal0, Goal, !Constraint,
!GCInfo),
% DEBUGGING CODE
% size(Constraint, NumNodes, Depth),
% unsafe_perform_io(io.format(
% "post lambda Size: %d, Depth: %d\n",
% [i(NumNodes), i(Depth)])),
update_mc_info(leave_lambda_goal, !GCInfo),
RHS = RHS0 ^ rhs_lambda_goal := Goal
).
:- pred call_constraints(goal_id::in, pred_id::in,
list(prog_var)::in, list(prog_var)::in,
mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
call_constraints(GoalId, PredId, HeadVars, Args, !Constraint, !GCInfo) :-
InstGraph = !.GCInfo ^ inst_graph,
Generator =
(pred((V - W)::out) is nondet :-
corresponding_members(HeadVars, Args, X, Y),
inst_graph.same_graph_corresponding_nodes(InstGraph, X, Y, V, W)
),
Accumulator =
(pred((V - W)::in, C0::in, C::out, S0::in, S::out) is det :-
get_var_in_pred(PredId, V `at` whole_body_goal_id, V_, S0, S1),
get_var(W `at` GoalId, Wgi, S1, S2),
get_var_in_pred(PredId, in(V), Vin, S2, S3),
get_var(out(W), Wout, S3, S),
C = C0 ^ eq_vars(V_, Wgi) ^ imp_vars(Vin, Wout)
),
solutions.aggregate2(Generator, Accumulator, !Constraint, !GCInfo).
:- pred higher_order_call_constraints(
mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
higher_order_call_constraints(Constraint0, Constraint, !GCInfo) :-
HoModes = !.GCInfo ^ ho_modes,
HoCalls = !.GCInfo ^ ho_calls,
ModuleInfo = !.GCInfo ^ module_info,
InstGraph = !.GCInfo ^ inst_graph,
update_md_info(
(pred(Constraint1::out, in, out) is det -->
map.foldl2(
(pred(HoVarLevel::in, Calls::in, Cons0::in, Cons::out,
in, out) is det -->
update_mc_info(set_level_from_var(HoVarLevel)),
( { map.search(HoModes, HoVarLevel, ArgModesList) } ->
list.foldl2(
(pred((GoalId - Args)::in, C0::in, C::out,
in, out) is det -->
list.foldl2(
process_mode_decl(ModuleInfo, InstGraph,
Args, ignore, call_in(GoalId), no,
false_var(var_at_goal_id(GoalId)),
call_out(GoalId), no
), ArgModesList, zero, C1),
{ C = C0 * C1 } ),
Calls, Cons0, Cons)
;
{ Cons = Cons0 }
)
), HoCalls, Constraint0, Constraint1)),
Constraint, !GCInfo).
:- pred negation_constraints(goal_id::in, set(prog_var)::in,
mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
negation_constraints(GoalId, NonLocals, !Constraint, !GCInfo) :-
InstGraph = !.GCInfo ^ inst_graph,
inst_graph.foldl_reachable_from_list2(
(pred(V::in, C0::in, C::out, in, out) is det -->
get_var(V `at` GoalId, Vgp),
{ C = C0 ^ not_var(Vgp) }
), InstGraph, to_sorted_list(NonLocals),
!Constraint, !GCInfo).
:- pred generic_call_constrain_var(prog_var::in, goal_id::in,
mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
generic_call_constrain_var(Var, GoalId, !Constraint, !GCInfo) :-
InstGraph = !.GCInfo ^ inst_graph,
inst_graph.foldl_reachable2(
( pred(V::in, C0::in, C::out, in, out) is det -->
get_var(out(V), Vout),
get_var(V `at` GoalId, Vgp),
{ C = C0 ^ var(Vout) ^ not_var(Vgp) }
), InstGraph, Var, !Constraint, !GCInfo).
:- pred constrict_to_vars(list(prog_var)::in, set(prog_var)::in,
goal_id::in, mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
constrict_to_vars(NonLocals, GoalVars, GoalId, !Constraint, !GCInfo) :-
get_forward_goal_path_map(!.GCInfo ^ mc_info, ForwardGoalPathMap),
!:Constraint = restrict_filter(
keep_var(ForwardGoalPathMap, NonLocals, GoalVars, GoalId,
!.GCInfo ^ atomic_goals, !.GCInfo ^ inst_graph),
!.GCInfo ^ mc_info, !.Constraint).
:- pred keep_var(goal_forward_path_map::in, list(prog_var)::in,
set(prog_var)::in, goal_id::in, set(goal_id)::in, inst_graph::in,
rep_var::in) is semidet.
keep_var(ForwardGoalPathMap, NonLocals, GoalVars, GoalId, AtomicGoals,
InstGraph, RepVar) :-
(
RepVar = _V `at` RepGoalId,
set.member(RepGoalId, AtomicGoals)
;
(
( RepVar = in(V)
; RepVar = out(V)
; RepVar = V `at` _
),
set.member(V, GoalVars)
)
=>
(
list.member(NonLocal, NonLocals),
inst_graph.reachable(InstGraph, NonLocal, V),
\+ (
RepVar = _ `at` RepGoalId,
% XXX What higher level operation is being implemented here?
map.lookup(ForwardGoalPathMap, GoalId, GoalPath),
map.lookup(ForwardGoalPathMap, RepGoalId, RepGoalPath),
GoalPath = fgp(GoalPathSteps),
RepGoalPath = fgp(RepGoalPathSteps),
list.remove_suffix(RepGoalPathSteps, GoalPathSteps, [_ | _])
)
)
).
:- type sccs == list(list(pred_id)).
% Obtain the SCCs for the module.
%
:- pred get_predicate_sccs(module_info::in, module_info::out, sccs::out)
is det.
get_predicate_sccs(!ModuleInfo, SCCs) :-
module_info_get_valid_predids(PredIds, !ModuleInfo),
dependency_graph.build_pred_dependency_graph(!.ModuleInfo, PredIds,
do_not_include_imported, DepInfo),
hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs0),
% Remove predicates that have mode declarations and place them in
% their own ``SCC'' at the end of the list.
% Predicates with mode declarations do not need to be processed with
% the rest of their SCC since the mode declaration can be used in any
% calls to them. Such predicates should be processed last to take
% advantage of mode info inferred from other predicates.
extract_mode_decl_preds(!.ModuleInfo, SCCs0, [], SCCs1),
% We add imported preds to the end of the SCC list, one SCC per pred.
% This allows a constraint to be created for each imported pred
% based on its mode declarations.
add_imported_preds(!.ModuleInfo, SCCs1, SCCs).
:- pred extract_mode_decl_preds(module_info::in, sccs::in, sccs::in, sccs::out)
is det.
extract_mode_decl_preds(_ModuleInfo, [], !DeclaredPreds).
extract_mode_decl_preds(ModuleInfo, [SCC0 | SCCs0], !DeclaredPreds) :-
list.filter(pred_has_mode_decl(ModuleInfo), SCC0, Declared, SCC),
(
Declared = []
;
Declared = [_ | _],
list.foldl(
(pred(Pred::in, Preds0::in, Preds::out) is det :-
Preds = [[Pred] | Preds0]
), Declared, !DeclaredPreds)
),
extract_mode_decl_preds(ModuleInfo, SCCs0, !DeclaredPreds),
(
SCC = []
;
SCC = [_ | _],
!:DeclaredPreds = [SCC | !.DeclaredPreds]
).
:- pred pred_has_mode_decl(module_info::in, pred_id::in) is semidet.
pred_has_mode_decl(ModuleInfo, PredId) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
\+ pred_info_infer_modes(PredInfo).
:- pred add_imported_preds(module_info::in, sccs::in, sccs::out) is det.
add_imported_preds(ModuleInfo, SCCs0, SCCs) :-
module_info_get_valid_predids(PredIds, ModuleInfo, _ModuleInfo),
list.filter_map(
(pred(PredId::in, [PredId]::out) is semidet :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_is_imported(PredInfo)
), PredIds, ImportedPredIds),
SCCs = SCCs0 ++ ImportedPredIds.
:- pred cons_id_in_bound_insts(cons_id::in, list(bound_inst)::in,
list(mer_inst)::out) is semidet.
cons_id_in_bound_insts(ConsId, [bound_functor(ConsId0, Insts0) | BIs],
Insts) :-
( equivalent_cons_ids(ConsId0, ConsId) ->
Insts = Insts0
;
cons_id_in_bound_insts(ConsId, BIs, Insts)
).
%------------------------------------------------------------------------%
% For local variables, V_ must be equivalent to Vgp.
:- pred constrain_local_vars(set(prog_var)::in, goal_id::in,
mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
constrain_local_vars(Locals, GoalId, !Constraint, !GCInfo) :-
list.foldl2(do_constrain_local_vars(GoalId), to_sorted_list(Locals),
!Constraint, !GCInfo).
:- pred do_constrain_local_vars(goal_id::in, prog_var::in,
mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
do_constrain_local_vars(GoalId, Var, !Constraint, !GCInfo) :-
get_var(Var `at` GoalId, Vgp, !GCInfo),
get_var(out(Var), Vout, !GCInfo),
( using_simple_mode_constraints(!.GCInfo ^ g_mc_info) ->
% For simple_mode_constraints, local variables must all be bound
% within the goal.
!:Constraint = !.Constraint ^ var(Vgp) ^ var(Vout)
;
!:Constraint = !.Constraint ^ eq_vars(Vgp, Vout)
).
:- pred constrain_non_occurring_vars(can_succeed::in, set(prog_var)::in,
set(prog_var)::in, goal_id::in,
mode_constraint::in, mode_constraint::out,
goal_constraints_info::in, goal_constraints_info::out) is det.
constrain_non_occurring_vars(no, _, _, _, !Constraint, !GCInfo).
constrain_non_occurring_vars(yes, ParentNonLocals, OccurringVars, GoalId,
!Constraint, !GCInfo) :-
InstGraph = !.GCInfo ^ inst_graph,
Generator =
(pred(V::out) is nondet :-
set.member(U, ParentNonLocals),
inst_graph.reachable(InstGraph, U, V),
\+ set.member(V, OccurringVars)
),
Accumulator =
(pred(V::in, Vs0::in, Vs::out, in, out) is det -->
get_var(V `at` GoalId, VGP),
{ Vs = Vs0 `insert` VGP }
),
solutions.aggregate2(Generator, Accumulator, empty_vars_set,
NonOccurringVars, !GCInfo),
!:Constraint = !.Constraint ^ conj_not_vars(NonOccurringVars).
% aggregate2((pred(V::out) is nondet :-
% set.member(U, ParentNonLocals),
% inst_graph.reachable(InstGraph, U, V),
% \+ set.member(V, OccurringVars)
% ), (pred(V::in, C0::in, C::out, in, out) is det -->
% get_var(V `at` GoalId, VGP),
% { C = C0 ^ not_var(VGP) }
% ), Constraint0, Constraint).
%------------------------------------------------------------------------%
:- pred share_ho_modes(prog_var::in, prog_var::in, ho_modes::in, ho_modes::out,
mode_constraint_info::in, mode_constraint_info::out) is det.
share_ho_modes(VarA, VarB, HoModes0, HoModes, !MCI) :-
get_prog_var_level(!.MCI, VarA, A),
get_prog_var_level(!.MCI, VarB, B),
( map.search(HoModes0, A, AModes) ->
( map.search(HoModes0, B, BModes) ->
Modes = list.sort_and_remove_dups(AModes ++ BModes),
map.det_update(HoModes0, A, Modes, HoModes1),
map.det_update(HoModes1, B, Modes, HoModes)
;
map.det_insert(HoModes0, B, AModes, HoModes)
)
; map.search(HoModes0, B, BModes) ->
map.det_insert(HoModes0, A, BModes, HoModes)
;
HoModes = HoModes0
).
%------------------------------------------------------------------------%
%------------------------------------------------------------------------%
:- pred arg_modes_map(list(prog_var)::in, inst_graph::in, mode_constraint::in,
mode_constraint_info::in, arg_modes_map::out) is nondet.
arg_modes_map(HeadVars, InstGraph, Constraint0, Info0, ArgModes) :-
solutions.solutions(inst_graph.reachable_from_list(InstGraph, HeadVars),
Vars),
list.map_foldl((pred(PV::in, (MV - in(PV))::out, in, out) is det -->
mode_constraint_var(in(PV), MV)), Vars, InVars, Info0, Info1),
list.map_foldl((pred(PV::in, (MV - out(PV))::out, in, out) is det -->
mode_constraint_var(out(PV), MV)), Vars, OutVars, Info0, Info1),
MVars = list.sort_and_remove_dups(InVars ++ OutVars),
MVarKeys = assoc_list.keys(MVars),
Constraint = restrict_filter(
(pred(V::in) is semidet :- list.member(V, MVarKeys)),
ensure_normalised(Constraint0)),
ArgModes0 = map.init - map.init,
list.foldl2(arg_modes_map_2, MVars, Constraint, _,
ArgModes0, ArgModes).
:- pred arg_modes_map_2(pair(mode_constraint_var, rep_var)::in,
mode_constraint::in, mode_constraint::out,
arg_modes_map::in, arg_modes_map::out) is nondet.
arg_modes_map_2(MV - RV, Constraint0, Constraint, ArgModes0, ArgModes) :-
(
Constraint = var_restrict_true(MV, Constraint0),
Bool = yes
;
Constraint = var_restrict_false(MV, Constraint0),
Bool = no
),
Constraint \= zero,
ArgModes0 = InModes0 - OutModes0,
(
RV = in(PV),
ArgModes = map.det_insert(InModes0, PV, Bool) - OutModes0
;
RV = out(PV),
ArgModes = InModes0 - map.det_insert(OutModes0, PV, Bool)
).
% :- type labelling == map(mode_constraint_var, bool).
%
% :- pred labelling(set(mode_constraint_var)::in, mode_constraint::in,
% labelling::out) is nondet.
%
% labelling(Vs, Constraint, Map) :-
% labelling(Vs, Constraint, TrueVars, FalseVars),
% Map = true_false_sets_to_labelling_map(TrueVars, FalseVars).
%
% % Return a ``fundamental mode'' (i.e. non-implied mode) for the given
% % mode constraint. This is calculated by computing a minimal model for
% % the initial insts of the head variables of the predicate.
% :- pred fundamental_mode(set(mode_constraint_var)::in, mode_constraint::in,
% mode_constraint::out) is nondet.
%
% fundamental_mode(Vs, Constraint0, Constraint) :-
% minimal_model(Vs, Constraint0, TrueVars, FalseVars),
%
% % XXX There's probably a more efficient way to do this.
% Constraint = Constraint0 * conj_vars(TrueVars) *
% (~disj_vars(FalseVars)).
%
% :- func true_false_sets_to_labelling_map(set(mode_constraint_var),
% set(mode_constraint_var)) = labelling.
%
% true_false_sets_to_labelling_map(TrueVars, FalseVars) =
% list.foldl(func(V, M) = map.det_insert(M, V, no),
% set.to_sorted_list(FalseVars),
% list.foldl(func(V, M) = map.det_insert(M, V, yes),
% set.to_sorted_list(TrueVars), map.init)).
%
% % implied_mode(L0, L1) is true iff mode L0 is implied by mode L1.
% :- pred implied_mode(labelling::in, labelling::in) is semidet.
%
% implied_mode(L0, L1) :-
% all [V] ( map.member(L1, V, yes) => map.lookup(L0, V, yes) ).
%
% :- pred split_constraint_into_modes(pred_id::in, list(prog_var)::in,
% inst_graph::in, mode_constraint::in, list(labelling)::out,
% mode_constraint_info::in, mode_constraint_info::out) is det.
%
% split_constraint_into_modes(PredId, HeadVars, InstGraph, ModeConstraint0,
% Labellings) -->
% { solutions(inst_graph.reachable_from_list(InstGraph, HeadVars),
% ReachVars) },
% list.map_foldl((pred(PV::in, MV::out, in, out) is det -->
% mode_constraint_var(in(PV), MV)
% ), ReachVars, InVars),
%
% get_interesting_vars_for_pred(PredId, InterestingVars),
% { solutions((pred(Labelling::out) is nondet :-
% fundamental_mode(set.list_to_set(InVars), ModeConstraint0,
% ModeConstraint1),
% labelling(InterestingVars, ModeConstraint1, Labelling)
% ), Labellings) }.
%------------------------------------------------------------------------%
%------------------------------------------------------------------------%
:- func get_goal_id(hlds_goal) = goal_id.
get_goal_id(hlds_goal(_, GoalInfo)) =
goal_info_get_goal_id(GoalInfo).
:- func vars(hlds_goal) = set(prog_var).
vars(hlds_goal(_, GoalInfo)) = OccurringVars :-
goal_info_get_occurring_vars(GoalInfo, OccurringVars).
%------------------------------------------------------------------------%
% A predicate can succeed if at least one of its procedures
% can succeed.
%
:- pred pred_can_succeed(pred_info::in) is semidet.
pred_can_succeed(PredInfo) :-
pred_info_get_procedures(PredInfo, ProcTable),
some [ProcInfo] (
map.member(ProcTable, _ProcId, ProcInfo),
proc_can_succeed(ProcInfo)
).
% A procedure can possibly succeed if it has no declared determinism or
% it has a declared determinism that allows more than zero solutions.
% (This is a conservative approximation since we can't use the results
% of determinism inference -- it hasn't been run yet.)
%
:- pred proc_can_succeed(proc_info::in) is semidet.
proc_can_succeed(ProcInfo) :-
proc_info_get_declared_determinism(ProcInfo, MaybeDet),
(
MaybeDet = no
;
MaybeDet = yes(Detism),
determinism_components(Detism, _, SolnCount),
SolnCount \= at_most_zero
).
%------------------------------------------------------------------------%
% DEBUGGING CODE
%
% :- impure pred conj_to_dot(mode_constraint::in, prog_varset::in,
% mode_constraint_info::in, io::di, io::uo) is det.
%
% conj_to_dot(MC, VS, CI) -->
% robdd_to_dot(MC, VS, CI, string.format("conj%d.dot", [i(conjnum)])).
%
% :- impure func conjnum = int.
%
% :- pragma foreign_code("C",
% "
% static MR_Integer conjnum = 0;
% ").
%
% :- pragma foreign_proc("C",
% conjnum = (N::out),
% [will_not_call_mercury],
% "
% N = conjnum++;
% ").
%------------------------------------------------------------------------%
:- func this_file = string.
this_file = "mode_constraints.m".
%------------------------------------------------------------------------%
:- end_module mode_constraints.
%------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink