%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2009-2012 The University of Melbourne.
% Copyright (C) 2015 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public Licence - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: try_expand.m
% Author: wangp.
%
% Try goals are implemented by replacing them with calls to predicates in the
% `exception' module.  For example, goal such as:
%
%      (try [] p(X, Y)
%       then q(X, Y)
%       else r
%       catch ...
%      )
%
% is expanded to:
%
%      exception.try(
%          (pred(OutputTuple::out) is semidet :-
%              p(X, Y),
%              OutputTuple = {X, Y}
%          ), TryResult),
%      (
%          TryResult = succeeded({X, Y}),
%          q(X, Y)
%      ;
%          TryResult = failed,
%          r
%      ;
%          TryResult = exception(Excp),
%          ...exception handling...
%      )
%
% The transformation requires us to know which variables are bound in the
% higher order term that is passed to `try', as well as the determinism, so we
% can't transform them immediately when converting from the parse tree to HLDS
% representations.  But try goals have very complex control flows and we don't
% really want to write and maintain mode, determinism, and other analyses to
% work on them directly either.
%
% Instead, we cheat a little and "pre-transform" try goals very early on (when
% converting from a parse tree to an HLDS) into something that resembles
% somewhat the final forms, e.g.
%
%      magic_exception_result(TryResult),  % out(cannot_fail)
%      (
%          TryResult = succeeded({}),
%          ( if p(X, Y) then
%              q(X, Y)
%          else
%              r
%          )
%      ;
%          TryResult = exception(Excp),
%          ...exception handling...
%      )
%
% We let the semantic checks work on these pre-transformed goals.  Afterwards
% we pick out the various pieces and construct the proper, final goals.
%
%-----------------------------------------------------------------------------%
%
% PRE-TRANSFORMATION (implemented in add_clause.m)
%
% 1. try goal without I/O but with an else part
%
%      magic_exception_result(TryResult),  % out(cannot_fail)
%      (
%          TryResult = succeeded({}),
%          ( if <Goal> then
%              <Then>
%          else
%              <Else>
%          )
%      ;
%          TryResult = exception(Excp),
%          <ExcpHandling>
%      )
%
%   As intended, variables bound in <Goal> are only in scope within <Then>,
%   not <Else> nor <ExcpHandling>.
%
% 2. try goal without I/O and without an else part, or
% 3. try goal with I/O
%
%       magic_exception_result(TryResult),  % out(cannot_fail)
%       (
%           TryResult = succeeded({}),
%           some [] <Goal>,
%           some [] <Then>
%       ;
%           TryResult = exception(Excp),
%           <ExcpHandling>
%       )
%
%   The `some' scopes there so that we can distinguish between <Goal> and
%   <Then> later. (They act as barrier scopes, except we can't introduce
%   barrier scopes then.  We depend on the early analyses not to move things
%   in and out of `some' scopes.)
%
%-----------------------------------------------------------------------------%
%
% POST-TRANSFORMATION (implemented in this module)
%
% 1. try goal without I/O, and can fail
%
%      try((pred(OutputTuple::out) is semidet :-
%              <Goal>,
%              OutputTuple = { <BoundVars> }
%          ), TryResult),
%      (
%          TryResult = succeeded(TmpTupleVar),
%          inst_cast(TmpTupleVar, TupleVar),
%          TupleVar = { <BoundVars> },
%          <Then>
%      ;
%          TryResult = failed,
%          <Else>
%      ;
%          TryResult = exception(Excp),
%          <ExcpHandling>
%      )
%
% 2. try goal without I/O, and cannot fail
%
%      try((pred(OutputTuple::out) is det :-
%              <Goal>,
%              OutputTuple = { <BoundVars> }
%          ), TryResult),
%      (
%          TryResult = succeeded(TmpTupleVar),
%          inst_cast(TmpTupleVar, TupleVar),
%          TupleVar = { <BoundVars> },
%          <Then>
%      ;
%          TryResult = exception(Excp),
%          <ExcpHandling>
%      )
%
% 3. try goal with I/O
%
%      try_io((pred(OutputTuple::out, !.IO::di, !:IO::uo) is det :-
%              <Goal>,
%              OutputTuple = { <BoundVars> }
%          ), TryResult, !IO),
%      (
%          TryResult = succeeded(TmpTupleVar),
%          inst_cast(TmpTupleVar, TupleVar),
%          TupleVar = { <BoundVars> },
%          <Then>
%      ;
%          TryResult = exception(Excp),
%          <ExcpHandling>
%      )
%
%   We have to rename an io.state variable in ExcpHandling so that the sequence
%   begins with the output I/O state of the `try_io' call.
%
% The inst casts preserve the known insts of the BoundVars, which were lost due
% to the calls to try*.
%
% The <ExcpHandling> parts can be passed through from the pre-transformation.
% If a `catch_any' is present the exception handling looks like this:
%
%      ( if exc_univ_to_type(Excp, <CatchPattern1>) then
%          <CatchGoal1>
%      else if exc_univ_to_type(Excp, <CatchPattern2>) then
%          <CatchGoal2>
%      else
%          CatchAnyVar = exc_univ_value(Excp),
%          <CatchAnyGoal>
%      )
%
% Otherwise, if `catch_any' is not present:
%
%      ( if exc_univ_to_type(Excp, <CatchPattern1>) then
%          <CatchGoal1>
%      else if exc_univ_to_type(Excp, <CatchPattern2>) then
%          <CatchGoal2>
%      else
%          rethrow(TryResult)
%      )
%
%-----------------------------------------------------------------------------%

:- module check_hlds.try_expand.
:- interface.

:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module parse_tree.
:- import_module parse_tree.error_spec.

:- import_module io.
:- import_module list.

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

:- pred expand_try_goals_in_module(io.text_output_stream::in,
    module_info::in, module_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

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

:- implementation.

:- import_module check_hlds.det_analysis.
:- import_module check_hlds.det_report.
:- import_module check_hlds.modes.
:- import_module check_hlds.polymorphism_type_info.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_proc_util.
:- import_module hlds.instmap.
:- import_module hlds.make_goal.
:- import_module hlds.pred_table.
:- import_module hlds.quantification.
:- import_module mdbcomp.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.error_util.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_mode.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.set_of_var.
:- import_module parse_tree.var_table.

:- import_module bool.
:- import_module map.
:- import_module maybe.
:- import_module pair.
:- import_module require.
:- import_module string.
:- import_module term_context.

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

expand_try_goals_in_module(ProgressStream, !ModuleInfo, !Specs) :-
    % The exception module is implicitly imported if any try goals were seen,
    % so if the exception module is not imported, then we know there are
    % no try goals to be expanded.
    module_info_get_avail_module_map(!.ModuleInfo, AvailModuleMap),
    ( if map.search(AvailModuleMap, mercury_exception_module, _) then
        some [!Globals] (
            module_info_get_globals(!.ModuleInfo, !:Globals),
            disable_det_warnings(OptionsToRestore, !Globals),
            module_info_set_globals(!.Globals, !ModuleInfo),

            module_info_get_valid_pred_ids(!.ModuleInfo, PredIds),
            list.foldl2(expand_try_goals_in_pred(ProgressStream), PredIds,
                !ModuleInfo, !Specs),

            module_info_get_globals(!.ModuleInfo, !:Globals),
            restore_det_warnings(OptionsToRestore, !Globals),
            module_info_set_globals(!.Globals, !ModuleInfo)
        )
    else
        true
    ).

:- pred expand_try_goals_in_pred(io.text_output_stream::in, pred_id::in,
    module_info::in, module_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

expand_try_goals_in_pred(ProgressStream, PredId, !ModuleInfo, !Specs) :-
    module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
    ProcIds = pred_info_all_non_imported_procids(PredInfo),
    list.foldl2(expand_try_goals_in_proc(ProgressStream, PredId), ProcIds,
        !ModuleInfo, !Specs).

:- pred expand_try_goals_in_proc(io.text_output_stream::in,
    pred_id::in, proc_id::in, module_info::in, module_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

expand_try_goals_in_proc(ProgressStream, PredId, ProcId,
        !ModuleInfo, !Specs) :-
    some [!PredInfo, !ProcInfo] (
        module_info_pred_proc_info(!.ModuleInfo, PredId, ProcId,
            !:PredInfo, !:ProcInfo),
        proc_info_get_goal(!.ProcInfo, Goal0),
        proc_info_get_initial_instmap(!.ModuleInfo, !.ProcInfo, InitInstMap),

        Info0 = trys_info(!.ModuleInfo, !.PredInfo, !.ProcInfo, no),
        expand_try_goals_in_goal(InitInstMap, Goal0, Goal, Info0, Info),
        Info = trys_info(!:ModuleInfo, !:PredInfo, !:ProcInfo, Changed),

        (
            Changed = yes,
            update_changed_proc(ProgressStream, Goal, PredId, ProcId,
                !.PredInfo, !.ProcInfo, !ModuleInfo, !Specs),
            module_info_clobber_dependency_info(!ModuleInfo)
        ;
            Changed = no
        )
    ).

:- pred update_changed_proc(io.text_output_stream::in, hlds_goal::in,
    pred_id::in, proc_id::in,
    pred_info::in, proc_info::in, module_info::in, module_info::out,
    list(error_spec)::in, list(error_spec)::out) is det.

update_changed_proc(ProgressStream, Goal, PredId, ProcId, PredInfo,
        !.ProcInfo, !ModuleInfo, !Specs) :-
    proc_info_set_goal(Goal, !ProcInfo),
    requantify_proc_general(ord_nl_maybe_lambda, !ProcInfo),
    module_info_set_pred_proc_info(PredId, ProcId, PredInfo, !.ProcInfo,
        !ModuleInfo),

    map.init(ProcModeErrorMap0),
    modecheck_proc(PredId, ProcId, !ModuleInfo,
        ProcModeErrorMap0, _ProcModeErrorMap0, _Changed, ModeSpecs),
    module_info_get_globals(!.ModuleInfo, Globals),
    HasModeErrors = contains_errors(Globals, ModeSpecs),
    (
        HasModeErrors = yes,
        % In some cases we may detect mode errors after expanding try goals
        % which were missed before, so we don't abort the compiler, but we do
        % stop compiling not long after this pass.
        !:Specs = ModeSpecs ++ !.Specs,
        % Since the changed procedure is now invalid, delete it.
        % XXX If our caller needed PredInfo to be valid after the call
        % to this predicate, we would return it, but since it doesn't ...
        pred_info_get_proc_table(PredInfo, ProcTable0),
        map.delete(ProcId, ProcTable0, ProcTable),
        pred_info_set_proc_table(ProcTable, PredInfo, UpdatedPredInfo),
        module_info_set_pred_info(PredId, UpdatedPredInfo, !ModuleInfo)
    ;
        HasModeErrors = no,
        % Determinism errors should have been detected before expansion, but
        % compilation would continue anyway.
        % XXX It would be nice to replace any pre-expansion determinism error
        % messages (which mention the hidden predicate magic_exception_result)
        % with these error messages.
        determinism_check_proc(ProgressStream, PredId, ProcId, _DetismSpecs,
            !ModuleInfo)
    ).

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

:- type trys_info
    --->    trys_info(
                ti_module_info  :: module_info,
                ti_pred_info    :: pred_info,
                ti_proc_info    :: proc_info,
                ti_changed      :: bool
            ).

:- pred expand_try_goals_in_goal(instmap::in, hlds_goal::in, hlds_goal::out,
    trys_info::in, trys_info::out) is det.

expand_try_goals_in_goal(InstMap, Goal0, Goal, !Info) :-
    Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
    (
        GoalExpr0 = unify(_, _, _, _, _),
        Goal = Goal0
    ;
        GoalExpr0 = conj(ConjType, Conjuncts0),
        expand_try_goals_in_conj(InstMap, Conjuncts0, Conjuncts, !Info),
        GoalExpr = conj(ConjType, Conjuncts),
        Goal = hlds_goal(GoalExpr, GoalInfo0)
    ;
        GoalExpr0 = disj(Disjuncts0),
        expand_try_goals_in_disj(InstMap, Disjuncts0, Disjuncts, !Info),
        GoalExpr = disj(Disjuncts),
        Goal = hlds_goal(GoalExpr, GoalInfo0)
    ;
        GoalExpr0 = negation(SubGoal0),
        expand_try_goals_in_goal(InstMap, SubGoal0, SubGoal, !Info),
        GoalExpr = negation(SubGoal),
        Goal = hlds_goal(GoalExpr, GoalInfo0)
    ;
        GoalExpr0 = switch(Var, CanFail, Cases0),
        expand_try_goals_in_cases(InstMap, Cases0, Cases, !Info),
        GoalExpr = switch(Var, CanFail, Cases),
        Goal = hlds_goal(GoalExpr, GoalInfo0)
    ;
        GoalExpr0 = scope(Reason, InnerGoal0),
        (
            Reason = from_ground_term(_, from_ground_term_construct),
            % There can be no try goals inside this scope.
            Goal = Goal0
        ;
            ( Reason = exist_quant(_, _)
            ; Reason = disable_warnings(_, _)
            ; Reason = promise_solutions(_, _)
            ; Reason = promise_purity(_)
            ; Reason = require_detism(_)
            ; Reason = require_complete_switch(_)
            ; Reason = require_switch_arms_detism(_, _)
            ; Reason = commit(_)
            ; Reason = barrier(_)
            ; Reason = from_ground_term(_, from_ground_term_deconstruct)
            ; Reason = from_ground_term(_, from_ground_term_other)
            ; Reason = trace_goal(_, _, _, _, _)
            ; Reason = loop_control(_, _, _)
            ),
            expand_try_goals_in_goal(InstMap, InnerGoal0, InnerGoal, !Info),
            GoalExpr = scope(Reason, InnerGoal),
            Goal = hlds_goal(GoalExpr, GoalInfo0)
        ;
            Reason = from_ground_term(_, from_ground_term_initial),
            unexpected($pred, "from_ground_term_initial")
        )
    ;
        GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
        expand_try_goals_in_if_then_else(InstMap, Cond0, Cond, Then0, Then,
            Else0, Else, !Info),
        GoalExpr = if_then_else(Vars, Cond, Then, Else),
        Goal = hlds_goal(GoalExpr, GoalInfo0)
    ;
        ( GoalExpr0 = generic_call(_, _, _, _, _)
        ; GoalExpr0 = plain_call(_, _, _, _, _, _)
        ; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
        ),
        Goal = Goal0
    ;
        % This should be expanded out at this stage
        GoalExpr0 = shorthand(ShortHand0),
        (
            ShortHand0 = try_goal(_, _, _),
            expand_try_goal(InstMap, ShortHand0, Goal, !Info)
        ;
            ShortHand0 = atomic_goal(AtomicGoalType, Outer, Inner,
                MaybeOutputVars, MainGoal0, OrElseGoals0, OrElseInners),
            expand_try_goals_in_goal(InstMap, MainGoal0, MainGoal, !Info),
            expand_try_goals_in_disj(InstMap, OrElseGoals0, OrElseGoals,
                !Info),
            GoalExpr = atomic_goal(AtomicGoalType, Outer, Inner,
                MaybeOutputVars, MainGoal, OrElseGoals, OrElseInners),
            Goal = hlds_goal(shorthand(GoalExpr), GoalInfo0)
        ;
            ShortHand0 = bi_implication(_, _),
            unexpected($pred, "bi_implication")
        )
    ).

:- pred expand_try_goals_in_conj(instmap::in,
    list(hlds_goal)::in, list(hlds_goal)::out,
    trys_info::in, trys_info::out) is det.

expand_try_goals_in_conj(_InstMap0, [], [], !Info).
expand_try_goals_in_conj(InstMap0, [Goal0 | Goals0], [Goal | Goals], !Info) :-
    expand_try_goals_in_goal(InstMap0, Goal0, Goal, !Info),
    Goal0 = hlds_goal(_, GoalInfo),
    InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
    apply_instmap_delta(InstMapDelta, InstMap0, InstMap),
    expand_try_goals_in_conj(InstMap, Goals0, Goals, !Info).

:- pred expand_try_goals_in_disj(instmap::in,
    list(hlds_goal)::in, list(hlds_goal)::out,
    trys_info::in, trys_info::out) is det.

expand_try_goals_in_disj(InstMap0, Goals0, Goals, !Info) :-
    list.map_foldl(expand_try_goals_in_goal(InstMap0), Goals0, Goals, !Info).

:- pred expand_try_goals_in_cases(instmap::in, list(case)::in, list(case)::out,
    trys_info::in, trys_info::out) is det.

expand_try_goals_in_cases(_InstMap0, [], [], !Info).
expand_try_goals_in_cases(InstMap0, [Case0 | Cases0], [Case | Cases], !Info) :-
    Case0 = case(MainConsId, OtherConsIds, Goal0),
    expand_try_goals_in_goal(InstMap0, Goal0, Goal, !Info),
    expand_try_goals_in_cases(InstMap0, Cases0, Cases, !Info),
    Case = case(MainConsId, OtherConsIds, Goal).

:- pred expand_try_goals_in_if_then_else(instmap::in,
    hlds_goal::in, hlds_goal::out, hlds_goal::in,
    hlds_goal::out, hlds_goal::in, hlds_goal::out,
    trys_info::in, trys_info::out) is det.

expand_try_goals_in_if_then_else(InstMap0, Cond0, Cond, Then0, Then,
        Else0, Else, !Info) :-
    expand_try_goals_in_goal(InstMap0, Cond0, Cond, !Info),

    Cond0 = hlds_goal(_, CondInfo),
    CondInstMapDelta = goal_info_get_instmap_delta(CondInfo),
    apply_instmap_delta(CondInstMapDelta, InstMap0, InstMapAfterCond),
    expand_try_goals_in_goal(InstMapAfterCond, Then0, Then, !Info),

    expand_try_goals_in_goal(InstMap0, Else0, Else, !Info).

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

:- inst try_goal for shorthand_goal_expr/0
    --->    try_goal(ground, ground, ground).

:- pred expand_try_goal(instmap::in, shorthand_goal_expr::in(try_goal),
    hlds_goal::out, trys_info::in, trys_info::out) is det.

expand_try_goal(InstMap, TryGoal, FinalGoal, !Info) :-
    TryGoal = try_goal(MaybeIO, ResultVar, IntermediateGoal),
    extract_intermediate_goal_parts(!.Info ^ ti_module_info, ResultVar,
        IntermediateGoal, Goal0, Then0, MaybeElse0, ExcpHandling0),

    % Handle nested try goals.
    expand_try_goals_in_goal(InstMap, Goal0, Goal1, !Info),
    update_instmap(Goal0, InstMap, InstMapAfterGoal),
    expand_try_goals_in_goal(InstMapAfterGoal, Then0, Then1, !Info),
    (
        MaybeElse0 = yes(Else0),
        expand_try_goals_in_goal(InstMap, Else0, Else1, !Info),
        MaybeElse1 = yes(Else1)
    ;
        MaybeElse0 = no,
        MaybeElse1 = no
    ),
    expand_try_goals_in_goal(InstMap, ExcpHandling0, ExcpHandling1, !Info),

    % Find the output variables.  Note we use Goal0, not Goal1, as any nested
    % tries would have been transformed will mess up the calculation.
    bound_nonlocals_in_goal(!.Info ^ ti_module_info, InstMap, Goal0,
        GoalOutputVarsSet0),
    (
        MaybeIO = yes(try_io_state_vars(_IOStateVarInitial, IOStateVarFinal)),
        set_of_var.delete(IOStateVarFinal,
            GoalOutputVarsSet0, GoalOutputVarsSet)
    ;
        MaybeIO = no,
        GoalOutputVarsSet = GoalOutputVarsSet0
    ),

    some [!ModuleInfo, !PredInfo, !ProcInfo] (
        !.Info = trys_info(!:ModuleInfo, !:PredInfo, !:ProcInfo, _),
        expand_try_goal_2(MaybeIO, ResultVar, Goal1, Then1, MaybeElse1,
            ExcpHandling1, InstMapAfterGoal, GoalOutputVarsSet, FinalGoal,
            !PredInfo, !ProcInfo, !ModuleInfo),
        !:Info = trys_info(!.ModuleInfo, !.PredInfo, !.ProcInfo, yes)
    ).

:- pred expand_try_goal_2(maybe(try_io_state_vars)::in, prog_var::in,
    hlds_goal::in, hlds_goal::in, maybe(hlds_goal)::in, hlds_goal::in,
    instmap::in, set_of_progvar::in, hlds_goal::out,
    pred_info::in, pred_info::out, proc_info::in, proc_info::out,
    module_info::in, module_info::out) is det.

expand_try_goal_2(MaybeIO, ResultVar, Goal1, Then1, MaybeElse1, ExcpHandling1,
        InstMap, GoalOutputVarsSet, FinalGoal,
        !PredInfo, !ProcInfo, !ModuleInfo) :-
    some [!VarTable] (
        % Get the type of the output tuple.
        proc_info_get_var_table(!.ProcInfo, !:VarTable),
        GoalOutputVars = set_of_var.to_sorted_list(GoalOutputVarsSet),
        lookup_var_types(!.VarTable, GoalOutputVars, GoalOutputVarTypes),
        OutputTupleType = tuple_type(GoalOutputVarTypes, kind_star),

        % Fix the type of the result of the try call, now that we know what it
        % should be.
        RealResultVarType = defined_type(
            qualified(mercury_exception_module, "exception_result"),
            [OutputTupleType], kind_star),
        lookup_var_entry(!.VarTable, ResultVar, ResultVarEntry0),
        ResultVarEntry0 = vte(ResultVarName, _, _),
        ResultVarEntry = vte(ResultVarName, RealResultVarType,
            is_not_dummy_type),
        update_var_entry(ResultVar, ResultVarEntry, !VarTable),
        proc_info_set_var_table(!.VarTable, !ProcInfo)
    ),

    make_try_lambda(Goal1, GoalOutputVarsSet, OutputTupleType,
        MaybeIO, LambdaVar, AssignLambdaVar, !ProcInfo),

    Goal1 = hlds_goal(_, GoalInfo1),
    GoalPurity = goal_info_get_purity(GoalInfo1),
    GoalContext = goal_info_get_context(GoalInfo1),

    (
        MaybeIO = yes(try_io_state_vars(GoalInitialIOVar, GoalFinalIOVar)),

        % We need to rearrange I/O state variables a bit.
        %
        % Let Goal take the I/O state from GoalInitialIOVar to GoalFinalIOVar.
        % The input to try_io will be GoalInitialIOVar.
        % Let the output of try_io to be TryIOOutputVar.
        %
        % Due to the pre-transformation, ExcpHandling also takes the I/O state
        % from GoalInitialIOVar to GoalFinalIOVar.  We need to rename
        % GoalInitialIOVar to TryIOOutputVar as the exception handling code
        % follows the try_io call.
        %
        % We cannot let TryIOOutputVar be GoalFinalIOVar, as the latter may
        % already appear somewhere in ExcpHandling.  TryIOOutputVar must be a
        % new variable.
        %
        % The Then part starts the I/O state sequence from GoalFinalIOVar, so
        % we need to unify "GoalFinalIOVar = TryIOOutputVar".  We don't use
        % renaming in this case because GoalFinalIOVar might not even occur in
        % the Then part; then renaming would lead to a mode error.

        proc_info_create_var_from_type("TryIOOutput", io_state_type,
            is_dummy_type, TryIOOutputVar, !ProcInfo),
        make_try_call("try_io", LambdaVar, ResultVar,
            [GoalInitialIOVar, TryIOOutputVar], OutputTupleType, GoalPurity,
            GoalContext, CallTryGoal, !PredInfo, !ProcInfo, !ModuleInfo),

        create_pure_atomic_complicated_unification(GoalFinalIOVar,
            rhs_var(TryIOOutputVar), dummy_context,
            umc_implicit("try_expand"), [], UnifyThenInitialIOVar),
        conjoin_goals(UnifyThenInitialIOVar, Then1, Then),

        RenamingExcp =
            map.from_assoc_list([GoalInitialIOVar - TryIOOutputVar]),
        rename_some_vars_in_goal(RenamingExcp, ExcpHandling1, ExcpHandling)
    ;
        MaybeIO = no,
        make_try_call("try", LambdaVar, ResultVar, [], OutputTupleType,
            GoalPurity, GoalContext, CallTryGoal, !PredInfo, !ProcInfo,
            !ModuleInfo),
        Then = Then1,
        ExcpHandling = ExcpHandling1
    ),

    goal_info_init(GoalInfo),

    % The `succeeded' case.
    proc_info_create_var_from_type("TmpOutputTuple", OutputTupleType,
        is_not_dummy_type, TmpTupleVar, !ProcInfo),
    proc_info_create_var_from_type("OutputTuple", OutputTupleType,
        is_not_dummy_type, TupleVar, !ProcInfo),
    deconstruct_functor(ResultVar, exception_succeeded_functor, [TmpTupleVar],
        DeconstructSucceeded),
    instmap_lookup_vars(InstMap, GoalOutputVars, TupleArgInsts),
    make_output_tuple_inst_cast(TmpTupleVar, TupleVar, TupleArgInsts,
        CastOutputTuple),
    deconstruct_tuple(TupleVar, GoalOutputVars, DeconstructOutputs),
    conj_list_to_goal([DeconstructSucceeded, CastOutputTuple,
        DeconstructOutputs, Then], GoalInfo, DeconstructsThen),
    SucceededCase = case(exception_succeeded_functor, [], DeconstructsThen),

    % The `exception' case.
    ExceptionCase = case(exception_exception_functor, [], ExcpHandling),

    % The `failed' case.
    (
        MaybeElse1 = yes(Else1),
        FailedCase = case(exception_failed_functor, [], Else1),
        MaybeFailedCase = [FailedCase]
    ;
        MaybeElse1 = no,
        MaybeFailedCase = []
    ),

    Cases = [SucceededCase, ExceptionCase | MaybeFailedCase],
    ResultSwitch = hlds_goal(switch(ResultVar, cannot_fail, Cases), GoalInfo),
    conj_list_to_goal([AssignLambdaVar, CallTryGoal, ResultSwitch], GoalInfo,
        FinalGoal).

    % Pick out the parts of the original try goal from a pre-transformed goal.
    %
