mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-16 22:35:41 +00:00
459847a064
Estimated hours taken: 18 Branches: main Move the univ, maybe, pair and unit types from std_util into their own modules. std_util still contains the general purpose higher-order programming constructs. library/std_util.m: Move univ, maybe, pair and unit (plus any other related types and procedures) into their own modules. library/maybe.m: New module. This contains the maybe and maybe_error types and the associated procedures. library/pair.m: New module. This contains the pair type and associated procedures. library/unit.m: New module. This contains the types unit/0 and unit/1. library/univ.m: New module. This contains the univ type and associated procedures. library/library.m: Add the new modules. library/private_builtin.m: Update the declaration of the type_ctor_info struct for univ. runtime/mercury.h: Update the declaration for the type_ctor_info struct for univ. runtime/mercury_mcpp.h: runtime/mercury_hlc_types.h: Update the definition of MR_Univ. runtime/mercury_init.h: Fix a comment: ML_type_name is now exported from type_desc.m. compiler/mlds_to_il.m: Update the the name of the module that defines univs (which are handled specially by the il code generator.) library/*.m: compiler/*.m: browser/*.m: mdbcomp/*.m: profiler/*.m: deep_profiler/*.m: Conform to the above changes. Import the new modules where they are needed; don't import std_util where it isn't needed. Fix formatting in lots of modules. Delete duplicate module imports. tests/*: Update the test suite to confrom to the above changes.
579 lines
22 KiB
Mathematica
579 lines
22 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2001-2006 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
% File: mode_ordering.m.
|
|
% Main author: dmo.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module check_hlds.mode_ordering.
|
|
:- interface.
|
|
|
|
:- import_module check_hlds.mode_constraint_robdd.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.inst_graph.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
:- import_module map.
|
|
|
|
:- type pred_constraint_info
|
|
---> pci(
|
|
mode_constraint,
|
|
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 mode_ordering.proc(inst_graph::in, mode_constraint::in,
|
|
mode_constraint_info::in, module_info::in, pred_constraint_map::in,
|
|
proc_info::in, proc_info::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.clause_to_proc.
|
|
:- import_module check_hlds.mode_constraint_robdd.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module mode_robdd.
|
|
% :- import_module mode_robdd.check.
|
|
% :- import_module mode_robdd.tfeir.
|
|
:- import_module mode_robdd.tfeirn.
|
|
:- import_module libs.compiler_util.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module pair.
|
|
:- import_module relation.
|
|
:- import_module set.
|
|
:- 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) :-
|
|
copy_module_clauses_to_procs(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, ModeConstraintInfo),
|
|
( pred_info_infer_modes(PredInfo0) ->
|
|
( map.search(RequestedProcsMap0, PredId, RequestedProcs) ->
|
|
list.foldl(
|
|
mode_ordering.infer_proc(ModeConstraint0,
|
|
ModeConstraintInfo, !.ModuleInfo, PredConstraintMap),
|
|
RequestedProcs, PredInfo0, PredInfo)
|
|
;
|
|
% XXX Maybe we should remove the predicate from the
|
|
% module_info here since it is not used.
|
|
PredInfo = PredInfo0
|
|
)
|
|
;
|
|
ProcIds = pred_info_non_imported_procids(PredInfo0),
|
|
list.foldl(
|
|
mode_ordering.check_proc(ModeConstraint0,
|
|
ModeConstraintInfo, !.ModuleInfo, PredConstraintMap),
|
|
ProcIds, PredInfo0, PredInfo)
|
|
),
|
|
module_info_set_pred_info(PredId, PredInfo, !ModuleInfo).
|
|
|
|
:- pred mode_ordering.infer_proc(mode_constraint::in,
|
|
mode_constraint_info::in, module_info::in, pred_constraint_map::in,
|
|
mode_constraint::in, pred_info::in, pred_info::out) is det.
|
|
|
|
mode_ordering.infer_proc(Constraint0, ModeConstraintInfo, ModuleInfo,
|
|
PredConstraintMap, ModeDeclConstraint, !PredInfo) :-
|
|
pred_info_create_proc_info_for_mode_decl_constraint(
|
|
ModeDeclConstraint, ProcId, !PredInfo),
|
|
mode_ordering.check_proc(Constraint0, ModeConstraintInfo, ModuleInfo,
|
|
PredConstraintMap, ProcId, !PredInfo).
|
|
|
|
:- pred mode_ordering.check_proc(mode_constraint::in,
|
|
mode_constraint_info::in, module_info::in, pred_constraint_map::in,
|
|
proc_id::in, pred_info::in, pred_info::out) is det.
|
|
|
|
mode_ordering.check_proc(Constraint0, ModeConstraintInfo, ModuleInfo,
|
|
PredConstraintMap, ProcId, !PredInfo) :-
|
|
pred_info_proc_info(!.PredInfo, ProcId, ProcInfo0),
|
|
proc_info_head_modes_constraint(ProcInfo0, ModeDeclConstraint),
|
|
Constraint = Constraint0 * ModeDeclConstraint,
|
|
InstGraph = !.PredInfo ^ inst_graph_info ^ implementation_inst_graph,
|
|
mode_ordering.proc(InstGraph, Constraint, ModeConstraintInfo,
|
|
ModuleInfo, PredConstraintMap, 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.
|
|
%
|
|
mode_ordering.proc(InstGraph, ModeConstraint, ModeConstraintInfo, ModuleInfo,
|
|
PredConstraintMap, !ProcInfo) :-
|
|
MOI = mode_ordering_info(InstGraph,
|
|
atomic_prodvars_map(ModeConstraint, ModeConstraintInfo),
|
|
stack.init, ModuleInfo, PredConstraintMap),
|
|
proc_info_get_goal(!.ProcInfo, Goal0),
|
|
mode_order_goal(Goal0, Goal, MOI, _MOI),
|
|
proc_info_set_goal(Goal, !ProcInfo).
|
|
|
|
:- type mode_ordering_info
|
|
---> mode_ordering_info(
|
|
inst_graph :: inst_graph,
|
|
prodvars_map :: prodvars_map,
|
|
lambda_nesting :: lambda_path,
|
|
module_info :: module_info,
|
|
pred_constraint_map :: pred_constraint_map
|
|
).
|
|
|
|
:- pred enter_lambda_goal(goal_path::in,
|
|
mode_ordering_info::in, mode_ordering_info::out) is det.
|
|
|
|
enter_lambda_goal(GoalPath, !MOI) :-
|
|
LambdaNesting0 = !.MOI ^ lambda_nesting,
|
|
!:MOI = !.MOI ^ lambda_nesting := stack.push(LambdaNesting0, GoalPath).
|
|
|
|
:- pred leave_lambda_goal(mode_ordering_info::in, mode_ordering_info::out)
|
|
is det.
|
|
|
|
leave_lambda_goal(!MOI) :-
|
|
LambdaNesting0 = !.MOI ^ lambda_nesting,
|
|
stack.pop_det(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(GoalExpr0 - GoalInfo0, GoalExpr - GoalInfo, !MOI) :-
|
|
mode_order_goal_2(GoalExpr0, GoalExpr, GoalInfo0, GoalInfo, !MOI).
|
|
|
|
:- 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(Goal0, Goal, !GoalInfo, !MOI) :-
|
|
Goal0 = conj(ConjType, Goals0),
|
|
Goal = conj(ConjType, Goals),
|
|
(
|
|
ConjType = plain_conj,
|
|
list.map_foldl(mode_order_goal, Goals0, Goals1, !MOI),
|
|
mode_order_conj(Goals1, Goals),
|
|
union_mode_vars_sets(Goals, !GoalInfo),
|
|
ConsVars = !.GoalInfo ^ consuming_vars,
|
|
!:GoalInfo = !.GoalInfo ^ consuming_vars :=
|
|
ConsVars `difference` !.GoalInfo ^ producing_vars,
|
|
NeedVars = !.GoalInfo ^ need_visible_vars,
|
|
!:GoalInfo = !.GoalInfo ^ need_visible_vars :=
|
|
NeedVars `difference` !.GoalInfo ^ make_visible_vars
|
|
;
|
|
ConjType = parallel_conj,
|
|
list.map_foldl(mode_order_goal, Goals0, Goals, !MOI),
|
|
union_mode_vars_sets(Goals, !GoalInfo)
|
|
).
|
|
|
|
mode_order_goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
|
|
Goal0 = call(PredId, _, Args, _, _, _),
|
|
Goal = Goal0 ^ call_proc_id := ProcId,
|
|
set_atomic_prod_vars(ProdVars, !GoalInfo, !MOI),
|
|
MakeVisibleVars = list_to_set(Args) `intersect` ProdVars,
|
|
|
|
find_matching_proc(PredId, Args, ProdVars, ProcId, ConsumingVars, !MOI),
|
|
NeedVisibleVars = list_to_set(Args) `intersect` ConsumingVars,
|
|
|
|
goal_info_set_consuming_vars(ConsumingVars, !GoalInfo),
|
|
goal_info_set_make_visible_vars(MakeVisibleVars, !GoalInfo),
|
|
goal_info_set_need_visible_vars(NeedVisibleVars, !GoalInfo).
|
|
|
|
mode_order_goal_2(Goal0, _, !GoalInfo, !MOI) :-
|
|
Goal0 = generic_call(_GenericCall0, _Args, _Modes0, _Det),
|
|
unexpected(this_file, "mode_order_goal_2: generic_call NYI").
|
|
|
|
mode_order_goal_2(Goal0, _, !GoalInfo, !MOI) :-
|
|
Goal0 = switch(_Var, _CanFail0, _Cases0),
|
|
unexpected(this_file, "mode_order_goal_2: switch").
|
|
|
|
mode_order_goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
|
|
Goal0 = unify(VarA, RHS0, UnifyMode, Unification0, Context),
|
|
Goal = unify(VarA, RHS, UnifyMode, Unification, Context),
|
|
set_atomic_prod_vars(ProdVars, !GoalInfo, !MOI),
|
|
InstGraph = !.MOI ^ inst_graph,
|
|
(
|
|
RHS0 = var(VarB),
|
|
RHS = RHS0,
|
|
( ProdVars `contains` VarA ->
|
|
Unification = assign(VarA, VarB),
|
|
MakeVisibleVars = make_singleton_set(VarA),
|
|
NeedVisibleVars = make_singleton_set(VarB)
|
|
; ProdVars `contains` VarB ->
|
|
Unification = assign(VarB, VarA),
|
|
MakeVisibleVars = make_singleton_set(VarB),
|
|
NeedVisibleVars = make_singleton_set(VarA)
|
|
;
|
|
Unification = simple_test(VarA, VarB),
|
|
% XXX may be complicated unify -- need to check.
|
|
MakeVisibleVars = set.init,
|
|
NeedVisibleVars = list_to_set([VarA, VarB])
|
|
),
|
|
ConsumingVars = solutions.solutions_set((pred(Var::out) is nondet :-
|
|
inst_graph.corresponding_nodes(InstGraph, VarA, VarB, VarC, VarD),
|
|
( ProdVars `contains` VarC ->
|
|
Var = VarD
|
|
; ProdVars `contains` VarD ->
|
|
Var = VarC
|
|
;
|
|
fail
|
|
)))
|
|
;
|
|
RHS0 = functor(_ConsId, _IsExistConstruct, ArgVars),
|
|
RHS = RHS0,
|
|
( ProdVars `contains` VarA ->
|
|
% Unification = construct(VarA, ConsId, ArgVars,
|
|
% _UniModes, _HowTo, _CellUniq, _MaybeRLExprId),
|
|
Unification = Unification0, % XXX
|
|
ConsumingVars = set.init,
|
|
MakeVisibleVars = list_to_set([VarA | ArgVars]),
|
|
NeedVisibleVars = set.init
|
|
;
|
|
% Unification = deconstruct(VarA, ConsId, ArgVars,
|
|
% _UniModes, _CanFail, _CanCGC),
|
|
Unification = Unification0, % XXX
|
|
ConsumingVars = make_singleton_set(VarA),
|
|
MakeVisibleVars = list_to_set(ArgVars),
|
|
NeedVisibleVars = make_singleton_set(VarA)
|
|
)
|
|
;
|
|
% Unification = construct(VarA, _ConsId, _ArgVars,
|
|
% _UniModes, _HowTo, _CellUniq, _MaybeRLExprId),
|
|
Unification = Unification0, % XXX
|
|
RHS0 = lambda_goal(A, B, C, NonLocals, LambdaVars, Modes0,
|
|
G, SubGoal0),
|
|
Modes = Modes0, % XXX
|
|
RHS = lambda_goal(A, B, C, NonLocals, LambdaVars, Modes,
|
|
G, SubGoal),
|
|
|
|
goal_info_get_goal_path(!.GoalInfo, GoalPath),
|
|
enter_lambda_goal(GoalPath, !MOI),
|
|
mode_order_goal(SubGoal0, SubGoal, !MOI),
|
|
leave_lambda_goal(!MOI),
|
|
|
|
ConsumingVars = solutions.solutions_set(
|
|
inst_graph.reachable_from_list(InstGraph, NonLocals)),
|
|
MakeVisibleVars = make_singleton_set(VarA),
|
|
NeedVisibleVars = list_to_set(NonLocals)
|
|
),
|
|
goal_info_set_consuming_vars(ConsumingVars, !GoalInfo),
|
|
goal_info_set_make_visible_vars(MakeVisibleVars, !GoalInfo),
|
|
goal_info_set_need_visible_vars(NeedVisibleVars, !GoalInfo).
|
|
|
|
mode_order_goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
|
|
Goal0 = disj(Goals0),
|
|
Goal = disj(Goals),
|
|
list.map_foldl(mode_order_goal, Goals0, Goals, !MOI),
|
|
mode_order_disj(Goals, !GoalInfo).
|
|
|
|
mode_order_goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
|
|
Goal0 = not(SubGoal0),
|
|
Goal = not(SubGoal),
|
|
mode_order_goal(SubGoal0, SubGoal, !MOI),
|
|
goal_info_copy_mode_var_sets(SubGoal ^ snd, !GoalInfo).
|
|
|
|
mode_order_goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
|
|
Goal0 = scope(Reason, SubGoal0),
|
|
Goal = scope(Reason, SubGoal),
|
|
mode_order_goal(SubGoal0, SubGoal, !MOI),
|
|
goal_info_copy_mode_var_sets(SubGoal ^ snd, !GoalInfo).
|
|
|
|
mode_order_goal_2(Goal0, Goal, !GoalInfo, !MOI) :-
|
|
Goal0 = if_then_else(Locals, Cond0, Then0, Else0),
|
|
Goal = if_then_else(Locals, Cond, Then, Else),
|
|
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),
|
|
ConsVars = !.GoalInfo ^ consuming_vars,
|
|
!:GoalInfo = !.GoalInfo ^ consuming_vars :=
|
|
ConsVars `difference` !.GoalInfo ^ producing_vars,
|
|
NeedVars = !.GoalInfo ^ need_visible_vars,
|
|
!:GoalInfo = !.GoalInfo ^ need_visible_vars :=
|
|
NeedVars `difference` !.GoalInfo ^ make_visible_vars,
|
|
|
|
combine_mode_vars_sets(Else ^ snd, !GoalInfo).
|
|
|
|
mode_order_goal_2(Goal0, _, !GoalInfo, !MOI) :-
|
|
Goal0 = foreign_proc(_, _, _, _, _, _),
|
|
unexpected(this_file, "mode_order_goal_2: pragma_foreign_code NYI").
|
|
|
|
mode_order_goal_2(Goal0, _, !GoalInfo, !MOI) :-
|
|
Goal0 = shorthand(_),
|
|
unexpected(this_file, "mode_order_goal_2: shorthand").
|
|
|
|
:- pred mode_order_disj(hlds_goals::in,
|
|
hlds_goal_info::in, hlds_goal_info::out) is det.
|
|
|
|
mode_order_disj([], !GoalInfo).
|
|
mode_order_disj([_ - 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(_ - 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) :-
|
|
ProdVars0 = !.GoalInfo ^ producing_vars,
|
|
ConsumVars0 = !.GoalInfo ^ consuming_vars,
|
|
MakeVisibleVars0 = !.GoalInfo ^ make_visible_vars,
|
|
NeedVisibleVars0 = !.GoalInfo ^ need_visible_vars,
|
|
|
|
!:GoalInfo = !.GoalInfo ^ producing_vars
|
|
:= ProdVars0 `intersect` GI ^ producing_vars,
|
|
!:GoalInfo = !.GoalInfo ^ consuming_vars
|
|
:= ConsumVars0 `union` GI ^ consuming_vars,
|
|
!:GoalInfo = !.GoalInfo ^ make_visible_vars
|
|
:= MakeVisibleVars0 `intersect` GI ^ make_visible_vars,
|
|
!:GoalInfo = !.GoalInfo ^ need_visible_vars
|
|
:= NeedVisibleVars0 `union` GI ^ need_visible_vars.
|
|
|
|
:- pred union_mode_vars_sets(hlds_goals::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) :-
|
|
ProdVars0 = !.GoalInfo ^ producing_vars,
|
|
ConsumVars0 = !.GoalInfo ^ consuming_vars,
|
|
MakeVisibleVars0 = !.GoalInfo ^ make_visible_vars,
|
|
NeedVisibleVars0 = !.GoalInfo ^ need_visible_vars,
|
|
Goal = _ - GI,
|
|
|
|
!:GoalInfo = !.GoalInfo ^ producing_vars
|
|
:= ProdVars0 `union` GI ^ producing_vars,
|
|
!:GoalInfo = !.GoalInfo ^ consuming_vars
|
|
:= ConsumVars0 `union` GI ^ consuming_vars,
|
|
!:GoalInfo = !.GoalInfo ^ make_visible_vars
|
|
:= MakeVisibleVars0 `union` GI ^ make_visible_vars,
|
|
!:GoalInfo = !.GoalInfo ^ need_visible_vars
|
|
:= NeedVisibleVars0 `union` GI ^ need_visible_vars.
|
|
|
|
:- 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) :-
|
|
!:GoalInfo = !.GoalInfo ^ producing_vars := GI ^ producing_vars,
|
|
!:GoalInfo = !.GoalInfo ^ consuming_vars := GI ^ consuming_vars,
|
|
!:GoalInfo = !.GoalInfo ^ make_visible_vars := GI ^ make_visible_vars,
|
|
!:GoalInfo = !.GoalInfo ^ need_visible_vars := GI ^ need_visible_vars.
|
|
|
|
:- pred mode_order_conj(hlds_goals::in, hlds_goals::out) is det.
|
|
|
|
mode_order_conj(Goals0, Goals) :-
|
|
GoalMap = list.foldl((func(G, GM) = map.det_insert(GM, Index, G) :-
|
|
(
|
|
G = _ - GI,
|
|
goal_info_get_goal_path(GI, GP),
|
|
GP = [conj(Index0) | _]
|
|
->
|
|
Index = Index0
|
|
;
|
|
unexpected(this_file, "mode_order_conj: goal_path error")
|
|
)), Goals0, map.init),
|
|
|
|
ProdMap =
|
|
map.foldl((func(I, G, PM0) =
|
|
list.foldl((func(V, PM1) = map.det_insert(PM1, V, I)),
|
|
set.to_sorted_list(G ^ snd ^ producing_vars), PM0)
|
|
), GoalMap, map.init),
|
|
|
|
MakeVisMap =
|
|
map.foldl((func(I, G, MVM0) =
|
|
list.foldl((func(V, MVM1) = map.set(MVM1, V, I)),
|
|
% XXX disjunction required!
|
|
set.to_sorted_list(G ^ snd ^ make_visible_vars), MVM0)
|
|
), GoalMap, map.init),
|
|
|
|
Relation = map.foldl((func(I, G, R0) = R :-
|
|
GI = G ^ snd,
|
|
relation.add_element(R0, I, Key0, R1),
|
|
R2 = list.foldl((func(V, R10) = R12 :-
|
|
( Index1 = map.search(ProdMap, V) ->
|
|
relation.add_element(R10, Index1, Key1, R11),
|
|
relation.add(R11, Key1, Key0, R12)
|
|
;
|
|
R12 = R10
|
|
)
|
|
), set.to_sorted_list(GI ^ consuming_vars), R1),
|
|
R = list.foldl((func(V, R20) = R22 :-
|
|
( Index2 = map.search(MakeVisMap, V) ->
|
|
relation.add_element(R20, Index2, Key2, R21),
|
|
relation.add(R21, Key2, Key0, R22)
|
|
;
|
|
R22 = R20
|
|
)
|
|
), set.to_sorted_list(GI ^ need_visible_vars), R2)
|
|
), GoalMap, relation.init),
|
|
|
|
( relation.tsort(Relation, TSort) ->
|
|
Goals = map.apply_to_list(TSort, GoalMap)
|
|
;
|
|
% XXX Report a mode error for this.
|
|
unexpected(this_file, "conj: Cycle in goal dependencies.")
|
|
).
|
|
|
|
:- pred set_atomic_prod_vars(set(prog_var)::out,
|
|
hlds_goal_info::in, hlds_goal_info::out,
|
|
mode_ordering_info::in, mode_ordering_info::out) is det.
|
|
|
|
set_atomic_prod_vars(ProdVars, !GoalInfo, !MOI) :-
|
|
LambdaNesting = !.MOI ^ lambda_nesting,
|
|
AtomicProdVars = !.MOI ^ prodvars_map,
|
|
goal_info_get_goal_path(!.GoalInfo, GoalPath),
|
|
(
|
|
map.search(AtomicProdVars, stack.push(LambdaNesting, GoalPath),
|
|
ProdVars0)
|
|
->
|
|
ProdVars = ProdVars0
|
|
;
|
|
ProdVars = set.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) :-
|
|
( semidet_succeed ->
|
|
% XXX
|
|
sorry(this_file,
|
|
"NYI: pred_info_create_proc_info_for_mode_decl_constraint")
|
|
;
|
|
% XXX keep det checker happy.
|
|
ProcId = initial_proc_id
|
|
).
|
|
|
|
:- pred find_matching_proc(pred_id::in, list(prog_var)::in, set(prog_var)::in,
|
|
proc_id::out, set(prog_var)::out,
|
|
mode_ordering_info::in, mode_ordering_info::out) is det.
|
|
|
|
find_matching_proc(PredId, Args, ProdVars, ProcId, ConsumingVars, !MOI) :-
|
|
ModuleInfo = !.MOI ^ module_info,
|
|
CallerInstGraph = !.MOI ^ inst_graph,
|
|
PredConstraintMap = !.MOI ^ pred_constraint_map,
|
|
lookup_pred_constraint(PredConstraintMap, PredId, _, MCInfo),
|
|
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
CalleeInstGraph = PredInfo^inst_graph_info^interface_inst_graph,
|
|
pred_info_get_procedures(PredInfo, ProcTable),
|
|
map.to_assoc_list(ProcTable, ProcList),
|
|
(
|
|
find_matching_proc_2(ProcList, ProdVars, Args,
|
|
CallerInstGraph, CalleeInstGraph, MCInfo, ProcId0, ConsumingVars0)
|
|
->
|
|
ProcId = ProcId0,
|
|
ConsumingVars = ConsumingVars0
|
|
;
|
|
pred_info_infer_modes(PredInfo)
|
|
->
|
|
% XXX We are inferring modes for the called predicate. Need to add
|
|
% a new mode to the requested procs map.
|
|
unexpected(this_file, "find_matching_proc: infer_modes NYI")
|
|
;
|
|
% 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(this_file, "find_matching_proc: unexpected mode error")
|
|
).
|
|
|
|
:- pred find_matching_proc_2(assoc_list(proc_id, proc_info)::in,
|
|
set(prog_var)::in, list(prog_var)::in, inst_graph::in, inst_graph::in,
|
|
mode_constraint_info::in, proc_id::out, set(prog_var)::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),
|
|
(
|
|
(
|
|
all [X, Y] inst_graph.corresponding_nodes_from_lists(
|
|
CallerInstGraph, CalleeInstGraph, Args, HeadVars, X, Y)
|
|
=>
|
|
(
|
|
ProdVars `contains` X
|
|
<=>
|
|
(
|
|
var_entailed(Constraint,
|
|
mode_constraint_var(MCInfo, out(Y))),
|
|
\+ var_entailed(Constraint,
|
|
mode_constraint_var(MCInfo, in(Y)))
|
|
)
|
|
)
|
|
)
|
|
->
|
|
ProcId = ProcId0,
|
|
ConsumingVars = solutions.solutions_set(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)))
|
|
)
|
|
)
|
|
;
|
|
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, MCInfo) :-
|
|
map.lookup(PCM, PredId, pci(MC, MCInfo)).
|
|
|
|
|
|
:- func this_file = string.
|
|
|
|
this_file = "mode_ordering.m.".
|
|
|