%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2005-2012 The University of Melbourne.
% Copyright (C) 2014-2021 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: superhomogeneous.m.
% Main author of the original version of this module: fjh.
% Main author of the current version of this module: zs.
%
% This module performs the conversion of clause bodies
% to superhomogeneous form.
%
% XXX The code in this module should follow a consistent naming convention
% to distinguish
%
% - variables that refer to goals in the term we are parsing from
% - variables that refer to goals in the HLDS we are building.
%
%-----------------------------------------------------------------------------%

:- module hlds.make_hlds.superhomogeneous.
:- interface.

:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module hlds.make_hlds.qual_info.
:- import_module hlds.make_hlds.state_var.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.
:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.

:- import_module list.

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

:- type arg_context
    --->    ac_head(pred_or_func, arity)
            % The arguments in the head of the clause.

    ;       ac_call(call_id)
            % The arguments in a call to a predicate.

    ;       ac_functor(            % The arguments in a functor.
                cons_id,
                unify_main_context,
                unify_sub_contexts
            ).

    % A variable and a term it is to be unified with.
:- type unify_var_term
    --->    unify_var_term(prog_var, prog_term).

    % A variable and a term it is to be unified with, and information
    % about where the unification is taking place: the argument number
    % in a call, and the context of that argument.
:- type unify_var_term_num_context
    --->    unify_var_term_num_context(prog_var, prog_term, int, arg_context).

:- func unify_var_term_project_var(unify_var_term) = prog_var.

:- pred pair_vars_with_terms(list(prog_var)::in, list(prog_term)::in,
    list(unify_var_term)::out) is det.

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

    % `insert_arg_unifications' takes a list of variables, a list of terms
    % to unify them with, and a goal, and inserts the appropriate unifications
    % onto the front of the goal. It calls `unravel_unification' to ensure that
    % each unification gets reduced to superhomogeneous form. It also gets
    % passed an `arg_context', which indicates where the terms came from.
    %
    % We never insert unifications of the form X = X.
    %
    % XXX We should have versions of these predicates that take the variables
    % and the terms to unify them as a single assoc_list, instead of taking
    % them as two separate lists whose lengths must be equal, but may not be.
    %
:- pred insert_arg_unifications(list(unify_var_term)::in,
    prog_context::in, arg_context::in, hlds_goal::in, hlds_goal::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out,
    module_info::in, module_info::out, qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

:- pred insert_arg_unifications_with_contexts(
    list(unify_var_term_num_context)::in,
    prog_context::in, hlds_goal::in, hlds_goal::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out, module_info::in, module_info::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

:- pred unravel_unification(prog_term::in, prog_term::in, prog_context::in,
    unify_main_context::in, unify_sub_contexts::in, purity::in, hlds_goal::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out,
    module_info::in, module_info::out, qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

    % make_fresh_arg_vars_subst_svars(Args, Vars, VarsArgs,
    %   !VarSet, !SVarState, !Specs):
    %
    % Ensure we have a distinct variable for each term in Args.
    % Return a list of these variables in Vars, and return lists of each Var
    % and Arg packaged together in VarsArgs. (Almost all of our callers
    % want both.)
    %
    % For each term in Args, if the term is a variable V which is distinct
    % from the variables already produced, then use just V as the distinct
    % variable paired with the term in VarsArgs. If it isn't, we pair the term
    % with a fresh variable we allocate from !VarSet.
    % XXX The use of "fresh" in the name of this predicate implies
    % that we never just use V, which is misleading.
    %
    % !:VarSet will be the varset resulting after all the necessary variables
    % have been allocated. If any of the Args is of the form !.S or !:S,
    % we do state var substitution for them. We need !SVarState for correct
    % state var references, and !Specs for incorrect state var references.
    %
:- pred make_fresh_arg_vars_subst_svars(list(prog_term)::in,
    list(prog_var)::out, list(unify_var_term)::out,
    prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
    list(error_spec)::in, list(error_spec)::out) is det.

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

:- implementation.

:- import_module check_hlds.
:- import_module check_hlds.mode_test.
:- import_module check_hlds.mode_util.
:- import_module hlds.from_ground_term_util.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_cons.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_goal.
:- import_module hlds.make_goal.
:- import_module hlds.make_hlds.field_access.
:- import_module hlds.make_hlds.goal_expr_to_goal.
:- import_module hlds.passes_aux.
:- import_module libs.
:- import_module libs.globals.  % for get_maybe_from_ground_term_threshold
:- import_module libs.options.  % for warn_suspected_occurs_check_failure
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.maybe_error.
:- import_module parse_tree.module_qual.
:- import_module parse_tree.parse_dcg_goal.
:- import_module parse_tree.parse_goal.
:- import_module parse_tree.parse_inst_mode_name.
:- import_module parse_tree.parse_sym_name.
:- import_module parse_tree.parse_tree_out_term.
:- import_module parse_tree.parse_type_name.
:- import_module parse_tree.parse_util.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
:- import_module parse_tree.set_of_var.

:- import_module bool.
:- import_module cord.
:- import_module int.
:- import_module integer.
:- import_module io.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module term.
:- import_module varset.

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

unify_var_term_project_var(unify_var_term(Var, _)) = Var.

pair_vars_with_terms([], [], []).
pair_vars_with_terms([], [_ | _], _) :-
    unexpected($pred, "length mismatch").
pair_vars_with_terms([_ | _], [], _) :-
    unexpected($pred, "length mismatch").
pair_vars_with_terms([Var | Vars], [Term | Terms], [VarTerm | VarsTerms]) :-
    VarTerm = unify_var_term(Var, Term),
    pair_vars_with_terms(Vars, Terms, VarsTerms).

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

insert_arg_unifications(XVarsArgTerms0, Context, ArgContext, Goal0, Goal,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
    substitute_state_var_mappings_unify_var_term(XVarsArgTerms0, XVarsArgTerms,
        !VarSet, !SVarState, !Specs),
    map.init(AncestorVarMap),
    do_arg_unifications(XVarsArgTerms, Context, ArgContext,
        construct_bottom_up, 1, AncestorVarMap, Expansions,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
    Goal0 = hlds_goal(_, GoalInfo0),
    insert_expansions_before_goal_top_not_fgti(GoalInfo0, Expansions,
        Goal0, Goal).

insert_arg_unifications_with_contexts(XVarsArgTermsArgNumsContexts0,
        Context, Goal0, Goal,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
    substitute_state_var_mappings_unify_var_term_num_context(
        XVarsArgTermsArgNumsContexts0, XVarsArgTermsArgNumsContexts,
        !VarSet, !SVarState, !Specs),
    map.init(AncestorVarMap),
    do_arg_unifications_with_contexts(XVarsArgTermsArgNumsContexts,
        Context, construct_bottom_up, AncestorVarMap, Expansions,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
    Goal0 = hlds_goal(_, GoalInfo0),
    insert_expansions_before_goal_top_not_fgti(GoalInfo0, Expansions,
        Goal0, Goal).

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

:- pred substitute_state_var_mappings_unify_var_term(
    list(unify_var_term)::in, list(unify_var_term)::out,
    prog_varset::in, prog_varset::out,
    svar_state::in, svar_state::out,
    list(error_spec)::in, list(error_spec)::out) is det.

substitute_state_var_mappings_unify_var_term([], [], !VarSet, !State, !Specs).
substitute_state_var_mappings_unify_var_term([UVT0 | UVTs0], [UVT | UVTs],
        !VarSet, !State, !Specs) :-
    UVT0 = unify_var_term(Var, Arg0),
    substitute_state_var_mapping(Arg0, Arg, !VarSet, !State, !Specs),
    UVT = unify_var_term(Var, Arg),
    substitute_state_var_mappings_unify_var_term(UVTs0, UVTs,
        !VarSet, !State, !Specs).

:- pred substitute_state_var_mappings_unify_var_term_num_context(
    list(unify_var_term_num_context)::in,
        list(unify_var_term_num_context)::out,
    prog_varset::in, prog_varset::out,
    svar_state::in, svar_state::out,
    list(error_spec)::in, list(error_spec)::out) is det.

substitute_state_var_mappings_unify_var_term_num_context([], [],
        !VarSet, !State, !Specs).
substitute_state_var_mappings_unify_var_term_num_context(
        [UVTNC0 | UVTNCs0], [UVTNC | UVTNCs], !VarSet, !State, !Specs) :-
    UVTNC0 = unify_var_term_num_context(Var, Arg0, ArgNum, ArgContext),
    substitute_state_var_mapping(Arg0, Arg, !VarSet, !State, !Specs),
    UVTNC = unify_var_term_num_context(Var, Arg, ArgNum, ArgContext),
    substitute_state_var_mappings_unify_var_term_num_context(UVTNCs0, UVTNCs,
        !VarSet, !State, !Specs).

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

unravel_unification(LHS0, RHS0, Context, MainContext, SubContext, Purity,
        Goal, !SVarState, !SVarStore, !VarSet,
        !ModuleInfo, !QualInfo, !Specs) :-
    (
        Purity = purity_pure,
        Order = deconstruct_top_down
    ;
        ( Purity = purity_semipure
        ; Purity = purity_impure
        ),
        Order = construct_bottom_up
    ),
    do_unravel_unification(LHS0, RHS0, Context, MainContext, SubContext,
        Purity, Order, Expansion,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
    goal_info_init(Context, GoalInfo),
    expansion_to_goal_wrap_if_fgti(GoalInfo, Expansion, Goal).

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

:- type maybe_fgti_var_size
    --->    not_fgti
    ;       fgti_var_size(prog_var, int).

:- type expansion
    --->    expansion(
                maybe_fgti_var_size,
                cord(hlds_goal)
            ).

:- type ancestor_var_map == map(prog_var, prog_context).

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

:- pred expansion_to_goal_wrap_if_fgti(hlds_goal_info::in, expansion::in,
    hlds_goal::out) is det.

expansion_to_goal_wrap_if_fgti(GoalInfo, Expansion, Goal) :-
    Expansion = expansion(MaybeFGTI, ExpansionGoalCord),
    ExpansionGoals = cord.list(ExpansionGoalCord),
    (
        ExpansionGoals = [],
        Goal = hlds_goal(true_goal_expr, GoalInfo)
    ;
        ExpansionGoals = [ExpansionGoal0],
        ExpansionGoal0 = hlds_goal(ExpansionGoalExpr, ExpansionGoalInfo0),
        Context = goal_info_get_context(GoalInfo),
        goal_info_set_context(Context, ExpansionGoalInfo0, ExpansionGoalInfo),
        Goal = hlds_goal(ExpansionGoalExpr, ExpansionGoalInfo)
    ;
        ExpansionGoals = [_, _ | _],
        ( if
            MaybeFGTI = fgti_var_size(TermVar, Size),
            get_maybe_from_ground_term_threshold = yes(Threshold),
            Size >= Threshold
        then
            goal_info_set_nonlocals(set_of_var.make_singleton(TermVar),
                GoalInfo, MarkedGoalInfo),
            mark_nonlocals_in_ground_term_initial(ExpansionGoals, MarkedGoals),
            ConjGoalExpr = conj(plain_conj, MarkedGoals),
            ConjGoal = hlds_goal(ConjGoalExpr, MarkedGoalInfo),
            Reason = from_ground_term(TermVar, from_ground_term_initial),
            GoalExpr = scope(Reason, ConjGoal),
            Goal = hlds_goal(GoalExpr, MarkedGoalInfo)
        else
            GoalExpr = conj(plain_conj, ExpansionGoals),
            Goal = hlds_goal(GoalExpr, GoalInfo)
        )
    ).

:- pred expansion_to_goal_cord_wrap_if_fgti(hlds_goal_info::in, expansion::in,
    cord(hlds_goal)::out) is det.

expansion_to_goal_cord_wrap_if_fgti(GoalInfo, Expansion,
        MaybeWrappedGoalCord) :-
    Expansion = expansion(MaybeFGTI, GoalCord),
    ( if
        MaybeFGTI = fgti_var_size(TermVar, Size),
        get_maybe_from_ground_term_threshold = yes(Threshold),
        Size >= Threshold
    then
        Goals = cord.list(GoalCord),
        goal_info_set_nonlocals(set_of_var.make_singleton(TermVar),
            GoalInfo, MarkedGoalInfo),
        mark_nonlocals_in_ground_term_initial(Goals, MarkedGoals),
        ConjGoalExpr = conj(plain_conj, MarkedGoals),
        ConjGoal = hlds_goal(ConjGoalExpr, MarkedGoalInfo),
        Reason = from_ground_term(TermVar, from_ground_term_initial),
        ScopeGoalExpr = scope(Reason, ConjGoal),
        ScopeGoal = hlds_goal(ScopeGoalExpr, MarkedGoalInfo),
        MaybeWrappedGoalCord = cord.singleton(ScopeGoal)
    else
        MaybeWrappedGoalCord = GoalCord
    ).

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

mark_nonlocals_in_ground_term_initial([], []).
mark_nonlocals_in_ground_term_initial([Goal0 | Goals0], [Goal | Goals]) :-
    Goal0 = hlds_goal(GoalExpr, GoalInfo0),
    ( if
        GoalExpr = unify(LHSVar, RHS, _, _, _),
        RHS = rhs_functor(_, _, RHSVars)
    then
        set_of_var.list_to_set([LHSVar | RHSVars], NonLocals),
        goal_info_set_nonlocals(NonLocals, GoalInfo0, GoalInfo),
        Goal = hlds_goal(GoalExpr, GoalInfo)
    else
        unexpected($pred, "wrong shape goal")
    ),
    mark_nonlocals_in_ground_term_initial(Goals0, Goals).

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

:- pred insert_expansion_before_goal_top_not_fgti(hlds_goal_info::in,
    expansion::in, hlds_goal::in, hlds_goal::out) is det.

insert_expansion_before_goal_top_not_fgti(GoalInfo, Expansion, BaseGoal,
        Goal) :-
    goal_to_conj_list(BaseGoal, BaseGoals),
    expansion_to_goal_cord_wrap_if_fgti(GoalInfo, Expansion,
        ExpansionGoalCord),
    ExpansionGoals = cord.list(ExpansionGoalCord),
    conj_list_to_goal(ExpansionGoals ++ BaseGoals, GoalInfo, Goal).

:- pred insert_expansions_before_goal_top_not_fgti(hlds_goal_info::in,
    list(expansion)::in, hlds_goal::in, hlds_goal::out) is det.

insert_expansions_before_goal_top_not_fgti(GoalInfo, Expansions, BaseGoal,
        Goal) :-
    goal_to_conj_list(BaseGoal, BaseGoals),
    list.map(expansion_to_goal_cord_wrap_if_fgti(GoalInfo), Expansions,
        ExpansionGoalCords),
    ExpansionGoals = cord.cord_list_to_list(ExpansionGoalCords),
    conj_list_to_goal(ExpansionGoals ++ BaseGoals, GoalInfo, Goal).

:- pred append_expansions_after_goal_top_ftgi(hlds_goal_info::in, prog_var::in,
    hlds_goal::in, int::in, list(expansion)::in, expansion::out) is det.

append_expansions_after_goal_top_ftgi(GoalInfo, TermVar,
        BaseGoal, BaseGoalSize, ArgExpansions, Expansion) :-
    append_expansions_after_goal_top_ftgi_loop(ArgExpansions, yes, AllFGTI,
        BaseGoalSize, TotalSize),
    (
        AllFGTI = no,
        list.map(expansion_to_goal_cord_wrap_if_fgti(GoalInfo),
            ArgExpansions, ArgGoalCords),
        ArgGoalsCord = cord.cord_list_to_cord(ArgGoalCords),
        % XXX If BaseGoal can be a plain_conj, then we should expand it here.
        GoalCord = cord.cons(BaseGoal, ArgGoalsCord),
        Expansion = expansion(not_fgti, GoalCord)
    ;
        AllFGTI = yes,
        list.map(project_expansion_goals, ArgExpansions, ArgGoalCords),
        ArgGoalsCord = cord.cord_list_to_cord(ArgGoalCords),
        % XXX If BaseGoal can be a plain_conj, then we should expand it here.
        GoalCord = cord.cons(BaseGoal, ArgGoalsCord),
        Expansion = expansion(fgti_var_size(TermVar, TotalSize), GoalCord)
    ).

:- pred append_expansions_after_goal_top_ftgi_loop(list(expansion)::in,
    bool::in, bool::out, int::in, int::out) is det.

append_expansions_after_goal_top_ftgi_loop([], !AllFGTI, !TotalSize).
append_expansions_after_goal_top_ftgi_loop([Expansion | Expansions],
        !AllFGTI, !TotalSize) :-
    Expansion = expansion(MaybeFGTI, _),
    (
        MaybeFGTI = not_fgti,
        !:AllFGTI = no
    ;
        MaybeFGTI = fgti_var_size(_, Size),
        !:TotalSize = !.TotalSize + Size
    ),
    append_expansions_after_goal_top_ftgi_loop(Expansions,
        !AllFGTI, !TotalSize).

:- pred project_expansion_goals(expansion::in, cord(hlds_goal)::out)
    is det.

project_expansion_goals(expansion(_, GoalCord), GoalCord).

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

:- pred do_arg_unifications(list(unify_var_term)::in,
    prog_context::in, arg_context::in,
    goal_order::in, int::in, ancestor_var_map::in, list(expansion)::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out, module_info::in, module_info::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

do_arg_unifications([], _Context, _ArgContext, _Order, _ArgNum,
        _AncestorVarMap, [],
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).
do_arg_unifications([unify_var_term(XVar, YTerm) | XVarsYTerms],
        Context, ArgContext, Order, ArgNum,
        AncestorVarMap, [Expansion | Expansions],
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
    do_arg_unification(XVar, YTerm, Context, ArgContext, Order, ArgNum,
        AncestorVarMap, Expansion,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
    do_arg_unifications(XVarsYTerms, Context, ArgContext, Order, ArgNum + 1,
        AncestorVarMap, Expansions,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).

:- pred do_arg_unifications_with_fresh_vars(list(prog_term)::in,
    prog_context::in, arg_context::in, goal_order::in, int::in,
    list(prog_var)::in, ancestor_var_map::in,
    list(prog_var)::out, list(expansion)::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out, module_info::in, module_info::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

do_arg_unifications_with_fresh_vars([], _Context, _ArgContext,
        _Order, _ArgNum, _SeenXVars, _AncestorVarMap, [], [],
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).
do_arg_unifications_with_fresh_vars([YTerm | YTerms], Context, ArgContext,
        Order, ArgNum, !.SeenXVars, AncestorVarMap,
        [XVar | XVars], [Expansion | Expansions],
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
    make_fresh_arg_var_no_svar(YTerm, XVar, !.SeenXVars, !VarSet),
    !:SeenXVars = [XVar | !.SeenXVars],
    do_arg_unification(XVar, YTerm, Context, ArgContext, Order,
        ArgNum, AncestorVarMap, Expansion,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
    do_arg_unifications_with_fresh_vars(YTerms, Context, ArgContext, Order,
        ArgNum + 1, !.SeenXVars, AncestorVarMap, XVars, Expansions,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).

:- pred do_arg_unifications_with_contexts(list(unify_var_term_num_context)::in,
    prog_context::in, goal_order::in, ancestor_var_map::in,
    list(expansion)::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out, module_info::in, module_info::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

do_arg_unifications_with_contexts([], _Context, _Order, _AncestorVarMap, [],
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).
do_arg_unifications_with_contexts(
        [HeadXVarYTermArgContext | TailXVarsYTermsArgContexts],
        Context, Order, AncestorVarMap, Expansions,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
    HeadXVarYTermArgContext = unify_var_term_num_context(HeadXVar,
        HeadYTerm, HeadArgNumber, HeadArgContext),
    do_arg_unification(HeadXVar, HeadYTerm, Context, HeadArgContext, Order,
        HeadArgNumber, AncestorVarMap, HeadExpansion, !SVarState, !SVarStore,
        !VarSet, !ModuleInfo, !QualInfo, !Specs),
    do_arg_unifications_with_contexts(TailXVarsYTermsArgContexts,
        Context, Order, AncestorVarMap, TailExpansions,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
    Expansions = [HeadExpansion | TailExpansions].

:- pred do_arg_unification(prog_var::in, prog_term::in,
    prog_context::in, arg_context::in,
    goal_order::in, int::in, ancestor_var_map::in, expansion::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out, module_info::in, module_info::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

do_arg_unification(XVar, YTerm, Context, ArgContext, Order, ArgNum,
        !.AncestorVarMap, Expansion, !SVarState, !SVarStore,
        !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
    % It is the caller's job to make sure that if needed, then both
    % XVar and the top level of YTerm have already been through
    % state var mapping expansion.
    occurs_check(!.ModuleInfo, !.VarSet, !.AncestorVarMap, XVar, !Specs),
    (
        YTerm = term.variable(YVar, YVarContext),
        ( if XVar = YVar then
            % Skip unifications of the form `XVar = XVar'.
            GoalCord = cord.init
        else
            arg_context_to_unify_context(ArgContext, ArgNum,
                MainContext, SubContext),
            make_atomic_unification(XVar, rhs_var(YVar), YVarContext,
                MainContext, SubContext, purity_pure, Goal, !QualInfo),
            GoalCord = cord.singleton(Goal)
        ),
        Expansion = expansion(not_fgti, GoalCord)
    ;
        YTerm = term.functor(YFunctor, YArgTerms, YFunctorContext),
        arg_context_to_unify_context(ArgContext, ArgNum,
            MainContext, SubContext),
        unravel_var_functor_unification(XVar, YFunctor, YArgTerms,
            YFunctorContext, Context, MainContext, SubContext, purity_pure,
            Order, !.AncestorVarMap, Expansion, !SVarState, !SVarStore,
            !VarSet, !ModuleInfo, !QualInfo, !Specs)
    ).

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

