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

    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE RankNTypes #-}
    {-# LANGUAGE MultiWayIf #-}
    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE RecordWildCards #-}

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

    -- | Typecheck some @Matches@
    module GHC.Tc.Gen.Match
       ( tcMatchesFun
       , tcGRHS
       , tcGRHSsPat
       , tcMatchesCase
       , tcMatchLambda
       , TcMatchCtxt(..)
       , TcStmtChecker
       , TcExprStmtChecker
       , TcCmdStmtChecker
       , tcStmts
       , tcStmtsAndThen
       , tcDoStmts
       , tcBody
       , tcDoStmt
       , tcGuardStmt
       )
    where

    import GHC.Prelude

    import {-# SOURCE #-}   GHC.Tc.Gen.Expr( tcSyntaxOp, tcInferRho, tcInferRhoNC
                                           , tcMonoExpr, tcMonoExprNC, tcExpr
                                           , tcCheckMonoExpr, tcCheckMonoExprNC
                                           , tcCheckPolyExpr, tcCheckId )

    import GHC.Types.Basic (LexicalFixity(..))
    import GHC.Hs
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Utils.Env
    import GHC.Tc.Gen.Pat
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Gen.Bind
    import GHC.Tc.Utils.Unify
    import GHC.Tc.Types.Origin
    import GHC.Core.Multiplicity
    import GHC.Core.UsageEnv
    import GHC.Types.Name
    import GHC.Builtin.Types
    import GHC.Types.Id
    import GHC.Core.TyCon
    import GHC.Builtin.Types.Prim
    import GHC.Tc.Types.Evidence
    import GHC.Utils.Outputable
    import GHC.Utils.Misc
    import GHC.Types.SrcLoc
    import GHC.Driver.Session ( getDynFlags )

    -- Create chunkified tuple tybes for monad comprehensions
    import GHC.Core.Make

    import Control.Monad
    import Control.Arrow ( second )

    #include "HsVersions.h"

    {-
    ************************************************************************
    *                                                                      *
    \subsection{tcMatchesFun, tcMatchesCase}
    *                                                                      *
    ************************************************************************

    @tcMatchesFun@ typechecks a @[Match]@ list which occurs in a
    @FunMonoBind@.  The second argument is the name of the function, which
    is used in error messages.  It checks that all the equations have the
    same number of arguments before using @tcMatches@ to do the work.
    -}

    tcMatchesFun :: Located Name
                 -> MatchGroup GhcRn (LHsExpr GhcRn)
                 -> ExpRhoType    -- Expected type of function
                 -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
                                    -- Returns type of body
    tcMatchesFun :: Located Name
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    tcMatchesFun fn :: Located Name
    fn@(L SrcSpan
    _ Name
    fun_name) MatchGroup GhcRn (LHsExpr GhcRn)
    matches ExpRhoType
    exp_ty
      = do  {  -- Check that they all have the same no of arguments
               -- Location is in the monad, set the caller so that
               -- any inter-equation error messages get some vaguely
               -- sensible location.        Note: we have to do this odd
               -- ann-grabbing, because we don't always have annotations in
               -- hand when we call tcMatchesFun...
              String -> SDoc -> TcRn ()
    traceTc String
    "tcMatchesFun" (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    fun_name SDoc -> SDoc -> SDoc
    $$ ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    exp_ty)
            ; Name -> MatchGroup GhcRn (LHsExpr GhcRn) -> TcRn ()
    forall body. Name -> MatchGroup GhcRn body -> TcRn ()
    checkArgs Name
    fun_name MatchGroup GhcRn (LHsExpr GhcRn)
    matches

            ; SDoc
    -> UserTypeCtxt
    -> Arity
    -> ExpRhoType
    -> ([Scaled ExpRhoType]
        -> ExpRhoType -> TcM (MatchGroup GhcTc (LHsExpr GhcTc)))
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    forall a.
    SDoc
    -> UserTypeCtxt
    -> Arity
    -> ExpRhoType
    -> ([Scaled ExpRhoType] -> ExpRhoType -> TcM a)
    -> TcM (HsWrapper, a)
    matchExpectedFunTys SDoc
    herald UserTypeCtxt
    ctxt Arity
    arity ExpRhoType
    exp_ty (([Scaled ExpRhoType]
      -> ExpRhoType -> TcM (MatchGroup GhcTc (LHsExpr GhcTc)))
     -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc)))
    -> ([Scaled ExpRhoType]
        -> ExpRhoType -> TcM (MatchGroup GhcTc (LHsExpr GhcTc)))
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ \ [Scaled ExpRhoType]
    pat_tys ExpRhoType
    rhs_ty ->
                 -- NB: exp_type may be polymorphic, but
                 --     matchExpectedFunTys can cope with that
              Mult
    -> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
    -> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    Many (TcM (MatchGroup GhcTc (LHsExpr GhcTc))
     -> TcM (MatchGroup GhcTc (LHsExpr GhcTc)))
    -> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
    -> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $
              -- toplevel bindings and let bindings are, at the
              -- moment, always unrestricted. The value being bound
              -- must, accordingly, be unrestricted. Hence them
              -- being scaled by Many. When let binders come with a
              -- multiplicity, then @tcMatchesFun@ will have to take
              -- a multiplicity argument, and scale accordingly.
              TcMatchCtxt HsExpr
    -> [Scaled ExpRhoType]
    -> ExpRhoType
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    -> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
    forall (body :: * -> *).
    Outputable (body GhcRn) =>
    TcMatchCtxt body
    -> [Scaled ExpRhoType]
    -> ExpRhoType
    -> MatchGroup GhcRn (Located (body GhcRn))
    -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
    tcMatches TcMatchCtxt HsExpr
    match_ctxt [Scaled ExpRhoType]
    pat_tys ExpRhoType
    rhs_ty MatchGroup GhcRn (LHsExpr GhcRn)
    matches }
      where
        arity :: Arity
    arity  = MatchGroup GhcRn (LHsExpr GhcRn) -> Arity
    forall (id :: Pass) body. MatchGroup (GhcPass id) body -> Arity
    matchGroupArity MatchGroup GhcRn (LHsExpr GhcRn)
    matches
        herald :: SDoc
    herald = String -> SDoc
    text String
    "The equation(s) for"
                 SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    fun_name) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "have"
        ctxt :: UserTypeCtxt
    ctxt   = UserTypeCtxt
    GenSigCtxt  -- Was: FunSigCtxt fun_name True
                             -- But that's wrong for f :: Int -> forall a. blah
        what :: HsMatchContext GhcRn
    what   = FunRhs :: forall p.
    LIdP p -> LexicalFixity -> SrcStrictness -> HsMatchContext p
    FunRhs { mc_fun :: LIdP GhcRn
    mc_fun = Located Name
    LIdP GhcRn
    fn, mc_fixity :: LexicalFixity
    mc_fixity = LexicalFixity
    Prefix, mc_strictness :: SrcStrictness
    mc_strictness = SrcStrictness
    strictness }
        match_ctxt :: TcMatchCtxt HsExpr
    match_ctxt = MC :: forall (body :: * -> *).
    HsMatchContext GhcRn
    -> (Located (body GhcRn)
        -> ExpRhoType -> TcM (Located (body GhcTc)))
    -> TcMatchCtxt body
    MC { mc_what :: HsMatchContext GhcRn
    mc_what = HsMatchContext GhcRn
    what, mc_body :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    mc_body = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBody }
        strictness :: SrcStrictness
    strictness
          | [L SrcSpan
    _ Match GhcRn (LHsExpr GhcRn)
    match] <- GenLocated SrcSpan [LMatch GhcRn (LHsExpr GhcRn)]
    -> [LMatch GhcRn (LHsExpr GhcRn)]
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpan [LMatch GhcRn (LHsExpr GhcRn)]
     -> [LMatch GhcRn (LHsExpr GhcRn)])
    -> GenLocated SrcSpan [LMatch GhcRn (LHsExpr GhcRn)]
    -> [LMatch GhcRn (LHsExpr GhcRn)]
    forall a b. (a -> b) -> a -> b
    $ MatchGroup GhcRn (LHsExpr GhcRn)
    -> GenLocated SrcSpan [LMatch GhcRn (LHsExpr GhcRn)]
    forall p body. MatchGroup p body -> Located [LMatch p body]
    mg_alts MatchGroup GhcRn (LHsExpr GhcRn)
    matches
          , FunRhs{ mc_strictness :: forall p. HsMatchContext p -> SrcStrictness
    mc_strictness = SrcStrictness
    SrcStrict } <- Match GhcRn (LHsExpr GhcRn) -> HsMatchContext (NoGhcTc GhcRn)
    forall p body. Match p body -> HsMatchContext (NoGhcTc p)
    m_ctxt Match GhcRn (LHsExpr GhcRn)
    match
          = SrcStrictness
    SrcStrict
          | Bool
    otherwise
          = SrcStrictness
    NoSrcStrict

    {-
    @tcMatchesCase@ doesn't do the argument-count check because the
    parser guarantees that each equation has exactly one argument.
    -}

    tcMatchesCase :: (Outputable (body GhcRn)) =>
                    TcMatchCtxt body                        -- Case context
                 -> Scaled TcSigmaType                      -- Type of scrutinee
                 -> MatchGroup GhcRn (Located (body GhcRn)) -- The case alternatives
                 -> ExpRhoType                    -- Type of whole case expressions
                 -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
                    -- Translated alternatives
                    -- wrapper goes from MatchGroup's ty to expected ty

    tcMatchesCase :: forall (body :: * -> *).
    Outputable (body GhcRn) =>
    TcMatchCtxt body
    -> Scaled Mult
    -> MatchGroup GhcRn (Located (body GhcRn))
    -> ExpRhoType
    -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
    tcMatchesCase TcMatchCtxt body
    ctxt (Scaled Mult
    scrut_mult Mult
    scrut_ty) MatchGroup GhcRn (Located (body GhcRn))
    matches ExpRhoType
    res_ty
      = TcMatchCtxt body
    -> [Scaled ExpRhoType]
    -> ExpRhoType
    -> MatchGroup GhcRn (Located (body GhcRn))
    -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
    forall (body :: * -> *).
    Outputable (body GhcRn) =>
    TcMatchCtxt body
    -> [Scaled ExpRhoType]
    -> ExpRhoType
    -> MatchGroup GhcRn (Located (body GhcRn))
    -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
    tcMatches TcMatchCtxt body
    ctxt [Mult -> ExpRhoType -> Scaled ExpRhoType
    forall a. Mult -> a -> Scaled a
    Scaled Mult
    scrut_mult (Mult -> ExpRhoType
    mkCheckExpType Mult
    scrut_ty)] ExpRhoType
    res_ty MatchGroup GhcRn (Located (body GhcRn))
    matches

    tcMatchLambda :: SDoc -- see Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify
                  -> TcMatchCtxt HsExpr
                  -> MatchGroup GhcRn (LHsExpr GhcRn)
                  -> ExpRhoType
                  -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    tcMatchLambda :: SDoc
    -> TcMatchCtxt HsExpr
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    tcMatchLambda SDoc
    herald TcMatchCtxt HsExpr
    match_ctxt MatchGroup GhcRn (LHsExpr GhcRn)
    match ExpRhoType
    res_ty
      = SDoc
    -> UserTypeCtxt
    -> Arity
    -> ExpRhoType
    -> ([Scaled ExpRhoType]
        -> ExpRhoType -> TcM (MatchGroup GhcTc (LHsExpr GhcTc)))
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    forall a.
    SDoc
    -> UserTypeCtxt
    -> Arity
    -> ExpRhoType
    -> ([Scaled ExpRhoType] -> ExpRhoType -> TcM a)
    -> TcM (HsWrapper, a)
    matchExpectedFunTys SDoc
    herald UserTypeCtxt
    GenSigCtxt Arity
    n_pats ExpRhoType
    res_ty (([Scaled ExpRhoType]
      -> ExpRhoType -> TcM (MatchGroup GhcTc (LHsExpr GhcTc)))
     -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc)))
    -> ([Scaled ExpRhoType]
        -> ExpRhoType -> TcM (MatchGroup GhcTc (LHsExpr GhcTc)))
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ \ [Scaled ExpRhoType]
    pat_tys ExpRhoType
    rhs_ty ->
        TcMatchCtxt HsExpr
    -> [Scaled ExpRhoType]
    -> ExpRhoType
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    -> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
    forall (body :: * -> *).
    Outputable (body GhcRn) =>
    TcMatchCtxt body
    -> [Scaled ExpRhoType]
    -> ExpRhoType
    -> MatchGroup GhcRn (Located (body GhcRn))
    -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
    tcMatches TcMatchCtxt HsExpr
    match_ctxt [Scaled ExpRhoType]
    pat_tys ExpRhoType
    rhs_ty MatchGroup GhcRn (LHsExpr GhcRn)
    match
      where
        n_pats :: Arity
    n_pats | MatchGroup GhcRn (LHsExpr GhcRn) -> Bool
    forall id body. MatchGroup id body -> Bool
    isEmptyMatchGroup MatchGroup GhcRn (LHsExpr GhcRn)
    match = Arity
    1   -- must be lambda-case
               | Bool
    otherwise               = MatchGroup GhcRn (LHsExpr GhcRn) -> Arity
    forall (id :: Pass) body. MatchGroup (GhcPass id) body -> Arity
    matchGroupArity MatchGroup GhcRn (LHsExpr GhcRn)
    match

    -- @tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind@.

    tcGRHSsPat :: GRHSs GhcRn (LHsExpr GhcRn) -> TcRhoType
               -> TcM (GRHSs GhcTc (LHsExpr GhcTc))
    -- Used for pattern bindings
    tcGRHSsPat :: GRHSs GhcRn (LHsExpr GhcRn)
    -> Mult -> TcM (GRHSs GhcTc (LHsExpr GhcTc))
    tcGRHSsPat GRHSs GhcRn (LHsExpr GhcRn)
    grhss Mult
    res_ty = TcMatchCtxt HsExpr
    -> GRHSs GhcRn (LHsExpr GhcRn)
    -> ExpRhoType
    -> TcM (GRHSs GhcTc (LHsExpr GhcTc))
    forall (body :: * -> *).
    TcMatchCtxt body
    -> GRHSs GhcRn (Located (body GhcRn))
    -> ExpRhoType
    -> TcM (GRHSs GhcTc (Located (body GhcTc)))
    tcGRHSs TcMatchCtxt HsExpr
    match_ctxt GRHSs GhcRn (LHsExpr GhcRn)
    grhss (Mult -> ExpRhoType
    mkCheckExpType Mult
    res_ty)
      where
        match_ctxt :: TcMatchCtxt HsExpr
    match_ctxt = MC :: forall (body :: * -> *).
    HsMatchContext GhcRn
    -> (Located (body GhcRn)
        -> ExpRhoType -> TcM (Located (body GhcTc)))
    -> TcMatchCtxt body
    MC { mc_what :: HsMatchContext GhcRn
    mc_what = HsMatchContext GhcRn
    forall p. HsMatchContext p
    PatBindRhs,
                          mc_body :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    mc_body = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBody }

    {- *********************************************************************
    *                                                                      *
                    tcMatch
    *                                                                      *
    ********************************************************************* -}

    data TcMatchCtxt body   -- c.f. TcStmtCtxt, also in this module
      = MC { forall (body :: * -> *). TcMatchCtxt body -> HsMatchContext GhcRn
    mc_what :: HsMatchContext GhcRn,  -- What kind of thing this is
             forall (body :: * -> *).
    TcMatchCtxt body
    -> Located (body GhcRn) -> ExpRhoType -> TcM (Located (body GhcTc))
    mc_body :: Located (body GhcRn)   -- Type checker for a body of
                                               -- an alternative
                     -> ExpRhoType
                     -> TcM (Located (body GhcTc)) }

    -- | Type-check a MatchGroup.
    tcMatches :: (Outputable (body GhcRn)) => TcMatchCtxt body
              -> [Scaled ExpSigmaType]      -- Expected pattern types
              -> ExpRhoType                 -- Expected result-type of the Match.
              -> MatchGroup GhcRn (Located (body GhcRn))
              -> TcM (MatchGroup GhcTc (Located (body GhcTc)))

    tcMatches :: forall (body :: * -> *).
    Outputable (body GhcRn) =>
    TcMatchCtxt body
    -> [Scaled ExpRhoType]
    -> ExpRhoType
    -> MatchGroup GhcRn (Located (body GhcRn))
    -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
    tcMatches TcMatchCtxt body
    ctxt [Scaled ExpRhoType]
    pat_tys ExpRhoType
    rhs_ty (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
    mg_alts = L SrcSpan
    l [LMatch GhcRn (Located (body GhcRn))]
    matches
                                      , mg_origin :: forall p body. MatchGroup p body -> Origin
    mg_origin = Origin
    origin })
      | [LMatch GhcRn (Located (body GhcRn))] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LMatch GhcRn (Located (body GhcRn))]
    matches  -- Deal with case e of {}
        -- Since there are no branches, no one else will fill in rhs_ty
        -- when in inference mode, so we must do it ourselves,
        -- here, using expTypeToType
      = do { UsageEnv -> TcRn ()
    tcEmitBindingUsage UsageEnv
    bottomUE
           ; [Scaled Mult]
    pat_tys <- (Scaled ExpRhoType -> IOEnv (Env TcGblEnv TcLclEnv) (Scaled Mult))
    -> [Scaled ExpRhoType]
    -> IOEnv (Env TcGblEnv TcLclEnv) [Scaled Mult]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Scaled ExpRhoType -> IOEnv (Env TcGblEnv TcLclEnv) (Scaled Mult)
    scaledExpTypeToType [Scaled ExpRhoType]
    pat_tys
           ; Mult
    rhs_ty  <- ExpRhoType -> TcM Mult
    expTypeToType ExpRhoType
    rhs_ty
           ; MatchGroup GhcTc (Located (body GhcTc))
    -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MG :: forall p body.
    XMG p body
    -> Located [LMatch p body] -> Origin -> MatchGroup p body
    MG { mg_alts :: Located [LMatch GhcTc (Located (body GhcTc))]
    mg_alts = SrcSpan
    -> [LMatch GhcTc (Located (body GhcTc))]
    -> Located [LMatch GhcTc (Located (body GhcTc))]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l []
                        , mg_ext :: XMG GhcTc (Located (body GhcTc))
    mg_ext = [Scaled Mult] -> Mult -> MatchGroupTc
    MatchGroupTc [Scaled Mult]
    pat_tys Mult
    rhs_ty
                        , mg_origin :: Origin
    mg_origin = Origin
    origin }) }

      | Bool
    otherwise
      = do { [(UsageEnv, LMatch GhcTc (Located (body GhcTc)))]
    umatches <- (LMatch GhcRn (Located (body GhcRn))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (UsageEnv, LMatch GhcTc (Located (body GhcTc))))
    -> [LMatch GhcRn (Located (body GhcRn))]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [(UsageEnv, LMatch GhcTc (Located (body GhcTc)))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (TcM (LMatch GhcTc (Located (body GhcTc)))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (UsageEnv, LMatch GhcTc (Located (body GhcTc)))
    forall a. TcM a -> TcM (UsageEnv, a)
    tcCollectingUsage (TcM (LMatch GhcTc (Located (body GhcTc)))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (UsageEnv, LMatch GhcTc (Located (body GhcTc))))
    -> (LMatch GhcRn (Located (body GhcRn))
        -> TcM (LMatch GhcTc (Located (body GhcTc))))
    -> LMatch GhcRn (Located (body GhcRn))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (UsageEnv, LMatch GhcTc (Located (body GhcTc)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcMatchCtxt body
    -> [Scaled ExpRhoType]
    -> ExpRhoType
    -> LMatch GhcRn (Located (body GhcRn))
    -> TcM (LMatch GhcTc (Located (body GhcTc)))
    forall (body :: * -> *).
    Outputable (body GhcRn) =>
    TcMatchCtxt body
    -> [Scaled ExpRhoType]
    -> ExpRhoType
    -> LMatch GhcRn (Located (body GhcRn))
    -> TcM (LMatch GhcTc (Located (body GhcTc)))
    tcMatch TcMatchCtxt body
    ctxt [Scaled ExpRhoType]
    pat_tys ExpRhoType
    rhs_ty) [LMatch GhcRn (Located (body GhcRn))]
    matches
           ; let ([UsageEnv]
    usages,[LMatch GhcTc (Located (body GhcTc))]
    matches') = [(UsageEnv, LMatch GhcTc (Located (body GhcTc)))]
    -> ([UsageEnv], [LMatch GhcTc (Located (body GhcTc))])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(UsageEnv, LMatch GhcTc (Located (body GhcTc)))]
    umatches
           ; UsageEnv -> TcRn ()
    tcEmitBindingUsage (UsageEnv -> TcRn ()) -> UsageEnv -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ [UsageEnv] -> UsageEnv
    supUEs [UsageEnv]
    usages
           ; [Scaled Mult]
    pat_tys  <- (Scaled ExpRhoType -> IOEnv (Env TcGblEnv TcLclEnv) (Scaled Mult))
    -> [Scaled ExpRhoType]
    -> IOEnv (Env TcGblEnv TcLclEnv) [Scaled Mult]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Scaled ExpRhoType -> IOEnv (Env TcGblEnv TcLclEnv) (Scaled Mult)
    readScaledExpType [Scaled ExpRhoType]
    pat_tys
           ; Mult
    rhs_ty   <- ExpRhoType -> TcM Mult
    readExpType ExpRhoType
    rhs_ty
           ; MatchGroup GhcTc (Located (body GhcTc))
    -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MG :: forall p body.
    XMG p body
    -> Located [LMatch p body] -> Origin -> MatchGroup p body
    MG { mg_alts :: Located [LMatch GhcTc (Located (body GhcTc))]
    mg_alts   = SrcSpan
    -> [LMatch GhcTc (Located (body GhcTc))]
    -> Located [LMatch GhcTc (Located (body GhcTc))]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l [LMatch GhcTc (Located (body GhcTc))]
    matches'
                        , mg_ext :: XMG GhcTc (Located (body GhcTc))
    mg_ext    = [Scaled Mult] -> Mult -> MatchGroupTc
    MatchGroupTc [Scaled Mult]
    pat_tys Mult
    rhs_ty
                        , mg_origin :: Origin
    mg_origin = Origin
    origin }) }

    -------------
    tcMatch :: (Outputable (body GhcRn)) => TcMatchCtxt body
            -> [Scaled ExpSigmaType]        -- Expected pattern types
            -> ExpRhoType            -- Expected result-type of the Match.
            -> LMatch GhcRn (Located (body GhcRn))
            -> TcM (LMatch GhcTc (Located (body GhcTc)))

    tcMatch :: forall (body :: * -> *).
    Outputable (body GhcRn) =>
    TcMatchCtxt body
    -> [Scaled ExpRhoType]
    -> ExpRhoType
    -> LMatch GhcRn (Located (body GhcRn))
    -> TcM (LMatch GhcTc (Located (body GhcTc)))
    tcMatch TcMatchCtxt body
    ctxt [Scaled ExpRhoType]
    pat_tys ExpRhoType
    rhs_ty LMatch GhcRn (Located (body GhcRn))
    match
      = (Match GhcRn (Located (body GhcRn))
     -> TcM (Match GhcTc (Located (body GhcTc))))
    -> LMatch GhcRn (Located (body GhcRn))
    -> TcM (Located (Match GhcTc (Located (body GhcTc))))
    forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
    wrapLocM (TcMatchCtxt body
    -> [Scaled ExpRhoType]
    -> ExpRhoType
    -> Match GhcRn (Located (body GhcRn))
    -> TcM (Match GhcTc (Located (body GhcTc)))
    tc_match TcMatchCtxt body
    ctxt [Scaled ExpRhoType]
    pat_tys ExpRhoType
    rhs_ty) LMatch GhcRn (Located (body GhcRn))
    match
      where
        tc_match :: TcMatchCtxt body
    -> [Scaled ExpRhoType]
    -> ExpRhoType
    -> Match GhcRn (Located (body GhcRn))
    -> TcM (Match GhcTc (Located (body GhcTc)))
    tc_match TcMatchCtxt body
    ctxt [Scaled ExpRhoType]
    pat_tys ExpRhoType
    rhs_ty
                 match :: Match GhcRn (Located (body GhcRn))
    match@(Match { m_pats :: forall p body. Match p body -> [LPat p]
    m_pats = [LPat GhcRn]
    pats, m_grhss :: forall p body. Match p body -> GRHSs p body
    m_grhss = GRHSs GhcRn (Located (body GhcRn))
    grhss })
          = Match GhcRn (Located (body GhcRn))
    -> TcM (Match GhcTc (Located (body GhcTc)))
    -> TcM (Match GhcTc (Located (body GhcTc)))
    add_match_ctxt Match GhcRn (Located (body GhcRn))
    match (TcM (Match GhcTc (Located (body GhcTc)))
     -> TcM (Match GhcTc (Located (body GhcTc))))
    -> TcM (Match GhcTc (Located (body GhcTc)))
    -> TcM (Match GhcTc (Located (body GhcTc)))
    forall a b. (a -> b) -> a -> b
    $
            do { ([Located (Pat GhcTc)]
    pats', GRHSs GhcTc (Located (body GhcTc))
    grhss') <- HsMatchContext GhcRn
    -> [LPat GhcRn]
    -> [Scaled ExpRhoType]
    -> TcM (GRHSs GhcTc (Located (body GhcTc)))
    -> TcM ([LPat GhcTc], GRHSs GhcTc (Located (body GhcTc)))
    forall a.
    HsMatchContext GhcRn
    -> [LPat GhcRn]
    -> [Scaled ExpRhoType]
    -> TcM a
    -> TcM ([LPat GhcTc], a)
    tcPats (TcMatchCtxt body -> HsMatchContext GhcRn
    forall (body :: * -> *). TcMatchCtxt body -> HsMatchContext GhcRn
    mc_what TcMatchCtxt body
    ctxt) [LPat GhcRn]
    pats [Scaled ExpRhoType]
    pat_tys (TcM (GRHSs GhcTc (Located (body GhcTc)))
     -> TcM ([LPat GhcTc], GRHSs GhcTc (Located (body GhcTc))))
    -> TcM (GRHSs GhcTc (Located (body GhcTc)))
    -> TcM ([LPat GhcTc], GRHSs GhcTc (Located (body GhcTc)))
    forall a b. (a -> b) -> a -> b
    $
                                    TcMatchCtxt body
    -> GRHSs GhcRn (Located (body GhcRn))
    -> ExpRhoType
    -> TcM (GRHSs GhcTc (Located (body GhcTc)))
    forall (body :: * -> *).
    TcMatchCtxt body
    -> GRHSs GhcRn (Located (body GhcRn))
    -> ExpRhoType
    -> TcM (GRHSs GhcTc (Located (body GhcTc)))
    tcGRHSs TcMatchCtxt body
    ctxt GRHSs GhcRn (Located (body GhcRn))
    grhss ExpRhoType
    rhs_ty
               ; Match GhcTc (Located (body GhcTc))
    -> TcM (Match GhcTc (Located (body GhcTc)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Match :: forall p body.
    XCMatch p body
    -> HsMatchContext (NoGhcTc p)
    -> [LPat p]
    -> GRHSs p body
    -> Match p body
    Match { m_ext :: XCMatch GhcTc (Located (body GhcTc))
    m_ext = NoExtField
    XCMatch GhcTc (Located (body GhcTc))
    noExtField
                               , m_ctxt :: HsMatchContext (NoGhcTc GhcTc)
    m_ctxt = TcMatchCtxt body -> HsMatchContext GhcRn
    forall (body :: * -> *). TcMatchCtxt body -> HsMatchContext GhcRn
    mc_what TcMatchCtxt body
    ctxt, m_pats :: [LPat GhcTc]
    m_pats = [Located (Pat GhcTc)]
    [LPat GhcTc]
    pats'
                               , m_grhss :: GRHSs GhcTc (Located (body GhcTc))
    m_grhss = GRHSs GhcTc (Located (body GhcTc))
    grhss' }) }

            -- For (\x -> e), tcExpr has already said "In the expression \x->e"
            -- so we don't want to add "In the lambda abstraction \x->e"
        add_match_ctxt :: Match GhcRn (Located (body GhcRn))
    -> TcM (Match GhcTc (Located (body GhcTc)))
    -> TcM (Match GhcTc (Located (body GhcTc)))
    add_match_ctxt Match GhcRn (Located (body GhcRn))
    match TcM (Match GhcTc (Located (body GhcTc)))
    thing_inside
            = case TcMatchCtxt body -> HsMatchContext GhcRn
    forall (body :: * -> *). TcMatchCtxt body -> HsMatchContext GhcRn
    mc_what TcMatchCtxt body
    ctxt of
                HsMatchContext GhcRn
    LambdaExpr -> TcM (Match GhcTc (Located (body GhcTc)))
    thing_inside
                HsMatchContext GhcRn
    _          -> SDoc
    -> TcM (Match GhcTc (Located (body GhcTc)))
    -> TcM (Match GhcTc (Located (body GhcTc)))
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (Match GhcRn (Located (body GhcRn)) -> SDoc
    forall (idR :: Pass) body.
    (OutputableBndrId idR, Outputable body) =>
    Match (GhcPass idR) body -> SDoc
    pprMatchInCtxt Match GhcRn (Located (body GhcRn))
    match) TcM (Match GhcTc (Located (body GhcTc)))
    thing_inside

    -------------
    tcGRHSs :: TcMatchCtxt body -> GRHSs GhcRn (Located (body GhcRn)) -> ExpRhoType
            -> TcM (GRHSs GhcTc (Located (body GhcTc)))

    -- Notice that we pass in the full res_ty, so that we get
    -- good inference from simple things like
    --      f = \(x::forall a.a->a) -> <stuff>
    -- We used to force it to be a monotype when there was more than one guard
    -- but we don't need to do that any more

    tcGRHSs :: forall (body :: * -> *).
    TcMatchCtxt body
    -> GRHSs GhcRn (Located (body GhcRn))
    -> ExpRhoType
    -> TcM (GRHSs GhcTc (Located (body GhcTc)))
    tcGRHSs TcMatchCtxt body
    ctxt (GRHSs XCGRHSs GhcRn (Located (body GhcRn))
    _ [LGRHS GhcRn (Located (body GhcRn))]
    grhss (L SrcSpan
    l HsLocalBinds GhcRn
    binds)) ExpRhoType
    res_ty
      = do  { (HsLocalBinds GhcTc
    binds', [(UsageEnv, Located (GRHS GhcTc (Located (body GhcTc))))]
    ugrhss)
                <- HsLocalBinds GhcRn
    -> TcM [(UsageEnv, Located (GRHS GhcTc (Located (body GhcTc))))]
    -> TcM
         (HsLocalBinds GhcTc,
          [(UsageEnv, Located (GRHS GhcTc (Located (body GhcTc))))])
    forall thing.
    HsLocalBinds GhcRn -> TcM thing -> TcM (HsLocalBinds GhcTc, thing)
    tcLocalBinds HsLocalBinds GhcRn
    binds (TcM [(UsageEnv, Located (GRHS GhcTc (Located (body GhcTc))))]
     -> TcM
          (HsLocalBinds GhcTc,
           [(UsageEnv, Located (GRHS GhcTc (Located (body GhcTc))))]))
    -> TcM [(UsageEnv, Located (GRHS GhcTc (Located (body GhcTc))))]
    -> TcM
         (HsLocalBinds GhcTc,
          [(UsageEnv, Located (GRHS GhcTc (Located (body GhcTc))))])
    forall a b. (a -> b) -> a -> b
    $
                   (LGRHS GhcRn (Located (body GhcRn))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (UsageEnv, Located (GRHS GhcTc (Located (body GhcTc)))))
    -> [LGRHS GhcRn (Located (body GhcRn))]
    -> TcM [(UsageEnv, Located (GRHS GhcTc (Located (body GhcTc))))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (TcM (Located (GRHS GhcTc (Located (body GhcTc))))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (UsageEnv, Located (GRHS GhcTc (Located (body GhcTc))))
    forall a. TcM a -> TcM (UsageEnv, a)
    tcCollectingUsage (TcM (Located (GRHS GhcTc (Located (body GhcTc))))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (UsageEnv, Located (GRHS GhcTc (Located (body GhcTc)))))
    -> (LGRHS GhcRn (Located (body GhcRn))
        -> TcM (Located (GRHS GhcTc (Located (body GhcTc)))))
    -> LGRHS GhcRn (Located (body GhcRn))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (UsageEnv, Located (GRHS GhcTc (Located (body GhcTc))))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GRHS GhcRn (Located (body GhcRn))
     -> TcM (GRHS GhcTc (Located (body GhcTc))))
    -> LGRHS GhcRn (Located (body GhcRn))
    -> TcM (Located (GRHS GhcTc (Located (body GhcTc))))
    forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
    wrapLocM (TcMatchCtxt body
    -> ExpRhoType
    -> GRHS GhcRn (Located (body GhcRn))
    -> TcM (GRHS GhcTc (Located (body GhcTc)))
    forall (body :: * -> *).
    TcMatchCtxt body
    -> ExpRhoType
    -> GRHS GhcRn (Located (body GhcRn))
    -> TcM (GRHS GhcTc (Located (body GhcTc)))
    tcGRHS TcMatchCtxt body
    ctxt ExpRhoType
    res_ty)) [LGRHS GhcRn (Located (body GhcRn))]
    grhss
            ; let ([UsageEnv]
    usages, [Located (GRHS GhcTc (Located (body GhcTc)))]
    grhss') = [(UsageEnv, Located (GRHS GhcTc (Located (body GhcTc))))]
    -> ([UsageEnv], [Located (GRHS GhcTc (Located (body GhcTc)))])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(UsageEnv, Located (GRHS GhcTc (Located (body GhcTc))))]
    ugrhss
            ; UsageEnv -> TcRn ()
    tcEmitBindingUsage (UsageEnv -> TcRn ()) -> UsageEnv -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ [UsageEnv] -> UsageEnv
    supUEs [UsageEnv]
    usages
            ; GRHSs GhcTc (Located (body GhcTc))
    -> TcM (GRHSs GhcTc (Located (body GhcTc)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCGRHSs GhcTc (Located (body GhcTc))
    -> [Located (GRHS GhcTc (Located (body GhcTc)))]
    -> LHsLocalBinds GhcTc
    -> GRHSs GhcTc (Located (body GhcTc))
    forall p body.
    XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
    GRHSs NoExtField
    XCGRHSs GhcTc (Located (body GhcTc))
    noExtField [Located (GRHS GhcTc (Located (body GhcTc)))]
    grhss' (SrcSpan -> HsLocalBinds GhcTc -> LHsLocalBinds GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsLocalBinds GhcTc
    binds')) }

    -------------
    tcGRHS :: TcMatchCtxt body -> ExpRhoType -> GRHS GhcRn (Located (body GhcRn))
           -> TcM (GRHS GhcTc (Located (body GhcTc)))

    tcGRHS :: forall (body :: * -> *).
    TcMatchCtxt body
    -> ExpRhoType
    -> GRHS GhcRn (Located (body GhcRn))
    -> TcM (GRHS GhcTc (Located (body GhcTc)))
    tcGRHS TcMatchCtxt body
    ctxt ExpRhoType
    res_ty (GRHS XCGRHS GhcRn (Located (body GhcRn))
    _ [GuardLStmt GhcRn]
    guards Located (body GhcRn)
    rhs)
      = do  { ([LStmt GhcTc (LHsExpr GhcTc)]
    guards', Located (body GhcTc)
    rhs')
                <- HsStmtContext GhcRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [GuardLStmt GhcRn]
    -> ExpRhoType
    -> (ExpRhoType -> TcM (Located (body GhcTc)))
    -> TcM ([LStmt GhcTc (LHsExpr GhcTc)], Located (body GhcTc))
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext GhcRn
    stmt_ctxt TcStmtChecker HsExpr ExpRhoType
    tcGuardStmt [GuardLStmt GhcRn]
    guards ExpRhoType
    res_ty ((ExpRhoType -> TcM (Located (body GhcTc)))
     -> TcM ([LStmt GhcTc (LHsExpr GhcTc)], Located (body GhcTc)))
    -> (ExpRhoType -> TcM (Located (body GhcTc)))
    -> TcM ([LStmt GhcTc (LHsExpr GhcTc)], Located (body GhcTc))
    forall a b. (a -> b) -> a -> b
    $
                   TcMatchCtxt body
    -> Located (body GhcRn) -> ExpRhoType -> TcM (Located (body GhcTc))
    forall (body :: * -> *).
    TcMatchCtxt body
    -> Located (body GhcRn) -> ExpRhoType -> TcM (Located (body GhcTc))
    mc_body TcMatchCtxt body
    ctxt Located (body GhcRn)
    rhs
            ; GRHS GhcTc (Located (body GhcTc))
    -> TcM (GRHS GhcTc (Located (body GhcTc)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCGRHS GhcTc (Located (body GhcTc))
    -> [LStmt GhcTc (LHsExpr GhcTc)]
    -> Located (body GhcTc)
    -> GRHS GhcTc (Located (body GhcTc))
    forall p body.
    XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
    GRHS NoExtField
    XCGRHS GhcTc (Located (body GhcTc))
    noExtField [LStmt GhcTc (LHsExpr GhcTc)]
    guards' Located (body GhcTc)
    rhs') }
      where
        stmt_ctxt :: HsStmtContext GhcRn
    stmt_ctxt  = HsMatchContext GhcRn -> HsStmtContext GhcRn
    forall p. HsMatchContext p -> HsStmtContext p
    PatGuard (TcMatchCtxt body -> HsMatchContext GhcRn
    forall (body :: * -> *). TcMatchCtxt body -> HsMatchContext GhcRn
    mc_what TcMatchCtxt body
    ctxt)

    {-
    ************************************************************************
    *                                                                      *
    \subsection{@tcDoStmts@ typechecks a {\em list} of do statements}
    *                                                                      *
    ************************************************************************
    -}

    tcDoStmts :: HsStmtContext GhcRn
              -> Located [LStmt GhcRn (LHsExpr GhcRn)]
              -> ExpRhoType
              -> TcM (HsExpr GhcTc)          -- Returns a HsDo
    tcDoStmts :: HsStmtContext GhcRn
    -> Located [GuardLStmt GhcRn] -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcDoStmts HsStmtContext GhcRn
    ListComp (L SrcSpan
    l [GuardLStmt GhcRn]
    stmts) ExpRhoType
    res_ty
      = do  { Mult
    res_ty <- ExpRhoType -> TcM Mult
    expTypeToType ExpRhoType
    res_ty
            ; (TcCoercionN
    co, Mult
    elt_ty) <- Mult -> TcM (TcCoercionN, Mult)
    matchExpectedListTy Mult
    res_ty
            ; let list_ty :: Mult
    list_ty = Mult -> Mult
    mkListTy Mult
    elt_ty
            ; [LStmt GhcTc (LHsExpr GhcTc)]
    stmts' <- HsStmtContext GhcRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [GuardLStmt GhcRn]
    -> ExpRhoType
    -> TcM [LStmt GhcTc (LHsExpr GhcTc)]
    forall (body :: * -> *) rho_type.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> TcM [LStmt GhcTc (Located (body GhcTc))]
    tcStmts HsStmtContext GhcRn
    forall p. HsStmtContext p
    ListComp (TyCon -> TcStmtChecker HsExpr ExpRhoType
    tcLcStmt TyCon
    listTyCon) [GuardLStmt GhcRn]
    stmts
                                (Mult -> ExpRhoType
    mkCheckExpType Mult
    elt_ty)
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
    -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ TcCoercionN -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrapCo TcCoercionN
    co (XDo GhcTc
    -> HsStmtContext GhcRn
    -> Located [LStmt GhcTc (LHsExpr GhcTc)]
    -> HsExpr GhcTc
    forall p.
    XDo p -> HsStmtContext GhcRn -> Located [ExprLStmt p] -> HsExpr p
    HsDo Mult
    XDo GhcTc
    list_ty HsStmtContext GhcRn
    forall p. HsStmtContext p
    ListComp (SrcSpan
    -> [LStmt GhcTc (LHsExpr GhcTc)]
    -> Located [LStmt GhcTc (LHsExpr GhcTc)]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l [LStmt GhcTc (LHsExpr GhcTc)]
    stmts')) }

    tcDoStmts doExpr :: HsStmtContext GhcRn
    doExpr@(DoExpr Maybe ModuleName
    _) (L SrcSpan
    l [GuardLStmt GhcRn]
    stmts) ExpRhoType
    res_ty
      = do  { [LStmt GhcTc (LHsExpr GhcTc)]
    stmts' <- HsStmtContext GhcRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [GuardLStmt GhcRn]
    -> ExpRhoType
    -> TcM [LStmt GhcTc (LHsExpr GhcTc)]
    forall (body :: * -> *) rho_type.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> TcM [LStmt GhcTc (Located (body GhcTc))]
    tcStmts HsStmtContext GhcRn
    doExpr TcStmtChecker HsExpr ExpRhoType
    tcDoStmt [GuardLStmt GhcRn]
    stmts ExpRhoType
    res_ty
            ; Mult
    res_ty <- ExpRhoType -> TcM Mult
    readExpType ExpRhoType
    res_ty
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XDo GhcTc
    -> HsStmtContext GhcRn
    -> Located [LStmt GhcTc (LHsExpr GhcTc)]
    -> HsExpr GhcTc
    forall p.
    XDo p -> HsStmtContext GhcRn -> Located [ExprLStmt p] -> HsExpr p
    HsDo Mult
    XDo GhcTc
    res_ty HsStmtContext GhcRn
    doExpr (SrcSpan
    -> [LStmt GhcTc (LHsExpr GhcTc)]
    -> Located [LStmt GhcTc (LHsExpr GhcTc)]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l [LStmt GhcTc (LHsExpr GhcTc)]
    stmts')) }

    tcDoStmts mDoExpr :: HsStmtContext GhcRn
    mDoExpr@(MDoExpr Maybe ModuleName
    _) (L SrcSpan
    l [GuardLStmt GhcRn]
    stmts) ExpRhoType
    res_ty
      = do  { [LStmt GhcTc (LHsExpr GhcTc)]
    stmts' <- HsStmtContext GhcRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [GuardLStmt GhcRn]
    -> ExpRhoType
    -> TcM [LStmt GhcTc (LHsExpr GhcTc)]
    forall (body :: * -> *) rho_type.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> TcM [LStmt GhcTc (Located (body GhcTc))]
    tcStmts HsStmtContext GhcRn
    mDoExpr TcStmtChecker HsExpr ExpRhoType
    tcDoStmt [GuardLStmt GhcRn]
    stmts ExpRhoType
    res_ty
            ; Mult
    res_ty <- ExpRhoType -> TcM Mult
    readExpType ExpRhoType
    res_ty
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XDo GhcTc
    -> HsStmtContext GhcRn
    -> Located [LStmt GhcTc (LHsExpr GhcTc)]
    -> HsExpr GhcTc
    forall p.
    XDo p -> HsStmtContext GhcRn -> Located [ExprLStmt p] -> HsExpr p
    HsDo Mult
    XDo GhcTc
    res_ty HsStmtContext GhcRn
    mDoExpr (SrcSpan
    -> [LStmt GhcTc (LHsExpr GhcTc)]
    -> Located [LStmt GhcTc (LHsExpr GhcTc)]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l [LStmt GhcTc (LHsExpr GhcTc)]
    stmts')) }

    tcDoStmts HsStmtContext GhcRn
    MonadComp (L SrcSpan
    l [GuardLStmt GhcRn]
    stmts) ExpRhoType
    res_ty
      = do  { [LStmt GhcTc (LHsExpr GhcTc)]
    stmts' <- HsStmtContext GhcRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [GuardLStmt GhcRn]
    -> ExpRhoType
    -> TcM [LStmt GhcTc (LHsExpr GhcTc)]
    forall (body :: * -> *) rho_type.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> TcM [LStmt GhcTc (Located (body GhcTc))]
    tcStmts HsStmtContext GhcRn
    forall p. HsStmtContext p
    MonadComp TcStmtChecker HsExpr ExpRhoType
    tcMcStmt [GuardLStmt GhcRn]
    stmts ExpRhoType
    res_ty
            ; Mult
    res_ty <- ExpRhoType -> TcM Mult
    readExpType ExpRhoType
    res_ty
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XDo GhcTc
    -> HsStmtContext GhcRn
    -> Located [LStmt GhcTc (LHsExpr GhcTc)]
    -> HsExpr GhcTc
    forall p.
    XDo p -> HsStmtContext GhcRn -> Located [ExprLStmt p] -> HsExpr p
    HsDo Mult
    XDo GhcTc
    res_ty HsStmtContext GhcRn
    forall p. HsStmtContext p
    MonadComp (SrcSpan
    -> [LStmt GhcTc (LHsExpr GhcTc)]
    -> Located [LStmt GhcTc (LHsExpr GhcTc)]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l [LStmt GhcTc (LHsExpr GhcTc)]
    stmts')) }

    tcDoStmts HsStmtContext GhcRn
    ctxt Located [GuardLStmt GhcRn]
    _ ExpRhoType
    _ = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcDoStmts" (HsStmtContext GhcRn -> SDoc
    forall id. Outputable (IdP id) => HsStmtContext id -> SDoc
    pprStmtContext HsStmtContext GhcRn
    ctxt)

    tcBody :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBody :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBody LHsExpr GhcRn
    body ExpRhoType
    res_ty
      = do  { String -> SDoc -> TcRn ()
    traceTc String
    "tcBody" (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    res_ty)
            ; LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExpr LHsExpr GhcRn
    body ExpRhoType
    res_ty
            }

    {-
    ************************************************************************
    *                                                                      *
    \subsection{tcStmts}
    *                                                                      *
    ************************************************************************
    -}

    type TcExprStmtChecker = TcStmtChecker HsExpr ExpRhoType
    type TcCmdStmtChecker  = TcStmtChecker HsCmd  TcRhoType

    type TcStmtChecker body rho_type
      =  forall thing. HsStmtContext GhcRn
                    -> Stmt GhcRn (Located (body GhcRn))
                    -> rho_type                 -- Result type for comprehension
                    -> (rho_type -> TcM thing)  -- Checker for what follows the stmt
                    -> TcM (Stmt GhcTc (Located (body GhcTc)), thing)

    tcStmts :: (Outputable (body GhcRn)) => HsStmtContext GhcRn
            -> TcStmtChecker body rho_type   -- NB: higher-rank type
            -> [LStmt GhcRn (Located (body GhcRn))]
            -> rho_type
            -> TcM [LStmt GhcTc (Located (body GhcTc))]
    tcStmts :: forall (body :: * -> *) rho_type.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> TcM [LStmt GhcTc (Located (body GhcTc))]
    tcStmts HsStmtContext GhcRn
    ctxt TcStmtChecker body rho_type
    stmt_chk [LStmt GhcRn (Located (body GhcRn))]
    stmts rho_type
    res_ty
      = do { ([LStmt GhcTc (Located (body GhcTc))]
    stmts', ()
    _) <- HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcRn ())
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], ())
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext GhcRn
    ctxt TcStmtChecker body rho_type
    stmt_chk [LStmt GhcRn (Located (body GhcRn))]
    stmts rho_type
    res_ty ((rho_type -> TcRn ())
     -> TcM ([LStmt GhcTc (Located (body GhcTc))], ()))
    -> (rho_type -> TcRn ())
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], ())
    forall a b. (a -> b) -> a -> b
    $
                            TcRn () -> rho_type -> TcRn ()
    forall a b. a -> b -> a
    const (() -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
           ; [LStmt GhcTc (Located (body GhcTc))]
    -> TcM [LStmt GhcTc (Located (body GhcTc))]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [LStmt GhcTc (Located (body GhcTc))]
    stmts' }

    tcStmtsAndThen :: (Outputable (body GhcRn)) => HsStmtContext GhcRn
                   -> TcStmtChecker body rho_type    -- NB: higher-rank type
                   -> [LStmt GhcRn (Located (body GhcRn))]
                   -> rho_type
                   -> (rho_type -> TcM thing)
                   -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)

    -- Note the higher-rank type.  stmt_chk is applied at different
    -- types in the equations for tcStmts

    tcStmtsAndThen :: forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext GhcRn
    _ TcStmtChecker body rho_type
    _ [] rho_type
    res_ty rho_type -> TcM thing
    thing_inside
      = do  { thing
    thing <- rho_type -> TcM thing
    thing_inside rho_type
    res_ty
            ; ([LStmt GhcTc (Located (body GhcTc))], thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], thing
    thing) }

    -- LetStmts are handled uniformly, regardless of context
    tcStmtsAndThen HsStmtContext GhcRn
    ctxt TcStmtChecker body rho_type
    stmt_chk (L SrcSpan
    loc (LetStmt XLetStmt GhcRn GhcRn (Located (body GhcRn))
    x (L SrcSpan
    l HsLocalBinds GhcRn
    binds)) : [LStmt GhcRn (Located (body GhcRn))]
    stmts)
                                                                 rho_type
    res_ty rho_type -> TcM thing
    thing_inside
      = do  { (HsLocalBinds GhcTc
    binds', ([LStmt GhcTc (Located (body GhcTc))]
    stmts',thing
    thing)) <- HsLocalBinds GhcRn
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    -> TcM
         (HsLocalBinds GhcTc, ([LStmt GhcTc (Located (body GhcTc))], thing))
    forall thing.
    HsLocalBinds GhcRn -> TcM thing -> TcM (HsLocalBinds GhcTc, thing)
    tcLocalBinds HsLocalBinds GhcRn
    binds (TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
     -> TcM
          (HsLocalBinds GhcTc,
           ([LStmt GhcTc (Located (body GhcTc))], thing)))
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    -> TcM
         (HsLocalBinds GhcTc, ([LStmt GhcTc (Located (body GhcTc))], thing))
    forall a b. (a -> b) -> a -> b
    $
                  HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext GhcRn
    ctxt TcStmtChecker body rho_type
    stmt_chk [LStmt GhcRn (Located (body GhcRn))]
    stmts rho_type
    res_ty rho_type -> TcM thing
    thing_inside
            ; ([LStmt GhcTc (Located (body GhcTc))], thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan
    -> StmtLR GhcTc GhcTc (Located (body GhcTc))
    -> LStmt GhcTc (Located (body GhcTc))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XLetStmt GhcTc GhcTc (Located (body GhcTc))
    -> LHsLocalBinds GhcTc -> StmtLR GhcTc GhcTc (Located (body GhcTc))
    forall idL idR body.
    XLetStmt idL idR body
    -> LHsLocalBindsLR idL idR -> StmtLR idL idR body
    LetStmt XLetStmt GhcRn GhcRn (Located (body GhcRn))
    XLetStmt GhcTc GhcTc (Located (body GhcTc))
    x (SrcSpan -> HsLocalBinds GhcTc -> LHsLocalBinds GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsLocalBinds GhcTc
    binds')) LStmt GhcTc (Located (body GhcTc))
    -> [LStmt GhcTc (Located (body GhcTc))]
    -> [LStmt GhcTc (Located (body GhcTc))]
    forall a. a -> [a] -> [a]
    : [LStmt GhcTc (Located (body GhcTc))]
    stmts', thing
    thing) }

    -- Don't set the error context for an ApplicativeStmt.  It ought to be
    -- possible to do this with a popErrCtxt in the tcStmt case for
    -- ApplicativeStmt, but it did something strange and broke a test (ado002).
    tcStmtsAndThen HsStmtContext GhcRn
    ctxt TcStmtChecker body rho_type
    stmt_chk (L SrcSpan
    loc StmtLR GhcRn GhcRn (Located (body GhcRn))
    stmt : [LStmt GhcRn (Located (body GhcRn))]
    stmts) rho_type
    res_ty rho_type -> TcM thing
    thing_inside
      | ApplicativeStmt{} <- StmtLR GhcRn GhcRn (Located (body GhcRn))
    stmt
      = do  { (StmtLR GhcTc GhcTc (Located (body GhcTc))
    stmt', ([LStmt GhcTc (Located (body GhcTc))]
    stmts', thing
    thing)) <-
                 HsStmtContext GhcRn
    -> StmtLR GhcRn GhcRn (Located (body GhcRn))
    -> rho_type
    -> (rho_type -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing))
    -> TcM
         (StmtLR GhcTc GhcTc (Located (body GhcTc)),
          ([LStmt GhcTc (Located (body GhcTc))], thing))
    TcStmtChecker body rho_type
    stmt_chk HsStmtContext GhcRn
    ctxt StmtLR GhcRn GhcRn (Located (body GhcRn))
    stmt rho_type
    res_ty ((rho_type -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing))
     -> TcM
          (StmtLR GhcTc GhcTc (Located (body GhcTc)),
           ([LStmt GhcTc (Located (body GhcTc))], thing)))
    -> (rho_type -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing))
    -> TcM
         (StmtLR GhcTc GhcTc (Located (body GhcTc)),
          ([LStmt GhcTc (Located (body GhcTc))], thing))
    forall a b. (a -> b) -> a -> b
    $ \ rho_type
    res_ty' ->
                   HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext GhcRn
    ctxt TcStmtChecker body rho_type
    stmt_chk [LStmt GhcRn (Located (body GhcRn))]
    stmts rho_type
    res_ty'  ((rho_type -> TcM thing)
     -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing))
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    forall a b. (a -> b) -> a -> b
    $
                     rho_type -> TcM thing
    thing_inside
            ; ([LStmt GhcTc (Located (body GhcTc))], thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan
    -> StmtLR GhcTc GhcTc (Located (body GhcTc))
    -> LStmt GhcTc (Located (body GhcTc))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc StmtLR GhcTc GhcTc (Located (body GhcTc))
    stmt' LStmt GhcTc (Located (body GhcTc))
    -> [LStmt GhcTc (Located (body GhcTc))]
    -> [LStmt GhcTc (Located (body GhcTc))]
    forall a. a -> [a] -> [a]
    : [LStmt GhcTc (Located (body GhcTc))]
    stmts', thing
    thing) }

      -- For the vanilla case, handle the location-setting part
      | Bool
    otherwise
      = do  { (StmtLR GhcTc GhcTc (Located (body GhcTc))
    stmt', ([LStmt GhcTc (Located (body GhcTc))]
    stmts', thing
    thing)) <-
                    SrcSpan
    -> TcM
         (StmtLR GhcTc GhcTc (Located (body GhcTc)),
          ([LStmt GhcTc (Located (body GhcTc))], thing))
    -> TcM
         (StmtLR GhcTc GhcTc (Located (body GhcTc)),
          ([LStmt GhcTc (Located (body GhcTc))], thing))
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc                              (TcM
       (StmtLR GhcTc GhcTc (Located (body GhcTc)),
        ([LStmt GhcTc (Located (body GhcTc))], thing))
     -> TcM
          (StmtLR GhcTc GhcTc (Located (body GhcTc)),
           ([LStmt GhcTc (Located (body GhcTc))], thing)))
    -> TcM
         (StmtLR GhcTc GhcTc (Located (body GhcTc)),
          ([LStmt GhcTc (Located (body GhcTc))], thing))
    -> TcM
         (StmtLR GhcTc GhcTc (Located (body GhcTc)),
          ([LStmt GhcTc (Located (body GhcTc))], thing))
    forall a b. (a -> b) -> a -> b
    $
                    SDoc
    -> TcM
         (StmtLR GhcTc GhcTc (Located (body GhcTc)),
          ([LStmt GhcTc (Located (body GhcTc))], thing))
    -> TcM
         (StmtLR GhcTc GhcTc (Located (body GhcTc)),
          ([LStmt GhcTc (Located (body GhcTc))], thing))
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (HsStmtContext GhcRn
    -> StmtLR GhcRn GhcRn (Located (body GhcRn)) -> SDoc
    forall (idL :: Pass) (idR :: Pass) body.
    (OutputableBndrId idL, OutputableBndrId idR, Outputable body) =>
    HsStmtContext (GhcPass idL)
    -> StmtLR (GhcPass idL) (GhcPass idR) body -> SDoc
    pprStmtInCtxt HsStmtContext GhcRn
    ctxt StmtLR GhcRn GhcRn (Located (body GhcRn))
    stmt)        (TcM
       (StmtLR GhcTc GhcTc (Located (body GhcTc)),
        ([LStmt GhcTc (Located (body GhcTc))], thing))
     -> TcM
          (StmtLR GhcTc GhcTc (Located (body GhcTc)),
           ([LStmt GhcTc (Located (body GhcTc))], thing)))
    -> TcM
         (StmtLR GhcTc GhcTc (Located (body GhcTc)),
          ([LStmt GhcTc (Located (body GhcTc))], thing))
    -> TcM
         (StmtLR GhcTc GhcTc (Located (body GhcTc)),
          ([LStmt GhcTc (Located (body GhcTc))], thing))
    forall a b. (a -> b) -> a -> b
    $
                    HsStmtContext GhcRn
    -> StmtLR GhcRn GhcRn (Located (body GhcRn))
    -> rho_type
    -> (rho_type -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing))
    -> TcM
         (StmtLR GhcTc GhcTc (Located (body GhcTc)),
          ([LStmt GhcTc (Located (body GhcTc))], thing))
    TcStmtChecker body rho_type
    stmt_chk HsStmtContext GhcRn
    ctxt StmtLR GhcRn GhcRn (Located (body GhcRn))
    stmt rho_type
    res_ty                   ((rho_type -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing))
     -> TcM
          (StmtLR GhcTc GhcTc (Located (body GhcTc)),
           ([LStmt GhcTc (Located (body GhcTc))], thing)))
    -> (rho_type -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing))
    -> TcM
         (StmtLR GhcTc GhcTc (Located (body GhcTc)),
          ([LStmt GhcTc (Located (body GhcTc))], thing))
    forall a b. (a -> b) -> a -> b
    $ \ rho_type
    res_ty' ->
                    TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    forall a. TcM a -> TcM a
    popErrCtxt                                  (TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
     -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing))
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    forall a b. (a -> b) -> a -> b
    $
                    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext GhcRn
    ctxt TcStmtChecker body rho_type
    stmt_chk [LStmt GhcRn (Located (body GhcRn))]
    stmts rho_type
    res_ty'  ((rho_type -> TcM thing)
     -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing))
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    forall a b. (a -> b) -> a -> b
    $
                    rho_type -> TcM thing
    thing_inside
            ; ([LStmt GhcTc (Located (body GhcTc))], thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan
    -> StmtLR GhcTc GhcTc (Located (body GhcTc))
    -> LStmt GhcTc (Located (body GhcTc))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc StmtLR GhcTc GhcTc (Located (body GhcTc))
    stmt' LStmt GhcTc (Located (body GhcTc))
    -> [LStmt GhcTc (Located (body GhcTc))]
    -> [LStmt GhcTc (Located (body GhcTc))]
    forall a. a -> [a] -> [a]
    : [LStmt GhcTc (Located (body GhcTc))]
    stmts', thing
    thing) }

    ---------------------------------------------------
    --              Pattern guards
    ---------------------------------------------------

    tcGuardStmt :: TcExprStmtChecker
    tcGuardStmt :: TcStmtChecker HsExpr ExpRhoType
    tcGuardStmt HsStmtContext GhcRn
    _ (BodyStmt XBodyStmt GhcRn GhcRn (LHsExpr GhcRn)
    _ LHsExpr GhcRn
    guard SyntaxExpr GhcRn
    _ SyntaxExpr GhcRn
    _) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do  { LHsExpr GhcTc
    guard' <- Mult -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    Many (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    guard Mult
    boolTy
              -- Scale the guard to Many (see #19120 and #19193)
            ; thing
    thing  <- ExpRhoType -> TcM thing
    thing_inside ExpRhoType
    res_ty
            ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XBodyStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LHsExpr GhcTc
    -> SyntaxExpr GhcTc
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt Mult
    XBodyStmt GhcTc GhcTc (LHsExpr GhcTc)
    boolTy LHsExpr GhcTc
    guard' SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr, thing
    thing) }

    tcGuardStmt HsStmtContext GhcRn
    ctxt (BindStmt XBindStmt GhcRn GhcRn (LHsExpr GhcRn)
    _ LPat GhcRn
    pat LHsExpr GhcRn
    rhs) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do  { -- The Many on the next line and the unrestricted on the line after
              -- are linked. These must be the same multiplicity. Consider
              --   x <- rhs -> u
              --
              -- The multiplicity of x in u must be the same as the multiplicity at
              -- which the rhs has been consumed. When solving #18738, we want these
              -- two multiplicity to still be the same.
              (LHsExpr GhcTc
    rhs', Mult
    rhs_ty) <- Mult -> TcM (LHsExpr GhcTc, Mult) -> TcM (LHsExpr GhcTc, Mult)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    Many (TcM (LHsExpr GhcTc, Mult) -> TcM (LHsExpr GhcTc, Mult))
    -> TcM (LHsExpr GhcTc, Mult) -> TcM (LHsExpr GhcTc, Mult)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcM (LHsExpr GhcTc, Mult)
    tcInferRhoNC LHsExpr GhcRn
    rhs
                                       -- Stmt has a context already
            ; (Located (Pat GhcTc)
    pat', thing
    thing)  <- HsMatchContext GhcRn
    -> CtOrigin
    -> LPat GhcRn
    -> Scaled Mult
    -> TcM thing
    -> TcM (LPat GhcTc, thing)
    forall a.
    HsMatchContext GhcRn
    -> CtOrigin
    -> LPat GhcRn
    -> Scaled Mult
    -> TcM a
    -> TcM (LPat GhcTc, a)
    tcCheckPat_O (HsStmtContext GhcRn -> HsMatchContext GhcRn
    forall p. HsStmtContext p -> HsMatchContext p
    StmtCtxt HsStmtContext GhcRn
    ctxt) (LHsExpr GhcRn -> CtOrigin
    lexprCtOrigin LHsExpr GhcRn
    rhs)
                                             LPat GhcRn
    pat (Mult -> Scaled Mult
    forall a. a -> Scaled a
    unrestricted Mult
    rhs_ty) (TcM thing -> TcM (LPat GhcTc, thing))
    -> TcM thing -> TcM (LPat GhcTc, thing)
    forall a b. (a -> b) -> a -> b
    $
                                ExpRhoType -> TcM thing
    thing_inside ExpRhoType
    res_ty
            ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LPat GhcTc -> LHsExpr GhcTc -> Stmt GhcTc (LHsExpr GhcTc)
    forall (bodyR :: * -> *).
    LPat GhcTc
    -> Located (bodyR GhcTc)
    -> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))
    mkTcBindStmt Located (Pat GhcTc)
    LPat GhcTc
    pat' LHsExpr GhcTc
    rhs', thing
    thing) }

    tcGuardStmt HsStmtContext GhcRn
    _ Stmt GhcRn (LHsExpr GhcRn)
    stmt ExpRhoType
    _ ExpRhoType -> TcM thing
    _
      = String -> SDoc -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcGuardStmt: unexpected Stmt" (Stmt GhcRn (LHsExpr GhcRn) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Stmt GhcRn (LHsExpr GhcRn)
    stmt)

    ---------------------------------------------------
    --           List comprehensions
    --               (no rebindable syntax)
    ---------------------------------------------------

    -- Dealt with separately, rather than by tcMcStmt, because
    --   a) We have special desugaring rules for list comprehensions,
    --      which avoid creating intermediate lists.  They in turn
    --      assume that the bind/return operations are the regular
    --      polymorphic ones, and in particular don't have any
    --      coercion matching stuff in them.  It's hard to avoid the
    --      potential for non-trivial coercions in tcMcStmt

    tcLcStmt :: TyCon       -- The list type constructor ([])
             -> TcExprStmtChecker

    tcLcStmt :: TyCon -> TcStmtChecker HsExpr ExpRhoType
    tcLcStmt TyCon
    _ HsStmtContext GhcRn
    _ (LastStmt XLastStmt GhcRn GhcRn (LHsExpr GhcRn)
    x LHsExpr GhcRn
    body Maybe Bool
    noret SyntaxExpr GhcRn
    _) ExpRhoType
    elt_ty ExpRhoType -> TcM thing
    thing_inside
      = do { LHsExpr GhcTc
    body' <- LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC LHsExpr GhcRn
    body ExpRhoType
    elt_ty
           ; thing
    thing <- ExpRhoType -> TcM thing
    thing_inside (String -> ExpRhoType
    forall a. String -> a
    panic String
    "tcLcStmt: thing_inside")
           ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XLastStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LHsExpr GhcTc
    -> Maybe Bool
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XLastStmt idL idR body
    -> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
    LastStmt XLastStmt GhcRn GhcRn (LHsExpr GhcRn)
    XLastStmt GhcTc GhcTc (LHsExpr GhcTc)
    x LHsExpr GhcTc
    body' Maybe Bool
    noret SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr, thing
    thing) }

    -- A generator, pat <- rhs
    tcLcStmt TyCon
    m_tc HsStmtContext GhcRn
    ctxt (BindStmt XBindStmt GhcRn GhcRn (LHsExpr GhcRn)
    _ LPat GhcRn
    pat LHsExpr GhcRn
    rhs) ExpRhoType
    elt_ty ExpRhoType -> TcM thing
    thing_inside
     = do   { Mult
    pat_ty <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    liftedTypeKind
            ; LHsExpr GhcTc
    rhs'   <- LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    rhs (TyCon -> [Mult] -> Mult
    mkTyConApp TyCon
    m_tc [Mult
    pat_ty])
            ; (Located (Pat GhcTc)
    pat', thing
    thing)  <- HsMatchContext GhcRn
    -> LPat GhcRn
    -> Scaled Mult
    -> TcM thing
    -> TcM (LPat GhcTc, thing)
    forall a.
    HsMatchContext GhcRn
    -> LPat GhcRn -> Scaled Mult -> TcM a -> TcM (LPat GhcTc, a)
    tcCheckPat (HsStmtContext GhcRn -> HsMatchContext GhcRn
    forall p. HsStmtContext p -> HsMatchContext p
    StmtCtxt HsStmtContext GhcRn
    ctxt) LPat GhcRn
    pat (Mult -> Scaled Mult
    forall a. a -> Scaled a
    unrestricted Mult
    pat_ty) (TcM thing -> TcM (LPat GhcTc, thing))
    -> TcM thing -> TcM (LPat GhcTc, thing)
    forall a b. (a -> b) -> a -> b
    $
                                ExpRhoType -> TcM thing
    thing_inside ExpRhoType
    elt_ty
            ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LPat GhcTc -> LHsExpr GhcTc -> Stmt GhcTc (LHsExpr GhcTc)
    forall (bodyR :: * -> *).
    LPat GhcTc
    -> Located (bodyR GhcTc)
    -> StmtLR GhcTc GhcTc (Located (bodyR GhcTc))
    mkTcBindStmt Located (Pat GhcTc)
    LPat GhcTc
    pat' LHsExpr GhcTc
    rhs', thing
    thing) }

    -- A boolean guard
    tcLcStmt TyCon
    _ HsStmtContext GhcRn
    _ (BodyStmt XBodyStmt GhcRn GhcRn (LHsExpr GhcRn)
    _ LHsExpr GhcRn
    rhs SyntaxExpr GhcRn
    _ SyntaxExpr GhcRn
    _) ExpRhoType
    elt_ty ExpRhoType -> TcM thing
    thing_inside
      = do  { LHsExpr GhcTc
    rhs'  <- LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    rhs Mult
    boolTy
            ; thing
    thing <- ExpRhoType -> TcM thing
    thing_inside ExpRhoType
    elt_ty
            ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XBodyStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LHsExpr GhcTc
    -> SyntaxExpr GhcTc
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt Mult
    XBodyStmt GhcTc GhcTc (LHsExpr GhcTc)
    boolTy LHsExpr GhcTc
    rhs' SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr, thing
    thing) }

    -- ParStmt: See notes with tcMcStmt
    tcLcStmt TyCon
    m_tc HsStmtContext GhcRn
    ctxt (ParStmt XParStmt GhcRn GhcRn (LHsExpr GhcRn)
    _ [ParStmtBlock GhcRn GhcRn]
    bndr_stmts_s HsExpr GhcRn
    _ SyntaxExpr GhcRn
    _) ExpRhoType
    elt_ty ExpRhoType -> TcM thing
    thing_inside
      = do  { ([ParStmtBlock GhcTc GhcTc]
    pairs', thing
    thing) <- [ParStmtBlock GhcRn GhcRn]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([ParStmtBlock GhcTc GhcTc], thing)
    loop [ParStmtBlock GhcRn GhcRn]
    bndr_stmts_s
            ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XParStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> [ParStmtBlock GhcTc GhcTc]
    -> HsExpr GhcTc
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XParStmt idL idR body
    -> [ParStmtBlock idL idR]
    -> HsExpr idR
    -> SyntaxExpr idR
    -> StmtLR idL idR body
    ParStmt Mult
    XParStmt GhcTc GhcTc (LHsExpr GhcTc)
    unitTy [ParStmtBlock GhcTc GhcTc]
    pairs' HsExpr GhcTc
    forall (p :: Pass). HsExpr (GhcPass p)
    noExpr SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr, thing
    thing) }
      where
        -- loop :: [([LStmt GhcRn], [GhcRn])]
        --      -> TcM ([([LStmt GhcTc], [GhcTc])], thing)
        loop :: [ParStmtBlock GhcRn GhcRn]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([ParStmtBlock GhcTc GhcTc], thing)
    loop [] = do { thing
    thing <- ExpRhoType -> TcM thing
    thing_inside ExpRhoType
    elt_ty
                     ; ([ParStmtBlock GhcTc GhcTc], thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([ParStmtBlock GhcTc GhcTc], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], thing
    thing) }         -- matching in the branches

        loop (ParStmtBlock XParStmtBlock GhcRn GhcRn
    x [GuardLStmt GhcRn]
    stmts [IdP GhcRn]
    names SyntaxExpr GhcRn
    _ : [ParStmtBlock GhcRn GhcRn]
    pairs)
          = do { ([LStmt GhcTc (LHsExpr GhcTc)]
    stmts', ([Id]
    ids, [ParStmtBlock GhcTc GhcTc]
    pairs', thing
    thing))
                    <- HsStmtContext GhcRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [GuardLStmt GhcRn]
    -> ExpRhoType
    -> (ExpRhoType -> TcM ([Id], [ParStmtBlock GhcTc GhcTc], thing))
    -> TcM
         ([LStmt GhcTc (LHsExpr GhcTc)],
          ([Id], [ParStmtBlock GhcTc GhcTc], thing))
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext GhcRn
    ctxt (TyCon -> TcStmtChecker HsExpr ExpRhoType
    tcLcStmt TyCon
    m_tc) [GuardLStmt GhcRn]
    stmts ExpRhoType
    elt_ty ((ExpRhoType -> TcM ([Id], [ParStmtBlock GhcTc GhcTc], thing))
     -> TcM
          ([LStmt GhcTc (LHsExpr GhcTc)],
           ([Id], [ParStmtBlock GhcTc GhcTc], thing)))
    -> (ExpRhoType -> TcM ([Id], [ParStmtBlock GhcTc GhcTc], thing))
    -> TcM
         ([LStmt GhcTc (LHsExpr GhcTc)],
          ([Id], [ParStmtBlock GhcTc GhcTc], thing))
    forall a b. (a -> b) -> a -> b
    $ \ ExpRhoType
    _elt_ty' ->
                       do { [Id]
    ids <- [Name] -> TcM [Id]
    tcLookupLocalIds [Name]
    [IdP GhcRn]
    names
                          ; ([ParStmtBlock GhcTc GhcTc]
    pairs', thing
    thing) <- [ParStmtBlock GhcRn GhcRn]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([ParStmtBlock GhcTc GhcTc], thing)
    loop [ParStmtBlock GhcRn GhcRn]
    pairs
                          ; ([Id], [ParStmtBlock GhcTc GhcTc], thing)
    -> TcM ([Id], [ParStmtBlock GhcTc GhcTc], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id]
    ids, [ParStmtBlock GhcTc GhcTc]
    pairs', thing
    thing) }
               ; ([ParStmtBlock GhcTc GhcTc], thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([ParStmtBlock GhcTc GhcTc], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( XParStmtBlock GhcTc GhcTc
    -> [LStmt GhcTc (LHsExpr GhcTc)]
    -> [IdP GhcTc]
    -> SyntaxExpr GhcTc
    -> ParStmtBlock GhcTc GhcTc
    forall idL idR.
    XParStmtBlock idL idR
    -> [ExprLStmt idL]
    -> [IdP idR]
    -> SyntaxExpr idR
    -> ParStmtBlock idL idR
    ParStmtBlock XParStmtBlock GhcRn GhcRn
    XParStmtBlock GhcTc GhcTc
    x [LStmt GhcTc (LHsExpr GhcTc)]
    stmts' [Id]
    [IdP GhcTc]
    ids SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr ParStmtBlock GhcTc GhcTc
    -> [ParStmtBlock GhcTc GhcTc] -> [ParStmtBlock GhcTc GhcTc]
    forall a. a -> [a] -> [a]
    : [ParStmtBlock GhcTc GhcTc]
    pairs', thing
    thing ) }

    tcLcStmt TyCon
    m_tc HsStmtContext GhcRn
    ctxt (TransStmt { trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
    trS_form = TransForm
    form, trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
    trS_stmts = [GuardLStmt GhcRn]
    stmts
                                  , trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
    trS_bndrs =  [(IdP GhcRn, IdP GhcRn)]
    bindersMap
                                  , trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
    trS_by = Maybe (LHsExpr GhcRn)
    by, trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
    trS_using = LHsExpr GhcRn
    using }) ExpRhoType
    elt_ty ExpRhoType -> TcM thing
    thing_inside
      = do { let ([Name]
    bndr_names, [Name]
    n_bndr_names) = [(Name, Name)] -> ([Name], [Name])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(Name, Name)]
    [(IdP GhcRn, IdP GhcRn)]
    bindersMap
                 unused_ty :: ExpRhoType
    unused_ty = String -> SDoc -> ExpRhoType
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcLcStmt: inner ty" ([(Name, Name)] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [(Name, Name)]
    [(IdP GhcRn, IdP GhcRn)]
    bindersMap)
                 -- The inner 'stmts' lack a LastStmt, so the element type
                 --  passed in to tcStmtsAndThen is never looked at
           ; ([LStmt GhcTc (LHsExpr GhcTc)]
    stmts', ([Id]
    bndr_ids, Maybe (LHsExpr GhcTc, Mult)
    by'))
                <- HsStmtContext GhcRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [GuardLStmt GhcRn]
    -> ExpRhoType
    -> (ExpRhoType -> TcM ([Id], Maybe (LHsExpr GhcTc, Mult)))
    -> TcM
         ([LStmt GhcTc (LHsExpr GhcTc)],
          ([Id], Maybe (LHsExpr GhcTc, Mult)))
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen (HsStmtContext GhcRn -> HsStmtContext GhcRn
    forall p. HsStmtContext p -> HsStmtContext p
    TransStmtCtxt HsStmtContext GhcRn
    ctxt) (TyCon -> TcStmtChecker HsExpr ExpRhoType
    tcLcStmt TyCon
    m_tc) [GuardLStmt GhcRn]
    stmts ExpRhoType
    unused_ty ((ExpRhoType -> TcM ([Id], Maybe (LHsExpr GhcTc, Mult)))
     -> TcM
          ([LStmt GhcTc (LHsExpr GhcTc)],
           ([Id], Maybe (LHsExpr GhcTc, Mult))))
    -> (ExpRhoType -> TcM ([Id], Maybe (LHsExpr GhcTc, Mult)))
    -> TcM
         ([LStmt GhcTc (LHsExpr GhcTc)],
          ([Id], Maybe (LHsExpr GhcTc, Mult)))
    forall a b. (a -> b) -> a -> b
    $ \ExpRhoType
    _ -> do
                   { Maybe (LHsExpr GhcTc, Mult)
    by' <- (LHsExpr GhcRn -> TcM (LHsExpr GhcTc, Mult))
    -> Maybe (LHsExpr GhcRn)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (LHsExpr GhcTc, Mult))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse LHsExpr GhcRn -> TcM (LHsExpr GhcTc, Mult)
    tcInferRho Maybe (LHsExpr GhcRn)
    by
                   ; [Id]
    bndr_ids <- [Name] -> TcM [Id]
    tcLookupLocalIds [Name]
    bndr_names
                   ; ([Id], Maybe (LHsExpr GhcTc, Mult))
    -> TcM ([Id], Maybe (LHsExpr GhcTc, Mult))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id]
    bndr_ids, Maybe (LHsExpr GhcTc, Mult)
    by') }

           ; let m_app :: Mult -> Mult
    m_app Mult
    ty = TyCon -> [Mult] -> Mult
    mkTyConApp TyCon
    m_tc [Mult
    ty]

           --------------- Typecheck the 'using' function -------------
           -- using :: ((a,b,c)->t) -> m (a,b,c) -> m (a,b,c)m      (ThenForm)
           --       :: ((a,b,c)->t) -> m (a,b,c) -> m (m (a,b,c)))  (GroupForm)

             -- n_app :: Type -> Type   -- Wraps a 'ty' into '[ty]' for GroupForm
           ; let n_app :: Mult -> Mult
    n_app = case TransForm
    form of
                           TransForm
    ThenForm -> (\Mult
    ty -> Mult
    ty)
                           TransForm
    _        -> Mult -> Mult
    m_app

                 by_arrow :: Type -> Type     -- Wraps 'ty' to '(a->t) -> ty' if the By is present
                 by_arrow :: Mult -> Mult
    by_arrow = case Maybe (LHsExpr GhcTc, Mult)
    by' of
                              Maybe (LHsExpr GhcTc, Mult)
    Nothing       -> \Mult
    ty -> Mult
    ty
                              Just (LHsExpr GhcTc
    _,Mult
    e_ty) -> \Mult
    ty -> (Mult
    alphaTy Mult -> Mult -> Mult
    `mkVisFunTyMany` Mult
    e_ty) Mult -> Mult -> Mult
    `mkVisFunTyMany` Mult
    ty

                 tup_ty :: Mult
    tup_ty        = [Id] -> Mult
    mkBigCoreVarTupTy [Id]
    bndr_ids
                 poly_arg_ty :: Mult
    poly_arg_ty   = Mult -> Mult
    m_app Mult
    alphaTy
                 poly_res_ty :: Mult
    poly_res_ty   = Mult -> Mult
    m_app (Mult -> Mult
    n_app Mult
    alphaTy)
                 using_poly_ty :: Mult
    using_poly_ty = Id -> Mult -> Mult
    mkInfForAllTy Id
    alphaTyVar (Mult -> Mult) -> Mult -> Mult
    forall a b. (a -> b) -> a -> b
    $
                                 Mult -> Mult
    by_arrow (Mult -> Mult) -> Mult -> Mult
    forall a b. (a -> b) -> a -> b
    $
                                 Mult
    poly_arg_ty Mult -> Mult -> Mult
    `mkVisFunTyMany` Mult
    poly_res_ty

           ; LHsExpr GhcTc
    using' <- LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    using Mult
    using_poly_ty
           ; let final_using :: LHsExpr GhcTc
    final_using = (HsExpr GhcTc -> HsExpr GhcTc) -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap (Mult -> HsWrapper
    WpTyApp Mult
    tup_ty)) LHsExpr GhcTc
    using'

                 -- 'stmts' returns a result of type (m1_ty tuple_ty),
                 -- typically something like [(Int,Bool,Int)]
                 -- We don't know what tuple_ty is yet, so we use a variable
           ; let mk_n_bndr :: Name -> TcId -> TcId
                 mk_n_bndr :: Name -> Id -> Id
    mk_n_bndr Name
    n_bndr_name Id
    bndr_id = HasDebugCallStack => Name -> Mult -> Mult -> Id
    Name -> Mult -> Mult -> Id
    mkLocalId Name
    n_bndr_name Mult
    Many (Mult -> Mult
    n_app (Id -> Mult
    idType Id
    bndr_id))

                 -- Ensure that every old binder of type `b` is linked up with its
                 -- new binder which should have type `n b`
                 -- See Note [GroupStmt binder map] in GHC.Hs.Expr
                 n_bndr_ids :: [Id]
    n_bndr_ids  = (Name -> Id -> Id) -> [Name] -> [Id] -> [Id]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Name -> Id -> Id
    mk_n_bndr [Name]
    n_bndr_names [Id]
    bndr_ids
                 bindersMap' :: [(Id, Id)]
    bindersMap' = [Id]
    bndr_ids [Id] -> [Id] -> [(Id, Id)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Id]
    n_bndr_ids

           -- Type check the thing in the environment with
           -- these new binders and return the result
           ; thing
    thing <- [Id] -> TcM thing -> TcM thing
    forall a. [Id] -> TcM a -> TcM a
    tcExtendIdEnv [Id]
    n_bndr_ids (ExpRhoType -> TcM thing
    thing_inside ExpRhoType
    elt_ty)

           ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TransStmt :: forall idL idR body.
    XTransStmt idL idR body
    -> TransForm
    -> [ExprLStmt idL]
    -> [(IdP idR, IdP idR)]
    -> LHsExpr idR
    -> Maybe (LHsExpr idR)
    -> SyntaxExpr idR
    -> SyntaxExpr idR
    -> HsExpr idR
    -> StmtLR idL idR body
    TransStmt { trS_stmts :: [LStmt GhcTc (LHsExpr GhcTc)]
    trS_stmts = [LStmt GhcTc (LHsExpr GhcTc)]
    stmts', trS_bndrs :: [(IdP GhcTc, IdP GhcTc)]
    trS_bndrs = [(Id, Id)]
    [(IdP GhcTc, IdP GhcTc)]
    bindersMap'
                               , trS_by :: Maybe (LHsExpr GhcTc)
    trS_by = ((LHsExpr GhcTc, Mult) -> LHsExpr GhcTc)
    -> Maybe (LHsExpr GhcTc, Mult) -> Maybe (LHsExpr GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (LHsExpr GhcTc, Mult) -> LHsExpr GhcTc
    forall a b. (a, b) -> a
    fst Maybe (LHsExpr GhcTc, Mult)
    by', trS_using :: LHsExpr GhcTc
    trS_using = LHsExpr GhcTc
    final_using
                               , trS_ret :: SyntaxExpr GhcTc
    trS_ret = SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr
                               , trS_bind :: SyntaxExpr GhcTc
    trS_bind = SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr
                               , trS_fmap :: HsExpr GhcTc
    trS_fmap = HsExpr GhcTc
    forall (p :: Pass). HsExpr (GhcPass p)
    noExpr
                               , trS_ext :: XTransStmt GhcTc GhcTc (LHsExpr GhcTc)
    trS_ext = Mult
    XTransStmt GhcTc GhcTc (LHsExpr GhcTc)
    unitTy
                               , trS_form :: TransForm
    trS_form = TransForm
    form }, thing
    thing) }

    tcLcStmt TyCon
    _ HsStmtContext GhcRn
    _ Stmt GhcRn (LHsExpr GhcRn)
    stmt ExpRhoType
    _ ExpRhoType -> TcM thing
    _
      = String -> SDoc -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcLcStmt: unexpected Stmt" (Stmt GhcRn (LHsExpr GhcRn) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Stmt GhcRn (LHsExpr GhcRn)
    stmt)

    ---------------------------------------------------
    --           Monad comprehensions
    --        (supports rebindable syntax)
    ---------------------------------------------------

    tcMcStmt :: TcExprStmtChecker

    tcMcStmt :: TcStmtChecker HsExpr ExpRhoType
    tcMcStmt HsStmtContext GhcRn
    _ (LastStmt XLastStmt GhcRn GhcRn (LHsExpr GhcRn)
    x LHsExpr GhcRn
    body Maybe Bool
    noret SyntaxExpr GhcRn
    return_op) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do  { (LHsExpr GhcTc
    body', SyntaxExprTc
    return_op')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc, SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    MCompOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    return_op [SyntaxOpType
    SynRho] ExpRhoType
    res_ty (([Mult] -> [Mult] -> TcM (LHsExpr GhcTc))
     -> TcM (LHsExpr GhcTc, SyntaxExprTc))
    -> ([Mult] -> [Mult] -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc, SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                   \ [Mult
    a_ty] [Mult
    mult]->
                   Mult -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExprNC LHsExpr GhcRn
    body Mult
    a_ty
            ; thing
    thing      <- ExpRhoType -> TcM thing
    thing_inside (String -> ExpRhoType
    forall a. String -> a
    panic String
    "tcMcStmt: thing_inside")
            ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XLastStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LHsExpr GhcTc
    -> Maybe Bool
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XLastStmt idL idR body
    -> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
    LastStmt XLastStmt GhcRn GhcRn (LHsExpr GhcRn)
    XLastStmt GhcTc GhcTc (LHsExpr GhcTc)
    x LHsExpr GhcTc
    body' Maybe Bool
    noret SyntaxExpr GhcTc
    SyntaxExprTc
    return_op', thing
    thing) }

    -- Generators for monad comprehensions ( pat <- rhs )
    --
    --   [ body | q <- gen ]  ->  gen :: m a
    --                            q   ::   a
    --

    tcMcStmt HsStmtContext GhcRn
    ctxt (BindStmt XBindStmt GhcRn GhcRn (LHsExpr GhcRn)
    xbsrn LPat GhcRn
    pat LHsExpr GhcRn
    rhs) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
               -- (>>=) :: rhs_ty -> (pat_ty -> new_res_ty) -> res_ty
      = do  { ((LHsExpr GhcTc
    rhs', Mult
    pat_mult, Located (Pat GhcTc)
    pat', thing
    thing, Mult
    new_res_ty), SyntaxExprTc
    bind_op')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult]
        -> [Mult]
        -> TcM (LHsExpr GhcTc, Mult, Located (Pat GhcTc), thing, Mult))
    -> TcM
         ((LHsExpr GhcTc, Mult, Located (Pat GhcTc), thing, Mult),
          SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    MCompOrigin (XBindStmtRn -> SyntaxExpr GhcRn
    xbsrn_bindOp XBindStmt GhcRn GhcRn (LHsExpr GhcRn)
    XBindStmtRn
    xbsrn)
                              [SyntaxOpType
    SynRho, SyntaxOpType -> SyntaxOpType -> SyntaxOpType
    SynFun SyntaxOpType
    SynAny SyntaxOpType
    SynRho] ExpRhoType
    res_ty (([Mult]
      -> [Mult]
      -> TcM (LHsExpr GhcTc, Mult, Located (Pat GhcTc), thing, Mult))
     -> TcM
          ((LHsExpr GhcTc, Mult, Located (Pat GhcTc), thing, Mult),
           SyntaxExprTc))
    -> ([Mult]
        -> [Mult]
        -> TcM (LHsExpr GhcTc, Mult, Located (Pat GhcTc), thing, Mult))
    -> TcM
         ((LHsExpr GhcTc, Mult, Located (Pat GhcTc), thing, Mult),
          SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                   \ [Mult
    rhs_ty, Mult
    pat_ty, Mult
    new_res_ty] [Mult
    rhs_mult, Mult
    fun_mult, Mult
    pat_mult] ->
                   do { LHsExpr GhcTc
    rhs' <- Mult -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    rhs_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExprNC LHsExpr GhcRn
    rhs Mult
    rhs_ty
                      ; (Located (Pat GhcTc)
    pat', thing
    thing) <- Mult
    -> TcM (Located (Pat GhcTc), thing)
    -> TcM (Located (Pat GhcTc), thing)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    fun_mult (TcM (Located (Pat GhcTc), thing)
     -> TcM (Located (Pat GhcTc), thing))
    -> TcM (Located (Pat GhcTc), thing)
    -> TcM (Located (Pat GhcTc), thing)
    forall a b. (a -> b) -> a -> b
    $ HsMatchContext GhcRn
    -> LPat GhcRn
    -> Scaled Mult
    -> TcM thing
    -> TcM (LPat GhcTc, thing)
    forall a.
    HsMatchContext GhcRn
    -> LPat GhcRn -> Scaled Mult -> TcM a -> TcM (LPat GhcTc, a)
    tcCheckPat (HsStmtContext GhcRn -> HsMatchContext GhcRn
    forall p. HsStmtContext p -> HsMatchContext p
    StmtCtxt HsStmtContext GhcRn
    ctxt) LPat GhcRn
    pat (Mult -> Mult -> Scaled Mult
    forall a. Mult -> a -> Scaled a
    Scaled Mult
    pat_mult Mult
    pat_ty) (TcM thing -> TcM (LPat GhcTc, thing))
    -> TcM thing -> TcM (LPat GhcTc, thing)
    forall a b. (a -> b) -> a -> b
    $
                                         ExpRhoType -> TcM thing
    thing_inside (Mult -> ExpRhoType
    mkCheckExpType Mult
    new_res_ty)
                      ; (LHsExpr GhcTc, Mult, Located (Pat GhcTc), thing, Mult)
    -> TcM (LHsExpr GhcTc, Mult, Located (Pat GhcTc), thing, Mult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsExpr GhcTc
    rhs', Mult
    pat_mult, Located (Pat GhcTc)
    pat', thing
    thing, Mult
    new_res_ty) }

            -- If (but only if) the pattern can fail, typecheck the 'fail' operator
            ; Maybe SyntaxExprTc
    fail_op' <- (Maybe (Maybe SyntaxExprTc) -> Maybe SyntaxExprTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Maybe SyntaxExprTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Maybe (Maybe SyntaxExprTc) -> Maybe SyntaxExprTc
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Maybe SyntaxExprTc))
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> ((SyntaxExprRn
         -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
        -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Maybe SyntaxExprTc)))
    -> (SyntaxExprRn
        -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe SyntaxExprRn
    -> (SyntaxExprRn
        -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Maybe SyntaxExprTc))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM (XBindStmtRn -> FailOperator GhcRn
    xbsrn_failOp XBindStmt GhcRn GhcRn (LHsExpr GhcRn)
    XBindStmtRn
    xbsrn) ((SyntaxExprRn
      -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> (SyntaxExprRn
        -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $ \SyntaxExprRn
    fail ->
                CtOrigin
    -> LPat GhcTc
    -> SyntaxExpr GhcRn
    -> Mult
    -> TcRn (FailOperator GhcTc)
    tcMonadFailOp (LPat GhcRn -> CtOrigin
    MCompPatOrigin LPat GhcRn
    pat) Located (Pat GhcTc)
    LPat GhcTc
    pat' SyntaxExpr GhcRn
    SyntaxExprRn
    fail Mult
    new_res_ty

            ; let xbstc :: XBindStmtTc
    xbstc = XBindStmtTc :: SyntaxExpr GhcTc
    -> Mult -> Mult -> FailOperator GhcTc -> XBindStmtTc
    XBindStmtTc
                    { xbstc_bindOp :: SyntaxExpr GhcTc
    xbstc_bindOp = SyntaxExpr GhcTc
    SyntaxExprTc
    bind_op'
                    , xbstc_boundResultType :: Mult
    xbstc_boundResultType = Mult
    new_res_ty
                    , xbstc_boundResultMult :: Mult
    xbstc_boundResultMult = Mult
    pat_mult
                    , xbstc_failOp :: FailOperator GhcTc
    xbstc_failOp = FailOperator GhcTc
    Maybe SyntaxExprTc
    fail_op'
                    }
            ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LPat GhcTc -> LHsExpr GhcTc -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
    BindStmt XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
    XBindStmtTc
    xbstc Located (Pat GhcTc)
    LPat GhcTc
    pat' LHsExpr GhcTc
    rhs', thing
    thing) }

    -- Boolean expressions.
    --
    --   [ body | stmts, expr ]  ->  expr :: m Bool
    --
    tcMcStmt HsStmtContext GhcRn
    _ (BodyStmt XBodyStmt GhcRn GhcRn (LHsExpr GhcRn)
    _ LHsExpr GhcRn
    rhs SyntaxExpr GhcRn
    then_op SyntaxExpr GhcRn
    guard_op) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do  { -- Deal with rebindable syntax:
              --    guard_op :: test_ty -> rhs_ty
              --    then_op  :: rhs_ty -> new_res_ty -> res_ty
              -- Where test_ty is, for example, Bool
            ; ((thing
    thing, LHsExpr GhcTc
    rhs', Mult
    rhs_ty, SyntaxExprTc
    guard_op'), SyntaxExprTc
    then_op')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult]
        -> [Mult] -> TcM (thing, LHsExpr GhcTc, Mult, SyntaxExprTc))
    -> TcM ((thing, LHsExpr GhcTc, Mult, SyntaxExprTc), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    MCompOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    then_op [SyntaxOpType
    SynRho, SyntaxOpType
    SynRho] ExpRhoType
    res_ty (([Mult]
      -> [Mult] -> TcM (thing, LHsExpr GhcTc, Mult, SyntaxExprTc))
     -> TcM ((thing, LHsExpr GhcTc, Mult, SyntaxExprTc), SyntaxExprTc))
    -> ([Mult]
        -> [Mult] -> TcM (thing, LHsExpr GhcTc, Mult, SyntaxExprTc))
    -> TcM ((thing, LHsExpr GhcTc, Mult, SyntaxExprTc), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                   \ [Mult
    rhs_ty, Mult
    new_res_ty] [Mult
    rhs_mult, Mult
    fun_mult] ->
                   do { (LHsExpr GhcTc
    rhs', SyntaxExprTc
    guard_op')
                          <- Mult
    -> TcM (LHsExpr GhcTc, SyntaxExprTc)
    -> TcM (LHsExpr GhcTc, SyntaxExprTc)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    rhs_mult (TcM (LHsExpr GhcTc, SyntaxExprTc)
     -> TcM (LHsExpr GhcTc, SyntaxExprTc))
    -> TcM (LHsExpr GhcTc, SyntaxExprTc)
    -> TcM (LHsExpr GhcTc, SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                             CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc, SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    MCompOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    guard_op [SyntaxOpType
    SynAny]
                                        (Mult -> ExpRhoType
    mkCheckExpType Mult
    rhs_ty) (([Mult] -> [Mult] -> TcM (LHsExpr GhcTc))
     -> TcM (LHsExpr GhcTc, SyntaxExprTc))
    -> ([Mult] -> [Mult] -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc, SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                             \ [Mult
    test_ty] [Mult
    test_mult] ->
                             Mult -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    test_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    rhs Mult
    test_ty
                      ; thing
    thing <- Mult -> TcM thing -> TcM thing
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    fun_mult (TcM thing -> TcM thing) -> TcM thing -> TcM thing
    forall a b. (a -> b) -> a -> b
    $ ExpRhoType -> TcM thing
    thing_inside (Mult -> ExpRhoType
    mkCheckExpType Mult
    new_res_ty)
                      ; (thing, LHsExpr GhcTc, Mult, SyntaxExprTc)
    -> TcM (thing, LHsExpr GhcTc, Mult, SyntaxExprTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (thing
    thing, LHsExpr GhcTc
    rhs', Mult
    rhs_ty, SyntaxExprTc
    guard_op') }
            ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XBodyStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LHsExpr GhcTc
    -> SyntaxExpr GhcTc
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt Mult
    XBodyStmt GhcTc GhcTc (LHsExpr GhcTc)
    rhs_ty LHsExpr GhcTc
    rhs' SyntaxExpr GhcTc
    SyntaxExprTc
    then_op' SyntaxExpr GhcTc
    SyntaxExprTc
    guard_op', thing
    thing) }

    -- Grouping statements
    --
    --   [ body | stmts, then group by e using f ]
    --     ->  e :: t
    --         f :: forall a. (a -> t) -> m a -> m (m a)
    --   [ body | stmts, then group using f ]
    --     ->  f :: forall a. m a -> m (m a)

    -- We type [ body | (stmts, group by e using f), ... ]
    --     f <optional by> [ (a,b,c) | stmts ] >>= \(a,b,c) -> ...body....
    --
    -- We type the functions as follows:
    --     f <optional by> :: m1 (a,b,c) -> m2 (a,b,c)              (ThenForm)
    --                     :: m1 (a,b,c) -> m2 (n (a,b,c))          (GroupForm)
    --     (>>=) :: m2 (a,b,c)     -> ((a,b,c)   -> res) -> res     (ThenForm)
    --           :: m2 (n (a,b,c)) -> (n (a,b,c) -> res) -> res     (GroupForm)
    --
    tcMcStmt HsStmtContext GhcRn
    ctxt (TransStmt { trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
    trS_stmts = [GuardLStmt GhcRn]
    stmts, trS_bndrs :: forall idL idR body. StmtLR idL idR body -> [(IdP idR, IdP idR)]
    trS_bndrs = [(IdP GhcRn, IdP GhcRn)]
    bindersMap
                             , trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
    trS_by = Maybe (LHsExpr GhcRn)
    by, trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
    trS_using = LHsExpr GhcRn
    using, trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
    trS_form = TransForm
    form
                             , trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    trS_ret = SyntaxExpr GhcRn
    return_op, trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    trS_bind = SyntaxExpr GhcRn
    bind_op
                             , trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
    trS_fmap = HsExpr GhcRn
    fmap_op }) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do { Mult
    m1_ty   <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    typeToTypeKind
           ; Mult
    m2_ty   <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    typeToTypeKind
           ; Mult
    tup_ty  <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    liftedTypeKind
           ; Mult
    by_e_ty <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    liftedTypeKind  -- The type of the 'by' expression (if any)

             -- n_app :: Type -> Type   -- Wraps a 'ty' into '(n ty)' for GroupForm
           ; Mult -> Mult
    n_app <- case TransForm
    form of
                        TransForm
    ThenForm -> (Mult -> Mult) -> IOEnv (Env TcGblEnv TcLclEnv) (Mult -> Mult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (\Mult
    ty -> Mult
    ty)
                        TransForm
    _        -> do { Mult
    n_ty <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    typeToTypeKind
                                       ; (Mult -> Mult) -> IOEnv (Env TcGblEnv TcLclEnv) (Mult -> Mult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Mult
    n_ty Mult -> Mult -> Mult
    `mkAppTy`) }
           ; let by_arrow :: Type -> Type
                 -- (by_arrow res) produces ((alpha->e_ty) -> res)     ('by' present)
                 --                          or res                    ('by' absent)
                 by_arrow :: Mult -> Mult
    by_arrow = case Maybe (LHsExpr GhcRn)
    by of
                              Maybe (LHsExpr GhcRn)
    Nothing -> \Mult
    res -> Mult
    res
                              Just {} -> \Mult
    res -> (Mult
    alphaTy Mult -> Mult -> Mult
    `mkVisFunTyMany` Mult
    by_e_ty) Mult -> Mult -> Mult
    `mkVisFunTyMany` Mult
    res

                 poly_arg_ty :: Mult
    poly_arg_ty  = Mult
    m1_ty Mult -> Mult -> Mult
    `mkAppTy` Mult
    alphaTy
                 using_arg_ty :: Mult
    using_arg_ty = Mult
    m1_ty Mult -> Mult -> Mult
    `mkAppTy` Mult
    tup_ty
                 poly_res_ty :: Mult
    poly_res_ty  = Mult
    m2_ty Mult -> Mult -> Mult
    `mkAppTy` Mult -> Mult
    n_app Mult
    alphaTy
                 using_res_ty :: Mult
    using_res_ty = Mult
    m2_ty Mult -> Mult -> Mult
    `mkAppTy` Mult -> Mult
    n_app Mult
    tup_ty
                 using_poly_ty :: Mult
    using_poly_ty = Id -> Mult -> Mult
    mkInfForAllTy Id
    alphaTyVar (Mult -> Mult) -> Mult -> Mult
    forall a b. (a -> b) -> a -> b
    $
                                 Mult -> Mult
    by_arrow (Mult -> Mult) -> Mult -> Mult
    forall a b. (a -> b) -> a -> b
    $
                                 Mult
    poly_arg_ty Mult -> Mult -> Mult
    `mkVisFunTyMany` Mult
    poly_res_ty

                 -- 'stmts' returns a result of type (m1_ty tuple_ty),
                 -- typically something like [(Int,Bool,Int)]
                 -- We don't know what tuple_ty is yet, so we use a variable
           ; let ([Name]
    bndr_names, [Name]
    n_bndr_names) = [(Name, Name)] -> ([Name], [Name])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(Name, Name)]
    [(IdP GhcRn, IdP GhcRn)]
    bindersMap
           ; ([LStmt GhcTc (LHsExpr GhcTc)]
    stmts', ([Id]
    bndr_ids, Maybe (LHsExpr GhcTc)
    by', SyntaxExprTc
    return_op')) <-
                HsStmtContext GhcRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [GuardLStmt GhcRn]
    -> ExpRhoType
    -> (ExpRhoType -> TcM ([Id], Maybe (LHsExpr GhcTc), SyntaxExprTc))
    -> TcM
         ([LStmt GhcTc (LHsExpr GhcTc)],
          ([Id], Maybe (LHsExpr GhcTc), SyntaxExprTc))
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen (HsStmtContext GhcRn -> HsStmtContext GhcRn
    forall p. HsStmtContext p -> HsStmtContext p
    TransStmtCtxt HsStmtContext GhcRn
    ctxt) TcStmtChecker HsExpr ExpRhoType
    tcMcStmt [GuardLStmt GhcRn]
    stmts
                               (Mult -> ExpRhoType
    mkCheckExpType Mult
    using_arg_ty) ((ExpRhoType -> TcM ([Id], Maybe (LHsExpr GhcTc), SyntaxExprTc))
     -> TcM
          ([LStmt GhcTc (LHsExpr GhcTc)],
           ([Id], Maybe (LHsExpr GhcTc), SyntaxExprTc)))
    -> (ExpRhoType -> TcM ([Id], Maybe (LHsExpr GhcTc), SyntaxExprTc))
    -> TcM
         ([LStmt GhcTc (LHsExpr GhcTc)],
          ([Id], Maybe (LHsExpr GhcTc), SyntaxExprTc))
    forall a b. (a -> b) -> a -> b
    $ \ExpRhoType
    res_ty' -> do
                    { Maybe (LHsExpr GhcTc)
    by' <- case Maybe (LHsExpr GhcRn)
    by of
                               Maybe (LHsExpr GhcRn)
    Nothing -> Maybe (LHsExpr GhcTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (LHsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (LHsExpr GhcTc)
    forall a. Maybe a
    Nothing
                               Just LHsExpr GhcRn
    e  -> do { LHsExpr GhcTc
    e' <- LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    e Mult
    by_e_ty
                                             ; Maybe (LHsExpr GhcTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (LHsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsExpr GhcTc -> Maybe (LHsExpr GhcTc)
    forall a. a -> Maybe a
    Just LHsExpr GhcTc
    e') }

                    -- Find the Ids (and hence types) of all old binders
                    ; [Id]
    bndr_ids <- [Name] -> TcM [Id]
    tcLookupLocalIds [Name]
    bndr_names

                    -- 'return' is only used for the binders, so we know its type.
                    --   return :: (a,b,c,..) -> m (a,b,c,..)
                    ; (()
    _, SyntaxExprTc
    return_op') <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcRn ())
    -> TcM ((), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    MCompOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    return_op
                                           [Mult -> SyntaxOpType
    synKnownType ([Id] -> Mult
    mkBigCoreVarTupTy [Id]
    bndr_ids)]
                                           ExpRhoType
    res_ty' (([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc))
    -> ([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $ \ [Mult]
    _ [Mult]
    _ -> () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

                    ; ([Id], Maybe (LHsExpr GhcTc), SyntaxExprTc)
    -> TcM ([Id], Maybe (LHsExpr GhcTc), SyntaxExprTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id]
    bndr_ids, Maybe (LHsExpr GhcTc)
    by', SyntaxExprTc
    return_op') }

           --------------- Typecheck the 'bind' function -------------
           -- (>>=) :: m2 (n (a,b,c)) -> ( n (a,b,c) -> new_res_ty ) -> res_ty
           ; Mult
    new_res_ty <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    liftedTypeKind
           ; (()
    _, SyntaxExprTc
    bind_op')  <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcRn ())
    -> TcM ((), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    MCompOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    bind_op
                                 [ Mult -> SyntaxOpType
    synKnownType Mult
    using_res_ty
                                 , Mult -> SyntaxOpType
    synKnownType (Mult -> Mult
    n_app Mult
    tup_ty Mult -> Mult -> Mult
    `mkVisFunTyMany` Mult
    new_res_ty) ]
                                 ExpRhoType
    res_ty (([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc))
    -> ([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $ \ [Mult]
    _ [Mult]
    _ -> () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

           --------------- Typecheck the 'fmap' function -------------
           ; HsExpr GhcTc
    fmap_op' <- case TransForm
    form of
                           TransForm
    ThenForm -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    forall (p :: Pass). HsExpr (GhcPass p)
    noExpr
                           TransForm
    _ -> (LHsExpr GhcTc -> HsExpr GhcTc)
    -> TcM (LHsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap LHsExpr GhcTc -> HsExpr GhcTc
    forall l e. GenLocated l e -> e
    unLoc (TcM (LHsExpr GhcTc) -> TcM (HsExpr GhcTc))
    -> (Mult -> TcM (LHsExpr GhcTc)) -> Mult -> TcM (HsExpr GhcTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr (HsExpr GhcRn -> LHsExpr GhcRn
    forall e. e -> Located e
    noLoc HsExpr GhcRn
    fmap_op) (Mult -> TcM (HsExpr GhcTc)) -> Mult -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                                Id -> Mult -> Mult
    mkInfForAllTy Id
    alphaTyVar (Mult -> Mult) -> Mult -> Mult
    forall a b. (a -> b) -> a -> b
    $
                                Id -> Mult -> Mult
    mkInfForAllTy Id
    betaTyVar  (Mult -> Mult) -> Mult -> Mult
    forall a b. (a -> b) -> a -> b
    $
                                (Mult
    alphaTy Mult -> Mult -> Mult
    `mkVisFunTyMany` Mult
    betaTy)
                                Mult -> Mult -> Mult
    `mkVisFunTyMany` (Mult -> Mult
    n_app Mult
    alphaTy)
                                Mult -> Mult -> Mult
    `mkVisFunTyMany` (Mult -> Mult
    n_app Mult
    betaTy)

           --------------- Typecheck the 'using' function -------------
           -- using :: ((a,b,c)->t) -> m1 (a,b,c) -> m2 (n (a,b,c))

           ; LHsExpr GhcTc
    using' <- LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    using Mult
    using_poly_ty
           ; let final_using :: LHsExpr GhcTc
    final_using = (HsExpr GhcTc -> HsExpr GhcTc) -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap (Mult -> HsWrapper
    WpTyApp Mult
    tup_ty)) LHsExpr GhcTc
    using'

           --------------- Building the bindersMap ----------------
           ; let mk_n_bndr :: Name -> TcId -> TcId
                 mk_n_bndr :: Name -> Id -> Id
    mk_n_bndr Name
    n_bndr_name Id
    bndr_id = HasDebugCallStack => Name -> Mult -> Mult -> Id
    Name -> Mult -> Mult -> Id
    mkLocalId Name
    n_bndr_name Mult
    Many (Mult -> Mult
    n_app (Id -> Mult
    idType Id
    bndr_id))

                 -- Ensure that every old binder of type `b` is linked up with its
                 -- new binder which should have type `n b`
                 -- See Note [GroupStmt binder map] in GHC.Hs.Expr
                 n_bndr_ids :: [Id]
    n_bndr_ids = String -> (Name -> Id -> Id) -> [Name] -> [Id] -> [Id]
    forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithEqual String
    "tcMcStmt" Name -> Id -> Id
    mk_n_bndr [Name]
    n_bndr_names [Id]
    bndr_ids
                 bindersMap' :: [(Id, Id)]
    bindersMap' = [Id]
    bndr_ids [Id] -> [Id] -> [(Id, Id)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Id]
    n_bndr_ids

           -- Type check the thing in the environment with
           -- these new binders and return the result
           ; thing
    thing <- [Id] -> TcM thing -> TcM thing
    forall a. [Id] -> TcM a -> TcM a
    tcExtendIdEnv [Id]
    n_bndr_ids (TcM thing -> TcM thing) -> TcM thing -> TcM thing
    forall a b. (a -> b) -> a -> b
    $
                      ExpRhoType -> TcM thing
    thing_inside (Mult -> ExpRhoType
    mkCheckExpType Mult
    new_res_ty)

           ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TransStmt :: forall idL idR body.
    XTransStmt idL idR body
    -> TransForm
    -> [ExprLStmt idL]
    -> [(IdP idR, IdP idR)]
    -> LHsExpr idR
    -> Maybe (LHsExpr idR)
    -> SyntaxExpr idR
    -> SyntaxExpr idR
    -> HsExpr idR
    -> StmtLR idL idR body
    TransStmt { trS_stmts :: [LStmt GhcTc (LHsExpr GhcTc)]
    trS_stmts = [LStmt GhcTc (LHsExpr GhcTc)]
    stmts', trS_bndrs :: [(IdP GhcTc, IdP GhcTc)]
    trS_bndrs = [(Id, Id)]
    [(IdP GhcTc, IdP GhcTc)]
    bindersMap'
                               , trS_by :: Maybe (LHsExpr GhcTc)
    trS_by = Maybe (LHsExpr GhcTc)
    by', trS_using :: LHsExpr GhcTc
    trS_using = LHsExpr GhcTc
    final_using
                               , trS_ret :: SyntaxExpr GhcTc
    trS_ret = SyntaxExpr GhcTc
    SyntaxExprTc
    return_op', trS_bind :: SyntaxExpr GhcTc
    trS_bind = SyntaxExpr GhcTc
    SyntaxExprTc
    bind_op'
                               , trS_ext :: XTransStmt GhcTc GhcTc (LHsExpr GhcTc)
    trS_ext = Mult -> Mult
    n_app Mult
    tup_ty
                               , trS_fmap :: HsExpr GhcTc
    trS_fmap = HsExpr GhcTc
    fmap_op', trS_form :: TransForm
    trS_form = TransForm
    form }, thing
    thing) }

    -- A parallel set of comprehensions
    --      [ (g x, h x) | ... ; let g v = ...
    --                   | ... ; let h v = ... ]
    --
    -- It's possible that g,h are overloaded, so we need to feed the LIE from the
    -- (g x, h x) up through both lots of bindings (so we get the bindLocalMethods).
    -- Similarly if we had an existential pattern match:
    --
    --      data T = forall a. Show a => C a
    --
    --      [ (show x, show y) | ... ; C x <- ...
    --                         | ... ; C y <- ... ]
    --
    -- Then we need the LIE from (show x, show y) to be simplified against
    -- the bindings for x and y.
    --
    -- It's difficult to do this in parallel, so we rely on the renamer to
    -- ensure that g,h and x,y don't duplicate, and simply grow the environment.
    -- So the binders of the first parallel group will be in scope in the second
    -- group.  But that's fine; there's no shadowing to worry about.
    --
    -- Note: The `mzip` function will get typechecked via:
    --
    --   ParStmt [st1::t1, st2::t2, st3::t3]
    --
    --   mzip :: m st1
    --        -> (m st2 -> m st3 -> m (st2, st3))   -- recursive call
    --        -> m (st1, (st2, st3))
    --
    tcMcStmt HsStmtContext GhcRn
    ctxt (ParStmt XParStmt GhcRn GhcRn (LHsExpr GhcRn)
    _ [ParStmtBlock GhcRn GhcRn]
    bndr_stmts_s HsExpr GhcRn
    mzip_op SyntaxExpr GhcRn
    bind_op) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do { Mult
    m_ty   <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    typeToTypeKind

           ; let mzip_ty :: Mult
    mzip_ty  = [Id] -> Mult -> Mult
    mkInfForAllTys [Id
    alphaTyVar, Id
    betaTyVar] (Mult -> Mult) -> Mult -> Mult
    forall a b. (a -> b) -> a -> b
    $
                            (Mult
    m_ty Mult -> Mult -> Mult
    `mkAppTy` Mult
    alphaTy)
                            Mult -> Mult -> Mult
    `mkVisFunTyMany`
                            (Mult
    m_ty Mult -> Mult -> Mult
    `mkAppTy` Mult
    betaTy)
                            Mult -> Mult -> Mult
    `mkVisFunTyMany`
                            (Mult
    m_ty Mult -> Mult -> Mult
    `mkAppTy` [Mult] -> Mult
    mkBoxedTupleTy [Mult
    alphaTy, Mult
    betaTy])
           ; HsExpr GhcTc
    mzip_op' <- LHsExpr GhcTc -> HsExpr GhcTc
    forall l e. GenLocated l e -> e
    unLoc (LHsExpr GhcTc -> HsExpr GhcTc)
    -> TcM (LHsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr (HsExpr GhcRn -> LHsExpr GhcRn
    forall e. e -> Located e
    noLoc HsExpr GhcRn
    mzip_op) Mult
    mzip_ty

            -- type dummies since we don't know all binder types yet
           ; [[Mult]]
    id_tys_s <- (([Name] -> IOEnv (Env TcGblEnv TcLclEnv) [Mult])
    -> [[Name]] -> IOEnv (Env TcGblEnv TcLclEnv) [[Mult]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (([Name] -> IOEnv (Env TcGblEnv TcLclEnv) [Mult])
     -> [[Name]] -> IOEnv (Env TcGblEnv TcLclEnv) [[Mult]])
    -> ((Name -> TcM Mult)
        -> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [Mult])
    -> (Name -> TcM Mult)
    -> [[Name]]
    -> IOEnv (Env TcGblEnv TcLclEnv) [[Mult]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Name -> TcM Mult)
    -> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [Mult]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM) (TcM Mult -> Name -> TcM Mult
    forall a b. a -> b -> a
    const (Mult -> TcM Mult
    newFlexiTyVarTy Mult
    liftedTypeKind))
                           [ [Name]
    [IdP GhcRn]
    names | ParStmtBlock XParStmtBlock GhcRn GhcRn
    _ [GuardLStmt GhcRn]
    _ [IdP GhcRn]
    names SyntaxExpr GhcRn
    _ <- [ParStmtBlock GhcRn GhcRn]
    bndr_stmts_s ]

           -- Typecheck bind:
           ; let tup_tys :: [Mult]
    tup_tys  = [ [Mult] -> Mult
    mkBigCoreTupTy [Mult]
    id_tys | [Mult]
    id_tys <- [[Mult]]
    id_tys_s ]
                 tuple_ty :: Mult
    tuple_ty = [Mult] -> Mult
    forall {t :: * -> *}. Foldable t => t Mult -> Mult
    mk_tuple_ty [Mult]
    tup_tys

           ; ((([ParStmtBlock GhcTc GhcTc]
    blocks', thing
    thing), Mult
    inner_res_ty), SyntaxExprTc
    bind_op')
               <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult]
        -> [Mult] -> TcM (([ParStmtBlock GhcTc GhcTc], thing), Mult))
    -> TcM ((([ParStmtBlock GhcTc GhcTc], thing), Mult), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    MCompOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    bind_op
                             [ Mult -> SyntaxOpType
    synKnownType (Mult
    m_ty Mult -> Mult -> Mult
    `mkAppTy` Mult
    tuple_ty)
                             , SyntaxOpType -> SyntaxOpType -> SyntaxOpType
    SynFun (Mult -> SyntaxOpType
    synKnownType Mult
    tuple_ty) SyntaxOpType
    SynRho ] ExpRhoType
    res_ty (([Mult]
      -> [Mult] -> TcM (([ParStmtBlock GhcTc GhcTc], thing), Mult))
     -> TcM ((([ParStmtBlock GhcTc GhcTc], thing), Mult), SyntaxExprTc))
    -> ([Mult]
        -> [Mult] -> TcM (([ParStmtBlock GhcTc GhcTc], thing), Mult))
    -> TcM ((([ParStmtBlock GhcTc GhcTc], thing), Mult), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                  \ [Mult
    inner_res_ty] [Mult]
    _ ->
                  do { ([ParStmtBlock GhcTc GhcTc], thing)
    stuff <- Mult
    -> ExpRhoType
    -> [Mult]
    -> [ParStmtBlock GhcRn GhcRn]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([ParStmtBlock GhcTc GhcTc], thing)
    loop Mult
    m_ty (Mult -> ExpRhoType
    mkCheckExpType Mult
    inner_res_ty)
                                     [Mult]
    tup_tys [ParStmtBlock GhcRn GhcRn]
    bndr_stmts_s
                     ; (([ParStmtBlock GhcTc GhcTc], thing), Mult)
    -> TcM (([ParStmtBlock GhcTc GhcTc], thing), Mult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([ParStmtBlock GhcTc GhcTc], thing)
    stuff, Mult
    inner_res_ty) }

           ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XParStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> [ParStmtBlock GhcTc GhcTc]
    -> HsExpr GhcTc
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XParStmt idL idR body
    -> [ParStmtBlock idL idR]
    -> HsExpr idR
    -> SyntaxExpr idR
    -> StmtLR idL idR body
    ParStmt Mult
    XParStmt GhcTc GhcTc (LHsExpr GhcTc)
    inner_res_ty [ParStmtBlock GhcTc GhcTc]
    blocks' HsExpr GhcTc
    mzip_op' SyntaxExpr GhcTc
    SyntaxExprTc
    bind_op', thing
    thing) }

      where
        mk_tuple_ty :: t Mult -> Mult
    mk_tuple_ty t Mult
    tys = (Mult -> Mult -> Mult) -> t Mult -> Mult
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 (\Mult
    tn Mult
    tm -> [Mult] -> Mult
    mkBoxedTupleTy [Mult
    tn, Mult
    tm]) t Mult
    tys

           -- loop :: Type                                  -- m_ty
           --      -> ExpRhoType                            -- inner_res_ty
           --      -> [TcType]                              -- tup_tys
           --      -> [ParStmtBlock Name]
           --      -> TcM ([([LStmt GhcTc], [TcId])], thing)
        loop :: Mult
    -> ExpRhoType
    -> [Mult]
    -> [ParStmtBlock GhcRn GhcRn]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([ParStmtBlock GhcTc GhcTc], thing)
    loop Mult
    _ ExpRhoType
    inner_res_ty [] [] = do { thing
    thing <- ExpRhoType -> TcM thing
    thing_inside ExpRhoType
    inner_res_ty
                                       ; ([ParStmtBlock GhcTc GhcTc], thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([ParStmtBlock GhcTc GhcTc], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], thing
    thing) }
                                       -- matching in the branches

        loop Mult
    m_ty ExpRhoType
    inner_res_ty (Mult
    tup_ty_in : [Mult]
    tup_tys_in)
                               (ParStmtBlock XParStmtBlock GhcRn GhcRn
    x [GuardLStmt GhcRn]
    stmts [IdP GhcRn]
    names SyntaxExpr GhcRn
    return_op : [ParStmtBlock GhcRn GhcRn]
    pairs)
          = do { let m_tup_ty :: Mult
    m_tup_ty = Mult
    m_ty Mult -> Mult -> Mult
    `mkAppTy` Mult
    tup_ty_in
               ; ([LStmt GhcTc (LHsExpr GhcTc)]
    stmts', ([Id]
    ids, SyntaxExprTc
    return_op', [ParStmtBlock GhcTc GhcTc]
    pairs', thing
    thing))
                    <- HsStmtContext GhcRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [GuardLStmt GhcRn]
    -> ExpRhoType
    -> (ExpRhoType
        -> TcM ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing))
    -> TcM
         ([LStmt GhcTc (LHsExpr GhcTc)],
          ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing))
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext GhcRn
    ctxt TcStmtChecker HsExpr ExpRhoType
    tcMcStmt [GuardLStmt GhcRn]
    stmts (Mult -> ExpRhoType
    mkCheckExpType Mult
    m_tup_ty) ((ExpRhoType
      -> TcM ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing))
     -> TcM
          ([LStmt GhcTc (LHsExpr GhcTc)],
           ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing)))
    -> (ExpRhoType
        -> TcM ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing))
    -> TcM
         ([LStmt GhcTc (LHsExpr GhcTc)],
          ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing))
    forall a b. (a -> b) -> a -> b
    $
                       \ExpRhoType
    m_tup_ty' ->
                       do { [Id]
    ids <- [Name] -> TcM [Id]
    tcLookupLocalIds [Name]
    [IdP GhcRn]
    names
                          ; let tup_ty :: Mult
    tup_ty = [Id] -> Mult
    mkBigCoreVarTupTy [Id]
    ids
                          ; (()
    _, SyntaxExprTc
    return_op') <-
                              CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcRn ())
    -> TcM ((), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    MCompOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    return_op
                                         [Mult -> SyntaxOpType
    synKnownType Mult
    tup_ty] ExpRhoType
    m_tup_ty' (([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc))
    -> ([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                                         \ [Mult]
    _ [Mult]
    _ -> () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                          ; ([ParStmtBlock GhcTc GhcTc]
    pairs', thing
    thing) <- Mult
    -> ExpRhoType
    -> [Mult]
    -> [ParStmtBlock GhcRn GhcRn]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([ParStmtBlock GhcTc GhcTc], thing)
    loop Mult
    m_ty ExpRhoType
    inner_res_ty [Mult]
    tup_tys_in [ParStmtBlock GhcRn GhcRn]
    pairs
                          ; ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing)
    -> TcM ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id]
    ids, SyntaxExprTc
    return_op', [ParStmtBlock GhcTc GhcTc]
    pairs', thing
    thing) }
               ; ([ParStmtBlock GhcTc GhcTc], thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([ParStmtBlock GhcTc GhcTc], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XParStmtBlock GhcTc GhcTc
    -> [LStmt GhcTc (LHsExpr GhcTc)]
    -> [IdP GhcTc]
    -> SyntaxExpr GhcTc
    -> ParStmtBlock GhcTc GhcTc
    forall idL idR.
    XParStmtBlock idL idR
    -> [ExprLStmt idL]
    -> [IdP idR]
    -> SyntaxExpr idR
    -> ParStmtBlock idL idR
    ParStmtBlock XParStmtBlock GhcRn GhcRn
    XParStmtBlock GhcTc GhcTc
    x [LStmt GhcTc (LHsExpr GhcTc)]
    stmts' [Id]
    [IdP GhcTc]
    ids SyntaxExpr GhcTc
    SyntaxExprTc
    return_op' ParStmtBlock GhcTc GhcTc
    -> [ParStmtBlock GhcTc GhcTc] -> [ParStmtBlock GhcTc GhcTc]
    forall a. a -> [a] -> [a]
    : [ParStmtBlock GhcTc GhcTc]
    pairs', thing
    thing) }
        loop Mult
    _ ExpRhoType
    _ [Mult]
    _ [ParStmtBlock GhcRn GhcRn]
    _ = String
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([ParStmtBlock GhcTc GhcTc], thing)
    forall a. String -> a
    panic String
    "tcMcStmt.loop"

    tcMcStmt HsStmtContext GhcRn
    _ Stmt GhcRn (LHsExpr GhcRn)
    stmt ExpRhoType
    _ ExpRhoType -> TcM thing
    _
      = String -> SDoc -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcMcStmt: unexpected Stmt" (Stmt GhcRn (LHsExpr GhcRn) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Stmt GhcRn (LHsExpr GhcRn)
    stmt)

    ---------------------------------------------------
    --           Do-notation
    --        (supports rebindable syntax)
    ---------------------------------------------------

    tcDoStmt :: TcExprStmtChecker

    tcDoStmt :: TcStmtChecker HsExpr ExpRhoType
    tcDoStmt HsStmtContext GhcRn
    _ (LastStmt XLastStmt GhcRn GhcRn (LHsExpr GhcRn)
    x LHsExpr GhcRn
    body Maybe Bool
    noret SyntaxExpr GhcRn
    _) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do { LHsExpr GhcTc
    body' <- LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC LHsExpr GhcRn
    body ExpRhoType
    res_ty
           ; thing
    thing <- ExpRhoType -> TcM thing
    thing_inside (String -> ExpRhoType
    forall a. String -> a
    panic String
    "tcDoStmt: thing_inside")
           ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XLastStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LHsExpr GhcTc
    -> Maybe Bool
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XLastStmt idL idR body
    -> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
    LastStmt XLastStmt GhcRn GhcRn (LHsExpr GhcRn)
    XLastStmt GhcTc GhcTc (LHsExpr GhcTc)
    x LHsExpr GhcTc
    body' Maybe Bool
    noret SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr, thing
    thing) }

    tcDoStmt HsStmtContext GhcRn
    ctxt (BindStmt XBindStmt GhcRn GhcRn (LHsExpr GhcRn)
    xbsrn LPat GhcRn
    pat LHsExpr GhcRn
    rhs) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do  {       -- Deal with rebindable syntax:
                    --       (>>=) :: rhs_ty ->_rhs_mult (pat_ty ->_pat_mult new_res_ty) ->_fun_mult res_ty
                    -- This level of generality is needed for using do-notation
                    -- in full generality; see #1537

              ((LHsExpr GhcTc
    rhs', Mult
    pat_mult, Located (Pat GhcTc)
    pat', Mult
    new_res_ty, thing
    thing), SyntaxExprTc
    bind_op')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult]
        -> [Mult]
        -> TcM (LHsExpr GhcTc, Mult, Located (Pat GhcTc), Mult, thing))
    -> TcM
         ((LHsExpr GhcTc, Mult, Located (Pat GhcTc), Mult, thing),
          SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    DoOrigin (XBindStmtRn -> SyntaxExpr GhcRn
    xbsrn_bindOp XBindStmt GhcRn GhcRn (LHsExpr GhcRn)
    XBindStmtRn
    xbsrn) [SyntaxOpType
    SynRho, SyntaxOpType -> SyntaxOpType -> SyntaxOpType
    SynFun SyntaxOpType
    SynAny SyntaxOpType
    SynRho] ExpRhoType
    res_ty (([Mult]
      -> [Mult]
      -> TcM (LHsExpr GhcTc, Mult, Located (Pat GhcTc), Mult, thing))
     -> TcM
          ((LHsExpr GhcTc, Mult, Located (Pat GhcTc), Mult, thing),
           SyntaxExprTc))
    -> ([Mult]
        -> [Mult]
        -> TcM (LHsExpr GhcTc, Mult, Located (Pat GhcTc), Mult, thing))
    -> TcM
         ((LHsExpr GhcTc, Mult, Located (Pat GhcTc), Mult, thing),
          SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                    \ [Mult
    rhs_ty, Mult
    pat_ty, Mult
    new_res_ty] [Mult
    rhs_mult,Mult
    fun_mult,Mult
    pat_mult] ->
                    do { LHsExpr GhcTc
    rhs' <-Mult -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    rhs_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExprNC LHsExpr GhcRn
    rhs Mult
    rhs_ty
                       ; (Located (Pat GhcTc)
    pat', thing
    thing) <- Mult
    -> TcM (Located (Pat GhcTc), thing)
    -> TcM (Located (Pat GhcTc), thing)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    fun_mult (TcM (Located (Pat GhcTc), thing)
     -> TcM (Located (Pat GhcTc), thing))
    -> TcM (Located (Pat GhcTc), thing)
    -> TcM (Located (Pat GhcTc), thing)
    forall a b. (a -> b) -> a -> b
    $ HsMatchContext GhcRn
    -> LPat GhcRn
    -> Scaled Mult
    -> TcM thing
    -> TcM (LPat GhcTc, thing)
    forall a.
    HsMatchContext GhcRn
    -> LPat GhcRn -> Scaled Mult -> TcM a -> TcM (LPat GhcTc, a)
    tcCheckPat (HsStmtContext GhcRn -> HsMatchContext GhcRn
    forall p. HsStmtContext p -> HsMatchContext p
    StmtCtxt HsStmtContext GhcRn
    ctxt) LPat GhcRn
    pat (Mult -> Mult -> Scaled Mult
    forall a. Mult -> a -> Scaled a
    Scaled Mult
    pat_mult Mult
    pat_ty) (TcM thing -> TcM (LPat GhcTc, thing))
    -> TcM thing -> TcM (LPat GhcTc, thing)
    forall a b. (a -> b) -> a -> b
    $
                                          ExpRhoType -> TcM thing
    thing_inside (Mult -> ExpRhoType
    mkCheckExpType Mult
    new_res_ty)
                       ; (LHsExpr GhcTc, Mult, Located (Pat GhcTc), Mult, thing)
    -> TcM (LHsExpr GhcTc, Mult, Located (Pat GhcTc), Mult, thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsExpr GhcTc
    rhs', Mult
    pat_mult, Located (Pat GhcTc)
    pat', Mult
    new_res_ty, thing
    thing) }

            -- If (but only if) the pattern can fail, typecheck the 'fail' operator
            ; Maybe SyntaxExprTc
    fail_op' <- (Maybe (Maybe SyntaxExprTc) -> Maybe SyntaxExprTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Maybe SyntaxExprTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Maybe (Maybe SyntaxExprTc) -> Maybe SyntaxExprTc
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Maybe SyntaxExprTc))
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> ((SyntaxExprRn
         -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
        -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Maybe SyntaxExprTc)))
    -> (SyntaxExprRn
        -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe SyntaxExprRn
    -> (SyntaxExprRn
        -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Maybe SyntaxExprTc))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM (XBindStmtRn -> FailOperator GhcRn
    xbsrn_failOp XBindStmt GhcRn GhcRn (LHsExpr GhcRn)
    XBindStmtRn
    xbsrn) ((SyntaxExprRn
      -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> (SyntaxExprRn
        -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $ \SyntaxExprRn
    fail ->
                CtOrigin
    -> LPat GhcTc
    -> SyntaxExpr GhcRn
    -> Mult
    -> TcRn (FailOperator GhcTc)
    tcMonadFailOp (LPat GhcRn -> CtOrigin
    DoPatOrigin LPat GhcRn
    pat) Located (Pat GhcTc)
    LPat GhcTc
    pat' SyntaxExpr GhcRn
    SyntaxExprRn
    fail Mult
    new_res_ty
            ; let xbstc :: XBindStmtTc
    xbstc = XBindStmtTc :: SyntaxExpr GhcTc
    -> Mult -> Mult -> FailOperator GhcTc -> XBindStmtTc
    XBindStmtTc
                    { xbstc_bindOp :: SyntaxExpr GhcTc
    xbstc_bindOp = SyntaxExpr GhcTc
    SyntaxExprTc
    bind_op'
                    , xbstc_boundResultType :: Mult
    xbstc_boundResultType = Mult
    new_res_ty
                    , xbstc_boundResultMult :: Mult
    xbstc_boundResultMult = Mult
    pat_mult
                    , xbstc_failOp :: FailOperator GhcTc
    xbstc_failOp = FailOperator GhcTc
    Maybe SyntaxExprTc
    fail_op'
                    }
            ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LPat GhcTc -> LHsExpr GhcTc -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
    BindStmt XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
    XBindStmtTc
    xbstc Located (Pat GhcTc)
    LPat GhcTc
    pat' LHsExpr GhcTc
    rhs', thing
    thing) }

    tcDoStmt HsStmtContext GhcRn
    ctxt (ApplicativeStmt XApplicativeStmt GhcRn GhcRn (LHsExpr GhcRn)
    _ [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    pairs FailOperator GhcRn
    mb_join) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do  { let tc_app_stmts :: ExpRhoType
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, thing)
    tc_app_stmts ExpRhoType
    ty = HsStmtContext GhcRn
    -> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    -> ExpRhoType
    -> (Mult -> TcM thing)
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, thing)
    forall t.
    HsStmtContext GhcRn
    -> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    -> ExpRhoType
    -> (Mult -> TcM t)
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, t)
    tcApplicativeStmts HsStmtContext GhcRn
    ctxt [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    pairs ExpRhoType
    ty ((Mult -> TcM thing)
     -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, thing))
    -> (Mult -> TcM thing)
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, thing)
    forall a b. (a -> b) -> a -> b
    $
                                    ExpRhoType -> TcM thing
    thing_inside (ExpRhoType -> TcM thing)
    -> (Mult -> ExpRhoType) -> Mult -> TcM thing
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Mult -> ExpRhoType
    mkCheckExpType
            ; (([(SyntaxExprTc, ApplicativeArg GhcTc)]
    pairs', Mult
    body_ty, thing
    thing), Maybe SyntaxExprTc
    mb_join') <- case FailOperator GhcRn
    mb_join of
                FailOperator GhcRn
    Nothing -> (, Maybe SyntaxExprTc
    forall a. Maybe a
    Nothing) (([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing)
     -> (([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing),
         Maybe SyntaxExprTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing),
          Maybe SyntaxExprTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ExpRhoType
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, thing)
    tc_app_stmts ExpRhoType
    res_ty
                Just SyntaxExpr GhcRn
    join_op ->
                  (SyntaxExprTc -> Maybe SyntaxExprTc)
    -> (([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing),
        SyntaxExprTc)
    -> (([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing),
        Maybe SyntaxExprTc)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second SyntaxExprTc -> Maybe SyntaxExprTc
    forall a. a -> Maybe a
    Just ((([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing),
      SyntaxExprTc)
     -> (([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing),
         Maybe SyntaxExprTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing),
          SyntaxExprTc)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing),
          Maybe SyntaxExprTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                  (CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult]
        -> [Mult]
        -> IOEnv
             (Env TcGblEnv TcLclEnv)
             ([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing),
          SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    DoOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    join_op [SyntaxOpType
    SynRho] ExpRhoType
    res_ty (([Mult]
      -> [Mult]
      -> IOEnv
           (Env TcGblEnv TcLclEnv)
           ([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing),
           SyntaxExprTc))
    -> ([Mult]
        -> [Mult]
        -> IOEnv
             (Env TcGblEnv TcLclEnv)
             ([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing),
          SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                   \ [Mult
    rhs_ty] [Mult
    rhs_mult] -> Mult
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    rhs_mult (IOEnv
       (Env TcGblEnv TcLclEnv)
       ([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          ([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, thing)
    forall a b. (a -> b) -> a -> b
    $ ExpRhoType
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, thing)
    tc_app_stmts (Mult -> ExpRhoType
    mkCheckExpType Mult
    rhs_ty))

            ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XApplicativeStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
    -> FailOperator GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XApplicativeStmt idL idR body
    -> [(SyntaxExpr idR, ApplicativeArg idL)]
    -> Maybe (SyntaxExpr idR)
    -> StmtLR idL idR body
    ApplicativeStmt Mult
    XApplicativeStmt GhcTc GhcTc (LHsExpr GhcTc)
    body_ty [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
    [(SyntaxExprTc, ApplicativeArg GhcTc)]
    pairs' FailOperator GhcTc
    Maybe SyntaxExprTc
    mb_join', thing
    thing) }

    tcDoStmt HsStmtContext GhcRn
    _ (BodyStmt XBodyStmt GhcRn GhcRn (LHsExpr GhcRn)
    _ LHsExpr GhcRn
    rhs SyntaxExpr GhcRn
    then_op SyntaxExpr GhcRn
    _) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do  {       -- Deal with rebindable syntax;
                    --   (>>) :: rhs_ty -> new_res_ty -> res_ty
            ; ((LHsExpr GhcTc
    rhs', Mult
    rhs_ty, thing
    thing), SyntaxExprTc
    then_op')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM (LHsExpr GhcTc, Mult, thing))
    -> TcM ((LHsExpr GhcTc, Mult, thing), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    DoOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    then_op [SyntaxOpType
    SynRho, SyntaxOpType
    SynRho] ExpRhoType
    res_ty (([Mult] -> [Mult] -> TcM (LHsExpr GhcTc, Mult, thing))
     -> TcM ((LHsExpr GhcTc, Mult, thing), SyntaxExprTc))
    -> ([Mult] -> [Mult] -> TcM (LHsExpr GhcTc, Mult, thing))
    -> TcM ((LHsExpr GhcTc, Mult, thing), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                   \ [Mult
    rhs_ty, Mult
    new_res_ty] [Mult
    rhs_mult,Mult
    fun_mult] ->
                   do { LHsExpr GhcTc
    rhs' <- Mult -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    rhs_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExprNC LHsExpr GhcRn
    rhs Mult
    rhs_ty
                      ; thing
    thing <- Mult -> TcM thing -> TcM thing
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    fun_mult (TcM thing -> TcM thing) -> TcM thing -> TcM thing
    forall a b. (a -> b) -> a -> b
    $ ExpRhoType -> TcM thing
    thing_inside (Mult -> ExpRhoType
    mkCheckExpType Mult
    new_res_ty)
                      ; (LHsExpr GhcTc, Mult, thing) -> TcM (LHsExpr GhcTc, Mult, thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsExpr GhcTc
    rhs', Mult
    rhs_ty, thing
    thing) }
            ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XBodyStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LHsExpr GhcTc
    -> SyntaxExpr GhcTc
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt Mult
    XBodyStmt GhcTc GhcTc (LHsExpr GhcTc)
    rhs_ty LHsExpr GhcTc
    rhs' SyntaxExpr GhcTc
    SyntaxExprTc
    then_op' SyntaxExpr GhcTc
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr, thing
    thing) }

    tcDoStmt HsStmtContext GhcRn
    ctxt (RecStmt { recS_stmts :: forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
    recS_stmts = [GuardLStmt GhcRn]
    stmts, recS_later_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
    recS_later_ids = [IdP GhcRn]
    later_names
                           , recS_rec_ids :: forall idL idR body. StmtLR idL idR body -> [IdP idR]
    recS_rec_ids = [IdP GhcRn]
    rec_names, recS_ret_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_ret_fn = SyntaxExpr GhcRn
    ret_op
                           , recS_mfix_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_mfix_fn = SyntaxExpr GhcRn
    mfix_op, recS_bind_fn :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_bind_fn = SyntaxExpr GhcRn
    bind_op })
             ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do  { let tup_names :: [Name]
    tup_names = [Name]
    [IdP GhcRn]
    rec_names [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ (Name -> Bool) -> [Name] -> [Name]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    [IdP GhcRn]
    rec_names) [Name]
    [IdP GhcRn]
    later_names
            ; [Mult]
    tup_elt_tys <- Arity -> Mult -> IOEnv (Env TcGblEnv TcLclEnv) [Mult]
    newFlexiTyVarTys ([Name] -> Arity
    forall (t :: * -> *) a. Foldable t => t a -> Arity
    length [Name]
    tup_names) Mult
    liftedTypeKind
            ; let tup_ids :: [Id]
    tup_ids = (Name -> Mult -> Id) -> [Name] -> [Mult] -> [Id]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Name
    n Mult
    t -> HasDebugCallStack => Name -> Mult -> Mult -> Id
    Name -> Mult -> Mult -> Id
    mkLocalId Name
    n Mult
    Many Mult
    t) [Name]
    tup_names [Mult]
    tup_elt_tys
                    -- Many because it's a recursive definition
                  tup_ty :: Mult
    tup_ty  = [Mult] -> Mult
    mkBigCoreTupTy [Mult]
    tup_elt_tys

            ; [Id]
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall a. [Id] -> TcM a -> TcM a
    tcExtendIdEnv [Id]
    tup_ids (TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
     -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing))
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall a b. (a -> b) -> a -> b
    $ do
            { (([LStmt GhcTc (LHsExpr GhcTc)]
    stmts', (SyntaxExprTc
    ret_op', [HsExpr GhcTc]
    tup_rets)), Mult
    stmts_ty)
                    <- (ExpRhoType
     -> TcM
          ([LStmt GhcTc (LHsExpr GhcTc)], (SyntaxExprTc, [HsExpr GhcTc])))
    -> TcM
         (([LStmt GhcTc (LHsExpr GhcTc)], (SyntaxExprTc, [HsExpr GhcTc])),
          Mult)
    forall a. (ExpRhoType -> TcM a) -> TcM (a, Mult)
    tcInfer ((ExpRhoType
      -> TcM
           ([LStmt GhcTc (LHsExpr GhcTc)], (SyntaxExprTc, [HsExpr GhcTc])))
     -> TcM
          (([LStmt GhcTc (LHsExpr GhcTc)], (SyntaxExprTc, [HsExpr GhcTc])),
           Mult))
    -> (ExpRhoType
        -> TcM
             ([LStmt GhcTc (LHsExpr GhcTc)], (SyntaxExprTc, [HsExpr GhcTc])))
    -> TcM
         (([LStmt GhcTc (LHsExpr GhcTc)], (SyntaxExprTc, [HsExpr GhcTc])),
          Mult)
    forall a b. (a -> b) -> a -> b
    $ \ ExpRhoType
    exp_ty ->
                       HsStmtContext GhcRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [GuardLStmt GhcRn]
    -> ExpRhoType
    -> (ExpRhoType -> TcM (SyntaxExprTc, [HsExpr GhcTc]))
    -> TcM
         ([LStmt GhcTc (LHsExpr GhcTc)], (SyntaxExprTc, [HsExpr GhcTc]))
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext GhcRn
    ctxt TcStmtChecker HsExpr ExpRhoType
    tcDoStmt [GuardLStmt GhcRn]
    stmts ExpRhoType
    exp_ty ((ExpRhoType -> TcM (SyntaxExprTc, [HsExpr GhcTc]))
     -> TcM
          ([LStmt GhcTc (LHsExpr GhcTc)], (SyntaxExprTc, [HsExpr GhcTc])))
    -> (ExpRhoType -> TcM (SyntaxExprTc, [HsExpr GhcTc]))
    -> TcM
         ([LStmt GhcTc (LHsExpr GhcTc)], (SyntaxExprTc, [HsExpr GhcTc]))
    forall a b. (a -> b) -> a -> b
    $ \ ExpRhoType
    inner_res_ty ->
                       do { [HsExpr GhcTc]
    tup_rets <- (Name -> ExpRhoType -> TcM (HsExpr GhcTc))
    -> [Name]
    -> [ExpRhoType]
    -> IOEnv (Env TcGblEnv TcLclEnv) [HsExpr GhcTc]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Name -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcCheckId [Name]
    tup_names
                                          ((Mult -> ExpRhoType) -> [Mult] -> [ExpRhoType]
    forall a b. (a -> b) -> [a] -> [b]
    map Mult -> ExpRhoType
    mkCheckExpType [Mult]
    tup_elt_tys)
                                 -- Unify the types of the "final" Ids (which may
                                 -- be polymorphic) with those of "knot-tied" Ids
                          ; (()
    _, SyntaxExprTc
    ret_op')
                              <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcRn ())
    -> TcM ((), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    DoOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    ret_op [Mult -> SyntaxOpType
    synKnownType Mult
    tup_ty]
                                            ExpRhoType
    inner_res_ty (([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc))
    -> ([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $ \[Mult]
    _ [Mult]
    _ -> () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                          ; (SyntaxExprTc, [HsExpr GhcTc])
    -> TcM (SyntaxExprTc, [HsExpr GhcTc])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SyntaxExprTc
    ret_op', [HsExpr GhcTc]
    tup_rets) }

            ; ((()
    _, SyntaxExprTc
    mfix_op'), Mult
    mfix_res_ty)
                <- (ExpRhoType -> TcM ((), SyntaxExprTc))
    -> TcM (((), SyntaxExprTc), Mult)
    forall a. (ExpRhoType -> TcM a) -> TcM (a, Mult)
    tcInfer ((ExpRhoType -> TcM ((), SyntaxExprTc))
     -> TcM (((), SyntaxExprTc), Mult))
    -> (ExpRhoType -> TcM ((), SyntaxExprTc))
    -> TcM (((), SyntaxExprTc), Mult)
    forall a b. (a -> b) -> a -> b
    $ \ ExpRhoType
    exp_ty ->
                   CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcRn ())
    -> TcM ((), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    DoOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    mfix_op
                              [Mult -> SyntaxOpType
    synKnownType (Mult -> Mult -> Mult
    mkVisFunTyMany Mult
    tup_ty Mult
    stmts_ty)] ExpRhoType
    exp_ty (([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc))
    -> ([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                   \ [Mult]
    _ [Mult]
    _ -> () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

            ; ((thing
    thing, Mult
    new_res_ty), SyntaxExprTc
    bind_op')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM (thing, Mult))
    -> TcM ((thing, Mult), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    DoOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    bind_op
                              [ Mult -> SyntaxOpType
    synKnownType Mult
    mfix_res_ty
                              , SyntaxOpType -> SyntaxOpType -> SyntaxOpType
    SynFun (Mult -> SyntaxOpType
    synKnownType Mult
    tup_ty) SyntaxOpType
    SynRho ]
                              ExpRhoType
    res_ty (([Mult] -> [Mult] -> TcM (thing, Mult))
     -> TcM ((thing, Mult), SyntaxExprTc))
    -> ([Mult] -> [Mult] -> TcM (thing, Mult))
    -> TcM ((thing, Mult), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                   \ [Mult
    new_res_ty] [Mult]
    _ ->
                   do { thing
    thing <- ExpRhoType -> TcM thing
    thing_inside (Mult -> ExpRhoType
    mkCheckExpType Mult
    new_res_ty)
                      ; (thing, Mult) -> TcM (thing, Mult)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (thing
    thing, Mult
    new_res_ty) }

            ; let rec_ids :: [Id]
    rec_ids = [Name] -> [Id] -> [Id]
    forall b a. [b] -> [a] -> [a]
    takeList [Name]
    [IdP GhcRn]
    rec_names [Id]
    tup_ids
            ; [Id]
    later_ids <- [Name] -> TcM [Id]
    tcLookupLocalIds [Name]
    [IdP GhcRn]
    later_names
            ; String -> SDoc -> TcRn ()
    traceTc String
    "tcdo" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat [[Id] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Id]
    rec_ids SDoc -> SDoc -> SDoc
    <+> [Mult] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((Id -> Mult) -> [Id] -> [Mult]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Mult
    idType [Id]
    rec_ids),
                                     [Id] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Id]
    later_ids SDoc -> SDoc -> SDoc
    <+> [Mult] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((Id -> Mult) -> [Id] -> [Mult]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Mult
    idType [Id]
    later_ids)]
            ; (Stmt GhcTc (LHsExpr GhcTc), thing)
    -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RecStmt :: forall idL idR body.
    XRecStmt idL idR body
    -> [LStmtLR idL idR body]
    -> [IdP idR]
    -> [IdP idR]
    -> SyntaxExpr idR
    -> SyntaxExpr idR
    -> SyntaxExpr idR
    -> StmtLR idL idR body
    RecStmt { recS_stmts :: [LStmt GhcTc (LHsExpr GhcTc)]
    recS_stmts = [LStmt GhcTc (LHsExpr GhcTc)]
    stmts', recS_later_ids :: [IdP GhcTc]
    recS_later_ids = [Id]
    [IdP GhcTc]
    later_ids
                              , recS_rec_ids :: [IdP GhcTc]
    recS_rec_ids = [Id]
    [IdP GhcTc]
    rec_ids, recS_ret_fn :: SyntaxExpr GhcTc
    recS_ret_fn = SyntaxExpr GhcTc
    SyntaxExprTc
    ret_op'
                              , recS_mfix_fn :: SyntaxExpr GhcTc
    recS_mfix_fn = SyntaxExpr GhcTc
    SyntaxExprTc
    mfix_op', recS_bind_fn :: SyntaxExpr GhcTc
    recS_bind_fn = SyntaxExpr GhcTc
    SyntaxExprTc
    bind_op'
                              , recS_ext :: XRecStmt GhcTc GhcTc (LHsExpr GhcTc)
    recS_ext = RecStmtTc :: Mult -> [HsExpr GhcTc] -> [HsExpr GhcTc] -> Mult -> RecStmtTc
    RecStmtTc
                                { recS_bind_ty :: Mult
    recS_bind_ty = Mult
    new_res_ty
                                , recS_later_rets :: [HsExpr GhcTc]
    recS_later_rets = []
                                , recS_rec_rets :: [HsExpr GhcTc]
    recS_rec_rets = [HsExpr GhcTc]
    tup_rets
                                , recS_ret_ty :: Mult
    recS_ret_ty = Mult
    stmts_ty} }, thing
    thing)
            }}

    tcDoStmt HsStmtContext GhcRn
    _ Stmt GhcRn (LHsExpr GhcRn)
    stmt ExpRhoType
    _ ExpRhoType -> TcM thing
    _
      = String -> SDoc -> TcM (Stmt GhcTc (LHsExpr GhcTc), thing)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcDoStmt: unexpected Stmt" (Stmt GhcRn (LHsExpr GhcRn) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Stmt GhcRn (LHsExpr GhcRn)
    stmt)

    ---------------------------------------------------
    -- MonadFail Proposal warnings
    ---------------------------------------------------

    -- The idea behind issuing MonadFail warnings is that we add them whenever a
    -- failable pattern is encountered. However, instead of throwing a type error
    -- when the constraint cannot be satisfied, we only issue a warning in
    -- "GHC.Tc.Errors".

    tcMonadFailOp :: CtOrigin
                  -> LPat GhcTc
                  -> SyntaxExpr GhcRn    -- The fail op
                  -> TcType              -- Type of the whole do-expression
                  -> TcRn (FailOperator GhcTc)  -- Typechecked fail op
    -- Get a 'fail' operator expression, to use if the pattern match fails.
    -- This won't be used in cases where we've already determined the pattern
    -- match can't fail (so the fail op is Nothing), however, it seems that the
    -- isIrrefutableHsPat test is still required here for some reason I haven't
    -- yet determined.
    tcMonadFailOp :: CtOrigin
    -> LPat GhcTc
    -> SyntaxExpr GhcRn
    -> Mult
    -> TcRn (FailOperator GhcTc)
    tcMonadFailOp CtOrigin
    orig LPat GhcTc
    pat SyntaxExpr GhcRn
    fail_op Mult
    res_ty = do
        DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        if DynFlags -> LPat GhcTc -> Bool
    forall (p :: Pass).
    OutputableBndrId p =>
    DynFlags -> LPat (GhcPass p) -> Bool
    isIrrefutableHsPat DynFlags
    dflags LPat GhcTc
    pat
          then Maybe SyntaxExprTc
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe SyntaxExprTc
    forall a. Maybe a
    Nothing
          else SyntaxExprTc -> Maybe SyntaxExprTc
    forall a. a -> Maybe a
    Just (SyntaxExprTc -> Maybe SyntaxExprTc)
    -> (((), SyntaxExprTc) -> SyntaxExprTc)
    -> ((), SyntaxExprTc)
    -> Maybe SyntaxExprTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((), SyntaxExprTc) -> SyntaxExprTc
    forall a b. (a, b) -> b
    snd (((), SyntaxExprTc) -> Maybe SyntaxExprTc)
    -> TcM ((), SyntaxExprTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcRn ())
    -> TcM ((), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    orig SyntaxExpr GhcRn
    SyntaxExprRn
    fail_op [Mult -> SyntaxOpType
    synKnownType Mult
    stringTy]
                                (Mult -> ExpRhoType
    mkCheckExpType Mult
    res_ty) (([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc))
    -> ([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $ \[Mult]
    _ [Mult]
    _ -> () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    {-
    Note [Treat rebindable syntax first]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When typechecking
            do { bar; ... } :: IO ()
    we want to typecheck 'bar' in the knowledge that it should be an IO thing,
    pushing info from the context into the RHS.  To do this, we check the
    rebindable syntax first, and push that information into (tcLExprNC rhs).
    Otherwise the error shows up when checking the rebindable syntax, and
    the expected/inferred stuff is back to front (see #3613).

    Note [typechecking ApplicativeStmt]

    join ((\pat1 ... patn -> body) <$> e1 <*> ... <*> en)

    fresh type variables:
       pat_ty_1..pat_ty_n
       exp_ty_1..exp_ty_n
       t_1..t_(n-1)

    body  :: body_ty
    (\pat1 ... patn -> body) :: pat_ty_1 -> ... -> pat_ty_n -> body_ty
    pat_i :: pat_ty_i
    e_i   :: exp_ty_i
    <$>   :: (pat_ty_1 -> ... -> pat_ty_n -> body_ty) -> exp_ty_1 -> t_1
    <*>_i :: t_(i-1) -> exp_ty_i -> t_i
    join :: tn -> res_ty
    -}

    tcApplicativeStmts
      :: HsStmtContext GhcRn
      -> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
      -> ExpRhoType                         -- rhs_ty
      -> (TcRhoType -> TcM t)               -- thing_inside
      -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Type, t)

    tcApplicativeStmts :: forall t.
    HsStmtContext GhcRn
    -> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    -> ExpRhoType
    -> (Mult -> TcM t)
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, t)
    tcApplicativeStmts HsStmtContext GhcRn
    ctxt [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    pairs ExpRhoType
    rhs_ty Mult -> TcM t
    thing_inside
     = do { Mult
    body_ty <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    liftedTypeKind
          ; let arity :: Arity
    arity = [(SyntaxExprRn, ApplicativeArg GhcRn)] -> Arity
    forall (t :: * -> *) a. Foldable t => t a -> Arity
    length [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    [(SyntaxExprRn, ApplicativeArg GhcRn)]
    pairs
          ; [ExpRhoType]
    ts <- Arity
    -> IOEnv (Env TcGblEnv TcLclEnv) ExpRhoType
    -> IOEnv (Env TcGblEnv TcLclEnv) [ExpRhoType]
    forall (m :: * -> *) a. Applicative m => Arity -> m a -> m [a]
    replicateM (Arity
    arityArity -> Arity -> Arity
    forall a. Num a => a -> a -> a
    -Arity
    1) (IOEnv (Env TcGblEnv TcLclEnv) ExpRhoType
     -> IOEnv (Env TcGblEnv TcLclEnv) [ExpRhoType])
    -> IOEnv (Env TcGblEnv TcLclEnv) ExpRhoType
    -> IOEnv (Env TcGblEnv TcLclEnv) [ExpRhoType]
    forall a b. (a -> b) -> a -> b
    $ IOEnv (Env TcGblEnv TcLclEnv) ExpRhoType
    newInferExpType
          ; [Mult]
    exp_tys <- Arity -> TcM Mult -> IOEnv (Env TcGblEnv TcLclEnv) [Mult]
    forall (m :: * -> *) a. Applicative m => Arity -> m a -> m [a]
    replicateM Arity
    arity (TcM Mult -> IOEnv (Env TcGblEnv TcLclEnv) [Mult])
    -> TcM Mult -> IOEnv (Env TcGblEnv TcLclEnv) [Mult]
    forall a b. (a -> b) -> a -> b
    $ Mult -> TcM Mult
    newFlexiTyVarTy Mult
    liftedTypeKind
          ; [Mult]
    pat_tys <- Arity -> TcM Mult -> IOEnv (Env TcGblEnv TcLclEnv) [Mult]
    forall (m :: * -> *) a. Applicative m => Arity -> m a -> m [a]
    replicateM Arity
    arity (TcM Mult -> IOEnv (Env TcGblEnv TcLclEnv) [Mult])
    -> TcM Mult -> IOEnv (Env TcGblEnv TcLclEnv) [Mult]
    forall a b. (a -> b) -> a -> b
    $ Mult -> TcM Mult
    newFlexiTyVarTy Mult
    liftedTypeKind
          ; let fun_ty :: Mult
    fun_ty = [Mult] -> Mult -> Mult
    mkVisFunTysMany [Mult]
    pat_tys Mult
    body_ty

           -- NB. do the <$>,<*> operators first, we don't want type errors here
           --     i.e. goOps before goArgs
           -- See Note [Treat rebindable syntax first]
          ; let ([SyntaxExprRn]
    ops, [ApplicativeArg GhcRn]
    args) = [(SyntaxExprRn, ApplicativeArg GhcRn)]
    -> ([SyntaxExprRn], [ApplicativeArg GhcRn])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    [(SyntaxExprRn, ApplicativeArg GhcRn)]
    pairs
          ; [SyntaxExprTc]
    ops' <- Mult
    -> [(SyntaxExprRn, ExpRhoType, Mult)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [SyntaxExprTc]
    goOps Mult
    fun_ty ([SyntaxExprRn]
    -> [ExpRhoType] -> [Mult] -> [(SyntaxExprRn, ExpRhoType, Mult)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [SyntaxExprRn]
    ops ([ExpRhoType]
    ts [ExpRhoType] -> [ExpRhoType] -> [ExpRhoType]
    forall a. [a] -> [a] -> [a]
    ++ [ExpRhoType
    rhs_ty]) [Mult]
    exp_tys)

          -- Typecheck each ApplicativeArg separately
          -- See Note [ApplicativeDo and constraints]
          ; [ApplicativeArg GhcTc]
    args' <- ((ApplicativeArg GhcRn, Mult, Mult)
     -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc))
    -> [(ApplicativeArg GhcRn, Mult, Mult)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [ApplicativeArg GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Mult
    -> (ApplicativeArg GhcRn, Mult, Mult)
    -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
    goArg Mult
    body_ty) ([ApplicativeArg GhcRn]
    -> [Mult] -> [Mult] -> [(ApplicativeArg GhcRn, Mult, Mult)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [ApplicativeArg GhcRn]
    args [Mult]
    pat_tys [Mult]
    exp_tys)

          -- Bring into scope all the things bound by the args,
          -- and typecheck the thing_inside
          -- See Note [ApplicativeDo and constraints]
          ; t
    res <- [Id] -> TcM t -> TcM t
    forall a. [Id] -> TcM a -> TcM a
    tcExtendIdEnv ((ApplicativeArg GhcTc -> [Id]) -> [ApplicativeArg GhcTc] -> [Id]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ApplicativeArg GhcTc -> [Id]
    get_arg_bndrs [ApplicativeArg GhcTc]
    args') (TcM t -> TcM t) -> TcM t -> TcM t
    forall a b. (a -> b) -> a -> b
    $
                   Mult -> TcM t
    thing_inside Mult
    body_ty

          ; ([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, t)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([(SyntaxExprTc, ApplicativeArg GhcTc)], Mult, t)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([SyntaxExprTc]
    -> [ApplicativeArg GhcTc] -> [(SyntaxExprTc, ApplicativeArg GhcTc)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [SyntaxExprTc]
    ops' [ApplicativeArg GhcTc]
    args', Mult
    body_ty, t
    res) }
      where
        goOps :: Mult
    -> [(SyntaxExprRn, ExpRhoType, Mult)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [SyntaxExprTc]
    goOps Mult
    _ [] = [SyntaxExprTc] -> IOEnv (Env TcGblEnv TcLclEnv) [SyntaxExprTc]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
        goOps Mult
    t_left ((SyntaxExprRn
    op,ExpRhoType
    t_i,Mult
    exp_ty) : [(SyntaxExprRn, ExpRhoType, Mult)]
    ops)
          = do { (()
    _, SyntaxExprTc
    op')
                   <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcRn ())
    -> TcM ((), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult] -> [Mult] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    DoOrigin SyntaxExprRn
    op
                                 [Mult -> SyntaxOpType
    synKnownType Mult
    t_left, Mult -> SyntaxOpType
    synKnownType Mult
    exp_ty] ExpRhoType
    t_i (([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc))
    -> ([Mult] -> [Mult] -> TcRn ()) -> TcM ((), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                       \ [Mult]
    _ [Mult]
    _ -> () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
               ; Mult
    t_i <- ExpRhoType -> TcM Mult
    readExpType ExpRhoType
    t_i
               ; [SyntaxExprTc]
    ops' <- Mult
    -> [(SyntaxExprRn, ExpRhoType, Mult)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [SyntaxExprTc]
    goOps Mult
    t_i [(SyntaxExprRn, ExpRhoType, Mult)]
    ops
               ; [SyntaxExprTc] -> IOEnv (Env TcGblEnv TcLclEnv) [SyntaxExprTc]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SyntaxExprTc
    op' SyntaxExprTc -> [SyntaxExprTc] -> [SyntaxExprTc]
    forall a. a -> [a] -> [a]
    : [SyntaxExprTc]
    ops') }

        goArg :: Type -> (ApplicativeArg GhcRn, Type, Type)
              -> TcM (ApplicativeArg GhcTc)

        goArg :: Mult
    -> (ApplicativeArg GhcRn, Mult, Mult)
    -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
    goArg Mult
    body_ty (ApplicativeArgOne
                        { xarg_app_arg_one :: forall idL. ApplicativeArg idL -> XApplicativeArgOne idL
    xarg_app_arg_one = XApplicativeArgOne GhcRn
    fail_op
                        , app_arg_pattern :: forall idL. ApplicativeArg idL -> LPat idL
    app_arg_pattern = LPat GhcRn
    pat
                        , arg_expr :: forall idL. ApplicativeArg idL -> LHsExpr idL
    arg_expr = LHsExpr GhcRn
    rhs
                        , Bool
    is_body_stmt :: forall idL. ApplicativeArg idL -> Bool
    is_body_stmt :: Bool
    ..
                        }, Mult
    pat_ty, Mult
    exp_ty)
          = SrcSpan
    -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (SrcSpan -> SrcSpan -> SrcSpan
    combineSrcSpans (GenLocated SrcSpan (Pat GhcRn) -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc GenLocated SrcSpan (Pat GhcRn)
    LPat GhcRn
    pat) (LHsExpr GhcRn -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc LHsExpr GhcRn
    rhs)) (IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
     -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
    forall a b. (a -> b) -> a -> b
    $
            SDoc
    -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (HsStmtContext GhcRn -> Stmt GhcRn (LHsExpr GhcRn) -> SDoc
    forall (idL :: Pass) (idR :: Pass) body.
    (OutputableBndrId idL, OutputableBndrId idR, Outputable body) =>
    HsStmtContext (GhcPass idL)
    -> StmtLR (GhcPass idL) (GhcPass idR) body -> SDoc
    pprStmtInCtxt HsStmtContext GhcRn
    ctxt (LPat GhcRn -> LHsExpr GhcRn -> Stmt GhcRn (LHsExpr GhcRn)
    forall (bodyR :: * -> *).
    LPat GhcRn
    -> Located (bodyR GhcRn)
    -> StmtLR GhcRn GhcRn (Located (bodyR GhcRn))
    mkRnBindStmt LPat GhcRn
    pat LHsExpr GhcRn
    rhs))   (IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
     -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
    forall a b. (a -> b) -> a -> b
    $
            do { LHsExpr GhcTc
    rhs'      <- LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExprNC LHsExpr GhcRn
    rhs Mult
    exp_ty
               ; (Located (Pat GhcTc)
    pat', ()
    _) <- HsMatchContext GhcRn
    -> LPat GhcRn -> Scaled Mult -> TcRn () -> TcM (LPat GhcTc, ())
    forall a.
    HsMatchContext GhcRn
    -> LPat GhcRn -> Scaled Mult -> TcM a -> TcM (LPat GhcTc, a)
    tcCheckPat (HsStmtContext GhcRn -> HsMatchContext GhcRn
    forall p. HsStmtContext p -> HsMatchContext p
    StmtCtxt HsStmtContext GhcRn
    ctxt) LPat GhcRn
    pat (Mult -> Scaled Mult
    forall a. a -> Scaled a
    unrestricted Mult
    pat_ty) (TcRn () -> TcM (LPat GhcTc, ()))
    -> TcRn () -> TcM (LPat GhcTc, ())
    forall a b. (a -> b) -> a -> b
    $
                              () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
               ; Maybe SyntaxExprTc
    fail_op' <- (Maybe (Maybe SyntaxExprTc) -> Maybe SyntaxExprTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Maybe SyntaxExprTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Maybe (Maybe SyntaxExprTc) -> Maybe SyntaxExprTc
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Maybe SyntaxExprTc))
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> ((SyntaxExprRn
         -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
        -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Maybe SyntaxExprTc)))
    -> (SyntaxExprRn
        -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe SyntaxExprRn
    -> (SyntaxExprRn
        -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Maybe SyntaxExprTc))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM Maybe SyntaxExprRn
    XApplicativeArgOne GhcRn
    fail_op ((SyntaxExprRn
      -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> (SyntaxExprRn
        -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $ \SyntaxExprRn
    fail ->
                   CtOrigin
    -> LPat GhcTc
    -> SyntaxExpr GhcRn
    -> Mult
    -> TcRn (FailOperator GhcTc)
    tcMonadFailOp (LPat GhcRn -> CtOrigin
    DoPatOrigin LPat GhcRn
    pat) Located (Pat GhcTc)
    LPat GhcTc
    pat' SyntaxExpr GhcRn
    SyntaxExprRn
    fail Mult
    body_ty

               ; ApplicativeArg GhcTc
    -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ApplicativeArgOne :: forall idL.
    XApplicativeArgOne idL
    -> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
    ApplicativeArgOne
                          { xarg_app_arg_one :: XApplicativeArgOne GhcTc
    xarg_app_arg_one = Maybe SyntaxExprTc
    XApplicativeArgOne GhcTc
    fail_op'
                          , app_arg_pattern :: LPat GhcTc
    app_arg_pattern = Located (Pat GhcTc)
    LPat GhcTc
    pat'
                          , arg_expr :: LHsExpr GhcTc
    arg_expr        = LHsExpr GhcTc
    rhs'
                          , Bool
    is_body_stmt :: Bool
    is_body_stmt :: Bool
    .. }
                        ) }

        goArg Mult
    _body_ty (ApplicativeArgMany XApplicativeArgMany GhcRn
    x [GuardLStmt GhcRn]
    stmts HsExpr GhcRn
    ret LPat GhcRn
    pat HsStmtContext GhcRn
    ctxt, Mult
    pat_ty, Mult
    exp_ty)
          = do { ([LStmt GhcTc (LHsExpr GhcTc)]
    stmts', (HsExpr GhcTc
    ret',Located (Pat GhcTc)
    pat')) <-
                    HsStmtContext GhcRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [GuardLStmt GhcRn]
    -> ExpRhoType
    -> (ExpRhoType -> TcM (HsExpr GhcTc, Located (Pat GhcTc)))
    -> TcM
         ([LStmt GhcTc (LHsExpr GhcTc)],
          (HsExpr GhcTc, Located (Pat GhcTc)))
    forall (body :: * -> *) rho_type thing.
    Outputable (body GhcRn) =>
    HsStmtContext GhcRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (Located (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext GhcRn
    ctxt TcStmtChecker HsExpr ExpRhoType
    tcDoStmt [GuardLStmt GhcRn]
    stmts (Mult -> ExpRhoType
    mkCheckExpType Mult
    exp_ty) ((ExpRhoType -> TcM (HsExpr GhcTc, Located (Pat GhcTc)))
     -> TcM
          ([LStmt GhcTc (LHsExpr GhcTc)],
           (HsExpr GhcTc, Located (Pat GhcTc))))
    -> (ExpRhoType -> TcM (HsExpr GhcTc, Located (Pat GhcTc)))
    -> TcM
         ([LStmt GhcTc (LHsExpr GhcTc)],
          (HsExpr GhcTc, Located (Pat GhcTc)))
    forall a b. (a -> b) -> a -> b
    $
                    \ExpRhoType
    res_ty  -> do
                      { HsExpr GhcTc
    ret'      <- HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    ret ExpRhoType
    res_ty
                      ; (Located (Pat GhcTc)
    pat', ()
    _) <- HsMatchContext GhcRn
    -> LPat GhcRn -> Scaled Mult -> TcRn () -> TcM (LPat GhcTc, ())
    forall a.
    HsMatchContext GhcRn
    -> LPat GhcRn -> Scaled Mult -> TcM a -> TcM (LPat GhcTc, a)
    tcCheckPat (HsStmtContext GhcRn -> HsMatchContext GhcRn
    forall p. HsStmtContext p -> HsMatchContext p
    StmtCtxt HsStmtContext GhcRn
    ctxt) LPat GhcRn
    pat (Mult -> Scaled Mult
    forall a. a -> Scaled a
    unrestricted Mult
    pat_ty) (TcRn () -> TcM (LPat GhcTc, ()))
    -> TcRn () -> TcM (LPat GhcTc, ())
    forall a b. (a -> b) -> a -> b
    $
                                     () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                      ; (HsExpr GhcTc, Located (Pat GhcTc))
    -> TcM (HsExpr GhcTc, Located (Pat GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc
    ret', Located (Pat GhcTc)
    pat')
                      }
               ; ApplicativeArg GhcTc
    -> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XApplicativeArgMany GhcTc
    -> [LStmt GhcTc (LHsExpr GhcTc)]
    -> HsExpr GhcTc
    -> LPat GhcTc
    -> HsStmtContext GhcRn
    -> ApplicativeArg GhcTc
    forall idL.
    XApplicativeArgMany idL
    -> [ExprLStmt idL]
    -> HsExpr idL
    -> LPat idL
    -> HsStmtContext GhcRn
    -> ApplicativeArg idL
    ApplicativeArgMany XApplicativeArgMany GhcRn
    XApplicativeArgMany GhcTc
    x [LStmt GhcTc (LHsExpr GhcTc)]
    stmts' HsExpr GhcTc
    ret' Located (Pat GhcTc)
    LPat GhcTc
    pat' HsStmtContext GhcRn
    ctxt) }

        get_arg_bndrs :: ApplicativeArg GhcTc -> [Id]
        get_arg_bndrs :: ApplicativeArg GhcTc -> [Id]
    get_arg_bndrs (ApplicativeArgOne { app_arg_pattern :: forall idL. ApplicativeArg idL -> LPat idL
    app_arg_pattern = LPat GhcTc
    pat }) = LPat GhcTc -> [IdP GhcTc]
    forall p. CollectPass p => LPat p -> [IdP p]
    collectPatBinders LPat GhcTc
    pat
        get_arg_bndrs (ApplicativeArgMany { bv_pattern :: forall idL. ApplicativeArg idL -> LPat idL
    bv_pattern =  LPat GhcTc
    pat }) = LPat GhcTc -> [IdP GhcTc]
    forall p. CollectPass p => LPat p -> [IdP p]
    collectPatBinders LPat GhcTc
    pat

    {- Note [ApplicativeDo and constraints]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    An applicative-do is supposed to take place in parallel, so
    constraints bound in one arm can't possibly be available in another
    (#13242).  Our current rule is this (more details and discussion
    on the ticket). Consider

       ...stmts...
       ApplicativeStmts [arg1, arg2, ... argN]
       ...more stmts...

    where argi :: ApplicativeArg. Each 'argi' itself contains one or more Stmts.
    Now, we say that:

    * Constraints required by the argi can be solved from
      constraint bound by ...stmts...

    * Constraints and existentials bound by the argi are not available
      to solve constraints required either by argj (where i /= j),
      or by ...more stmts....

    * Within the stmts of each 'argi' individually, however, constraints bound
      by earlier stmts can be used to solve later ones.

    To achieve this, we just typecheck each 'argi' separately, bring all
    the variables they bind into scope, and typecheck the thing_inside.

    ************************************************************************
    *                                                                      *
    \subsection{Errors and contexts}
    *                                                                      *
    ************************************************************************

    @sameNoOfArgs@ takes a @[RenamedMatch]@ and decides whether the same
    number of args are used in each equation.
    -}

    checkArgs :: Name -> MatchGroup GhcRn body -> TcM ()
    checkArgs :: forall body. Name -> MatchGroup GhcRn body -> TcRn ()
    checkArgs Name
    _ (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
    mg_alts = L SrcSpan
    _ [] })
        = () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkArgs Name
    fun (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
    mg_alts = L SrcSpan
    _ (LMatch GhcRn body
    match1:[LMatch GhcRn body]
    matches) })
        | [LMatch GhcRn body] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LMatch GhcRn body]
    bad_matches
        = () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        | Bool
    otherwise
        = SDoc -> TcRn ()
    forall a. SDoc -> TcM a
    failWithTc ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Equations for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    fun) SDoc -> SDoc -> SDoc
    <+>
                             String -> SDoc
    text String
    "have different numbers of arguments"
                           , Arity -> SDoc -> SDoc
    nest Arity
    2 (SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (LMatch GhcRn body -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc LMatch GhcRn body
    match1))
                           , Arity -> SDoc -> SDoc
    nest Arity
    2 (SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (LMatch GhcRn body -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc ([LMatch GhcRn body] -> LMatch GhcRn body
    forall a. [a] -> a
    head [LMatch GhcRn body]
    bad_matches)))])
      where
        n_args1 :: Arity
    n_args1 = LMatch GhcRn body -> Arity
    forall body. LMatch GhcRn body -> Arity
    args_in_match LMatch GhcRn body
    match1
        bad_matches :: [LMatch GhcRn body]
    bad_matches = [LMatch GhcRn body
    m | LMatch GhcRn body
    m <- [LMatch GhcRn body]
    matches, LMatch GhcRn body -> Arity
    forall body. LMatch GhcRn body -> Arity
    args_in_match LMatch GhcRn body
    m Arity -> Arity -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Arity
    n_args1]

        args_in_match :: LMatch GhcRn body -> Int
        args_in_match :: forall body. LMatch GhcRn body -> Arity
    args_in_match (L SrcSpan
    _ (Match { m_pats :: forall p body. Match p body -> [LPat p]
    m_pats = [LPat GhcRn]
    pats })) = [GenLocated SrcSpan (Pat GhcRn)] -> Arity
    forall (t :: * -> *) a. Foldable t => t a -> Arity
    length [GenLocated SrcSpan (Pat GhcRn)]
    [LPat GhcRn]
    pats