mercury/compiler/modecheck_util.m

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2009-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: modecheck_util.m.
%
%-----------------------------------------------------------------------------%

:- module check_hlds.modecheck_util.
:- interface.

:- import_module check_hlds.mode_info.
:- import_module hlds.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module hlds.instmap.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.

:- import_module list.
:- import_module maybe.

%-----------------------------------------------------------------------------%

:- type extra_goals
    --->    no_extra_goals
    ;       extra_goals(
                % Goals to insert before the main goal.
                extra_before_main   :: list(hlds_goal),

                % Goals to append after the main goal.
                extra_after_main    :: list(hlds_goal)
            ).

:- type after_goals
    --->    no_after_goals
    ;       after_goals(
                % Instmap at end of main goal.
                after_instmap       :: instmap,

                % Goals to append after the main goal.
                after_goals         :: list(hlds_goal)
            ).

    % Append_extra_goals inserts adds some goals to the
    % list of goals to insert before/after the main goal.
    %
:- pred append_extra_goals(extra_goals::in, extra_goals::in,
    extra_goals::out) is det.

    % Handle_extra_goals combines MainGoal and ExtraGoals into a single
    % hlds_goal_expr, rerunning mode analysis on the entire conjunction
    % if ExtraGoals is not empty.
    %
:- pred handle_extra_goals(hlds_goal_expr::in, extra_goals::in,
    hlds_goal_info::in, list(prog_var)::in, list(prog_var)::in,
    instmap::in, hlds_goal_expr::out, mode_info::in, mode_info::out) is det.

%-----------------------------------------------------------------------------%

    % Calculate the argument number offset that needs to be passed to
    % modecheck_var_list_is_live, modecheck_var_has_inst_list, and
    % modecheck_set_var_inst_list. This offset number is calculated so that
    % real arguments get positive argument numbers and type_info arguments
    % get argument numbers less than or equal to 0.
    %
:- pred compute_arg_offset(pred_info::in, int::out) is det.

    % Given a list of variables and a list of expected liveness, ensure
    % that the inst of each variable satisfies the corresponding expected
    % liveness. See below for the difference between the two variants.
    %
:- pred modecheck_var_list_is_live_exact_match(list(prog_var)::in,
    list(is_live)::in, int::in, mode_info::in, mode_info::out) is det.
:- pred modecheck_var_list_is_live_no_exact_match(list(prog_var)::in,
    list(is_live)::in, int::in, mode_info::in, mode_info::out) is det.

    % Given a list of variables and a list of initial insts, ensure that
    % the inst of each variable matches the corresponding initial inst.
    % The first variant requires an exact match (using inst_matches_final),
    % while the second we allow the var to be more instantiated than the inst
    % (using inst_matches_initial).
    %
:- pred modecheck_var_has_inst_list_exact_match(list(prog_var)::in,
    list(mer_inst)::in, int::in, inst_var_sub::out,
    mode_info::in, mode_info::out) is det.
:- pred modecheck_var_has_inst_list_no_exact_match(list(prog_var)::in,
    list(mer_inst)::in, int::in, inst_var_sub::out,
    mode_info::in, mode_info::out) is det.

    % This is a special-cased, cut-down version of
    % modecheck_var_has_inst_list_no_exact_match for use specifically
    % on introduced type_info_type variables.
    %
:- pred modecheck_introduced_type_info_var_has_inst_no_exact_match(
    prog_var::in, mer_type::in, mer_inst::in,
    mode_info::in, mode_info::out) is det.

    % modecheck_set_var_inst(Var, Inst, MaybeUInst, !ModeInfo):
    %
    % Assign the given Inst to the given Var, after checking that it is
    % okay to do so. If the inst to be assigned is the result of an
    % abstract unification then the MaybeUInst argument should be the
    % initial inst of the _other_ side of the unification. This allows
    % more precise (i.e. less conservative) checking in the case that
    % Inst contains `any' components and Var is locked (i.e. is a
    % nonlocal variable in a negated context). Where the inst is not
    % the result of an abstract unification then MaybeUInst should be `no'.
    %
:- pred modecheck_set_var_inst(prog_var::in, mer_inst::in, maybe(mer_inst)::in,
    mode_info::in, mode_info::out) is det.

:- pred modecheck_set_var_inst_list(list(prog_var)::in, list(mer_inst)::in,
    list(mer_inst)::in, int::in, list(prog_var)::out, extra_goals::out,
    mode_info::in, mode_info::out) is det.

:- pred mode_info_add_goals_live_vars(conj_type::in, list(hlds_goal)::in,
    mode_info::in, mode_info::out) is det.

:- pred mode_info_remove_goals_live_vars(list(hlds_goal)::in,
    mode_info::in, mode_info::out) is det.

    % modecheck_functor_test(Var, ConsId, !ModeInfo):
    %
    % Update the instmap to reflect the fact that Var was bound to ConsId.
    % This is used for the functor tests in `switch' statements.
    %
:- pred modecheck_functor_test(prog_var::in, cons_id::in,
    mode_info::in, mode_info::out) is det.

    % modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo):
    %
    % Update the instmap to reflect the fact that Var was bound to either
    % MainConsId or one of the OtherConsIds.
    % This is used for the functor tests in `switch' statements.
    %
:- pred modecheck_functors_test(prog_var::in, cons_id::in, list(cons_id)::in,
    mode_info::in, mode_info::out) is det.

    % compute_goal_instmap_delta(InstMap0, GoalExpr, !GoalInfo, !ModeInfo):
    %
    % Work out the instmap_delta for a goal from the instmaps before and after
    % the goal. The instmap before the goal is given by InstMap0; the instmap
    % after the goal is given by !.ModeInfo.
    %
:- pred compute_goal_instmap_delta(instmap::in, hlds_goal_expr::in,
    hlds_goal_info::in, hlds_goal_info::out, mode_info::in, mode_info::out)
    is det.

