%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2005-2012 The University of Melbourne.
% Copyright (C) 2014-2021, 2025-2026 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_lambda.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 lambda expressions in clause bodies
% to superhomogeneous form.
%
%---------------------------------------------------------------------------%

:- module hlds.make_hlds.superhomogeneous_lambda.
:- interface.

:- import_module hlds.hlds_goal.
:- import_module hlds.make_hlds.state_var.
:- import_module hlds.make_hlds.superhomogeneous_util.
:- import_module parse_tree.
:- import_module parse_tree.prog_data.

:- import_module list.
:- import_module maybe.

:- 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, list(unify_sub_context)::in,
    prog_term::in, maybe({lambda_body_kind, prog_term})::in, expansion::out,
    svar_state::in, unravel_info::in, unravel_info::out) is det.

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

:- implementation.

:- import_module hlds.goal_vars.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_goal.
:- import_module hlds.make_goal.
:- import_module hlds.make_hlds.goal_expr_to_goal.
:- import_module hlds.make_hlds.qual_info.
:- import_module hlds.make_hlds.superhomogeneous.
:- import_module hlds.mode_test.
:- import_module hlds.mode_util.
:- import_module hlds.passes_aux.
:- import_module hlds.status.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.error_spec.
:- import_module parse_tree.maybe_error.
:- import_module parse_tree.module_qual.
:- import_module parse_tree.module_qual.id_set.
:- import_module parse_tree.module_qual.mq_info.
:- import_module parse_tree.module_qual.qualify_items.
:- 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_tree_out_misc.
:- import_module parse_tree.parse_tree_out_term.
:- import_module parse_tree.prog_item.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_util.
:- import_module parse_tree.set_of_var.
:- import_module parse_tree.var_db.

:- import_module cord.
:- import_module int.
:- import_module io.
:- import_module map.
:- import_module one_or_more.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module term.
:- import_module term_vars.
:- import_module varset.

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

parse_lambda_expr(XVar, Purity, Context, MainContext, SubContext,
        PurityPFArgsDetTerm, MaybeLambdaBody, Expansion, SVarState, !UrInfo) :-
    (
        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),
        VarSet0 = !.UrInfo ^ ui_varset,
        (
            LambdaBodyKind = lambda_body_ordinary,
            parse_goal(GenericBodyGoalTerm, ContextPieces,
                MaybeBodyGoal0, VarSet0, VarSet),
            MaybeDCGVars = no_dcg_vars
        ;
            LambdaBodyKind = lambda_body_dcg,
            parse_dcg_pred_goal(GenericBodyGoalTerm, ContextPieces,
                MaybeBodyGoal0, DCGVar0, DCGVarN, VarSet0, VarSet),
            MaybeDCGVars = dcg_vars(DCGVar0, DCGVarN)
        ),
        !UrInfo ^ ui_varset := VarSet,
        (
            MaybeBodyGoal0 = ok2(BodyGoal, BodyGoalWarningSpecs),
            add_unravel_specs(BodyGoalWarningSpecs, !UrInfo),
            MaybeBodyGoal = ok1(BodyGoal)
        ;
            MaybeBodyGoal0 = error2(BodyGoalSpecs),
            MaybeBodyGoal = error1(BodyGoalSpecs)
        )
    ),
    parse_lambda_purity_pf_args_det_term(PurityPFArgsDetTerm, MaybeDCGVars,
        MaybeLambdaHead, !UrInfo),
    (
        MaybeLambdaHead = error1(LambdaHeadSpecs),
        add_unravel_oom_specs(LambdaHeadSpecs, !UrInfo),
        record_unravel_found_syntax_error(!UrInfo),
        Expansion = expansion(not_fgti, cord.empty)
    ;
        MaybeLambdaHead = ok1(LambdaHead),
        build_lambda_expression(XVar, Purity, Context, MainContext, SubContext,
            LambdaHead, MaybeBodyGoal, Expansion, SVarState, !UrInfo)
    ).

:- 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,
    unravel_info::in, unravel_info::out) is det.

