%-----------------------------------------------------------------------------% % 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. %-----------------------------------------------------------------------------%