%-----------------------------------------------------------------------------%

    % Construct a call to initialise a free solver type variable.
    %
:- pred construct_initialisation_call(prog_var::in, mer_type::in, mer_inst::in,
    prog_context::in, maybe(call_unify_context)::in,
    hlds_goal::out, mode_info::in, mode_info::out) is det.

    % Construct a list of initialisation calls.
    %
:- pred construct_initialisation_calls(list(prog_var)::in,
    list(hlds_goal)::out, mode_info::in, mode_info::out) is det.

:- pred prepend_initialisation_call(prog_var::in, mer_type::in, mer_inst::in,
    hlds_goal::in, hlds_goal::out, mode_info::in, mode_info::out) is det.

:- pred mode_context_to_unify_context(mode_info::in, mode_context::in,
    unify_context::out) is det.

    % Given a list of variables, and a list of livenesses,
    % select the live variables.
    %
:- pred get_live_vars(list(prog_var)::in, list(is_live)::in,
    list(prog_var)::out) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- import_module check_hlds.delay_info.
:- import_module check_hlds.inst_match.
:- import_module check_hlds.inst_util.
:- import_module check_hlds.mode_errors.
:- import_module check_hlds.modecheck_goal.
:- import_module check_hlds.modecheck_unify.
:- import_module check_hlds.polymorphism.
:- import_module check_hlds.type_util.
:- import_module hlds.hlds_module.
:- import_module hlds.pred_table.
:- import_module hlds.special_pred.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.set_of_var.

:- import_module bool.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module term.
:- import_module varset.

%-----------------------------------------------------------------------------%

append_extra_goals(no_extra_goals, ExtraGoals, ExtraGoals).
append_extra_goals(extra_goals(BeforeGoals, AfterGoals),
        no_extra_goals, extra_goals(BeforeGoals, AfterGoals)).
append_extra_goals(extra_goals(BeforeGoals0, AfterGoals0),
        extra_goals(BeforeGoals1, AfterGoals1),
        extra_goals(BeforeGoals, AfterGoals)) :-
    BeforeGoals = BeforeGoals0 ++ BeforeGoals1,
    AfterGoals = AfterGoals0 ++ AfterGoals1.

handle_extra_goals(MainGoal, no_extra_goals, _GoalInfo0, _Args0, _Args,
        _InstMap0, MainGoal, !ModeInfo).