:- pred do_unravel_unification(prog_term::in, prog_term::in,
    prog_context::in, unify_main_context::in, unify_sub_contexts::in,
    purity::in, goal_order::in, expansion::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out, module_info::in, module_info::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

do_unravel_unification(LHS0, RHS0, Context, MainContext, SubContext,
        Purity, Order, Expansion, !SVarState, !SVarStore, !VarSet,
        !ModuleInfo, !QualInfo, !Specs) :-
    substitute_state_var_mapping(LHS0, LHS, !VarSet, !SVarState, !Specs),
    substitute_state_var_mapping(RHS0, RHS, !VarSet, !SVarState, !Specs),
    classify_unravel_unification(LHS, RHS,
        Context, MainContext, SubContext, Purity, Order, map.init, Expansion,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).

:- pred do_unravel_var_unification(prog_var::in, prog_term::in,
    prog_context::in, unify_main_context::in, unify_sub_contexts::in,
    purity::in, goal_order::in, expansion::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out, module_info::in, module_info::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

do_unravel_var_unification(LHSVar, RHS0, Context, MainContext, SubContext,
        Purity, Order, Expansion, !SVarState, !SVarStore, !VarSet,
        !ModuleInfo, !QualInfo, !Specs) :-
    substitute_state_var_mapping(RHS0, RHS, !VarSet, !SVarState, !Specs),
    classify_unravel_var_unification(LHSVar, RHS,
        Context, MainContext, SubContext, Purity, Order, map.init, Expansion,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs).

:- pred classify_unravel_unification(prog_term::in, prog_term::in,
    prog_context::in, unify_main_context::in, unify_sub_contexts::in,
    purity::in, goal_order::in, ancestor_var_map::in, expansion::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out, module_info::in, module_info::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

classify_unravel_unification(XTerm, YTerm, Context, MainContext, SubContext,
        Purity, Order, !.AncestorVarMap, Expansion, !SVarState, !SVarStore,
        !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
    (
        % `X = Y' needs no unravelling.
        XTerm = term.variable(XVar, _),
        YTerm = term.variable(YVar, _),
        make_atomic_unification(XVar, rhs_var(YVar), Context, MainContext,
            SubContext, Purity, Goal, !QualInfo),
        Expansion = expansion(not_fgti, cord.singleton(Goal))
    ;
        XTerm = term.variable(XVar, _),
        YTerm = term.functor(YFunctor, YArgTerms, YFunctorContext),
        unravel_var_functor_unification(XVar, YFunctor, YArgTerms,
            YFunctorContext, Context, MainContext, SubContext,
            Purity, Order, !.AncestorVarMap, Expansion, !SVarState, !SVarStore,
            !VarSet, !ModuleInfo, !QualInfo, !Specs)
    ;
        XTerm = term.functor(XFunctor, XArgTerms, XFunctorContext),
        YTerm = term.variable(YVar, _),
        unravel_var_functor_unification(YVar, XFunctor, XArgTerms,
            XFunctorContext, Context, MainContext, SubContext,
            Purity, Order, !.AncestorVarMap, Expansion, !SVarState, !SVarStore,
            !VarSet, !ModuleInfo, !QualInfo, !Specs)
    ;
        % If we find a unification of the form `f1(...) = f2(...)',
        % then we replace it with `Tmp = f1(...), Tmp = f2(...)',
        % and then process it according to the rules above.
        % Note that we can't simplify it yet, e.g. by pairwise unifying
        % the args of XTerm and YTerm, because we might simplify away
        % type errors.
        XTerm = term.functor(XFunctor, XArgTerms, XFunctorContext),
        YTerm = term.functor(YFunctor, YArgTerms, YFunctorContext),
        varset.new_var(TmpVar, !VarSet),
        % TmpVar cannot occur in either XTerm or YTerm, so adding it
        % to !AncestorVarMap would not result in any hits, and would only
        % slow down lookups.
        unravel_var_functor_unification(TmpVar, XFunctor, XArgTerms,
            XFunctorContext, Context, MainContext, SubContext,
            Purity, Order, !.AncestorVarMap, ExpansionX,
            !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
        unravel_var_functor_unification(TmpVar, YFunctor, YArgTerms,
            YFunctorContext, Context, MainContext, SubContext,
            Purity, Order, !.AncestorVarMap, ExpansionY,
            !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
        goal_info_init(Context, GoalInfo),
        expansion_to_goal_cord_wrap_if_fgti(GoalInfo, ExpansionX,
            MaybeWrappedGoalCordX),
        expansion_to_goal_cord_wrap_if_fgti(GoalInfo, ExpansionY,
            MaybeWrappedGoalCordY),
        GoalCord = MaybeWrappedGoalCordX ++ MaybeWrappedGoalCordY,
        Expansion = expansion(not_fgti, GoalCord)
    ).

:- pred classify_unravel_var_unification(prog_var::in, prog_term::in,
    prog_context::in, unify_main_context::in, unify_sub_contexts::in,
    purity::in, goal_order::in, ancestor_var_map::in, expansion::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out, module_info::in, module_info::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

classify_unravel_var_unification(XVar, YTerm, Context, MainContext, SubContext,
        Purity, Order, AncestorVarMap, Expansion, !SVarState, !SVarStore,
        !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
    (
        % `X = Y' needs no unravelling.
        YTerm = term.variable(YVar, _),
        occurs_check(!.ModuleInfo, !.VarSet, AncestorVarMap, YVar, !Specs),
        make_atomic_unification(XVar, rhs_var(YVar), Context, MainContext,
            SubContext, Purity, Goal, !QualInfo),
        Expansion = expansion(not_fgti, cord.singleton(Goal))
    ;
        YTerm = term.functor(YFunctor, YArgTerms, YFunctorContext),
        unravel_var_functor_unification(XVar, YFunctor, YArgTerms,
            YFunctorContext, Context, MainContext, SubContext,
            Purity, Order, AncestorVarMap, Expansion, !SVarState, !SVarStore,
            !VarSet, !ModuleInfo, !QualInfo, !Specs)
    ).

    % Given an unification of the form
    %   X = f(ArgTerm1, ArgTerm2, ArgTerm3)
    % we replace it with
    %   X = f(NewVar1, NewVar2, NewVar3),
    %   NewVar1 = ArgTerm1,
    %   NewVar2 = ArgTerm2,
    %   NewVar3 = ArgTerm3.
    % In the trivial case `X = c', no unravelling occurs.
    %
    % XXX We could do better on the error messages for lambda expressions
    % and field extraction and update expressions.
    %
:- pred unravel_var_functor_unification(prog_var::in, term.const::in,
    list(prog_term)::in, term.context::in,
    prog_context::in, unify_main_context::in, unify_sub_contexts::in,
    purity::in, goal_order::in, ancestor_var_map::in, expansion::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out, module_info::in, module_info::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

unravel_var_functor_unification(XVar, YFunctor, YArgTerms0, YFunctorContext,
        Context, MainContext, SubContext,
        Purity, Order, !.AncestorVarMap, Expansion,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
    substitute_state_var_mappings(YArgTerms0, YArgTerms, !VarSet,
        !SVarState, !Specs),
    ( if
        YFunctor = term.atom(YAtom),
        maybe_unravel_special_var_functor_unification(XVar, YAtom, YArgTerms,
            YFunctorContext, Context, MainContext, SubContext, Purity,
            Order, ExpansionPrime, !SVarState, !SVarStore, !VarSet,
            !ModuleInfo, !QualInfo, !Specs)
    then
        Expansion = ExpansionPrime
    else
        % Handle the usual case.
        ( if
            % The condition of this if-then-else is based on the logic of
            % try_parse_sym_name_and_args, but specialized to this location,
            % so that we can do state var expansion only if we need to.
            YFunctor = term.atom(YAtom),
            ( if
                YAtom = ".",
                YArgTerms = [ModuleNameTerm, NameArgsTerm]
            then
                NameArgsTerm = term.functor(term.atom(Name), NameArgTerms, _),
                try_parse_symbol_name(ModuleNameTerm, ModuleName),
                FunctorName = qualified(ModuleName, Name),
                % We have done state variable name expansion at the top
                % level of Args, but not at the level of NameArgTerms.
                substitute_state_var_mappings(NameArgTerms,
                    MaybeQualifiedYArgTermsPrime, !VarSet, !SVarState, !Specs)
            else
                FunctorName = string_to_sym_name_sep(YAtom, "__"),
                MaybeQualifiedYArgTermsPrime = YArgTerms
            )
        then
            MaybeQualifiedYArgTerms = MaybeQualifiedYArgTermsPrime,
            list.length(MaybeQualifiedYArgTerms, Arity),
            ConsId = cons(FunctorName, Arity, cons_id_dummy_type_ctor)
        else
            % If YFunctor is a numeric or string constant, it *should*
            % have no arguments. If it nevertheless does, we still record
            % its arguments, and let the error be caught later during
            % typechecking.
            parse_ordinary_cons_id(!.VarSet, YFunctor, YArgTerms,
                YFunctorContext, ConsId, !Specs),
            MaybeQualifiedYArgTerms = YArgTerms
        ),
        build_var_cons_id_unification(XVar, ConsId, MaybeQualifiedYArgTerms,
            YFunctorContext, Context, MainContext, SubContext, Purity,
            !.AncestorVarMap, Expansion,
            !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs)
    ).

:- pred build_var_cons_id_unification(prog_var::in, cons_id::in,
    list(prog_term)::in, term.context::in, prog_context::in,
    unify_main_context::in, unify_sub_contexts::in, purity::in,
    ancestor_var_map::in, expansion::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out, module_info::in, module_info::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

build_var_cons_id_unification(XVar, ConsId, MaybeQualifiedYArgTerms,
        YFunctorContext, Context, MainContext, SubContext, Purity,
        !.AncestorVarMap, Expansion,
        !SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
    % Our caller has done state variable name expansion
    % at the top level of MaybeQualifiedYArgTerms.
    (
        MaybeQualifiedYArgTerms = [],
        RHS = rhs_functor(ConsId, is_not_exist_constr, []),
        make_atomic_unification(XVar, RHS, YFunctorContext,
            MainContext, SubContext, Purity, FunctorGoal, !QualInfo),
        goal_set_purity(Purity, FunctorGoal, Goal),
        Expansion = expansion(fgti_var_size(XVar, 1), cord.singleton(Goal))
    ;
        MaybeQualifiedYArgTerms = [_ | _],
        ArgContext = ac_functor(ConsId, MainContext, SubContext),
        maybe_add_to_ancestor_var_map(!.ModuleInfo, XVar, ConsId, Context,
            !AncestorVarMap),
        (
            Purity = purity_pure,
            % If we can, we want to add the unifications for the arguments
            % AFTER the unification of the top level function symbol,
            % because otherwise we get efficiency problems during
            % type-checking.
            do_arg_unifications_with_fresh_vars(MaybeQualifiedYArgTerms,
                YFunctorContext, ArgContext, deconstruct_top_down, 1,
                [], !.AncestorVarMap, YVars, ArgExpansions,
                !SVarState, !SVarStore, !VarSet,
                !ModuleInfo, !QualInfo, !Specs),
            RHS = rhs_functor(ConsId, is_not_exist_constr, YVars),
            make_atomic_unification(XVar, RHS, YFunctorContext,
                MainContext, SubContext, Purity, FunctorGoal, !QualInfo),
            goal_info_init(Context, GoalInfo),
            append_expansions_after_goal_top_ftgi(GoalInfo, XVar,
                FunctorGoal, 1, ArgExpansions, Expansion)
        ;
            ( Purity = purity_semipure
            ; Purity = purity_impure
            ),
            % For impure unifications, we need to put the unifications
            % for the arguments BEFORE the unification of the top level
            % function symbol, because mode reordering can't reorder
            % code around that unification.
            do_arg_unifications_with_fresh_vars(MaybeQualifiedYArgTerms,
                YFunctorContext, ArgContext, construct_bottom_up, 1,
                [], !.AncestorVarMap, YVars, ArgExpansions,
                !SVarState, !SVarStore, !VarSet,
                !ModuleInfo, !QualInfo, !Specs),
            RHS = rhs_functor(ConsId, is_not_exist_constr, YVars),
            make_atomic_unification(XVar, RHS, YFunctorContext,
                MainContext, SubContext, Purity, FunctorGoal, !QualInfo),
            goal_info_init(Context, GoalInfo),
            insert_expansions_before_goal_top_not_fgti(GoalInfo,
                ArgExpansions, FunctorGoal, Goal0),
            goal_set_purity(Purity, Goal0, Goal),
            Expansion = expansion(not_fgti, cord.singleton(Goal))
        )
    ).

    % Add the variable on the left side of the var-functor unification
    % XVar = ConsId(...) to the ancestor var map *if* it can be part of
    % an occurs check violation we want to report.
    %
    % - The occurs check cannot be violated if ConsId is a constant.
    %
    % - If ConsId cannot actually be a data constructor, then this unification
    %   cannot be part of an occurs check violation we want to report.
    %   There are four possibilities:
    %
    %   1 ConsId(...) is a full application of a function, which returns
    %     a piece of data. Even if XVar occurs somewhere inside the
    %     arguments of ConsId, checking whether XVar is equal to the
    %     value computed from it is a perfectly legitimate test.
    %
    %   2 ConsId(...) is a partial application of a function or a predicate,
    %     and XVar's type is the higher order type matching the type
    %     of this closure. This case *would* be a perfectly legitimate
    %     equality test like case 1, were it not for the fact that unification
    %     of higher order values is not allowed (because it is an undecidable
    %     problem). This should therefore be detected as a type error.
    %
    %   3 ConsId(...) is a partial application of a function or a predicate,
    %     and XVar's type is not the higher order type matching the type
    %     of this closure. This is a more straightforward type error.
    %
    %   4 ConsId is not a function or a predicate. This is a straightforward
    %     "unknown function symbol" error.
    %
    %   In case 1, any warning about occurs check violation would be
    %   misleading. In cases 2, 3 and 4, it would be redundant, since they
    %   all involve an error which is not really about the occurs check.
    %
:- pred maybe_add_to_ancestor_var_map(module_info::in, prog_var::in,
    cons_id::in, prog_context::in,
    ancestor_var_map::in, ancestor_var_map::out) is det.

maybe_add_to_ancestor_var_map(ModuleInfo, XVar, ConsId, Context,
        !AncestorVarMap) :-
    ( if
        % The only two kinds of cons_ids that may (a) appear in user
        % written code, as opposed to compiler-generated code, and
        % (b) may have nonzero arities, are cons and tuple_cons.
        % However, the cons_ids of tuples are represented by tuple_cons
        % only *after* resolve_unify_functor.m has been run as part of
        % the post_typecheck pass. Until then, they have the form
        % recognized by the second disjunct.
        ConsId = cons(SymName, Arity, _TypeCtor),
        Arity > 0,
        (
            module_info_get_cons_table(ModuleInfo, ConsTable),
            is_known_data_cons(ConsTable, ConsId)
        ;
            SymName = unqualified("{}")
        )
    then
        map.search_insert(XVar, Context, _OldContext, !AncestorVarMap)
    else
        true
    ).

:- pred parse_ordinary_cons_id(prog_varset::in, term.const::in,
    list(prog_term)::in, term.context::in, cons_id::out,
    list(error_spec)::in, list(error_spec)::out) is det.

parse_ordinary_cons_id(VarSet, Functor, ArgTerms, Context, ConsId, !Specs) :-
    (
        Functor = term.atom(Name),
        list.length(ArgTerms, Arity),
        ConsId = cons(unqualified(Name), Arity, cons_id_dummy_type_ctor)
    ;
        Functor = term.integer(Base, Integer, Signedness, Size),
%       expect(unify(ArgTerms, []), $pred,
%           "parse_simple_term has given an integer arguments"),
        parse_integer_cons_id(Base, Integer, Signedness, Size, Context,
            MaybeConsId),
        (
            MaybeConsId = ok1(ConsId)
        ;
            MaybeConsId = error1(ConsIdSpecs),
            % This is a dummy.
            ConsId = some_int_const(int_const(0)),
            !:Specs = ConsIdSpecs ++ !.Specs
        )
    ;
        Functor = term.float(Float),
%       expect(unify(ArgTerms, []), $pred,
%           "parse_simple_term has given a float arguments"),
        ConsId = float_const(Float)
    ;
        Functor = term.string(String),
%       expect(unify(ArgTerms, []), $pred,
%           "parse_simple_term has given a string arguments"),
        ConsId = string_const(String)
    ;
        Functor = term.implementation_defined(Name),
%       expect(unify(ArgTerms, []), $pred,
%           "parse_simple_term has given an implementation_defined arguments"),
        ( if
            ( Name = "line",   IDCKind = idc_line
            ; Name = "file",   IDCKind = idc_file
            ; Name = "module", IDCKind = idc_module
            ; Name = "pred",   IDCKind = idc_pred
            ; Name = "grade",  IDCKind = idc_grade
            )
        then
            ConsId = impl_defined_const(IDCKind)
        else
            ErrorTerm = functor(Functor, ArgTerms, Context),
            TermStr = describe_error_term(VarSet, ErrorTerm),
            Pieces = [words("Error:"),
                words("unexpected implementation defined literal"),
                quote(TermStr), suffix("."), nl,
                words("The only valid implementation defined literals are"),
                quote("$line"), suffix(","), quote("$file"), suffix(","),
                quote("$module"), suffix(","), quote("$pred"), words("and"),
                quote("$grade"), suffix("."), nl],
            Spec = simplest_spec($pred, severity_error,
                phase_parse_tree_to_hlds, Context, Pieces),
            !:Specs = [Spec | !.Specs],
            % This is a dummy.
            ConsId = impl_defined_const(idc_line)
        )
    ).

    % See whether YAtom indicates a term with special syntax.
    %
:- pred maybe_unravel_special_var_functor_unification(prog_var::in,
    string::in, list(prog_term)::in, term.context::in,
    prog_context::in, unify_main_context::in, unify_sub_contexts::in,
    purity::in, goal_order::in, expansion::out,
    svar_state::in, svar_state::out, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out, module_info::in, module_info::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is semidet.

maybe_unravel_special_var_functor_unification(XVar, YAtom, YArgTerms,
        YFunctorContext, Context, MainContext, SubContext, Purity, Order,
        Expansion, !SVarState, !SVarStore, !VarSet,
        !ModuleInfo, !QualInfo, !Specs)  :-
    % Switch on YAtom.
    % We cannot require each of the switch arms to be det. One reason is that
    % some of the keywords we are looking for contain just one character,
    % and *could* be a reference to a character constant (since the lexer
    % doesn't distinguish between seeing e.g. ':' with and without the quotes).
    % However, each arm should wrap a require_det scope around all the goals
    % that we execute when we have decided that the term we are parsing *is*
    % in fact supposed to be the construct we are looking for.
    (
        % Handle explicit type qualification.
        ( YAtom = "with_type"
        ; YAtom = ":"
        ),
        ( if YArgTerms = [RValTerm, DeclTypeTerm0] then
            require_det (
                % DeclType0 is a prog_term, but it is really a type,
                % so we coerce it to a generic term before parsing it.
                term.coerce(DeclTypeTerm0, DeclTypeTerm1),
                ContextPieces =
                    cord.singleton(words("In explicit type qualification:")),
                varset.coerce(!.VarSet, GenericVarSet),
                parse_type(no_allow_ho_inst_info(wnhii_type_qual),
                    GenericVarSet, ContextPieces, DeclTypeTerm1,
                    DeclTypeResult),
                (
                    DeclTypeResult = ok1(DeclType),
                    varset.coerce(!.VarSet, DeclVarSet),
                    process_type_qualification(XVar, DeclType, DeclVarSet,
                        YFunctorContext, !ModuleInfo, !QualInfo, !Specs)
                ;
                    DeclTypeResult = error1(DeclTypeSpecs),
                    % The varset is a prog_varset even though it contains
                    % the names of type variables in ErrorTerm, which is
                    % a generic term.
                    !:Specs = DeclTypeSpecs ++ !.Specs
                ),
                do_unravel_var_unification(XVar, RValTerm,
                    Context, MainContext, SubContext, Purity, Order, Expansion,
                    !SVarState, !SVarStore, !VarSet,
                    !ModuleInfo, !QualInfo, !Specs)
            )
        else if YAtom = ":", YArgTerms = [] then
            % This may be the character ':'.
            fail
        else
            % The code below is disabled, as per the discussion on m-rev
            % that started on 2016 may 5.
            fail
%           Pieces = [words("Error: the type qualification operator"),
%               quote(YAtom), words("can be used only in expressions"),
%               words("of the form"), quote("<term> " ++ YAtom ++ " <type>"),
%               suffix("."), nl],
%           Msg = simple_msg(YFunctorContext, [always(Pieces)]),
%           Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
%           !:Specs = [Spec | !.Specs],
%           qual_info_set_found_syntax_error(yes, !QualInfo),
%           Expansion = expansion(not_fgti, cord.empty)
        )
    ;
        % Handle unification expressions.
        YAtom = "@",
        (
            YArgTerms = [],
            % This may be the character '@'.
            fail
        ;
            YArgTerms = [LVal, RVal],
            require_det (
                do_unravel_var_unification(XVar, LVal, Context,
                    MainContext, SubContext, Purity, Order, ExpansionL,
                    !SVarState, !SVarStore, !VarSet,
                    !ModuleInfo, !QualInfo, !Specs),
                do_unravel_var_unification(XVar, RVal, Context,
                    MainContext, SubContext, Purity, Order, ExpansionR,
                    !SVarState, !SVarStore, !VarSet,
                    !ModuleInfo, !QualInfo, !Specs),
                ExpansionL = expansion(_, GoalCordL),
                ExpansionR = expansion(_, GoalCordR),
                Expansion = expansion(not_fgti, GoalCordL ++ GoalCordR)
            )
        ;
            ( YArgTerms = [_]
            ; YArgTerms = [_, _, _ | _]
            ),
            % The code below is disabled, as per the discussion on m-rev
            % that started on 2016 may 5.
            fail
%           Pieces = [words("Error: the unification expression operator"),
%               quote(YAtom), words("can be used only in expressions"),
%               words("of the form"), quote("<term> " ++ YAtom ++ " <term>"),
%               suffix("."), nl],
%           Msg = simple_msg(YFunctorContext, [always(Pieces)]),
%           Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
%           !:Specs = [Spec | !.Specs],
%           qual_info_set_found_syntax_error(yes, !QualInfo),
%           Expansion = expansion(not_fgti, cord.empty)
        )
    ;
        % Handle coerce expressions.
        YAtom = "coerce",
        YArgTerms = [RValTerm0],
        require_det (
            (
                RValTerm0 = term.variable(RValTermVar, _),
                RValGoalCord = cord.empty
            ;
                RValTerm0 = term.functor(_, _, _),
                substitute_state_var_mapping(RValTerm0, RValTerm,
                    !VarSet, !SVarState, !Specs),
                make_fresh_arg_var_no_svar(RValTerm0, RValTermVar, [],
                    !VarSet),
                do_unravel_var_unification(RValTermVar, RValTerm, Context,
                    MainContext, SubContext, Purity, Order, RValTermExpansion,
                    !SVarState, !SVarStore, !VarSet,
                    !ModuleInfo, !QualInfo, !Specs),
                RValTermExpansion = expansion(_, RValGoalCord)
            ),
            CoerceGoalExpr = generic_call(cast(subtype_coerce),
                [RValTermVar, XVar], [in_mode, out_mode],
                arg_reg_types_unset, detism_det),
            goal_info_init(Context, CoerceGoalInfo),
            CoerceGoal = hlds_goal(CoerceGoalExpr, CoerceGoalInfo),
            CoerceGoalCord = cord.singleton(CoerceGoal),
            Expansion = expansion(not_fgti, RValGoalCord ++ CoerceGoalCord)
        )
    ;
        % Handle if-then-else expressions.
        (
            YAtom = "else",
            YArgTerms = [CondThenTerm0, ElseTerm0],
            CondThenTerm0 = term.functor(term.atom("if"),
                [term.functor(term.atom("then"), [CondTerm0, ThenTerm0], _)],
                    _)
        ;
            YAtom = ";",
            YArgTerms = [CondThenTerm0, ElseTerm0],
            CondThenTerm0 = term.functor(term.atom("->"),
                [CondTerm0, ThenTerm0], _)
        ),

        require_det (
            term.coerce(CondTerm0, CondTerm),
            ContextPieces = cord.init,
            parse_some_vars_goal(CondTerm, ContextPieces, MaybeVarsCond,
                !VarSet),
            (
                MaybeVarsCond =
                    ok4(Vars, StateVars, CondParseTree, CondWarningSpecs),
                !:Specs = CondWarningSpecs ++ !.Specs,
                BeforeSVarState = !.SVarState,
                svar_prepare_for_local_state_vars(Context, !.VarSet, StateVars,
                    BeforeSVarState, BeforeInsideSVarState, !Specs),
                map.init(EmptySubst),

                transform_parse_tree_goal_to_hlds(loc_inside_atomic_goal,
                    CondParseTree, EmptySubst, CondGoal,
                    BeforeInsideSVarState, AfterCondInsideSVarState,
                    !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),

                substitute_state_var_mapping(ThenTerm0, ThenTerm, !VarSet,
                    AfterCondInsideSVarState, AfterThenInsideSVarState0,
                    !Specs),
                map.init(AncestorVarMap),
                classify_unravel_var_unification(XVar, ThenTerm,
                    Context, MainContext, SubContext,
                    Purity, Order, AncestorVarMap, ThenExpansion,
                    AfterThenInsideSVarState0, AfterThenInsideSVarState,
                    !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
                goal_info_init(get_term_context(ThenTerm), ThenGoalInfo),
                expansion_to_goal_wrap_if_fgti(ThenGoalInfo,
                    ThenExpansion, ThenGoal0),

                module_info_get_globals(!.ModuleInfo, Globals),
                module_info_get_name(!.ModuleInfo, ModuleName),
                svar_finish_local_state_vars(Globals, ModuleName, StateVars,
                    BeforeSVarState, AfterThenInsideSVarState,
                    AfterThenSVarState),

                substitute_state_var_mapping(ElseTerm0, ElseTerm, !VarSet,
                    BeforeSVarState, AfterElseSVarState0, !Specs),
                classify_unravel_var_unification(XVar, ElseTerm,
                    Context, MainContext, SubContext,
                    Purity, Order, AncestorVarMap, ElseExpansion,
                    AfterElseSVarState0, AfterElseSVarState,
                    !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs),
                goal_info_init(get_term_context(ElseTerm), ElseGoalInfo),
                expansion_to_goal_wrap_if_fgti(ElseGoalInfo,
                    ElseExpansion, ElseGoal0),

                svar_finish_if_then_else(Globals, ModuleName,
                    loc_inside_atomic_goal, Context, StateVars,
                    ThenGoal0, ThenGoal, ElseGoal0, ElseGoal,
                    BeforeSVarState, AfterCondInsideSVarState,
                    AfterThenSVarState, AfterElseSVarState,
                    AfterITESVarState, !VarSet, !SVarStore, !Specs),
                !:SVarState = AfterITESVarState,

                GoalExpr = if_then_else(StateVars ++ Vars,
                    CondGoal, ThenGoal, ElseGoal),
                goal_info_init(Context, GoalInfo),
                Goal = hlds_goal(GoalExpr, GoalInfo),
                Expansion = expansion(not_fgti, cord.singleton(Goal))
            ;
                MaybeVarsCond = error4(VarsCondSpecs),
                !:Specs = VarsCondSpecs ++ !.Specs,
                Expansion = expansion(not_fgti,
                    cord.singleton(true_goal_with_context(Context)))
            )
        )
    ;
        % Handle field extraction expressions.
        YAtom = "^",
        (
            YArgTerms = [],
            % This may be the character '^'.
            fail
        ;
            YArgTerms = [InputTerm0, FieldNameTerm],
            FieldNameContextPieces = [words("On the right hand side"),
                words("of the"), quote("^"), words("operator"),
                words("in a field selection expression:")],
            parse_field_list(FieldNameTerm, !.VarSet,
                FieldNameContextPieces, MaybeFieldNames),
            (
                MaybeFieldNames = ok1(FieldNames),
                require_det (
                    substitute_state_var_mapping(InputTerm0, InputTerm,
                        !VarSet, !SVarState, !Specs),
                    make_fresh_arg_var_no_svar(InputTerm, InputTermVar, [],
                        !VarSet),
                    expand_get_field_function_call(Context, MainContext,
                        SubContext, FieldNames, XVar, InputTermVar, Purity,
                        Functor, _, GetGoal, !SVarState, !SVarStore, !VarSet,
                        !ModuleInfo, !QualInfo, !Specs),

                    ArgContext = ac_functor(Functor, MainContext, SubContext),
                    map.init(AncestorVarMap),
                    do_arg_unification(InputTermVar, InputTerm,
                        YFunctorContext, ArgContext, Order,
                        1, AncestorVarMap, InputArgExpansion,
                        !SVarState, !SVarStore, !VarSet,
                        !ModuleInfo, !QualInfo, !Specs),
                    goal_info_init(Context, GoalInfo),
                    insert_expansion_before_goal_top_not_fgti(GoalInfo,
                        InputArgExpansion, GetGoal, Goal),
                    Expansion = expansion(not_fgti, cord.singleton(Goal))
                )
            ;
                MaybeFieldNames = error1(_FieldNamesSpecs),
                % The code below is disabled, as per the discussion
                % on m-rev that started on 2016 may 5.
                fail
%               !:Specs = FieldNamesSpecs ++ !.Specs,
%               qual_info_set_found_syntax_error(yes, !QualInfo),
%               Expansion = expansion(not_fgti, cord.empty)
            )
        ;
            ( YArgTerms = [_]
            ; YArgTerms = [_, _, _ | _]
            ),
            % The code below is disabled, as per the discussion on m-rev
            % that started on 2016 may 5.
            fail
%           Pieces = [words("Error: the field access operator"), quote(YAtom),
%               words("can be used only in expressions of the form"),
%               quote("<term> ^ <fieldname>"), suffix("."), nl],
%           Msg = simple_msg(YFunctorContext, [always(Pieces)]),
%           Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
%           !:Specs = [Spec | !.Specs],
%           qual_info_set_found_syntax_error(yes, !QualInfo),
%           Expansion = expansion(not_fgti, cord.empty)
        )
    ;
        % Handle field update expressions.
        YAtom = ":=",
        ( if
            YArgTerms = [FieldDescrTerm, FieldValueTerm0],
            FieldDescrTerm = term.functor(term.atom("^"),
                [InputTerm0, FieldNameTerm], _)
        then
            FieldNameContextPieces = [words("On the right hand side"),
                words("of the"), quote("^"), words("operator"),
                words("in a field update expression:")],
            parse_field_list(FieldNameTerm, !.VarSet,
                FieldNameContextPieces, MaybeFieldNames),
            (
                MaybeFieldNames = ok1(FieldNames),
                require_det (
                    substitute_state_var_mapping(InputTerm0, InputTerm,
                        !VarSet, !SVarState, !Specs),
                    make_fresh_arg_var_no_svar(InputTerm, InputTermVar, [],
                        !VarSet),
                    substitute_state_var_mapping(FieldValueTerm0,
                        FieldValueTerm, !VarSet, !SVarState, !Specs),
                    make_fresh_arg_var_no_svar(FieldValueTerm, FieldValueVar,
                        [InputTermVar], !VarSet),

                    expand_set_field_function_call(Context, MainContext,
                        SubContext, FieldNames, FieldValueVar,
                        InputTermVar, XVar,
                        Functor, InnerFunctor - FieldSubContext, SetGoal,
                        !SVarState, !SVarStore, !VarSet,
                        !ModuleInfo, !QualInfo, !Specs),

                    TermArgNumber = 1,
                    TermArgContext = ac_functor(Functor,
                        MainContext, SubContext),
                    InputVTNC = unify_var_term_num_context(InputTermVar,
                        InputTerm, TermArgNumber, TermArgContext),

                    FieldArgNumber = 2,
                    FieldArgContext = ac_functor(InnerFunctor, MainContext,
                        FieldSubContext),
                    FieldVTNC = unify_var_term_num_context(FieldValueVar,
                        FieldValueTerm, FieldArgNumber, FieldArgContext),

                    map.init(AncestorVarMap),
                    do_arg_unifications_with_contexts([InputVTNC, FieldVTNC],
                        Context, Order, AncestorVarMap,
                        InputFieldArgExpansions,
                        !SVarState, !SVarStore, !VarSet,
                        !ModuleInfo, !QualInfo, !Specs),

                    goal_info_init(Context, GoalInfo),
                    insert_expansions_before_goal_top_not_fgti(GoalInfo,
                        InputFieldArgExpansions, SetGoal, Goal),
                    Expansion = expansion(not_fgti, cord.singleton(Goal))
                )
            ;
                MaybeFieldNames = error1(_FieldNamesSpecs),
                % The code below is disabled, as per the discussion
                % on m-rev that started on 2016 may 5.
                fail
%               !:Specs = FieldNamesSpecs ++ !.Specs,
%               qual_info_set_found_syntax_error(yes, !QualInfo),
%               Expansion = expansion(not_fgti, cord.empty)
            )
        else
            % The code below is disabled, as per the discussion on m-rev
            % that started on 2016 may 5.
            fail
%           Pieces = [words("Error: the field update operator"), quote(YAtom),
%               words("can be used only in expressions of the form"),
%               quote("<term> ^ <fieldname> := <newfieldvalueterm>"),
%               suffix("."), nl],
%           Msg = simple_msg(YFunctorContext, [always(Pieces)]),
%           Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
%           !:Specs = [Spec | !.Specs],
%           qual_info_set_found_syntax_error(yes, !QualInfo),
%           Expansion = expansion(not_fgti, cord.empty)
        )
    ;
        (
            YAtom = ":-",
            LambdaBodyKind = lambda_body_ordinary
        ;
            YAtom = "-->",
            LambdaBodyKind = lambda_body_dcg
        ),
        % A lambda expression with a body goal. It may or may not have purity
        % marker.
        ( if YArgTerms = [PurityPFArgsDetTerm, BodyGoalTerm] then
            require_det(
                parse_lambda_expr(XVar, Purity,
                    Context, MainContext, SubContext,
                    PurityPFArgsDetTerm, yes({LambdaBodyKind, BodyGoalTerm}),
                    Expansion, !.SVarState, !SVarStore, !VarSet,
                    !ModuleInfo, !QualInfo, !Specs)
            )
        else
            HeadForm = "<lambda expression head> ",
            BodyForm = " <lambda expression body>",
            Form = HeadForm ++ YAtom ++ BodyForm,
            Pieces = [words("Error: the clause neck operator"), quote(YAtom),
                words("can be used only in expressions of the form"),
                quote(Form), suffix("."), nl],
            Spec = simplest_spec($pred, severity_error,
                phase_parse_tree_to_hlds, YFunctorContext, Pieces),
            !:Specs = [Spec | !.Specs],
            qual_info_set_found_syntax_error(yes, !QualInfo),
            Expansion = expansion(not_fgti, cord.empty)
        )
%   ;
%       ( YAtom = "impure"
%       ; YAtom = "semipure"
%       ),
%       % This could be a lambda expression without a body goal
%       % but with a purity marker. However, since it could also be
%       % a marker in front of an ordinary, non-lambda unification,
%       % we cannot insist on parsing it as a language expression.
    ;
        YAtom = "is",
        % A lambda expression without a body goal or a purity marker,
        % but with a declared determinism.
        require_det (
            YTerm = term.functor(term.atom(YAtom), YArgTerms, YFunctorContext),
            parse_lambda_expr(XVar, Purity, Context, MainContext, SubContext,
                YTerm, no, Expansion, !.SVarState, !SVarStore,
                !VarSet, !ModuleInfo, !QualInfo, !Specs)
        )
    ;
        YAtom = "=",
        % A lambda expression without a body goal or a purity marker,
        % and without a declared determinism. This can happen only if
        % the lambda expression is a function, in which case its top functor
        % will be "=", and the top functor of the left operand of the "="
        % will be "func" or "any_func". (If it isn't, then we are looking at
        % a plain old unification that does NOT involve a lambda expression.)
        ( if
            YArgTerms = [FuncArgsTerm, _ReturnArgModeTerm],
            FuncArgsTerm = term.functor(term.atom(FuncTermFunctor), _, _),
            ( FuncTermFunctor = "func"
            ; FuncTermFunctor = "any_func"
            )
        then
            require_det (
                YTerm = term.functor(term.atom(YAtom), YArgTerms,
                    YFunctorContext),
                parse_lambda_expr(XVar, Purity,
                    Context, MainContext, SubContext, YTerm, no, Expansion,
                    !.SVarState, !SVarStore, !VarSet,
                    !ModuleInfo, !QualInfo, !Specs)
            )
        else
            fail
        )
    ).

%---------------------------------------------------------------------------%
%
% Code for parsing pred/func expressions.
%

:- type lambda_body_kind
    --->    lambda_body_ordinary
    ;       lambda_body_dcg.

:- pred parse_lambda_expr(prog_var::in, purity::in,
    prog_context::in, unify_main_context::in, unify_sub_contexts::in,
    prog_term::in, maybe({lambda_body_kind, prog_term})::in, expansion::out,
    svar_state::in, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out,
    module_info::in, module_info::out, qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

parse_lambda_expr(XVar, Purity, Context, MainContext, SubContext,
        PurityPFArgsDetTerm, MaybeLambdaBody, Expansion,
        !.SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
    (
        MaybeLambdaBody = no,
        TrueGoal = true_expr(Context),
        MaybeBodyGoal = ok1(TrueGoal),
        MaybeDCGVars = no_dcg_vars
    ;
        MaybeLambdaBody = yes({LambdaBodyKind, BodyGoalTerm}),
        ContextPieces = cord.singleton(
            words("In the body of lambda expression:")),
        term.coerce(BodyGoalTerm, GenericBodyGoalTerm),
        (
            LambdaBodyKind = lambda_body_ordinary,
            parse_goal(GenericBodyGoalTerm, ContextPieces,
                MaybeBodyGoal0, !VarSet),
            MaybeDCGVars = no_dcg_vars
        ;
            LambdaBodyKind = lambda_body_dcg,
            parse_dcg_pred_goal(GenericBodyGoalTerm, ContextPieces,
                MaybeBodyGoal0, DCGVar0, DCGVarN, !VarSet),
            MaybeDCGVars = dcg_vars(DCGVar0, DCGVarN)
        ),
        (
            MaybeBodyGoal0 = ok2(BodyGoal, BodyGoalWarningSpecs),
            !:Specs = BodyGoalWarningSpecs ++ !.Specs,
            MaybeBodyGoal = ok1(BodyGoal)
        ;
            MaybeBodyGoal0 = error2(BodyGoalSpecs),
            MaybeBodyGoal = error1(BodyGoalSpecs)
        )
    ),
    parse_lambda_purity_pf_args_det_term(PurityPFArgsDetTerm, MaybeDCGVars,
        MaybeLambdaHead, !VarSet, !QualInfo),
    (
        MaybeLambdaHead = error1(LambdaHeadSpecs),
        !:Specs = LambdaHeadSpecs ++ !.Specs,
        qual_info_set_found_syntax_error(yes, !QualInfo),
        Expansion = expansion(not_fgti, cord.empty)
    ;
        MaybeLambdaHead = ok1(LambdaHead),
        build_lambda_expression(XVar, Purity, Context, MainContext, SubContext,
            LambdaHead, MaybeBodyGoal, Expansion,
            !.SVarState, !SVarStore, !VarSet, !ModuleInfo, !QualInfo, !Specs)
    ).

:- type maybe_dcg_vars
    --->    no_dcg_vars
    ;       dcg_vars(prog_var, prog_var).

:- pred parse_lambda_purity_pf_args_det_term(prog_term::in, maybe_dcg_vars::in,
    maybe1(lambda_head)::out, prog_varset::in, prog_varset::out,
    qual_info::in, qual_info::out) is det.

parse_lambda_purity_pf_args_det_term(PurityPFArgsDetTerm, MaybeDCGVars,
        MaybeLambdaHead, !VarSet, !QualInfo) :-
    term.coerce(PurityPFArgsDetTerm, GenericPurityPFArgsDetTerm),
    parse_purity_annotation(GenericPurityPFArgsDetTerm, LambdaPurity,
        PFArgsDetTerm),

%   A summary of the term structures that the two conditions of the nested
%   if-then-else below look for:
%
%   (
%       % Condition 1p:
%       PFArgsDetTerm = is(BeforeIsTerm, DetismTerm),
%       ( BeforeIsTerm = pred(...) ; BeforeIsTerm = any_pred(...) )
%   ;
%       % Condition 1f:
%       PFArgsDetTerm = is(BeforeIsTerm, DetismTerm),
%       BeforeIsTerm = "="(FuncArgsTerm, FuncRetTerm),
%       ( FuncArgsTerm = func(...) ; FuncArgsTerm = any_func(...) )
%   ;
%       % Condition 2f:
%       PFArgsDetTerm = "="(FuncArgsTerm, FuncRetTerm),
%       ( FuncArgsTerm = func(...) ; FuncArgsTerm = any_func(...) )
%   )

    ( if
        PFArgsDetTerm = term.functor(term.atom("is"),
            [BeforeIsTerm, DetismTerm], _),
        BeforeIsTerm = term.functor(term.atom(BeforeIsFunctor),
            BeforeIsArgTerms, Context),
        (
            % Condition 1p.
            (
                BeforeIsFunctor = "pred",
                Groundness = ho_ground
            ;
                BeforeIsFunctor = "any_pred",
                Groundness = ho_any
            ),
            ArgModeTerms0 = BeforeIsArgTerms,
            MaybeFuncRetArgModeTerm = no
        ;
            % Condition 1f.
            BeforeIsFunctor = "=",
            BeforeIsArgTerms = [FuncArgsTerm, FuncRetArgModeTerm0],
            FuncArgsTerm = term.functor(term.atom(FuncTermFunctor),
                ArgModeTerms0, _),
            (
                FuncTermFunctor = "func",
                Groundness = ho_ground
            ;
                FuncTermFunctor = "any_func",
                Groundness = ho_any
            ),
            MaybeFuncRetArgModeTerm = yes(FuncRetArgModeTerm0)
        )
    then
        parse_lambda_detism(!.VarSet, DetismTerm, MaybeDetism),
        (
            MaybeFuncRetArgModeTerm = no,
            PredOrFunc = pf_predicate,
            (
                MaybeDCGVars = no_dcg_vars,
                ArgModeTerms = ArgModeTerms0,
                parse_lambda_args_pred(Context, ArgModeTerms,
                    LambdaArgs, !VarSet, BadModeSpecs, SVarSpecs),
                LambdaHead = lambda_head(LambdaPurity, Groundness,
                    PredOrFunc, lambda_normal, LambdaArgs,
                    BadModeSpecs, SVarSpecs, MaybeDetism),
                MaybeLambdaHead = ok1(LambdaHead)
            ;
                MaybeDCGVars = dcg_vars(DCGVar0, DCGVarN),
                (
                    ( ArgModeTerms0 = []
                    ; ArgModeTerms0 = [_]
                    ),
                    Pieces = [words("Error: the head of a lambda expression"),
                        words("that is defined by a DCG clause"),
                        words("must have at least arguments."), nl],
                    Spec = simplest_spec($pred, severity_error,
                        phase_parse_tree_to_hlds, Context, Pieces),
                    MaybeLambdaHead =
                        error1([Spec | get_any_errors1(MaybeDetism)])
                ;
                    ArgModeTerms0 =
                        [ArgModeTerm1, ArgModeTerm2 | ArgModeTerms3plus],
                    split_last_two(
                        ArgModeTerm1, ArgModeTerm2, ArgModeTerms3plus,
                        NonDCGArgModeTerms, DCGModeTerm0, DCGModeTermN),
                    DCGContext0 = get_term_context(DCGModeTerm0),
                    DCGContextN = get_term_context(DCGModeTermN),
                    DCGVarTerm0 = term.variable(DCGVar0, DCGContext0),
                    DCGVarTermN = term.variable(DCGVarN, DCGContextN),
                    term.coerce(DCGVarTerm0, GenericDCGVarTerm0),
                    term.coerce(DCGVarTermN, GenericDCGVarTermN),
                    DCGArgModeTerm0 = term.functor(term.atom("::"),
                        [GenericDCGVarTerm0, DCGModeTerm0], DCGContext0),
                    DCGArgModeTermN = term.functor(term.atom("::"),
                        [GenericDCGVarTermN, DCGModeTermN], DCGContextN),
                    ArgModeTerms = NonDCGArgModeTerms ++
                        [DCGArgModeTerm0, DCGArgModeTermN],
                    parse_lambda_args_pred(Context, ArgModeTerms,
                        LambdaArgs, !VarSet, BadModeSpecs, SVarSpecs),
                    LambdaHead = lambda_head(LambdaPurity, Groundness,
                        PredOrFunc, lambda_normal, LambdaArgs,
                        BadModeSpecs, SVarSpecs, MaybeDetism),
                    MaybeLambdaHead = ok1(LambdaHead)
                )
            )
        ;
            MaybeFuncRetArgModeTerm = yes(FuncRetArgModeTerm),
            PredOrFunc = pf_function,
            (
                MaybeDCGVars = no_dcg_vars,
                parse_lambda_args_func(Context,
                    ArgModeTerms0, FuncRetArgModeTerm,
                    LambdaArgs, !VarSet, BadModeSpecs, SVarSpecs),
                LambdaHead = lambda_head(LambdaPurity, Groundness, PredOrFunc,
                    lambda_normal, LambdaArgs, BadModeSpecs, SVarSpecs,
                    MaybeDetism),
                MaybeLambdaHead = ok1(LambdaHead)
            ;
                MaybeDCGVars = dcg_vars(_, _),
                Pieces = [words("Error: DCG notation is not allowed"),
                    words("in clauses for functions."), nl],
                Spec = simplest_spec($pred, severity_error,
                    phase_parse_tree_to_hlds, Context, Pieces),
                MaybeLambdaHead = error1([Spec | get_any_errors1(MaybeDetism)])
            )
        )
    else if
        % Condition 2f.
        %
        % We are looking for the same term structure as condition 1b,
        % minus the outer "is detism" wrapper. This is why the structure
        % of this code, and the variable names, resemble condition 1b.
        PFArgsDetTerm = term.functor(term.atom(BeforeIsFunctor),
            BeforeIsArgTerms, Context),
        BeforeIsFunctor = "=",
        BeforeIsArgTerms = [FuncArgsTerm, FuncRetArgModeTerm],
        FuncArgsTerm = term.functor(term.atom(FuncTermFunctor),
            ArgModeTerms, _),
        (
            FuncTermFunctor = "func",
            Groundness = ho_ground
        ;
            FuncTermFunctor = "any_func",
            Groundness = ho_any
        )
    then
        PredOrFunc = pf_function,
        % XXX Should we require that ArgModeTerms and FuncRetArgModeTerm
        % *must* have no explicit mode annotations?
        (
            MaybeDCGVars = no_dcg_vars,
            parse_lambda_args_func(Context, ArgModeTerms, FuncRetArgModeTerm,
                LambdaArgs, !VarSet, BadModeSpecs, SVarSpecs),
            MaybeDetism = ok1(detism_det),
            LambdaHead = lambda_head(LambdaPurity, Groundness, PredOrFunc,
                lambda_normal, LambdaArgs, BadModeSpecs, SVarSpecs,
                MaybeDetism),
            MaybeLambdaHead = ok1(LambdaHead)
        ;
            MaybeDCGVars = dcg_vars(_, _),
            Pieces = [words("Error: DCG notation is not allowed"),
                words("in clauses for functions."), nl],
            Spec = simplest_spec($pred, severity_error,
                phase_parse_tree_to_hlds, Context, Pieces),
            MaybeLambdaHead = error1([Spec])
        )
    else
        Pieces = [words("Error: the clause head part of a lambda expression"),
            words("should have one of the following forms:"),
            quote("pred(<args>) is <determinism>"), nl,
            quote("any_pred(<args>) is <determinism>"), nl,
            quote("func(<args>) = <retarg> is <determinism>"), nl,
            quote("any_func(<args>) = <retarg> is <determinism>"), nl,
            quote("func(<args>) = <retarg>"), nl,
            quote("any_func(<args>) = <retarg>"), suffix(","), nl,
            words("or one of those forms preceded by either"),
            quote("semipure"), words("or"), quote("impure"), suffix("."), nl],
        Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds,
            get_term_context(PFArgsDetTerm), Pieces),
        qual_info_set_found_syntax_error(yes, !QualInfo),
        MaybeLambdaHead = error1([Spec])
    ).

:- pred split_last_two(T::in, T::in, list(T)::in, list(T)::out, T::out, T::out)
    is det.

split_last_two(Element1, Element2, Elements3plus, Main, LastButOne, Last) :-
    (
        Elements3plus = [],
        Main = [],
        LastButOne = Element1,
        Last = Element2
    ;
        Elements3plus = [Element3 | Elements4plus],
        split_last_two(Element2, Element3, Elements4plus, MainTail,
            LastButOne, Last),
        Main = [Element1 | MainTail]
    ).

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

:- pred parse_lambda_args_func(term.context::in, list(term)::in, term::in,
    list(lambda_arg)::out, prog_varset::in, prog_varset::out,
    list(error_spec)::out, list(error_spec)::out) is det.

parse_lambda_args_func(Context, ArgModeTerms, FuncRetArgModeTerm,
        LambdaArgs, !VarSet, !:BadModeSpecs, !:SVarSpecs) :-
    !:BadModeSpecs = [],
    !:SVarSpecs = [],
    parse_lambda_args(lambda_arg_ordinary,
        ArgModeTerms, OrdinaryLambdaArgs, 1, ResultArgNum,
        !VarSet, !BadModeSpecs, !SVarSpecs),
    parse_lambda_arg(lambda_arg_func_result,
        FuncRetArgModeTerm, FuncRetLambdaArg, ResultArgNum, _,
        !VarSet, !BadModeSpecs, !SVarSpecs),
    LambdaArgs = OrdinaryLambdaArgs ++ [FuncRetLambdaArg],
    classify_lambda_arg_modes_present_absent(LambdaArgs,
        PresentArgs, AbsentArgs),
    (
        AbsentArgs = []
        % All arguments have explicit mode annotations.
    ;
        AbsentArgs = [_ | _],
        (
            PresentArgs = []
            % No arguments have explicit mode annotations.
            % The argument modes that together constitute the default
            % function mode have already been filled in.
        ;
            PresentArgs = [_ | _],
            add_some_not_all_args_have_modes_error(Context, AbsentArgs,
                !BadModeSpecs)
        )
    ).

:- pred parse_lambda_args_pred(term.context::in, list(term)::in,
    list(lambda_arg)::out, prog_varset::in, prog_varset::out,
    list(error_spec)::out, list(error_spec)::out) is det.

parse_lambda_args_pred(Context, ArgModeTerms,
        LambdaArgs, !VarSet, !:BadModeSpecs, !:SVarSpecs) :-
    !:BadModeSpecs = [],
    !:SVarSpecs = [],
    parse_lambda_args(lambda_arg_ordinary, ArgModeTerms, LambdaArgs, 1, _,
        !VarSet, !BadModeSpecs, !SVarSpecs),
    classify_lambda_arg_modes_present_absent(LambdaArgs,
        PresentArgs, AbsentArgs),
    (
        AbsentArgs = []
        % All arguments have explicit mode annotations.
    ;
        AbsentArgs = [_ | _],
        (
            PresentArgs = [],
            add_pred_no_args_have_modes_error(Context, !BadModeSpecs)
        ;
            PresentArgs = [_ | _],
            add_some_not_all_args_have_modes_error(Context, AbsentArgs,
                !BadModeSpecs)
        )
    ).

:- pred classify_lambda_arg_modes_present_absent(list(lambda_arg)::in,
    list(lambda_arg)::out, list(lambda_arg)::out) is det.

classify_lambda_arg_modes_present_absent([], [], []).
classify_lambda_arg_modes_present_absent([LambdaArg | LambdaArgs],
        PresentArgs, AbsentArgs) :-
    classify_lambda_arg_modes_present_absent(LambdaArgs,
        PresentArgsTail, AbsentArgsTail),
    PresentOrAbsent = LambdaArg ^ la_arg_mode_presence,
    (
        PresentOrAbsent = lam_present,
        PresentArgs = [LambdaArg | PresentArgsTail],
        AbsentArgs = AbsentArgsTail
    ;
        PresentOrAbsent = lam_absent,
        PresentArgs = PresentArgsTail,
        AbsentArgs = [LambdaArg | AbsentArgsTail]
    ).

:- pred add_some_not_all_args_have_modes_error(prog_context::in,
    list(lambda_arg)::in,
    list(error_spec)::in, list(error_spec)::out) is det.

add_some_not_all_args_have_modes_error(Context, _AbsentArgs, !Specs) :-
    % We could use _AbsentArgs to make the error message more detailed.
    Pieces = [words("Error: in head of lambda expression:"),
        words("some but not all arguments have modes."), nl],
    Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds,
        Context, Pieces),
    !:Specs = [Spec | !.Specs].

:- pred add_pred_no_args_have_modes_error(prog_context::in,
    list(error_spec)::in, list(error_spec)::out) is det.

add_pred_no_args_have_modes_error(Context, !Specs) :-
    % We could use _AbsentArgs to make the error message more detailed.
    Pieces = [words("Error: in head of predicate lambda expression:"),
        words("none of the arguments have modes."), nl],
    Spec = simplest_spec($pred, severity_error, phase_parse_tree_to_hlds,
        Context, Pieces),
    !:Specs = [Spec | !.Specs].

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

:- type lambda_arg_kind
    --->    lambda_arg_ordinary
    ;       lambda_arg_func_result.

:- type lambda_arg_mode_presence
    --->    lam_absent
    ;       lam_present.

:- type lambda_arg
    --->    lambda_arg(
                la_arg_num              :: int,
                la_arg_term             :: prog_term,
                la_arg_var              :: prog_var,
                la_kind                 :: lambda_arg_kind,

                % If the lambda argument does not have a "::mode" annotation,
                % the la_arg_mode_presence field will contain lam_absent,
                % and the la_arg_mode field will contain the default mode
                % for the argument position ("in" for ordinary arguments,
                % "out" for function results).
                %
                % If the lambda argument does have a "::mode" annotation,
                % the la_arg_mode_presence field will contain lam_present.
                % If the mode annotation can be successfully parsed,
                % the la_arg_mode field will contain that mode.
                % If the mode annotation cannot be parsed, then
                % the la_arg_mode field will contain the default mode
                % for the argument position, as above, but the messages
                % descrbing the error will be added to !BadModeSpecs.
                la_arg_mode_presence    :: lambda_arg_mode_presence,
                la_arg_mode             :: mer_mode,

                % The context of the mode annotation, or if it is absent,
                % the context of the argument.
                la_arg_mode_context     :: prog_context
            ).

:- func project_lambda_arg_term(lambda_arg) = prog_term.

project_lambda_arg_term(LambdaArg) = ArgTerm :-
    ArgTerm = LambdaArg ^ la_arg_term.

:- func project_lambda_var(lambda_arg) = prog_var.

project_lambda_var(LambdaArg) = LambdaVar :-
    LambdaVar = LambdaArg ^ la_arg_var.

:- func project_lambda_arg_mode(lambda_arg) = mer_mode.

project_lambda_arg_mode(LambdaArg) = Mode :-
    Mode = LambdaArg ^ la_arg_mode.

:- func project_lambda_var_arg_mode(lambda_arg) = pair(prog_var, mer_mode).

project_lambda_var_arg_mode(LambdaArg) = LambdaVar - Mode :-
    LambdaVar = LambdaArg ^ la_arg_var,
    Mode = LambdaArg ^ la_arg_mode.

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

    % Parse a list of lambda argument terms, each which should be of the form
    % argterm::modeterm.
    %
:- pred parse_lambda_args(lambda_arg_kind::in,
    list(term)::in, list(lambda_arg)::out,
    int::in, int::out, prog_varset::in, prog_varset::out,
    list(error_spec)::in, list(error_spec)::out,
    list(error_spec)::in, list(error_spec)::out) is det.

parse_lambda_args(_Kind, [], [], !ArgNum, !VarSet, !BadModeSpecs, !SVarSpecs).
parse_lambda_args(Kind, [HeadArgModeTerm | TailArgModeTerms],
        [HeadLambdaArg | TailLambdaArgs],
        !ArgNum, !VarSet, !BadModeSpecs, !SVarSpecs) :-
    parse_lambda_arg(Kind, HeadArgModeTerm, HeadLambdaArg,
        !ArgNum, !VarSet, !BadModeSpecs, !SVarSpecs),
    parse_lambda_args(Kind, TailArgModeTerms, TailLambdaArgs,
        !ArgNum, !VarSet, !BadModeSpecs, !SVarSpecs).

:- pred parse_lambda_arg(lambda_arg_kind::in, term::in, lambda_arg::out,
    int::in, int::out, prog_varset::in, prog_varset::out,
    list(error_spec)::in, list(error_spec)::out,
    list(error_spec)::in, list(error_spec)::out) is det.

parse_lambda_arg(Kind, ArgModeTerm, LambdaArg, !ArgNum, !VarSet,
        !BadModeSpecs, !SVarSpecs) :-
    ( if
        ArgModeTerm = term.functor(term.atom("::"),
            [ArgTermPrime, ModeTerm], _)
    then
        ArgTerm = ArgTermPrime,
        PresentOrAbsent = lam_present,
        ModeContext = get_term_context(ModeTerm),
        ContextPieces = cord.from_list([words("In the"), nth_fixed(!.ArgNum),
            words("argument of the lambda expression:")]),
        varset.coerce(!.VarSet, GenericVarSet),
        parse_mode(allow_constrained_inst_var, GenericVarSet, ContextPieces,
            ModeTerm, MaybeMode0),
        (
            MaybeMode0 = ok1(Mode0),
            constrain_inst_vars_in_mode(Mode0, Mode)
        ;
            MaybeMode0 = error1(ModeSpecs),
            !:BadModeSpecs = ModeSpecs ++ !.BadModeSpecs,
            Mode = default_mode_for_lambda_arg(Kind)
        )
    else
        ArgTerm = ArgModeTerm,
        PresentOrAbsent = lam_absent,
        Mode = default_mode_for_lambda_arg(Kind),
        ModeContext = get_term_context(ArgModeTerm)
    ),

    term.coerce(ArgTerm, ProgArgTerm),
    % We currently do not allow !X to appear as a lambda head argument, though
    % we might later extend the syntax still further to accommodate this
    % using syntax such as !IO::(di, uo).
    ( if is_term_a_bang_state_pair(ProgArgTerm, StateVar, StateVarContext) then
        (
            Kind = lambda_arg_ordinary,
            report_illegal_bang_svar_lambda_arg(StateVarContext, !.VarSet,
                StateVar, !SVarSpecs)
        ;
            Kind = lambda_arg_func_result,
            report_illegal_func_svar_result(StateVarContext, !.VarSet,
                StateVar, !SVarSpecs)
        )
    else
        true
    ),
    % We always allocate a new variable for each lambda argument,
    % even if the argument term is already a variable (which is what
    % make_fresh_arg_vars_subst_svars does). This is because for functions,
    % we need to ensure that the variable corresponding to the function
    % result term is a new variable, to avoid the function result term
    % becoming lambda-quantified.
    LambdaVarName = "LambdaHeadVar__" ++ string.int_to_string(!.ArgNum),
    varset.new_named_var(LambdaVarName, LambdaVar, !VarSet),
    LambdaArg = lambda_arg(!.ArgNum, ProgArgTerm, LambdaVar, Kind,
        PresentOrAbsent, Mode, ModeContext),
    !:ArgNum = !.ArgNum + 1.

:- func default_mode_for_lambda_arg(lambda_arg_kind) = mer_mode.

default_mode_for_lambda_arg(Kind) = Mode :-
    (
        Kind = lambda_arg_ordinary,
        in_mode(Mode)
    ;
        Kind = lambda_arg_func_result,
        out_mode(Mode)
    ).

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

:- pred parse_purity_annotation(term(T)::in, purity::out, term(T)::out) is det.

parse_purity_annotation(Term0, Purity, Term) :-
    ( if
        Term0 = term.functor(term.atom(PurityName), [Term1], _),
        purity_name(Purity0, PurityName)
    then
        Purity = Purity0,
        Term = Term1
    else
        Purity = purity_pure,
        Term = Term0
    ).

:- pred parse_lambda_detism(prog_varset::in, term::in,
    maybe1(determinism)::out) is det.

parse_lambda_detism(VarSet, DetismTerm, MaybeDetism) :-
    ( if
        DetismTerm = term.functor(term.atom(DetString), [], _),
        standard_det(DetString, Detism)
    then
        MaybeDetism = ok1(Detism)
    else
        varset.coerce(VarSet, GenericVarSet),
        TermStr = describe_error_term(GenericVarSet, DetismTerm),
        Pieces = [words("Error:"), words(TermStr),
            words("is not a valid determinism."), nl],
        Spec = simplest_spec($pred, severity_error, phase_term_to_parse_tree,
            get_term_context(DetismTerm), Pieces),
        MaybeDetism = error1([Spec])
    ).

%-----------------------------------------------------------------------------%
%
% Code for building lambda expressions.
%

:- type lambda_head
    --->    lambda_head(
                purity,
                ho_groundness,
                pred_or_func,
                lambda_eval_method,
                list(lambda_arg),
                list(error_spec),       % Errors about unparseable and/or
                                        % missing arg modes.
                list(error_spec),       % Errors about !X arguments.
                maybe1(determinism)     % The determinism of the lambda expr.
            ).

:- pred build_lambda_expression(prog_var::in, purity::in,
    prog_context::in, unify_main_context::in, unify_sub_contexts::in,
    lambda_head::in, maybe1(goal)::in, expansion::out,
    svar_state::in, svar_store::in, svar_store::out,
    prog_varset::in, prog_varset::out,
    module_info::in, module_info::out, qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

build_lambda_expression(LHSVar, UnificationPurity,
        Context, MainContext, SubContext, LambdaHead, MaybeBodyGoal,
        Expansion, OutsideSVarState, !SVarStore,
        !VarSet, !ModuleInfo, !QualInfo, !Specs) :-
    % In the parse tree, the lambda arguments can be any terms, but in the HLDS
    % they must be distinct variables. So we introduce fresh variables
    % for the lambda arguments, and add appropriate unifications.
    %
    % For example, we convert from:
    %
    %       X = (func(f(A, B), c) = D :- Body )
    %
    % to:
    %
    %       X = (func(H1, H2) = H3 :-
    %           some [A, B] (
    %               H1 = f(A, B),
    %               H2 = c,
    %               Body,
    %               H3 = D
    %       )
    %
    % Note that the quantification is important here. That is why we need
    % to introduce the explicit `some [...]'. Variables in the argument
    % positions are lambda-quantified, so when we move them to the body,
    % we need to make them explicitly existentially quantified to avoid
    % capturing any variables of the same name that occur outside this scope.
    %
    % Also, note that any introduced unifications that construct the output
    % arguments for the lambda expression, need to occur *after* the body
    % of the lambda expression. This is in case the body of the lambda
    % expression is impure, in which case the mode analyser cannot reorder
    % the unifications; this results in a mode error.
    %
    % XXX The mode analyser *should* be able to reorder such unifications,
    % especially ones that the compiler introduced itself.
    %
    % For predicates, all variables occurring in the lambda arguments are
    % locally quantified to the lambda goal. For functions, we need to
    % be careful because variables in arguments should similarly be quantified,
    % but variables in the function return value term (and not in the
    % arguments) should *not* be locally quantified.

    LambdaHead = lambda_head(LambdaPurity, Groundness, PredOrFunc,
        EvalMethod, LambdaArgs0, BadModeSpecs, SVarSpecs, MaybeDetism),
    qualify_lambda_arg_modes_if_not_opt_imported(LambdaArgs0, LambdaArgs1,
        Modes, !QualInfo, !Specs),
    inconsistent_constrained_inst_vars_in_modes(Modes, InconsistentVars),
    (
        InconsistentVars = []
    ;
        InconsistentVars = [_ | _],
        varset.coerce(!.VarSet, InstVarSet),
        InconsistentVarStrs = list.map(
            mercury_var_to_string(InstVarSet, print_name_only),
            InconsistentVars),
        InconsistentVarPieces =
            [words("Error: the constraints on the inst"),
            words(choose_number(InconsistentVars, "variable", "variables")) |
            list_to_quoted_pieces(InconsistentVarStrs)] ++
            [words("are inconsistent."), nl],
        InconsistentVarSpec = simplest_spec($pred, severity_error,
            phase_term_to_parse_tree, Context, InconsistentVarPieces),
        !:Specs = [InconsistentVarSpec | !.Specs]
    ),
    (
        MaybeDetism = ok1(Detism)
    ;
        MaybeDetism = error1(DetismSpecs),
        !:Specs = DetismSpecs ++ !.Specs,
        % Due to the error, this dummy value won't be used.
        Detism = detism_det
    ),
    (
        MaybeBodyGoal = ok1(BodyGoal)
    ;
        MaybeBodyGoal = error1(BodyGoalSpecs),
        !:Specs = BodyGoalSpecs ++ !.Specs,
        qual_info_set_found_syntax_error(yes, !QualInfo),
        % Due to the error, this dummy value won't be used.
        BodyGoal = true_expr(Context)
    ),

    ArgSpecs = BadModeSpecs ++ SVarSpecs,
    (
        ArgSpecs = [_ | _],
        !:Specs = ArgSpecs ++ !.Specs,
        qual_info_set_found_syntax_error(yes, !QualInfo),
        Goal = true_goal_with_context(Context)
    ;
        ArgSpecs = [],
        some [!SVarState] (
            ArgTerms1 = list.map(project_lambda_arg_term, LambdaArgs1),
            svar_prepare_for_lambda_head(Context, ArgTerms1, ArgTerms,
                FinalSVarMap, OutsideSVarState, !:SVarState, !VarSet, !Specs),
            InitialSVarState = !.SVarState,

            % Partition the arguments (and their corresponding lambda vars)
            % into two sets: those that are not output, i.e. input and unused,
            % and those that are output.
            %
            % The call to svar_prepare_for_lambda_head obsoletes the arg term
            % fields of LambdaArgs1, so we must pass the new arg terms
            % separately. We don't need to put them back into the lambda args,
            % since the lambda args won't be needed later.
            partition_args_and_lambda_vars(!.ModuleInfo, LambdaArgs1, ArgTerms,
                NonOutputLambdaVarsArgs, OutputLambdaVarsArgs),

            list.length(ArgTerms, NumArgs),
            ArgContext = ac_head(PredOrFunc, NumArgs),

            % Create the unifications that need to come before the body of the
            % lambda expression; those corresponding to args whose mode is
            % input or unused.
            HeadBefore0 = true_goal_with_context(Context),
            insert_arg_unifications(NonOutputLambdaVarsArgs,
                Context, ArgContext, HeadBefore0, HeadBefore,
                !SVarState, !SVarStore, !VarSet,
                !ModuleInfo, !QualInfo, !Specs),

            map.init(Substitution),
            transform_parse_tree_goal_to_hlds(loc_whole_goal, BodyGoal,
                Substitution, Body, !SVarState, !SVarStore,
                !VarSet, !ModuleInfo, !QualInfo, !Specs),

            % Create the unifications that need to come after the body of the
            % lambda expression; those corresponding to args whose mode is
            % output.
            HeadAfter0 = true_goal_with_context(Context),
            insert_arg_unifications(OutputLambdaVarsArgs,
                Context, ArgContext, HeadAfter0, HeadAfter,
                !SVarState, !SVarStore, !VarSet,
                !ModuleInfo, !QualInfo, !Specs),

            LambdaVarsModes =
                list.map(project_lambda_var_arg_mode, LambdaArgs1),
            LambdaVars =
                list.map(project_lambda_var, LambdaArgs1),

            trace [compiletime(flag("debug-statevar-lambda")), io(!IO)] (
                get_debug_output_stream(!.ModuleInfo, DebugStream, !IO),
                io.write_string(DebugStream, "\nLAMBDA EXPRESSION\n", !IO),
                io.write_string(DebugStream, "arg terms before:\n", !IO),
                list.foldl(io.write_line(DebugStream), ArgTerms1, !IO),
                io.write_string(DebugStream, "arg terms after:\n", !IO),
                list.foldl(io.write_line(DebugStream), ArgTerms, !IO),
                io.write_string(DebugStream, "lambda arg vars:\n", !IO),
                io.write_line(DebugStream, LambdaVars, !IO),
                io.write_string(DebugStream,
                    "lambda arg unifies before:\n", !IO),
                dump_goal_nl(DebugStream, !.ModuleInfo, !.VarSet,
                    HeadBefore, !IO),
                io.write_string(DebugStream, "lambda body:\n", !IO),
                dump_goal_nl(DebugStream, !.ModuleInfo, !.VarSet, Body, !IO),
                io.write_string(DebugStream,
                    "lambda arg unifies after:\n", !IO),
                dump_goal_nl(DebugStream, !.ModuleInfo, !.VarSet,
                    HeadAfter, !IO),
                map.to_assoc_list(FinalSVarMap, FinalSVarList),
                io.write_string(DebugStream, "FinalSVarMap:\n", !IO),
                io.write_line(DebugStream, FinalSVarList, !IO)
            ),

            % Fix up any state variable unifications.
            FinalSVarState = !.SVarState,
            module_info_get_globals(!.ModuleInfo, Globals),
            module_info_get_name(!.ModuleInfo, ModuleName),
            svar_finish_lambda_body(Globals, ModuleName, Context, FinalSVarMap,
                [HeadBefore, Body, HeadAfter], HLDS_Goal0,
                InitialSVarState, FinalSVarState, !SVarStore),

            % Figure out which variables we need to explicitly existentially
            % quantify.
            (
                PredOrFunc = pf_predicate,
                QuantifiedArgTerms = ArgTerms
            ;
                PredOrFunc = pf_function,
                pred_args_to_func_args(ArgTerms, QuantifiedArgTerms,
                    _ReturnValTerm)
            ),
            term.vars_list(QuantifiedArgTerms, QuantifiedVars0),
            list.sort_and_remove_dups(QuantifiedVars0, QuantifiedVars),

            goal_info_init(Context, GoalInfo),
            HLDS_GoalExpr = scope(exist_quant(QuantifiedVars), HLDS_Goal0),
            HLDS_Goal = hlds_goal(HLDS_GoalExpr, GoalInfo),

            % We set the lambda nonlocals here to anything that could
            % possibly be nonlocal. Quantification will reduce this down
            % to the proper set of nonlocal arguments.
            some [!LambdaGoalVars] (
                goal_util.goal_vars(HLDS_Goal, !:LambdaGoalVars),
                set_of_var.delete_list(LambdaVars, !LambdaGoalVars),
                set_of_var.delete_list(QuantifiedVars, !LambdaGoalVars),
                LambdaNonLocals = set_of_var.to_sorted_list(!.LambdaGoalVars)
            ),

            LambdaRHS = rhs_lambda_goal(LambdaPurity, Groundness, PredOrFunc,
                EvalMethod, LambdaNonLocals, LambdaVarsModes, Detism,
                HLDS_Goal),
            make_atomic_unification(LHSVar, LambdaRHS, Context, MainContext,
                SubContext, UnificationPurity, Goal, !QualInfo)
        )
    ),
    Expansion = expansion(not_fgti, cord.singleton(Goal)).

    % Partition the lists of arguments and variables into lists
    % of non-output and output arguments and variables.
    %
:- pred partition_args_and_lambda_vars(module_info::in,
    list(lambda_arg)::in, list(prog_term)::in,
    list(unify_var_term)::out, list(unify_var_term)::out) is det.

partition_args_and_lambda_vars(_, [], [], [], []).
partition_args_and_lambda_vars(_, [], [_ | _], _, _) :-
    unexpected($pred, "mismatched lists").
partition_args_and_lambda_vars(_, [_ | _], [], _, _) :-
    unexpected($pred, "mismatched lists").
partition_args_and_lambda_vars(ModuleInfo,
        [LambdaArg | LambdaArgs], [ArgTerm | ArgTerms],
        InputLambdaVarsArgTerms, OutputLambdaVarsArgTerms) :-
    partition_args_and_lambda_vars(ModuleInfo, LambdaArgs, ArgTerms,
        InputLambdaVarsArgTermsTail, OutputLambdaVarsArgTermsTail),

    LambdaArg = lambda_arg(_ArgNum, _SupersededArgTerm, LambdaVar,
        _Kind, _PresentOrAbsent, Mode, _ModeContext),
    LambdaVarArgTerm = unify_var_term(LambdaVar, ArgTerm),

    % If the mode is undefined, calling mode_is_output/2 directly would cause
    % the compiler to abort, so we don't want to do that.
    %
    % It does not really matter whether we consider an argument with an
    % undefined mode input or output, because mode analysis will fail anyway.
    % The code here is slightly simpler if we consider it input.
    ( if
        mode_is_defined(ModuleInfo, Mode),
        mode_is_output(ModuleInfo, Mode)
    then
        % defined and output
        InputLambdaVarsArgTerms  = InputLambdaVarsArgTermsTail,
        OutputLambdaVarsArgTerms =
            [LambdaVarArgTerm | OutputLambdaVarsArgTermsTail]
    else
        % undefined or (defined and not output)
        InputLambdaVarsArgTerms  =
            [LambdaVarArgTerm | InputLambdaVarsArgTermsTail],
        OutputLambdaVarsArgTerms = OutputLambdaVarsArgTermsTail
    ).

    % Succeeds iff the given mode is defined.
    %
:- pred mode_is_defined(module_info::in, mer_mode::in) is semidet.

mode_is_defined(ModuleInfo, Mode) :-
    mode_get_insts_semidet(ModuleInfo, Mode, _, _).

:- pred qualify_lambda_arg_modes_if_not_opt_imported(
    list(lambda_arg)::in, list(lambda_arg)::out, list(mer_mode)::out,
    qual_info::in, qual_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

qualify_lambda_arg_modes_if_not_opt_imported(LambdaArgs0, LambdaArgs,
        Modes, !QualInfo, !Specs) :-
    qual_info_get_maybe_opt_imported(!.QualInfo, MaybeOptImported),
    (
        MaybeOptImported = is_not_opt_imported,
        % Lambda expressions cannot appear in the interface of a module.
        InInt = mq_not_used_in_interface,
        qual_info_get_mq_info(!.QualInfo, MQInfo0),
        qualify_lambda_arg_modes(InInt, LambdaArgs0, LambdaArgs, Modes,
            MQInfo0, MQInfo, !Specs),
        qual_info_set_mq_info(MQInfo, !QualInfo)
    ;
        MaybeOptImported = is_opt_imported,
        % The modes in `.opt' files are already fully module qualified.
        LambdaArgs = LambdaArgs0,
        Modes = list.map(project_lambda_arg_mode, LambdaArgs)
    ).

:- pred qualify_lambda_arg_modes(mq_in_interface::in,
    list(lambda_arg)::in, list(lambda_arg)::out, list(mer_mode)::out,
    mq_info::in, mq_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

qualify_lambda_arg_modes(_InInt, [], [], [], !MQInfo, !Specs).
qualify_lambda_arg_modes(InInt, [LambdaArg0 | LambdaArgs0],
        [LambdaArg | LambdaArgs], [Mode | Modes], !MQInfo, !Specs) :-
    LambdaArg0 = lambda_arg(ArgNum, ProgArgTerm, LambdaVar,
        Kind, PresentOrAbsent, Mode0, ModeContext),
    qualify_lambda_mode(InInt, ModeContext, Mode0, Mode, !MQInfo, !Specs),
    LambdaArg = lambda_arg(ArgNum, ProgArgTerm, LambdaVar,
        Kind, PresentOrAbsent, Mode, ModeContext),
    qualify_lambda_arg_modes(InInt, LambdaArgs0,
        LambdaArgs, Modes, !MQInfo, !Specs).

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

:- pred arg_context_to_unify_context(arg_context::in, int::in,
    unify_main_context::out, unify_sub_contexts::out) is det.

arg_context_to_unify_context(ArgContext, ArgNum, MainContext, SubContexts) :-
    (
        ArgContext = ac_head(PredOrFunc, Arity),
        ( if PredOrFunc = pf_function, ArgNum = Arity then
            % It is the function result term in the head.
            MainContext = umc_head_result
        else
            % It is a head argument.
            MainContext = umc_head(ArgNum)
        ),
        SubContexts = []
    ;
        ArgContext = ac_call(PredId),
        MainContext = umc_call(PredId, ArgNum),
        SubContexts = []
    ;
        ArgContext = ac_functor(ConsId, MainContext, SubContexts0),
        SubContext = unify_sub_context(ConsId, ArgNum),
        SubContexts = [SubContext | SubContexts0]
    ).

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

make_fresh_arg_vars_subst_svars(Args, Vars, VarsArgs,
        !VarSet, !SVarState, !Specs) :-
    % For efficiency, we construct `VarsArgs' backwards and then reverse it
    % to get the correct order.
    make_fresh_arg_vars_subst_svars_loop(Args, Vars, [], RevVarsArgs,
        !VarSet, !SVarState, !Specs),
    list.reverse(RevVarsArgs, VarsArgs).

:- pred make_fresh_arg_vars_subst_svars_loop(
    list(prog_term)::in, list(prog_var)::out,
    list(unify_var_term)::in, list(unify_var_term)::out,
    prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
    list(error_spec)::in, list(error_spec)::out) is det.

make_fresh_arg_vars_subst_svars_loop([], [],
        !RevVarsArgs, !VarSet, !SVarState, !Specs).
make_fresh_arg_vars_subst_svars_loop([Arg | Args], [Var | Vars],
        !RevVarsArgs, !VarSet, !SVarState, !Specs) :-
    make_fresh_arg_var_subst_svars(Arg, Var, !RevVarsArgs,
        !VarSet, !SVarState, !Specs),
    make_fresh_arg_vars_subst_svars_loop(Args, Vars,
        !RevVarsArgs, !VarSet, !SVarState, !Specs).

:- pred make_fresh_arg_var_subst_svars(prog_term::in, prog_var::out,
    list(unify_var_term)::in, list(unify_var_term)::out,
    prog_varset::in, prog_varset::out, svar_state::in, svar_state::out,
    list(error_spec)::in, list(error_spec)::out) is det.

make_fresh_arg_var_subst_svars(Arg0, Var, !RevVarsArgs,
        !VarSet, !SVarState, !Specs) :-
    substitute_state_var_mapping(Arg0, Arg, !VarSet, !SVarState, !Specs),
    (
        Arg = term.variable(ArgVar, _),
        ( if have_seen_arg_var(!.RevVarsArgs, ArgVar) then
            % This is the second or later appearance of ArgVar
            % in the argument list.
            varset.new_var(Var, !VarSet)
        else
            Var = ArgVar
        )
    ;
        Arg = term.functor(_, _, _),
        varset.new_var(Var, !VarSet)
    ),
    !:RevVarsArgs = [unify_var_term(Var, Arg) | !.RevVarsArgs].

:- pred have_seen_arg_var(list(unify_var_term)::in, prog_var::in) is semidet.

have_seen_arg_var([RevUnifyVarTerm | RevUnifyVarTerms], ArgVar) :-
    RevUnifyVarTerm = unify_var_term(RevVar, _),
    ( if RevVar = ArgVar then
        true
    else
        have_seen_arg_var(RevUnifyVarTerms, ArgVar)
    ).

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

:- pred make_fresh_arg_var_no_svar(prog_term::in, prog_var::out,
    list(prog_var)::in, prog_varset::in, prog_varset::out) is det.

make_fresh_arg_var_no_svar(Arg, Var, Vars0, !VarSet) :-
    ( if
        Arg = term.variable(ArgVar, _),
        not list.member(ArgVar, Vars0)
    then
        Var = ArgVar
    else
        varset.new_var(Var, !VarSet)
    ).

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

:- pred occurs_check(module_info::in, prog_varset::in, ancestor_var_map::in,
    prog_var::in, list(error_spec)::in, list(error_spec)::out) is det.

occurs_check(ModuleInfo, VarSet, AncestorVarMap, Var, !Specs) :-
    ( if map.search(AncestorVarMap, Var, AncestorContext) then
        module_info_get_globals(ModuleInfo, Globals),
        globals.lookup_bool_option(Globals,
            warn_suspected_occurs_check_failure, WarnOccursCheck),
        (
            WarnOccursCheck = no
        ;
            WarnOccursCheck = yes,
            varset.lookup_name(VarSet, Var, VarName),
            Pieces = [words("Warning: the variable"), quote(VarName),
                words("is unified with a term containing itself."), nl],
            Spec = simplest_spec($pred, severity_warning,
                phase_parse_tree_to_hlds, AncestorContext, Pieces),
            !:Specs = [Spec | !.Specs]
        )
    else
        true
    ).

%-----------------------------------------------------------------------------%
:- end_module hlds.make_hlds.superhomogeneous.
%-----------------------------------------------------------------------------%