:- pred extract_intermediate_goal_parts(module_info::in, prog_var::in,
    hlds_goal::in, hlds_goal::out, hlds_goal::out, maybe(hlds_goal)::out,
    hlds_goal::out) is det.

extract_intermediate_goal_parts(ModuleInfo, ResultVar, IntermediateGoal,
        Goal, Then, MaybeElse, ExcpHandling) :-
    ( if
        extract_intermediate_goal_parts_2(ModuleInfo, ResultVar,
            IntermediateGoal, GoalPrime, ThenPrime, MaybeElsePrime,
            ExcpHandlingPrime)
    then
        Goal = GoalPrime,
        Then = ThenPrime,
        MaybeElse = MaybeElsePrime,
        ExcpHandling = ExcpHandlingPrime
    else if
        % This form should only be encountered if there was an error in the
        % program, when the inner goal may fail, in a context where it must not
        % fail.  Compilation doesn't stop immediately after determinism
        % analysis detects the error so we need to handle this form as well.
        IntermediateGoal = hlds_goal(scope(_, ScopedGoal), _),
        extract_intermediate_goal_parts_2(ModuleInfo, ResultVar,
            ScopedGoal, GoalPrime, ThenPrime, MaybeElsePrime,
            ExcpHandlingPrime)
    then
        Goal = GoalPrime,
        Then = ThenPrime,
        MaybeElse = MaybeElsePrime,
        ExcpHandling = ExcpHandlingPrime
    else
        unexpected($pred, "unexpected goal form")
    ).