handle_extra_goals(MainGoal, extra_goals(BeforeGoals0, AfterGoals0),
        GoalInfo0, Args0, Args, InstMap0, Goal, !ModeInfo) :-
    mode_info_get_errors(!.ModeInfo, Errors),
    (
        % There's no point adding extra goals if the code is
        % unreachable anyway.
        instmap_is_reachable(InstMap0),

        % If we recorded errors processing the goal, it will have to be
        % reprocessed anyway, so don't add the extra goals now.
        Errors = []
    ->
        % We need to be careful to update the delta-instmaps
        % correctly, using the appropriate instmaps:
        %
        %       % InstMapAtStart is here
        %    BeforeGoals,
        %       % we don't know the instmap here,
        %       % but as it happens we don't need it
        %    main goal,
        %       % InstMapAfterMain is here
        %    AfterGoals
        %       % InstMapAtEnd (from the ModeInfo) is here

        % Recompute the new set of non-local variables for the main goal.
        NonLocals0 = goal_info_get_nonlocals(GoalInfo0),
        set_of_var.list_to_set(Args0, OldArgVars),
        set_of_var.list_to_set(Args, NewArgVars),
        set_of_var.difference(NewArgVars, OldArgVars, IntroducedVars),
        set_of_var.union(NonLocals0, IntroducedVars, OutsideVars),
        set_of_var.intersect(OutsideVars, NewArgVars, NonLocals),
        goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),

        % Combine the main goal and the extra goals into a conjunction.
        Goal0 = hlds_goal(MainGoal, GoalInfo),
        Context = goal_info_get_context(GoalInfo0),
        handle_extra_goals_contexts(BeforeGoals0, Context, BeforeGoals),
        handle_extra_goals_contexts(AfterGoals0, Context, AfterGoals),
        GoalList0 = BeforeGoals ++ [Goal0 | AfterGoals],

        mode_info_get_may_change_called_proc(!.ModeInfo, MayChangeCalledProc0),

        % Make sure we don't go into an infinite loop if
        % there is a bug in the code to add extra goals.
        mode_info_set_checking_extra_goals(yes, !ModeInfo),

        % We've already worked out which procedure should be called,
        % we don't need to do it again.
        mode_info_set_may_change_called_proc(may_not_change_called_proc,
            !ModeInfo),

        mode_info_set_instmap(InstMap0, !ModeInfo),

        % Recheck the goals to compute the instmap_deltas.
        %
        % This can fail even if the original check on the goal
        % succeeded in the case of a unification procedure which
        % binds a partially instantiated variable, because adding
        % the extra goals can make the partially instantiated
        % variables `live' after the main goal.
        % The other thing to beware of in this case is that delaying
        % must be disabled while processing the extra goals. If it
        % is not, the main unification will be delayed until after the
        % argument unifications, which turns them into assignments,
        % and we end up repeating the process forever.
        mode_info_add_goals_live_vars(plain_conj, GoalList0, !ModeInfo),
        modecheck_conj_list_no_delay(GoalList0, GoalList, !ModeInfo),
        Goal = conj(plain_conj, GoalList),
        mode_info_set_checking_extra_goals(no, !ModeInfo),
        mode_info_set_may_change_called_proc(MayChangeCalledProc0, !ModeInfo)
    ;
        Goal = MainGoal
    ).

    % Modecheck a conjunction without doing any reordering.
    % This is used by handle_extra_goals above.
    %
:- pred modecheck_conj_list_no_delay(list(hlds_goal)::in, list(hlds_goal)::out,
    mode_info::in, mode_info::out) is det.

modecheck_conj_list_no_delay([], [], !ModeInfo).
modecheck_conj_list_no_delay([Goal0 | Goals0], [Goal | Goals], !ModeInfo) :-
    NonLocals = goal_get_nonlocals(Goal0),
    mode_info_remove_live_vars(NonLocals, !ModeInfo),
    modecheck_goal(Goal0, Goal, !ModeInfo),
    mode_info_get_instmap(!.ModeInfo, InstMap),
    ( instmap_is_unreachable(InstMap) ->
        % We should not mode-analyse the remaining goals, since they
        % are unreachable.  Instead we optimize them away, so that
        % later passes won't complain about them not having mode information.
        mode_info_remove_goals_live_vars(Goals0, !ModeInfo),
        Goals  = []
    ;
        modecheck_conj_list_no_delay(Goals0, Goals, !ModeInfo)
    ).

:- pred handle_extra_goals_contexts(list(hlds_goal)::in, prog_context::in,
    list(hlds_goal)::out) is det.

handle_extra_goals_contexts([], _Context, []).
handle_extra_goals_contexts([Goal0 | Goals0], Context, [Goal | Goals]) :-
    Goal0 = hlds_goal(GoalExpr, GoalInfo0),
    goal_info_set_context(Context, GoalInfo0, GoalInfo),
    Goal = hlds_goal(GoalExpr, GoalInfo),
    handle_extra_goals_contexts(Goals0, Context, Goals).

%-----------------------------------------------------------------------------%

modecheck_functor_test(Var, ConsId, !ModeInfo) :-
    % Figure out the arity of this constructor, _including_ any type-infos
    % or typeclass-infos inserted for existential data types.
    mode_info_get_module_info(!.ModeInfo, ModuleInfo),
    mode_info_get_var_types(!.ModeInfo, VarTypes),
    lookup_var_type(VarTypes, Var, Type),
    BoundInst = cons_id_to_bound_inst(ModuleInfo, Type, ConsId),

    % Record the fact that Var was bound to ConsId.
    Inst = bound(unique, inst_test_no_results, [BoundInst]),
    modecheck_set_var_inst(Var, Inst, no, !ModeInfo).

modecheck_functors_test(Var, MainConsId, OtherConsIds, !ModeInfo) :-
    % Figure out the arity of this constructor, _including_ any type-infos
    % or typeclass-infos inserted for existential data types.
    mode_info_get_module_info(!.ModeInfo, ModuleInfo),
    mode_info_get_var_types(!.ModeInfo, VarTypes),
    lookup_var_type(VarTypes, Var, Type),
    BoundInsts = list.map(cons_id_to_bound_inst(ModuleInfo, Type),
        [MainConsId | OtherConsIds]),

    % Record the fact that Var was bound to MainConsId or one of the
    % OtherConsIds.
    Inst = bound(unique, inst_test_no_results, BoundInsts),
    modecheck_set_var_inst(Var, Inst, no, !ModeInfo).

:- func cons_id_to_bound_inst(module_info, mer_type, cons_id) = bound_inst.

cons_id_to_bound_inst(ModuleInfo, Type, ConsId) = BoundInst :-
    ConsIdAdjustedArity = cons_id_adjusted_arity(ModuleInfo, Type, ConsId),
    list.duplicate(ConsIdAdjustedArity, free, ArgInsts),
    BoundInst = bound_functor(ConsId, ArgInsts).

compute_goal_instmap_delta(InstMap0, GoalExpr, !GoalInfo, !ModeInfo) :-
    ( GoalExpr = conj(_, []) ->
        % When modecheck_unify.m replaces a unification with a dead variable
        % with `true', make sure the instmap_delta of the goal is empty.
        % The code generator and mode_util.recompute_instmap_delta can be
        % confused by references to the dead variable in the instmap_delta,
        % resulting in calls to error/1.

        instmap_delta_init_reachable(DeltaInstMap),
        mode_info_set_instmap(InstMap0, !ModeInfo)
    ;
        NonLocals = goal_info_get_nonlocals(!.GoalInfo),
        mode_info_get_instmap(!.ModeInfo, InstMap),
        compute_instmap_delta(InstMap0, InstMap, NonLocals, DeltaInstMap)
    ),
    goal_info_set_instmap_delta(DeltaInstMap, !GoalInfo).

%-----------------------------------------------------------------------------%

compute_arg_offset(PredInfo, ArgOffset) :-
    OrigArity = pred_info_orig_arity(PredInfo),
    pred_info_get_arg_types(PredInfo, ArgTypes),
    list.length(ArgTypes, CurrentArity),
    ArgOffset = OrigArity - CurrentArity.

%-----------------------------------------------------------------------------%

modecheck_var_list_is_live_exact_match([_ | _], [], _, !ModeInfo) :-
    unexpected($module, $pred, "length mismatch").
modecheck_var_list_is_live_exact_match([], [_ | _], _, !ModeInfo) :-
    unexpected($module, $pred, "length mismatch").
modecheck_var_list_is_live_exact_match([], [], _ArgNum, !ModeInfo).
modecheck_var_list_is_live_exact_match([Var | Vars], [IsLive | IsLives],
        ArgNum0, !ModeInfo) :-
    ArgNum = ArgNum0 + 1,
    mode_info_set_call_arg_context(ArgNum, !ModeInfo),
    modecheck_var_is_live_exact_match(Var, IsLive, !ModeInfo),
    modecheck_var_list_is_live_exact_match(Vars, IsLives, ArgNum, !ModeInfo).

modecheck_var_list_is_live_no_exact_match([_ | _], [], _, !ModeInfo) :-
    unexpected($module, $pred, "length mismatch").
modecheck_var_list_is_live_no_exact_match([], [_ | _], _, !ModeInfo) :-
    unexpected($module, $pred, "length mismatch").