parse_lambda_purity_pf_args_det_term(PurityPFArgsDetTerm, MaybeDCGVars,
        MaybeLambdaHead, !UrInfo) :-
    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
        VarSet0 = !.UrInfo ^ ui_varset,
        parse_lambda_detism(VarSet0, DetismTerm, MaybeDetism),
        (
            MaybeFuncRetArgModeTerm = no,
            PredOrFunc = pf_predicate,
            (
                MaybeDCGVars = no_dcg_vars,
                ArgModeTerms = ArgModeTerms0,
                parse_lambda_args_pred(Context, ArgModeTerms,
                    LambdaArgs, BadModeSpecs, SVarSpecs, !UrInfo),
                LambdaHead = lambda_head(LambdaPurity, Groundness, PredOrFunc,
                    LambdaArgs, BadModeSpecs, SVarSpecs, MaybeDetism),
                MaybeLambdaHead = ok1(LambdaHead)
            ;
                MaybeDCGVars = dcg_vars(DCGVar0, DCGVarN),
                (
                    ( ArgModeTerms0 = []
                    ; ArgModeTerms0 = [_]
                    ),
                    Pieces = [words("Error:")] ++
                        color_as_subject([words("the head of a"),
                            words("lambda expression that is defined"),
                            words("by a DCG clause")]) ++
                        color_as_incorrect([words("must have"),
                            words("at least two arguments.")]) ++
                        [nl],
                    Spec = spec($pred, severity_error, phase_pt2h,
                        Context, Pieces),
                    MaybeLambdaHead =
                        error1(one_or_more(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, BadModeSpecs, SVarSpecs, !UrInfo),
                    LambdaHead = lambda_head(LambdaPurity, Groundness,
                        PredOrFunc, 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, BadModeSpecs, SVarSpecs, !UrInfo),
                LambdaHead = lambda_head(LambdaPurity, Groundness, PredOrFunc,
                    LambdaArgs, BadModeSpecs, SVarSpecs, MaybeDetism),
                MaybeLambdaHead = ok1(LambdaHead)
            ;
                MaybeDCGVars = dcg_vars(_, _),
                Pieces = [words("Error: DCG notation is")] ++
                    color_as_incorrect([words("not allowed")]) ++
                    [words("in")] ++
                    color_as_subject([words("clauses for functions.")]) ++
                    [nl],
                Spec = spec($pred, severity_error, phase_pt2h,
                    Context, Pieces),
                MaybeLambdaHead =
                    error1(one_or_more(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, BadModeSpecs, SVarSpecs, !UrInfo),
            MaybeDetism = ok1(detism_det),
            LambdaHead = lambda_head(LambdaPurity, Groundness, PredOrFunc,
                LambdaArgs, BadModeSpecs, SVarSpecs, MaybeDetism),
            MaybeLambdaHead = ok1(LambdaHead)
        ;
            MaybeDCGVars = dcg_vars(_, _),
            Pieces = [words("Error: DCG notation is")] ++
                color_as_incorrect([words("not allowed")]) ++
                [words("in")] ++
                color_as_subject([words("clauses for functions.")]) ++
                [nl],
            Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces),
            MaybeLambdaHead = error1(one_or_more(Spec, []))
        )
    else
        Form1 = "pred(<args>) is <determinism>",
        Form2 = "any_pred(<args>) is <determinism>",
        Form3 = "func(<args>) = <retarg> is <determinism>",
        Form4 = "any_func(<args>) = <retarg> is <determinism>",
        Form5 = "func(<args>) = <retarg>",
        Form6 = "any_func(<args>) = <retarg>",
        Pieces =
            [words("Error: the clause head part of a lambda expression")] ++
            color_as_incorrect(
                [words("must have one of the following forms:")]) ++
            color_as_correct([quote(Form1)]) ++ [nl] ++
            color_as_correct([quote(Form2)]) ++ [nl] ++
            color_as_correct([quote(Form3)]) ++ [nl] ++
            color_as_correct([quote(Form4)]) ++ [nl] ++
            color_as_correct([quote(Form5)]) ++ [nl] ++
            color_as_correct([quote(Form6)]) ++ [suffix(","), nl,
            words("or one of those forms preceded by either"),
            quote("semipure"), words("or"), quote("impure"), suffix("."), nl],
        Context = get_term_context(PFArgsDetTerm),
        Spec = spec($pred, severity_error, phase_pt2h, Context, Pieces),
        record_unravel_found_syntax_error(!UrInfo),
        MaybeLambdaHead = error1(one_or_more(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, list(error_spec)::out, list(error_spec)::out,
    unravel_info::in, unravel_info::out) is det.

parse_lambda_args_func(Context, ArgModeTerms, FuncRetArgModeTerm,
        LambdaArgs, !:BadModeSpecs, !:SVarSpecs, !UrInfo) :-
    !:BadModeSpecs = [],
    !:SVarSpecs = [],
    parse_lambda_args(lambda_arg_ordinary,
        ArgModeTerms, OrdinaryLambdaArgs, 1, ResultArgNum,
        !BadModeSpecs, !SVarSpecs, !UrInfo),
    parse_lambda_arg(lambda_arg_func_result,
        FuncRetArgModeTerm, FuncRetLambdaArg, ResultArgNum, _,
        !BadModeSpecs, !SVarSpecs, !UrInfo),
    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, list(error_spec)::out, list(error_spec)::out,
    unravel_info::in, unravel_info::out) is det.

parse_lambda_args_pred(Context, ArgModeTerms,
        LambdaArgs, !:BadModeSpecs, !:SVarSpecs, !UrInfo) :-
    !:BadModeSpecs = [],
    !:SVarSpecs = [],
    parse_lambda_args(lambda_arg_ordinary, ArgModeTerms, LambdaArgs, 1, _,
        !BadModeSpecs, !SVarSpecs, !UrInfo),
    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) :-
    AbsentArgPieces =
        list.map(func(Arg) = nth_fixed(Arg ^ la_arg_num), AbsentArgs),
    AbsentArgsDotPieces = piece_list_to_color_pieces(color_incorrect, "and",
        [suffix(".")], AbsentArgPieces),
    Pieces = [words("Error: in head of lambda expression:")] ++
        color_as_incorrect(
            [words("some but not all arguments have modes.")]) ++
        [nl,
        words("The arguments without modes are the")] ++
        AbsentArgsDotPieces ++ [nl],
    Spec = spec($pred, severity_error, phase_pt2h, 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:")] ++
        color_as_incorrect([words("none of the arguments have modes.")]) ++
        [nl],
    Spec = spec($pred, severity_error, phase_pt2h, 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,
    list(error_spec)::in, list(error_spec)::out,
    list(error_spec)::in, list(error_spec)::out,
    unravel_info::in, unravel_info::out) is det.

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

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

parse_lambda_arg(Kind, ArgModeTerm, LambdaArg, !ArgNum,
        !BadModeSpecs, !SVarSpecs, !UrInfo) :-
    ( 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:")]),
        VarSet0 = !.UrInfo ^ ui_varset,
        varset.coerce(VarSet0, 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 = one_or_more_to_list(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
        VarSet1 = !.UrInfo ^ ui_varset,
        (
            Kind = lambda_arg_ordinary,
            SVarSpec = report_illegal_bang_svar_lambda_arg_raw(StateVarContext,
                VarSet1, StateVar)
        ;
            Kind = lambda_arg_func_result,
            SVarSpec = report_illegal_func_svar_result_raw(StateVarContext,
                VarSet1, StateVar)
        ),
        !:SVarSpecs = [SVarSpec | !.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),
    create_new_named_unravel_var(LambdaVarName, LambdaVar, !UrInfo),
    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:")] ++ color_as_incorrect([words(TermStr)]) ++
            [words("is not a valid determinism."), nl],
        Spec = spec($pred, severity_error, phase_t2pt,
            get_term_context(DetismTerm), Pieces),
        MaybeDetism = error1(one_or_more(Spec, []))
    ).

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

:- type lambda_head
    --->    lambda_head(
                purity,
                ho_groundness,
                pred_or_func,
                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.
            ).

    % 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.
    %
:- pred build_lambda_expression(prog_var::in, purity::in,
    prog_context::in, unify_main_context::in, list(unify_sub_context)::in,
    lambda_head::in, maybe1(goal)::in, expansion::out,
    svar_state::in, unravel_info::in, unravel_info::out) is det.

build_lambda_expression(LHSVar, UnificationPurity,
        Context, MainContext, SubContext, LambdaHead, MaybeBodyGoal,
        Expansion, OutsideSVarState, !UrInfo) :-
    LambdaHead = lambda_head(LambdaPurity, Groundness, PredOrFunc,
        LambdaArgs0, BadModeSpecs, SVarSpecs, MaybeDetism),
    qualify_lambda_arg_modes_if_not_opt_imported(LambdaArgs0, LambdaArgs1,
        Modes, !UrInfo),
    VarSet0 = !.UrInfo ^ ui_varset,
    varset.coerce(VarSet0, TVarSet),
    varset.coerce(VarSet0, InstVarSet),
    warn_about_any_inconsistent_inst_vars(InstVarSet, Context, Modes, !UrInfo),
    (
        MaybeDetism = ok1(Detism)
    ;
        MaybeDetism = error1(DetismSpecs),
        add_unravel_oom_specs(DetismSpecs, !UrInfo),
        % Due to the error, this dummy value won't be used.
        Detism = detism_det
    ),
    (
        MaybeBodyGoal = ok1(BodyGoal)
    ;
        MaybeBodyGoal = error1(BodyGoalSpecs),
        add_unravel_oom_specs(BodyGoalSpecs, !UrInfo),
        record_unravel_found_syntax_error(!UrInfo),
        % Due to the error, this dummy value won't be used.
        BodyGoal = true_expr(Context)
    ),

    ArgSpecs = BadModeSpecs ++ SVarSpecs,
    (
        ArgSpecs = [_ | _],
        add_unravel_specs(ArgSpecs, !UrInfo),
        record_unravel_found_syntax_error(!UrInfo),
        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, NewSVars, OutsideSVarState,
                !:SVarState, !UrInfo),
            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.
            ModuleInfo0 = !.UrInfo ^ ui_module_info,
            partition_args_and_lambda_vars(ModuleInfo0, LambdaArgs1, ArgTerms,
                NonOutputLambdaVarsArgs, OutputLambdaVarsArgs),

            PredFormArity = arg_list_arity(ArgTerms),
            ArgContext = ac_head(PredOrFunc, PredFormArity),

            % 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, !UrInfo),

            map.init(EmptyRenaming),
            transform_parse_tree_goal_to_hlds(loc_whole_goal, EmptyRenaming,
                BodyGoal, Body, !SVarState, !UrInfo),

            % 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, !UrInfo),

            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(ModuleInfo0, 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, ModuleInfo0, vns_varset(VarSet0),
                    TVarSet, InstVarSet, HeadBefore, !IO),
                io.write_string(DebugStream, "lambda body:\n", !IO),
                dump_goal_nl(DebugStream, ModuleInfo0, vns_varset(VarSet0),
                    TVarSet, InstVarSet, Body, !IO),
                io.write_string(DebugStream,
                    "lambda arg unifies after:\n", !IO),
                dump_goal_nl(DebugStream, ModuleInfo0, vns_varset(VarSet0),
                    TVarSet, InstVarSet, 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,
            svar_finish_lambda_body(Context, Modes, NewSVars, FinalSVarMap,
                BodyGoal, [HeadBefore, Body, HeadAfter], HLDS_Goal0,
                InitialSVarState, FinalSVarState, !UrInfo),

            % 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.vars_in_terms(QuantifiedArgTerms, QuantifiedVars0),
            list.sort_and_remove_dups(QuantifiedVars0, QuantifiedVars),

            goal_info_init(Context, GoalInfo),
            Reason = exist_quant(QuantifiedVars, compiler_quant),
            HLDS_GoalExpr = scope(Reason, 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] (
                vars_in_goal(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,
                LambdaNonLocals, LambdaVarsModes, Detism, HLDS_Goal),
            create_atomic_complicated_unification(LHSVar, LambdaRHS,
                Context, MainContext, SubContext, UnificationPurity, Goal)
        )
    ),
    Expansion = expansion(not_fgti, cord.singleton(Goal)).

:- pred warn_about_any_inconsistent_inst_vars(inst_varset::in,
    prog_context::in, list(mer_mode)::in,
    unravel_info::in, unravel_info::out) is det.

warn_about_any_inconsistent_inst_vars(InstVarSet, Context, Modes, !UrInfo) :-
    inconsistent_constrained_inst_vars_in_modes(Modes, InconsistentVars),
    (
        InconsistentVars = []
    ;
        InconsistentVars = [_ | _],
        VarPieces = list.map(var_to_quote_piece(InstVarSet), InconsistentVars),
        Pieces = [words("Error: the constraints on the inst"),
            words(choose_number(InconsistentVars, "variable", "variables"))] ++
            piece_list_to_color_pieces(color_subject, "and", [], VarPieces) ++
            color_as_incorrect([words("are inconsistent.")]) ++ [nl],
        Spec = spec($pred, severity_error, phase_t2pt, Context, Pieces),
        add_unravel_spec(Spec, !UrInfo)
    ).

    % 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,
    unravel_info::in, unravel_info::out) is det.

qualify_lambda_arg_modes_if_not_opt_imported(LambdaArgs0, LambdaArgs,
        Modes, !UrInfo) :-
    QualInfo0 = !.UrInfo ^ ui_qual_info,
    qual_info_get_maybe_opt_imported(QualInfo0, 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(QualInfo0, MQInfo0),
        qualify_lambda_arg_modes(InInt, LambdaArgs0, LambdaArgs, Modes,
            MQInfo0, MQInfo),
        qual_info_set_mq_info(MQInfo, QualInfo0, QualInfo),
        !UrInfo ^ ui_qual_info := 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) is det.

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

%---------------------------------------------------------------------------%
:- end_module hlds.make_hlds.superhomogeneous_lambda.
%---------------------------------------------------------------------------%