:- pred extract_intermediate_goal_parts_2(module_info::in, prog_var::in,
    hlds_goal::in, hlds_goal::out, hlds_goal::out, maybe(hlds_goal)::out,
    hlds_goal::out) is semidet.

extract_intermediate_goal_parts_2(ModuleInfo, ResultVar, IntermediateGoal,
        Goal, Then, MaybeElse, ExcpHandling) :-
    IntermediateGoal = hlds_goal(conj(plain_conj, Conjuncts), _),
    Conjuncts = [
        hlds_goal(MagicCall, _),
        hlds_goal(Switch, _)
    ],
    MagicCall = plain_call(_, _, [ResultVar], _, _, _),
    Switch = switch(ResultVar, cannot_fail, Cases),

    lookup_case_goal(Cases, exception_succeeded_functor, SucceededGoal),
    extract_from_succeeded_goal(ModuleInfo, SucceededGoal, Goal, Then,
        MaybeElse),

    lookup_case_goal(Cases, exception_exception_functor, ExcpHandling).

    % There are two forms we could extract when TryResult has the
    % functor exception.succeeded/1.
    %
    %      TryResult = exception.succeeded(V),
    %      V = {},
    %      ( if Goal then
    %          Then
    %      else
    %          Else
    %      ),
    %      Rest
    %
    % or:
    %
    %      TryResult = exception.succeeded(V),
    %      V = {},
    %      some [] Goal,
    %      some [] Then,
    %      Rest
    %