modecheck_var_list_is_live_no_exact_match([], [], _ArgNum, !ModeInfo).
modecheck_var_list_is_live_no_exact_match([Var | Vars], [IsLive | IsLives],
        ArgNum0, !ModeInfo) :-
    ArgNum = ArgNum0 + 1,
    mode_info_set_call_arg_context(ArgNum, !ModeInfo),
    modecheck_var_is_live_no_exact_match(Var, IsLive, !ModeInfo),
    modecheck_var_list_is_live_no_exact_match(Vars, IsLives, ArgNum,
        !ModeInfo).

    % `live' means possibly used later on, and `dead' means definitely not used
    % later on. If you don't need an exact match, then the only time you get
    % an error is if you pass a variable which is live to a predicate
    % that expects the variable to be dead; the predicate may use destructive
    % update to clobber the variable, so we must be sure that it is dead
    % after the call.
    %

    % A version of modecheck_var_is_live specialized for NeedExactMatch = no.
    %
:- pred modecheck_var_is_live_no_exact_match(prog_var::in, is_live::in,
    mode_info::in, mode_info::out) is det.

modecheck_var_is_live_no_exact_match(VarId, ExpectedIsLive, !ModeInfo) :-
    mode_info_var_is_live(!.ModeInfo, VarId, VarIsLive),
    (
        ExpectedIsLive = is_dead,
        VarIsLive = is_live
    ->
        WaitingVars = set_of_var.make_singleton(VarId),
        ModeError = mode_error_var_is_live(VarId),
        mode_info_error(WaitingVars, ModeError, !ModeInfo)
    ;
        true
    ).

    % A version of modecheck_var_is_live specialized for NeedExactMatch = yes.
    %
:- pred modecheck_var_is_live_exact_match(prog_var::in, is_live::in,
    mode_info::in, mode_info::out) is det.

modecheck_var_is_live_exact_match(VarId, ExpectedIsLive, !ModeInfo) :-
    mode_info_var_is_live(!.ModeInfo, VarId, VarIsLive),
    ( VarIsLive = ExpectedIsLive ->
        true
    ;
        WaitingVars = set_of_var.make_singleton(VarId),
        ModeError = mode_error_var_is_live(VarId),
        mode_info_error(WaitingVars, ModeError, !ModeInfo)
    ).

%-----------------------------------------------------------------------------%

    % Given a list of variables and a list of initial insts, ensure that
    % the inst of each variable matches the corresponding initial inst.
    %
modecheck_var_has_inst_list_exact_match(Vars, Insts, ArgNum, Subst,
        !ModeInfo) :-
    modecheck_var_has_inst_list_exact_match_2(Vars, Insts, ArgNum,
        map.init, Subst, !ModeInfo).

modecheck_var_has_inst_list_no_exact_match(Vars, Insts, ArgNum, Subst,
        !ModeInfo) :-
    modecheck_var_has_inst_list_no_exact_match_2(Vars, Insts, ArgNum,
        map.init, Subst, !ModeInfo).

:- pred modecheck_var_has_inst_list_exact_match_2(list(prog_var)::in,
    list(mer_inst)::in, int::in, inst_var_sub::in, inst_var_sub::out,
    mode_info::in, mode_info::out) is det.

modecheck_var_has_inst_list_exact_match_2([_ | _], [], _, !Subst, !ModeInfo) :-
    unexpected($module, $pred, "length mismatch").
modecheck_var_has_inst_list_exact_match_2([], [_ | _], _, !Subst, !ModeInfo) :-
    unexpected($module, $pred, "length mismatch").
modecheck_var_has_inst_list_exact_match_2([], [], _ArgNum, !Subst, !ModeInfo).
modecheck_var_has_inst_list_exact_match_2([Var | Vars], [Inst | Insts],
        ArgNum0, !Subst, !ModeInfo) :-
    ArgNum = ArgNum0 + 1,
    mode_info_set_call_arg_context(ArgNum, !ModeInfo),
    modecheck_var_has_inst_exact_match(Var, Inst, !Subst, !ModeInfo),
    modecheck_var_has_inst_list_exact_match_2(Vars, Insts, ArgNum,
        !Subst, !ModeInfo).

:- pred modecheck_var_has_inst_list_no_exact_match_2(list(prog_var)::in,
    list(mer_inst)::in, int::in, inst_var_sub::in, inst_var_sub::out,
    mode_info::in, mode_info::out) is det.

modecheck_var_has_inst_list_no_exact_match_2([_ | _], [], _,
        !Subst, !ModeInfo) :-
    unexpected($module, $pred, "length mismatch").
modecheck_var_has_inst_list_no_exact_match_2([], [_ | _], _,
        !Subst, !ModeInfo) :-
    unexpected($module, $pred, "length mismatch").
modecheck_var_has_inst_list_no_exact_match_2([], [], _ArgNum,
        !Subst, !ModeInfo).
modecheck_var_has_inst_list_no_exact_match_2([Var | Vars], [Inst | Insts],
        ArgNum0, !Subst, !ModeInfo) :-
    ArgNum = ArgNum0 + 1,
    mode_info_set_call_arg_context(ArgNum, !ModeInfo),
    modecheck_var_has_inst_no_exact_match(Var, Inst, !Subst, !ModeInfo),
    modecheck_var_has_inst_list_no_exact_match_2(Vars, Insts, ArgNum,
        !Subst, !ModeInfo).

:- pred modecheck_var_has_inst_exact_match(prog_var::in, mer_inst::in,
    inst_var_sub::in, inst_var_sub::out,
    mode_info::in, mode_info::out) is det.

modecheck_var_has_inst_exact_match(Var, Inst, !Subst, !ModeInfo) :-
    mode_info_get_instmap(!.ModeInfo, InstMap),
    instmap_lookup_var(InstMap, Var, VarInst),
    mode_info_get_var_types(!.ModeInfo, VarTypes),
    lookup_var_type(VarTypes, Var, Type),
    mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
    (
        inst_matches_initial_no_implied_modes_sub(VarInst, Inst, Type,
            ModuleInfo0, ModuleInfo, !Subst)
    ->
        mode_info_set_module_info(ModuleInfo, !ModeInfo)
    ;
        WaitingVars = set_of_var.make_singleton(Var),
        ModeError = mode_error_var_has_inst(Var, VarInst, Inst),
        mode_info_error(WaitingVars, ModeError, !ModeInfo)
    ).

