mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
ee1aca8331
compiler/state_var.m:
Move an import to the implementation section.
compiler/mode_constraints.m:
compiler/mode_ordering.m:
compiler/stm_expand.m:
Avoid warnings about final statevars being unused.
compiler/Mercury.options:
Stop switching off the warnings this diff avoids, not just for the
above three modules, but also for two others, one of which
(parse_module.m) apparently had the warnings a while ago,
while the second (prog_event.m) never got them in the first place.
compiler/prog_event.m:
Remove an ambiguity.
810 lines
32 KiB
Mathematica
810 lines
32 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2001-2012 The University of Melbourne.
|
|
% Copyright (C) 2014-2015, 2017-2025 The Mercury team.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
%
|
|
% File: mode_ordering.m.
|
|
% Main author: dmo.
|
|
%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module check_hlds.mode_ordering.
|
|
:- interface.
|
|
|
|
:- import_module check_hlds.mode_constraint_robdd.
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.set_of_var.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
|
|
:- type pred_constraint_info
|
|
---> pci(
|
|
pci_mode_constraint :: mode_constraint,
|
|
pci_mci :: mode_constraint_info
|
|
).
|
|
|
|
:- type pred_constraint_map == map(pred_id, pred_constraint_info).
|
|
|
|
% Given a top-down list of predicate SCCs, attempt to schedule goals
|
|
% for mode of each predicate, and determine which modes are needed
|
|
% for each predicate.
|
|
%
|
|
:- pred mode_ordering(pred_constraint_map::in, list(list(pred_id))::in,
|
|
module_info::in, module_info::out, io::di, io::uo) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred goal_info_get_occurring_vars(hlds_goal_info::in, set_of_progvar::out)
|
|
is det.
|
|
:- pred goal_info_get_producing_vars(hlds_goal_info::in, set_of_progvar::out)
|
|
is det.
|
|
:- pred goal_info_get_consuming_vars(hlds_goal_info::in, set_of_progvar::out)
|
|
is det.
|
|
:- pred goal_info_get_make_visible_vars(hlds_goal_info::in,
|
|
set_of_progvar::out) is det.
|
|
:- pred goal_info_get_need_visible_vars(hlds_goal_info::in,
|
|
set_of_progvar::out) is det.
|
|
|
|
:- pred goal_info_set_occurring_vars(set_of_progvar::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.clause_to_proc.
|
|
:- import_module hlds.hlds_proc_util.
|
|
:- import_module hlds.inst_graph.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.goal_path.
|
|
:- import_module mode_robdd.
|
|
:- import_module mode_robdd.tfeirn.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module digraph.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module solutions.
|
|
:- import_module stack.
|
|
|
|
mode_ordering(PredConstraintMap, SCCs, !ModuleInfo, !IO) :-
|
|
list.foldl(mode_ordering_scc(PredConstraintMap), SCCs, !ModuleInfo),
|
|
report_ordering_mode_errors(!.ModuleInfo, !IO).
|
|
|
|
:- pred mode_ordering_scc(pred_constraint_map::in, list(pred_id)::in,
|
|
module_info::in, module_info::out) is det.
|
|
|
|
mode_ordering_scc(PredConstraintMap, SCC, !ModuleInfo) :-
|
|
% XXX This call to copy_clauses_to_procs_for_preds_in_module_info
|
|
% should *not* be necessary.
|
|
copy_clauses_to_nonmethod_procs_for_preds_in_module_info(SCC, !ModuleInfo),
|
|
list.foldl(mode_ordering_pred(PredConstraintMap, SCC), SCC, !ModuleInfo).
|
|
|
|
:- pred mode_ordering_pred(pred_constraint_map::in, list(pred_id)::in,
|
|
pred_id::in, module_info::in, module_info::out) is det.
|
|
|
|
mode_ordering_pred(PredConstraintMap, _SCC, PredId, !ModuleInfo) :-
|
|
% XXX Mode inference NYI.
|
|
RequestedProcsMap0 = map.init,
|
|
|
|
module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
|
|
lookup_pred_constraint(PredConstraintMap, PredId, ModeConstraint0, MCI),
|
|
( if pred_info_infer_modes(PredInfo0) then
|
|
( if map.search(RequestedProcsMap0, PredId, RequestedProcs) then
|
|
list.foldl(
|
|
mode_ordering_infer_proc(!.ModuleInfo, PredConstraintMap,
|
|
PredId, MCI, ModeConstraint0),
|
|
RequestedProcs, PredInfo0, PredInfo)
|
|
else
|
|
% XXX Maybe we should remove the predicate from the
|
|
% module_info here since it is not used.
|
|
PredInfo = PredInfo0
|
|
)
|
|
else
|
|
ProcIds = pred_info_all_non_imported_procids(PredInfo0),
|
|
list.foldl(
|
|
mode_ordering_check_proc(!.ModuleInfo, PredConstraintMap,
|
|
PredId, MCI, ModeConstraint0),
|
|
ProcIds, PredInfo0, PredInfo)
|
|
),
|
|
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
|
|
|
|
:- pred mode_ordering_infer_proc(module_info::in, pred_constraint_map::in,
|
|
pred_id::in, mode_constraint_info::in,
|
|
mode_constraint::in, mode_constraint::in,
|
|
pred_info::in, pred_info::out) is det.
|
|
|
|
mode_ordering_infer_proc(ModuleInfo, PredConstraintMap, PredId, MCI,
|
|
Constraint0, ModeDeclConstraint, !PredInfo) :-
|
|
pred_info_create_proc_info_for_mode_decl_constraint(ModeDeclConstraint,
|
|
ProcId, !PredInfo),
|
|
mode_ordering_check_proc(ModuleInfo, PredConstraintMap, PredId, MCI,
|
|
Constraint0, ProcId, !PredInfo).
|
|
|
|
:- pred mode_ordering_check_proc(module_info::in, pred_constraint_map::in,
|
|
pred_id::in, mode_constraint_info::in, mode_constraint::in, proc_id::in,
|
|
pred_info::in, pred_info::out) is det.
|
|
|
|
mode_ordering_check_proc(ModuleInfo, PredConstraintMap, PredId, MCI,
|
|
Constraint0, ProcId, !PredInfo) :-
|
|
pred_info_proc_info(!.PredInfo, ProcId, ProcInfo0),
|
|
proc_info_head_modes_constraint(ProcInfo0, ModeDeclConstraint),
|
|
Constraint = Constraint0 * ModeDeclConstraint,
|
|
pred_info_get_inst_graph_info(!.PredInfo, InstGraphInfo),
|
|
InstGraph = InstGraphInfo ^ implementation_inst_graph,
|
|
mode_ordering_proc(ModuleInfo, PredConstraintMap, PredId, MCI, InstGraph,
|
|
Constraint, ProcInfo0, ProcInfo),
|
|
pred_info_set_proc_info(ProcId, ProcInfo, !PredInfo).
|
|
|
|
% Perform mode ordering for a procedure. The ModeConstraint must be
|
|
% constrained to contain just the mode information for this procedure.
|
|
%
|
|
:- pred mode_ordering_proc(module_info::in, pred_constraint_map::in,
|
|
pred_id::in, mode_constraint_info::in, inst_graph::in,
|
|
mode_constraint::in, proc_info::in, proc_info::out) is det.
|
|
|
|
mode_ordering_proc(ModuleInfo, PredConstraintMap, PredId, MCI, InstGraph,
|
|
ModeConstraint, !ProcInfo) :-
|
|
ProdVarsMap = atomic_prodvars_map(ModeConstraint, MCI),
|
|
LambdaNesting0 = stack.init,
|
|
get_forward_goal_path_map_for_pred(MCI, PredId, ForwardGoalPathMap),
|
|
MOI0 = mode_ordering_info(InstGraph, ProdVarsMap, LambdaNesting0,
|
|
ModuleInfo, PredConstraintMap, ForwardGoalPathMap),
|
|
|
|
proc_info_get_goal(!.ProcInfo, Goal0),
|
|
mode_order_goal(Goal0, Goal, MOI0, _MOI),
|
|
proc_info_set_goal(Goal, !ProcInfo).
|
|
|
|
:- type mode_ordering_info
|
|
---> mode_ordering_info(
|
|
moi_inst_graph :: inst_graph,
|
|
moi_prodvars_map :: prodvars_map,
|
|
moi_lambda_nesting :: lambda_path,
|
|
moi_module_info :: module_info,
|
|
moi_pred_constraint_map :: pred_constraint_map,
|
|
moi_goal_path_map :: goal_forward_path_map
|
|
).
|
|
|
|
:- pred enter_lambda_goal(goal_id::in,
|
|
mode_ordering_info::in, mode_ordering_info::out) is det.
|
|
|
|
enter_lambda_goal(GoalId, !MOI) :-
|
|
LambdaNesting0 = !.MOI ^ moi_lambda_nesting,
|
|
!MOI ^ moi_lambda_nesting := stack.push(LambdaNesting0, GoalId).
|
|
|
|
:- pred leave_lambda_goal(mode_ordering_info::in, mode_ordering_info::out)
|
|
is det.
|
|
|
|
leave_lambda_goal(!MOI) :-
|
|
LambdaNesting0 = !.MOI ^ moi_lambda_nesting,
|
|
stack.det_pop(_, LambdaNesting0, LambdaNesting),
|
|
!MOI ^ moi_lambda_nesting := LambdaNesting.
|
|
|
|
:- pred mode_order_goal(hlds_goal::in, hlds_goal::out,
|
|
mode_ordering_info::in, mode_ordering_info::out) is det.
|
|
|
|
mode_order_goal(Goal0, Goal, !MOI) :-
|
|
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
|
|
mode_order_goal_2(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !MOI),
|
|
Goal = hlds_goal(GoalExpr, GoalInfo).
|
|
|
|
:- pred mode_order_goal_2(hlds_goal_expr::in, hlds_goal_expr::out,
|
|
hlds_goal_info::in, hlds_goal_info::out,
|
|
mode_ordering_info::in, mode_ordering_info::out) is det.
|
|
|
|
mode_order_goal_2(GoalExpr0, GoalExpr, !GoalInfo, !MOI) :-
|
|
(
|
|
GoalExpr0 = conj(ConjType, Goals0),
|
|
(
|
|
ConjType = plain_conj,
|
|
list.map_foldl(mode_order_goal, Goals0, Goals1, !MOI),
|
|
ForwardGoalPathMap = !.MOI ^ moi_goal_path_map,
|
|
mode_order_conj(ForwardGoalPathMap, Goals1, Goals),
|
|
union_mode_vars_sets(Goals, !GoalInfo),
|
|
|
|
goal_info_get_consuming_vars(!.GoalInfo, ConsumingVars0),
|
|
goal_info_get_producing_vars(!.GoalInfo, ProducingVars0),
|
|
set_of_var.difference(ConsumingVars0, ProducingVars0,
|
|
ConsumingVars),
|
|
goal_info_set_consuming_vars(ConsumingVars, !GoalInfo),
|
|
|
|
goal_info_get_need_visible_vars(!.GoalInfo, NeedVars0),
|
|
goal_info_get_make_visible_vars(!.GoalInfo, MakeVars0),
|
|
set_of_var.difference(NeedVars0, MakeVars0, NeedVars),
|
|
goal_info_set_need_visible_vars(NeedVars, !GoalInfo)
|
|
;
|
|
ConjType = parallel_conj,
|
|
list.map_foldl(mode_order_goal, Goals0, Goals, !MOI),
|
|
union_mode_vars_sets(Goals, !GoalInfo)
|
|
),
|
|
GoalExpr = conj(ConjType, Goals)
|
|
;
|
|
GoalExpr0 = plain_call(PredId, _, Args, _, _, _),
|
|
set_atomic_prod_vars(!.MOI, ProducingVars, !GoalInfo),
|
|
find_matching_proc(!.MOI, PredId, Args, ProducingVars,
|
|
ProcId, ConsumingVars),
|
|
ArgsSet = set_of_var.list_to_set(Args),
|
|
set_of_var.intersect(ArgsSet, ProducingVars, MakeVisibleVars),
|
|
set_of_var.intersect(ArgsSet, ConsumingVars, NeedVisibleVars),
|
|
goal_info_set_consuming_vars(ConsumingVars, !GoalInfo),
|
|
goal_info_set_make_visible_vars(MakeVisibleVars, !GoalInfo),
|
|
goal_info_set_need_visible_vars(NeedVisibleVars, !GoalInfo),
|
|
GoalExpr = GoalExpr0 ^ call_proc_id := ProcId
|
|
;
|
|
GoalExpr0 = generic_call(_GenericCall0, _Args, _Modes0, _, _Det),
|
|
unexpected($pred, "generic_call NYI")
|
|
;
|
|
GoalExpr0 = switch(_Var, _CanFail0, _Cases0),
|
|
unexpected($pred, "switch")
|
|
;
|
|
GoalExpr0 = unify(VarA, RHS0, UnifyMode, Unification0, Context),
|
|
set_atomic_prod_vars(!.MOI, ProdVars, !GoalInfo),
|
|
InstGraph = !.MOI ^ moi_inst_graph,
|
|
(
|
|
RHS0 = rhs_var(VarB),
|
|
RHS = RHS0,
|
|
( if set_of_var.contains(ProdVars, VarA) then
|
|
Unification = assign(VarA, VarB),
|
|
set_of_var.make_singleton(VarA, MakeVisibleVars),
|
|
set_of_var.make_singleton(VarB, NeedVisibleVars)
|
|
else if set_of_var.contains(ProdVars, VarB) then
|
|
Unification = assign(VarB, VarA),
|
|
set_of_var.make_singleton(VarA, MakeVisibleVars),
|
|
set_of_var.make_singleton(VarB, NeedVisibleVars)
|
|
else
|
|
Unification = simple_test(VarA, VarB),
|
|
% XXX may be complicated unify -- need to check.
|
|
set_of_var.init(MakeVisibleVars),
|
|
set_of_var.list_to_set([VarA, VarB], NeedVisibleVars)
|
|
),
|
|
solutions.solutions(
|
|
( pred(Var::out) is nondet :-
|
|
inst_graph.same_graph_corresponding_nodes(InstGraph,
|
|
VarA, VarB, VarC, VarD),
|
|
( if set_of_var.contains(ProdVars, VarC) then
|
|
Var = VarD
|
|
else if set_of_var.contains(ProdVars, VarD) then
|
|
Var = VarC
|
|
else
|
|
fail
|
|
)
|
|
),
|
|
ConsumingVarsList
|
|
),
|
|
set_of_var.sorted_list_to_set(ConsumingVarsList, ConsumingVars)
|
|
;
|
|
RHS0 = rhs_functor(_ConsId, _IsExistConstruct, ArgVars),
|
|
RHS = RHS0,
|
|
( if set_of_var.contains(ProdVars, VarA) then
|
|
% Unification = construct(VarA, ConsId, ArgVars,
|
|
% _UniModes, _HowTo, _CellUniq, _MaybeRLExprId),
|
|
Unification = Unification0, % XXX
|
|
set_of_var.init(ConsumingVars),
|
|
set_of_var.list_to_set([VarA | ArgVars], MakeVisibleVars),
|
|
set_of_var.init(NeedVisibleVars)
|
|
else
|
|
% Unification = deconstruct(VarA, ConsId, ArgVars,
|
|
% _UniModes, _CanFail, _CanCGC),
|
|
Unification = Unification0, % XXX
|
|
set_of_var.make_singleton(VarA, ConsumingVars),
|
|
set_of_var.list_to_set(ArgVars, MakeVisibleVars),
|
|
set_of_var.make_singleton(VarA, NeedVisibleVars)
|
|
)
|
|
;
|
|
% Unification = construct(VarA, _ConsId, _ArgVars,
|
|
% _UniModes, _HowTo, _CellUniq, _MaybeRLExprId),
|
|
Unification = Unification0, % XXX
|
|
RHS0 = rhs_lambda_goal(A, B, C, NonLocals, ArgVarsModes0,
|
|
F, SubGoal0),
|
|
ArgVarsModes = ArgVarsModes0, % XXX
|
|
RHS = rhs_lambda_goal(A, B, C, NonLocals, ArgVarsModes,
|
|
F, SubGoal),
|
|
|
|
GoalId = goal_info_get_goal_id(!.GoalInfo),
|
|
enter_lambda_goal(GoalId, !MOI),
|
|
mode_order_goal(SubGoal0, SubGoal, !MOI),
|
|
leave_lambda_goal(!MOI),
|
|
|
|
solutions.solutions(
|
|
inst_graph.reachable_from_list(InstGraph, NonLocals),
|
|
ConsumingVarsList),
|
|
set_of_var.sorted_list_to_set(ConsumingVarsList, ConsumingVars),
|
|
set_of_var.make_singleton(VarA, MakeVisibleVars),
|
|
set_of_var.list_to_set(NonLocals, NeedVisibleVars)
|
|
),
|
|
goal_info_set_consuming_vars(ConsumingVars, !GoalInfo),
|
|
goal_info_set_make_visible_vars(MakeVisibleVars, !GoalInfo),
|
|
goal_info_set_need_visible_vars(NeedVisibleVars, !GoalInfo),
|
|
|
|
GoalExpr = unify(VarA, RHS, UnifyMode, Unification, Context)
|
|
;
|
|
GoalExpr0 = disj(Goals0),
|
|
list.map_foldl(mode_order_goal, Goals0, Goals, !MOI),
|
|
mode_order_disj(Goals, !GoalInfo),
|
|
GoalExpr = disj(Goals)
|
|
;
|
|
GoalExpr0 = negation(SubGoal0),
|
|
mode_order_goal(SubGoal0, SubGoal, !MOI),
|
|
goal_info_copy_mode_var_sets(SubGoal ^ hg_info, !GoalInfo),
|
|
GoalExpr = negation(SubGoal)
|
|
;
|
|
% XXX We should special-case the handling of from_ground_term_construct
|
|
% scopes.
|
|
GoalExpr0 = scope(Reason, SubGoal0),
|
|
mode_order_goal(SubGoal0, SubGoal, !MOI),
|
|
goal_info_copy_mode_var_sets(SubGoal ^ hg_info, !GoalInfo),
|
|
GoalExpr = scope(Reason, SubGoal)
|
|
;
|
|
GoalExpr0 = if_then_else(Locals, Cond0, Then0, Else0),
|
|
mode_order_goal(Cond0, Cond, !MOI),
|
|
mode_order_goal(Then0, Then, !MOI),
|
|
mode_order_goal(Else0, Else, !MOI),
|
|
% XXX Ned to make sure that Cond can be scheduled before Then and Else.
|
|
|
|
union_mode_vars_sets([Cond, Then], !GoalInfo),
|
|
|
|
goal_info_get_consuming_vars(!.GoalInfo, ConsumingVars0),
|
|
goal_info_get_producing_vars(!.GoalInfo, ProducingVars0),
|
|
set_of_var.difference(ConsumingVars0, ProducingVars0, ConsumingVars),
|
|
goal_info_set_consuming_vars(ConsumingVars, !GoalInfo),
|
|
|
|
goal_info_get_need_visible_vars(!.GoalInfo, NeedVars0),
|
|
goal_info_get_make_visible_vars(!.GoalInfo, MakeVars0),
|
|
set_of_var.difference(NeedVars0, MakeVars0, NeedVars),
|
|
goal_info_set_need_visible_vars(NeedVars, !GoalInfo),
|
|
|
|
combine_mode_vars_sets(Else ^ hg_info, !GoalInfo),
|
|
GoalExpr = if_then_else(Locals, Cond, Then, Else)
|
|
;
|
|
GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _),
|
|
unexpected($pred, "pragma_foreign_code NYI")
|
|
;
|
|
GoalExpr0 = shorthand(_),
|
|
unexpected($pred, "shorthand")
|
|
).
|
|
% mode_order_goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
|
|
% Goal0 = atomic_goal(GoalType, Outer, Inner, Vars, MainGoal0,
|
|
% OrElseGoals0),
|
|
% mode_order_goal(MainGoal0, MainGoal, !MOI),
|
|
% list.map_foldl(mode_order_goal, OrElseGoals0, OrElseGoals, !MOI),
|
|
% mode_order_disj(OrElseGoals, !GoalInfo),
|
|
% Goal = atomic_goal(GoalType, Outer, Inner, Vars, MainGoal, OrElseGoals).
|
|
|
|
:- pred mode_order_disj(list(hlds_goal)::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
|
|
mode_order_disj([], !GoalInfo).
|
|
mode_order_disj([hlds_goal(_, GI) | Goals], !GoalInfo) :-
|
|
goal_info_copy_mode_var_sets(GI, !GoalInfo),
|
|
list.foldl(mode_order_disj_2, Goals, !GoalInfo).
|
|
|
|
:- pred mode_order_disj_2(hlds_goal::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
|
|
mode_order_disj_2(hlds_goal(_, GI), !GoalInfo) :-
|
|
combine_mode_vars_sets(GI, !GoalInfo).
|
|
|
|
:- pred combine_mode_vars_sets(hlds_goal_info::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
|
|
combine_mode_vars_sets(GI, !GoalInfo) :-
|
|
goal_info_get_producing_vars(!.GoalInfo, ProducingVars0),
|
|
goal_info_get_consuming_vars(!.GoalInfo, ConsumingVars0),
|
|
goal_info_get_make_visible_vars(!.GoalInfo, MakeVisibleVars0),
|
|
goal_info_get_need_visible_vars(!.GoalInfo, NeedVisibleVars0),
|
|
|
|
goal_info_get_producing_vars(GI, GI_ProducingVars0),
|
|
goal_info_get_consuming_vars(GI, GI_ConsumingVars0),
|
|
goal_info_get_make_visible_vars(GI, GI_MakeVisibleVars0),
|
|
goal_info_get_need_visible_vars(GI, GI_NeedVisibleVars0),
|
|
|
|
set_of_var.intersect(ProducingVars0, GI_ProducingVars0, ProducingVars),
|
|
set_of_var.union(ConsumingVars0, GI_ConsumingVars0, ConsumingVars),
|
|
set_of_var.intersect(MakeVisibleVars0, GI_MakeVisibleVars0,
|
|
MakeVisibleVars),
|
|
set_of_var.union(NeedVisibleVars0, GI_NeedVisibleVars0, NeedVisibleVars),
|
|
|
|
goal_info_set_producing_vars(ProducingVars, !GoalInfo),
|
|
goal_info_set_consuming_vars(ConsumingVars, !GoalInfo),
|
|
goal_info_set_make_visible_vars(MakeVisibleVars, !GoalInfo),
|
|
goal_info_set_need_visible_vars(NeedVisibleVars, !GoalInfo).
|
|
|
|
:- pred union_mode_vars_sets(list(hlds_goal)::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
|
|
union_mode_vars_sets(Goals, !GoalInfo) :-
|
|
list.foldl(union_mode_vars_set, Goals, !GoalInfo).
|
|
|
|
:- pred union_mode_vars_set(hlds_goal::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
|
|
union_mode_vars_set(Goal, !GoalInfo) :-
|
|
Goal = hlds_goal(_, GI),
|
|
|
|
goal_info_get_producing_vars(!.GoalInfo, ProducingVars0),
|
|
goal_info_get_consuming_vars(!.GoalInfo, ConsumingVars0),
|
|
goal_info_get_make_visible_vars(!.GoalInfo, MakeVisibleVars0),
|
|
goal_info_get_need_visible_vars(!.GoalInfo, NeedVisibleVars0),
|
|
|
|
goal_info_get_producing_vars(GI, GI_ProducingVars0),
|
|
goal_info_get_consuming_vars(GI, GI_ConsumingVars0),
|
|
goal_info_get_make_visible_vars(GI, GI_MakeVisibleVars0),
|
|
goal_info_get_need_visible_vars(GI, GI_NeedVisibleVars0),
|
|
|
|
set_of_var.union(ProducingVars0, GI_ProducingVars0, ProducingVars),
|
|
set_of_var.union(ConsumingVars0, GI_ConsumingVars0, ConsumingVars),
|
|
set_of_var.union(MakeVisibleVars0, GI_MakeVisibleVars0, MakeVisibleVars),
|
|
set_of_var.union(NeedVisibleVars0, GI_NeedVisibleVars0, NeedVisibleVars),
|
|
|
|
goal_info_set_producing_vars(ProducingVars, !GoalInfo),
|
|
goal_info_set_consuming_vars(ConsumingVars, !GoalInfo),
|
|
goal_info_set_make_visible_vars(MakeVisibleVars, !GoalInfo),
|
|
goal_info_set_need_visible_vars(NeedVisibleVars, !GoalInfo).
|
|
|
|
:- pred goal_info_copy_mode_var_sets(hlds_goal_info::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
|
|
goal_info_copy_mode_var_sets(GI, !GoalInfo) :-
|
|
goal_info_get_producing_vars(GI, GI_ProducingVars),
|
|
goal_info_get_consuming_vars(GI, GI_ConsumingVars),
|
|
goal_info_get_make_visible_vars(GI, GI_MakeVisibleVars),
|
|
goal_info_get_need_visible_vars(GI, GI_NeedVisibleVars),
|
|
|
|
goal_info_set_producing_vars(GI_ProducingVars, !GoalInfo),
|
|
goal_info_set_consuming_vars(GI_ConsumingVars, !GoalInfo),
|
|
goal_info_set_make_visible_vars(GI_MakeVisibleVars, !GoalInfo),
|
|
goal_info_set_need_visible_vars(GI_NeedVisibleVars, !GoalInfo).
|
|
|
|
:- pred mode_order_conj(goal_forward_path_map::in,
|
|
list(hlds_goal)::in, list(hlds_goal)::out) is det.
|
|
|
|
mode_order_conj(ForwardGoalPathMap, Goals0, Goals) :-
|
|
list.foldl(
|
|
( pred(G::in, GM0::in, GM::out) is det :-
|
|
G = hlds_goal(_, GI),
|
|
GoalId = goal_info_get_goal_id(GI),
|
|
map.lookup(ForwardGoalPathMap, GoalId, GoalPath),
|
|
( if
|
|
goal_path_get_last(GoalPath, LastStep),
|
|
LastStep = step_conj(Index0)
|
|
then
|
|
Index = Index0
|
|
else
|
|
unexpected($pred, "goal_path error")
|
|
),
|
|
map.det_insert(Index, G, GM0, GM)
|
|
), Goals0, map.init, GoalMap),
|
|
|
|
map.foldl(
|
|
( pred(I::in, G::in, PM0::in, PM::out) is det :-
|
|
goal_info_get_producing_vars(G ^ hg_info, ProducingVars),
|
|
list.foldl(
|
|
( pred(V::in, PM1::in, PM2::out) is det :-
|
|
map.det_insert(V, I, PM1, PM2)
|
|
),
|
|
set_of_var.to_sorted_list(ProducingVars), PM0, PM)
|
|
), GoalMap, map.init, ProdMap),
|
|
|
|
map.foldl(
|
|
( pred(I::in, G::in, MVM0::in, MVM::out) is det :-
|
|
% XXX disjunction required!
|
|
goal_info_get_make_visible_vars(G ^ hg_info, MakeVisVars),
|
|
list.foldl(
|
|
( pred(V::in, MVM1::in, MVM2::out) is det :-
|
|
map.set(V, I, MVM1, MVM2)
|
|
),
|
|
set_of_var.to_sorted_list(MakeVisVars), MVM0, MVM)
|
|
), GoalMap, map.init, MakeVisMap),
|
|
|
|
map.foldl(
|
|
( pred(I::in, G::in, !.R::in, !:R::out) is det :-
|
|
GI = G ^ hg_info,
|
|
digraph.add_vertex(I, Key0, !R),
|
|
goal_info_get_consuming_vars(GI, ConsumingVars),
|
|
goal_info_get_need_visible_vars(GI, NeedVisVars),
|
|
list.foldl(
|
|
( pred(V::in, !.R1::in, !:R1::out) is det :-
|
|
( if map.search(ProdMap, V, Index1) then
|
|
digraph.add_vertex(Index1, Key1, !R1),
|
|
digraph.add_edge(Key1, Key0, !R1)
|
|
else
|
|
true
|
|
)
|
|
), set_of_var.to_sorted_list(ConsumingVars), !R),
|
|
list.foldl(
|
|
( pred(V::in, !.R2::in, !:R2::out) is det :-
|
|
( if map.search(MakeVisMap, V, Index2) then
|
|
digraph.add_vertex(Index2, Key2, !R2),
|
|
digraph.add_edge(Key2, Key0, !R2)
|
|
else
|
|
true
|
|
)
|
|
), set_of_var.to_sorted_list(NeedVisVars), !R)
|
|
), GoalMap, digraph.init, Graph),
|
|
|
|
( if digraph.return_vertices_in_from_to_order(Graph, TSort) then
|
|
Goals = map.apply_to_list(TSort, GoalMap)
|
|
else
|
|
% XXX Report a mode error for this.
|
|
unexpected($pred, "tsort failed")
|
|
).
|
|
|
|
:- pred set_atomic_prod_vars(mode_ordering_info::in, set_of_progvar::out,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
|
|
set_atomic_prod_vars(MOI, ProdVars, !GoalInfo) :-
|
|
LambdaNesting = MOI ^ moi_lambda_nesting,
|
|
AtomicProdVars = MOI ^ moi_prodvars_map,
|
|
GoalId = goal_info_get_goal_id(!.GoalInfo),
|
|
( if
|
|
map.search(AtomicProdVars, stack.push(LambdaNesting, GoalId),
|
|
ProdVars0)
|
|
then
|
|
ProdVars = ProdVars0
|
|
else
|
|
ProdVars = set_of_var.init
|
|
),
|
|
goal_info_set_producing_vars(ProdVars, !GoalInfo).
|
|
|
|
:- pred pred_info_create_proc_info_for_mode_decl_constraint(
|
|
mode_constraint::in, proc_id::out, pred_info::in, pred_info::out) is det.
|
|
|
|
pred_info_create_proc_info_for_mode_decl_constraint(_ModeDeclConstraint,
|
|
ProcId, PredInfo, PredInfo) :-
|
|
( if semidet_succeed then
|
|
% XXX
|
|
sorry($pred, "NYI")
|
|
else
|
|
% XXX keep det checker happy.
|
|
ProcId = initial_proc_id
|
|
).
|
|
|
|
:- pred find_matching_proc(mode_ordering_info::in, pred_id::in,
|
|
list(prog_var)::in, set_of_progvar::in,
|
|
proc_id::out, set_of_progvar::out) is det.
|
|
|
|
find_matching_proc(MOI, PredId, Args, ProdVars, ProcId, ConsumingVars) :-
|
|
ModuleInfo = MOI ^ moi_module_info,
|
|
CallerInstGraph = MOI ^ moi_inst_graph,
|
|
PredConstraintMap = MOI ^ moi_pred_constraint_map,
|
|
lookup_pred_constraint(PredConstraintMap, PredId, _, MCInfo),
|
|
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
pred_info_get_inst_graph_info(PredInfo, CalleeInstGraphInfo),
|
|
CalleeInstGraph = CalleeInstGraphInfo ^ interface_inst_graph,
|
|
pred_info_get_proc_table(PredInfo, ProcTable),
|
|
map.to_assoc_list(ProcTable, ProcList),
|
|
( if
|
|
find_matching_proc_2(ProcList, ProdVars, Args,
|
|
CallerInstGraph, CalleeInstGraph, MCInfo, ProcId0, ConsumingVars0)
|
|
then
|
|
ProcId = ProcId0,
|
|
ConsumingVars = ConsumingVars0
|
|
else if
|
|
pred_info_infer_modes(PredInfo)
|
|
then
|
|
% XXX We are inferring modes for the called predicate. Need to add
|
|
% a new mode to the requested procs map.
|
|
unexpected($pred, "infer_modes NYI")
|
|
else
|
|
% If we get here, it means there is a mode error which should have been
|
|
% picked up by the constraints pass but was missed some how.
|
|
unexpected($pred, "unexpected mode error")
|
|
).
|
|
|
|
:- pred find_matching_proc_2(assoc_list(proc_id, proc_info)::in,
|
|
set_of_progvar::in, list(prog_var)::in, inst_graph::in, inst_graph::in,
|
|
mode_constraint_info::in, proc_id::out, set_of_progvar::out) is semidet.
|
|
|
|
find_matching_proc_2([ProcId0 - ProcInfo | ProcList], ProdVars, Args,
|
|
CallerInstGraph, CalleeInstGraph, MCInfo, ProcId, ConsumingVars) :-
|
|
proc_info_get_headvars(ProcInfo, HeadVars),
|
|
proc_info_head_modes_constraint(ProcInfo, Constraint0),
|
|
Constraint = ensure_normalised(Constraint0),
|
|
( if
|
|
(
|
|
all [X, Y] (
|
|
inst_graph.corresponding_nodes_from_lists(
|
|
CallerInstGraph, CalleeInstGraph, Args, HeadVars, X, Y)
|
|
)
|
|
=>
|
|
(
|
|
set_of_var.contains(ProdVars, X)
|
|
<=>
|
|
(
|
|
var_entailed(Constraint,
|
|
mode_constraint_var(MCInfo, out(Y))),
|
|
not var_entailed(Constraint,
|
|
mode_constraint_var(MCInfo, in(Y)))
|
|
)
|
|
)
|
|
)
|
|
then
|
|
ProcId = ProcId0,
|
|
GenPred =
|
|
( pred(X::out) is nondet :-
|
|
some [Y] (
|
|
inst_graph.corresponding_nodes_from_lists(CallerInstGraph,
|
|
CalleeInstGraph, Args, HeadVars, X, Y),
|
|
var_entailed(Constraint,
|
|
mode_constraint_var(MCInfo, in(Y)))
|
|
)
|
|
),
|
|
ConsumingVarsList = solutions.solutions(GenPred),
|
|
set_of_var.sorted_list_to_set(ConsumingVarsList, ConsumingVars)
|
|
else
|
|
find_matching_proc_2(ProcList, ProdVars, Args, CallerInstGraph,
|
|
CalleeInstGraph, MCInfo, ProcId, ConsumingVars)
|
|
).
|
|
|
|
:- pred report_ordering_mode_errors(module_info::in, io::di, io::uo) is det.
|
|
|
|
report_ordering_mode_errors(_, !IO).
|
|
% XXX
|
|
% io.stderr_stream(StdErr, !IO),
|
|
% io.write_string(StdErr, "Mode error reporting NYI", !IO).
|
|
|
|
:- pred lookup_pred_constraint(pred_constraint_map::in, pred_id::in,
|
|
mode_constraint::out, mode_constraint_info::out) is det.
|
|
|
|
lookup_pred_constraint(PCM, PredId, MC, MCI) :-
|
|
map.lookup(PCM, PredId, pci(MC, MCI)).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred goal_info_set_producing_vars(set_of_progvar::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
:- pred goal_info_set_consuming_vars(set_of_progvar::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
:- pred goal_info_set_make_visible_vars(set_of_progvar::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
:- pred goal_info_set_need_visible_vars(set_of_progvar::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
|
|
goal_info_get_occurring_vars(GoalInfo, OccurringVars) :-
|
|
MMCI = goal_info_get_maybe_mode_constr(GoalInfo),
|
|
(
|
|
MMCI = yes(MCI),
|
|
OccurringVars = MCI ^ mci_occurring_vars
|
|
;
|
|
MMCI = no,
|
|
OccurringVars = set_of_var.init
|
|
).
|
|
|
|
goal_info_get_producing_vars(GoalInfo, ProducingVars) :-
|
|
MMCI = goal_info_get_maybe_mode_constr(GoalInfo),
|
|
(
|
|
MMCI = yes(MCI),
|
|
ProducingVars = MCI ^ mci_producing_vars
|
|
;
|
|
MMCI = no,
|
|
ProducingVars = set_of_var.init
|
|
).
|
|
|
|
goal_info_get_consuming_vars(GoalInfo, ConsumingVars) :-
|
|
MMCI = goal_info_get_maybe_mode_constr(GoalInfo),
|
|
(
|
|
MMCI = yes(MCI),
|
|
ConsumingVars = MCI ^ mci_consuming_vars
|
|
;
|
|
MMCI = no,
|
|
ConsumingVars = set_of_var.init
|
|
).
|
|
|
|
goal_info_get_make_visible_vars(GoalInfo, MakeVisibleVars) :-
|
|
MMCI = goal_info_get_maybe_mode_constr(GoalInfo),
|
|
(
|
|
MMCI = yes(MCI),
|
|
MakeVisibleVars = MCI ^ mci_make_visible_vars
|
|
;
|
|
MMCI = no,
|
|
MakeVisibleVars = set_of_var.init
|
|
).
|
|
|
|
goal_info_get_need_visible_vars(GoalInfo, NeedVisibleVars) :-
|
|
MMCI = goal_info_get_maybe_mode_constr(GoalInfo),
|
|
(
|
|
MMCI = yes(MCI),
|
|
NeedVisibleVars = MCI ^ mci_need_visible_vars
|
|
;
|
|
MMCI = no,
|
|
NeedVisibleVars = set_of_var.init
|
|
).
|
|
|
|
goal_info_set_occurring_vars(OccurringVars, !GoalInfo) :-
|
|
MMCI0 = goal_info_get_maybe_mode_constr(!.GoalInfo),
|
|
(
|
|
MMCI0 = yes(MCI0),
|
|
MCI = MCI0 ^ mci_occurring_vars := OccurringVars
|
|
;
|
|
MMCI0 = no,
|
|
set_of_var.init(ProducingVars),
|
|
set_of_var.init(ConsumingVars),
|
|
set_of_var.init(MakeVisibleVars),
|
|
set_of_var.init(NeedVisibleVars),
|
|
MCI = mode_constr_goal_info(OccurringVars, ProducingVars,
|
|
ConsumingVars, MakeVisibleVars, NeedVisibleVars)
|
|
),
|
|
goal_info_set_maybe_mode_constr(yes(MCI), !GoalInfo).
|
|
|
|
goal_info_set_producing_vars(ProducingVars, !GoalInfo) :-
|
|
MMCI0 = goal_info_get_maybe_mode_constr(!.GoalInfo),
|
|
(
|
|
MMCI0 = yes(MCI0),
|
|
MCI = MCI0 ^ mci_producing_vars := ProducingVars
|
|
;
|
|
MMCI0 = no,
|
|
set_of_var.init(OccurringVars),
|
|
set_of_var.init(ConsumingVars),
|
|
set_of_var.init(MakeVisibleVars),
|
|
set_of_var.init(NeedVisibleVars),
|
|
MCI = mode_constr_goal_info(OccurringVars, ProducingVars,
|
|
ConsumingVars, MakeVisibleVars, NeedVisibleVars)
|
|
),
|
|
goal_info_set_maybe_mode_constr(yes(MCI), !GoalInfo).
|
|
|
|
goal_info_set_consuming_vars(ConsumingVars, !GoalInfo) :-
|
|
MMCI0 = goal_info_get_maybe_mode_constr(!.GoalInfo),
|
|
(
|
|
MMCI0 = yes(MCI0),
|
|
MCI = MCI0 ^ mci_consuming_vars := ConsumingVars
|
|
;
|
|
MMCI0 = no,
|
|
set_of_var.init(OccurringVars),
|
|
set_of_var.init(ProducingVars),
|
|
set_of_var.init(MakeVisibleVars),
|
|
set_of_var.init(NeedVisibleVars),
|
|
MCI = mode_constr_goal_info(OccurringVars, ProducingVars,
|
|
ConsumingVars, MakeVisibleVars, NeedVisibleVars)
|
|
),
|
|
goal_info_set_maybe_mode_constr(yes(MCI), !GoalInfo).
|
|
|
|
goal_info_set_make_visible_vars(MakeVisibleVars, !GoalInfo) :-
|
|
MMCI0 = goal_info_get_maybe_mode_constr(!.GoalInfo),
|
|
(
|
|
MMCI0 = yes(MCI0),
|
|
MCI = MCI0 ^ mci_make_visible_vars := MakeVisibleVars
|
|
;
|
|
MMCI0 = no,
|
|
set_of_var.init(OccurringVars),
|
|
set_of_var.init(ProducingVars),
|
|
set_of_var.init(ConsumingVars),
|
|
set_of_var.init(NeedVisibleVars),
|
|
MCI = mode_constr_goal_info(OccurringVars, ProducingVars,
|
|
ConsumingVars, MakeVisibleVars, NeedVisibleVars)
|
|
),
|
|
goal_info_set_maybe_mode_constr(yes(MCI), !GoalInfo).
|
|
|
|
goal_info_set_need_visible_vars(NeedVisibleVars, !GoalInfo) :-
|
|
MMCI0 = goal_info_get_maybe_mode_constr(!.GoalInfo),
|
|
(
|
|
MMCI0 = yes(MCI0),
|
|
MCI = MCI0 ^ mci_need_visible_vars := NeedVisibleVars
|
|
;
|
|
MMCI0 = no,
|
|
set_of_var.init(OccurringVars),
|
|
set_of_var.init(ProducingVars),
|
|
set_of_var.init(ConsumingVars),
|
|
set_of_var.init(MakeVisibleVars),
|
|
MCI = mode_constr_goal_info(OccurringVars, ProducingVars,
|
|
ConsumingVars, MakeVisibleVars, NeedVisibleVars)
|
|
),
|
|
goal_info_set_maybe_mode_constr(yes(MCI), !GoalInfo).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module check_hlds.mode_ordering.
|
|
%-----------------------------------------------------------------------------%
|