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

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

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

    -}

    -- | Typecheck some @Matches@
    module GHC.Tc.Gen.Match
       ( tcFunBindMatches
       , tcCaseMatches
       , tcLambdaMatches
       , tcGRHSList
       , tcGRHSsPat
       , TcStmtChecker
       , TcExprStmtChecker
       , TcCmdStmtChecker
       , tcStmts
       , tcStmtsAndThen
       , tcDoStmts
       , tcBody
       , tcDoStmt
       , tcGuardStmt
       , checkArgCounts
       )
    where

    import GHC.Prelude

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

    import GHC.Rename.Utils ( bindLocalNames, isIrrefutableHsPat )
    import GHC.Tc.Errors.Types
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Utils.Env
    import GHC.Tc.Gen.Pat
    import GHC.Tc.Gen.Do
    import GHC.Tc.Gen.Head( tcCheckId )
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Gen.Bind
    import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic )
    import GHC.Tc.Utils.Unify
    import GHC.Tc.Types.Origin
    import GHC.Tc.Types.Evidence

    import GHC.Core.Multiplicity
    import GHC.Core.UsageEnv
    import GHC.Core.TyCon
    -- Create chunkified tuple types for monad comprehensions
    import GHC.Core.Make

    import GHC.Hs

    import GHC.Builtin.Types
    import GHC.Builtin.Types.Prim

    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Misc
    import GHC.Driver.DynFlags ( getDynFlags )

    import GHC.Types.Name
    import GHC.Types.Id
    import GHC.Types.SrcLoc
    import GHC.Types.Basic( VisArity, isDoExpansionGenerated )

    import Control.Monad
    import Control.Arrow ( second )
    import qualified Data.List.NonEmpty as NE
    import Data.Maybe (mapMaybe)

    import qualified GHC.LanguageExtensions as LangExt

    {-
    ************************************************************************
    *                                                                      *
    \subsection{tcFunBindMatches, tcCaseMatches}
    *                                                                      *
    ************************************************************************

    `tcFunBindMatches` typechecks a `[Match]` list which occurs in a
    `FunBind`.  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.
    -}

    tcFunBindMatches :: UserTypeCtxt
                     -> Name            -- Function name
                     -> Mult            -- The multiplicity of the binder
                     -> MatchGroup GhcRn (LHsExpr GhcRn)
                     -> [ExpPatType]    -- Scoped skolemised binders
                     -> ExpRhoType      -- Expected type of function; caller
                                        -- has skolemised any outer forall's
                     -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    -- See Note [Skolemisation overview] in GHC.Tc.Utils.Unify
    tcFunBindMatches :: UserTypeCtxt
    -> Name
    -> Mult
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    -> [ExpPatType]
    -> ExpRhoType
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    tcFunBindMatches UserTypeCtxt
    ctxt Name
    fun_name Mult
    mult MatchGroup GhcRn (LHsExpr GhcRn)
    matches [ExpPatType]
    invis_pat_tys ExpRhoType
    exp_ty
      = Bool
    -> SDoc
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    forall a. HasCallStack => Bool -> SDoc -> a -> a
    assertPpr (MatchGroup GhcRn (LHsExpr GhcRn) -> Bool
    funBindPrecondition MatchGroup GhcRn (LHsExpr GhcRn)
    matches) (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> SDoc
    forall (idR :: Pass) body.
    (OutputableBndrId idR, Outputable body) =>
    MatchGroup (GhcPass idR) body -> SDoc
    pprMatches MatchGroup GhcRn (LHsExpr GhcRn)
    MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    matches) (TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
     -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc)))
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $
        do  {  -- Check that they all have the same no of arguments
              arity <- MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> TcM VisArity
    forall (body :: * -> *).
    AnnoBody body =>
    MatchGroup GhcRn (LocatedA (body GhcRn)) -> TcM VisArity
    checkArgCounts MatchGroup GhcRn (LHsExpr GhcRn)
    MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    matches

            ; traceTc "tcFunBindMatches 1" (ppr fun_name $$ ppr mult $$ ppr exp_ty $$ ppr arity)

            ; (wrap_fun, (wrap_mult, r))
                 <- matchExpectedFunTys herald ctxt arity exp_ty $ \ [ExpPatType]
    pat_tys ExpRhoType
    rhs_ty ->
                    Mult
    -> TcM
         (HsWrapper,
          MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> TcM
         (HsWrapper,
          MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    mult (TcM
       (HsWrapper,
        MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
     -> TcM
          (HsWrapper,
           MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    -> TcM
         (HsWrapper,
          MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> TcM
         (HsWrapper,
          MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall a b. (a -> b) -> a -> b
    $
                       -- Makes sure that if the binding is unrestricted, it counts as
                       -- consuming its rhs Many times.

                    do { String -> SDoc -> TcRn ()
    traceTc String
    "tcFunBindMatches 2" ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ UserTypeCtxt -> SDoc
    pprUserTypeCtxt UserTypeCtxt
    ctxt, [ExpPatType] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ExpPatType]
    invis_pat_tys
                                                          , [ExpPatType] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ExpPatType]
    pat_tys SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    rhs_ty ])
                       ; HsMatchContextRn
    -> TcMatchAltChecker HsExpr
    -> [ExpPatType]
    -> ExpRhoType
    -> MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> TcM
         (HsWrapper,
          MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall (body :: * -> *).
    (AnnoBody body, Outputable (body GhcTc)) =>
    HsMatchContextRn
    -> TcMatchAltChecker body
    -> [ExpPatType]
    -> ExpRhoType
    -> MatchGroup GhcRn (LocatedA (body GhcRn))
    -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc)))
    tcMatches HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    mctxt LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    TcMatchAltChecker HsExpr
    tcBody ([ExpPatType]
    invis_pat_tys [ExpPatType] -> [ExpPatType] -> [ExpPatType]
    forall a. [a] -> [a] -> [a]
    ++ [ExpPatType]
    pat_tys) ExpRhoType
    rhs_ty MatchGroup GhcRn (LHsExpr GhcRn)
    MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    matches }

            ; return (wrap_fun <.> wrap_mult, r) }
      where
        herald :: ExpectedFunTyOrigin
    herald = TypedThing
    -> MatchGroup GhcRn (LHsExpr GhcRn) -> ExpectedFunTyOrigin
    ExpectedFunTyMatches (Name -> TypedThing
    NameThing Name
    fun_name) MatchGroup GhcRn (LHsExpr GhcRn)
    matches
        mctxt :: HsMatchContext (GenLocated SrcSpanAnnN Name)
    mctxt  = GenLocated SrcSpanAnnN Name
    -> HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. fn -> HsMatchContext fn
    mkPrefixFunRhs (Name -> GenLocated SrcSpanAnnN Name
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA Name
    fun_name)

    funBindPrecondition :: MatchGroup GhcRn (LHsExpr GhcRn) -> Bool
    funBindPrecondition :: MatchGroup GhcRn (LHsExpr GhcRn) -> Bool
    funBindPrecondition (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
    mg_alts = L SrcSpanAnnL
    _ [GenLocated
       SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    alts })
      = Bool -> Bool
    not ([GenLocated
       SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenLocated
       SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    alts) Bool -> Bool -> Bool
    && (GenLocated
       SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
     -> Bool)
    -> [GenLocated
          SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all GenLocated
      SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> Bool
    forall {l} {p} {body}. GenLocated l (Match p body) -> Bool
    is_fun_rhs [GenLocated
       SrcSpanAnnA (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    alts
      where
        is_fun_rhs :: GenLocated l (Match p body) -> Bool
    is_fun_rhs (L l
    _ (Match { m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
    m_ctxt = FunRhs {} })) = Bool
    True
        is_fun_rhs GenLocated l (Match p body)
    _                                    = Bool
    False

    tcLambdaMatches :: HsExpr GhcRn -> HsLamVariant
                    -> MatchGroup GhcRn (LHsExpr GhcRn)
                    -> [ExpPatType]  -- Already skolemised
                    -> ExpSigmaType  -- NB can be a sigma-type
                    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    tcLambdaMatches :: HsExpr GhcRn
    -> HsLamVariant
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    -> [ExpPatType]
    -> ExpRhoType
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    tcLambdaMatches HsExpr GhcRn
    e HsLamVariant
    lam_variant MatchGroup GhcRn (LHsExpr GhcRn)
    matches [ExpPatType]
    invis_pat_tys ExpRhoType
    res_ty
      =  do { arity <- MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> TcM VisArity
    forall (body :: * -> *).
    AnnoBody body =>
    MatchGroup GhcRn (LocatedA (body GhcRn)) -> TcM VisArity
    checkArgCounts MatchGroup GhcRn (LHsExpr GhcRn)
    MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    matches
                -- Check argument counts since this is also used for \cases

            ; (wrapper, (mult_co_wrap, r))
                <- matchExpectedFunTys herald GenSigCtxt arity res_ty $ \ [ExpPatType]
    pat_tys ExpRhoType
    rhs_ty ->
                   HsMatchContextRn
    -> TcMatchAltChecker HsExpr
    -> [ExpPatType]
    -> ExpRhoType
    -> MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> TcM
         (HsWrapper,
          MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall (body :: * -> *).
    (AnnoBody body, Outputable (body GhcTc)) =>
    HsMatchContextRn
    -> TcMatchAltChecker body
    -> [ExpPatType]
    -> ExpRhoType
    -> MatchGroup GhcRn (LocatedA (body GhcRn))
    -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc)))
    tcMatches HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    ctxt LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    TcMatchAltChecker HsExpr
    tc_body ([ExpPatType]
    invis_pat_tys [ExpPatType] -> [ExpPatType] -> [ExpPatType]
    forall a. [a] -> [a] -> [a]
    ++ [ExpPatType]
    pat_tys) ExpRhoType
    rhs_ty MatchGroup GhcRn (LHsExpr GhcRn)
    MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    matches

            ; return (wrapper <.> mult_co_wrap, r) }
      where
        ctxt :: HsMatchContext (GenLocated SrcSpanAnnN Name)
    ctxt   = HsLamVariant -> HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsLamVariant -> HsMatchContext fn
    LamAlt HsLamVariant
    lam_variant
        herald :: ExpectedFunTyOrigin
    herald = HsLamVariant -> HsExpr GhcRn -> ExpectedFunTyOrigin
    ExpectedFunTyLam HsLamVariant
    lam_variant HsExpr GhcRn
    e
                 -- See Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify

        tc_body :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tc_body | Origin -> Bool
    isDoExpansionGenerated (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> XMG GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    forall p body. MatchGroup p body -> XMG p body
    mg_ext MatchGroup GhcRn (LHsExpr GhcRn)
    MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    matches)
                  -- See Part 3. B. of Note [Expanding HsDo with XXExprGhcRn] in
                  -- `GHC.Tc.Gen.Do`. Testcase: Typeable1
                = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBodyNC -- NB: Do not add any error contexts
                           -- It has already been done
                | Bool
    otherwise
                = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBody

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

    tcCaseMatches :: (AnnoBody body, Outputable (body GhcTc))
                  => HsMatchContextRn
                  -> TcMatchAltChecker body    -- ^ Typecheck the alternative RHSS
                  -> Scaled TcSigmaTypeFRR     -- ^ Type of scrutinee
                  -> MatchGroup GhcRn (LocatedA (body GhcRn)) -- ^ The case alternatives
                  -> ExpRhoType                               -- ^ Type of the whole case expression
                  -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc)))
                    -- Translated alternatives
                    -- wrapper goes from MatchGroup's ty to expected ty

    tcCaseMatches :: forall (body :: * -> *).
    (AnnoBody body, Outputable (body GhcTc)) =>
    HsMatchContextRn
    -> TcMatchAltChecker body
    -> Scaled Mult
    -> MatchGroup GhcRn (LocatedA (body GhcRn))
    -> ExpRhoType
    -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc)))
    tcCaseMatches HsMatchContextRn
    ctxt TcMatchAltChecker body
    tc_body (Scaled Mult
    scrut_mult Mult
    scrut_ty) MatchGroup GhcRn (LocatedA (body GhcRn))
    matches ExpRhoType
    res_ty
      = HsMatchContextRn
    -> TcMatchAltChecker body
    -> [ExpPatType]
    -> ExpRhoType
    -> MatchGroup GhcRn (LocatedA (body GhcRn))
    -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc)))
    forall (body :: * -> *).
    (AnnoBody body, Outputable (body GhcTc)) =>
    HsMatchContextRn
    -> TcMatchAltChecker body
    -> [ExpPatType]
    -> ExpRhoType
    -> MatchGroup GhcRn (LocatedA (body GhcRn))
    -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc)))
    tcMatches HsMatchContextRn
    ctxt TcMatchAltChecker body
    tc_body [Scaled ExpRhoType -> ExpPatType
    ExpFunPatTy (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 (LocatedA (body GhcRn))
    matches

    -- @tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind@.
    tcGRHSsPat :: Mult -> GRHSs GhcRn (LHsExpr GhcRn) -> ExpRhoType
               -> TcM (GRHSs GhcTc (LHsExpr GhcTc))
    -- Used for pattern bindings
    tcGRHSsPat :: Mult
    -> GRHSs GhcRn (LHsExpr GhcRn)
    -> ExpRhoType
    -> TcM (GRHSs GhcTc (LHsExpr GhcTc))
    tcGRHSsPat Mult
    mult GRHSs GhcRn (LHsExpr GhcRn)
    grhss ExpRhoType
    res_ty
      = Mult
    -> TcM (GRHSs GhcTc (LHsExpr GhcTc))
    -> TcM (GRHSs GhcTc (LHsExpr GhcTc))
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    mult (TcM (GRHSs GhcTc (LHsExpr GhcTc))
     -> TcM (GRHSs GhcTc (LHsExpr GhcTc)))
    -> TcM (GRHSs GhcTc (LHsExpr GhcTc))
    -> TcM (GRHSs GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ do
        { (mult_co_wrapper, r) <- HsMatchContextRn
    -> TcMatchAltChecker HsExpr
    -> GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> ExpRhoType
    -> TcM
         (HsWrapper, GRHSs GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall (body :: * -> *).
    AnnoBody body =>
    HsMatchContextRn
    -> TcMatchAltChecker body
    -> GRHSs GhcRn (LocatedA (body GhcRn))
    -> ExpRhoType
    -> TcM (HsWrapper, GRHSs GhcTc (LocatedA (body GhcTc)))
    tcGRHSs HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsMatchContext fn
    PatBindRhs LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    TcMatchAltChecker HsExpr
    tcBody GRHSs GhcRn (LHsExpr GhcRn)
    GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    grhss ExpRhoType
    res_ty
        ; return $ mkWrap mult_co_wrapper r }
      where
        mkWrap :: HsWrapper
    -> GRHSs p (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> GRHSs p (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    mkWrap HsWrapper
    wrap grhss :: GRHSs p (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    grhss@(GRHSs { grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
    grhssGRHSs = L l
    loc (GRHS XCGRHS p (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    x [GuardLStmt p]
    guards GenLocated SrcSpanAnnA (HsExpr GhcTc)
    body) : [XRec p (GRHS p (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    rhss }) =
          GRHSs p (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    grhss { grhssGRHSs = L loc (GRHS x guards (mkLHsWrap wrap body)) : rhss }
        mkWrap HsWrapper
    _ (GRHSs { grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
    grhssGRHSs = [] }) = String -> GRHSs p (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall a. HasCallStack => String -> a
    panic String
    "tcGRHSsPat: empty GHRSs"
        mkWrap HsWrapper
    _ GRHSs p (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    _ = String -> GRHSs p (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall a. HasCallStack => String -> a
    panic String
    "tcGRHSsPat: non-empty extensions"
        -- Should be the following but it warns of redundant pattern and I couldn't
        -- find a way to silence them
        --
        -- mkWrap _ (GRHSs { grhssGRHSs = L _ (XGRHS absent) : _ }) = dataConCantHappen absent
        -- mkWrap _ (XGRHSs absent) = dataConCantHappen absent

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

    -- | Type checker for a body of a match alternative
    type TcMatchAltChecker body   -- c.f. TcStmtChecker, also in this module
      =  LocatedA (body GhcRn)
      -> ExpRhoType
      -> TcM (LocatedA (body GhcTc))

    type AnnoBody body
      = ( Outputable (body GhcRn)
        , Anno (Match GhcRn (LocatedA (body GhcRn))) ~ SrcSpanAnnA
        , Anno (Match GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA
        , Anno [LocatedA (Match GhcRn (LocatedA (body GhcRn)))] ~ SrcSpanAnnL
        , Anno [LocatedA (Match GhcTc (LocatedA (body GhcTc)))] ~ SrcSpanAnnL
        , Anno (GRHS GhcRn (LocatedA (body GhcRn))) ~ EpAnnCO
        , Anno (GRHS GhcTc (LocatedA (body GhcTc))) ~ EpAnnCO
        , Anno (StmtLR GhcRn GhcRn (LocatedA (body GhcRn))) ~ SrcSpanAnnA
        , Anno (StmtLR GhcTc GhcTc (LocatedA (body GhcTc))) ~ SrcSpanAnnA
        )

    -- | Type-check a MatchGroup.
    tcMatches :: (AnnoBody body, Outputable (body GhcTc))
              => HsMatchContextRn
              -> TcMatchAltChecker body
              -> [ExpPatType]             -- ^ Expected pattern types.
              -> ExpRhoType               -- ^ Expected result-type of the Match.
              -> MatchGroup GhcRn (LocatedA (body GhcRn))
              -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc)))

    tcMatches :: forall (body :: * -> *).
    (AnnoBody body, Outputable (body GhcTc)) =>
    HsMatchContextRn
    -> TcMatchAltChecker body
    -> [ExpPatType]
    -> ExpRhoType
    -> MatchGroup GhcRn (LocatedA (body GhcRn))
    -> TcM (HsWrapper, MatchGroup GhcTc (LocatedA (body GhcTc)))
    tcMatches HsMatchContextRn
    ctxt TcMatchAltChecker body
    tc_body [ExpPatType]
    pat_tys ExpRhoType
    rhs_ty (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
    mg_alts = L SrcSpanAnnL
    l [LocatedA (Match GhcRn (LocatedA (body GhcRn)))]
    matches
                                              , mg_ext :: forall p body. MatchGroup p body -> XMG p body
    mg_ext = XMG GhcRn (LocatedA (body GhcRn))
    origin })
      | [LocatedA (Match GhcRn (LocatedA (body GhcRn)))] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LocatedA (Match GhcRn (LocatedA (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
             -- See Note [Pattern types for EmptyCase]
           ; let vis_pat_tys :: [ExpPatType]
    vis_pat_tys = (ExpPatType -> Bool) -> [ExpPatType] -> [ExpPatType]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ExpPatType -> Bool
    isVisibleExpPatType [ExpPatType]
    pat_tys
           ; pat_ty <- case [ExpPatType]
    vis_pat_tys of
               [ExpFunPatTy Scaled ExpRhoType
    t]      -> Scaled ExpRhoType -> IOEnv (Env TcGblEnv TcLclEnv) (Scaled Mult)
    scaledExpTypeToType Scaled ExpRhoType
    t
               [ExpForAllPatTy ForAllTyBinder
    tvb] -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) (Scaled Mult)
    forall a. TcRnMessage -> TcM a
    failWithTc (TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) (Scaled Mult))
    -> TcRnMessage -> IOEnv (Env TcGblEnv TcLclEnv) (Scaled Mult)
    forall a b. (a -> b) -> a -> b
    $ HsMatchContextRn -> BadEmptyCaseReason -> TcRnMessage
    TcRnEmptyCase HsMatchContextRn
    ctxt (ForAllTyBinder -> BadEmptyCaseReason
    EmptyCaseForall ForAllTyBinder
    tvb)
               []                   -> String -> IOEnv (Env TcGblEnv TcLclEnv) (Scaled Mult)
    forall a. HasCallStack => String -> a
    panic String
    "tcMatches: no arguments in EmptyCase"
               ExpPatType
    _t1:(ExpPatType
    _t2:[ExpPatType]
    _ts)        -> String -> IOEnv (Env TcGblEnv TcLclEnv) (Scaled Mult)
    forall a. HasCallStack => String -> a
    panic String
    "tcMatches: multiple arguments in EmptyCase"
           ; rhs_ty  <- expTypeToType rhs_ty
           ; return (idHsWrapper, MG { mg_alts = L l []
                                     , mg_ext = MatchGroupTc [pat_ty] rhs_ty origin
                                     }) }

      | Bool
    otherwise
      = do { umatches <- (LocatedA (Match GhcRn (LocatedA (body GhcRn)))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (UsageEnv,
           (HsWrapper,
            GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (body GhcTc))))))
    -> [LocatedA (Match GhcRn (LocatedA (body GhcRn)))]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [(UsageEnv,
           (HsWrapper,
            GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (body GhcTc)))))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (TcM
      (HsWrapper,
       GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (body GhcTc))))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (UsageEnv,
          (HsWrapper,
           GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (body GhcTc)))))
    forall a. TcM a -> TcM (UsageEnv, a)
    tcCollectingUsage (TcM
       (HsWrapper,
        GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (body GhcTc))))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (UsageEnv,
           (HsWrapper,
            GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (body GhcTc))))))
    -> (LocatedA (Match GhcRn (LocatedA (body GhcRn)))
        -> TcM
             (HsWrapper,
              GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (body GhcTc)))))
    -> LocatedA (Match GhcRn (LocatedA (body GhcRn)))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (UsageEnv,
          (HsWrapper,
           GenLocated SrcSpanAnnA (Match GhcTc (LocatedA (body GhcTc)))))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcMatchAltChecker body
    -> [ExpPatType]
    -> ExpRhoType
    -> LMatch GhcRn (LocatedA (body GhcRn))
    -> TcM (HsWrapper, LMatch GhcTc (LocatedA (body GhcTc)))
    forall (body :: * -> *).
    AnnoBody body =>
    TcMatchAltChecker body
    -> [ExpPatType]
    -> ExpRhoType
    -> LMatch GhcRn (LocatedA (body GhcRn))
    -> TcM (HsWrapper, LMatch GhcTc (LocatedA (body GhcTc)))
    tcMatch TcMatchAltChecker body
    tc_body [ExpPatType]
    pat_tys ExpRhoType
    rhs_ty) [LocatedA (Match GhcRn (LocatedA (body GhcRn)))]
    matches
           ; let (usages, wmatches) = unzip umatches
           ; let (wrappers, matches') = unzip wmatches
           ; let wrapper = [HsWrapper] -> HsWrapper
    forall a. Monoid a => [a] -> a
    mconcat [HsWrapper]
    wrappers
           ; tcEmitBindingUsage $ supUEs usages
           ; pat_tys  <- mapM readScaledExpType (filter_out_forall_pat_tys pat_tys)
           ; rhs_ty   <- readExpType rhs_ty
           ; traceTc "tcMatches" (ppr matches' $$ ppr pat_tys $$ ppr rhs_ty)
           ; return (wrapper, MG { mg_alts   = L l matches'
                                 , mg_ext    = MatchGroupTc pat_tys rhs_ty origin
                                 }) }
      where
        -- We filter out foralls because we have no use for them in HsToCore.
        filter_out_forall_pat_tys :: [ExpPatType] -> [Scaled ExpSigmaTypeFRR]
        filter_out_forall_pat_tys :: [ExpPatType] -> [Scaled ExpRhoType]
    filter_out_forall_pat_tys = (ExpPatType -> Maybe (Scaled ExpRhoType))
    -> [ExpPatType] -> [Scaled ExpRhoType]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ExpPatType -> Maybe (Scaled ExpRhoType)
    match_fun_pat_ty
          where
            match_fun_pat_ty :: ExpPatType -> Maybe (Scaled ExpRhoType)
    match_fun_pat_ty (ExpFunPatTy Scaled ExpRhoType
    t)  = Scaled ExpRhoType -> Maybe (Scaled ExpRhoType)
    forall a. a -> Maybe a
    Just Scaled ExpRhoType
    t
            match_fun_pat_ty ExpForAllPatTy{} = Maybe (Scaled ExpRhoType)
    forall a. Maybe a
    Nothing

    {- Note [Pattern types for EmptyCase]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In tcMatches, we might encounter an empty list of matches if the user wrote
    `case x of {}` or `\case {}`.

    * First of all, both `case x of {}` and `\case {}` match on exactly one visible
      argument, which follows from

        checkArgCounts :: MatchGroup GhcRn ... -> TcM VisArity
        checkArgCounts (MG { mg_alts = L _ [] })
          = return 1
        ...

      So we expect vis_pat_tys to be a singleton list [pat_ty] and panic otherwise.

      Multi-case `\cases {}` can't violate this assumption in `tcMatches` because it
      must have been rejected earlier in `rnMatchGroup`.

      Other MatchGroup contexts (function equations `f x = ...`, lambdas `\a b -> ...`,
      etc) are not considered here because there is no syntax to construct them with
      an empty list of alternatives.

    * With lambda-case, we run the risk of trying to match on a type argument:

        f :: forall (xs :: Type) -> ()
        f = \case {}

      This is not valid and it used to trigger a panic in pmcMatches (#25004).
      We reject it by inspecting the expected pattern type:

        ; pat_ty <- case vis_pat_tys of
            [ExpFunPatTy t]      -> ...    -- value argument, ok
            [ExpForAllPatTy tvb] -> ...    -- type argument, error!

      Test case: typecheck/should_fail/T25004
    -}

    -------------
    tcMatch :: (AnnoBody body)
            => TcMatchAltChecker body
            -> [ExpPatType]          -- Expected pattern types
            -> ExpRhoType            -- Expected result-type of the Match.
            -> LMatch GhcRn (LocatedA (body GhcRn))
            -> TcM (HsWrapper, LMatch GhcTc (LocatedA (body GhcTc)))

    tcMatch :: forall (body :: * -> *).
    AnnoBody body =>
    TcMatchAltChecker body
    -> [ExpPatType]
    -> ExpRhoType
    -> LMatch GhcRn (LocatedA (body GhcRn))
    -> TcM (HsWrapper, LMatch GhcTc (LocatedA (body GhcTc)))
    tcMatch TcMatchAltChecker body
    tc_body [ExpPatType]
    pat_tys ExpRhoType
    rhs_ty LMatch GhcRn (LocatedA (body GhcRn))
    match
      = do { (L loc (wrapper, r)) <- (Match GhcRn (LocatedA (body GhcRn))
     -> TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc))))
    -> LocatedA (Match GhcRn (LocatedA (body GhcRn)))
    -> TcRn
         (GenLocated
            SrcSpanAnnA (HsWrapper, Match GhcTc (LocatedA (body GhcTc))))
    forall a b ann.
    (a -> TcM b)
    -> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
    wrapLocMA ([ExpPatType]
    -> ExpRhoType
    -> Match GhcRn (LocatedA (body GhcRn))
    -> TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    tc_match [ExpPatType]
    pat_tys ExpRhoType
    rhs_ty) LMatch GhcRn (LocatedA (body GhcRn))
    LocatedA (Match GhcRn (LocatedA (body GhcRn)))
    match
           ; return (wrapper, L loc r) }
      where
        tc_match :: [ExpPatType]
    -> ExpRhoType
    -> Match GhcRn (LocatedA (body GhcRn))
    -> TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    tc_match [ExpPatType]
    pat_tys ExpRhoType
    rhs_ty
                 match :: Match GhcRn (LocatedA (body GhcRn))
    match@(Match { m_ctxt :: forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
    m_ctxt = HsMatchContext (LIdP (NoGhcTc GhcRn))
    ctxt, 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 (LocatedA (body GhcRn))
    grhss })
          = TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    -> TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    add_match_ctxt (TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
     -> TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc))))
    -> TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    -> TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    forall a b. (a -> b) -> a -> b
    $
            do { (pats', (wrapper, grhss')) <- HsMatchContextRn
    -> [LPat GhcRn]
    -> [ExpPatType]
    -> TcM (HsWrapper, GRHSs GhcTc (LocatedA (body GhcTc)))
    -> TcM
         ([LPat GhcTc], (HsWrapper, GRHSs GhcTc (LocatedA (body GhcTc))))
    forall a.
    HsMatchContextRn
    -> [LPat GhcRn] -> [ExpPatType] -> TcM a -> TcM ([LPat GhcTc], a)
    tcMatchPats HsMatchContext (LIdP (NoGhcTc GhcRn))
    HsMatchContextRn
    ctxt [LPat GhcRn]
    pats [ExpPatType]
    pat_tys (TcM (HsWrapper, GRHSs GhcTc (LocatedA (body GhcTc)))
     -> TcM
          ([LPat GhcTc], (HsWrapper, GRHSs GhcTc (LocatedA (body GhcTc)))))
    -> TcM (HsWrapper, GRHSs GhcTc (LocatedA (body GhcTc)))
    -> TcM
         ([LPat GhcTc], (HsWrapper, GRHSs GhcTc (LocatedA (body GhcTc))))
    forall a b. (a -> b) -> a -> b
    $
                                               HsMatchContextRn
    -> TcMatchAltChecker body
    -> GRHSs GhcRn (LocatedA (body GhcRn))
    -> ExpRhoType
    -> TcM (HsWrapper, GRHSs GhcTc (LocatedA (body GhcTc)))
    forall (body :: * -> *).
    AnnoBody body =>
    HsMatchContextRn
    -> TcMatchAltChecker body
    -> GRHSs GhcRn (LocatedA (body GhcRn))
    -> ExpRhoType
    -> TcM (HsWrapper, GRHSs GhcTc (LocatedA (body GhcTc)))
    tcGRHSs HsMatchContext (LIdP (NoGhcTc GhcRn))
    HsMatchContextRn
    ctxt TcMatchAltChecker body
    tc_body GRHSs GhcRn (LocatedA (body GhcRn))
    grhss ExpRhoType
    rhs_ty
                 -- NB: pats' are just the /value/ patterns
                 -- See Note [tcMatchPats] in GHC.Tc.Gen.Pat

               ; return (wrapper, Match { m_ext   = noAnn
                                        , m_ctxt  = ctxt
                                        , m_pats  = pats'
                                        , m_grhss = grhss' }) }
          where
            -- 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"
            -- But for \cases with many alternatives, it is helpful to say
            --     which particular alternative we are looking at
            add_match_ctxt :: TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    -> TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    add_match_ctxt TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    thing_inside = case HsMatchContext (LIdP (NoGhcTc GhcRn))
    ctxt of
                LamAlt HsLamVariant
    LamSingle -> TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    thing_inside
                StmtCtxt (HsDoStmt{}) -> TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    thing_inside -- this is an expanded do stmt
                HsMatchContext (LIdP (NoGhcTc GhcRn))
    _          -> SDoc
    -> TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    -> TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (Match GhcRn (LocatedA (body GhcRn)) -> SDoc
    forall (idR :: Pass) body.
    (OutputableBndrId idR, Outputable body) =>
    Match (GhcPass idR) body -> SDoc
    pprMatchInCtxt Match GhcRn (LocatedA (body GhcRn))
    match) TcM (HsWrapper, Match GhcTc (LocatedA (body GhcTc)))
    thing_inside

    -------------
    tcGRHSs :: AnnoBody body
            => HsMatchContextRn
            -> TcMatchAltChecker body
            -> GRHSs GhcRn (LocatedA (body GhcRn))
            -> ExpRhoType
            -> TcM (HsWrapper, GRHSs GhcTc (LocatedA (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 :: * -> *).
    AnnoBody body =>
    HsMatchContextRn
    -> TcMatchAltChecker body
    -> GRHSs GhcRn (LocatedA (body GhcRn))
    -> ExpRhoType
    -> TcM (HsWrapper, GRHSs GhcTc (LocatedA (body GhcTc)))
    tcGRHSs HsMatchContextRn
    ctxt TcMatchAltChecker body
    tc_body (GRHSs XCGRHSs GhcRn (LocatedA (body GhcRn))
    _ [LGRHS GhcRn (LocatedA (body GhcRn))]
    grhss HsLocalBinds GhcRn
    binds) ExpRhoType
    res_ty
      = do  { (binds', wrapper, grhss') <- HsLocalBinds GhcRn
    -> TcM [GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))]
    -> TcM
         (HsLocalBinds GhcTc, HsWrapper,
          [GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))])
    forall thing.
    HsLocalBinds GhcRn
    -> TcM thing -> TcM (HsLocalBinds GhcTc, HsWrapper, thing)
    tcLocalBinds HsLocalBinds GhcRn
    binds (TcM [GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))]
     -> TcM
          (HsLocalBinds GhcTc, HsWrapper,
           [GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))]))
    -> TcM [GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))]
    -> TcM
         (HsLocalBinds GhcTc, HsWrapper,
          [GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))])
    forall a b. (a -> b) -> a -> b
    $ do
                                           HsMatchContextRn
    -> TcMatchAltChecker body
    -> [LGRHS GhcRn (LocatedA (body GhcRn))]
    -> ExpRhoType
    -> TcM [LGRHS GhcTc (LocatedA (body GhcTc))]
    forall (body :: * -> *).
    AnnoBody body =>
    HsMatchContextRn
    -> TcMatchAltChecker body
    -> [LGRHS GhcRn (LocatedA (body GhcRn))]
    -> ExpRhoType
    -> TcM [LGRHS GhcTc (LocatedA (body GhcTc))]
    tcGRHSList HsMatchContextRn
    ctxt TcMatchAltChecker body
    tc_body [LGRHS GhcRn (LocatedA (body GhcRn))]
    grhss ExpRhoType
    res_ty
            ; return (wrapper, GRHSs emptyComments grhss' binds') }

    tcGRHSList :: forall body. AnnoBody body
               => HsMatchContextRn -> TcMatchAltChecker body
               -> [LGRHS GhcRn (LocatedA (body GhcRn))] -> ExpRhoType
               -> TcM [LGRHS GhcTc (LocatedA (body GhcTc))]
    tcGRHSList :: forall (body :: * -> *).
    AnnoBody body =>
    HsMatchContextRn
    -> TcMatchAltChecker body
    -> [LGRHS GhcRn (LocatedA (body GhcRn))]
    -> ExpRhoType
    -> TcM [LGRHS GhcTc (LocatedA (body GhcTc))]
    tcGRHSList HsMatchContextRn
    ctxt TcMatchAltChecker body
    tc_body [LGRHS GhcRn (LocatedA (body GhcRn))]
    grhss ExpRhoType
    res_ty
       = do { (usages, grhss') <- (GenLocated EpAnnCO (GRHS GhcRn (LocatedA (body GhcRn)))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (UsageEnv,
           GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))))
    -> [GenLocated EpAnnCO (GRHS GhcRn (LocatedA (body GhcRn)))]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([UsageEnv],
          [GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc)))])
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> m (b, c)) -> [a] -> m ([b], [c])
    mapAndUnzipM ((GRHS GhcRn (LocatedA (body GhcRn))
     -> TcM (UsageEnv, GRHS GhcTc (LocatedA (body GhcTc))))
    -> GenLocated EpAnnCO (GRHS GhcRn (LocatedA (body GhcRn)))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (UsageEnv, GenLocated EpAnnCO (GRHS GhcTc (LocatedA (body GhcTc))))
    forall a b c ann.
    (a -> TcM (b, c))
    -> GenLocated (EpAnn ann) a -> TcM (b, GenLocated (EpAnn ann) c)
    wrapLocSndMA GRHS GhcRn (LocatedA (body GhcRn))
    -> TcM (UsageEnv, GRHS GhcTc (LocatedA (body GhcTc)))
    tc_alt) [LGRHS GhcRn (LocatedA (body GhcRn))]
    [GenLocated EpAnnCO (GRHS GhcRn (LocatedA (body GhcRn)))]
    grhss
            ; tcEmitBindingUsage $ supUEs usages
            ; return grhss' }
       where
         stmt_ctxt :: HsStmtContext (GenLocated SrcSpanAnnN Name)
    stmt_ctxt = HsMatchContext (GenLocated SrcSpanAnnN Name)
    -> HsStmtContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsMatchContext fn -> HsStmtContext fn
    PatGuard HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    ctxt

         tc_alt :: GRHS GhcRn (LocatedA (body GhcRn))
                -> TcM (UsageEnv, GRHS GhcTc (LocatedA (body GhcTc)))
         tc_alt :: GRHS GhcRn (LocatedA (body GhcRn))
    -> TcM (UsageEnv, GRHS GhcTc (LocatedA (body GhcTc)))
    tc_alt (GRHS XCGRHS GhcRn (LocatedA (body GhcRn))
    _ [GuardLStmt GhcRn]
    guards LocatedA (body GhcRn)
    rhs)
           = TcM (GRHS GhcTc (LocatedA (body GhcTc)))
    -> TcM (UsageEnv, GRHS GhcTc (LocatedA (body GhcTc)))
    forall a. TcM a -> TcM (UsageEnv, a)
    tcCollectingUsage (TcM (GRHS GhcTc (LocatedA (body GhcTc)))
     -> TcM (UsageEnv, GRHS GhcTc (LocatedA (body GhcTc))))
    -> TcM (GRHS GhcTc (LocatedA (body GhcTc)))
    -> TcM (UsageEnv, GRHS GhcTc (LocatedA (body GhcTc)))
    forall a b. (a -> b) -> a -> b
    $
             do  { (guards', rhs')
                       <- HsStmtContextRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    -> ExpRhoType
    -> (ExpRhoType -> TcM (LocatedA (body GhcTc)))
    -> TcM
         ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
          LocatedA (body GhcTc))
    forall (body :: * -> *) rho_type thing.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (LocatedA (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContextRn
    HsStmtContext (GenLocated SrcSpanAnnN Name)
    stmt_ctxt HsStmtContextRn
    -> Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> ExpRhoType
    -> (ExpRhoType -> TcM thing)
    -> TcM
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    TcStmtChecker HsExpr ExpRhoType
    tcGuardStmt [GuardLStmt GhcRn]
    [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    guards ExpRhoType
    res_ty ((ExpRhoType -> TcM (LocatedA (body GhcTc)))
     -> TcM
          ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
           LocatedA (body GhcTc)))
    -> (ExpRhoType -> TcM (LocatedA (body GhcTc)))
    -> TcM
         ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
          LocatedA (body GhcTc))
    forall a b. (a -> b) -> a -> b
    $
                          TcMatchAltChecker body
    tc_body LocatedA (body GhcRn)
    rhs
                 ; return (GRHS noAnn guards' rhs') }

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

    tcDoStmts :: HsDoFlavour
              -> LocatedL [LStmt GhcRn (LHsExpr GhcRn)]
              -> ExpRhoType
              -> TcM (HsExpr GhcTc)          -- Returns a HsDo
    tcDoStmts :: HsDoFlavour
    -> LocatedL [GuardLStmt GhcRn] -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcDoStmts HsDoFlavour
    ListComp (L SrcSpanAnnL
    l [GuardLStmt GhcRn]
    stmts) ExpRhoType
    res_ty
      = do  { res_ty <- ExpRhoType -> TcM Mult
    expTypeToType ExpRhoType
    res_ty
            ; (co, elt_ty) <- matchExpectedListTy res_ty
            ; let list_ty = Mult -> Mult
    mkListTy Mult
    elt_ty
            ; stmts' <- tcStmts (HsDoStmt ListComp) (tcLcStmt listTyCon) stmts
                                (mkCheckExpType elt_ty)
            ; return $ mkHsWrapCo co (HsDo list_ty ListComp (L l stmts')) }

    tcDoStmts doExpr :: HsDoFlavour
    doExpr@(DoExpr Maybe ModuleName
    _) ss :: LocatedL [GuardLStmt GhcRn]
    ss@(L SrcSpanAnnL
    l [GuardLStmt GhcRn]
    stmts) ExpRhoType
    res_ty
      = do  { isApplicativeDo <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.ApplicativeDo
            ; if isApplicativeDo
              then do { stmts' <- tcStmts (HsDoStmt doExpr) tcDoStmt stmts res_ty
                      ; res_ty <- readExpType res_ty
                      ; return (HsDo res_ty doExpr (L l stmts')) }
              else do { expanded_expr <- expandDoStmts doExpr stmts
                                                   -- Do expansion on the fly
                      ; mkExpandedExprTc (HsDo noExtField doExpr ss) <$> tcExpr (unLoc expanded_expr) res_ty }
            }

    tcDoStmts mDoExpr :: HsDoFlavour
    mDoExpr@(MDoExpr Maybe ModuleName
    _) ss :: LocatedL [GuardLStmt GhcRn]
    ss@(L SrcSpanAnnL
    _ [GuardLStmt GhcRn]
    stmts) ExpRhoType
    res_ty
      = do  { expanded_expr <- HsDoFlavour -> [GuardLStmt GhcRn] -> TcM (LHsExpr GhcRn)
    expandDoStmts HsDoFlavour
    mDoExpr [GuardLStmt GhcRn]
    stmts -- Do expansion on the fly
            ; mkExpandedExprTc (HsDo noExtField mDoExpr ss) <$> tcExpr (unLoc expanded_expr) res_ty  }

    tcDoStmts HsDoFlavour
    MonadComp (L SrcSpanAnnL
    l [GuardLStmt GhcRn]
    stmts) ExpRhoType
    res_ty
      = do  { stmts' <- HsStmtContextRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    -> ExpRhoType
    -> TcM [LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    forall (body :: * -> *) rho_type.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> TcM [LStmt GhcTc (LocatedA (body GhcTc))]
    tcStmts (HsDoFlavour -> HsStmtContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsDoFlavour -> HsStmtContext fn
    HsDoStmt HsDoFlavour
    MonadComp) HsStmtContextRn
    -> Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> ExpRhoType
    -> (ExpRhoType -> TcM thing)
    -> TcM
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    TcStmtChecker HsExpr ExpRhoType
    tcMcStmt [GuardLStmt GhcRn]
    [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    stmts ExpRhoType
    res_ty
            ; res_ty <- readExpType res_ty
            ; return (HsDo res_ty MonadComp (L l stmts')) }
    tcDoStmts ctxt :: HsDoFlavour
    ctxt@HsDoFlavour
    GhciStmtCtxt LocatedL [GuardLStmt GhcRn]
    _ ExpRhoType
    _ = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcDoStmts" (HsDoFlavour -> SDoc
    pprHsDoFlavour HsDoFlavour
    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)
    tcPolyLExpr LHsExpr GhcRn
    body ExpRhoType
    res_ty
            }

    tcBodyNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBodyNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBodyNC LHsExpr GhcRn
    body ExpRhoType
    res_ty
      = do  { String -> SDoc -> TcRn ()
    traceTc String
    "tcBodyNC" (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    res_ty)
            ; LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC 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. HsStmtContextRn
                    -> Stmt GhcRn (LocatedA (body GhcRn))
                    -> rho_type                 -- Result type for comprehension
                    -> (rho_type -> TcM thing)  -- Checker for what follows the stmt
                    -> TcM (Stmt GhcTc (LocatedA (body GhcTc)), thing)

    tcStmts :: (AnnoBody body) => HsStmtContextRn
            -> TcStmtChecker body rho_type   -- NB: higher-rank type
            -> [LStmt GhcRn (LocatedA (body GhcRn))]
            -> rho_type
            -> TcM [LStmt GhcTc (LocatedA (body GhcTc))]
    tcStmts :: forall (body :: * -> *) rho_type.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> TcM [LStmt GhcTc (LocatedA (body GhcTc))]
    tcStmts HsStmtContextRn
    ctxt TcStmtChecker body rho_type
    stmt_chk [LStmt GhcRn (LocatedA (body GhcRn))]
    stmts rho_type
    res_ty
      = do { (stmts', _) <- HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcRn ())
    -> TcM
         ([XRec GhcTc (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))], ())
    forall (body :: * -> *) rho_type thing.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (LocatedA (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContextRn
    ctxt HsStmtContextRn
    -> Stmt GhcRn (LocatedA (body GhcRn))
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)), thing)
    TcStmtChecker body rho_type
    stmt_chk [LStmt GhcRn (LocatedA (body GhcRn))]
    stmts rho_type
    res_ty ((rho_type -> TcRn ())
     -> TcM
          ([XRec GhcTc (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))], ()))
    -> (rho_type -> TcRn ())
    -> TcM
         ([XRec GhcTc (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))], ())
    forall a b. (a -> b) -> a -> b
    $
                            TcRn () -> rho_type -> TcRn ()
    forall a b. a -> b -> a
    const (() -> TcRn ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
           ; return stmts' }

    tcStmtsAndThen :: (AnnoBody body) => HsStmtContextRn
                   -> TcStmtChecker body rho_type    -- NB: higher-rank type
                   -> [LStmt GhcRn (LocatedA (body GhcRn))]
                   -> rho_type
                   -> (rho_type -> TcM thing)
                   -> TcM ([LStmt GhcTc (LocatedA (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.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (LocatedA (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContextRn
    _ TcStmtChecker body rho_type
    _ [] rho_type
    res_ty rho_type -> TcM thing
    thing_inside
      = do  { thing <- rho_type -> TcM thing
    thing_inside rho_type
    res_ty
            ; return ([], thing) }

    -- LetStmts are handled uniformly, regardless of context
    tcStmtsAndThen HsStmtContextRn
    ctxt TcStmtChecker body rho_type
    stmt_chk (L SrcSpanAnnA
    loc (LetStmt XLetStmt GhcRn GhcRn (LocatedA (body GhcRn))
    x HsLocalBinds GhcRn
    binds) : [LStmt GhcRn (LocatedA (body GhcRn))]
    stmts)
                                                                 rho_type
    res_ty rho_type -> TcM thing
    thing_inside
      = do  { (binds', _, (stmts',thing)) <- HsLocalBinds GhcRn
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([GenLocated
             SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
          thing)
    -> TcM
         (HsLocalBinds GhcTc, HsWrapper,
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    forall thing.
    HsLocalBinds GhcRn
    -> TcM thing -> TcM (HsLocalBinds GhcTc, HsWrapper, thing)
    tcLocalBinds HsLocalBinds GhcRn
    binds (IOEnv
       (Env TcGblEnv TcLclEnv)
       ([GenLocated
           SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
        thing)
     -> TcM
          (HsLocalBinds GhcTc, HsWrapper,
           ([GenLocated
               SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
            thing)))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([GenLocated
             SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
          thing)
    -> TcM
         (HsLocalBinds GhcTc, HsWrapper,
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    forall a b. (a -> b) -> a -> b
    $
                  HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([XRec GhcTc (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))], thing)
    forall (body :: * -> *) rho_type thing.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (LocatedA (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContextRn
    ctxt HsStmtContextRn
    -> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)), thing)
    TcStmtChecker body rho_type
    stmt_chk [LStmt GhcRn (LocatedA (body GhcRn))]
    stmts rho_type
    res_ty rho_type -> TcM thing
    thing_inside
            ; return (L loc (LetStmt x binds') : stmts', 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 HsStmtContextRn
    ctxt TcStmtChecker body rho_type
    stmt_chk (L SrcSpanAnnA
    loc StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
    stmt : [LStmt GhcRn (LocatedA (body GhcRn))]
    stmts) rho_type
    res_ty rho_type -> TcM thing
    thing_inside
      | ApplicativeStmt{} <- StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
    stmt
      = do  { (stmt', (stmts', thing)) <-
                 HsStmtContextRn
    -> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
    -> rho_type
    -> (rho_type
        -> IOEnv
             (Env TcGblEnv TcLclEnv)
             ([GenLocated
                 SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
              thing))
    -> TcM
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    TcStmtChecker body rho_type
    stmt_chk HsStmtContextRn
    ctxt StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
    stmt rho_type
    res_ty ((rho_type
      -> IOEnv
           (Env TcGblEnv TcLclEnv)
           ([GenLocated
               SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
            thing))
     -> TcM
          (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
           ([GenLocated
               SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
            thing)))
    -> (rho_type
        -> IOEnv
             (Env TcGblEnv TcLclEnv)
             ([GenLocated
                 SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
              thing))
    -> TcM
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    forall a b. (a -> b) -> a -> b
    $ \ rho_type
    res_ty' ->
                   HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([XRec GhcTc (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))], thing)
    forall (body :: * -> *) rho_type thing.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (LocatedA (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContextRn
    ctxt HsStmtContextRn
    -> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)), thing)
    TcStmtChecker body rho_type
    stmt_chk [LStmt GhcRn (LocatedA (body GhcRn))]
    stmts rho_type
    res_ty'  ((rho_type -> TcM thing)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          ([XRec GhcTc (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))], thing))
    -> (rho_type -> TcM thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([XRec GhcTc (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))], thing)
    forall a b. (a -> b) -> a -> b
    $
                     rho_type -> TcM thing
    thing_inside
            ; return (L loc stmt' : stmts', thing) }

      -- For the vanilla case, handle the location-setting part
      | Bool
    otherwise
      = do  { (stmt', (stmts', thing)) <-
                    SrcSpanAnnA
    -> TcM
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    -> TcM
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc                             (TcM
       (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
        ([GenLocated
            SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
         thing))
     -> TcM
          (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
           ([GenLocated
               SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
            thing)))
    -> TcM
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    -> TcM
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    forall a b. (a -> b) -> a -> b
    $
                    SDoc
    -> TcM
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    -> TcM
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (HsStmtContext (GenLocated SrcSpanAnnN Name)
    -> StmtLR GhcRn GhcRn (LocatedA (body GhcRn)) -> SDoc
    forall (idL :: Pass) (idR :: Pass) fn body.
    (OutputableBndrId idL, OutputableBndrId idR, Outputable fn,
     Outputable body,
     Anno (StmtLR (GhcPass idL) (GhcPass idR) body) ~ SrcSpanAnnA) =>
    HsStmtContext fn -> StmtLR (GhcPass idL) (GhcPass idR) body -> SDoc
    pprStmtInCtxt HsStmtContextRn
    HsStmtContext (GenLocated SrcSpanAnnN Name)
    ctxt StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
    stmt)        (TcM
       (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
        ([GenLocated
            SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
         thing))
     -> TcM
          (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
           ([GenLocated
               SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
            thing)))
    -> TcM
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    -> TcM
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    forall a b. (a -> b) -> a -> b
    $
                    HsStmtContextRn
    -> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
    -> rho_type
    -> (rho_type
        -> IOEnv
             (Env TcGblEnv TcLclEnv)
             ([GenLocated
                 SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
              thing))
    -> TcM
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    TcStmtChecker body rho_type
    stmt_chk HsStmtContextRn
    ctxt StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
    stmt rho_type
    res_ty                   ((rho_type
      -> IOEnv
           (Env TcGblEnv TcLclEnv)
           ([GenLocated
               SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
            thing))
     -> TcM
          (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
           ([GenLocated
               SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
            thing)))
    -> (rho_type
        -> IOEnv
             (Env TcGblEnv TcLclEnv)
             ([GenLocated
                 SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
              thing))
    -> TcM
         (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)),
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    forall a b. (a -> b) -> a -> b
    $ \ rho_type
    res_ty' ->
                    IOEnv
      (Env TcGblEnv TcLclEnv)
      ([GenLocated
          SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
       thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([GenLocated
             SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
          thing)
    forall a. TcM a -> TcM a
    popErrCtxt                                  (IOEnv
       (Env TcGblEnv TcLclEnv)
       ([GenLocated
           SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
        thing)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          ([GenLocated
              SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
           thing))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([GenLocated
             SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
          thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([GenLocated
             SrcSpanAnnA (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))],
          thing)
    forall a b. (a -> b) -> a -> b
    $
                    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([XRec GhcTc (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))], thing)
    forall (body :: * -> *) rho_type thing.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (LocatedA (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContextRn
    ctxt HsStmtContextRn
    -> StmtLR GhcRn GhcRn (LocatedA (body GhcRn))
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)), thing)
    TcStmtChecker body rho_type
    stmt_chk [LStmt GhcRn (LocatedA (body GhcRn))]
    stmts rho_type
    res_ty'  ((rho_type -> TcM thing)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          ([XRec GhcTc (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))], thing))
    -> (rho_type -> TcM thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([XRec GhcTc (StmtLR GhcTc GhcTc (LocatedA (body GhcTc)))], thing)
    forall a b. (a -> b) -> a -> b
    $
                    rho_type -> TcM thing
    thing_inside
            ; return (L loc stmt' : stmts', thing) }

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

    tcGuardStmt :: TcExprStmtChecker
    tcGuardStmt :: TcStmtChecker HsExpr ExpRhoType
    tcGuardStmt HsStmtContextRn
    _ (BodyStmt XBodyStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    _ GenLocated SrcSpanAnnA (HsExpr GhcRn)
    guard SyntaxExpr GhcRn
    _ SyntaxExpr GhcRn
    _) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do  { guard' <- Mult -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    ManyTy (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
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    guard Mult
    boolTy
              -- Scale the guard to Many (see #19120 and #19193)
            ; thing  <- thing_inside res_ty
            ; return (BodyStmt boolTy guard' noSyntaxExpr noSyntaxExpr, thing) }

    tcGuardStmt HsStmtContextRn
    ctxt (BindStmt XBindStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    _ LPat GhcRn
    pat GenLocated SrcSpanAnnA (HsExpr 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.
              (rhs', rhs_ty) <- Mult -> TcM (LHsExpr GhcTc, Mult) -> TcM (LHsExpr GhcTc, Mult)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    ManyTy (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
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    rhs
                                       -- Stmt has a context already
            ; hasFixedRuntimeRep_syntactic FRRBindStmtGuard rhs_ty
            ; (pat', thing)  <- tcCheckPat_O (StmtCtxt ctxt) (lexprCtOrigin rhs)
                                             pat (unrestricted rhs_ty) $
                                thing_inside res_ty
            ; return (mkTcBindStmt pat' rhs', thing) }

    tcGuardStmt HsStmtContextRn
    _ Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    stmt ExpRhoType
    _ ExpRhoType -> TcM thing
    _
      = String
    -> SDoc
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcGuardStmt: unexpected Stmt" (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr 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

    {-
    Note [Binding in list comprehension isn't linear]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In principle, [ y | () <- xs, y <- [0,1]] could be linear in `xs`.
    But, the way the desugaring works, we get something like

    case xs of
      () : xs ' -> letrec next_stmt = … xs' …

    In the current typing rules for letrec in Core, next_stmt is necessarily of
    multiplicity Many and so is every free variable, including xs'. Which, in turns,
    requires xs to be of multiplicity Many.

    Rodrigo Mesquita worked out, in his master thesis, how to make letrecs having
    non-Many multiplicities. But it's a fair bit of work to implement.

    Since nobody actually cares about [ y | () <- xs, y <- [0,1]] being linear, then
    we just conservatively make it unrestricted instead.

    If we're to change that, we have to be careful that [ y | _ <- xs, y <- [0,1]]
    isn't linear in `xs` since the elements of `xs` are ignored. So we'd still have
    to call `tcScalingUsage` on `xs` in `tcLcStmt`, we'd just have to create a fresh
    multiplicity variable. We'd also use the same multiplicity variable in the call
    to `tcCheckPat` instead of `unrestricted`.
    -}

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

    tcLcStmt :: TyCon -> TcStmtChecker HsExpr ExpRhoType
    tcLcStmt TyCon
    _ HsStmtContextRn
    _ (LastStmt XLastStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    x GenLocated SrcSpanAnnA (HsExpr GhcRn)
    body Maybe Bool
    noret SyntaxExpr GhcRn
    _) ExpRhoType
    elt_ty ExpRhoType -> TcM thing
    thing_inside
      = do { body' <- LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC LHsExpr GhcRn
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    body ExpRhoType
    elt_ty
           ; thing <- thing_inside (panic "tcLcStmt: thing_inside")
           ; return (LastStmt x body' noret noSyntaxExpr, thing) }

    -- A generator, pat <- rhs
    tcLcStmt TyCon
    m_tc HsStmtContextRn
    ctxt (BindStmt XBindStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    _ LPat GhcRn
    pat GenLocated SrcSpanAnnA (HsExpr GhcRn)
    rhs) ExpRhoType
    elt_ty ExpRhoType -> TcM thing
    thing_inside
     = do   { pat_ty <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    liftedTypeKind
              -- About the next `tcScalingUsage ManyTy` and unrestricted
              -- see Note [Binding in list comprehension isn't linear]
            ; rhs'   <- tcScalingUsage ManyTy $ tcCheckMonoExpr rhs (mkTyConApp m_tc [pat_ty])
            ; (pat', thing)  <- tcCheckPat (StmtCtxt ctxt) pat (unrestricted pat_ty) $
                                tcScalingUsage ManyTy $
                                thing_inside elt_ty
            ; return (mkTcBindStmt pat' rhs', thing) }

    -- A boolean guard
    tcLcStmt TyCon
    _ HsStmtContextRn
    _ (BodyStmt XBodyStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    _ GenLocated SrcSpanAnnA (HsExpr GhcRn)
    rhs SyntaxExpr GhcRn
    _ SyntaxExpr GhcRn
    _) ExpRhoType
    elt_ty ExpRhoType -> TcM thing
    thing_inside
      = do  { rhs'  <- LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    rhs Mult
    boolTy
            ; thing <- tcScalingUsage ManyTy $ thing_inside elt_ty
            ; return (BodyStmt boolTy rhs' noSyntaxExpr noSyntaxExpr, thing) }

    -- ParStmt: See notes with tcMcStmt and Note [Scoping in parallel list comprehensions]
    tcLcStmt TyCon
    m_tc HsStmtContextRn
    ctxt (ParStmt XParStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    _ [ParStmtBlock GhcRn GhcRn]
    bndr_stmts_s HsExpr GhcRn
    _ SyntaxExpr GhcRn
    _) ExpRhoType
    elt_ty ExpRhoType -> TcM thing
    thing_inside
      = Mult
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    ManyTy (IOEnv
       (Env TcGblEnv TcLclEnv)
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)),
           thing))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    forall a b. (a -> b) -> a -> b
    $ -- parallel list comprehension never desugars to something linear.
        do  { env <- RnM LocalRdrEnv
    getLocalRdrEnv
            ; (pairs', thing) <- loop env [] bndr_stmts_s
            ; return (ParStmt unitTy pairs' noExpr noSyntaxExpr, thing) }
      where
        -- loop :: LocalRdrEnv -- The original LocalRdrEnv
        --      -> [Name]      -- Variables bound by earlier branches
        --      -> [([LStmt GhcRn], [GhcRn])]
        --      -> TcM ([([LStmt GhcTc], [GhcTc])], thing)
        --
        -- Invariant: on entry to `loop`, the LocalRdrEnv is set to
        --            origEnv, the LocalRdrEnv for the entire comprehension
        loop :: LocalRdrEnv
    -> [Name]
    -> [ParStmtBlock GhcRn GhcRn]
    -> RnM ([ParStmtBlock GhcTc GhcTc], thing)
    loop LocalRdrEnv
    _ [Name]
    allBinds [] = do { thing <- [Name] -> TcM thing -> TcM thing
    forall a. [Name] -> RnM a -> RnM a
    bindLocalNames [Name]
    allBinds (TcM thing -> TcM thing) -> TcM thing -> TcM thing
    forall a b. (a -> b) -> a -> b
    $ ExpRhoType -> TcM thing
    thing_inside ExpRhoType
    elt_ty
                                ; return ([], thing) }   -- matching in the branches

        loop LocalRdrEnv
    origEnv [Name]
    priorBinds (ParStmtBlock XParStmtBlock GhcRn GhcRn
    x [GuardLStmt GhcRn]
    stmts [IdP GhcRn]
    names SyntaxExpr GhcRn
    _ : [ParStmtBlock GhcRn GhcRn]
    pairs)
          = do { (stmts', (ids, pairs', thing))
                    <- HsStmtContextRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    -> ExpRhoType
    -> (ExpRhoType -> TcM ([Id], [ParStmtBlock GhcTc GhcTc], thing))
    -> TcM
         ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
          ([Id], [ParStmtBlock GhcTc GhcTc], thing))
    forall (body :: * -> *) rho_type thing.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (LocatedA (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContextRn
    ctxt (TyCon -> TcStmtChecker HsExpr ExpRhoType
    tcLcStmt TyCon
    m_tc) [GuardLStmt GhcRn]
    [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    stmts ExpRhoType
    elt_ty ((ExpRhoType -> TcM ([Id], [ParStmtBlock GhcTc GhcTc], thing))
     -> TcM
          ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
           ([Id], [ParStmtBlock GhcTc GhcTc], thing)))
    -> (ExpRhoType -> TcM ([Id], [ParStmtBlock GhcTc GhcTc], thing))
    -> TcM
         ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
          ([Id], [ParStmtBlock GhcTc GhcTc], thing))
    forall a b. (a -> b) -> a -> b
    $ \ ExpRhoType
    _elt_ty' ->
                       do { ids <- [Name] -> TcM [Id]
    tcLookupLocalIds [IdP GhcRn]
    [Name]
    names
                          ; (pairs', thing) <- setLocalRdrEnv origEnv $
                              loop origEnv (names ++ priorBinds) pairs
                          ; return (ids, pairs', thing) }
               ; return ( ParStmtBlock x stmts' ids noSyntaxExpr : pairs', thing ) }

    tcLcStmt TyCon
    m_tc HsStmtContextRn
    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
      = Mult
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    ManyTy (IOEnv
       (Env TcGblEnv TcLclEnv)
       (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)),
           thing))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    forall a b. (a -> b) -> a -> b
    $ -- Transform statements are too complex: just make everything multiplicity Many
        do { let ([Name]
    bndr_names, [Name]
    n_bndr_names) = [(Name, Name)] -> ([Name], [Name])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(IdP GhcRn, IdP GhcRn)]
    [(Name, Name)]
    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 [(IdP GhcRn, IdP GhcRn)]
    [(Name, Name)]
    bindersMap)
                 -- The inner 'stmts' lack a LastStmt, so the element type
                 --  passed in to tcStmtsAndThen is never looked at
           ; (stmts', (bndr_ids, by'))
                <- HsStmtContextRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    -> ExpRhoType
    -> (ExpRhoType
        -> TcM ([Id], Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult)))
    -> TcM
         ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
          ([Id], Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult)))
    forall (body :: * -> *) rho_type thing.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (LocatedA (body GhcTc))], thing)
    tcStmtsAndThen (HsStmtContext (GenLocated SrcSpanAnnN Name)
    -> HsStmtContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsStmtContext fn -> HsStmtContext fn
    TransStmtCtxt HsStmtContextRn
    HsStmtContext (GenLocated SrcSpanAnnN Name)
    ctxt) (TyCon -> TcStmtChecker HsExpr ExpRhoType
    tcLcStmt TyCon
    m_tc) [GuardLStmt GhcRn]
    [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    stmts ExpRhoType
    unused_ty ((ExpRhoType
      -> TcM ([Id], Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult)))
     -> TcM
          ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
           ([Id], Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult))))
    -> (ExpRhoType
        -> TcM ([Id], Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult)))
    -> TcM
         ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
          ([Id], Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult)))
    forall a b. (a -> b) -> a -> b
    $ \ExpRhoType
    _ -> do
                   { by' <- (GenLocated SrcSpanAnnA (HsExpr GhcRn)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult))
    -> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult))
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Maybe a -> f (Maybe b)
    traverse LHsExpr GhcRn -> TcM (LHsExpr GhcTc, Mult)
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult)
    tcInferRho Maybe (LHsExpr GhcRn)
    Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    by
                   ; bndr_ids <- tcLookupLocalIds bndr_names
                   ; return (bndr_ids, by') }

           ; let 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 = 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 = case Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult)
    by' of
                              Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult)
    Nothing       -> \Mult
    ty -> Mult
    ty
                              Just (GenLocated SrcSpanAnnA (HsExpr GhcTc)
    _,Mult
    e_ty) -> \Mult
    ty -> (Mult
    alphaTy HasDebugCallStack => Mult -> Mult -> Mult
    Mult -> Mult -> Mult
    `mkVisFunTyMany` Mult
    e_ty) HasDebugCallStack => Mult -> Mult -> Mult
    Mult -> Mult -> Mult
    `mkVisFunTyMany` Mult
    ty

                 tup_ty        = [Id] -> Mult
    HasDebugCallStack => [Id] -> Mult
    mkBigCoreVarTupTy [Id]
    bndr_ids
                 poly_arg_ty   = Mult -> Mult
    m_app Mult
    alphaTy
                 poly_res_ty   = Mult -> Mult
    m_app (Mult -> Mult
    n_app Mult
    alphaTy)
                 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 HasDebugCallStack => Mult -> Mult -> Mult
    Mult -> Mult -> Mult
    `mkVisFunTyMany` Mult
    poly_res_ty

           ; using' <- tcCheckPolyExpr using using_poly_ty
           ; let final_using = (HsExpr GhcTc -> HsExpr GhcTc)
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a b.
    (a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
    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)) GenLocated SrcSpanAnnA (HsExpr 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
    n_bndr_name Id
    bndr_id = HasDebugCallStack => Name -> Mult -> Mult -> Id
    Name -> Mult -> Mult -> Id
    mkLocalId Name
    n_bndr_name Mult
    ManyTy (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 [TransStmt binder map] in GHC.Hs.Expr
                 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]
    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 <- tcExtendIdEnv n_bndr_ids (thing_inside elt_ty)

           ; return (TransStmt { trS_stmts = stmts', trS_bndrs = bindersMap'
                               , trS_by = fmap fst by', trS_using = final_using
                               , trS_ret = noSyntaxExpr
                               , trS_bind = noSyntaxExpr
                               , trS_fmap = noExpr
                               , trS_ext = unitTy
                               , trS_form = form }, thing) }

    tcLcStmt TyCon
    _ HsStmtContextRn
    _ Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    stmt ExpRhoType
    _ ExpRhoType -> TcM thing
    _
      = String
    -> SDoc
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcLcStmt: unexpected Stmt" (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    stmt)

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

    tcMcStmt :: TcExprStmtChecker

    tcMcStmt :: TcStmtChecker HsExpr ExpRhoType
    tcMcStmt HsStmtContextRn
    _ (LastStmt XLastStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    x GenLocated SrcSpanAnnA (HsExpr GhcRn)
    body Maybe Bool
    noret SyntaxExpr GhcRn
    return_op) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do  { (body', return_op')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult]
        -> [Mult]
        -> IOEnv
             (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> TcM (GenLocated SrcSpanAnnA (HsExpr 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]
      -> IOEnv
           (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
     -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc), SyntaxExprTc))
    -> ([Mult]
        -> [Mult]
        -> IOEnv
             (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> TcM (GenLocated SrcSpanAnnA (HsExpr 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
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    body Mult
    a_ty
            ; thing      <- thing_inside (panic "tcMcStmt: thing_inside")
            ; return (LastStmt x body' noret return_op', thing) }

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

    tcMcStmt HsStmtContextRn
    ctxt (BindStmt XBindStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    xbsrn LPat GhcRn
    pat GenLocated SrcSpanAnnA (HsExpr GhcRn)
    rhs) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
               -- (>>=) :: rhs_ty -> (pat_ty -> new_res_ty) -> res_ty
      = do  { ((rhs_ty, rhs', pat_mult, pat', thing, new_res_ty), bind_op')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult]
        -> [Mult]
        -> TcM
             (Mult, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult,
              GenLocated SrcSpanAnnA (Pat GhcTc), thing, Mult))
    -> TcM
         ((Mult, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult,
           GenLocated SrcSpanAnnA (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 (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    XBindStmtRn
    xbsrn)
                              [SyntaxOpType
    SynRho, SyntaxOpType -> SyntaxOpType -> SyntaxOpType
    SynFun SyntaxOpType
    SynAny SyntaxOpType
    SynRho] ExpRhoType
    res_ty (([Mult]
      -> [Mult]
      -> TcM
           (Mult, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult,
            GenLocated SrcSpanAnnA (Pat GhcTc), thing, Mult))
     -> TcM
          ((Mult, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult,
            GenLocated SrcSpanAnnA (Pat GhcTc), thing, Mult),
           SyntaxExprTc))
    -> ([Mult]
        -> [Mult]
        -> TcM
             (Mult, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult,
              GenLocated SrcSpanAnnA (Pat GhcTc), thing, Mult))
    -> TcM
         ((Mult, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult,
           GenLocated SrcSpanAnnA (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 { 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
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    rhs Mult
    rhs_ty
                      ; (pat', thing) <- tcScalingUsage fun_mult $ tcCheckPat (StmtCtxt ctxt) pat (Scaled pat_mult pat_ty) $
                                         thing_inside (mkCheckExpType new_res_ty)
                      ; return (rhs_ty, rhs', pat_mult, pat', thing, new_res_ty) }

            ; hasFixedRuntimeRep_syntactic (FRRBindStmt MonadComprehension) rhs_ty

            -- If (but only if) the pattern can fail, typecheck the 'fail' operator
            ; fail_op' <- fmap join . forM (xbsrn_failOp xbsrn) $ \SyntaxExprRn
    fail ->
                CtOrigin
    -> LPat GhcTc
    -> SyntaxExpr GhcRn
    -> Mult
    -> TcRn (FailOperator GhcTc)
    tcMonadFailOp (LPat GhcRn -> CtOrigin
    MCompPatOrigin LPat GhcRn
    pat) LPat GhcTc
    GenLocated SrcSpanAnnA (Pat GhcTc)
    pat' SyntaxExpr GhcRn
    SyntaxExprRn
    fail Mult
    new_res_ty

            ; let xbstc = 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'
                    }
            ; return (BindStmt xbstc pat' rhs', thing) }

    -- Boolean expressions.
    --
    --   [ body | stmts, expr ]  ->  expr :: m Bool
    --
    tcMcStmt HsStmtContextRn
    _ (BodyStmt XBodyStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    _ GenLocated SrcSpanAnnA (HsExpr 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, rhs', rhs_ty, new_res_ty, test_ty, guard_op'), then_op')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult]
        -> [Mult]
        -> TcM
             (thing, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult, Mult, Mult,
              SyntaxExprTc))
    -> TcM
         ((thing, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult, Mult, 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, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult, Mult, Mult,
            SyntaxExprTc))
     -> TcM
          ((thing, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult, Mult, Mult,
            SyntaxExprTc),
           SyntaxExprTc))
    -> ([Mult]
        -> [Mult]
        -> TcM
             (thing, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult, Mult, Mult,
              SyntaxExprTc))
    -> TcM
         ((thing, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult, Mult, Mult,
           SyntaxExprTc),
          SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                   \ [Mult
    rhs_ty, Mult
    new_res_ty] [Mult
    rhs_mult, Mult
    fun_mult] ->
                   do { ((rhs', test_ty), guard_op')
                          <- Mult
    -> TcM
         ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult), SyntaxExprTc)
    -> TcM
         ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult), SyntaxExprTc)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    rhs_mult (TcM ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult), SyntaxExprTc)
     -> TcM
          ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult), SyntaxExprTc))
    -> TcM
         ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult), SyntaxExprTc)
    -> TcM
         ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                             CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult]
        -> [Mult]
        -> IOEnv
             (Env TcGblEnv TcLclEnv)
             (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult))
    -> TcM
         ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult), 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]
      -> IOEnv
           (Env TcGblEnv TcLclEnv)
           (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult))
     -> TcM
          ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult), SyntaxExprTc))
    -> ([Mult]
        -> [Mult]
        -> IOEnv
             (Env TcGblEnv TcLclEnv)
             (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult))
    -> TcM
         ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                             \ [Mult
    test_ty] [Mult
    test_mult] -> do
                               rhs' <- 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
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    rhs Mult
    test_ty
                               return $ (rhs', test_ty)
                      ; thing <- tcScalingUsage fun_mult $ thing_inside (mkCheckExpType new_res_ty)
                      ; return (thing, rhs', rhs_ty, new_res_ty, test_ty, guard_op') }

            ; hasFixedRuntimeRep_syntactic FRRBodyStmtGuard test_ty
            ; hasFixedRuntimeRep_syntactic (FRRBodyStmt MonadComprehension 1) rhs_ty
            ; hasFixedRuntimeRep_syntactic (FRRBodyStmt MonadComprehension 2) new_res_ty

            ; return (BodyStmt rhs_ty rhs' then_op' guard_op', 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 HsStmtContextRn
    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 { m1_ty   <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    typeToTypeKind
           ; m2_ty   <- newFlexiTyVarTy typeToTypeKind
           ; tup_ty  <- newFlexiTyVarTy liftedTypeKind
           ; by_e_ty <- newFlexiTyVarTy liftedTypeKind  -- The type of the 'by' expression (if any)

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

                 poly_arg_ty  = Mult
    m1_ty Mult -> Mult -> Mult
    `mkAppTy` Mult
    alphaTy
                 using_arg_ty = Mult
    m1_ty Mult -> Mult -> Mult
    `mkAppTy` Mult
    tup_ty
                 poly_res_ty  = Mult
    m2_ty Mult -> Mult -> Mult
    `mkAppTy` Mult -> Mult
    n_app Mult
    alphaTy
                 using_res_ty = Mult
    m2_ty Mult -> Mult -> Mult
    `mkAppTy` Mult -> Mult
    n_app Mult
    tup_ty
                 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 HasDebugCallStack => Mult -> Mult -> Mult
    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 (bndr_names, n_bndr_names) = unzip bindersMap
           ; (stmts', (bndr_ids, by', return_op')) <-
                tcStmtsAndThen (TransStmtCtxt ctxt) tcMcStmt stmts
                               (mkCheckExpType using_arg_ty) $ \ExpRhoType
    res_ty' -> do
                    { by' <- case Maybe (LHsExpr GhcRn)
    by of
                               Maybe (LHsExpr GhcRn)
    Nothing -> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall a. Maybe a
    Nothing
                               Just LHsExpr GhcRn
    e  -> do { e' <- LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    e Mult
    by_e_ty
                                             ; return (Just e') }

                    -- Find the Ids (and hence types) of all old binders
                    ; bndr_ids <- tcLookupLocalIds bndr_names

                    -- 'return' is only used for the binders, so we know its type.
                    --   return :: (a,b,c,..) -> m (a,b,c,..)
                    ; (_, return_op') <- tcSyntaxOp MCompOrigin return_op
                                           [synKnownType (mkBigCoreVarTupTy bndr_ids)]
                                           res_ty' $ \ [Mult]
    _ [Mult]
    _ -> () -> TcRn ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

                    ; return (bndr_ids, by', return_op') }

           --------------- Typecheck the 'bind' function -------------
           -- (>>=) :: m2 (n (a,b,c)) -> ( n (a,b,c) -> new_res_ty ) -> res_ty
           ; new_res_ty <- newFlexiTyVarTy liftedTypeKind
           ; (_, bind_op')  <- tcSyntaxOp MCompOrigin bind_op
                                 [ synKnownType using_res_ty
                                 , synKnownType (n_app tup_ty `mkVisFunTyMany` new_res_ty) ]
                                 res_ty $ \ [Mult]
    _ [Mult]
    _ -> () -> TcRn ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

           --------------- Typecheck the 'fmap' function -------------
           ; fmap_op' <- case form of
                           TransForm
    ThenForm -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    forall (p :: Pass). HsExpr (GhcPass p)
    noExpr
                           TransForm
    _ -> (GenLocated SrcSpanAnnA (HsExpr GhcTc) -> HsExpr GhcTc)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc)
    forall a b.
    (a -> b)
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap GenLocated SrcSpanAnnA (HsExpr GhcTc) -> HsExpr GhcTc
    forall l e. GenLocated l e -> e
    unLoc (IOEnv
       (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
     -> TcM (HsExpr GhcTc))
    -> (Mult
        -> IOEnv
             (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> Mult
    -> TcM (HsExpr GhcTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr (HsExpr GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
    forall e a. HasAnnotation e => a -> GenLocated e a
    noLocA 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 HasDebugCallStack => Mult -> Mult -> Mult
    Mult -> Mult -> Mult
    `mkVisFunTyMany` Mult
    betaTy)
                                HasDebugCallStack => Mult -> Mult -> Mult
    Mult -> Mult -> Mult
    `mkVisFunTyMany` (Mult -> Mult
    n_app Mult
    alphaTy)
                                HasDebugCallStack => Mult -> Mult -> Mult
    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))

           ; using' <- tcCheckPolyExpr using using_poly_ty
           ; let final_using = (HsExpr GhcTc -> HsExpr GhcTc)
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a b.
    (a -> b) -> GenLocated SrcSpanAnnA a -> GenLocated SrcSpanAnnA b
    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)) GenLocated SrcSpanAnnA (HsExpr GhcTc)
    using'

           --------------- Building the bindersMap ----------------
           ; let mk_n_bndr :: Name -> TcId -> TcId
                 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
    ManyTy (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 [TransStmt binder map] in GHC.Hs.Expr
                 n_bndr_ids = String -> (Name -> Id -> Id) -> [Name] -> [Id] -> [Id]
    forall a b c.
    HasDebugCallStack =>
    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]
    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 <- tcExtendIdEnv n_bndr_ids $
                      thing_inside (mkCheckExpType new_res_ty)

           ; return (TransStmt { trS_stmts = stmts', trS_bndrs = bindersMap'
                               , trS_by = by', trS_using = final_using
                               , trS_ret = return_op', trS_bind = bind_op'
                               , trS_ext = n_app tup_ty
                               , trS_fmap = fmap_op', trS_form = form }, 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 HsStmtContextRn
    ctxt (ParStmt XParStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    _ [ParStmtBlock GhcRn GhcRn]
    bndr_stmts_s HsExpr GhcRn
    mzip_op SyntaxExpr GhcRn
    bind_op) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do { m_ty   <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    typeToTypeKind

           ; let 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)
                            HasDebugCallStack => Mult -> Mult -> Mult
    Mult -> Mult -> Mult
    `mkVisFunTyMany`
                            (Mult
    m_ty Mult -> Mult -> Mult
    `mkAppTy` Mult
    betaTy)
                            HasDebugCallStack => Mult -> Mult -> Mult
    Mult -> Mult -> Mult
    `mkVisFunTyMany`
                            (Mult
    m_ty Mult -> Mult -> Mult
    `mkAppTy` [Mult] -> Mult
    mkBoxedTupleTy [Mult
    alphaTy, Mult
    betaTy])
           ; mzip_op' <- unLoc `fmap` tcCheckPolyExpr (noLocA mzip_op) mzip_ty

            -- type dummies since we don't know all binder types yet
           ; id_tys_s <- (mapM . mapM) (const (newFlexiTyVarTy liftedTypeKind))
                           [ names | ParStmtBlock _ _ names _ <- bndr_stmts_s ]

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

           ; (((blocks', thing), inner_res_ty), bind_op')
               <- tcSyntaxOp MCompOrigin bind_op
                             [ synKnownType (m_ty `mkAppTy` tuple_ty)
                             , SynFun (synKnownType tuple_ty) SynRho ] res_ty $
                  \ [Mult
    inner_res_ty] [Mult]
    _ ->
                  do { 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
                     ; return (stuff, inner_res_ty) }

           ; return (ParStmt inner_res_ty blocks' mzip_op' bind_op', thing) }

      where
        mk_tuple_ty :: t Mult -> Mult
    mk_tuple_ty t Mult
    tys = (Mult -> Mult -> Mult) -> t Mult -> Mult
    forall a. (a -> a -> a) -> t a -> a
    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 <- ExpRhoType -> TcM thing
    thing_inside ExpRhoType
    inner_res_ty
                                       ; return ([], 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
               ; (stmts', (ids, return_op', pairs', thing))
                    <- HsStmtContextRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    -> ExpRhoType
    -> (ExpRhoType
        -> TcM ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing))
    -> TcM
         ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
          ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing))
    forall (body :: * -> *) rho_type thing.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (LocatedA (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContextRn
    ctxt HsStmtContextRn
    -> Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> ExpRhoType
    -> (ExpRhoType -> TcM thing)
    -> TcM
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    TcStmtChecker HsExpr ExpRhoType
    tcMcStmt [GuardLStmt GhcRn]
    [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    stmts (Mult -> ExpRhoType
    mkCheckExpType Mult
    m_tup_ty) ((ExpRhoType
      -> TcM ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing))
     -> TcM
          ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
           ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing)))
    -> (ExpRhoType
        -> TcM ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing))
    -> TcM
         ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
          ([Id], SyntaxExprTc, [ParStmtBlock GhcTc GhcTc], thing))
    forall a b. (a -> b) -> a -> b
    $
                       \ExpRhoType
    m_tup_ty' ->
                       do { ids <- [Name] -> TcM [Id]
    tcLookupLocalIds [IdP GhcRn]
    [Name]
    names
                          ; let tup_ty = [Id] -> Mult
    HasDebugCallStack => [Id] -> Mult
    mkBigCoreVarTupTy [Id]
    ids
                          ; (_, return_op') <-
                              tcSyntaxOp MCompOrigin return_op
                                         [synKnownType tup_ty] m_tup_ty' $
                                         \ [Mult]
    _ [Mult]
    _ -> () -> TcRn ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                          ; (pairs', thing) <- loop m_ty inner_res_ty tup_tys_in pairs
                          ; return (ids, return_op', pairs', thing) }
               ; return (ParStmtBlock x stmts' ids return_op' : pairs', thing) }
        loop Mult
    _ ExpRhoType
    _ [Mult]
    _ [ParStmtBlock GhcRn GhcRn]
    _ = String
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([ParStmtBlock GhcTc GhcTc], thing)
    forall a. HasCallStack => String -> a
    panic String
    "tcMcStmt.loop"

    tcMcStmt HsStmtContextRn
    _ Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    stmt ExpRhoType
    _ ExpRhoType -> TcM thing
    _
      = String
    -> SDoc
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcMcStmt: unexpected Stmt" (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    stmt)

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

    tcDoStmt :: TcExprStmtChecker

    tcDoStmt :: TcStmtChecker HsExpr ExpRhoType
    tcDoStmt HsStmtContextRn
    _ (LastStmt XLastStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    x GenLocated SrcSpanAnnA (HsExpr GhcRn)
    body Maybe Bool
    noret SyntaxExpr GhcRn
    _) ExpRhoType
    res_ty ExpRhoType -> TcM thing
    thing_inside
      = do { body' <- LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC LHsExpr GhcRn
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    body ExpRhoType
    res_ty
           ; thing <- thing_inside (panic "tcDoStmt: thing_inside")
           ; return (LastStmt x body' noret noSyntaxExpr, thing) }
    tcDoStmt HsStmtContextRn
    ctxt (BindStmt XBindStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    xbsrn LPat GhcRn
    pat GenLocated SrcSpanAnnA (HsExpr 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

              ((rhs_ty, rhs', pat_mult, pat', new_res_ty, thing), bind_op')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult]
        -> [Mult]
        -> TcM
             (Mult, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult,
              GenLocated SrcSpanAnnA (Pat GhcTc), Mult, thing))
    -> TcM
         ((Mult, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult,
           GenLocated SrcSpanAnnA (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 (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    XBindStmtRn
    xbsrn) [SyntaxOpType
    SynRho, SyntaxOpType -> SyntaxOpType -> SyntaxOpType
    SynFun SyntaxOpType
    SynAny SyntaxOpType
    SynRho] ExpRhoType
    res_ty (([Mult]
      -> [Mult]
      -> TcM
           (Mult, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult,
            GenLocated SrcSpanAnnA (Pat GhcTc), Mult, thing))
     -> TcM
          ((Mult, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult,
            GenLocated SrcSpanAnnA (Pat GhcTc), Mult, thing),
           SyntaxExprTc))
    -> ([Mult]
        -> [Mult]
        -> TcM
             (Mult, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult,
              GenLocated SrcSpanAnnA (Pat GhcTc), Mult, thing))
    -> TcM
         ((Mult, GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult,
           GenLocated SrcSpanAnnA (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 { 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
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    rhs Mult
    rhs_ty
                       ; (pat', thing) <- tcScalingUsage fun_mult $ tcCheckPat (StmtCtxt ctxt) pat (Scaled pat_mult pat_ty) $
                                          thing_inside (mkCheckExpType new_res_ty)
                       ; return (rhs_ty, rhs', pat_mult, pat', new_res_ty, thing) }

            ; hasFixedRuntimeRep_syntactic (FRRBindStmt DoNotation) rhs_ty

            -- If (but only if) the pattern can fail, typecheck the 'fail' operator
            ; fail_op' <- fmap join . forM (xbsrn_failOp xbsrn) $ \SyntaxExprRn
    fail ->
                CtOrigin
    -> LPat GhcTc
    -> SyntaxExpr GhcRn
    -> Mult
    -> TcRn (FailOperator GhcTc)
    tcMonadFailOp (LPat GhcRn -> CtOrigin
    DoPatOrigin LPat GhcRn
    pat) LPat GhcTc
    GenLocated SrcSpanAnnA (Pat GhcTc)
    pat' SyntaxExpr GhcRn
    SyntaxExprRn
    fail Mult
    new_res_ty
            ; let xbstc = 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'
                    }
            ; return (BindStmt xbstc pat' rhs', thing) }

    tcDoStmt HsStmtContextRn
    ctxt (ApplicativeStmt XApplicativeStmt
      GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr 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 = HsStmtContextRn
    -> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    -> ExpRhoType
    -> (Mult -> TcM thing)
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, thing)
    forall t.
    HsStmtContextRn
    -> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    -> ExpRhoType
    -> (Mult -> TcM t)
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, t)
    tcApplicativeStmts HsStmtContextRn
    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
            ; ((pairs', body_ty, thing), 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 b c d. (b -> c) -> (d, b) -> (d, c)
    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
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, thing)
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, thing)
    forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    rhs_mult (TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, thing)
     -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, thing))
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, thing)
    -> TcM ([(SyntaxExpr GhcTc, 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))

            ; return (ApplicativeStmt body_ty pairs' mb_join', thing) }
    tcDoStmt HsStmtContextRn
    _ (BodyStmt XBodyStmt GhcRn GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    _ GenLocated SrcSpanAnnA (HsExpr 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
            ; ((rhs', rhs_ty, new_res_ty, thing), then_op')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Mult]
        -> [Mult]
        -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult, Mult, thing))
    -> TcM
         ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult, 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 (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult, Mult, thing))
     -> TcM
          ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult, Mult, thing),
           SyntaxExprTc))
    -> ([Mult]
        -> [Mult]
        -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult, Mult, thing))
    -> TcM
         ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Mult, Mult, thing),
          SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                   \ [Mult
    rhs_ty, Mult
    new_res_ty] [Mult
    rhs_mult,Mult
    fun_mult] ->
                   do { 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
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
    rhs Mult
    rhs_ty
                      ; thing <- tcScalingUsage fun_mult $ thing_inside (mkCheckExpType new_res_ty)
                      ; return (rhs', rhs_ty, new_res_ty, thing) }
            ; hasFixedRuntimeRep_syntactic (FRRBodyStmt DoNotation 1) rhs_ty
            ; hasFixedRuntimeRep_syntactic (FRRBodyStmt DoNotation 2) new_res_ty
            ; return (BodyStmt rhs_ty rhs' then_op' noSyntaxExpr, thing) }
    tcDoStmt HsStmtContextRn
    ctxt (RecStmt { recS_stmts :: forall idL idR body.
    StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
    recS_stmts = L SrcSpanAnnL
    l [GenLocated
       SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr 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 = [IdP GhcRn]
    [Name]
    rec_names [Name] -> [Name] -> [Name]
    forall a. [a] -> [a] -> [a]
    ++ (Name -> Bool) -> [Name] -> [Name]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (IdP GhcRn -> [IdP GhcRn] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [IdP GhcRn]
    rec_names) [IdP GhcRn]
    [Name]
    later_names
            ; tup_elt_tys <- VisArity -> Mult -> IOEnv (Env TcGblEnv TcLclEnv) [Mult]
    newFlexiTyVarTys ([Name] -> VisArity
    forall a. [a] -> VisArity
    forall (t :: * -> *) a. Foldable t => t a -> VisArity
    length [Name]
    tup_names) Mult
    liftedTypeKind
            ; let 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
    ManyTy Mult
    t) [Name]
    tup_names [Mult]
    tup_elt_tys
                    -- Many because it's a recursive definition
                  tup_ty  = [Mult] -> Mult
    HasDebugCallStack => [Mult] -> Mult
    mkBigCoreTupTy [Mult]
    tup_elt_tys

            ; tcExtendIdEnv tup_ids $ do
            { ((stmts', (ret_op', tup_rets)), stmts_ty)
                    <- tcInfer $ \ ExpRhoType
    exp_ty ->
                       HsStmtContextRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    -> ExpRhoType
    -> (ExpRhoType -> TcM (SyntaxExprTc, [HsExpr GhcTc]))
    -> TcM
         ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
          (SyntaxExprTc, [HsExpr GhcTc]))
    forall (body :: * -> *) rho_type thing.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (LocatedA (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContextRn
    ctxt HsStmtContextRn
    -> Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> ExpRhoType
    -> (ExpRhoType -> TcM thing)
    -> TcM
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    TcStmtChecker HsExpr ExpRhoType
    tcDoStmt [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    [GenLocated
       SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    stmts ExpRhoType
    exp_ty ((ExpRhoType -> TcM (SyntaxExprTc, [HsExpr GhcTc]))
     -> TcM
          ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
           (SyntaxExprTc, [HsExpr GhcTc])))
    -> (ExpRhoType -> TcM (SyntaxExprTc, [HsExpr GhcTc]))
    -> TcM
         ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
          (SyntaxExprTc, [HsExpr GhcTc]))
    forall a b. (a -> b) -> a -> b
    $ \ ExpRhoType
    inner_res_ty ->
                       do { 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
                          ; (_, ret_op')
                              <- tcSyntaxOp DoOrigin ret_op [synKnownType tup_ty]
                                            inner_res_ty $ \[Mult]
    _ [Mult]
    _ -> () -> TcRn ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                          ; return (ret_op', tup_rets) }

            ; ((_, mfix_op'), mfix_res_ty)
                <- tcInfer $ \ 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 (HasDebugCallStack => Mult -> Mult -> Mult
    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 a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

            ; ((thing, new_res_ty), bind_op')
                <- tcSyntaxOp DoOrigin bind_op
                              [ synKnownType mfix_res_ty
                              , SynFun (synKnownType tup_ty) SynRho ]
                              res_ty $
                   \ [Mult
    new_res_ty] [Mult]
    _ ->
                   do { thing <- ExpRhoType -> TcM thing
    thing_inside (Mult -> ExpRhoType
    mkCheckExpType Mult
    new_res_ty)
                      ; return (thing, new_res_ty) }

            ; let rec_ids = [Name] -> [Id] -> [Id]
    forall b a. [b] -> [a] -> [a]
    takeList [IdP GhcRn]
    [Name]
    rec_names [Id]
    tup_ids
            ; later_ids <- tcLookupLocalIds later_names
            ; traceTc "tcdo" $ vcat [ppr rec_ids <+> ppr (map idType rec_ids),
                                     ppr later_ids <+> ppr (map idType later_ids)]
            ; return (RecStmt { recS_stmts = L l stmts', recS_later_ids = later_ids
                              , recS_rec_ids = rec_ids, recS_ret_fn = ret_op'
                              , recS_mfix_fn = mfix_op', recS_bind_fn = bind_op'
                              , recS_ext = RecStmtTc
                                { recS_bind_ty = new_res_ty
                                , recS_later_rets = []
                                , recS_rec_rets = tup_rets
                                , recS_ret_ty = stmts_ty} }, thing)
            }}

    tcDoStmt HsStmtContextRn
    _ Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    stmt ExpRhoType
    _ ExpRhoType -> TcM thing
    _
      = String
    -> SDoc
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcDoStmt: unexpected Stmt" (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr 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
        dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        if isIrrefutableHsPat dflags pat
          then return Nothing
          else Just . snd <$> (tcSyntaxOp orig fail_op [synKnownType stringTy]
                                (mkCheckExpType res_ty) $ \[Mult]
    _ [Mult]
    _ -> () -> TcRn ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    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

    Note [Scoping in parallel list comprehensions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In a parallel list comprehension like [ ebody | a <- blah1; e1 | b <- blah2; e2 ]
    we want to ensure that in the lexical environment, tcl_rdr :: LocalRdrEnv, we have
      * 'a' in scope in e1, but not 'b'
      * 'b' in scope in e2, but not 'a'
      * Both in scope in ebody
    We don't want too /many/ variables in the LocalRdrEnv, else we make stupid
    suggestions for an out-of-scope variable (#22940).

    To achieve this we:
      * At the start of each branch, reset the LocalRdrEnv to the outer scope.
      * Before typechecking ebody, add to LocalRdrEnv all the variables bound in
        all branches. This step is done with bindLocalNames.
    -}

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

    tcApplicativeStmts :: forall t.
    HsStmtContextRn
    -> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    -> ExpRhoType
    -> (Mult -> TcM t)
    -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Mult, t)
    tcApplicativeStmts HsStmtContextRn
    ctxt [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    pairs ExpRhoType
    rhs_ty Mult -> TcM t
    thing_inside
     = do { body_ty <- Mult -> TcM Mult
    newFlexiTyVarTy Mult
    liftedTypeKind
          ; let arity = [(SyntaxExprRn, ApplicativeArg GhcRn)] -> VisArity
    forall a. [a] -> VisArity
    forall (t :: * -> *) a. Foldable t => t a -> VisArity
    length [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
    [(SyntaxExprRn, ApplicativeArg GhcRn)]
    pairs
          ; ts <- replicateM (arity-1) $ newInferExpType
          ; exp_tys <- replicateM arity $ newFlexiTyVarTy liftedTypeKind
          ; pat_tys <- replicateM arity $ newFlexiTyVarTy liftedTypeKind
          ; let 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 (ops, args) = unzip pairs
          ; ops' <- goOps fun_ty (zip3 ops (ts ++ [rhs_ty]) exp_tys)

          -- Typecheck each ApplicativeArg separately
          -- See Note [ApplicativeDo and constraints]
          ; args' <- mapM (goArg body_ty) (zip3 args pat_tys exp_tys)

          -- Bring into scope all the things bound by the args,
          -- and typecheck the thing_inside
          -- See Note [ApplicativeDo and constraints]
          ; res <- tcExtendIdEnv (concatMap get_arg_bndrs args') $
                   thing_inside body_ty

          ; return (zip ops' args', body_ty, res) }
      where
        goOps :: Mult
    -> [(SyntaxExprRn, ExpRhoType, Mult)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [SyntaxExprTc]
    goOps Mult
    _ [] = [SyntaxExprTc] -> IOEnv (Env TcGblEnv TcLclEnv) [SyntaxExprTc]
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    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 { (_, 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 a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
               ; t_i <- readExpType t_i
               ; ops' <- goOps t_i ops
               ; return (op' : 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 :: Bool
    is_body_stmt :: forall idL. ApplicativeArg idL -> 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 SrcSpanAnnA (Pat GhcRn) -> SrcSpan
    forall a e. HasLoc a => GenLocated a e -> SrcSpan
    getLocA LPat GhcRn
    GenLocated SrcSpanAnnA (Pat GhcRn)
    pat) (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SrcSpan
    forall a e. HasLoc a => GenLocated a e -> SrcSpan
    getLocA LHsExpr GhcRn
    GenLocated SrcSpanAnnA (HsExpr 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 (GenLocated SrcSpanAnnN Name)
    -> Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> SDoc
    forall (idL :: Pass) (idR :: Pass) fn body.
    (OutputableBndrId idL, OutputableBndrId idR, Outputable fn,
     Outputable body,
     Anno (StmtLR (GhcPass idL) (GhcPass idR) body) ~ SrcSpanAnnA) =>
    HsStmtContext fn -> StmtLR (GhcPass idL) (GhcPass idR) body -> SDoc
    pprStmtInCtxt HsStmtContextRn
    HsStmtContext (GenLocated SrcSpanAnnN Name)
    ctxt (LPat GhcRn
    -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    forall (bodyR :: * -> *).
    LPat GhcRn
    -> LocatedA (bodyR GhcRn)
    -> StmtLR GhcRn GhcRn (LocatedA (bodyR GhcRn))
    mkRnBindStmt LPat GhcRn
    pat LHsExpr GhcRn
    GenLocated SrcSpanAnnA (HsExpr 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 { rhs'      <- LHsExpr GhcRn -> Mult -> TcM (LHsExpr GhcTc)
    tcCheckMonoExprNC LHsExpr GhcRn
    rhs Mult
    exp_ty
               ; (pat', _) <- tcCheckPat (StmtCtxt ctxt) pat (unrestricted pat_ty) $
                              return ()
               ; fail_op' <- fmap join . forM fail_op $ \SyntaxExprRn
    fail ->
                   CtOrigin
    -> LPat GhcTc
    -> SyntaxExpr GhcRn
    -> Mult
    -> TcRn (FailOperator GhcTc)
    tcMonadFailOp (LPat GhcRn -> CtOrigin
    DoPatOrigin LPat GhcRn
    pat) LPat GhcTc
    GenLocated SrcSpanAnnA (Pat GhcTc)
    pat' SyntaxExpr GhcRn
    SyntaxExprRn
    fail Mult
    body_ty

               ; return (ApplicativeArgOne
                          { xarg_app_arg_one = fail_op'
                          , app_arg_pattern = pat'
                          , arg_expr        = rhs'
                          , .. }
                        ) }

        goArg Mult
    _body_ty (ApplicativeArgMany XApplicativeArgMany GhcRn
    x [GuardLStmt GhcRn]
    stmts HsExpr GhcRn
    ret LPat GhcRn
    pat HsDoFlavour
    ctxt, Mult
    pat_ty, Mult
    exp_ty)
          = do { (stmts', (ret',pat')) <-
                    HsStmtContextRn
    -> TcStmtChecker HsExpr ExpRhoType
    -> [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    -> ExpRhoType
    -> (ExpRhoType
        -> TcM (HsExpr GhcTc, GenLocated SrcSpanAnnA (Pat GhcTc)))
    -> TcM
         ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
          (HsExpr GhcTc, GenLocated SrcSpanAnnA (Pat GhcTc)))
    forall (body :: * -> *) rho_type thing.
    AnnoBody body =>
    HsStmtContextRn
    -> TcStmtChecker body rho_type
    -> [LStmt GhcRn (LocatedA (body GhcRn))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (LocatedA (body GhcTc))], thing)
    tcStmtsAndThen (HsDoFlavour -> HsStmtContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsDoFlavour -> HsStmtContext fn
    HsDoStmt HsDoFlavour
    ctxt) HsStmtContextRn
    -> Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> ExpRhoType
    -> (ExpRhoType -> TcM thing)
    -> TcM
         (StmtLR GhcTc GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)), thing)
    TcStmtChecker HsExpr ExpRhoType
    tcDoStmt [GuardLStmt GhcRn]
    [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
    stmts (Mult -> ExpRhoType
    mkCheckExpType Mult
    exp_ty) ((ExpRhoType
      -> TcM (HsExpr GhcTc, GenLocated SrcSpanAnnA (Pat GhcTc)))
     -> TcM
          ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
           (HsExpr GhcTc, GenLocated SrcSpanAnnA (Pat GhcTc))))
    -> (ExpRhoType
        -> TcM (HsExpr GhcTc, GenLocated SrcSpanAnnA (Pat GhcTc)))
    -> TcM
         ([LStmt GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))],
          (HsExpr GhcTc, GenLocated SrcSpanAnnA (Pat GhcTc)))
    forall a b. (a -> b) -> a -> b
    $
                    \ExpRhoType
    res_ty  -> do
                      { ret'      <- HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    ret ExpRhoType
    res_ty
                      ; (pat', _) <- tcCheckPat (StmtCtxt (HsDoStmt ctxt)) pat (unrestricted pat_ty) $
                                     return ()
                      ; return (ret', pat')
                      }
               ; return (ApplicativeArgMany x stmts' ret' pat' 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 }) = CollectFlag GhcTc -> LPat GhcTc -> [IdP GhcTc]
    forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
    collectPatBinders CollectFlag GhcTc
    forall p. CollectFlag p
    CollNoDictBinders LPat GhcTc
    pat
        get_arg_bndrs (ApplicativeArgMany { bv_pattern :: forall idL. ApplicativeArg idL -> LPat idL
    bv_pattern =  LPat GhcTc
    pat })    = CollectFlag GhcTc -> LPat GhcTc -> [IdP GhcTc]
    forall p. CollectPass p => CollectFlag p -> LPat p -> [IdP p]
    collectPatBinders CollectFlag GhcTc
    forall p. CollectFlag p
    CollNoDictBinders 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}
    *                                                                      *
    ************************************************************************
    -}

    -- | @checkArgCounts@ takes a @[RenamedMatch]@ and decides whether the same
    -- number of /required/ args are used in each equation.
    -- Returns the arity, the number of required args
    -- E.g.  f @a True  y = ...
    --       f    False z = ...
    --       The MatchGroup for `f` has arity 2, not 3
    checkArgCounts :: AnnoBody body
                   => MatchGroup GhcRn (LocatedA (body GhcRn))
                   -> TcM VisArity
    checkArgCounts :: forall (body :: * -> *).
    AnnoBody body =>
    MatchGroup GhcRn (LocatedA (body GhcRn)) -> TcM VisArity
    checkArgCounts (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
    mg_alts = L SrcSpanAnnL
    _ [] })
        = VisArity -> TcM VisArity
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return VisArity
    1 -- See Note [Empty MatchGroups] in GHC.Rename.Bind
                   --   case e of {} or \case {}
                   -- Both have arity 1

    checkArgCounts (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
    mg_alts = L SrcSpanAnnL
    _ (LocatedA (Match GhcRn (LocatedA (body GhcRn)))
    match1:[LocatedA (Match GhcRn (LocatedA (body GhcRn)))]
    matches) })
        | [LocatedA (Match GhcRn (LocatedA (body GhcRn)))] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LocatedA (Match GhcRn (LocatedA (body GhcRn)))]
    matches  -- There was only one match; nothing to check
        = VisArity -> TcM VisArity
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return VisArity
    n_args1

        -- Two or more matches: check that they agree on arity
        | Just NonEmpty (LocatedA (Match GhcRn (LocatedA (body GhcRn))))
    bad_matches <- Maybe (NonEmpty (LocatedA (Match GhcRn (LocatedA (body GhcRn)))))
    mb_bad_matches
        = TcRnMessage -> TcM VisArity
    forall a. TcRnMessage -> TcM a
    failWithTc (TcRnMessage -> TcM VisArity) -> TcRnMessage -> TcM VisArity
    forall a b. (a -> b) -> a -> b
    $ HsMatchContextRn -> MatchArgBadMatches -> TcRnMessage
    TcRnMatchesHaveDiffNumArgs (Match GhcRn (LocatedA (body GhcRn))
    -> HsMatchContext (LIdP (NoGhcTc GhcRn))
    forall p body. Match p body -> HsMatchContext (LIdP (NoGhcTc p))
    m_ctxt (LocatedA (Match GhcRn (LocatedA (body GhcRn)))
    -> Match GhcRn (LocatedA (body GhcRn))
    forall l e. GenLocated l e -> e
    unLoc LocatedA (Match GhcRn (LocatedA (body GhcRn)))
    match1))
                     (MatchArgBadMatches -> TcRnMessage)
    -> MatchArgBadMatches -> TcRnMessage
    forall a b. (a -> b) -> a -> b
    $ LocatedA (Match GhcRn (LocatedA (body GhcRn)))
    -> NonEmpty (LocatedA (Match GhcRn (LocatedA (body GhcRn))))
    -> MatchArgBadMatches
    forall body.
    LocatedA (Match GhcRn body)
    -> NonEmpty (LocatedA (Match GhcRn body)) -> MatchArgBadMatches
    MatchArgMatches LocatedA (Match GhcRn (LocatedA (body GhcRn)))
    match1 NonEmpty (LocatedA (Match GhcRn (LocatedA (body GhcRn))))
    bad_matches
        | Bool
    otherwise
        = VisArity -> TcM VisArity
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return VisArity
    n_args1
      where
        n_args1 :: VisArity
    n_args1 = LocatedA (Match GhcRn (LocatedA (body GhcRn))) -> VisArity
    forall body1. LocatedA (Match GhcRn body1) -> VisArity
    reqd_args_in_match LocatedA (Match GhcRn (LocatedA (body GhcRn)))
    match1
        mb_bad_matches :: Maybe (NonEmpty (LocatedA (Match GhcRn (LocatedA (body GhcRn)))))
    mb_bad_matches = [LocatedA (Match GhcRn (LocatedA (body GhcRn)))]
    -> Maybe
         (NonEmpty (LocatedA (Match GhcRn (LocatedA (body GhcRn)))))
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty [LocatedA (Match GhcRn (LocatedA (body GhcRn)))
    m | LocatedA (Match GhcRn (LocatedA (body GhcRn)))
    m <- [LocatedA (Match GhcRn (LocatedA (body GhcRn)))]
    matches, LocatedA (Match GhcRn (LocatedA (body GhcRn))) -> VisArity
    forall body1. LocatedA (Match GhcRn body1) -> VisArity
    reqd_args_in_match LocatedA (Match GhcRn (LocatedA (body GhcRn)))
    m VisArity -> VisArity -> Bool
    forall a. Eq a => a -> a -> Bool
    /= VisArity
    n_args1]

        reqd_args_in_match :: LocatedA (Match GhcRn body1) -> VisArity
        -- Counts the number of /required/ args in the match
        reqd_args_in_match :: forall body1. LocatedA (Match GhcRn body1) -> VisArity
    reqd_args_in_match (L SrcSpanAnnA
    _ (Match { m_pats :: forall p body. Match p body -> [LPat p]
    m_pats = [LPat GhcRn]
    pats })) = (GenLocated SrcSpanAnnA (Pat GhcRn) -> Bool)
    -> [GenLocated SrcSpanAnnA (Pat GhcRn)] -> VisArity
    forall a. (a -> Bool) -> [a] -> VisArity
    count (Pat GhcRn -> Bool
    forall p. Pat p -> Bool
    isVisArgPat (Pat GhcRn -> Bool)
    -> (GenLocated SrcSpanAnnA (Pat GhcRn) -> Pat GhcRn)
    -> GenLocated SrcSpanAnnA (Pat GhcRn)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpanAnnA (Pat GhcRn) -> Pat GhcRn
    forall l e. GenLocated l e -> e
    unLoc) [LPat GhcRn]
    [GenLocated SrcSpanAnnA (Pat GhcRn)]
    pats