:- pred modecheck_var_has_inst_no_exact_match(prog_var::in, mer_inst::in,
    inst_var_sub::in, inst_var_sub::out,
    mode_info::in, mode_info::out) is det.

modecheck_var_has_inst_no_exact_match(Var, Inst, !Subst, !ModeInfo) :-
    mode_info_get_instmap(!.ModeInfo, InstMap),
    instmap_lookup_var(InstMap, Var, VarInst),
    mode_info_get_var_types(!.ModeInfo, VarTypes),
    lookup_var_type(VarTypes, Var, Type),
    mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
    (
        inst_matches_initial_sub(VarInst, Inst, Type, ModuleInfo0, ModuleInfo,
            !Subst)
    ->
        mode_info_set_module_info(ModuleInfo, !ModeInfo)
    ;
        WaitingVars = set_of_var.make_singleton(Var),
        ModeError = mode_error_var_has_inst(Var, VarInst, Inst),
        mode_info_error(WaitingVars, ModeError, !ModeInfo)
    ).

modecheck_introduced_type_info_var_has_inst_no_exact_match(Var, Type, Inst,
        !ModeInfo) :-
    mode_info_get_instmap(!.ModeInfo, InstMap),
    instmap_lookup_var(InstMap, Var, VarInst),
    mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
    (
        inst_matches_initial_sub(VarInst, Inst, Type, ModuleInfo0, ModuleInfo,
            map.init, _Subst)
    ->
        mode_info_set_module_info(ModuleInfo, !ModeInfo)
    ;
        WaitingVars = set_of_var.make_singleton(Var),
        ModeError = mode_error_var_has_inst(Var, VarInst, Inst),
        mode_info_error(WaitingVars, ModeError, !ModeInfo)
    ).

%-----------------------------------------------------------------------------%

modecheck_set_var_inst_list(Vars0, InitialInsts, FinalInsts, ArgOffset,
        Vars, Goals, !ModeInfo) :-
    (
        modecheck_set_var_inst_list_2(Vars0, InitialInsts, FinalInsts,
            ArgOffset, Vars1, no_extra_goals, Goals1, !ModeInfo)
    ->
        Vars = Vars1,
        Goals = Goals1
    ;
        unexpected($module, $pred, "length mismatch")
    ).

:- pred modecheck_set_var_inst_list_2(list(prog_var)::in, list(mer_inst)::in,
    list(mer_inst)::in, int::in, list(prog_var)::out,
    extra_goals::in, extra_goals::out, mode_info::in, mode_info::out)
    is semidet.

modecheck_set_var_inst_list_2([], [], [], _, [], !ExtraGoals, !ModeInfo).
modecheck_set_var_inst_list_2([Var0 | Vars0], [InitialInst | InitialInsts],
        [FinalInst | FinalInsts], ArgNum0, [Var | Vars],
        !ExtraGoals, !ModeInfo) :-
    ArgNum = ArgNum0 + 1,
    mode_info_set_call_arg_context(ArgNum, !ModeInfo),
    modecheck_set_var_inst_call(Var0, InitialInst, FinalInst,
        Var, !ExtraGoals, !ModeInfo),
    modecheck_set_var_inst_list_2(Vars0, InitialInsts, FinalInsts, ArgNum,
        Vars, !ExtraGoals, !ModeInfo).

:- pred modecheck_set_var_inst_call(prog_var::in, mer_inst::in, mer_inst::in,
    prog_var::out, extra_goals::in, extra_goals::out,
    mode_info::in, mode_info::out) is det.

modecheck_set_var_inst_call(Var0, InitialInst, FinalInst, Var, !ExtraGoals,
        !ModeInfo) :-
    mode_info_get_instmap(!.ModeInfo, InstMap0),
    ( instmap_is_reachable(InstMap0) ->
        % The new inst must be computed by unifying the old inst
        % and the proc's final inst.
        instmap_lookup_var(InstMap0, Var0, VarInst0),
        handle_implied_mode(Var0, VarInst0, InitialInst, Var, !ExtraGoals,
            !ModeInfo),
        modecheck_set_var_inst(Var0, FinalInst, no, !ModeInfo),
        ( Var = Var0 ->
            true
        ;
            modecheck_set_var_inst(Var, FinalInst, no, !ModeInfo)
        )
    ;
        Var = Var0
    ).