:- pred extract_from_succeeded_goal(module_info::in, hlds_goal::in,
    hlds_goal::out, hlds_goal::out, maybe(hlds_goal)::out) is semidet.

extract_from_succeeded_goal(ModuleInfo, SucceededGoal, Goal, Then,
        MaybeElse) :-
    SucceededGoal = hlds_goal(conj(plain_conj, Conjuncts0), _),
    Conjuncts0 = [DeconstructResult, TestNullTuple | Conjuncts1],
    DeconstructResult = hlds_goal(unify(_ResultVar, _, _, _, _), _),
    TestNullTuple = hlds_goal(unify(_, TestRHS, _, _, _), _),
    TestRHS = rhs_functor(tuple_cons(0), is_not_exist_constr, []),

    ( if
        Conjuncts1 = [hlds_goal(IfThenElse, _) | Rest],
        IfThenElse = if_then_else(_, GoalPrime, Then0, Else0)
    then
        Goal = GoalPrime,

        % If Goal is erroneous the Then part may have been optimised away to
        % `true'.  However, we will be separating the Goal and Then parts in
        % the final goal, so the knowledge that Goal won't succeed will be lost
        % to the mode checker.  In that case we replace the Then goal by a call
        % to an `erroneous' procedure.
        Goal = hlds_goal(_, GoalInfo),
        GoalDetism = goal_info_get_determinism(GoalInfo),
        determinism_components(GoalDetism, _, GoalMaxSoln),
        (
            GoalMaxSoln = at_most_zero,
            make_unreachable_call(ModuleInfo, Then)
        ;
            ( GoalMaxSoln = at_most_one
            ; GoalMaxSoln = at_most_many_cc
            ; GoalMaxSoln = at_most_many
            ),
            conjoin_goal_and_goal_list(Then0, Rest, Then)
        ),

        conjoin_goal_and_goal_list(Else0, Rest, Else),
        MaybeElse = yes(Else)
    else
        Conjuncts1 = [SomeGoal | AfterSomeGoal],
        SomeGoal = hlds_goal(scope(exist_quant([], _), Goal), _),
        ( if
            AfterSomeGoal = [SomeThen | Rest],
            SomeThen = hlds_goal(scope(exist_quant([], _), Then0), _)
        then
            conjoin_goal_and_goal_list(Then0, Rest, Then),
            MaybeElse = no
        else
            % If "some [] Then" is missing then "some [] Goal" must be
            % `erroneous'.  Make the Then part into a call to an erroneous
            % procedure.
            Goal = hlds_goal(_, GoalInfo),
            GoalDetism = goal_info_get_determinism(GoalInfo),
            determinism_components(GoalDetism, _, GoalMaxSoln),
            (
                GoalMaxSoln = at_most_zero,
                make_unreachable_call(ModuleInfo, Then),
                MaybeElse = no
            ;
                ( GoalMaxSoln = at_most_one
                ; GoalMaxSoln = at_most_many_cc
                ; GoalMaxSoln = at_most_many
                ),
                unexpected($pred, "goal not erroneous")
            )
        )
    ).

:- pred lookup_case_goal(list(case)::in, cons_id::in, hlds_goal::out) is det.

lookup_case_goal([], ConsId, _) :-
    unexpected($pred, "couldn't find " ++ string(ConsId)).
lookup_case_goal([Case | Cases], ConsId, Goal) :-
    ( if Case = case(ConsId, [], GoalPrime) then
        Goal = GoalPrime
    else
        lookup_case_goal(Cases, ConsId, Goal)
    ).

:- pred bound_nonlocals_in_goal(module_info::in, instmap::in, hlds_goal::in,
    set_of_progvar::out) is det.

bound_nonlocals_in_goal(ModuleInfo, InstMap, Goal, BoundNonLocals) :-
    Goal = hlds_goal(_, GoalInfo),
    NonLocals = goal_info_get_nonlocals(GoalInfo),
    InstMapDelta = goal_info_get_instmap_delta(GoalInfo),
    BoundNonLocals = set_of_var.filter(
        var_is_bound_in_instmap_delta(ModuleInfo, InstMap, InstMapDelta),
        NonLocals).

:- pred make_try_lambda(hlds_goal::in, set_of_progvar::in,
    mer_type::in, maybe(try_io_state_vars)::in, prog_var::out, hlds_goal::out,
    proc_info::in, proc_info::out) is det.

make_try_lambda(Body0, OutputVarsSet, OutputTupleType, MaybeIO,
        LambdaVar, AssignLambdaVarGoal, !ProcInfo) :-
    Body0 = hlds_goal(_, BodyInfo0),
    NonLocals0 = goal_info_get_nonlocals(BodyInfo0),
    set_of_var.difference(NonLocals0, OutputVarsSet, NonLocals1),

    proc_info_create_var_from_type("OutputTuple", OutputTupleType,
        is_not_dummy_type, OutputTupleVar, !ProcInfo),
    (
        MaybeIO = yes(try_io_state_vars(IOVarInitial, IOVarFinal)),
        LambdaParamsModes = [OutputTupleVar - out_mode,
            IOVarInitial - di_mode, IOVarFinal - uo_mode],
        LambdaParamTypes = [OutputTupleType, io_state_type, io_state_type],
        set_of_var.delete(IOVarFinal, NonLocals1, NonLocals)
    ;
        MaybeIO = no,
        LambdaParamsModes = [OutputTupleVar - out_mode],
        LambdaParamTypes = [OutputTupleType],
        NonLocals = NonLocals0
    ),
    LambdaType = higher_order_type(pf_predicate, LambdaParamTypes,
        none_or_default_func, purity_pure),
    proc_info_create_var_from_type("TryLambda", LambdaType,
        is_not_dummy_type, LambdaVar, !ProcInfo),

    % Add the construction of OutputTuple to the body.
    construct_tuple(OutputTupleVar, set_of_var.to_sorted_list(OutputVarsSet),
        MakeOutputTuple),
    conjoin_goals(Body0, MakeOutputTuple, LambdaBody0),

    % Rename away output variables in the lambda body.
    proc_info_get_var_table(!.ProcInfo, VarTable0),
    clone_variables(set_of_var.to_sorted_list(OutputVarsSet),
        VarTable0, VarTable0, VarTable, map.init, Renaming),
    proc_info_set_var_table(VarTable, !ProcInfo),
    rename_some_vars_in_goal(Renaming, LambdaBody0, LambdaBody),

    % Get the determinism of the lambda.
    LambdaBody = hlds_goal(_, BodyGoalInfo),
    BodyDetism = goal_info_get_determinism(BodyGoalInfo),
    detism_to_try_lambda_detism(BodyDetism, LambdaDetism),

    % Make the lambda assignment.
    RHS = rhs_lambda_goal(purity_pure, ho_ground, pf_predicate,
        set_of_var.to_sorted_list(NonLocals), LambdaParamsModes,
        LambdaDetism, LambdaBody),
    create_pure_atomic_complicated_unification(LambdaVar, RHS,
        dummy_context, umc_implicit("try_expand"), [],
        AssignLambdaVarGoal0),
    goal_add_feature(feature_lambda_from_try,
        AssignLambdaVarGoal0, AssignLambdaVarGoal).

    % try* don't cover all possible determinisms so we have generate lambdas
    % with less restrictive determinisms.
    %
:- pred detism_to_try_lambda_detism(determinism::in, determinism::out) is det.

detism_to_try_lambda_detism(detism_det, detism_det).
detism_to_try_lambda_detism(detism_semi, detism_semi).
detism_to_try_lambda_detism(detism_multi, detism_cc_multi).
detism_to_try_lambda_detism(detism_non, detism_cc_non).
detism_to_try_lambda_detism(detism_cc_multi, detism_cc_multi).
detism_to_try_lambda_detism(detism_cc_non, detism_cc_non).
detism_to_try_lambda_detism(detism_erroneous, detism_det).
detism_to_try_lambda_detism(detism_failure, detism_semi).

:- pred make_try_call(string::in, prog_var::in, prog_var::in,
    list(prog_var)::in, mer_type::in, purity::in, prog_context::in,
    hlds_goal::out,
    pred_info::in, pred_info::out, proc_info::in, proc_info::out,
    module_info::in, module_info::out) is det.

make_try_call(PredName, LambdaVar, ResultVar, ExtraArgs, OutputTupleType,
        GoalPurity, Context, OverallGoal, !PredInfo, !ProcInfo, !ModuleInfo) :-
    polymorphism_make_type_info_var_mi(OutputTupleType, Context,
        TypeInfoVar, MakeTypeInfoGoals, !ModuleInfo, !PredInfo, !ProcInfo),

    % The mode will be fixed up by a later analysis.
    Mode = mode_no(0),
    Features = [],
    generate_plain_call(!.ModuleInfo, pf_predicate,
        mercury_exception_module, PredName,
        [TypeInfoVar], [LambdaVar, ResultVar] ++ ExtraArgs,
        instmap_delta_bind_no_var, Mode,
        detism_cc_multi, purity_pure, Features, Context, CallGoal0),

    goal_info_init(Context, GoalInfo),

    % The try* predicates are only implemented for pure lambdas.  If the lambda
    % is actually non-pure, retain that in the call to try* with a purity
    % scope.
    (
        GoalPurity = purity_pure,
        CallGoal = CallGoal0
    ;
        ( GoalPurity = purity_semipure
        ; GoalPurity = purity_impure
        ),
        ScopeReason = promise_purity(GoalPurity),
        CallGoal = hlds_goal(scope(ScopeReason, CallGoal0), GoalInfo)
    ),

    conj_list_to_goal(MakeTypeInfoGoals ++ [CallGoal], GoalInfo, OverallGoal).

:- pred make_unreachable_call(module_info::in, hlds_goal::out) is det.

make_unreachable_call(ModuleInfo, Goal) :-
    generate_plain_call(ModuleInfo, pf_predicate,
        mercury_exception_module, "unreachable",
        [], [], instmap_delta_bind_no_var, only_mode,
        detism_erroneous, purity_pure, [], dummy_context, Goal).

:- pred make_output_tuple_inst_cast(prog_var::in, prog_var::in,
    list(mer_inst)::in, hlds_goal::out) is det.

make_output_tuple_inst_cast(TmpTupleVar, TupleVar, TupleArgInsts,
        CastOrUnify) :-
    % If all the arguments have inst `ground' then a unification is enough.
    ( if
        list.member(ArgInst, TupleArgInsts),
        ArgInst \= ground(_, none_or_default_func)
    then
        TupleArity = list.length(TupleArgInsts),
        TupleInst = bound(shared, inst_test_no_results, [
            bound_functor(tuple_cons(TupleArity), TupleArgInsts)
        ]),
        generate_cast_with_insts(unsafe_type_inst_cast, TmpTupleVar, TupleVar,
            ground_inst, TupleInst, dummy_context, CastOrUnify)
    else
        create_pure_atomic_complicated_unification(TupleVar,
            rhs_var(TmpTupleVar), dummy_context,
            umc_implicit("try_expand"), [], CastOrUnify)
    ).

%-----------------------------------------------------------------------------%
:- end_module check_hlds.try_expand.
%-----------------------------------------------------------------------------%
