    {-# LANGUAGE ConstraintKinds  #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE RankNTypes       #-}
    {-# LANGUAGE RecordWildCards  #-}
    {-# LANGUAGE TupleSections    #-}
    {-# LANGUAGE TypeFamilies     #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}

    {-
    (c) The University of Glasgow 2006
    (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    (c) The University of Iowa 2023

    -}

    -- | Expand @Do@ block statements into @(>>=)@, @(>>)@ and @let@s
    --   After renaming but right ebefore type checking
    module GHC.Tc.Gen.Do (expandDoStmts) where

    import GHC.Prelude

    import GHC.Rename.Utils ( wrapGenSpan, genHsExpApps, genHsApp, genHsLet,
                              genHsLamDoExp, genHsCaseAltDoExp, genWildPat )
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Gen.Pat
    import GHC.Tc.Utils.TcMType

    import GHC.Hs

    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Driver.DynFlags ( DynFlags, getDynFlags )
    import GHC.Driver.Ppr (showPpr)

    import GHC.Types.SrcLoc
    import GHC.Types.Basic
    import qualified GHC.LanguageExtensions as LangExt

    import Data.List ((\\))

    {-
    ************************************************************************
    *                                                                      *
    \subsection{XXExprGhcRn for Do Statements}
    *                                                                      *
    ************************************************************************
    -}

    -- | Expand the `do`-statments into expressions right after renaming
    --   so that they can be typechecked.
    --   See Note [Expanding HsDo with XXExprGhcRn] below for `HsDo` specific commentary
    --   and Note [Handling overloaded and rebindable constructs] for high level commentary
    expandDoStmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn)
    expandDoStmts :: HsDoFlavour
    -> [ExprLStmt (GhcPass 'Renamed)]
    -> TcM (LHsExpr (GhcPass 'Renamed))
    expandDoStmts HsDoFlavour
    doFlav [ExprLStmt (GhcPass 'Renamed)]
    stmts = do expanded_expr <- HsDoFlavour
    -> [ExprLStmt (GhcPass 'Renamed)]
    -> TcM (LHsExpr (GhcPass 'Renamed))
    expand_do_stmts HsDoFlavour
    doFlav [ExprLStmt (GhcPass 'Renamed)]
    stmts
                                    case expanded_expr of
                                             L SrcSpanAnnA
    _ (XExpr (PopErrCtxt LHsExpr (GhcPass 'Renamed)
    e)) -> LocatedA (HsExpr (GhcPass 'Renamed))
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr (GhcPass 'Renamed)))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return LHsExpr (GhcPass 'Renamed)
    LocatedA (HsExpr (GhcPass 'Renamed))
    e
                                             -- The first expanded stmt doesn't need a pop as
                                             -- it would otherwise pop the "In the expression do ... " from
                                             -- the error context
                                             LocatedA (HsExpr (GhcPass 'Renamed))
    _                          -> LocatedA (HsExpr (GhcPass 'Renamed))
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr (GhcPass 'Renamed)))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return LocatedA (HsExpr (GhcPass 'Renamed))
    expanded_expr

    -- | The main work horse for expanding do block statements into applications of binds and thens
    --   See Note [Expanding HsDo with XXExprGhcRn]
    expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn)

    expand_do_stmts :: HsDoFlavour
    -> [ExprLStmt (GhcPass 'Renamed)]
    -> TcM (LHsExpr (GhcPass 'Renamed))
    expand_do_stmts HsDoFlavour
    ListComp [ExprLStmt (GhcPass 'Renamed)]
    _ =
      String
    -> SDoc
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr (GhcPass 'Renamed)))
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "expand_do_stmts: impossible happened. ListComp" SDoc
    forall doc. IsOutput doc => doc
    empty
            -- handeled by `GHC.Tc.Gen.Match.tcLcStmt`

    expand_do_stmts HsDoFlavour
    _ [] = String
    -> SDoc
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr (GhcPass 'Renamed)))
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "expand_do_stmts: impossible happened. Empty stmts" SDoc
    forall doc. IsOutput doc => doc
    empty

    expand_do_stmts HsDoFlavour
    _ (stmt :: ExprLStmt (GhcPass 'Renamed)
    stmt@(L SrcSpanAnnA
    _ (TransStmt {})):[ExprLStmt (GhcPass 'Renamed)]
    _) =
      String -> SDoc -> TcM (LHsExpr (GhcPass 'Renamed))
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "expand_do_stmts: TransStmt" (SDoc -> TcM (LHsExpr (GhcPass 'Renamed)))
    -> SDoc -> TcM (LHsExpr (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (LocatedA (HsExpr (GhcPass 'Renamed))))
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExprLStmt (GhcPass 'Renamed)
    GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (LocatedA (HsExpr (GhcPass 'Renamed))))
    stmt
      -- handeled by `GHC.Tc.Gen.Match.tcLcStmt`

    expand_do_stmts HsDoFlavour
    _ (stmt :: ExprLStmt (GhcPass 'Renamed)
    stmt@(L SrcSpanAnnA
    _ (ParStmt {})):[ExprLStmt (GhcPass 'Renamed)]
    _) =
      String -> SDoc -> TcM (LHsExpr (GhcPass 'Renamed))
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "expand_do_stmts: ParStmt" (SDoc -> TcM (LHsExpr (GhcPass 'Renamed)))
    -> SDoc -> TcM (LHsExpr (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (LocatedA (HsExpr (GhcPass 'Renamed))))
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExprLStmt (GhcPass 'Renamed)
    GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (LocatedA (HsExpr (GhcPass 'Renamed))))
    stmt
      -- handeled by `GHC.Tc.Gen.Match.tcLcStmt`

    expand_do_stmts HsDoFlavour
    _ (stmt :: ExprLStmt (GhcPass 'Renamed)
    stmt@(L SrcSpanAnnA
    _ (ApplicativeStmt{})): [ExprLStmt (GhcPass 'Renamed)]
    _) =
      String -> SDoc -> TcM (LHsExpr (GhcPass 'Renamed))
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "expand_do_stmts: Applicative Stmt" (SDoc -> TcM (LHsExpr (GhcPass 'Renamed)))
    -> SDoc -> TcM (LHsExpr (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (LocatedA (HsExpr (GhcPass 'Renamed))))
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExprLStmt (GhcPass 'Renamed)
    GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (LocatedA (HsExpr (GhcPass 'Renamed))))
    stmt
      -- Handeled by tcSyntaxOp see `GHC.Tc.Gen.Match.tcStmtsAndThen`

    expand_do_stmts HsDoFlavour
    _ [stmt :: ExprLStmt (GhcPass 'Renamed)
    stmt@(L SrcSpanAnnA
    loc (LastStmt XLastStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (LocatedA (HsExpr (GhcPass 'Renamed)))
    _ (L SrcSpanAnnA
    body_loc HsExpr (GhcPass 'Renamed)
    body) Maybe Bool
    _ SyntaxExpr (GhcPass 'Renamed)
    ret_expr))]
    -- See  Note [Expanding HsDo with XXExprGhcRn] Equation (5) below
    -- last statement of a list comprehension, needs to explicitly return it
    -- See `checkLastStmt` and `Syntax.Expr.StmtLR.LastStmt`
       | SyntaxExpr (GhcPass 'Renamed)
    SyntaxExprRn
    NoSyntaxExprRn <- SyntaxExpr (GhcPass 'Renamed)
    ret_expr
       -- Last statement is just body if we are not in ListComp context. See Syntax.Expr.LastStmt
       = do String -> SDoc -> TcRn ()
    traceTc String
    "expand_do_stmts last" (SyntaxExprRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SyntaxExpr (GhcPass 'Renamed)
    SyntaxExprRn
    ret_expr)
            LHsExpr (GhcPass 'Renamed) -> TcM (LHsExpr (GhcPass 'Renamed))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsExpr (GhcPass 'Renamed) -> TcM (LHsExpr (GhcPass 'Renamed)))
    -> LHsExpr (GhcPass 'Renamed) -> TcM (LHsExpr (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ SrcSpanAnnA
    -> ExprLStmt (GhcPass 'Renamed)
    -> HsExpr (GhcPass 'Renamed)
    -> LHsExpr (GhcPass 'Renamed)
    mkExpandedStmtPopAt SrcSpanAnnA
    loc ExprLStmt (GhcPass 'Renamed)
    stmt HsExpr (GhcPass 'Renamed)
    body

       | SyntaxExprRn HsExpr (GhcPass 'Renamed)
    ret <- SyntaxExpr (GhcPass 'Renamed)
    ret_expr
       --
       --    ------------------------------------------------
       --               return e  ~~> return e
       -- to make T18324 work
       = do String -> SDoc -> TcRn ()
    traceTc String
    "expand_do_stmts last" (SyntaxExprRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SyntaxExpr (GhcPass 'Renamed)
    SyntaxExprRn
    ret_expr)
            let expansion :: HsExpr (GhcPass 'Renamed)
    expansion = HsExpr (GhcPass 'Renamed)
    -> LHsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
    genHsApp HsExpr (GhcPass 'Renamed)
    ret (SrcSpanAnnA
    -> HsExpr (GhcPass 'Renamed)
    -> LocatedA (HsExpr (GhcPass 'Renamed))
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    body_loc HsExpr (GhcPass 'Renamed)
    body)
            LHsExpr (GhcPass 'Renamed) -> TcM (LHsExpr (GhcPass 'Renamed))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsExpr (GhcPass 'Renamed) -> TcM (LHsExpr (GhcPass 'Renamed)))
    -> LHsExpr (GhcPass 'Renamed) -> TcM (LHsExpr (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ SrcSpanAnnA
    -> ExprLStmt (GhcPass 'Renamed)
    -> HsExpr (GhcPass 'Renamed)
    -> LHsExpr (GhcPass 'Renamed)
    mkExpandedStmtPopAt SrcSpanAnnA
    loc ExprLStmt (GhcPass 'Renamed)
    stmt HsExpr (GhcPass 'Renamed)
    expansion

    expand_do_stmts HsDoFlavour
    do_or_lc (stmt :: ExprLStmt (GhcPass 'Renamed)
    stmt@(L SrcSpanAnnA
    loc (LetStmt XLetStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (LocatedA (HsExpr (GhcPass 'Renamed)))
    _ HsLocalBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    bs)) : [ExprLStmt (GhcPass 'Renamed)]
    lstmts) =
    -- See  Note [Expanding HsDo with XXExprGhcRn] Equation (3) below
    --                      stmts ~~> stmts'
    --    ------------------------------------------------
    --       let x = e ; stmts ~~> let x = e in stmts'
      do expand_stmts <- HsDoFlavour
    -> [ExprLStmt (GhcPass 'Renamed)]
    -> TcM (LHsExpr (GhcPass 'Renamed))
    expand_do_stmts HsDoFlavour
    do_or_lc [ExprLStmt (GhcPass 'Renamed)]
    lstmts
         let expansion = HsLocalBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> LHsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
    genHsLet HsLocalBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    bs LHsExpr (GhcPass 'Renamed)
    LocatedA (HsExpr (GhcPass 'Renamed))
    expand_stmts
         return $ mkExpandedStmtPopAt loc stmt expansion

    expand_do_stmts HsDoFlavour
    do_or_lc (stmt :: ExprLStmt (GhcPass 'Renamed)
    stmt@(L SrcSpanAnnA
    loc (BindStmt XBindStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (LocatedA (HsExpr (GhcPass 'Renamed)))
    xbsrn LPat (GhcPass 'Renamed)
    pat LocatedA (HsExpr (GhcPass 'Renamed))
    e)): [ExprLStmt (GhcPass 'Renamed)]
    lstmts)
      | SyntaxExprRn HsExpr (GhcPass 'Renamed)
    bind_op <- XBindStmtRn -> SyntaxExpr (GhcPass 'Renamed)
    xbsrn_bindOp XBindStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (LocatedA (HsExpr (GhcPass 'Renamed)))
    XBindStmtRn
    xbsrn
      , FailOperator (GhcPass 'Renamed)
    fail_op              <- XBindStmtRn -> FailOperator (GhcPass 'Renamed)
    xbsrn_failOp XBindStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (LocatedA (HsExpr (GhcPass 'Renamed)))
    XBindStmtRn
    xbsrn
    -- See  Note [Expanding HsDo with XXExprGhcRn] Equation (2) below
    -- the pattern binding pat can fail
    --      stmts ~~> stmt'    f = \case pat -> stmts';
    --                                   _   -> fail "Pattern match failure .."
    --    -------------------------------------------------------
    --       pat <- e ; stmts   ~~> (>>=) e f
      = do expand_stmts <- HsDoFlavour
    -> [ExprLStmt (GhcPass 'Renamed)]
    -> TcM (LHsExpr (GhcPass 'Renamed))
    expand_do_stmts HsDoFlavour
    do_or_lc [ExprLStmt (GhcPass 'Renamed)]
    lstmts
           failable_expr <- mk_failable_expr do_or_lc pat expand_stmts fail_op
           let expansion = HsExpr (GhcPass 'Renamed)
    -> [LHsExpr (GhcPass 'Renamed)] -> HsExpr (GhcPass 'Renamed)
    genHsExpApps HsExpr (GhcPass 'Renamed)
    bind_op  -- (>>=)
                           [ LHsExpr (GhcPass 'Renamed)
    LocatedA (HsExpr (GhcPass 'Renamed))
    e
                           , LHsExpr (GhcPass 'Renamed)
    LocatedA (HsExpr (GhcPass 'Renamed))
    failable_expr ]
           return $ mkExpandedStmtPopAt loc stmt expansion

      | Bool
    otherwise
      = String
    -> SDoc
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (LocatedA (HsExpr (GhcPass 'Renamed)))
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "expand_do_stmts: The impossible happened, missing bind operator from renamer" (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "stmt" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (LocatedA (HsExpr (GhcPass 'Renamed))))
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr  ExprLStmt (GhcPass 'Renamed)
    GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (LocatedA (HsExpr (GhcPass 'Renamed))))
    stmt)

    expand_do_stmts HsDoFlavour
    do_or_lc (stmt :: ExprLStmt (GhcPass 'Renamed)
    stmt@(L SrcSpanAnnA
    loc (BodyStmt XBodyStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (LocatedA (HsExpr (GhcPass 'Renamed)))
    _ LocatedA (HsExpr (GhcPass 'Renamed))
    e (SyntaxExprRn HsExpr (GhcPass 'Renamed)
    then_op) SyntaxExpr (GhcPass 'Renamed)
    _)) : [ExprLStmt (GhcPass 'Renamed)]
    lstmts) =
    -- See Note [BodyStmt] in Language.Haskell.Syntax.Expr
    -- See  Note [Expanding HsDo with XXExprGhcRn] Equation (1) below
    --              stmts ~~> stmts'
    --    ----------------------------------------------
    --      e ; stmts ~~> (>>) e stmts'
      do expand_stmts_expr <- HsDoFlavour
    -> [ExprLStmt (GhcPass 'Renamed)]
    -> TcM (LHsExpr (GhcPass 'Renamed))
    expand_do_stmts HsDoFlavour
    do_or_lc [ExprLStmt (GhcPass 'Renamed)]
    lstmts
         let expansion = HsExpr (GhcPass 'Renamed)
    -> [LHsExpr (GhcPass 'Renamed)] -> HsExpr (GhcPass 'Renamed)
    genHsExpApps HsExpr (GhcPass 'Renamed)
    then_op  -- (>>)
                                      [ LHsExpr (GhcPass 'Renamed)
    LocatedA (HsExpr (GhcPass 'Renamed))
    e
                                      , LHsExpr (GhcPass 'Renamed)
    LocatedA (HsExpr (GhcPass 'Renamed))
    expand_stmts_expr ]
         return $ mkExpandedStmtPopAt loc stmt expansion

    expand_do_stmts HsDoFlavour
    do_or_lc
           ((L SrcSpanAnnA
    loc (RecStmt { recS_stmts :: forall idL idR body.
    StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
    recS_stmts = L SrcSpanAnnL
    stmts_loc [GenLocated
       SrcSpanAnnA
       (StmtLR
          (GhcPass 'Renamed)
          (GhcPass 'Renamed)
          (LocatedA (HsExpr (GhcPass 'Renamed))))]
    rec_stmts
                            , recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
    recS_later_ids = [IdP (GhcPass 'Renamed)]
    later_ids  -- forward referenced local ids
                            , recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
    recS_rec_ids = [IdP (GhcPass 'Renamed)]
    local_ids     -- ids referenced outside of the rec block
                            , recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_bind_fn = SyntaxExprRn HsExpr (GhcPass 'Renamed)
    bind_fun   -- the (>>=) expr
                            , recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_mfix_fn = SyntaxExprRn HsExpr (GhcPass 'Renamed)
    mfix_fun   -- the `mfix` expr
                            , recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_ret_fn  = SyntaxExprRn HsExpr (GhcPass 'Renamed)
    return_fun -- the `return` expr
                                                              -- use it explicitly
                                                              -- at the end of expanded rec block
                            }))
             : [ExprLStmt (GhcPass 'Renamed)]
    lstmts) =
    -- See Note [Typing a RecStmt] in Language.Haskell.Syntax.Expr
    -- See  Note [Expanding HsDo with XXExprGhcRn] Equation (4) and (6) below
    --                                   stmts ~~> stmts'
    --    -------------------------------------------------------------------------------------------
    --      rec { later_ids, local_ids, rec_block } ; stmts
    --                    ~~> (>>=) (mfix (\[ local_only_ids ++ later_ids ]
    --                                           -> do { rec_stmts
    --                                                 ; return (local_only_ids ++ later_ids) } ))
    --                              (\ [ local_only_ids ++ later_ids ] -> stmts')
      do expand_stmts <- HsDoFlavour
    -> [ExprLStmt (GhcPass 'Renamed)]
    -> TcM (LHsExpr (GhcPass 'Renamed))
    expand_do_stmts HsDoFlavour
    do_or_lc [ExprLStmt (GhcPass 'Renamed)]
    lstmts
         -- NB: No need to wrap the expansion with an ExpandedStmt
         -- as we want to flatten the rec block statements into its parent do block anyway
         return $ mkHsApps (wrapGenSpan bind_fun)                                           -- (>>=)
                          [ (wrapGenSpan mfix_fun) `mkHsApp` mfix_expr           -- (mfix (do block))
                          , genHsLamDoExp do_or_lc [ mkBigLHsVarPatTup all_ids ] --        (\ x ->
                                           expand_stmts                          --               stmts')
                          ]
      where
        local_only_ids :: [Name]
    local_only_ids = [IdP (GhcPass 'Renamed)]
    [Name]
    local_ids [Name] -> [Name] -> [Name]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [IdP (GhcPass 'Renamed)]
    [Name]
    later_ids -- get unique local rec ids;
                                                -- local rec ids and later ids can overlap
        all_ids :: [Name]
    all_ids = [Name]
    local_only_ids [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ [IdP (GhcPass 'Renamed)]
    [Name]
    later_ids   -- put local ids before return ids

        return_stmt  :: ExprLStmt GhcRn
        return_stmt :: ExprLStmt (GhcPass 'Renamed)
    return_stmt  = StmtLR
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (LocatedA (HsExpr (GhcPass 'Renamed)))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR
            (GhcPass 'Renamed)
            (GhcPass 'Renamed)
            (LocatedA (HsExpr (GhcPass 'Renamed))))
    forall an a. NoAnn an => a -> LocatedAn an a
    wrapGenSpan (StmtLR
       (GhcPass 'Renamed)
       (GhcPass 'Renamed)
       (LocatedA (HsExpr (GhcPass 'Renamed)))
     -> GenLocated
          SrcSpanAnnA
          (StmtLR
             (GhcPass 'Renamed)
             (GhcPass 'Renamed)
             (LocatedA (HsExpr (GhcPass 'Renamed)))))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (LocatedA (HsExpr (GhcPass 'Renamed)))
    -> GenLocated
         SrcSpanAnnA
         (StmtLR
            (GhcPass 'Renamed)
            (GhcPass 'Renamed)
            (LocatedA (HsExpr (GhcPass 'Renamed))))
    forall a b. (a -> b) -> a -> b
    $ XLastStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (LocatedA (HsExpr (GhcPass 'Renamed)))
    -> LocatedA (HsExpr (GhcPass 'Renamed))
    -> Maybe Bool
    -> SyntaxExpr (GhcPass 'Renamed)
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (LocatedA (HsExpr (GhcPass 'Renamed)))
    forall idL idR body.
    XLastStmt idL idR body
    -> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
    LastStmt XLastStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (LocatedA (HsExpr (GhcPass 'Renamed)))
    NoExtField
    noExtField
                                         ([LHsExpr (GhcPass 'Renamed)]
    -> XExplicitTuple (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
    forall (id :: Pass).
    [LHsExpr (GhcPass id)]
    -> XExplicitTuple (GhcPass id) -> LHsExpr (GhcPass id)
    mkBigLHsTup ((Name -> LocatedA (HsExpr (GhcPass 'Renamed)))
    -> [Name] -> [LocatedA (HsExpr (GhcPass 'Renamed))]
    forall a b. (a -> b) -> [a] -> [b]
    map IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
    Name -> LocatedA (HsExpr (GhcPass 'Renamed))
    forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar [Name]
    all_ids) XExplicitTuple (GhcPass 'Renamed)
    NoExtField
    noExtField)
                                         Maybe Bool
    forall a. Maybe a
    Nothing
                                         (HsExpr (GhcPass 'Renamed) -> SyntaxExprRn
    SyntaxExprRn HsExpr (GhcPass 'Renamed)
    return_fun)
        do_stmts     :: XRec GhcRn [ExprLStmt GhcRn]
        do_stmts :: XRec (GhcPass 'Renamed) [ExprLStmt (GhcPass 'Renamed)]
    do_stmts     = SrcSpanAnnL
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR
             (GhcPass 'Renamed)
             (GhcPass 'Renamed)
             (LocatedA (HsExpr (GhcPass 'Renamed))))]
    -> GenLocated
         SrcSpanAnnL
         [GenLocated
            SrcSpanAnnA
            (StmtLR
               (GhcPass 'Renamed)
               (GhcPass 'Renamed)
               (LocatedA (HsExpr (GhcPass 'Renamed))))]
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnL
    stmts_loc ([GenLocated
        SrcSpanAnnA
        (StmtLR
           (GhcPass 'Renamed)
           (GhcPass 'Renamed)
           (LocatedA (HsExpr (GhcPass 'Renamed))))]
     -> GenLocated
          SrcSpanAnnL
          [GenLocated
             SrcSpanAnnA
             (StmtLR
                (GhcPass 'Renamed)
                (GhcPass 'Renamed)
                (LocatedA (HsExpr (GhcPass 'Renamed))))])
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR
             (GhcPass 'Renamed)
             (GhcPass 'Renamed)
             (LocatedA (HsExpr (GhcPass 'Renamed))))]
    -> GenLocated
         SrcSpanAnnL
         [GenLocated
            SrcSpanAnnA
            (StmtLR
               (GhcPass 'Renamed)
               (GhcPass 'Renamed)
               (LocatedA (HsExpr (GhcPass 'Renamed))))]
    forall a b. (a -> b) -> a -> b
    $ [GenLocated
       SrcSpanAnnA
       (StmtLR
          (GhcPass 'Renamed)
          (GhcPass 'Renamed)
          (LocatedA (HsExpr (GhcPass 'Renamed))))]
    rec_stmts [GenLocated
       SrcSpanAnnA
       (StmtLR
          (GhcPass 'Renamed)
          (GhcPass 'Renamed)
          (LocatedA (HsExpr (GhcPass 'Renamed))))]
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR
             (GhcPass 'Renamed)
             (GhcPass 'Renamed)
             (LocatedA (HsExpr (GhcPass 'Renamed))))]
    -> [GenLocated
          SrcSpanAnnA
          (StmtLR
             (GhcPass 'Renamed)
             (GhcPass 'Renamed)
             (LocatedA (HsExpr (GhcPass 'Renamed))))]
    forall a. [a] -> [a] -> [a]
    ++ [ExprLStmt (GhcPass 'Renamed)
    GenLocated
      SrcSpanAnnA
      (StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (LocatedA (HsExpr (GhcPass 'Renamed))))
    return_stmt]
        do_block     :: LHsExpr GhcRn
        do_block :: LHsExpr (GhcPass 'Renamed)
    do_block     = SrcSpanAnnA
    -> HsExpr (GhcPass 'Renamed)
    -> LocatedA (HsExpr (GhcPass 'Renamed))
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc (HsExpr (GhcPass 'Renamed) -> LocatedA (HsExpr (GhcPass 'Renamed)))
    -> HsExpr (GhcPass 'Renamed)
    -> LocatedA (HsExpr (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ XDo (GhcPass 'Renamed)
    -> HsDoFlavour
    -> XRec (GhcPass 'Renamed) [ExprLStmt (GhcPass 'Renamed)]
    -> HsExpr (GhcPass 'Renamed)
    forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
    HsDo XDo (GhcPass 'Renamed)
    NoExtField
    noExtField HsDoFlavour
    do_or_lc XRec (GhcPass 'Renamed) [ExprLStmt (GhcPass 'Renamed)]
    do_stmts
        mfix_expr    :: LHsExpr GhcRn
        mfix_expr :: LHsExpr (GhcPass 'Renamed)
    mfix_expr    = HsDoFlavour
    -> [LPat (GhcPass 'Renamed)]
    -> LHsExpr (GhcPass 'Renamed)
    -> LHsExpr (GhcPass 'Renamed)
    forall (p :: Pass).
    (IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) =>
    HsDoFlavour
    -> [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
    genHsLamDoExp HsDoFlavour
    do_or_lc [ Pat (GhcPass 'Renamed)
    -> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
    forall an a. NoAnn an => a -> LocatedAn an a
    wrapGenSpan (XLazyPat (GhcPass 'Renamed)
    -> LPat (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed)
    forall p. XLazyPat p -> LPat p -> Pat p
    LazyPat XLazyPat (GhcPass 'Renamed)
    NoExtField
    noExtField (LPat (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed))
    -> LPat (GhcPass 'Renamed) -> Pat (GhcPass 'Renamed)
    forall a b. (a -> b) -> a -> b
    $ [IdP (GhcPass 'Renamed)] -> LPat (GhcPass 'Renamed)
    mkBigLHsVarPatTup [IdP (GhcPass 'Renamed)]
    [Name]
    all_ids) ]
                                              (LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
    -> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr (GhcPass 'Renamed)
    do_block
                                 -- NB: LazyPat because we do not want to eagerly evaluate the pattern
                                 -- and potentially loop forever

    expand_do_stmts HsDoFlavour
    _ [ExprLStmt (GhcPass 'Renamed)]
    stmts = String -> SDoc -> TcM (LHsExpr (GhcPass 'Renamed))
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "expand_do_stmts: impossible happened" (SDoc -> TcM (LHsExpr (GhcPass 'Renamed)))
    -> SDoc -> TcM (LHsExpr (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ ([GenLocated
       SrcSpanAnnA
       (StmtLR
          (GhcPass 'Renamed)
          (GhcPass 'Renamed)
          (LocatedA (HsExpr (GhcPass 'Renamed))))]
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ExprLStmt (GhcPass 'Renamed)]
    [GenLocated
       SrcSpanAnnA
       (StmtLR
          (GhcPass 'Renamed)
          (GhcPass 'Renamed)
          (LocatedA (HsExpr (GhcPass 'Renamed))))]
    stmts)

    -- checks the pattern `pat`for irrefutability which decides if we need to wrap it with a fail block
    mk_failable_expr :: HsDoFlavour -> LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (LHsExpr GhcRn)
    mk_failable_expr :: HsDoFlavour
    -> LPat (GhcPass 'Renamed)
    -> LHsExpr (GhcPass 'Renamed)
    -> FailOperator (GhcPass 'Renamed)
    -> TcM (LHsExpr (GhcPass 'Renamed))
    mk_failable_expr HsDoFlavour
    doFlav pat :: LPat (GhcPass 'Renamed)
    pat@(L SrcSpanAnnA
    loc Pat (GhcPass 'Renamed)
    _) LHsExpr (GhcPass 'Renamed)
    expr FailOperator (GhcPass 'Renamed)
    fail_op =
      do { is_strict <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.Strict
         ; irrf_pat <- isIrrefutableHsPatRnTcM is_strict pat
         ; traceTc "mk_failable_expr" (vcat [ text "pat:" <+> ppr pat
                                            , text "isIrrefutable:" <+> ppr irrf_pat
                                            ])

         ; if irrf_pat                        -- don't wrap with fail block if
                                              -- the pattern is irrefutable
           then return $ genHsLamDoExp doFlav [pat] expr
           else L loc <$> mk_fail_block doFlav pat expr fail_op
         }

    -- makes the fail block with a given fail_op
    mk_fail_block :: HsDoFlavour -> LPat GhcRn -> LHsExpr GhcRn -> FailOperator GhcRn -> TcM (HsExpr GhcRn)
    mk_fail_block :: HsDoFlavour
    -> LPat (GhcPass 'Renamed)
    -> LHsExpr (GhcPass 'Renamed)
    -> FailOperator (GhcPass 'Renamed)
    -> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr (GhcPass 'Renamed))
    mk_fail_block HsDoFlavour
    doFlav pat :: LPat (GhcPass 'Renamed)
    pat@(L SrcSpanAnnA
    ploc Pat (GhcPass 'Renamed)
    _) LHsExpr (GhcPass 'Renamed)
    e (Just (SyntaxExprRn HsExpr (GhcPass 'Renamed)
    fail_op)) =
      do  dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
          return $ HsLam noAnn LamCases $ mkMatchGroup (doExpansionOrigin doFlav) -- \
                    (wrapGenSpan [ genHsCaseAltDoExp doFlav pat e                 --  pat -> expr
                                 , fail_alt_case dflags pat fail_op               --  _   -> fail "fail pattern"
                                 ])
            where
              fail_alt_case :: DynFlags -> LPat GhcRn -> HsExpr GhcRn -> LMatch GhcRn (LHsExpr GhcRn)
              fail_alt_case :: DynFlags
    -> LPat (GhcPass 'Renamed)
    -> HsExpr (GhcPass 'Renamed)
    -> LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    fail_alt_case DynFlags
    dflags LPat (GhcPass 'Renamed)
    pat HsExpr (GhcPass 'Renamed)
    fail_op = HsDoFlavour
    -> LPat (GhcPass 'Renamed)
    -> LocatedA (HsExpr (GhcPass 'Renamed))
    -> LMatch (GhcPass 'Renamed) (LocatedA (HsExpr (GhcPass 'Renamed)))
    forall (p :: Pass) (body :: * -> *).
    (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ EpAnnCO,
     Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA) =>
    HsDoFlavour
    -> LPat (GhcPass p)
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    genHsCaseAltDoExp HsDoFlavour
    doFlav LPat (GhcPass 'Renamed)
    genWildPat (LocatedA (HsExpr (GhcPass 'Renamed))
     -> LMatch
          (GhcPass 'Renamed) (LocatedA (HsExpr (GhcPass 'Renamed))))
    -> LocatedA (HsExpr (GhcPass 'Renamed))
    -> LMatch (GhcPass 'Renamed) (LocatedA (HsExpr (GhcPass 'Renamed)))
    forall a b. (a -> b) -> a -> b
    $
                                                 SrcSpanAnnA
    -> HsExpr (GhcPass 'Renamed)
    -> LocatedA (HsExpr (GhcPass 'Renamed))
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    ploc (DynFlags
    -> LPat (GhcPass 'Renamed)
    -> HsExpr (GhcPass 'Renamed)
    -> HsExpr (GhcPass 'Renamed)
    fail_op_expr DynFlags
    dflags LPat (GhcPass 'Renamed)
    pat HsExpr (GhcPass 'Renamed)
    fail_op)

              fail_op_expr :: DynFlags -> LPat GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
              fail_op_expr :: DynFlags
    -> LPat (GhcPass 'Renamed)
    -> HsExpr (GhcPass 'Renamed)
    -> HsExpr (GhcPass 'Renamed)
    fail_op_expr DynFlags
    dflags LPat (GhcPass 'Renamed)
    pat HsExpr (GhcPass 'Renamed)
    fail_op
                = LPat (GhcPass 'Renamed)
    -> HsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
    mkExpandedPatRn LPat (GhcPass 'Renamed)
    pat (HsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed))
    -> HsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
    forall a b. (a -> b) -> a -> b
    $
                        HsExpr (GhcPass 'Renamed)
    -> LHsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
    genHsApp HsExpr (GhcPass 'Renamed)
    fail_op (DynFlags -> LPat (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
    mk_fail_msg_expr DynFlags
    dflags LPat (GhcPass 'Renamed)
    pat)

              mk_fail_msg_expr :: DynFlags -> LPat GhcRn -> LHsExpr GhcRn
              mk_fail_msg_expr :: DynFlags -> LPat (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
    mk_fail_msg_expr DynFlags
    dflags LPat (GhcPass 'Renamed)
    pat
                = HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
    forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsLit (HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
    -> HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
    forall a b. (a -> b) -> a -> b
    $ String -> HsLit (GhcPass 'Renamed)
    forall (p :: Pass). String -> HsLit (GhcPass p)
    mkHsString (String -> HsLit (GhcPass 'Renamed))
    -> String -> HsLit (GhcPass 'Renamed)
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> SDoc -> String
    forall a. Outputable a => DynFlags -> a -> String
    showPpr DynFlags
    dflags (SDoc -> String) -> SDoc -> String
    forall a b. (a -> b) -> a -> b
    $
                  String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Pattern match failure in" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> HsDoFlavour -> SDoc
    pprHsDoFlavour (Maybe ModuleName -> HsDoFlavour
    DoExpr Maybe ModuleName
    forall a. Maybe a
    Nothing)
                       SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "at" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> SrcSpan
    forall a e. HasLoc a => GenLocated a e -> SrcSpan
    getLocA LPat (GhcPass 'Renamed)
    GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
    pat)

    mk_fail_block HsDoFlavour
    _ LPat (GhcPass 'Renamed)
    _ LHsExpr (GhcPass 'Renamed)
    _ FailOperator (GhcPass 'Renamed)
    _ = String
    -> SDoc
    -> IOEnv (Env TcGblEnv TcLclEnv) (HsExpr (GhcPass 'Renamed))
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "mk_fail_block: impossible happened" SDoc
    forall doc. IsOutput doc => doc
    empty

    {- Note [Expanding HsDo with XXExprGhcRn]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We expand `do`-blocks before typechecking it, by re-using the existing `XXExprGhcRns` and `RebindableSyntax` machinery.
    This is very similar to:
      1. Expansions done in `GHC.Rename.Expr.rnHsIf` for expanding `HsIf`; and
      2. `desugarRecordUpd` in `GHC.Tc.Gen.Expr.tcExpr` for expanding `RecordUpd`
    See Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr

    To disabmiguate desugaring (`HsExpr GhcTc -> Core.Expr`) we use the phrase expansion
    (`HsExpr GhcRn -> HsExpr GhcRn`)

    This expansion is done right before typechecking and after renaming
    See Part 2. of Note [Doing XXExprGhcRn in the Renamer vs Typechecker] in `GHC.Rename.Expr`

    Historical note START
    ---------------------
    In previous versions of GHC, the `do`-notation wasn't expanded before typechecking,
    instead the typechecker would operate directly on the original.
    Why? because it ensured that type error messages were explained in terms of
    what the programmer has written. In practice, however, this didn't work very well:

    * Attempts to typecheck the original source code turned out to be buggy, and virtually impossible
      to fix (#14963, #15598, #21206 and others)

    * The typechecker expected the `>>=` operator to have a type that matches
      `m _ -> (_ -> m _) -> m _` for some `m`. With `RebindableSyntax` or
      `QualifiedDo` the `>>=` operator might not have the
      standard type. It might have a type like

          (>>=) :: Wombat m => m a1 a2 b -> (b -> m a2 a3 c) -> m a1 a3 c

      Typechecking the term `(>>=) e1 (\x -> e2)` deals with all of this automatically.

    * With `ImpredicativeTypes` the programmer will expect Quick Look to instantiate
      the quantifiers impredicatively (#18324). Again, that happens automatically if
      you typecheck the expanded expression.

    Historical note END
    -------------------

    Do Expansions Equationally
    --------------------------
    We have the following schema for expanding `do`-statements.
    They capture the essence of statement expansions as implemented in `expand_do_stmts`

      DO【 _ 】 maps a sequence of do statements and recursively converts them into expressions

              (1) DO【 s; ss 】      = ‹ExpansionStmt s›((>>) s (‹PopErrCtxt›DO【 ss 】))

              (2) DO【 p <- e; ss 】 = if p is irrefutable
                                       then ‹ExpansionStmt (p <- e)›
                                              (>>=) s (‹PopExprCtxt›(\ p -> DO【 ss 】))
                                       else ‹ExpansionStmt (p <- e)›
                                              (>>=) s (‹PopExprCtxt›(\case p -> DO【 ss 】
                                                                           _ -> fail "pattern p failure"))

              (3) DO【 let x = e; ss 】
                                     = ‹ExpansionStmt (let x = e)› (let x = e in (‹PopErrCtxt›DO【 ss 】))

              (4) DO【 rec ss; sss 】
                                     = (>>=) e (\vars -> ‹PopErrCtxt›DO【 sss 】))
                                               where (vars, e) = RECDO【 ss 】

              (5) DO【 s 】          = s

      RECDO【 _ 】 maps a sequence of recursively dependent monadic statements and converts it into an expression paired
                  with the variables that the rec finds a fix point of.

              (6) RECDO【 ss 】     = (vars, mfix (\~vars -> (>>=) (DO【 ss 】) (return vars)))
                                      where vars are all the variables free in ss

    For a concrete example, consider a `do`-block written by the user

        f = {l0} do {l1} {pl}p <- {l1'} e1
                    {l2} g p
                    {l3} return {l3'} p

    The expanded version (performed by `expand_do_stmts`) looks like:

        f = {g1} (>>=) ({l1'} e1) (\ {pl}p ->
                       {g2} (>>) ({l2} g p)
                                 ({l3} return p))

    The {l1} etc are location/source span information stored in the AST by the parser,
    {g1} are compiler generated source spans.

    The 3 non-obvious points to consider are:
     1. Wrap the expression with a `fail` block if the pattern match is not irrefutable.
        See Part 1. below
     2. Generate appropriate warnings for discarded results in a body statement
        eg. say `do { .. ; (g p :: m Int) ; ... }`
        See Part 2. below
     3. Generating appropriate type error messages which blame the correct source spans
        See Part 3. below

    Part 1. Expanding Patterns Bindings
    -----------------------------------
    If `p` is a failable pattern---checked by `GHC.Tc.Gen.Pat.isIrrefutableHsPatRnTcM`---
    we need to wrap it with a `fail`-block. See Equation (2) above.

    The expansion of the `do`-block

            do { Just p <- e1; e2 }

    (ignoring the location information) will be

            (>>=) (e1)
                  (\case                 -- anonymous continuation lambda
                     Just p -> e2
                     _      -> fail "failable pattern p at location")

    The `fail`-block wrapping is done by `GHC.Tc.Gen.Do.mk_failable_expr`.

    * Note the explicit call to `fail`, in the monad of the `do`-block.  Part of the specification
      of do-notation is that if the pattern match fails, we fail in the monad, *not* just crash
      at runtime.

    * According to the language specification, when the pattern is irrefutable,
      we should not add the `fail` alternative. This is important because
      the occurrence of `fail` means that the typechecker will generate a `MonadFail` constraint,
      and irrefutable patterns shouldn't need a fail alternative.

    * _Wrinkel 1_: Note that pattern synonyms count as refutable during type checking,
      (see `GHC.Tc.Gen.Pat.isIrrefutableHsPatRnTcM`). They will hence generate a
      `MonadFail` constraint and they will always be wrapped in a `fail`able-block.

      Consider a patten synonym declaration (testcase T24552):

                 pattern MyJust :: a -> Maybe a
                 pattern MyJust x <- Just x where MyJust = Just

      and a `do`-block with the following bind and return statement

                 do { MyJust x <- [MyNothing, MyJust ()]
                    ; return x }

      The `do`-expansion will generate the expansion

                (>>=) ([MyNothing, MyJust ()])
                      (\case MyJust x -> return x                     -- (1)
                             _        -> fail "failable pattern .. "  -- (2)
                      )

      This code (specifically the `match` spanning lines (1) and (2)) is a compiler generated code;
      the associated `Origin` in tagged `Generated`
      The alternative statements will thus be ignored by the pattern match check (c.f. `isMatchContextPmChecked`).
      This ensures we do not generate spurious redundant-pattern-match warnings due to the line (2) above.
      See Note [Generated code and pattern-match checking]
      See Note [Long-distance information in matchWrapper]

    * _Wrinkle 2_: The call to `fail` will give rise to a `MonadFail` constraint. What `CtOrigin` do we
      attach to that constraint?  When the `MonadFail` constraint can't be solved, it'll show up in error
      messages and it needs to be a good location.  Ideally, it should identify the
      pattern `p`.  Hence, we wrap the `fail` alternative expression with a `ExpandedPat`
      that tags the fail expression with the failable pattern. (See testcase MonadFailErrors.hs)

    Part 2. Generate warnings for discarded body statement results
    --------------------------------------------------------------
    If the `do`-blocks' body statement is an expression that returns a
    value that is not of type `()`, we need to warn the user about discarded
    the value when `-Wunused-binds` flag is turned on. (See testcase T3263-2.hs)

    For example the `do`-block

        do { e1;  e2 } -- where, e1 :: m Int

    expands to

        (>>) e1 e2

    * If `e1` returns a non-() value we want to emit a warning, telling the user that they
      are discarding the value returned by e1. This is done by `HsToCore.dsExpr` in the `HsApp`
      with a call to `HsToCore.warnUnusedBindValue`.

    * The decision to trigger the warning is: if the function is a compiler generated `(>>)`,
      and its first argument `e1` has a non-() type

    Part 3. Blaming Offending Source Code and Generating Appropriate Error Messages
    -------------------------------------------------------------------------------
    To ensure we correctly track source of the offending user written source code,
    in this case the `do`-statement, we need to keep track of
    which source statement's expansion the typechecker is currently typechecking.
    For this purpose we use the `XXExprGhcRn.ExpansionRn`.
    It stores the original statement (with location) and the expanded expression

      A. Expanding Body Statements
      -----------------------------
      For example, the `do`-block

          do { e1;  e2; e3 }

      expands (ignoring the location info) to

          ‹ExpandedThingRn do { e1; e2; e3 }›                        -- Original Do Expression
                                                                     -- Expanded Do Expression
              (‹ExpandedThingRn e1›                                  -- Original Statement
                   ({(>>) e1}                                        -- Expanded Expression
                      ‹PopErrCtxt› (‹ExpandedThingRn e2›
                             ({(>>) e2}
                                ‹PopErrCtxt› (‹ExpandedThingRn e3› {e3})))))

      * Whenever the typechecker steps through an `ExpandedThingRn`,
        we push the original statement in the error context, set the error location to the
        location of the statement, and then typecheck the expanded expression.
        This is similar to vanilla `XXExprGhcRn` and rebindable syntax
        See Note [Rebindable syntax and XXExprGhcRn] in `GHC.Hs.Expr`.

      * Recall, that when a source function argument fails to typecheck,
        we print an error message like "In the second argument of the function f..".
        However, `(>>)` is generated thus, we don't want to display that to the user; it would be confusing.
        But also, we do not want to completely ignore it as we do want to keep the error blame carets
        as precise as possible, and not just blame the complete `do`-block.
        Thus, when we typecheck the application `(>>) e1`, we push the "In the stmt of do block e1" with
        the source location of `e1` in the error context stack as we walk inside an `ExpandedThingRn`.
        See also Note [splitHsApps].

      * After the expanded expression of a `do`-statement is typechecked
        and before moving to the next statement of the `do`-block, we need to first pop the top
        of the error context stack which contains the error message for
        the previous statement: eg. "In the stmt of a do block: e1".
        This is explicitly encoded in the expansion expression using
        the `XXExprGhcRn.PopErrCtxt`. Whenever `GHC.Tc.Gen.Expr.tcExpr` (via `GHC.Tc.Gen.tcXExpr`)
        sees a `PopErrCtxt` it calls `GHC.Tc.Utils.Monad.popErrCtxt` to pop of the top of error context stack.
        See ‹PopErrCtxt› in the example above.
        Without this popping business for error context stack,
        if there is a type error in `e2`, we would get a spurious and confusing error message
        which mentions "In the stmt of a do block e1" along with the message
        "In the stmt of a do block e2".

      B. Expanding Bind Statements
      -----------------------------
      A `do`-block with a bind statement:

          do { p <- e1; e2 }

      expands (ignoring the location information) to

         ‹ExpandedThingRn do{ p <- e1; e2 }›                                      -- Original Do Expression
                                                                                  --
             (‹ExpandedThingRn (p <- e1)›                                         -- Original Statement
                            (((>>=) e1)                                           -- Expanded Expression
                               ‹PopErrCtxt› ((\ p -> ‹ExpandedThingRn (e2)› e2)))
             )

      However, the expansion lambda `(\p -> e2)` is special as it is generated from a `do`-stmt expansion
      and if a type checker error occurs in the pattern `p` (which is source generated), we need to say
      "in a pattern binding in a do block" and not "in the pattern of a lambda" (cf. Typeable1.hs).
      We hence use a tag `GenReason` in `Ghc.Tc.Origin`. When typechecking a `HsLam` in `Tc.Gen.Expr.tcExpr`
      the `match_ctxt` is set to a `StmtCtxt` if `GenOrigin` is a `DoExpansionOrigin`.
    -}