modecheck_set_var_inst(Var0, NewInst, MaybeUInst, !ModeInfo) :-
    % Note that there are two versions of modecheck_set_var_inst,
    % one with arity 8 (suffixed with _call) and one with arity 5.
    % The former is used for predicate calls, where we may need
    % to introduce unifications to handle calls to implied modes.
    %
    mode_info_get_parallel_vars(!.ModeInfo, PVars0),
    mode_info_get_instmap(!.ModeInfo, InstMap0),
    ( instmap_is_reachable(InstMap0) ->
        instmap_lookup_var(InstMap0, Var0, OldInst),
        mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
        % The final new inst must be computed by unifying the old inst
        % and the tentative new inst. However, unifying a large inst with
        % itself can be VERY expensive; it can be worse than quadratic.
        % The OldInst = NewInst here may incrase execution time slightly
        % in normal cases, but should reduce it greatly in worst cases.
        (
            OldInst = NewInst
        ->
            ModuleInfo = ModuleInfo0,
            Inst = OldInst
        ;
            abstractly_unify_inst(is_dead, OldInst, NewInst,
                fake_unify, UnifyInst, _Det, ModuleInfo0, ModuleInfo1)
        ->
            ModuleInfo = ModuleInfo1,
            Inst = UnifyInst
        ;
            unexpected($module, $pred, "unify_inst failed")
        ),
        mode_info_set_module_info(ModuleInfo, !ModeInfo),
        mode_info_get_var_types(!.ModeInfo, VarTypes),
        lookup_var_type(VarTypes, Var0, Type),
        (
            % If the top-level inst of the variable is not_reached,
            % then the instmap as a whole must be unreachable.
            inst_expand(ModuleInfo, Inst, not_reached)
        ->
            instmap.init_unreachable(InstMap),
            mode_info_set_instmap(InstMap, !ModeInfo)
        ;
            % If we haven't added any information and
            % we haven't bound any part of the var, then
            % the only thing we can have done is lose uniqueness.
            inst_matches_initial(OldInst, Inst, Type, ModuleInfo)
        ->
            instmap_set_var(Var0, Inst, InstMap0, InstMap),
            mode_info_set_instmap(InstMap, !ModeInfo)
        ;
            % We must have either added some information,
            % lost some uniqueness, or bound part of the var.
            % The call to inst_matches_binding will succeed
            % only if we haven't bound any part of the var.
            \+ inst_matches_binding(Inst, OldInst, Type, ModuleInfo),

            % We've bound part of the var.  If the var was locked,
            % then we need to report an error...
            mode_info_var_is_locked(!.ModeInfo, Var0, Reason0),
            \+ (
                % ...unless the goal is a unification and the var was unified
                % with something no more instantiated than itself. This allows
                % for the case of `any = free', for example. The call to
                % inst_matches_binding, above will fail for the var with
                % mode `any >> any' however, it should be allowed because
                % it has only been unified with a free variable.
                MaybeUInst = yes(UInst),
                inst_is_at_least_as_instantiated(Inst, UInst, Type,
                    ModuleInfo),
                inst_matches_binding_allow_any_any(Inst, OldInst, Type,
                    ModuleInfo)
            )
        ->
            WaitingVars = set_of_var.make_singleton(Var0),
            ModeError = mode_error_bind_var(Reason0, Var0, OldInst, Inst),
            mode_info_error(WaitingVars, ModeError, !ModeInfo)
        ;
            instmap_set_var(Var0, Inst, InstMap0, InstMap),
            mode_info_set_instmap(InstMap, !ModeInfo),
            mode_info_get_delay_info(!.ModeInfo, DelayInfo0),
            delay_info_bind_var(Var0, DelayInfo0, DelayInfo),
            mode_info_set_delay_info(DelayInfo, !ModeInfo)
        )
    ;
        true
    ),
    (
        PVars0 = []
    ;
        PVars0 = [par_conj_mode_check(NonLocals, Bound0) | PVars1],
        ( set_of_var.member(NonLocals, Var0) ->
            set_of_var.insert(Var0, Bound0, Bound),
            PVars = [par_conj_mode_check(NonLocals, Bound) | PVars1]
        ;
            PVars = PVars0
        ),
        mode_info_set_parallel_vars(PVars, !ModeInfo)
    ).

    % If this was a call to an implied mode for that variable, then we need to
    % introduce a fresh variable.
    %
:- pred handle_implied_mode(prog_var::in, mer_inst::in, mer_inst::in,
    prog_var::out, extra_goals::in, extra_goals::out,
    mode_info::in, mode_info::out) is det.

handle_implied_mode(Var0, VarInst0, InitialInst0, Var, !ExtraGoals,
        !ModeInfo) :-
    mode_info_get_module_info(!.ModeInfo, ModuleInfo0),
    inst_expand(ModuleInfo0, InitialInst0, InitialInst),
    inst_expand(ModuleInfo0, VarInst0, VarInst1),

    mode_info_get_var_types(!.ModeInfo, VarTypes0),
    lookup_var_type(VarTypes0, Var0, VarType),
    (
        % If the initial inst of the variable matches_final the initial inst
        % specified in the pred's mode declaration, then it's not a call
        % to an implied mode, it's an exact match with a genuine mode.
        inst_matches_initial_no_implied_modes(VarInst1, InitialInst,
            VarType, ModuleInfo0)
    ->
        Var = Var0
    ;
        % This is the implied mode case. We do not yet handle implied modes
        % for partially instantiated vars, since that would require doing
        % a partially instantiated deep copy, and we don't know how to do
        % that yet.

        InitialInst = any(_, _),
        inst_is_free(ModuleInfo0, VarInst1)
    ->
        % This is the simple case of implied `any' modes, where the declared
        % mode was `any -> ...' and the argument passed was `free'.

        Var = Var0,

        % If the variable's type is not a solver type (in which case inst `any'
        % means the same as inst `ground') then this is an implied mode that we
        % don't yet know how to handle.
        %
        % If the variable's type is a solver type then we need to insert a call
        % to the solver type's initialisation predicate. (To avoid unnecessary
        % complications, we avoid doing this if there are any mode errors
        % recorded at this point.)

        mode_info_get_context(!.ModeInfo, Context),
        mode_info_get_mode_context(!.ModeInfo, ModeContext),
        mode_context_to_unify_context(!.ModeInfo, ModeContext, UnifyContext),
        CallUnifyContext = yes(call_unify_context(Var, rhs_var(Var),
            UnifyContext)),
        (
            mode_info_get_errors(!.ModeInfo, ModeErrors),
            ModeErrors = [],
            mode_info_may_init_solver_vars(!.ModeInfo),
            mode_info_solver_init_is_supported(!.ModeInfo),
            type_is_solver_type_with_auto_init(ModuleInfo0, VarType)
        ->
            % Create code to initialize the variable to inst `any',
            % by calling the solver type's initialisation predicate.
            insert_extra_initialisation_call(Var, VarType, InitialInst,
                Context, CallUnifyContext, !ExtraGoals, !ModeInfo)
        ;
            % If the type is a type variable, or isn't a solver type,
            % then give up.
            WaitingVars = set_of_var.make_singleton(Var0),
            ModeError = mode_error_implied_mode(Var0, VarInst0, InitialInst),
            mode_info_error(WaitingVars, ModeError, !ModeInfo)
        )
    ;
        inst_is_bound(ModuleInfo0, InitialInst)
    ->
        % This is the case we can't handle.
        Var = Var0,
        WaitingVars = set_of_var.make_singleton(Var0),
        ModeError = mode_error_implied_mode(Var0, VarInst0, InitialInst),
        mode_info_error(WaitingVars, ModeError, !ModeInfo)
    ;
        % This is the simple case of implied modes,
        % where the declared mode was free -> ...

        % Introduce a new variable.
        mode_info_get_varset(!.ModeInfo, VarSet0),
        varset.new_var(Var, VarSet0, VarSet),
        add_var_type(Var, VarType, VarTypes0, VarTypes),
        mode_info_set_varset(VarSet, !ModeInfo),
        mode_info_set_var_types(VarTypes, !ModeInfo),

        % Construct the code to do the unification.
        create_var_var_unification(Var0, Var, VarType, !.ModeInfo, ExtraGoal),

        % Append the goals together in the appropriate order:
        % ExtraGoals0, then NewUnify.
        NewUnifyExtraGoal = extra_goals([], [ExtraGoal]),
        append_extra_goals(!.ExtraGoals, NewUnifyExtraGoal, !:ExtraGoals)
    ).

