%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2012 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: 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(ProducingVars, !GoalInfo, !MOI),
        find_matching_proc(PredId, Args, ProducingVars, ProcId, ConsumingVars,
            !MOI),
        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(ProdVars, !GoalInfo, !MOI),
        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(set_of_progvar::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 ^ 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) :-
    ( if semidet_succeed then
        % XXX
        sorry($pred, "NYI")
    else
        % XXX keep det checker happy.
        ProcId = initial_proc_id
    ).

:- pred find_matching_proc(pred_id::in, list(prog_var)::in, set_of_progvar::in,
    proc_id::out, set_of_progvar::out,
    mode_ordering_info::in, mode_ordering_info::out) is det.

find_matching_proc(PredId, Args, ProdVars, ProcId, ConsumingVars, !MOI) :-
    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.
%-----------------------------------------------------------------------------%