%-----------------------------------------------------------------------------%

mode_info_add_goals_live_vars(_ConjType, [], !ModeInfo).
mode_info_add_goals_live_vars(ConjType, [Goal | Goals], !ModeInfo) :-
    % We add the live vars for the goals in the goal list in reverse order,
    % because this ensures that in the common case (where there is no
    % delaying), when we come to remove the live vars for the first goal
    % they will have been added last and will thus be at the start of the list
    % of live vars sets, which makes them cheaper to remove.
    mode_info_add_goals_live_vars(ConjType, Goals, !ModeInfo),
    (
        % Recurse into conjunctions, in case there are any conjunctions
        % that have not been flattened.
        Goal = hlds_goal(conj(ConjType, ConjGoals), _)
    ->
        mode_info_add_goals_live_vars(ConjType, ConjGoals, !ModeInfo)
    ;
        NonLocals = goal_get_nonlocals(Goal),
        mode_info_add_live_vars(NonLocals, !ModeInfo)
    ).

mode_info_remove_goals_live_vars([], !ModeInfo).
mode_info_remove_goals_live_vars([Goal | Goals], !ModeInfo) :-
    (
        % Recurse into conjunctions, in case there are any conjunctions
        % that have not been flattened.
        Goal = hlds_goal(conj(plain_conj, ConjGoals), _)
    ->
        mode_info_remove_goals_live_vars(ConjGoals, !ModeInfo)
    ;
        NonLocals = goal_get_nonlocals(Goal),
        mode_info_remove_live_vars(NonLocals, !ModeInfo)
    ),
    mode_info_remove_goals_live_vars(Goals, !ModeInfo).

%-----------------------------------------------------------------------------%

:- pred insert_extra_initialisation_call(prog_var::in, mer_type::in,
    mer_inst::in, prog_context::in, maybe(call_unify_context)::in,
    extra_goals::in, extra_goals::out, mode_info::in, mode_info::out) is det.

insert_extra_initialisation_call(Var, VarType, Inst, Context, CallUnifyContext,
        !ExtraGoals, !ModeInfo) :-
    construct_initialisation_call(Var, VarType, Inst, Context,
        CallUnifyContext, InitVarGoal, !ModeInfo),
    NewExtraGoal = extra_goals([InitVarGoal], []),
    append_extra_goals(!.ExtraGoals, NewExtraGoal, !:ExtraGoals).

construct_initialisation_calls([], [], !ModeInfo).
construct_initialisation_calls([Var | Vars], [Goal | Goals], !ModeInfo) :-
    mode_info_get_var_types(!.ModeInfo, VarTypes),
    lookup_var_type(VarTypes, Var, VarType),
    InitialInst           = free,
    Context               = term.context_init,
    MaybeCallUnifyContext = no,
    construct_initialisation_call(Var, VarType, InitialInst, Context,
        MaybeCallUnifyContext, Goal, !ModeInfo),
    construct_initialisation_calls(Vars, Goals, !ModeInfo).

construct_initialisation_call(Var, VarType, Inst, Context,
        MaybeCallUnifyContext, InitVarGoal, !ModeInfo) :-
    (
        type_to_ctor(VarType, TypeCtor),
        PredName = special_pred_name(spec_pred_init, TypeCtor),
        (
            TypeCtor = type_ctor(qualified(ModuleName, _TypeName), _Arity)
        ;
            TypeCtor = type_ctor(unqualified(_TypeName), _Arity),
            mode_info_get_module_info(!.ModeInfo, ModuleInfo),
            module_info_get_name(ModuleInfo, ModuleName)
        ),
        NonLocals = set_of_var.make_singleton(Var),
        InstMapDeltaAL = [Var - Inst],
        InstMapDelta = instmap_delta_from_assoc_list(InstMapDeltaAL),
        build_call(ModuleName, PredName, [Var], [VarType], NonLocals,
            InstMapDelta, Context, MaybeCallUnifyContext,
            hlds_goal(GoalExpr, GoalInfo), !ModeInfo)
    ->
        InitVarGoal = hlds_goal(GoalExpr, GoalInfo),
        % If Var was ignored, i.e. it occurred in only one atomic goal
        % and was not in that atomic goal's nonlocals set, then creating
        % the call to the initialisation predicate and adding it to the
        % procedure body requires the addition of Var to the original goal's
        % nonlocals set. This *should* be done by looking at all the places
        % in the compiler that decide to call construct_initialisation_call
        % directly or indirectly, and modifying that code to add Var to
        % the relevant nonlocals set, or possibly by avoiding the call
        % to construct_initialisation_call altogether (after all, if
        % a variable is ignored, it should not need initialization).
        %
        % However, getting a requantify pass to do it for us is less work.
        %
        % An example of code that needs this fix for the correctness of the
        % HLDS is tests/hard_coded/solver_construction_init_test.m.
        mode_info_set_need_to_requantify(need_to_requantify, !ModeInfo)
    ;
        unexpected($module, $pred, "condition failed")
    ).

:- pred build_call(module_name::in, string::in, list(prog_var)::in,
    list(mer_type)::in, set_of_progvar::in, instmap_delta::in,
    prog_context::in, maybe(call_unify_context)::in, hlds_goal::out,
    mode_info::in, mode_info::out) is semidet.

build_call(CalleeModuleName, CalleePredName, ArgVars, ArgTypes, NonLocals,
        InstMapDelta, Context, MaybeCallUnifyContext, Goal, !ModeInfo) :-
    mode_info_get_module_info(!.ModeInfo, ModuleInfo0),

    % Get the relevant information for the procedure we are transforming
    % (i.e., the caller).
    mode_info_get_pred_id(!.ModeInfo, PredId),
    mode_info_get_proc_id(!.ModeInfo, ProcId),
    module_info_pred_proc_info(ModuleInfo0, PredId, ProcId, PredInfo0,
        ProcInfo0),
    pred_info_get_typevarset(PredInfo0, TVarSet),
    pred_info_get_exist_quant_tvars(PredInfo0, ExistQTVars),
    pred_info_get_head_type_params(PredInfo0, HeadTypeParams),

    % Get the pred_info and proc_info for the procedure we are calling.
    SymName = qualified(CalleeModuleName, CalleePredName),
    get_pred_id_and_proc_id_by_types(is_fully_qualified, SymName, pf_predicate,
        TVarSet, ExistQTVars, ArgTypes, HeadTypeParams, ModuleInfo0,
        Context, CalleePredId, CalleeProcId),
    module_info_pred_proc_info(ModuleInfo0, CalleePredId, CalleeProcId,
        CalleePredInfo, CalleeProcInfo),

    % Create a poly_info for the caller.  We have to set the varset and
    % vartypes from the mode_info, not the proc_info, because new vars may
    % have been introduced during mode analysis (e.g., when adding
    % unifications to handle implied modes).
    mode_info_get_varset(!.ModeInfo, VarSet0),
    mode_info_get_var_types(!.ModeInfo, VarTypes0),
    proc_info_set_varset(VarSet0, ProcInfo0, ProcInfo1),
    proc_info_set_vartypes(VarTypes0, ProcInfo1, ProcInfo2),
    polymorphism.create_poly_info(ModuleInfo0, PredInfo0, ProcInfo2,
        PolyInfo0),

    % Create a goal_info for the call.
    goal_info_init(GoalInfo0),
    goal_info_set_context(Context, GoalInfo0, GoalInfo1),
    goal_info_set_nonlocals(NonLocals, GoalInfo1, GoalInfo2),
    goal_info_set_instmap_delta(InstMapDelta, GoalInfo2, GoalInfo),

    % Do the transformation for this call goal.
    SymName = qualified(CalleeModuleName, CalleePredName),
    polymorphism_process_new_call(CalleePredInfo, CalleeProcInfo,
        CalleePredId, CalleeProcId, ArgVars, not_builtin,
        MaybeCallUnifyContext, SymName, GoalInfo, Goal, PolyInfo0, PolyInfo),

    % Update the information in the predicate table.
    polymorphism.poly_info_extract(PolyInfo, PredInfo0, PredInfo,
        ProcInfo2, ProcInfo, ModuleInfo1),
    module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo,
        ModuleInfo1, ModuleInfo),

    % Update the information in the mode_info.
    proc_info_get_varset(ProcInfo, VarSet),
    proc_info_get_vartypes(ProcInfo, VarTypes),
    mode_info_set_varset(VarSet, !ModeInfo),
    mode_info_set_var_types(VarTypes, !ModeInfo),
    mode_info_set_module_info(ModuleInfo, !ModeInfo).

prepend_initialisation_call(Var, VarType, InitialInst, Goal0, Goal,
        !ModeInfo) :-
    Goal0   = hlds_goal(_GoalExpr0, GoalInfo0),
    Context = goal_info_get_context(GoalInfo0),
    CallUnifyContext = no,
    construct_initialisation_call(Var, VarType, InitialInst, Context,
        CallUnifyContext, InitVarGoal, !ModeInfo),
    goal_to_conj_list(Goal0, ConjList0),
    conj_list_to_goal([InitVarGoal | ConjList0], GoalInfo0, Goal).

%-----------------------------------------------------------------------------%

mode_context_to_unify_context(_ModeInfo, ModeContext, UnifyContext) :-
    (
        ModeContext = mode_context_unify(UnifyContext, _)
    ;
        ModeContext = mode_context_call(CallId, Arg),
        UnifyContext = unify_context(umc_call(CallId, Arg), [])
    ;
        ModeContext = mode_context_uninitialized,
        unexpected($module, $pred, "uninitialized context")
    ).

%-----------------------------------------------------------------------------%

get_live_vars([], [], []).
get_live_vars([_ | _], [], _) :-
    unexpected($module, $pred, "length mismatch").
get_live_vars([], [_ | _], _) :-
    unexpected($module, $pred, "length mismatch").
get_live_vars([Var | Vars], [IsLive | IsLives], LiveVars) :-
    (
        IsLive = is_live,
        LiveVars = [Var | LiveVars0]
    ;
        IsLive = is_dead,
        LiveVars = LiveVars0
    ),
    get_live_vars(Vars, IsLives, LiveVars0).

%-----------------------------------------------------------------------------%
:- end_module check_hlds.modecheck_util.
%-----------------------------------------------------------------------------%