    {-# LANGUAGE DataKinds           #-}
    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TupleSections       #-}
    {-# LANGUAGE TypeFamilies        #-}
    {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
                                          -- in module Language.Haskell.Syntax.Extension
    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}

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

    -}

    module GHC.Tc.Gen.Expr
           ( tcCheckPolyExpr, tcCheckPolyExprNC,
             tcCheckMonoExpr, tcCheckMonoExprNC,
             tcMonoExpr, tcMonoExprNC,
             tcInferRho, tcInferRhoNC,
             tcPolyLExpr, tcPolyExpr, tcExpr, tcPolyLExprSig,
             tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType,
             tcCheckId,
             ) where

    import GHC.Prelude

    import Language.Haskell.Syntax.Basic (FieldLabelString(..))

    import {-# SOURCE #-} GHC.Tc.Gen.Splice
      ( tcTypedSplice, tcTypedBracket, tcUntypedBracket, getUntypedSpliceBody )

    import GHC.Hs
    import GHC.Hs.Syn.Type
    import GHC.Rename.Utils
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Utils.Unify
    import GHC.Types.Basic
    import GHC.Types.Error
    import GHC.Types.FieldLabel
    import GHC.Types.Unique.FM
    import GHC.Types.Unique.Map
    import GHC.Types.Unique.Set
    import GHC.Core.Multiplicity
    import GHC.Core.UsageEnv
    import GHC.Tc.Errors.Types
    import GHC.Tc.Utils.Concrete ( hasFixedRuntimeRep_syntactic, hasFixedRuntimeRep )
    import GHC.Tc.Utils.Instantiate
    import GHC.Tc.Gen.App
    import GHC.Tc.Gen.Head
    import GHC.Tc.Gen.Bind        ( tcLocalBinds )
    import GHC.Tc.Instance.Family ( tcGetFamInstEnvs )
    import GHC.Core.FamInstEnv    ( FamInstEnvs )
    import GHC.Rename.Env         ( addUsedGRE, getUpdFieldLbls )
    import GHC.Tc.Utils.Env
    import GHC.Tc.Gen.Arrow
    import GHC.Tc.Gen.Match( tcBody, tcLambdaMatches, tcCaseMatches
                           , tcGRHSList, tcDoStmts )
    import GHC.Tc.Gen.HsType
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Zonk.TcType
    import GHC.Tc.Types.Origin
    import GHC.Tc.Utils.TcType as TcType
    import GHC.Types.Id
    import GHC.Types.Id.Info
    import GHC.Core.ConLike
    import GHC.Core.DataCon
    import GHC.Types.Name
    import GHC.Types.Name.Env
    import GHC.Types.Name.Set
    import GHC.Types.Name.Reader
    import GHC.Core.Class(classTyCon)
    import GHC.Core.TyCon
    import GHC.Core.Type
    import GHC.Core.Coercion
    import GHC.Tc.Types.Evidence
    import GHC.Builtin.Types
    import GHC.Builtin.Names
    import GHC.Builtin.Uniques ( mkBuiltinUnique )
    import GHC.Driver.DynFlags
    import GHC.Types.SrcLoc
    import GHC.Utils.Misc
    import GHC.Data.Bag ( unitBag )
    import GHC.Data.List.SetOps
    import GHC.Data.Maybe
    import GHC.Utils.Outputable as Outputable
    import GHC.Utils.Panic

    import Control.Monad
    import qualified Data.List.NonEmpty as NE

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Main wrappers}
    *                                                                      *
    ************************************************************************
    -}

    tcCheckPolyExpr, tcCheckPolyExprNC
      :: LHsExpr GhcRn         -- Expression to type check
      -> TcSigmaType           -- Expected type (could be a polytype)
      -> TcM (LHsExpr GhcTc) -- Generalised expr with expected type

    -- tcCheckPolyExpr is a convenient place (frequent but not too frequent)
    -- place to add context information.
    -- The NC version does not do so, usually because the caller wants
    -- to do so themselves.

    tcCheckPolyExpr :: LHsExpr GhcRn -> Type -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr   LHsExpr GhcRn
    expr Type
    res_ty = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcPolyLExpr   LHsExpr GhcRn
    expr (Type -> ExpRhoType
    mkCheckExpType Type
    res_ty)
    tcCheckPolyExprNC :: LHsExpr GhcRn -> Type -> TcM (LHsExpr GhcTc)
    tcCheckPolyExprNC LHsExpr GhcRn
    expr Type
    res_ty = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcPolyLExprNC LHsExpr GhcRn
    expr (Type -> ExpRhoType
    mkCheckExpType Type
    res_ty)

    -----------------
    -- These versions take an ExpType
    tcPolyLExpr, tcPolyLExprNC :: LHsExpr GhcRn -> ExpSigmaType
                               -> TcM (LHsExpr GhcTc)

    tcPolyLExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcPolyLExpr (L SrcSpanAnnA
    loc HsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = SrcSpanAnnA -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc  (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $  -- Set location /first/; see GHC.Tc.Utils.Monad
        HsExpr GhcRn -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. HsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt HsExpr GhcRn
    expr (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $  -- Note [Error contexts in generated code]
        do { expr' <- HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcPolyExpr HsExpr GhcRn
    expr ExpRhoType
    res_ty
           ; return (L loc expr') }

    tcPolyLExprNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcPolyLExprNC (L SrcSpanAnnA
    loc HsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = SrcSpanAnnA -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc    (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do { expr' <- HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcPolyExpr HsExpr GhcRn
    expr ExpRhoType
    res_ty
           ; return (L loc expr') }

    -----------------
    tcPolyExpr :: HsExpr GhcRn -> ExpSigmaType -> TcM (HsExpr GhcTc)
    tcPolyExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcPolyExpr HsExpr GhcRn
    e (Infer InferResult
    inf) = HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    e (InferResult -> ExpRhoType
    Infer InferResult
    inf)
    tcPolyExpr HsExpr GhcRn
    e (Check Type
    ty)  = HsExpr GhcRn -> Either Type TcCompleteSig -> TcM (HsExpr GhcTc)
    tcPolyExprCheck HsExpr GhcRn
    e (Type -> Either Type TcCompleteSig
    forall a b. a -> Either a b
    Left Type
    ty)

    -----------------
    tcPolyLExprSig :: LHsExpr GhcRn -> TcCompleteSig -> TcM (LHsExpr GhcTc)
    tcPolyLExprSig :: LHsExpr GhcRn -> TcCompleteSig -> TcM (LHsExpr GhcTc)
    tcPolyLExprSig (L SrcSpanAnnA
    loc HsExpr GhcRn
    expr) TcCompleteSig
    sig
      = SrcSpanAnnA -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        -- No addExprCtxt.  For (e :: ty) we don't want generate
        --    In the expression e
        --    In the expression e :: ty
        -- We have already got an error-context for (e::ty), so when we
        -- get to `e`, just add the location
        do { String -> SDoc -> TcRn ()
    traceTc String
    "tcPolyLExprSig" (SrcSpanAnnA -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpanAnnA
    loc SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    expr)
           ; expr' <- HsExpr GhcRn -> Either Type TcCompleteSig -> TcM (HsExpr GhcTc)
    tcPolyExprCheck HsExpr GhcRn
    expr (TcCompleteSig -> Either Type TcCompleteSig
    forall a b. b -> Either a b
    Right TcCompleteSig
    sig)
           ; return (L loc expr') }

    -----------------
    tcPolyExprCheck :: HsExpr GhcRn
                    -> Either TcSigmaType TcCompleteSig
                    -> TcM (HsExpr GhcTc)
    -- tcPolyExpCheck deals with the special case for HsLam, in case the pushed-down
    -- type is a forall-type.  E.g.    (\@a -> blah) :: forall b. b -> Int
    --
    -- The (Either TcSigmaType TcCompleteSig) deals with:
    --   Left ty:    (f e) pushes f's argument type `ty` into `e`
    --   Right sig:  (e :: sig) pushes `sig` into `e`
    -- The Either stuff is entirely local to this function and its immediate callers.
    --
    -- See Note [Skolemisation overview] in GHC.Tc.Utils.Unify

    tcPolyExprCheck :: HsExpr GhcRn -> Either Type TcCompleteSig -> TcM (HsExpr GhcTc)
    tcPolyExprCheck HsExpr GhcRn
    expr Either Type TcCompleteSig
    res_ty
      = Either Type TcCompleteSig
    -> ([ExpPatType] -> Type -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc)
    outer_skolemise Either Type TcCompleteSig
    res_ty (([ExpPatType] -> Type -> TcM (HsExpr GhcTc))
     -> TcM (HsExpr GhcTc))
    -> ([ExpPatType] -> Type -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ \[ExpPatType]
    pat_tys Type
    rho_ty ->
        let
          -- tc_body is a little loop that looks past parentheses
          tc_body :: HsExpr GhcRn -> TcM (HsExpr GhcTc)
    tc_body (HsPar XPar GhcRn
    x (L SrcSpanAnnA
    loc HsExpr GhcRn
    e))
            = SrcSpanAnnA -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
              do { e' <- HsExpr GhcRn -> TcM (HsExpr GhcTc)
    tc_body HsExpr GhcRn
    e
                 ; return (HsPar x (L loc e')) }

          -- Look through any untyped splices (#24559)
          -- c.f. Note [Looking through Template Haskell splices in splitHsApps]
          tc_body (HsUntypedSplice XUntypedSplice GhcRn
    splice_res HsUntypedSplice GhcRn
    _)
            = do { body <- HsUntypedSpliceResult (HsExpr GhcRn) -> TcM (HsExpr GhcRn)
    getUntypedSpliceBody XUntypedSplice GhcRn
    HsUntypedSpliceResult (HsExpr GhcRn)
    splice_res
                 ; tc_body body }

          -- The special case for lambda: go to tcLambdaMatches, passing pat_tys
          tc_body e :: HsExpr GhcRn
    e@(HsLam XLam GhcRn
    x HsLamVariant
    lam_variant MatchGroup GhcRn (LHsExpr GhcRn)
    matches)
            = do { (wrap, matches') <- 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]
    pat_tys
                                                       (Type -> ExpRhoType
    mkCheckExpType Type
    rho_ty)
                   -- NB: tcLambdaMatches concludes with deep skolemisation,
                   --     if DeepSubsumption is on;  hence no need to do that here
                 ; return (mkHsWrap wrap $ HsLam x lam_variant matches') }

          -- The general case: just do deep skolemisation if necessary,
          -- before handing off to tcExpr
          tc_body HsExpr GhcRn
    e = do { ds_flag <- TcM DeepSubsumptionFlag
    getDeepSubsumptionFlag
                         ; inner_skolemise ds_flag rho_ty $ \Type
    rho_ty' ->
                           HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    e (Type -> ExpRhoType
    mkCheckExpType Type
    rho_ty') }
        in HsExpr GhcRn -> TcM (HsExpr GhcTc)
    tc_body HsExpr GhcRn
    expr
      where
        -- `outer_skolemise` is used always
        -- It only does shallow skolemisation
        -- It always makes an implication constraint if deferred-errors is on
        outer_skolemise :: Either TcSigmaType TcCompleteSig
                        -> ([ExpPatType] -> TcRhoType -> TcM (HsExpr GhcTc))
                        -> TcM (HsExpr GhcTc)
        outer_skolemise :: Either Type TcCompleteSig
    -> ([ExpPatType] -> Type -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc)
    outer_skolemise (Left Type
    ty) [ExpPatType] -> Type -> TcM (HsExpr GhcTc)
    thing_inside
          = do { (wrap, expr') <- Type
    -> ([ExpPatType] -> Type -> TcM (HsExpr GhcTc))
    -> TcM (HsWrapper, HsExpr GhcTc)
    forall result.
    Type
    -> ([ExpPatType] -> Type -> TcM result) -> TcM (HsWrapper, result)
    tcSkolemiseExpectedType Type
    ty [ExpPatType] -> Type -> TcM (HsExpr GhcTc)
    thing_inside
               ; return (mkHsWrap wrap expr') }
        outer_skolemise (Right TcCompleteSig
    sig) [ExpPatType] -> Type -> TcM (HsExpr GhcTc)
    thing_inside
          = do { (wrap, expr') <- TcCompleteSig
    -> ([ExpPatType] -> Type -> TcM (HsExpr GhcTc))
    -> TcM (HsWrapper, HsExpr GhcTc)
    forall result.
    TcCompleteSig
    -> ([ExpPatType] -> Type -> TcM result) -> TcM (HsWrapper, result)
    tcSkolemiseCompleteSig TcCompleteSig
    sig [ExpPatType] -> Type -> TcM (HsExpr GhcTc)
    thing_inside
               ; return (mkHsWrap wrap expr') }

        -- inner_skolemise is used when we do not have a lambda
        -- With deep skolemisation we must remember to deeply skolemise
        -- after the (always-shallow) tcSkolemiseCompleteSig
        inner_skolemise :: DeepSubsumptionFlag -> TcRhoType
                        -> (TcRhoType -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc)
        inner_skolemise :: DeepSubsumptionFlag
    -> Type -> (Type -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc)
    inner_skolemise DeepSubsumptionFlag
    Shallow Type
    rho_ty Type -> TcM (HsExpr GhcTc)
    thing_inside
          = -- We have already done shallow skolemisation, so nothing further to do
            Type -> TcM (HsExpr GhcTc)
    thing_inside Type
    rho_ty
        inner_skolemise DeepSubsumptionFlag
    Deep Type
    rho_ty Type -> TcM (HsExpr GhcTc)
    thing_inside
          = -- Try deep skolemisation
            do { (wrap, expr') <- DeepSubsumptionFlag
    -> UserTypeCtxt
    -> Type
    -> (Type -> TcM (HsExpr GhcTc))
    -> TcM (HsWrapper, HsExpr GhcTc)
    forall result.
    DeepSubsumptionFlag
    -> UserTypeCtxt
    -> Type
    -> (Type -> TcM result)
    -> TcM (HsWrapper, result)
    tcSkolemise DeepSubsumptionFlag
    Deep UserTypeCtxt
    ctxt Type
    rho_ty Type -> TcM (HsExpr GhcTc)
    thing_inside
               ; return (mkHsWrap wrap expr') }

        ctxt :: UserTypeCtxt
    ctxt = case Either Type TcCompleteSig
    res_ty of
                 Left {}   -> UserTypeCtxt
    GenSigCtxt
                 Right TcCompleteSig
    sig -> TcCompleteSig -> UserTypeCtxt
    sig_ctxt TcCompleteSig
    sig

    {- *********************************************************************
    *                                                                      *
            tcExpr: the main expression typechecker
    *                                                                      *
    ********************************************************************* -}

    tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType)
    -- Infer a *rho*-type. The return type is always instantiated.
    tcInferRho :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, Type)
    tcInferRho (L SrcSpanAnnA
    loc HsExpr GhcRn
    expr)
      = SrcSpanAnnA
    -> TcM (LHsExpr GhcTc, Type) -> TcM (LHsExpr GhcTc, Type)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc   (TcM (LHsExpr GhcTc, Type) -> TcM (LHsExpr GhcTc, Type))
    -> TcM (LHsExpr GhcTc, Type) -> TcM (LHsExpr GhcTc, Type)
    forall a b. (a -> b) -> a -> b
    $  -- Set location /first/; see GHC.Tc.Utils.Monad
        HsExpr GhcRn
    -> TcM (LHsExpr GhcTc, Type) -> TcM (LHsExpr GhcTc, Type)
    forall a. HsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt HsExpr GhcRn
    expr (TcM (LHsExpr GhcTc, Type) -> TcM (LHsExpr GhcTc, Type))
    -> TcM (LHsExpr GhcTc, Type) -> TcM (LHsExpr GhcTc, Type)
    forall a b. (a -> b) -> a -> b
    $  -- Note [Error contexts in generated code]
        do { (expr', rho) <- (ExpRhoType -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc, Type)
    forall a. (ExpRhoType -> TcM a) -> TcM (a, Type)
    tcInfer (HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    expr)
           ; return (L loc expr', rho) }

    tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, Type)
    tcInferRhoNC (L SrcSpanAnnA
    loc HsExpr GhcRn
    expr)
      = SrcSpanAnnA
    -> TcM (LHsExpr GhcTc, Type) -> TcM (LHsExpr GhcTc, Type)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcM (LHsExpr GhcTc, Type) -> TcM (LHsExpr GhcTc, Type))
    -> TcM (LHsExpr GhcTc, Type) -> TcM (LHsExpr GhcTc, Type)
    forall a b. (a -> b) -> a -> b
    $
        do { (expr', rho) <- (ExpRhoType -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc, Type)
    forall a. (ExpRhoType -> TcM a) -> TcM (a, Type)
    tcInfer (HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    expr)
           ; return (L loc expr', rho) }

    ---------------
    tcCheckMonoExpr, tcCheckMonoExprNC
        :: LHsExpr GhcRn     -- Expression to type check
        -> TcRhoType         -- Expected type
                             -- Definitely no foralls at the top
        -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr :: LHsExpr GhcRn -> Type -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr   LHsExpr GhcRn
    expr Type
    res_ty = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExpr   LHsExpr GhcRn
    expr (Type -> ExpRhoType
    mkCheckExpType Type
    res_ty)
    tcCheckMonoExprNC :: LHsExpr GhcRn -> Type -> TcM (LHsExpr GhcTc)
    tcCheckMonoExprNC LHsExpr GhcRn
    expr Type
    res_ty = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC LHsExpr GhcRn
    expr (Type -> ExpRhoType
    mkCheckExpType Type
    res_ty)

    ---------------
    tcMonoExpr, tcMonoExprNC
        :: LHsExpr GhcRn     -- Expression to type check
        -> ExpRhoType        -- Expected type
                             -- Definitely no foralls at the top
        -> TcM (LHsExpr GhcTc)

    tcMonoExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExpr (L SrcSpanAnnA
    loc HsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = SrcSpanAnnA -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc   (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $  -- Set location /first/; see GHC.Tc.Utils.Monad
        HsExpr GhcRn -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. HsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt HsExpr GhcRn
    expr (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $  -- Note [Error contexts in generated code]
        do  { expr' <- HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    expr ExpRhoType
    res_ty
            ; return (L loc expr') }

    tcMonoExprNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC (L SrcSpanAnnA
    loc HsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = SrcSpanAnnA -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do  { expr' <- HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    expr ExpRhoType
    res_ty
            ; return (L loc expr') }

    ---------------
    tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)

    -- Use tcApp to typecheck applications, which are treated specially
    -- by Quick Look.  Specifically:
    --   - HsVar           lone variables, to ensure that they can get an
    --                     impredicative instantiation (via Quick Look
    --                     driven by res_ty (in checking mode)).
    --   - HsApp           value applications
    --   - HsAppType       type applications
    --   - ExprWithTySig   (e :: type)
    --   - HsRecSel        overloaded record fields
    --   - ExpandedThingRn renamer/pre-typechecker expansions
    --   - HsOpApp         operator applications
    --   - HsOverLit       overloaded literals
    -- These constructors are the union of
    --   - ones taken apart by GHC.Tc.Gen.Head.splitHsApps
    --   - ones understood by GHC.Tc.Gen.Head.tcInferAppHead_maybe
    -- See Note [Application chains and heads] in GHC.Tc.Gen.App
    tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr e :: HsExpr GhcRn
    e@(HsVar {})              ExpRhoType
    res_ty = HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp HsExpr GhcRn
    e ExpRhoType
    res_ty
    tcExpr e :: HsExpr GhcRn
    e@(HsApp {})              ExpRhoType
    res_ty = HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp HsExpr GhcRn
    e ExpRhoType
    res_ty
    tcExpr e :: HsExpr GhcRn
    e@(OpApp {})              ExpRhoType
    res_ty = HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp HsExpr GhcRn
    e ExpRhoType
    res_ty
    tcExpr e :: HsExpr GhcRn
    e@(HsAppType {})          ExpRhoType
    res_ty = HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp HsExpr GhcRn
    e ExpRhoType
    res_ty
    tcExpr e :: HsExpr GhcRn
    e@(ExprWithTySig {})      ExpRhoType
    res_ty = HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp HsExpr GhcRn
    e ExpRhoType
    res_ty
    tcExpr e :: HsExpr GhcRn
    e@(HsRecSel {})           ExpRhoType
    res_ty = HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp HsExpr GhcRn
    e ExpRhoType
    res_ty

    tcExpr (XExpr XXExpr GhcRn
    e)                 ExpRhoType
    res_ty = XXExprGhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcXExpr XXExpr GhcRn
    XXExprGhcRn
    e ExpRhoType
    res_ty

    tcExpr e :: HsExpr GhcRn
    e@(HsOverLit XOverLitE GhcRn
    _ HsOverLit GhcRn
    lit) ExpRhoType
    res_ty
      = do { mb_res <- HsOverLit GhcRn -> ExpRhoType -> TcM (Maybe (HsOverLit GhcTc))
    tcShortCutLit HsOverLit GhcRn
    lit ExpRhoType
    res_ty
             -- See Note [Short cut for overloaded literals] in GHC.Tc.Zonk.Type
           ; case mb_res of
               Just HsOverLit GhcTc
    lit' -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XOverLitE GhcTc -> HsOverLit GhcTc -> HsExpr GhcTc
    forall p. XOverLitE p -> HsOverLit p -> HsExpr p
    HsOverLit XOverLitE GhcTc
    NoExtField
    noExtField HsOverLit GhcTc
    lit')
               Maybe (HsOverLit GhcTc)
    Nothing   -> HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp HsExpr GhcRn
    e ExpRhoType
    res_ty }

    -- Typecheck an occurrence of an unbound Id
    --
    -- Some of these started life as a true expression hole "_".
    -- Others might simply be variables that accidentally have no binding site
    tcExpr (HsUnboundVar XUnboundVar GhcRn
    _ RdrName
    occ) ExpRhoType
    res_ty
      = do { ty <- ExpRhoType -> TcM Type
    expTypeToType ExpRhoType
    res_ty    -- Allow Int# etc (#12531)
           ; her <- emitNewExprHole occ ty
           ; tcEmitBindingUsage bottomUE   -- Holes fit any usage environment
                                           -- (#18491)
           ; return (HsUnboundVar her occ) }

    tcExpr e :: HsExpr GhcRn
    e@(HsLit XLitE GhcRn
    x HsLit GhcRn
    lit) ExpRhoType
    res_ty
      = do { let lit_ty :: Type
    lit_ty = HsLit GhcRn -> Type
    forall (p :: Pass). HsLit (GhcPass p) -> Type
    hsLitType HsLit GhcRn
    lit
           ; HsExpr GhcRn
    -> HsExpr GhcTc -> Type -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResult HsExpr GhcRn
    e (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
    forall p. XLitE p -> HsLit p -> HsExpr p
    HsLit XLitE GhcRn
    XLitE GhcTc
    x (HsLit GhcRn -> HsLit GhcTc
    forall (p1 :: Pass) (p2 :: Pass).
    HsLit (GhcPass p1) -> HsLit (GhcPass p2)
    convertLit HsLit GhcRn
    lit)) Type
    lit_ty ExpRhoType
    res_ty }

    tcExpr (HsPar XPar GhcRn
    x LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do { expr' <- LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC LHsExpr GhcRn
    expr ExpRhoType
    res_ty
           ; return (HsPar x expr') }

    tcExpr (HsPragE XPragE GhcRn
    x HsPragE GhcRn
    prag LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do { expr' <- LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExpr LHsExpr GhcRn
    expr ExpRhoType
    res_ty
           ; return (HsPragE x (tcExprPrag prag) expr') }

    tcExpr (NegApp XNegApp GhcRn
    x LHsExpr GhcRn
    expr SyntaxExpr GhcRn
    neg_expr) ExpRhoType
    res_ty
      = do  { (expr', neg_expr')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Type]
        -> [Type]
        -> IOEnv
             (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    NegateOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    neg_expr [SyntaxOpType
    SynAny] ExpRhoType
    res_ty (([Type]
      -> [Type]
      -> IOEnv
           (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
     -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc), SyntaxExprTc))
    -> ([Type]
        -> [Type]
        -> IOEnv
             (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                   \[Type
    arg_ty] [Type
    arg_mult] ->
                   Type -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. Type -> TcM a -> TcM a
    tcScalingUsage Type
    arg_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> Type -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    expr Type
    arg_ty
            ; return (NegApp x expr' neg_expr') }

    tcExpr e :: HsExpr GhcRn
    e@(HsIPVar XIPVar GhcRn
    _ HsIPName
    x) ExpRhoType
    res_ty
      = do { ip_ty <- Type -> TcM Type
    newFlexiTyVarTy Type
    liftedTypeKind
              -- Create a unification type variable of kind 'Type'.
              -- (The type of an implicit parameter must have kind 'Type'.)
           ; let ip_name = FastString -> Type
    mkStrLitTy (HsIPName -> FastString
    hsIPNameFS HsIPName
    x)
           ; ipClass <- tcLookupClass ipClassName
           ; ip_var <- emitWantedEvVar origin (mkClassPred ipClass [ip_name, ip_ty])
           ; tcWrapResult e
                       (fromDict ipClass ip_name ip_ty (HsVar noExtField (noLocA ip_var)))
                       ip_ty res_ty }
      where
      -- Coerces a dictionary for `IP "x" t` into `t`.
      fromDict :: Class -> Type -> Type -> HsExpr GhcTc -> HsExpr GhcTc
    fromDict Class
    ipClass Type
    x Type
    ty = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc)
    -> HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $ TcCoercionR -> HsWrapper
    mkWpCastR (TcCoercionR -> HsWrapper) -> TcCoercionR -> HsWrapper
    forall a b. (a -> b) -> a -> b
    $
                              Type -> TcCoercionR
    unwrapIP (Type -> TcCoercionR) -> Type -> TcCoercionR
    forall a b. (a -> b) -> a -> b
    $ Class -> [Type] -> Type
    mkClassPred Class
    ipClass [Type
    x,Type
    ty]
      origin :: CtOrigin
    origin = HsIPName -> CtOrigin
    IPOccOrigin HsIPName
    x

    tcExpr e :: HsExpr GhcRn
    e@(HsLam XLam GhcRn
    x HsLamVariant
    lam_variant MatchGroup GhcRn (LHsExpr GhcRn)
    matches) ExpRhoType
    res_ty
      = do { (wrap, matches') <- 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 [] ExpRhoType
    res_ty
           ; return (mkHsWrap wrap $ HsLam x lam_variant matches') }

    {-
    ************************************************************************
    *                                                                      *
                    Explicit lists
    *                                                                      *
    ************************************************************************
    -}

    -- Explicit lists [e1,e2,e3] have been expanded already in the renamer
    -- The expansion includes an ExplicitList, but it is always the built-in
    -- list type, so that's all we need concern ourselves with here.  See
    -- GHC.Rename.Expr. Note [Handling overloaded and rebindable constructs]
    tcExpr (ExplicitList XExplicitList GhcRn
    _ [LHsExpr GhcRn]
    exprs) ExpRhoType
    res_ty
      = do  { res_ty <- ExpRhoType -> TcM Type
    expTypeToType ExpRhoType
    res_ty
            ; (coi, elt_ty) <- matchExpectedListTy res_ty
            ; let tc_elt LocatedA (HsExpr GhcRn)
    expr = LHsExpr GhcRn -> Type -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    LocatedA (HsExpr GhcRn)
    expr Type
    elt_ty
            ; exprs' <- mapM tc_elt exprs
            ; return $ mkHsWrapCo coi $ ExplicitList elt_ty exprs' }

    tcExpr expr :: HsExpr GhcRn
    expr@(ExplicitTuple XExplicitTuple GhcRn
    x [HsTupArg GhcRn]
    tup_args Boxity
    boxity) ExpRhoType
    res_ty
      | (HsTupArg GhcRn -> Bool) -> [HsTupArg GhcRn] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all HsTupArg GhcRn -> Bool
    forall (p :: Pass). HsTupArg (GhcPass p) -> Bool
    tupArgPresent [HsTupArg GhcRn]
    tup_args
      = do { let arity :: Int
    arity  = [HsTupArg GhcRn] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [HsTupArg GhcRn]
    tup_args
                 tup_tc :: TyCon
    tup_tc = Boxity -> Int -> TyCon
    tupleTyCon Boxity
    boxity Int
    arity
                   -- NB: tupleTyCon doesn't flatten 1-tuples
                   -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make
           ; res_ty <- ExpRhoType -> TcM Type
    expTypeToType ExpRhoType
    res_ty
           ; (coi, arg_tys) <- matchExpectedTyConApp tup_tc res_ty
                               -- Unboxed tuples have RuntimeRep vars, which we
                               -- don't care about here
                               -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
           ; let arg_tys' = case Boxity
    boxity of Boxity
    Unboxed -> Int -> [Type] -> [Type]
    forall a. Int -> [a] -> [a]
    drop Int
    arity [Type]
    arg_tys
                                           Boxity
    Boxed   -> [Type]
    arg_tys
           ; tup_args1 <- tcCheckExplicitTuple tup_args arg_tys'
           ; return $ mkHsWrapCo coi (ExplicitTuple x tup_args1 boxity) }

      | Bool
    otherwise
      = -- The tup_args are a mixture of Present and Missing (for tuple sections).
        do { (tup_args1, arg_tys) <- Boxity -> [HsTupArg GhcRn] -> TcM ([HsTupArg GhcTc], [Type])
    tcInferTupArgs Boxity
    boxity [HsTupArg GhcRn]
    tup_args

           ; let expr'       = XExplicitTuple GhcTc -> [HsTupArg GhcTc] -> Boxity -> HsExpr GhcTc
    forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
    ExplicitTuple XExplicitTuple GhcRn
    XExplicitTuple GhcTc
    x [HsTupArg GhcTc]
    tup_args1 Boxity
    boxity
                 missing_tys = [Type -> Type -> Scaled Type
    forall a. Type -> a -> Scaled a
    Scaled Type
    mult Type
    ty | (Missing (Scaled Type
    mult Type
    _), Type
    ty) <- [HsTupArg GhcTc] -> [Type] -> [(HsTupArg GhcTc, Type)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [HsTupArg GhcTc]
    tup_args1 [Type]
    arg_tys]

                 -- See Note [Typechecking data constructors] in GHC.Tc.Gen.Head
                 -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make
                 act_res_ty = [Scaled Type] -> Type -> Type
    HasDebugCallStack => [Scaled Type] -> Type -> Type
    mkScaledFunTys [Scaled Type]
    missing_tys (Boxity -> [Type] -> Type
    mkTupleTy1 Boxity
    boxity [Type]
    arg_tys)

           ; traceTc "ExplicitTuple" (ppr act_res_ty $$ ppr res_ty)

           ; tcWrapResultMono expr expr' act_res_ty res_ty }

    tcExpr (ExplicitSum XExplicitSum GhcRn
    _ Int
    alt Int
    arity LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do { let sum_tc :: TyCon
    sum_tc = Int -> TyCon
    sumTyCon Int
    arity
           ; res_ty <- ExpRhoType -> TcM Type
    expTypeToType ExpRhoType
    res_ty
           ; (coi, arg_tys) <- matchExpectedTyConApp sum_tc res_ty
           ; -- Drop levity vars, we don't care about them here
             let arg_tys' = Int -> [Type] -> [Type]
    forall a. Int -> [a] -> [a]
    drop Int
    arity [Type]
    arg_tys
                 arg_ty   = [Type]
    arg_tys' [Type] -> Int -> Type
    forall a. Outputable a => [a] -> Int -> a
    `getNth` (Int
    alt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
           ; expr' <- tcCheckPolyExpr expr arg_ty
           -- Check the whole res_ty, not just the arg_ty, to avoid #20277.
           -- Example:
           --   a :: TYPE rep (representation-polymorphic)
           --   (# 17# | #) :: (# Int# | a #)
           -- This should cause an error, even though (17# :: Int#)
           -- is not representation-polymorphic: we don't know how
           -- wide the concrete representation of the sum type will be.
           ; hasFixedRuntimeRep_syntactic (FRRUnboxedSum Nothing) res_ty
           ; return $ mkHsWrapCo coi (ExplicitSum arg_tys' alt arity expr' ) }

    {-
    ************************************************************************
    *                                                                      *
                    Let, case, if, do
    *                                                                      *
    ************************************************************************
    -}

    tcExpr (HsLet XLet GhcRn
    x HsLocalBinds GhcRn
    binds LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do  { (binds', wrapper, expr') <- HsLocalBinds GhcRn
    -> TcM (LHsExpr GhcTc)
    -> TcM (HsLocalBinds GhcTc, HsWrapper, LHsExpr GhcTc)
    forall thing.
    HsLocalBinds GhcRn
    -> TcM thing -> TcM (HsLocalBinds GhcTc, HsWrapper, thing)
    tcLocalBinds HsLocalBinds GhcRn
    binds (TcM (LHsExpr GhcTc)
     -> TcM (HsLocalBinds GhcTc, HsWrapper, LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc)
    -> TcM (HsLocalBinds GhcTc, HsWrapper, LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                                          LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExpr LHsExpr GhcRn
    expr ExpRhoType
    res_ty
              -- The wrapper checks for correct multiplicities.
              -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
            ; return (HsLet x binds' (mkLHsWrap wrapper expr')) }

    tcExpr (HsCase XCase GhcRn
    ctxt LHsExpr GhcRn
    scrut MatchGroup GhcRn (LHsExpr GhcRn)
    matches) ExpRhoType
    res_ty
      = do  {  -- We used to typecheck the case alternatives first.
               -- The case patterns tend to give good type info to use
               -- when typechecking the scrutinee.  For example
               --   case (map f) of
               --     (x:xs) -> ...
               -- will report that map is applied to too few arguments
               --
               -- But now, in the GADT world, we need to typecheck the scrutinee
               -- first, to get type info that may be refined in the case alternatives
              mult <- Type -> TcM Type
    newFlexiTyVarTy Type
    multiplicityTy

              -- Typecheck the scrutinee.  We use tcInferRho but tcInferSigma
              -- would also be possible (tcCaseMatches accepts sigma-types)
              -- Interesting litmus test: do these two behave the same?
              --     case id        of {..}
              --     case (\v -> v) of {..}
              -- This design choice is discussed in #17790
            ; (scrut', scrut_ty) <- tcScalingUsage mult $ tcInferRho scrut

            ; hasFixedRuntimeRep_syntactic FRRCase scrut_ty
            ; (mult_co_wrap, matches') <- tcCaseMatches tcBody (Scaled mult scrut_ty) matches res_ty
            ; return (HsCase ctxt (mkLHsWrap mult_co_wrap scrut') matches') }

    tcExpr (HsIf XIf GhcRn
    x LHsExpr GhcRn
    pred LHsExpr GhcRn
    b1 LHsExpr GhcRn
    b2) ExpRhoType
    res_ty
      = do { pred'    <- LHsExpr GhcRn -> Type -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    pred Type
    boolTy
           ; (u1,b1') <- tcCollectingUsage $ tcMonoExpr b1 res_ty
           ; (u2,b2') <- tcCollectingUsage $ tcMonoExpr b2 res_ty
           ; tcEmitBindingUsage (supUE u1 u2)
           ; return (HsIf x pred' b1' b2') }

    {-
    Note [MultiWayIf linearity checking]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we'd like to compute the usage environment for

    if | b1 -> e1
       | b2 -> e2
       | otherwise -> e3

    and let u1, u2, v1, v2, v3 denote the usage env for b1, b2, e1, e2, e3
    respectively.

    Since a multi-way if is mere sugar for nested if expressions, the usage
    environment should ideally be u1 + sup(v1, u2 + sup(v2, v3)).
    However, currently we don't support linear guards (#19193). All variables
    used in guards from u1 and u2 will have multiplicity Many.
    But in that case, we have equality u1 + sup(x,y) = sup(u1 + x, y),
                          and likewise u2 + sup(x,y) = sup(u2 + x, y) for any x,y.
    Using this identity, we can just compute sup(u1 + v1, u2 + v2, v3) instead.
    This is simple to do, since we get u_i + v_i directly from tcGRHS.
    If we add linear guards, this code will have to be revisited.
    Not using 'sup' caused #23814.
    -}

    tcExpr (HsMultiIf XMultiIf GhcRn
    _ [LGRHS GhcRn (LHsExpr GhcRn)]
    alts) ExpRhoType
    res_ty
      = do { alts' <- HsMatchContextRn
    -> TcMatchAltChecker HsExpr
    -> [LGRHS GhcRn (LocatedA (HsExpr GhcRn))]
    -> ExpRhoType
    -> TcM [LGRHS GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    forall (body :: * -> *).
    AnnoBody body =>
    HsMatchContextRn
    -> TcMatchAltChecker body
    -> [LGRHS GhcRn (LocatedA (body GhcRn))]
    -> ExpRhoType
    -> TcM [LGRHS GhcTc (LocatedA (body GhcTc))]
    tcGRHSList HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsMatchContext fn
    IfAlt LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    TcMatchAltChecker HsExpr
    tcBody [LGRHS GhcRn (LHsExpr GhcRn)]
    [LGRHS GhcRn (LocatedA (HsExpr GhcRn))]
    alts ExpRhoType
    res_ty
                      -- See Note [MultiWayIf linearity checking]
           ; res_ty <- readExpType res_ty
           ; return (HsMultiIf res_ty alts') }

    tcExpr (HsDo XDo GhcRn
    _ HsDoFlavour
    do_or_lc XRec GhcRn [ExprLStmt GhcRn]
    stmts) ExpRhoType
    res_ty
      = HsDoFlavour
    -> LocatedL [ExprLStmt GhcRn] -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcDoStmts HsDoFlavour
    do_or_lc XRec GhcRn [ExprLStmt GhcRn]
    LocatedL [ExprLStmt GhcRn]
    stmts ExpRhoType
    res_ty

    tcExpr (HsProc XProc GhcRn
    x LPat GhcRn
    pat LHsCmdTop GhcRn
    cmd) ExpRhoType
    res_ty
      = do  { (pat', cmd', coi) <- LPat GhcRn
    -> LHsCmdTop GhcRn
    -> ExpRhoType
    -> TcM (LPat GhcTc, LHsCmdTop GhcTc, TcCoercionR)
    tcProc LPat GhcRn
    pat LHsCmdTop GhcRn
    cmd ExpRhoType
    res_ty
            ; return $ mkHsWrapCo coi (HsProc x pat' cmd') }

    -- Typechecks the static form and wraps it with a call to 'fromStaticPtr'.
    -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable for an overview.
    -- To type check
    --      (static e) :: p a
    -- we want to check (e :: a),
    -- and wrap (static e) in a call to
    --    fromStaticPtr :: IsStatic p => StaticPtr a -> p a

    tcExpr (HsStatic XStatic GhcRn
    fvs LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do  { res_ty          <- ExpRhoType -> TcM Type
    expTypeToType ExpRhoType
    res_ty
            ; (co, (p_ty, expr_ty)) <- matchExpectedAppTy res_ty
            ; (expr', lie)    <- captureConstraints $
                addErrCtxt (hang (text "In the body of a static form:")
                                 2 (ppr expr)
                           ) $
                tcCheckPolyExprNC expr expr_ty

            -- Check that the free variables of the static form are closed.
            -- It's OK to use nonDetEltsUniqSet here as the only side effects of
            -- checkClosedInStaticForm are error messages.
            ; mapM_ checkClosedInStaticForm $ nonDetEltsUniqSet fvs

            -- Require the type of the argument to be Typeable.
            ; typeableClass <- tcLookupClass typeableClassName
            ; typeable_ev <- emitWantedEvVar StaticOrigin $
                      mkTyConApp (classTyCon typeableClass)
                                 [liftedTypeKind, expr_ty]

            -- Insert the constraints of the static form in a global list for later
            -- validation.
            ; emitStaticConstraints lie

            -- Wrap the static form with the 'fromStaticPtr' call.
            ; fromStaticPtr <- newMethodFromName StaticOrigin fromStaticPtrName
                                                 [p_ty]
            ; let wrap = [TyCoVar] -> HsWrapper
    mkWpEvVarApps [TyCoVar
    typeable_ev] HsWrapper -> HsWrapper -> HsWrapper
    <.> [Type] -> HsWrapper
    mkWpTyApps [Type
    expr_ty]
            ; loc <- getSrcSpanM
            ; static_ptr_ty_con <- tcLookupTyCon staticPtrTyConName
            ; return $ mkHsWrapCo co $ HsApp noExtField
                                (L (noAnnSrcSpan loc) $ mkHsWrap wrap fromStaticPtr)
                                (L (noAnnSrcSpan loc) (HsStatic (fvs, mkTyConApp static_ptr_ty_con [expr_ty]) expr'))
            }

    tcExpr (HsEmbTy XEmbTy GhcRn
    _ LHsWcType (NoGhcTc GhcRn)
    _) ExpRhoType
    _ = TcRnMessage -> TcM (HsExpr GhcTc)
    forall a. TcRnMessage -> TcRn a
    failWith TcRnMessage
    TcRnIllegalTypeExpr

    {-
    ************************************************************************
    *                                                                      *
                    Record construction and update
    *                                                                      *
    ************************************************************************
    -}

    tcExpr expr :: HsExpr GhcRn
    expr@(RecordCon { rcon_con :: forall p. HsExpr p -> XRec p (ConLikeP p)
    rcon_con = L SrcSpanAnnN
    loc Name
    con_name
                           , rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
    rcon_flds = HsRecordBinds GhcRn
    rbinds }) ExpRhoType
    res_ty
      = do  { con_like <- Name -> TcM ConLike
    tcLookupConLike Name
    con_name

            ; (con_expr, con_sigma) <- tcInferId con_name
            ; (con_wrap, con_tau)   <- topInstantiate orig con_sigma
                  -- a shallow instantiation should really be enough for
                  -- a data constructor.
            ; let arity = ConLike -> Int
    conLikeArity ConLike
    con_like
                  Right (arg_tys, actual_res_ty) = tcSplitFunTysN arity con_tau

            ; checkTc (conLikeHasBuilder con_like) $
              nonBidirectionalErr (conLikeName con_like)

            ; rbinds' <- tcRecordBinds con_like (map scaledThing arg_tys) rbinds
                       -- It is currently not possible for a record to have
                       -- multiplicities. When they do, `tcRecordBinds` will take
                       -- scaled types instead. Meanwhile, it's safe to take
                       -- `scaledThing` above, as we know all the multiplicities are
                       -- Many.

            ; let rcon_tc = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    con_wrap HsExpr GhcTc
    con_expr
                  expr' = RecordCon { rcon_ext :: XRecordCon GhcTc
    rcon_ext = XRecordCon GhcTc
    HsExpr GhcTc
    rcon_tc
                                    , rcon_con :: XRec GhcTc (ConLikeP GhcTc)
    rcon_con = SrcSpanAnnN -> ConLike -> GenLocated SrcSpanAnnN ConLike
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnN
    loc ConLike
    con_like
                                    , rcon_flds :: HsRecordBinds GhcTc
    rcon_flds = HsRecordBinds GhcTc
    HsRecFields GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    rbinds' }

            ; ret <- tcWrapResultMono expr expr' actual_res_ty res_ty

            -- Check for missing fields.  We do this after type-checking to get
            -- better types in error messages (cf #18869).  For example:
            --     data T a = MkT { x :: a, y :: a }
            --     r = MkT { y = True }
            -- Then we'd like to warn about a missing field `x :: True`, rather than `x :: a0`.
            --
            -- NB: to do this really properly we should delay reporting until typechecking is complete,
            -- via a new `HoleSort`.  But that seems too much work.
            ; checkMissingFields con_like rbinds arg_tys

            ; return ret }
      where
        orig :: CtOrigin
    orig = Name -> CtOrigin
    OccurrenceOf Name
    con_name

    -- Record updates via dot syntax are replaced by expanded expressions
    -- in the renamer. See Note [Overview of record dot syntax] in
    -- GHC.Hs.Expr. This is why we match on 'rupd_flds = Left rbnds' here
    -- and panic otherwise.
    tcExpr expr :: HsExpr GhcRn
    expr@(RecordUpd { rupd_expr :: forall p. HsExpr p -> LHsExpr p
    rupd_expr = LHsExpr GhcRn
    record_expr
                           , rupd_flds :: forall p. HsExpr p -> LHsRecUpdFields p
    rupd_flds =
                               RegularRecUpdFields
                                 { xRecUpdFields :: forall p. LHsRecUpdFields p -> XLHsRecUpdLabels p
    xRecUpdFields = XLHsRecUpdLabels GhcRn
    possible_parents
                                 , recUpdFields :: forall p. LHsRecUpdFields p -> [LHsRecUpdField p p]
    recUpdFields  = [LHsRecUpdField GhcRn GhcRn]
    rbnds }
                           })
           ExpRhoType
    res_ty
      = Bool -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => Bool -> a -> a
    assert ([GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcRn))
          (LocatedA (HsExpr GhcRn)))]
    -> Bool
    forall (f :: * -> *) a. Foldable f => f a -> Bool
    notNull [LHsRecUpdField GhcRn GhcRn]
    [GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcRn))
          (LocatedA (HsExpr GhcRn)))]
    rbnds) (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do  { -- Expand the record update. See Note [Record Updates].
            ; (ds_expr, ds_res_ty, err_ctxt)
                <- LHsExpr GhcRn
    -> NonEmpty (HsRecUpdParent GhcRn)
    -> [LHsRecUpdField GhcRn GhcRn]
    -> ExpRhoType
    -> TcM (HsExpr GhcRn, Type, SDoc)
    expandRecordUpd LHsExpr GhcRn
    record_expr NonEmpty (HsRecUpdParent GhcRn)
    XLHsRecUpdLabels GhcRn
    possible_parents [LHsRecUpdField GhcRn GhcRn]
    rbnds ExpRhoType
    res_ty

              -- Typecheck the expanded expression.
            ; expr' <- addErrCtxt err_ctxt $
                       tcExpr (mkExpandedExpr expr ds_expr) (Check ds_res_ty)
                -- NB: it's important to use ds_res_ty and not res_ty here.
                -- Test case: T18802b.

            ; addErrCtxt err_ctxt $ tcWrapResultMono expr expr' ds_res_ty res_ty
                -- We need to unify the result type of the expanded
                -- expression with the expected result type.
                --
                -- See Note [Unifying result types in tcRecordUpd].
                -- Test case: T10808.
            }

    tcExpr e :: HsExpr GhcRn
    e@(RecordUpd { rupd_flds :: forall p. HsExpr p -> LHsRecUpdFields p
    rupd_flds = OverloadedRecUpdFields {}}) ExpRhoType
    _
      = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcExpr: unexpected overloaded-dot RecordUpd" (SDoc -> TcM (HsExpr GhcTc)) -> SDoc -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    e

    {-
    ************************************************************************
    *                                                                      *
            Arithmetic sequences                    e.g. [a,b..]
            and their parallel-array counterparts   e.g. [: a,b.. :]

    *                                                                      *
    ************************************************************************
    -}

    tcExpr (ArithSeq XArithSeq GhcRn
    _ Maybe (SyntaxExpr GhcRn)
    witness ArithSeqInfo GhcRn
    seq) ExpRhoType
    res_ty
      = Maybe (SyntaxExpr GhcRn)
    -> ArithSeqInfo GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcArithSeq Maybe (SyntaxExpr GhcRn)
    witness ArithSeqInfo GhcRn
    seq ExpRhoType
    res_ty

    {-
    ************************************************************************
    *                                                                      *
                    Record dot syntax
    *                                                                      *
    ************************************************************************
    -}

    -- These terms have been replaced by their expanded expressions in the renamer. See
    -- Note [Overview of record dot syntax].
    tcExpr (HsGetField XGetField GhcRn
    _ LHsExpr GhcRn
    _ XRec GhcRn (DotFieldOcc GhcRn)
    _) ExpRhoType
    _ = String -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> a
    panic String
    "GHC.Tc.Gen.Expr: tcExpr: HsGetField: Not implemented"
    tcExpr (HsProjection XProjection GhcRn
    _ NonEmpty (XRec GhcRn (DotFieldOcc GhcRn))
    _) ExpRhoType
    _ = String -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> a
    panic String
    "GHC.Tc.Gen.Expr: tcExpr: HsProjection: Not implemented"

    {-
    ************************************************************************
    *                                                                      *
                    Template Haskell
    *                                                                      *
    ************************************************************************
    -}

    -- Here we get rid of it and add the finalizers to the global environment.
    -- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice.
    tcExpr (HsTypedSplice XTypedSplice GhcRn
    ext LHsExpr GhcRn
    splice)   ExpRhoType
    res_ty = Name -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcTypedSplice XTypedSplice GhcRn
    Name
    ext LHsExpr GhcRn
    splice ExpRhoType
    res_ty
    tcExpr e :: HsExpr GhcRn
    e@(HsTypedBracket XTypedBracket GhcRn
    _ LHsExpr GhcRn
    body)    ExpRhoType
    res_ty = HsExpr GhcRn -> LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcTypedBracket HsExpr GhcRn
    e LHsExpr GhcRn
    body ExpRhoType
    res_ty

    tcExpr e :: HsExpr GhcRn
    e@(HsUntypedBracket XUntypedBracket GhcRn
    ps HsQuote GhcRn
    body) ExpRhoType
    res_ty = HsExpr GhcRn
    -> HsQuote GhcRn
    -> [PendingRnSplice]
    -> ExpRhoType
    -> TcM (HsExpr GhcTc)
    tcUntypedBracket HsExpr GhcRn
    e HsQuote GhcRn
    body [PendingRnSplice]
    XUntypedBracket GhcRn
    ps ExpRhoType
    res_ty
    tcExpr (HsUntypedSplice XUntypedSplice GhcRn
    splice HsUntypedSplice GhcRn
    _)   ExpRhoType
    res_ty
      -- Since `tcApp` deals with `HsUntypedSplice` (in `splitHsApps`), you might
      -- wonder why we don't delegate to `tcApp` as we do for `HsVar`, etc.
      -- (See the initial block of equations for `tcExpr`.) But we can't do this
      -- for `HsUntypedSplice`; to see why, read Wrinkle (UTS1) in
      -- Note [Looking through Template Haskell splices in splitHsApps] in
      -- GHC.Tc.Gen.Head.
      = do { expr <- HsUntypedSpliceResult (HsExpr GhcRn) -> TcM (HsExpr GhcRn)
    getUntypedSpliceBody XUntypedSplice GhcRn
    HsUntypedSpliceResult (HsExpr GhcRn)
    splice
           ; tcExpr expr res_ty }

    {-
    ************************************************************************
    *                                                                      *
                    Catch-all
    *                                                                      *
    ************************************************************************
    -}

    tcExpr (HsOverLabel {})    ExpRhoType
    ty = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcExpr:HsOverLabel"  (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    ty)
    tcExpr (SectionL {})       ExpRhoType
    ty = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcExpr:SectionL"    (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    ty)
    tcExpr (SectionR {})       ExpRhoType
    ty = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcExpr:SectionR"    (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    ty)

    {-
    ************************************************************************
    *                                                                      *
                    Expansion Expressions (XXExprGhcRn)
    *                                                                      *
    ************************************************************************
    -}

    tcXExpr :: XXExprGhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)

    tcXExpr :: XXExprGhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcXExpr (PopErrCtxt (L SrcSpanAnnA
    loc HsExpr GhcRn
    e)) ExpRhoType
    res_ty
      = TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a. TcM a -> TcM a
    popErrCtxt (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ -- See Part 3 of Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do`
          SrcSpanAnnA -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
          HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    e ExpRhoType
    res_ty

    tcXExpr xe :: XXExprGhcRn
    xe@(ExpandedThingRn HsThingRn
    o HsExpr GhcRn
    e') ExpRhoType
    res_ty
      | OrigStmt ls :: ExprLStmt GhcRn
    ls@(L SrcSpanAnnA
    loc s :: StmtLR GhcRn GhcRn (LocatedA (HsExpr GhcRn))
    s@LetStmt{}) <- HsThingRn
    o
      , HsLet XLet GhcRn
    x HsLocalBinds GhcRn
    binds LHsExpr GhcRn
    e <- HsExpr GhcRn
    e'
      =  do { (binds', wrapper, e') <-  SrcSpanAnnA
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (HsLocalBinds GhcTc, HsWrapper,
          GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (HsLocalBinds GhcTc, HsWrapper,
          GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (IOEnv
       (Env TcGblEnv TcLclEnv)
       (HsLocalBinds GhcTc, HsWrapper,
        GenLocated SrcSpanAnnA (HsExpr GhcTc))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (HsLocalBinds GhcTc, HsWrapper,
           GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (HsLocalBinds GhcTc, HsWrapper,
          GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (HsLocalBinds GhcTc, HsWrapper,
          GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $
                                ExprStmt GhcRn
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (HsLocalBinds GhcTc, HsWrapper,
          GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (HsLocalBinds GhcTc, HsWrapper,
          GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall a. ExprStmt GhcRn -> TcRn a -> TcRn a
    addStmtCtxt ExprStmt GhcRn
    StmtLR GhcRn GhcRn (LocatedA (HsExpr GhcRn))
    s (IOEnv
       (Env TcGblEnv TcLclEnv)
       (HsLocalBinds GhcTc, HsWrapper,
        GenLocated SrcSpanAnnA (HsExpr GhcTc))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (HsLocalBinds GhcTc, HsWrapper,
           GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (HsLocalBinds GhcTc, HsWrapper,
          GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (HsLocalBinds GhcTc, HsWrapper,
          GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $
                                HsLocalBinds GhcRn
    -> TcM (LHsExpr GhcTc)
    -> TcM (HsLocalBinds GhcTc, HsWrapper, LHsExpr GhcTc)
    forall thing.
    HsLocalBinds GhcRn
    -> TcM thing -> TcM (HsLocalBinds GhcTc, HsWrapper, thing)
    tcLocalBinds HsLocalBinds GhcRn
    binds (TcM (LHsExpr GhcTc)
     -> TcM (HsLocalBinds GhcTc, HsWrapper, LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc)
    -> TcM (HsLocalBinds GhcTc, HsWrapper, LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                                LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC LHsExpr GhcRn
    e ExpRhoType
    res_ty -- NB: Do not call tcMonoExpr here as it adds
                                                      -- a duplicate error context
            ; return $ mkExpandedStmtTc ls (HsLet x binds' (mkLHsWrap wrapper e'))
            }
      | OrigStmt ls :: ExprLStmt GhcRn
    ls@(L SrcSpanAnnA
    loc s :: StmtLR GhcRn GhcRn (LocatedA (HsExpr GhcRn))
    s@LastStmt{}) <- HsThingRn
    o
      =  SrcSpanAnnA -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
              ExprStmt GhcRn -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a. ExprStmt GhcRn -> TcRn a -> TcRn a
    addStmtCtxt ExprStmt GhcRn
    StmtLR GhcRn GhcRn (LocatedA (HsExpr GhcRn))
    s (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
              ExprLStmt GhcRn -> HsExpr GhcTc -> HsExpr GhcTc
    mkExpandedStmtTc ExprLStmt GhcRn
    ls (HsExpr GhcTc -> HsExpr GhcTc)
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    e' ExpRhoType
    res_ty
                    -- It is important that we call tcExpr (and not tcApp) here as
                    -- `e` is the last statement's body expression
                    -- and not a HsApp of a generated (>>) or (>>=)
                    -- This improves error messages e.g. tests: DoExpansion1, DoExpansion2, DoExpansion3
      | OrigStmt ls :: ExprLStmt GhcRn
    ls@(L SrcSpanAnnA
    loc StmtLR GhcRn GhcRn (LocatedA (HsExpr GhcRn))
    _) <- HsThingRn
    o
      = SrcSpanAnnA -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
           ExprLStmt GhcRn -> HsExpr GhcTc -> HsExpr GhcTc
    mkExpandedStmtTc ExprLStmt GhcRn
    ls (HsExpr GhcTc -> HsExpr GhcTc)
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp (XXExpr GhcRn -> HsExpr GhcRn
    forall p. XXExpr p -> HsExpr p
    XExpr XXExpr GhcRn
    XXExprGhcRn
    xe) ExpRhoType
    res_ty

    tcXExpr XXExprGhcRn
    xe ExpRhoType
    res_ty = HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp (XXExpr GhcRn -> HsExpr GhcRn
    forall p. XXExpr p -> HsExpr p
    XExpr XXExpr GhcRn
    XXExprGhcRn
    xe) ExpRhoType
    res_ty

    {-
    ************************************************************************
    *                                                                      *
                    Arithmetic sequences [a..b] etc
    *                                                                      *
    ************************************************************************
    -}

    tcArithSeq :: Maybe (SyntaxExpr GhcRn) -> ArithSeqInfo GhcRn -> ExpRhoType
               -> TcM (HsExpr GhcTc)

    tcArithSeq :: Maybe (SyntaxExpr GhcRn)
    -> ArithSeqInfo GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcArithSeq Maybe (SyntaxExpr GhcRn)
    witness seq :: ArithSeqInfo GhcRn
    seq@(From LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do { (wrap, elt_mult, elt_ty, wit') <- Maybe (SyntaxExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, Type, Type, Maybe (SyntaxExpr GhcTc))
    arithSeqEltType Maybe (SyntaxExpr GhcRn)
    witness ExpRhoType
    res_ty
           ; expr' <-tcScalingUsage elt_mult $ tcCheckPolyExpr expr elt_ty
           ; enum_from <- newMethodFromName (ArithSeqOrigin seq)
                                  enumFromName [elt_ty]
           ; return $ mkHsWrap wrap $
             ArithSeq enum_from wit' (From expr') }

    tcArithSeq Maybe (SyntaxExpr GhcRn)
    witness seq :: ArithSeqInfo GhcRn
    seq@(FromThen LHsExpr GhcRn
    expr1 LHsExpr GhcRn
    expr2) ExpRhoType
    res_ty
      = do { (wrap, elt_mult, elt_ty, wit') <- Maybe (SyntaxExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, Type, Type, Maybe (SyntaxExpr GhcTc))
    arithSeqEltType Maybe (SyntaxExpr GhcRn)
    witness ExpRhoType
    res_ty
           ; expr1' <- tcScalingUsage elt_mult $ tcCheckPolyExpr expr1 elt_ty
           ; expr2' <- tcScalingUsage elt_mult $ tcCheckPolyExpr expr2 elt_ty
           ; enum_from_then <- newMethodFromName (ArithSeqOrigin seq)
                                  enumFromThenName [elt_ty]
           ; return $ mkHsWrap wrap $
             ArithSeq enum_from_then wit' (FromThen expr1' expr2') }

    tcArithSeq Maybe (SyntaxExpr GhcRn)
    witness seq :: ArithSeqInfo GhcRn
    seq@(FromTo LHsExpr GhcRn
    expr1 LHsExpr GhcRn
    expr2) ExpRhoType
    res_ty
      = do { (wrap, elt_mult, elt_ty, wit') <- Maybe (SyntaxExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, Type, Type, Maybe (SyntaxExpr GhcTc))
    arithSeqEltType Maybe (SyntaxExpr GhcRn)
    witness ExpRhoType
    res_ty
           ; expr1' <- tcScalingUsage elt_mult $ tcCheckPolyExpr expr1 elt_ty
           ; expr2' <- tcScalingUsage elt_mult $ tcCheckPolyExpr expr2 elt_ty
           ; enum_from_to <- newMethodFromName (ArithSeqOrigin seq)
                                  enumFromToName [elt_ty]
           ; return $ mkHsWrap wrap $
             ArithSeq enum_from_to wit' (FromTo expr1' expr2') }

    tcArithSeq Maybe (SyntaxExpr GhcRn)
    witness seq :: ArithSeqInfo GhcRn
    seq@(FromThenTo LHsExpr GhcRn
    expr1 LHsExpr GhcRn
    expr2 LHsExpr GhcRn
    expr3) ExpRhoType
    res_ty
      = do { (wrap, elt_mult, elt_ty, wit') <- Maybe (SyntaxExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, Type, Type, Maybe (SyntaxExpr GhcTc))
    arithSeqEltType Maybe (SyntaxExpr GhcRn)
    witness ExpRhoType
    res_ty
            ; expr1' <- tcScalingUsage elt_mult $ tcCheckPolyExpr expr1 elt_ty
            ; expr2' <- tcScalingUsage elt_mult $ tcCheckPolyExpr expr2 elt_ty
            ; expr3' <- tcScalingUsage elt_mult $ tcCheckPolyExpr expr3 elt_ty
            ; eft <- newMethodFromName (ArithSeqOrigin seq)
                                  enumFromThenToName [elt_ty]
            ; return $ mkHsWrap wrap $
              ArithSeq eft wit' (FromThenTo expr1' expr2' expr3') }

    -----------------
    arithSeqEltType :: Maybe (SyntaxExpr GhcRn) -> ExpRhoType
                    -> TcM (HsWrapper, Mult, TcType, Maybe (SyntaxExpr GhcTc))
    arithSeqEltType :: Maybe (SyntaxExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, Type, Type, Maybe (SyntaxExpr GhcTc))
    arithSeqEltType Maybe (SyntaxExpr GhcRn)
    Nothing ExpRhoType
    res_ty
      = do { res_ty <- ExpRhoType -> TcM Type
    expTypeToType ExpRhoType
    res_ty
           ; (coi, elt_ty) <- matchExpectedListTy res_ty
           ; return (mkWpCastN coi, OneTy, elt_ty, Nothing) }
    arithSeqEltType (Just SyntaxExpr GhcRn
    fl) ExpRhoType
    res_ty
      = do { ((elt_mult, elt_ty), fl')
               <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Type] -> [Type] -> TcM (Type, Type))
    -> TcM ((Type, Type), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    ListOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    fl [SyntaxOpType
    SynList] ExpRhoType
    res_ty (([Type] -> [Type] -> TcM (Type, Type))
     -> TcM ((Type, Type), SyntaxExprTc))
    -> ([Type] -> [Type] -> TcM (Type, Type))
    -> TcM ((Type, Type), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                  \ [Type
    elt_ty] [Type
    elt_mult] -> (Type, Type) -> TcM (Type, Type)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type
    elt_mult, Type
    elt_ty)
           ; return (idHsWrapper, elt_mult, elt_ty, Just fl') }

    ----------------

    -- | Typecheck an explicit tuple @(a,b,c)@ or @(\#a,b,c\#)@.
    --
    -- Does not handle tuple sections.
    tcCheckExplicitTuple :: [HsTupArg GhcRn]
                         -> [TcSigmaType]
                              -- ^ Argument types.
                              -- This function ensures they all have
                              -- a fixed runtime representation.
                         -> TcM [HsTupArg GhcTc]
    tcCheckExplicitTuple :: [HsTupArg GhcRn] -> [Type] -> TcM [HsTupArg GhcTc]
    tcCheckExplicitTuple [HsTupArg GhcRn]
    args [Type]
    tys
      = do Bool -> TcRn ()
    forall (m :: * -> *). (HasCallStack, Applicative m) => Bool -> m ()
    massert ([HsTupArg GhcRn] -> [Type] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [HsTupArg GhcRn]
    args [Type]
    tys)
           Int -> TcRn ()
    checkTupSize ([HsTupArg GhcRn] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [HsTupArg GhcRn]
    args)
           (Int
     -> HsTupArg GhcRn
     -> Type
     -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc))
    -> [Int] -> [HsTupArg GhcRn] -> [Type] -> TcM [HsTupArg GhcTc]
    forall (m :: * -> *) a b c d.
    Monad m =>
    (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m [d]
    zipWith3M Int
    -> HsTupArg GhcRn
    -> Type
    -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
    go [Int
    1,Int
    2..] [HsTupArg GhcRn]
    args [Type]
    tys
      where
        go :: Int -> HsTupArg GhcRn -> TcType -> TcM (HsTupArg GhcTc)
        go :: Int
    -> HsTupArg GhcRn
    -> Type
    -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
    go Int
    i (Missing {})     Type
    arg_ty
          = String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcCheckExplicitTuple: tuple sections not handled here"
              (Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Int
    i SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    arg_ty)
        go Int
    i (Present XPresent GhcRn
    x LHsExpr GhcRn
    expr) Type
    arg_ty
          = do { expr' <- LHsExpr GhcRn -> Type -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr Type
    arg_ty
               ; (co, _) <- hasFixedRuntimeRep (FRRUnboxedTuple i) arg_ty
               ; return (Present x (mkLHsWrap (mkWpCastN co) expr')) }

    -- | Typecheck an explicit tuple or tuple section by performing type inference.
    tcInferTupArgs :: Boxity
                   -> [HsTupArg GhcRn] -- ^ argument types
                   -> TcM ([HsTupArg GhcTc], [TcSigmaTypeFRR])
    tcInferTupArgs :: Boxity -> [HsTupArg GhcRn] -> TcM ([HsTupArg GhcTc], [Type])
    tcInferTupArgs Boxity
    boxity [HsTupArg GhcRn]
    args
      = do { Int -> TcRn ()
    checkTupSize ([HsTupArg GhcRn] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [HsTupArg GhcRn]
    args)
           ; (Int
     -> HsTupArg GhcRn
     -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc, Type))
    -> [Int] -> [HsTupArg GhcRn] -> TcM ([HsTupArg GhcTc], [Type])
    forall (m :: * -> *) a b c d.
    Monad m =>
    (a -> b -> m (c, d)) -> [a] -> [b] -> m ([c], [d])
    zipWithAndUnzipM Int
    -> HsTupArg GhcRn
    -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc, Type)
    tc_infer_tup_arg [Int
    1,Int
    2..] [HsTupArg GhcRn]
    args }
     where
      tc_infer_tup_arg :: Int -> HsTupArg GhcRn -> TcM (HsTupArg GhcTc, TcSigmaTypeFRR)
      tc_infer_tup_arg :: Int
    -> HsTupArg GhcRn
    -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc, Type)
    tc_infer_tup_arg Int
    i (Missing {})
        = do { mult <- Type -> TcM Type
    newFlexiTyVarTy Type
    multiplicityTy
             ; arg_ty <- new_arg_ty i
             ; return (Missing (Scaled mult arg_ty), arg_ty) }
      tc_infer_tup_arg Int
    i (Present XPresent GhcRn
    x lexpr :: LHsExpr GhcRn
    lexpr@(L SrcSpanAnnA
    l HsExpr GhcRn
    expr))
        = do { (expr', arg_ty) <- case Boxity
    boxity of
                 Boxity
    Unboxed -> FixedRuntimeRepContext
    -> (ExpRhoType -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc, Type)
    forall a.
    FixedRuntimeRepContext -> (ExpRhoType -> TcM a) -> TcM (a, Type)
    tcInferFRR (Int -> FixedRuntimeRepContext
    FRRUnboxedTuple Int
    i) (HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcPolyExpr HsExpr GhcRn
    expr)
                 Boxity
    Boxed   -> do { arg_ty <- Type -> TcM Type
    newFlexiTyVarTy Type
    liftedTypeKind
                               ; L _ expr' <- tcCheckPolyExpr lexpr arg_ty
                               ; return (expr', arg_ty) }
             ; return (Present x (L l expr'), arg_ty) }

      new_arg_ty :: Int -> TcM TcTypeFRR
      new_arg_ty :: Int -> TcM Type
    new_arg_ty Int
    i =
        case Boxity
    boxity of
          Boxity
    Unboxed -> FixedRuntimeRepContext -> TcM Type
    newOpenFlexiFRRTyVarTy (Int -> FixedRuntimeRepContext
    FRRUnboxedTupleSection Int
    i)
          Boxity
    Boxed   -> Type -> TcM Type
    newFlexiTyVarTy Type
    liftedTypeKind

    ---------------------------
    -- See TcType.SyntaxOpType also for commentary
    tcSyntaxOp :: CtOrigin
               -> SyntaxExprRn
               -> [SyntaxOpType]           -- ^ shape of syntax operator arguments
               -> ExpRhoType               -- ^ overall result type
               -> ([TcSigmaType] -> [Mult] -> TcM a) -- ^ Type check any arguments,
                                                     -- takes a type per hole and a
                                                     -- multiplicity per arrow in
                                                     -- the shape.
               -> TcM (a, SyntaxExprTc)
    -- ^ Typecheck a syntax operator
    -- The operator is a variable or a lambda at this stage (i.e. renamer
    -- output)t
    tcSyntaxOp :: forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    orig SyntaxExprRn
    expr [SyntaxOpType]
    arg_tys ExpRhoType
    res_ty
      = CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> SyntaxOpType
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> SyntaxOpType
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOpGen CtOrigin
    orig SyntaxExprRn
    expr [SyntaxOpType]
    arg_tys (ExpRhoType -> SyntaxOpType
    SynType ExpRhoType
    res_ty)

    -- | Slightly more general version of 'tcSyntaxOp' that allows the caller
    -- to specify the shape of the result of the syntax operator
    tcSyntaxOpGen :: CtOrigin
                  -> SyntaxExprRn
                  -> [SyntaxOpType]
                  -> SyntaxOpType
                  -> ([TcSigmaTypeFRR] -> [Mult] -> TcM a)
                  -> TcM (a, SyntaxExprTc)
    tcSyntaxOpGen :: forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> SyntaxOpType
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOpGen CtOrigin
    orig (SyntaxExprRn HsExpr GhcRn
    op) [SyntaxOpType]
    arg_tys SyntaxOpType
    res_ty [Type] -> [Type] -> TcM a
    thing_inside
      = do { (expr, sigma) <- (HsExpr GhcRn, AppCtxt) -> TcM (HsExpr GhcTc, Type)
    tcInferAppHead (HsExpr GhcRn
    op, HsExpr GhcRn -> Int -> SrcSpan -> AppCtxt
    VACall HsExpr GhcRn
    op Int
    0 SrcSpan
    noSrcSpan)
                 -- Ugh!! But all this code is scheduled for demolition anyway
           ; traceTc "tcSyntaxOpGen" (ppr op $$ ppr expr $$ ppr sigma)
           ; (result, expr_wrap, arg_wraps, res_wrap)
               <- tcSynArgA orig op sigma arg_tys res_ty $
                  thing_inside
           ; traceTc "tcSyntaxOpGen" (ppr op $$ ppr expr $$ ppr sigma )
           ; return (result, SyntaxExprTc { syn_expr = mkHsWrap expr_wrap expr
                                          , syn_arg_wraps = arg_wraps
                                          , syn_res_wrap  = res_wrap }) }
    tcSyntaxOpGen CtOrigin
    _ SyntaxExprRn
    NoSyntaxExprRn [SyntaxOpType]
    _ SyntaxOpType
    _ [Type] -> [Type] -> TcM a
    _ = String -> IOEnv (Env TcGblEnv TcLclEnv) (a, SyntaxExprTc)
    forall a. HasCallStack => String -> a
    panic String
    "tcSyntaxOpGen"

    {-
    Note [tcSynArg]
    ~~~~~~~~~~~~~~~
    Because of the rich structure of SyntaxOpType, we must do the
    contra-/covariant thing when working down arrows, to get the
    instantiation vs. skolemisation decisions correct (and, more
    obviously, the orientation of the HsWrappers). We thus have
    two tcSynArgs.
    -}

    -- works on "expected" types, skolemising where necessary
    -- See Note [tcSynArg]
    tcSynArgE :: CtOrigin
              -> HsExpr GhcRn -- ^ the operator to check (for error messages only)
              -> TcSigmaType
              -> SyntaxOpType                -- ^ shape it is expected to have
              -> ([TcSigmaTypeFRR] -> [Mult] -> TcM a) -- ^ check the arguments
              -> TcM (a, HsWrapper)
               -- ^ returns a wrapper :: (type of right shape) "->" (type passed in)
    tcSynArgE :: forall a.
    CtOrigin
    -> HsExpr GhcRn
    -> Type
    -> SyntaxOpType
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, HsWrapper)
    tcSynArgE CtOrigin
    orig HsExpr GhcRn
    op Type
    sigma_ty SyntaxOpType
    syn_ty [Type] -> [Type] -> TcM a
    thing_inside
      = do { (skol_wrap, (result, ty_wrapper))
               <- DeepSubsumptionFlag
    -> UserTypeCtxt
    -> Type
    -> (Type -> TcM (a, HsWrapper))
    -> TcM (HsWrapper, (a, HsWrapper))
    forall result.
    DeepSubsumptionFlag
    -> UserTypeCtxt
    -> Type
    -> (Type -> TcM result)
    -> TcM (HsWrapper, result)
    tcSkolemise DeepSubsumptionFlag
    Shallow UserTypeCtxt
    GenSigCtxt Type
    sigma_ty ((Type -> TcM (a, HsWrapper)) -> TcM (HsWrapper, (a, HsWrapper)))
    -> (Type -> TcM (a, HsWrapper)) -> TcM (HsWrapper, (a, HsWrapper))
    forall a b. (a -> b) -> a -> b
    $ \Type
    rho_ty ->
                  Type -> SyntaxOpType -> TcM (a, HsWrapper)
    go Type
    rho_ty SyntaxOpType
    syn_ty
           ; return (result, skol_wrap <.> ty_wrapper) }
        where
        go :: Type -> SyntaxOpType -> TcM (a, HsWrapper)
    go Type
    rho_ty SyntaxOpType
    SynAny
          = do { result <- [Type] -> [Type] -> TcM a
    thing_inside [Type
    rho_ty] []
               ; return (result, idHsWrapper) }

        go Type
    rho_ty SyntaxOpType
    SynRho   -- same as SynAny, because we skolemise eagerly
          = do { result <- [Type] -> [Type] -> TcM a
    thing_inside [Type
    rho_ty] []
               ; return (result, idHsWrapper) }

        go Type
    rho_ty SyntaxOpType
    SynList
          = do { (list_co, elt_ty) <- Type -> TcM (TcCoercionR, Type)
    matchExpectedListTy Type
    rho_ty
               ; result <- thing_inside [elt_ty] []
               ; return (result, mkWpCastN list_co) }

        go Type
    rho_ty (SynFun SyntaxOpType
    arg_shape SyntaxOpType
    res_shape)
          = do { ( match_wrapper                         -- :: (arg_ty -> res_ty) "->" rho_ty
                 , ( ( (result, arg_ty, res_ty, op_mult)
                     , res_wrapper )                     -- :: res_ty_out "->" res_ty
                   , arg_wrapper1, [], arg_wrapper2 ) )  -- :: arg_ty "->" arg_ty_out
                   <- ExpectedFunTyOrigin
    -> UserTypeCtxt
    -> Int
    -> ExpRhoType
    -> ([ExpPatType]
        -> ExpRhoType
        -> TcM
             (((a, Type, Type, Type), HsWrapper), HsWrapper, [HsWrapper],
              HsWrapper))
    -> TcM
         (HsWrapper,
          (((a, Type, Type, Type), HsWrapper), HsWrapper, [HsWrapper],
           HsWrapper))
    forall a.
    ExpectedFunTyOrigin
    -> UserTypeCtxt
    -> Int
    -> ExpRhoType
    -> ([ExpPatType] -> ExpRhoType -> TcM a)
    -> TcM (HsWrapper, a)
    matchExpectedFunTys ExpectedFunTyOrigin
    herald UserTypeCtxt
    GenSigCtxt Int
    1 (Type -> ExpRhoType
    mkCheckExpType Type
    rho_ty) (([ExpPatType]
      -> ExpRhoType
      -> TcM
           (((a, Type, Type, Type), HsWrapper), HsWrapper, [HsWrapper],
            HsWrapper))
     -> TcM
          (HsWrapper,
           (((a, Type, Type, Type), HsWrapper), HsWrapper, [HsWrapper],
            HsWrapper)))
    -> ([ExpPatType]
        -> ExpRhoType
        -> TcM
             (((a, Type, Type, Type), HsWrapper), HsWrapper, [HsWrapper],
              HsWrapper))
    -> TcM
         (HsWrapper,
          (((a, Type, Type, Type), HsWrapper), HsWrapper, [HsWrapper],
           HsWrapper))
    forall a b. (a -> b) -> a -> b
    $
                      \ [ExpFunPatTy Scaled ExpRhoType
    arg_ty] ExpRhoType
    res_ty ->
                      do { arg_tc_ty <- ExpRhoType -> TcM Type
    expTypeToType (Scaled ExpRhoType -> ExpRhoType
    forall a. Scaled a -> a
    scaledThing Scaled ExpRhoType
    arg_ty)
                         ; res_tc_ty <- expTypeToType res_ty

                             -- another nested arrow is too much for now,
                             -- but I bet we'll never need this
                         ; massertPpr (case arg_shape of
                                       SynFun {} -> Bool
    False;
                                       SyntaxOpType
    _         -> Bool
    True)
                                      (text "Too many nested arrows in SyntaxOpType" $$
                                       pprCtOrigin orig)

                         ; let arg_mult = Scaled ExpRhoType -> Type
    forall a. Scaled a -> Type
    scaledMult Scaled ExpRhoType
    arg_ty
                         ; tcSynArgA orig op arg_tc_ty [] arg_shape $
                           \ [Type]
    arg_results [Type]
    arg_res_mults ->
                           CtOrigin
    -> HsExpr GhcRn
    -> Type
    -> SyntaxOpType
    -> ([Type] -> [Type] -> TcM (a, Type, Type, Type))
    -> TcM ((a, Type, Type, Type), HsWrapper)
    forall a.
    CtOrigin
    -> HsExpr GhcRn
    -> Type
    -> SyntaxOpType
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, HsWrapper)
    tcSynArgE CtOrigin
    orig HsExpr GhcRn
    op Type
    res_tc_ty SyntaxOpType
    res_shape (([Type] -> [Type] -> TcM (a, Type, Type, Type))
     -> TcM ((a, Type, Type, Type), HsWrapper))
    -> ([Type] -> [Type] -> TcM (a, Type, Type, Type))
    -> TcM ((a, Type, Type, Type), HsWrapper)
    forall a b. (a -> b) -> a -> b
    $
                           \ [Type]
    res_results [Type]
    res_res_mults ->
                           do { result <- [Type] -> [Type] -> TcM a
    thing_inside ([Type]
    arg_results [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type]
    res_results) ([Type
    arg_mult] [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type]
    arg_res_mults [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type]
    res_res_mults)
                              ; return (result, arg_tc_ty, res_tc_ty, arg_mult) }}

               ; let fun_wrap = HsWrapper -> HsWrapper -> Scaled Type -> Type -> HsWrapper
    mkWpFun (HsWrapper
    arg_wrapper2 HsWrapper -> HsWrapper -> HsWrapper
    <.> HsWrapper
    arg_wrapper1) HsWrapper
    res_wrapper
                                  (Type -> Type -> Scaled Type
    forall a. Type -> a -> Scaled a
    Scaled Type
    op_mult Type
    arg_ty) Type
    res_ty
                   -- NB: arg_ty comes from matchExpectedFunTys, so it has a
                   -- fixed RuntimeRep, as needed to call mkWpFun.
               ; return (result, match_wrapper <.> fun_wrap) }
          where
            herald :: ExpectedFunTyOrigin
    herald = CtOrigin -> HsExpr GhcRn -> ExpectedFunTyOrigin
    forall (p :: Pass).
    OutputableBndrId p =>
    CtOrigin -> HsExpr (GhcPass p) -> ExpectedFunTyOrigin
    ExpectedFunTySyntaxOp CtOrigin
    orig HsExpr GhcRn
    op

        go Type
    rho_ty (SynType ExpRhoType
    the_ty)
          = do { wrap   <- CtOrigin -> UserTypeCtxt -> ExpRhoType -> Type -> TcM HsWrapper
    tcSubTypePat CtOrigin
    orig UserTypeCtxt
    GenSigCtxt ExpRhoType
    the_ty Type
    rho_ty
               ; result <- thing_inside [] []
               ; return (result, wrap) }

    -- works on "actual" types, instantiating where necessary
    -- See Note [tcSynArg]
    tcSynArgA :: CtOrigin
              -> HsExpr GhcRn -- ^ the operator we are checking (for error messages)
              -> TcSigmaType
              -> [SyntaxOpType]              -- ^ argument shapes
              -> SyntaxOpType                -- ^ result shape
              -> ([TcSigmaTypeFRR] -> [Mult] -> TcM a) -- ^ check the arguments
              -> TcM (a, HsWrapper, [HsWrapper], HsWrapper)
                -- ^ returns a wrapper to be applied to the original function,
                -- wrappers to be applied to arguments
                -- and a wrapper to be applied to the overall expression
    tcSynArgA :: forall a.
    CtOrigin
    -> HsExpr GhcRn
    -> Type
    -> [SyntaxOpType]
    -> SyntaxOpType
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, HsWrapper, [HsWrapper], HsWrapper)
    tcSynArgA CtOrigin
    orig HsExpr GhcRn
    op Type
    sigma_ty [SyntaxOpType]
    arg_shapes SyntaxOpType
    res_shape [Type] -> [Type] -> TcM a
    thing_inside
      = do { (match_wrapper, arg_tys, res_ty)
               <- ExpectedFunTyOrigin
    -> CtOrigin -> Int -> Type -> TcM (HsWrapper, [Scaled Type], Type)
    matchActualFunTys ExpectedFunTyOrigin
    herald CtOrigin
    orig ([SyntaxOpType] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [SyntaxOpType]
    arg_shapes) Type
    sigma_ty
                  -- match_wrapper :: sigma_ty "->" (arg_tys -> res_ty)
           ; ((result, res_wrapper), arg_wrappers)
               <- tc_syn_args_e (map scaledThing arg_tys) arg_shapes $ \ [Type]
    arg_results [Type]
    arg_res_mults ->
                  Type -> SyntaxOpType -> ([Type] -> TcM a) -> TcM (a, HsWrapper)
    forall a.
    Type -> SyntaxOpType -> ([Type] -> TcM a) -> TcM (a, HsWrapper)
    tc_syn_arg    Type
    res_ty  SyntaxOpType
    res_shape  (([Type] -> TcM a) -> TcM (a, HsWrapper))
    -> ([Type] -> TcM a) -> TcM (a, HsWrapper)
    forall a b. (a -> b) -> a -> b
    $ \ [Type]
    res_results ->
                  [Type] -> [Type] -> TcM a
    thing_inside ([Type]
    arg_results [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type]
    res_results) ((Scaled Type -> Type) -> [Scaled Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Scaled Type -> Type
    forall a. Scaled a -> Type
    scaledMult [Scaled Type]
    arg_tys [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type]
    arg_res_mults)
           ; return (result, match_wrapper, arg_wrappers, res_wrapper) }
      where
        herald :: ExpectedFunTyOrigin
    herald = CtOrigin -> HsExpr GhcRn -> ExpectedFunTyOrigin
    forall (p :: Pass).
    OutputableBndrId p =>
    CtOrigin -> HsExpr (GhcPass p) -> ExpectedFunTyOrigin
    ExpectedFunTySyntaxOp CtOrigin
    orig HsExpr GhcRn
    op

        tc_syn_args_e :: [TcSigmaTypeFRR] -> [SyntaxOpType]
                      -> ([TcSigmaTypeFRR] -> [Mult] -> TcM a)
                      -> TcM (a, [HsWrapper])
                        -- the wrappers are for arguments
        tc_syn_args_e :: forall a.
    [Type]
    -> [SyntaxOpType]
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, [HsWrapper])
    tc_syn_args_e (Type
    arg_ty : [Type]
    arg_tys) (SyntaxOpType
    arg_shape : [SyntaxOpType]
    arg_shapes) [Type] -> [Type] -> TcM a
    thing_inside
          = do { ((result, arg_wraps), arg_wrap)
                   <- CtOrigin
    -> HsExpr GhcRn
    -> Type
    -> SyntaxOpType
    -> ([Type] -> [Type] -> TcM (a, [HsWrapper]))
    -> TcM ((a, [HsWrapper]), HsWrapper)
    forall a.
    CtOrigin
    -> HsExpr GhcRn
    -> Type
    -> SyntaxOpType
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, HsWrapper)
    tcSynArgE     CtOrigin
    orig  HsExpr GhcRn
    op Type
    arg_ty  SyntaxOpType
    arg_shape  (([Type] -> [Type] -> TcM (a, [HsWrapper]))
     -> TcM ((a, [HsWrapper]), HsWrapper))
    -> ([Type] -> [Type] -> TcM (a, [HsWrapper]))
    -> TcM ((a, [HsWrapper]), HsWrapper)
    forall a b. (a -> b) -> a -> b
    $ \ [Type]
    arg1_results [Type]
    arg1_mults ->
                      [Type]
    -> [SyntaxOpType]
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, [HsWrapper])
    forall a.
    [Type]
    -> [SyntaxOpType]
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, [HsWrapper])
    tc_syn_args_e          [Type]
    arg_tys [SyntaxOpType]
    arg_shapes (([Type] -> [Type] -> TcM a) -> TcM (a, [HsWrapper]))
    -> ([Type] -> [Type] -> TcM a) -> TcM (a, [HsWrapper])
    forall a b. (a -> b) -> a -> b
    $ \ [Type]
    args_results [Type]
    args_mults ->
                      [Type] -> [Type] -> TcM a
    thing_inside ([Type]
    arg1_results [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type]
    args_results) ([Type]
    arg1_mults [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type]
    args_mults)
               ; return (result, arg_wrap : arg_wraps) }
        tc_syn_args_e [Type]
    _ [SyntaxOpType]
    _ [Type] -> [Type] -> TcM a
    thing_inside = (, []) (a -> (a, [HsWrapper])) -> TcM a -> TcM (a, [HsWrapper])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Type] -> [Type] -> TcM a
    thing_inside [] []

        tc_syn_arg :: TcSigmaTypeFRR -> SyntaxOpType
                   -> ([TcSigmaTypeFRR] -> TcM a)
                   -> TcM (a, HsWrapper)
                      -- the wrapper applies to the overall result
        tc_syn_arg :: forall a.
    Type -> SyntaxOpType -> ([Type] -> TcM a) -> TcM (a, HsWrapper)
    tc_syn_arg Type
    res_ty SyntaxOpType
    SynAny [Type] -> TcM a
    thing_inside
          = do { result <- [Type] -> TcM a
    thing_inside [Type
    res_ty]
               ; return (result, idHsWrapper) }
        tc_syn_arg Type
    res_ty SyntaxOpType
    SynRho [Type] -> TcM a
    thing_inside
          = do { (inst_wrap, rho_ty) <- CtOrigin -> Type -> TcM (HsWrapper, Type)
    topInstantiate CtOrigin
    orig Type
    res_ty
                   -- inst_wrap :: res_ty "->" rho_ty
               ; result <- thing_inside [rho_ty]
               ; return (result, inst_wrap) }
        tc_syn_arg Type
    res_ty SyntaxOpType
    SynList [Type] -> TcM a
    thing_inside
          = do { (inst_wrap, rho_ty) <- CtOrigin -> Type -> TcM (HsWrapper, Type)
    topInstantiate CtOrigin
    orig Type
    res_ty
                   -- inst_wrap :: res_ty "->" rho_ty
               ; (list_co, elt_ty)   <- matchExpectedListTy rho_ty
                   -- list_co :: [elt_ty] ~N rho_ty
               ; result <- thing_inside [elt_ty]
               ; return (result, mkWpCastN (mkSymCo list_co) <.> inst_wrap) }
        tc_syn_arg Type
    _ (SynFun {}) [Type] -> TcM a
    _
          = String -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) (a, HsWrapper)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcSynArgA hits a SynFun" (CtOrigin -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CtOrigin
    orig)
        tc_syn_arg Type
    res_ty (SynType ExpRhoType
    the_ty) [Type] -> TcM a
    thing_inside
          = do { wrap   <- CtOrigin -> UserTypeCtxt -> Type -> ExpRhoType -> TcM HsWrapper
    tcSubType CtOrigin
    orig UserTypeCtxt
    GenSigCtxt Type
    res_ty ExpRhoType
    the_ty
               ; result <- thing_inside []
               ; return (result, wrap) }

    {-
    Note [Push result type in]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    Unify with expected result before type-checking the args so that the
    info from res_ty percolates to args.  This is when we might detect a
    too-few args situation.  (One can think of cases when the opposite
    order would give a better error message.)
    experimenting with putting this first.

    Here's an example where it actually makes a real difference

       class C t a b | t a -> b
       instance C Char a Bool

       data P t a = forall b. (C t a b) => MkP b
       data Q t   = MkQ (forall a. P t a)

       f1, f2 :: Q Char;
       f1 = MkQ (MkP True)
       f2 = MkQ (MkP True :: forall a. P Char a)

    With the change, f1 will type-check, because the 'Char' info from
    the signature is propagated into MkQ's argument. With the check
    in the other order, the extra signature in f2 is reqd.
    -}

    {- *********************************************************************
    *                                                                      *
                     Expanding record update
    *                                                                      *
    ********************************************************************* -}

    {- Note [Record Updates]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    To typecheck a record update, we expand it first.  Suppose we have
        data T p q = T1 { x :: Int, y :: Bool, z :: Char }
                   | T2 { v :: Char }
                   | T3 { x :: Int }
                   | T4 { p :: Float, y :: Bool, x :: Int }
                   | T5
    Then the record update `e { x=e1, y=e2 }` expands as follows

           e { x=e1, y=e2 }
        ===>
           let { x' = e1; y' = e2 } in
           case e of
              T1 _ _ z -> T1 x' y' z
              T4 p _ _ -> T4 p y' x'
    T2, T3 and T5 should not occur, so we omit them from the match.
    The critical part of expansion is to identify T and then T1/T4.

    Wrinkle [Disambiguating fields]

      As explained in Note [Disambiguating record updates] in GHC.Rename.Pat,
      to typecheck a record update we first need to disambiguate the field labels,
      in order to find a parent which has at least one constructor with all of the fields
      being updated.

      As mentioned in Note [Type-directed record disambiguation], we sometimes use
      type-directed disambiguation, although this mechanism is deprecated and
      scheduled for removal via the implementation of GHC proposal #366
      https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0366-no-ambiguous-field-access.rst.

    All in all, this means that when typechecking a record update via expansion,
    we take the following steps:

      (0) Perform a first typechecking pass on the record expression (`e` in the example above),
          to infer the type of the record being updated.
      (1) Disambiguate the record fields (potentially using the type obtained in (0)).
      (2) Expand the record update as described above, using an XXExprGhcRn.
          (a) Create a let-binding to share the record update right-hand sides.
          (b) Expand the record update to a case expression updating all the
              relevant constructors (those that have all of the fields being updated).
      (3) Typecheck the expanded code.

    In (0), we call inferRho to infer the type of the record being updated. This returns the
    inferred type of the record, together with a typechecked expression (of type HsExpr GhcTc)
    and a collection of residual constraints.
    We have no need for the latter two, because we will typecheck again in (D3). So, for
    the time being (and until GHC proposal #366 is implemented), we simply drop them.

    Wrinkle [Using IdSig]

      As noted above, we want to let-bind the updated fields to avoid code duplication:

        let { x' = e1; y' = e2 } in
        case e of
           T1 _ _ z -> T1 x' y' z
           T4 p _ _ -> T4 p y' x'

      However, doing so in a naive way would cause difficulties for type inference.
      For example:

        data R b = MkR { f :: (forall a. a -> a) -> (Int,b), c :: Int }
        foo r = r { f = \ k -> (k 3, k 'x') }

      If we expand to:

        ds_foo r =
          let f' = \ k -> (k 3, k 'x')
          in case r of
            MkR _ b -> MkR f' b

      then we are unable to infer an appropriately polymorphic type for f', because we
      never infer higher-rank types. To circumvent this problem, we proceed as follows:

        1. Obtain general field types by instantiating any of the constructors
           that contain all the necessary fields. (Note that the field type must be
           identical across different constructors of a given data constructor).
        2. Let-bind an 'IdSig' with this type. This amounts to giving the let-bound
           'Id's a partial type signature.

      In the above example, it's as if we wrote:

        ds_foo r =
          let f' :: (forall a. a -> a) -> (Int, _b)
              f' = \ k -> (k 3, k 'x')
          in case r of
            MkR _ b -> MkR f' b

      This allows us to compute the right type for f', and thus accept this record update.

    Note [Type-directed record disambiguation]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    GHC currently supports an additional type-directed disambiguation
    mechanism, which is deprecated and scheduled for removal as part of
    GHC proposal #366 https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0366-no-ambiguous-field-access.rst.

    To perform this disambiguation, when there are multiple possible parents for
    a record update, the renamer defers to the typechecker.
    See GHC.Tc.Gen.Expr.disambiguateRecordBinds, and in particular the auxiliary
    function identifyParentLabels, which picks a parent for the record update
    using the following additional mechanisms:

      (a) Use the type being pushed in, if it is already a TyConApp. The
          following are valid updates at type `R`:

            g :: R -> R
            g x = x { fld1 = 3 }

            g' x = x { fld1 = 3 } :: R

      (b) Use the type signature of the record expression, if it exists and
          is a TyConApp. Thus this is valid update at type `R`:

            h x = (x :: R) { fld1 = 3 }

    Note that this type-directed disambiguation mechanism isn't very robust,
    as it doesn't properly integrate with the rest of the typechecker.
    For example, the following updates will all be rejected as ambiguous:

        let r :: R
            r = blah
        in r { foo = 3 }

        \r. (r { foo = 3 }, r :: R)

    Record updates which require constraint-solving should instead use the
    -XOverloadedRecordUpdate extension, as described in Note [Overview of record dot syntax].

    Note [Unifying result types in tcRecordUpd]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    After expanding and typechecking a record update in the way described in
    Note [Record Updates], we must take care to unify the result types.

    Example:

      type family F (a :: Type) :: Type where {}
      data D a = MkD { fld :: F a }

      f :: F Int -> D Bool -> D Int
      f i r = r { fld = i }

    This record update expands to:

      let x :: F alpha -- metavariable
          x = i
      in case r of
        MkD _ -> MkD x

    Because the type family F is not injective, our only hope for unifying the
    metavariable alpha is through the result type of the record update, which tells
    us that we should unify alpha := Int.

    Test case: T10808.

    Wrinkle [GADT result type in tcRecordUpd]

      When dealing with a GADT, we want to be careful about which result type we use.

      Example:

        data G a b where
          MkG :: { bar :: F a } -> G a Int

        g :: F Int -> G Float b -> G Int b
        g i r = r { bar = i }

        We **do not** want to use the result type from the constructor MkG, which would
        leave us with a result type "G alpha Int". Instead, we should use the result type
        from the GADT header, instantiating as above, to get "G alpha beta" which will get
        unified withy "G Int b".

        Test cases: T18809, HardRecordUpdate.

    -}

    -- | Expands a record update @record_expr { fld1 = e1, fld2 = e2 }@ into a case expression
    -- that matches on the constructors of the record @r@, as described in
    -- Note [Record Updates].
    --
    -- Returns a renamed but not-yet-typechecked expression, together with the
    -- result type of this expanded record update.
    expandRecordUpd :: LHsExpr GhcRn
                          -- ^ @record_expr@: expression to which the record update is applied
                     -> NE.NonEmpty (HsRecUpdParent GhcRn)
                          -- ^ Possible parent 'TyCon'/'PatSyn's for the record update,
                          -- with the associated constructors and field labels
                     -> [LHsRecUpdField GhcRn GhcRn]
                          -- ^ the record update fields
                     -> ExpRhoType
                          -- ^ the expected result type of the record update
                     -> TcM ( HsExpr GhcRn
                               -- Expanded record update expression
                            , TcType
                               -- result type of expanded record update
                            , SDoc
                               -- error context to push when typechecking
                               -- the expanded code
                            )
    expandRecordUpd :: LHsExpr GhcRn
    -> NonEmpty (HsRecUpdParent GhcRn)
    -> [LHsRecUpdField GhcRn GhcRn]
    -> ExpRhoType
    -> TcM (HsExpr GhcRn, Type, SDoc)
    expandRecordUpd LHsExpr GhcRn
    record_expr NonEmpty (HsRecUpdParent GhcRn)
    possible_parents [LHsRecUpdField GhcRn GhcRn]
    rbnds ExpRhoType
    res_ty
      = do {  -- STEP 0: typecheck the record_expr, the record to be updated.
              --
              -- Until GHC proposal #366 is implemented, we still use the type of
              -- the record to disambiguate its fields, so we must infer the record
              -- type here before we can expand. See Wrinkle [Disambiguating fields]
              -- in Note [Record Updates].
           ; ((_, record_rho), _lie) <- IOEnv
      (Env TcGblEnv TcLclEnv)
      (GenLocated SrcSpanAnnA (HsExpr GhcTc), Type)
    -> TcM
         ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Type), WantedConstraints)
    forall a. TcM a -> TcM (a, WantedConstraints)
    captureConstraints    (IOEnv
       (Env TcGblEnv TcLclEnv)
       (GenLocated SrcSpanAnnA (HsExpr GhcTc), Type)
     -> TcM
          ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Type), WantedConstraints))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated SrcSpanAnnA (HsExpr GhcTc), Type)
    -> TcM
         ((GenLocated SrcSpanAnnA (HsExpr GhcTc), Type), WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $ -- see (1) below
                                        Type -> TcM (LHsExpr GhcTc, Type) -> TcM (LHsExpr GhcTc, Type)
    forall a. Type -> TcM a -> TcM a
    tcScalingUsage Type
    ManyTy (TcM (LHsExpr GhcTc, Type) -> TcM (LHsExpr GhcTc, Type))
    -> TcM (LHsExpr GhcTc, Type) -> TcM (LHsExpr GhcTc, Type)
    forall a b. (a -> b) -> a -> b
    $ -- see (2) below
                                        LHsExpr GhcRn -> TcM (LHsExpr GhcTc, Type)
    tcInferRho LHsExpr GhcRn
    record_expr

                -- (1)
                -- Note that we capture, and then discard, the constraints.
                -- This `tcInferRho` is used *only* to identify the data type,
                -- so we can deal with field disambiguation.
                -- Then we are going to generate a expanded record update, including `record_expr`,
                -- and typecheck it from scratch.  We don't want to generate the constraints twice!

                -- (2)
                -- Record update drops some of the content of the record (namely the
                -- content of the field being updated). As a consequence, unless the
                -- field being updated is unrestricted in the record, we need an
                -- unrestricted record. Currently, we simply always require an
                -- unrestricted record.
                --
                -- Consider the following example:
                --
                -- data R a = R { self :: a }
                -- bad :: a ⊸ ()
                -- bad x = let r = R x in case r { self = () } of { R x' -> x' }
                --
                -- This should definitely *not* typecheck.

           -- STEP 1: disambiguate the record update by computing a single parent
           --         which has a constructor with all of the fields being updated.
           --
           -- See Note [Disambiguating record updates] in GHC.Rename.Pat.
           ; (cons, rbinds)
               <- disambiguateRecordBinds record_expr record_rho possible_parents rbnds res_ty
           ; let upd_flds = (GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
          (LocatedA (HsExpr GhcRn)))
     -> AmbiguousFieldOcc GhcTc)
    -> [GenLocated
          SrcSpanAnnA
          (HsFieldBind
             (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
             (LocatedA (HsExpr GhcRn)))]
    -> [AmbiguousFieldOcc GhcTc]
    forall a b. (a -> b) -> [a] -> [b]
    map (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc)
    -> AmbiguousFieldOcc GhcTc
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc)
     -> AmbiguousFieldOcc GhcTc)
    -> (GenLocated
          SrcSpanAnnA
          (HsFieldBind
             (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
             (LocatedA (HsExpr GhcRn)))
        -> GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
    -> GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
            (LocatedA (HsExpr GhcRn)))
    -> AmbiguousFieldOcc GhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsFieldBind
      (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
      (LocatedA (HsExpr GhcRn))
    -> GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc)
    forall lhs rhs. HsFieldBind lhs rhs -> lhs
    hfbLHS (HsFieldBind
       (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
       (LocatedA (HsExpr GhcRn))
     -> GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
    -> (GenLocated
          SrcSpanAnnA
          (HsFieldBind
             (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
             (LocatedA (HsExpr GhcRn)))
        -> HsFieldBind
             (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
             (LocatedA (HsExpr GhcRn)))
    -> GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
            (LocatedA (HsExpr GhcRn)))
    -> GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
         (LocatedA (HsExpr GhcRn)))
    -> HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
         (LocatedA (HsExpr GhcRn))
    forall l e. GenLocated l e -> e
    unLoc) [GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcTc))
          (LocatedA (HsExpr GhcRn)))]
    rbinds
                 sel_ids      = (AmbiguousFieldOcc GhcTc -> TyCoVar)
    -> [AmbiguousFieldOcc GhcTc] -> [TyCoVar]
    forall a b. (a -> b) -> [a] -> [b]
    map AmbiguousFieldOcc GhcTc -> TyCoVar
    selectorAmbiguousFieldOcc [AmbiguousFieldOcc GhcTc]
    upd_flds
                 upd_fld_names = (TyCoVar -> Name) -> [TyCoVar] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TyCoVar -> Name
    idName [TyCoVar]
    sel_ids
                 relevant_cons = UniqSet ConLike -> [ConLike]
    forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet UniqSet ConLike
    cons
                 relevant_con = [ConLike] -> ConLike
    forall a. HasCallStack => [a] -> a
    head [ConLike]
    relevant_cons

          -- STEP 2: expand the record update.
          --
          --  (a) Create new variables for the fields we are updating,
          --      so that we can share them across constructors.
          --
          --      Example:
          --
          --          e { x=e1, y=e2 }
          --
          --        We want to let-bind variables to `e1` and `e2`:
          --
          --          let x' :: Int
          --              x' = e1
          --              y' :: Bool
          --              y' = e2
          --          in ...

             -- Instantiate the type variables of any relevant constuctor
             -- with metavariables to obtain a type for each 'Id'.
             -- This will allow us to have 'Id's with polymorphic types
             -- by using 'IdSig'. See Wrinkle [Using IdSig] in Note [Record Updates].
           ; let (univ_tvs, ex_tvs, eq_spec, _, _, arg_tys, con_res_ty) = conLikeFullSig relevant_con
           ; (subst, tc_tvs) <- newMetaTyVars (univ_tvs ++ ex_tvs)
           ; let (actual_univ_tys, _actual_ex_tys) = splitAtList univ_tvs $ map mkTyVarTy tc_tvs

                 -- See Wrinkle [GADT result type in tcRecordUpd]
                 -- for an explanation of the following.
                 ds_res_ty = case ConLike
    relevant_con of
                   RealDataCon DataCon
    con
                     | Bool -> Bool
    not ([EqSpec] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [EqSpec]
    eq_spec) -- We only need to do this if we have actual GADT equalities.
                     -> TyCon -> [Type] -> Type
    mkFamilyTyConApp (DataCon -> TyCon
    dataConTyCon DataCon
    con) [Type]
    actual_univ_tys
                   ConLike
    _ -> HasDebugCallStack => Subst -> Type -> Type
    Subst -> Type -> Type
    substTy Subst
    subst Type
    con_res_ty

           -- Gather pairs of let-bound Ids and their right-hand sides,
           -- e.g. (x', e1), (y', e2), ...
           ; let mk_upd_id :: Name -> LHsFieldBind GhcTc fld (LHsExpr GhcRn) -> TcM (Name, (TcId, LHsExpr GhcRn))
                 mk_upd_id Name
    fld_nm (L SrcSpanAnnA
    _ HsFieldBind fld (LocatedA (HsExpr GhcRn))
    rbind)
                   = do { let Scaled Type
    _ Type
    arg_ty = NameEnv (Scaled Type) -> Name -> Scaled Type
    forall a. NameEnv a -> Name -> a
    lookupNameEnv_NF NameEnv (Scaled Type)
    arg_ty_env Name
    fld_nm
                              nm_occ :: OccName
    nm_occ = RdrName -> OccName
    rdrNameOcc (RdrName -> OccName) -> (Name -> RdrName) -> Name -> OccName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> RdrName
    nameRdrName (Name -> OccName) -> Name -> OccName
    forall a b. (a -> b) -> a -> b
    $ Name
    fld_nm
                              actual_arg_ty :: Type
    actual_arg_ty = HasDebugCallStack => Subst -> Type -> Type
    Subst -> Type -> Type
    substTy Subst
    subst Type
    arg_ty
                              rhs :: LocatedA (HsExpr GhcRn)
    rhs = HsFieldBind fld (LocatedA (HsExpr GhcRn))
    -> LocatedA (HsExpr GhcRn)
    forall lhs rhs. HsFieldBind lhs rhs -> rhs
    hfbRHS HsFieldBind fld (LocatedA (HsExpr GhcRn))
    rbind
                        ; (_co, actual_arg_ty) <- HasDebugCallStack =>
    FixedRuntimeRepContext -> Type -> TcM (TcCoercionR, Type)
    FixedRuntimeRepContext -> Type -> TcM (TcCoercionR, Type)
    hasFixedRuntimeRep (Name -> HsExpr GhcRn -> FixedRuntimeRepContext
    FRRRecordUpdate Name
    fld_nm (LocatedA (HsExpr GhcRn) -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LocatedA (HsExpr GhcRn)
    rhs)) Type
    actual_arg_ty
                          -- We get a better error message by doing a (redundant) representation-polymorphism check here,
                          -- rather than delaying until the typechecker typechecks the let-bindings,
                          -- because the let-bound Ids have internal names.
                          -- (As we will typecheck the let-bindings later, we can drop this coercion here.)
                          -- See RepPolyRecordUpdate test.
                        ; nm <- newNameAt nm_occ generatedSrcSpan
                        ; let id = HasDebugCallStack => Name -> Type -> Type -> TyCoVar
    Name -> Type -> Type -> TyCoVar
    mkLocalId Name
    nm Type
    ManyTy Type
    actual_arg_ty
                          -- NB: create fresh names to avoid any accidental shadowing
                          -- occurring in the RHS expressions when creating the let bindings:
                          --
                          --  let x1 = e1; x2 = e2; ...
                          --
                          -- Above, we use multiplicity Many rather than the one associated to arg_ty.
                          -- Normally, there shouldn't be a difference, since it's a let binding.
                          -- But -XStrict can convert the let to a case, and this causes issues
                          -- in test LinearRecUpd. Since we don't support linear record updates,
                          -- using Many is simple and safe.
                        ; return (fld_nm, (id, rhs))
                        }
                 arg_ty_env = [(Name, Scaled Type)] -> NameEnv (Scaled Type)
    forall a. [(Name, a)] -> NameEnv a
    mkNameEnv
                            ([(Name, Scaled Type)] -> NameEnv (Scaled Type))
    -> [(Name, Scaled Type)] -> NameEnv (Scaled Type)
    forall a b. (a -> b) -> a -> b
    $ (FieldLabel -> Scaled Type -> (Name, Scaled Type))
    -> [FieldLabel] -> [Scaled Type] -> [(Name, Scaled Type)]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\ FieldLabel
    lbl Scaled Type
    arg_ty -> (FieldLabel -> Name
    flSelector FieldLabel
    lbl, Scaled Type
    arg_ty))
                                (ConLike -> [FieldLabel]
    conLikeFieldLabels ConLike
    relevant_con)
                                [Scaled Type]
    arg_tys

           ; traceTc "tcRecordUpd" $
               vcat [ text "upd_fld_names:" <+> ppr upd_fld_names
                    , text "relevant_cons:" <+> ppr relevant_cons ]

           ; upd_ids <- zipWithM mk_upd_id upd_fld_names rbinds
           ; let updEnv :: UniqMap Name (Id, LHsExpr GhcRn)
                 updEnv = [(Name, (TyCoVar, LHsExpr GhcRn))]
    -> UniqMap Name (TyCoVar, LHsExpr GhcRn)
    forall k a. Uniquable k => [(k, a)] -> UniqMap k a
    listToUniqMap ([(Name, (TyCoVar, LHsExpr GhcRn))]
     -> UniqMap Name (TyCoVar, LHsExpr GhcRn))
    -> [(Name, (TyCoVar, LHsExpr GhcRn))]
    -> UniqMap Name (TyCoVar, LHsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ [(Name, (TyCoVar, LHsExpr GhcRn))]
    [(Name, (TyCoVar, LocatedA (HsExpr GhcRn)))]
    upd_ids

                 make_pat :: ConLike -> LMatch GhcRn (LHsExpr GhcRn)
                 -- As explained in Note [Record Updates], to expand
                 --
                 --   e { x=e1, y=e2 }
                 --
                 -- we generate a case statement, with an equation for
                 -- each constructor of the record. For example, for
                 -- the constructor
                 --
                 --   T1 :: { x :: Int, y :: Bool, z :: Char } -> T p q
                 --
                 -- we let-bind x' = e1, y' = e2 and generate the equation:
                 --
                 --   T1 _ _ z -> T1 x' y' z
                 make_pat ConLike
    conLike = HsMatchContext (LIdP (NoGhcTc GhcRn))
    -> [LPat GhcRn]
    -> LocatedA (HsExpr GhcRn)
    -> LMatch GhcRn (LocatedA (HsExpr GhcRn))
    forall (p :: Pass) (body :: * -> *).
    (Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ SrcSpanAnnA,
     Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
     ~ EpAnn NoEpAnns) =>
    HsMatchContext (LIdP (NoGhcTc (GhcPass p)))
    -> [LPat (GhcPass p)]
    -> LocatedA (body (GhcPass p))
    -> LMatch (GhcPass p) (LocatedA (body (GhcPass p)))
    mkSimpleMatch HsMatchContext (LIdP (NoGhcTc GhcRn))
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsMatchContext fn
    RecUpd [LPat GhcRn
    pat] LocatedA (HsExpr GhcRn)
    rhs
                   where
                     ([GenLocated SrcSpanAnnA (Pat GhcRn)]
    lhs_con_pats, [LocatedA (HsExpr GhcRn)]
    rhs_con_args)
                        = (Int
     -> FieldLabel
     -> (GenLocated SrcSpanAnnA (Pat GhcRn), LocatedA (HsExpr GhcRn)))
    -> [Int]
    -> [FieldLabel]
    -> ([GenLocated SrcSpanAnnA (Pat GhcRn)],
        [LocatedA (HsExpr GhcRn)])
    forall a b c d. (a -> b -> (c, d)) -> [a] -> [b] -> ([c], [d])
    zipWithAndUnzip Int -> FieldLabel -> (LPat GhcRn, LHsExpr GhcRn)
    Int
    -> FieldLabel
    -> (GenLocated SrcSpanAnnA (Pat GhcRn), LocatedA (HsExpr GhcRn))
    mk_con_arg [Int
    1..] [FieldLabel]
    con_fields
                     pat :: LPat GhcRn
    pat = Name -> [LPat GhcRn] -> LPat GhcRn
    genSimpleConPat Name
    con [LPat GhcRn]
    [GenLocated SrcSpanAnnA (Pat GhcRn)]
    lhs_con_pats
                     rhs :: LocatedA (HsExpr GhcRn)
    rhs = HsExpr GhcRn -> LocatedA (HsExpr GhcRn)
    forall an a. NoAnn an => a -> LocatedAn an a
    wrapGenSpan (HsExpr GhcRn -> LocatedA (HsExpr GhcRn))
    -> HsExpr GhcRn -> LocatedA (HsExpr GhcRn)
    forall a b. (a -> b) -> a -> b
    $ Name -> [LHsExpr GhcRn] -> HsExpr GhcRn
    genHsApps Name
    con [LHsExpr GhcRn]
    [LocatedA (HsExpr GhcRn)]
    rhs_con_args
                     con :: Name
    con = ConLike -> Name
    conLikeName ConLike
    conLike
                     con_fields :: [FieldLabel]
    con_fields = ConLike -> [FieldLabel]
    conLikeFieldLabels ConLike
    conLike

                 mk_con_arg :: Int
                            -> FieldLabel
                            -> ( LPat GhcRn
                                  -- LHS constructor pattern argument
                               , LHsExpr GhcRn )
                                  -- RHS constructor argument
                 mk_con_arg Int
    i FieldLabel
    fld_lbl =
                   -- The following generates the pattern matches of the expanded `case` expression.
                   -- For fields being updated (for example `x`, `y` in T1 and T4 in Note [Record Updates]),
                   -- wildcards are used to avoid creating unused variables.
                   case UniqMap Name (TyCoVar, LocatedA (HsExpr GhcRn))
    -> Name -> Maybe (TyCoVar, LocatedA (HsExpr GhcRn))
    forall k a. Uniquable k => UniqMap k a -> k -> Maybe a
    lookupUniqMap UniqMap Name (TyCoVar, LHsExpr GhcRn)
    UniqMap Name (TyCoVar, LocatedA (HsExpr GhcRn))
    updEnv (Name -> Maybe (TyCoVar, LocatedA (HsExpr GhcRn)))
    -> Name -> Maybe (TyCoVar, LocatedA (HsExpr GhcRn))
    forall a b. (a -> b) -> a -> b
    $ FieldLabel -> Name
    flSelector FieldLabel
    fld_lbl of
                     -- Field is being updated: LHS = wildcard pattern, RHS = appropriate let-bound Id.
                     Just (TyCoVar
    upd_id, LocatedA (HsExpr GhcRn)
    _) -> (LPat GhcRn
    genWildPat, Name -> LHsExpr GhcRn
    genLHsVar (TyCoVar -> Name
    idName TyCoVar
    upd_id))
                     -- Field is not being updated: LHS = variable pattern, RHS = that same variable.
                     Maybe (TyCoVar, LocatedA (HsExpr GhcRn))
    _  -> let fld_nm :: Name
    fld_nm = Unique -> OccName -> SrcSpan -> Name
    mkInternalName (Int -> Unique
    mkBuiltinUnique Int
    i)
                                          (Name -> OccName
    nameOccName (Name -> OccName) -> Name -> OccName
    forall a b. (a -> b) -> a -> b
    $ FieldLabel -> Name
    flSelector (FieldLabel -> Name) -> FieldLabel -> Name
    forall a b. (a -> b) -> a -> b
    $ FieldLabel
    fld_lbl)
                                          SrcSpan
    generatedSrcSpan
                           in (Name -> LPat GhcRn
    genVarPat Name
    fld_nm, Name -> LHsExpr GhcRn
    genLHsVar Name
    fld_nm)

           -- STEP 2 (b): expand to HsCase, as per note [Record Updates]
           ; let ds_expr :: HsExpr GhcRn
                 ds_expr = XLet GhcRn -> HsLocalBinds GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
    forall p. XLet p -> HsLocalBinds p -> LHsExpr p -> HsExpr p
    HsLet XLet GhcRn
    NoExtField
    noExtField HsLocalBinds GhcRn
    let_binds (SrcSpanAnnA -> HsExpr GhcRn -> LocatedA (HsExpr GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    gen HsExpr GhcRn
    case_expr)

                 case_expr :: HsExpr GhcRn
                 case_expr = XCase GhcRn
    -> LHsExpr GhcRn
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    -> HsExpr GhcRn
    forall p.
    XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
    HsCase XCase GhcRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    forall fn. HsMatchContext fn
    RecUpd LHsExpr GhcRn
    record_expr
                           (MatchGroup GhcRn (LHsExpr GhcRn) -> HsExpr GhcRn)
    -> MatchGroup GhcRn (LHsExpr GhcRn) -> HsExpr GhcRn
    forall a b. (a -> b) -> a -> b
    $ Origin
    -> LocatedL [LocatedA (Match GhcRn (LocatedA (HsExpr GhcRn)))]
    -> MatchGroup GhcRn (LocatedA (HsExpr GhcRn))
    forall (p :: Pass) (body :: * -> *).
    AnnoBody p body =>
    Origin
    -> LocatedL
         [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
    -> MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
    mkMatchGroup (GenReason -> DoPmc -> Origin
    Generated GenReason
    OtherExpansion DoPmc
    DoPmc) ([LocatedA (Match GhcRn (LocatedA (HsExpr GhcRn)))]
    -> LocatedL [LocatedA (Match GhcRn (LocatedA (HsExpr GhcRn)))]
    forall an a. NoAnn an => a -> LocatedAn an a
    wrapGenSpan [LMatch GhcRn (LHsExpr GhcRn)]
    [LocatedA (Match GhcRn (LocatedA (HsExpr GhcRn)))]
    matches)
                 matches :: [LMatch GhcRn (LHsExpr GhcRn)]
                 matches = (ConLike -> LocatedA (Match GhcRn (LocatedA (HsExpr GhcRn))))
    -> [ConLike] -> [LocatedA (Match GhcRn (LocatedA (HsExpr GhcRn)))]
    forall a b. (a -> b) -> [a] -> [b]
    map ConLike -> LMatch GhcRn (LHsExpr GhcRn)
    ConLike -> LocatedA (Match GhcRn (LocatedA (HsExpr GhcRn)))
    make_pat [ConLike]
    relevant_cons

                 let_binds :: HsLocalBindsLR GhcRn GhcRn
                 let_binds = XHsValBinds GhcRn GhcRn
    -> HsValBindsLR GhcRn GhcRn -> HsLocalBinds GhcRn
    forall idL idR.
    XHsValBinds idL idR
    -> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
    HsValBinds XHsValBinds GhcRn GhcRn
    EpAnn AnnList
    forall a. NoAnn a => a
    noAnn (HsValBindsLR GhcRn GhcRn -> HsLocalBinds GhcRn)
    -> HsValBindsLR GhcRn GhcRn -> HsLocalBinds GhcRn
    forall a b. (a -> b) -> a -> b
    $ XXValBindsLR GhcRn GhcRn -> HsValBindsLR GhcRn GhcRn
    forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
    XValBindsLR
                           (XXValBindsLR GhcRn GhcRn -> HsValBindsLR GhcRn GhcRn)
    -> XXValBindsLR GhcRn GhcRn -> HsValBindsLR GhcRn GhcRn
    forall a b. (a -> b) -> a -> b
    $ [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> NHsValBindsLR GhcRn
    forall idL.
    [(RecFlag, LHsBinds idL)] -> [LSig GhcRn] -> NHsValBindsLR idL
    NValBinds [(RecFlag, LHsBinds GhcRn)]
    upd_ids_lhs (((Name, (TyCoVar, LocatedA (HsExpr GhcRn)))
     -> GenLocated SrcSpanAnnA (Sig GhcRn))
    -> [(Name, (TyCoVar, LocatedA (HsExpr GhcRn)))]
    -> [GenLocated SrcSpanAnnA (Sig GhcRn)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, (TyCoVar, LHsExpr GhcRn)) -> LSig GhcRn
    (Name, (TyCoVar, LocatedA (HsExpr GhcRn)))
    -> GenLocated SrcSpanAnnA (Sig GhcRn)
    mk_idSig [(Name, (TyCoVar, LocatedA (HsExpr GhcRn)))]
    upd_ids)
                 upd_ids_lhs :: [(RecFlag, LHsBindsLR GhcRn GhcRn)]
                 upd_ids_lhs = [ (RecFlag
    NonRecursive, LHsBind GhcRn -> LHsBinds GhcRn
    forall a. a -> Bag a
    unitBag (LHsBind GhcRn -> LHsBinds GhcRn)
    -> LHsBind GhcRn -> LHsBinds GhcRn
    forall a b. (a -> b) -> a -> b
    $ Name -> [LPat GhcRn] -> LHsExpr GhcRn -> LHsBind GhcRn
    genSimpleFunBind (TyCoVar -> Name
    idName TyCoVar
    id) [] LHsExpr GhcRn
    LocatedA (HsExpr GhcRn)
    rhs)
                               | (Name
    _, (TyCoVar
    id, LocatedA (HsExpr GhcRn)
    rhs)) <- [(Name, (TyCoVar, LocatedA (HsExpr GhcRn)))]
    upd_ids ]
                 mk_idSig :: (Name, (Id, LHsExpr GhcRn)) -> LSig GhcRn
                 mk_idSig (Name
    _, (TyCoVar
    id, LHsExpr GhcRn
    _)) = SrcSpanAnnA -> Sig GhcRn -> GenLocated SrcSpanAnnA (Sig GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    gen (Sig GhcRn -> GenLocated SrcSpanAnnA (Sig GhcRn))
    -> Sig GhcRn -> GenLocated SrcSpanAnnA (Sig GhcRn)
    forall a b. (a -> b) -> a -> b
    $ XXSig GhcRn -> Sig GhcRn
    forall pass. XXSig pass -> Sig pass
    XSig (XXSig GhcRn -> Sig GhcRn) -> XXSig GhcRn -> Sig GhcRn
    forall a b. (a -> b) -> a -> b
    $ TyCoVar -> IdSig
    IdSig TyCoVar
    id
                   -- We let-bind variables using 'IdSig' in order to accept
                   -- record updates involving higher-rank types.
                   -- See Wrinkle [Using IdSig] in Note [Record Updates].
                 gen = SrcSpan -> SrcSpanAnnA
    forall e. HasAnnotation e => SrcSpan -> e
    noAnnSrcSpan SrcSpan
    generatedSrcSpan

            ; traceTc "expandRecordUpd" $
                vcat [ text "relevant_con:" <+> ppr relevant_con
                     , text "res_ty:" <+> ppr res_ty
                     , text "ds_res_ty:" <+> ppr ds_res_ty
                     ]

            ; let cons = [ConLike] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [ConLike]
    relevant_cons
                  err_lines =
                    (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "In a record update at field" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [Name] -> SDoc
    forall a. [a] -> SDoc
    plural [Name]
    upd_fld_names SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Name] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [Name]
    upd_fld_names SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    :)
                    ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ case ConLike
    relevant_con of
                         RealDataCon DataCon
    con ->
                            [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "with type constructor" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (DataCon -> TyCon
    dataConTyCon DataCon
    con))
                            , String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "data constructor" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [ConLike] -> SDoc
    forall a. [a] -> SDoc
    plural [ConLike]
    relevant_cons SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    cons ]
                         PatSynCon {} ->
                            [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "with pattern synonym" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [ConLike] -> SDoc
    forall a. [a] -> SDoc
    plural [ConLike]
    relevant_cons SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    cons ]
                    [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ if [TyCoVar] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyCoVar]
    ex_tvs
                       then []
                       else [ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "existential variable" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> [TyCoVar] -> SDoc
    forall a. [a] -> SDoc
    plural [TyCoVar]
    ex_tvs SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [TyCoVar] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TyCoVar]
    ex_tvs ]
                  err_ctxt = [SDoc] -> SDoc
    make_lines_msg [SDoc]
    err_lines

            ; return (ds_expr, ds_res_ty, err_ctxt) }

    -- | Pretty-print a collection of lines, adding commas at the end of each line,
    -- and adding "and" to the start of the last line.
    make_lines_msg :: [SDoc] -> SDoc
    make_lines_msg :: [SDoc] -> SDoc
    make_lines_msg []      = SDoc
    forall doc. IsOutput doc => doc
    empty
    make_lines_msg [SDoc
    last]  = SDoc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SDoc
    last SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    dot
    make_lines_msg [SDoc
    l1,SDoc
    l2] = SDoc
    l1 SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "and" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    l2 SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    dot
    make_lines_msg (SDoc
    l:[SDoc]
    ls)  = SDoc
    l SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    comma SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ [SDoc] -> SDoc
    make_lines_msg [SDoc]
    ls

    {- *********************************************************************
    *                                                                      *
                     Record bindings
    *                                                                      *
    **********************************************************************-}

    -- | Disambiguate the fields in a record update.
    --
    -- Most of the disambiguation has been done by the renamer; this function
    -- performs a final type-directed disambiguation pass, as explained in
    -- Note [Type-directed record disambiguation].
    disambiguateRecordBinds :: LHsExpr GhcRn -> TcRhoType
                            -> NE.NonEmpty (HsRecUpdParent GhcRn)
                            -> [LHsRecUpdField GhcRn GhcRn] -> ExpRhoType
                            -> TcM (UniqSet ConLike, [LHsRecUpdField GhcTc GhcRn])
    disambiguateRecordBinds :: LHsExpr GhcRn
    -> Type
    -> NonEmpty (HsRecUpdParent GhcRn)
    -> [LHsRecUpdField GhcRn GhcRn]
    -> ExpRhoType
    -> TcM (UniqSet ConLike, [LHsRecUpdField GhcTc GhcRn])
    disambiguateRecordBinds LHsExpr GhcRn
    record_expr Type
    record_rho NonEmpty (HsRecUpdParent GhcRn)
    possible_parents [LHsRecUpdField GhcRn GhcRn]
    rbnds ExpRhoType
    res_ty
      = do { fam_inst_envs <- TcM FamInstEnvs
    tcGetFamInstEnvs
             -- Identify a single parent, using type-directed disambiguation
             -- if necessary. (Note that type-directed disambiguation of
             -- record field updates is is scheduled for removal, as per
             -- Note [Type-directed record disambiguation].)
           ; TcRecUpdParent
               { tcRecUpdLabels = lbls
               , tcRecUpdCons   = cons }
                 <- identifyParentLabels fam_inst_envs possible_parents
             -- Pick the right selector with that parent for each field
           ; rbnds' <- zipWithM lookupField (NE.toList lbls) rbnds
           ; return (cons, rbnds') }
      where

        -- Try to identify a single parent, using type-directed disambiguation.
        --
        -- Any non-type-directed disambiguation will have been done already.
        -- See GHC.Rename.Env.lookupRecUpdFields.
        identifyParentLabels :: FamInstEnvs
                             -> NE.NonEmpty (HsRecUpdParent GhcRn)
                             -> TcM (HsRecUpdParent GhcTc)
        identifyParentLabels :: FamInstEnvs
    -> NonEmpty (HsRecUpdParent GhcRn) -> TcM (HsRecUpdParent GhcTc)
    identifyParentLabels FamInstEnvs
    fam_inst_envs NonEmpty (HsRecUpdParent GhcRn)
    possible_parents
          = case NonEmpty (HsRecUpdParent GhcRn)
    possible_parents of

            -- Exactly one possible parent for the record update!
            HsRecUpdParent GhcRn
    p NE.:| [] -> HsRecUpdParent GhcRn -> TcM (HsRecUpdParent GhcTc)
    lookup_parent_flds HsRecUpdParent GhcRn
    p

            -- Multiple possible parents: try harder to disambiguate.
            -- Can we get a parent TyCon from the pushed-in type?
            --
            -- See (a) in Note [Type-directed record disambiguation] in GHC.Rename.Pat.
            HsRecUpdParent GhcRn
    _ NE.:| HsRecUpdParent GhcRn
    _ : [HsRecUpdParent GhcRn]
    _
              | Just TyCon
    tc <- FamInstEnvs -> ExpRhoType -> Maybe TyCon
    tyConOfET FamInstEnvs
    fam_inst_envs ExpRhoType
    res_ty
              -> do { NonEmpty (HsRecUpdParent GhcRn) -> TyCon -> TcRn ()
    reportAmbiguousUpdate NonEmpty (HsRecUpdParent GhcRn)
    possible_parents TyCon
    tc
                    ; TyCon
    -> NonEmpty (HsRecUpdParent GhcRn) -> TcM (HsRecUpdParent GhcTc)
    try_disambiguated_tycon TyCon
    tc NonEmpty (HsRecUpdParent GhcRn)
    possible_parents }

            -- Does the expression being updated have a type signature?
            -- If so, try to extract a parent TyCon from it.
            --
            -- See (b) inNote [Type-directed record disambiguation] in GHC.Rename.Pat.
              | Just {} <- HsExpr GhcRn -> Maybe (LHsSigWcType GhcRn)
    obviousSig (LocatedA (HsExpr GhcRn) -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    LocatedA (HsExpr GhcRn)
    record_expr)
              , Just TyCon
    tc <- FamInstEnvs -> Type -> Maybe TyCon
    tyConOf FamInstEnvs
    fam_inst_envs Type
    record_rho
              -> do { NonEmpty (HsRecUpdParent GhcRn) -> TyCon -> TcRn ()
    reportAmbiguousUpdate NonEmpty (HsRecUpdParent GhcRn)
    possible_parents TyCon
    tc
                    ; TyCon
    -> NonEmpty (HsRecUpdParent GhcRn) -> TcM (HsRecUpdParent GhcTc)
    try_disambiguated_tycon TyCon
    tc NonEmpty (HsRecUpdParent GhcRn)
    possible_parents }

            -- Nothing else we can try...
            HsRecUpdParent GhcRn
    p1 NE.:| HsRecUpdParent GhcRn
    p2 : [HsRecUpdParent GhcRn]
    ps
              -> do { p1 <- HsRecUpdParent GhcRn -> TcM RecSelParent
    tcLookupRecSelParent HsRecUpdParent GhcRn
    p1
                    ; p2 <- tcLookupRecSelParent p2
                    ; ps <- mapM tcLookupRecSelParent ps
                    ; failWithTc $ TcRnBadRecordUpdate (getUpdFieldLbls rbnds)
                                 $ MultiplePossibleParents (p1, p2, ps) }

        -- Try to use the 'TyCon' we learned from type-directed disambiguation.
        -- This might not work, if it doesn't match up with any of the parents we had
        -- computed on the basis of the field labels.
        -- (See test cases overloadedrecfields01 and T21946.)
        try_disambiguated_tycon :: TyCon
                                -> NE.NonEmpty (HsRecUpdParent GhcRn)
                                -> TcM (HsRecUpdParent GhcTc)
        try_disambiguated_tycon :: TyCon
    -> NonEmpty (HsRecUpdParent GhcRn) -> TcM (HsRecUpdParent GhcTc)
    try_disambiguated_tycon TyCon
    tc NonEmpty (HsRecUpdParent GhcRn)
    pars
          = do { pars <- (HsRecUpdParent GhcRn
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (HsRecUpdParent GhcTc)))
    -> [HsRecUpdParent GhcRn]
    -> IOEnv (Env TcGblEnv TcLclEnv) [HsRecUpdParent GhcTc]
    forall (m :: * -> *) a b.
    Applicative m =>
    (a -> m (Maybe b)) -> [a] -> m [b]
    mapMaybeM ((HsRecUpdParent GhcTc -> Maybe (HsRecUpdParent GhcTc))
    -> TcM (HsRecUpdParent GhcTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (HsRecUpdParent 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 (TyCon -> HsRecUpdParent GhcTc -> Maybe (HsRecUpdParent GhcTc)
    guard_parent TyCon
    tc) (TcM (HsRecUpdParent GhcTc)
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (HsRecUpdParent GhcTc)))
    -> (HsRecUpdParent GhcRn -> TcM (HsRecUpdParent GhcTc))
    -> HsRecUpdParent GhcRn
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (HsRecUpdParent GhcTc))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsRecUpdParent GhcRn -> TcM (HsRecUpdParent GhcTc)
    lookup_parent_flds) (NonEmpty (HsRecUpdParent GhcRn) -> [HsRecUpdParent GhcRn]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty (HsRecUpdParent GhcRn)
    pars)
               ; case pars of
                   [HsRecUpdParent GhcTc
    par] -> HsRecUpdParent GhcTc -> TcM (HsRecUpdParent GhcTc)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsRecUpdParent GhcTc
    par
                   []    -> do { pars <- (HsRecUpdParent GhcRn -> TcM RecSelParent)
    -> NonEmpty (HsRecUpdParent GhcRn)
    -> IOEnv (Env TcGblEnv TcLclEnv) (NonEmpty RecSelParent)
    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) -> NonEmpty a -> m (NonEmpty b)
    mapM HsRecUpdParent GhcRn -> TcM RecSelParent
    tcLookupRecSelParent NonEmpty (HsRecUpdParent GhcRn)
    possible_parents
                               ; failWithTc $ TcRnBadRecordUpdate (getUpdFieldLbls rbnds)
                                            $ InvalidTyConParent tc pars }
                   [HsRecUpdParent GhcTc]
    _     -> String -> SDoc -> TcM (HsRecUpdParent GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "try_disambiguated_tycon: more than 1 valid parent"
                              ([RecSelParent] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([RecSelParent] -> SDoc) -> [RecSelParent] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (HsRecUpdParent GhcTc -> RecSelParent)
    -> [HsRecUpdParent GhcTc] -> [RecSelParent]
    forall a b. (a -> b) -> [a] -> [b]
    map HsRecUpdParent GhcTc -> RecSelParent
    tcRecUpdParent [HsRecUpdParent GhcTc]
    pars) }

        guard_parent :: TyCon -> HsRecUpdParent GhcTc -> Maybe (HsRecUpdParent GhcTc)
        guard_parent :: TyCon -> HsRecUpdParent GhcTc -> Maybe (HsRecUpdParent GhcTc)
    guard_parent TyCon
    disamb_tc cand_parent :: HsRecUpdParent GhcTc
    cand_parent@(TcRecUpdParent { tcRecUpdParent :: HsRecUpdParent GhcTc -> RecSelParent
    tcRecUpdParent = RecSelParent
    cand_tc })
          = do { Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (TyCon -> RecSelParent
    RecSelData TyCon
    disamb_tc RecSelParent -> RecSelParent -> Bool
    forall a. Eq a => a -> a -> Bool
    == RecSelParent
    cand_tc)
               ; HsRecUpdParent GhcTc -> Maybe (HsRecUpdParent GhcTc)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsRecUpdParent GhcTc
    cand_parent }

        lookup_parent_flds :: HsRecUpdParent GhcRn
                           -> TcM (HsRecUpdParent GhcTc)
        lookup_parent_flds :: HsRecUpdParent GhcRn -> TcM (HsRecUpdParent GhcTc)
    lookup_parent_flds par :: HsRecUpdParent GhcRn
    par@(RnRecUpdParent { rnRecUpdLabels :: HsRecUpdParent GhcRn -> NonEmpty FieldGlobalRdrElt
    rnRecUpdLabels = NonEmpty FieldGlobalRdrElt
    lbls, rnRecUpdCons :: HsRecUpdParent GhcRn -> UniqSet ConLikeName
    rnRecUpdCons = UniqSet ConLikeName
    cons })
          = do { let cons' :: NonDetUniqFM ConLike ConLikeName
                     cons' :: NonDetUniqFM ConLike ConLikeName
    cons' = UniqFM ConLike ConLikeName -> NonDetUniqFM ConLike ConLikeName
    forall {k} (key :: k) ele. UniqFM key ele -> NonDetUniqFM key ele
    NonDetUniqFM (UniqFM ConLike ConLikeName -> NonDetUniqFM ConLike ConLikeName)
    -> UniqFM ConLike ConLikeName -> NonDetUniqFM ConLike ConLikeName
    forall a b. (a -> b) -> a -> b
    $ UniqFM ConLikeName ConLikeName -> UniqFM ConLike ConLikeName
    forall {k1} {k2} (key1 :: k1) elt (key2 :: k2).
    UniqFM key1 elt -> UniqFM key2 elt
    unsafeCastUFMKey (UniqFM ConLikeName ConLikeName -> UniqFM ConLike ConLikeName)
    -> UniqFM ConLikeName ConLikeName -> UniqFM ConLike ConLikeName
    forall a b. (a -> b) -> a -> b
    $ UniqSet ConLikeName -> UniqFM ConLikeName ConLikeName
    forall a. UniqSet a -> UniqFM a a
    getUniqSet UniqSet ConLikeName
    cons
               ; cons <- (ConLikeName -> TcM ConLike)
    -> NonDetUniqFM ConLike ConLikeName
    -> IOEnv (Env TcGblEnv TcLclEnv) (NonDetUniqFM ConLike ConLike)
    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) -> NonDetUniqFM ConLike a -> f (NonDetUniqFM ConLike b)
    traverse (Name -> TcM ConLike
    tcLookupConLike (Name -> TcM ConLike)
    -> (ConLikeName -> Name) -> ConLikeName -> TcM ConLike
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConLikeName -> Name
    conLikeName_Name) NonDetUniqFM ConLike ConLikeName
    cons'
               ; tc   <- tcLookupRecSelParent par
               ; return $
                   TcRecUpdParent
                     { tcRecUpdParent = tc
                     , tcRecUpdLabels = lbls
                     , tcRecUpdCons   = unsafeUFMToUniqSet $ getNonDet cons } }

        lookupField :: FieldGlobalRdrElt
                    -> LHsRecUpdField GhcRn GhcRn
                    -> TcM (LHsRecUpdField GhcTc GhcRn)
        lookupField :: FieldGlobalRdrElt
    -> LHsRecUpdField GhcRn GhcRn -> TcM (LHsRecUpdField GhcTc GhcRn)
    lookupField FieldGlobalRdrElt
    fld_gre (L SrcSpanAnnA
    l HsFieldBind
      (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcRn))
      (LocatedA (HsExpr GhcRn))
    upd)
          = do { let L SrcSpanAnnA
    loc AmbiguousFieldOcc GhcRn
    af = HsFieldBind
      (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcRn))
      (LocatedA (HsExpr GhcRn))
    -> GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcRn)
    forall lhs rhs. HsFieldBind lhs rhs -> lhs
    hfbLHS HsFieldBind
      (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcRn))
      (LocatedA (HsExpr GhcRn))
    upd
                     lbl :: RdrName
    lbl      = AmbiguousFieldOcc GhcRn -> RdrName
    forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
    ambiguousFieldOccRdrName AmbiguousFieldOcc GhcRn
    af
                     mb_gre :: [FieldGlobalRdrElt]
    mb_gre   = RdrName -> [FieldGlobalRdrElt] -> [FieldGlobalRdrElt]
    forall info.
    RdrName -> [GlobalRdrEltX info] -> [GlobalRdrEltX info]
    pickGREs RdrName
    lbl [FieldGlobalRdrElt
    fld_gre]
                          -- NB: this GRE can be 'Nothing' when in GHCi.
                          -- See test T10439.

                 -- Mark the record fields as used, now that we have disambiguated.
                 -- There is no risk of duplicate deprecation warnings, as we have
                 -- not marked the GREs as used previously.
               ; SrcSpanAnnA -> TcRn () -> TcRn ()
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ (FieldGlobalRdrElt -> TcRn ()) -> [FieldGlobalRdrElt] -> TcRn ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (DeprecationWarnings -> FieldGlobalRdrElt -> TcRn ()
    addUsedGRE DeprecationWarnings
    AllDeprecationWarnings) [FieldGlobalRdrElt]
    mb_gre
               ; sel <- Name -> TcM TyCoVar
    tcLookupId (FieldGlobalRdrElt -> Name
    forall info. GlobalRdrEltX info -> Name
    greName FieldGlobalRdrElt
    fld_gre)
               ; return $ L l HsFieldBind
                   { hfbAnn = hfbAnn upd
                   , hfbLHS = L (l2l loc) $ Unambiguous sel (L (l2l loc) lbl)
                   , hfbRHS = hfbRHS upd
                   , hfbPun = hfbPun upd
                   } }

        -- The type-directed disambiguation mechanism is scheduled for removal,
        -- as per Note [Type-directed record disambiguation].
        -- So we emit a warning whenever the user relies on it.
        reportAmbiguousUpdate :: NE.NonEmpty (HsRecUpdParent GhcRn)
                              -> TyCon -> TcM ()
        reportAmbiguousUpdate :: NonEmpty (HsRecUpdParent GhcRn) -> TyCon -> TcRn ()
    reportAmbiguousUpdate NonEmpty (HsRecUpdParent GhcRn)
    parents TyCon
    parent_type =
            SrcSpan -> TcRn () -> TcRn ()
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ TcRnMessage -> TcRn ()
    addDiagnostic (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ HsExpr GhcRn -> TyCon -> TcRnMessage
    TcRnAmbiguousRecordUpdate HsExpr GhcRn
    rupd TyCon
    parent_type
          where
            rupd :: HsExpr GhcRn
    rupd = RecordUpd { rupd_expr :: LHsExpr GhcRn
    rupd_expr = LHsExpr GhcRn
    record_expr
                             , rupd_flds :: LHsRecUpdFields GhcRn
    rupd_flds =
                                 RegularRecUpdFields
                                  { xRecUpdFields :: XLHsRecUpdLabels GhcRn
    xRecUpdFields = NonEmpty (HsRecUpdParent GhcRn)
    XLHsRecUpdLabels GhcRn
    parents
                                  , recUpdFields :: [LHsRecUpdField GhcRn GhcRn]
    recUpdFields  = [LHsRecUpdField GhcRn GhcRn]
    rbnds }
                             , rupd_ext :: XRecordUpd GhcRn
    rupd_ext = XRecordUpd GhcRn
    NoExtField
    noExtField }
            loc :: SrcSpan
    loc  = GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcRn))
         (LocatedA (HsExpr GhcRn)))
    -> SrcSpan
    forall a e. HasLoc a => GenLocated a e -> SrcSpan
    getLocA ([GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcRn))
          (LocatedA (HsExpr GhcRn)))]
    -> GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcRn))
            (LocatedA (HsExpr GhcRn)))
    forall a. HasCallStack => [a] -> a
    head [LHsRecUpdField GhcRn GhcRn]
    [GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated SrcSpanAnnA (AmbiguousFieldOcc GhcRn))
          (LocatedA (HsExpr GhcRn)))]
    rbnds)

    {-
    Game plan for record bindings
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    1. Find the TyCon for the bindings, from the first field label.

    2. Instantiate its tyvars and unify (T a1 .. an) with expected_ty.

    For each binding field = value

    3. Instantiate the field type (from the field label) using the type
       envt from step 2.

    4  Type check the value using tcCheckPolyExprNC (in tcRecordField),
       passing the field type as the expected argument type.

    This extends OK when the field types are universally quantified.
    -}

    tcRecordBinds
            :: ConLike
            -> [TcType]     -- Expected type for each field
            -> HsRecordBinds GhcRn
            -> TcM (HsRecordBinds GhcTc)

    tcRecordBinds :: ConLike
    -> [Type] -> HsRecordBinds GhcRn -> TcM (HsRecordBinds GhcTc)
    tcRecordBinds ConLike
    con_like [Type]
    arg_tys (HsRecFields [LHsRecField GhcRn (LHsExpr GhcRn)]
    rbinds Maybe (XRec GhcRn RecFieldsDotDot)
    dd)
      = do  { mb_binds <- (GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
          (LocatedA (HsExpr GhcRn)))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (Maybe
             (GenLocated
                SrcSpanAnnA
                (HsFieldBind
                   (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
                   (GenLocated SrcSpanAnnA (HsExpr GhcTc))))))
    -> [GenLocated
          SrcSpanAnnA
          (HsFieldBind
             (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
             (LocatedA (HsExpr GhcRn)))]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [Maybe
            (GenLocated
               SrcSpanAnnA
               (HsFieldBind
                  (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
                  (GenLocated SrcSpanAnnA (HsExpr 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 LHsRecField GhcRn (LHsExpr GhcRn)
    -> TcM (Maybe (LHsRecField GhcTc (LHsExpr GhcTc)))
    GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
         (LocatedA (HsExpr GhcRn)))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Maybe
            (GenLocated
               SrcSpanAnnA
               (HsFieldBind
                  (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
                  (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
    do_bind [LHsRecField GhcRn (LHsExpr GhcRn)]
    [GenLocated
       SrcSpanAnnA
       (HsFieldBind
          (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
          (LocatedA (HsExpr GhcRn)))]
    rbinds
            ; return (HsRecFields (catMaybes mb_binds) dd) }
      where
        fields :: [Name]
    fields = (FieldLabel -> Name) -> [FieldLabel] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLabel -> Name
    flSelector ([FieldLabel] -> [Name]) -> [FieldLabel] -> [Name]
    forall a b. (a -> b) -> a -> b
    $ ConLike -> [FieldLabel]
    conLikeFieldLabels ConLike
    con_like
        flds_w_tys :: [(Name, Type)]
    flds_w_tys = String -> [Name] -> [Type] -> [(Name, Type)]
    forall a b. HasDebugCallStack => String -> [a] -> [b] -> [(a, b)]
    zipEqual String
    "tcRecordBinds" [Name]
    fields [Type]
    arg_tys

        do_bind :: LHsRecField GhcRn (LHsExpr GhcRn)
                -> TcM (Maybe (LHsRecField GhcTc (LHsExpr GhcTc)))
        do_bind :: LHsRecField GhcRn (LHsExpr GhcRn)
    -> TcM (Maybe (LHsRecField GhcTc (LHsExpr GhcTc)))
    do_bind (L SrcSpanAnnA
    l fld :: HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcRn)) (LocatedA (HsExpr GhcRn))
    fld@(HsFieldBind { hfbLHS :: forall lhs rhs. HsFieldBind lhs rhs -> lhs
    hfbLHS = GenLocated SrcSpanAnnA (FieldOcc GhcRn)
    f
                                     , hfbRHS :: forall lhs rhs. HsFieldBind lhs rhs -> rhs
    hfbRHS = LocatedA (HsExpr GhcRn)
    rhs }))

          = do { mb <- ConLike
    -> [(Name, Type)]
    -> LFieldOcc GhcRn
    -> LHsExpr GhcRn
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    tcRecordField ConLike
    con_like [(Name, Type)]
    flds_w_tys LFieldOcc GhcRn
    GenLocated SrcSpanAnnA (FieldOcc GhcRn)
    f LHsExpr GhcRn
    LocatedA (HsExpr GhcRn)
    rhs
               ; case mb of
                   Maybe
      (GenLocated SrcSpanAnnA (FieldOcc GhcTc),
       GenLocated SrcSpanAnnA (HsExpr GhcTc))
    Nothing         -> Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
            (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Maybe
            (GenLocated
               SrcSpanAnnA
               (HsFieldBind
                  (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
                  (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
            (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    forall a. Maybe a
    Nothing
                   Just (GenLocated SrcSpanAnnA (FieldOcc GhcTc)
    f', GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs') -> Maybe
      (GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
            (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Maybe
            (GenLocated
               SrcSpanAnnA
               (HsFieldBind
                  (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
                  (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated
      SrcSpanAnnA
      (HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> Maybe
         (GenLocated
            SrcSpanAnnA
            (HsFieldBind
               (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
               (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    forall a. a -> Maybe a
    Just (SrcSpanAnnA
    -> HsFieldBind
         (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
         (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA
         (HsFieldBind
            (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
            (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    l (HsFieldBind
                                                         { hfbAnn :: XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcTc))
    hfbAnn = HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcRn)) (LocatedA (HsExpr GhcRn))
    -> XHsFieldBind (GenLocated SrcSpanAnnA (FieldOcc GhcRn))
    forall lhs rhs. HsFieldBind lhs rhs -> XHsFieldBind lhs
    hfbAnn HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcRn)) (LocatedA (HsExpr GhcRn))
    fld
                                                         , hfbLHS :: GenLocated SrcSpanAnnA (FieldOcc GhcTc)
    hfbLHS = GenLocated SrcSpanAnnA (FieldOcc GhcTc)
    f'
                                                         , hfbRHS :: GenLocated SrcSpanAnnA (HsExpr GhcTc)
    hfbRHS = GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs'
                                                         , hfbPun :: Bool
    hfbPun = HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcRn)) (LocatedA (HsExpr GhcRn))
    -> Bool
    forall lhs rhs. HsFieldBind lhs rhs -> Bool
    hfbPun HsFieldBind
      (GenLocated SrcSpanAnnA (FieldOcc GhcRn)) (LocatedA (HsExpr GhcRn))
    fld}))) }

    fieldCtxt :: FieldLabelString -> SDoc
    fieldCtxt :: FieldLabelString -> SDoc
    fieldCtxt FieldLabelString
    field_name
      = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "In the" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc -> SDoc
    quotes (FieldLabelString -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr FieldLabelString
    field_name) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "field of a record"

    tcRecordField :: ConLike -> Assoc Name Type
                  -> LFieldOcc GhcRn -> LHsExpr GhcRn
                  -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    tcRecordField :: ConLike
    -> [(Name, Type)]
    -> LFieldOcc GhcRn
    -> LHsExpr GhcRn
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    tcRecordField ConLike
    con_like [(Name, Type)]
    flds_w_tys (L SrcSpanAnnA
    loc (FieldOcc XCFieldOcc GhcRn
    sel_name XRec GhcRn RdrName
    lbl)) LHsExpr GhcRn
    rhs
      | Just Type
    field_ty <- [(Name, Type)] -> Name -> Maybe Type
    forall a b. Eq a => Assoc a b -> a -> Maybe b
    assocMaybe [(Name, Type)]
    flds_w_tys XCFieldOcc GhcRn
    Name
    sel_name
          = SDoc
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (FieldLabelString -> SDoc
    fieldCtxt FieldLabelString
    field_lbl) (TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
     -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)))
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $
            do { rhs' <- LHsExpr GhcRn -> Type -> TcM (LHsExpr GhcTc)
    tcCheckPolyExprNC LHsExpr GhcRn
    rhs Type
    field_ty
               ; hasFixedRuntimeRep_syntactic (FRRRecordCon (unLoc lbl) (unLoc rhs'))
                    field_ty
               ; let field_id = OccName -> Unique -> Type -> Type -> SrcSpan -> TyCoVar
    mkUserLocal (Name -> OccName
    nameOccName XCFieldOcc GhcRn
    Name
    sel_name)
                                            (Name -> Unique
    nameUnique XCFieldOcc GhcRn
    Name
    sel_name)
                                            Type
    ManyTy Type
    field_ty (SrcSpanAnnA -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA SrcSpanAnnA
    loc)
                    -- Yuk: the field_id has the *unique* of the selector Id
                    --          (so we can find it easily)
                    --      but is a LocalId with the appropriate type of the RHS
                    --          (so the expansion knows the type of local binder to make)
               ; return (Just (L loc (FieldOcc field_id lbl), rhs')) }
          | Bool
    otherwise
          = do { TcRnMessage -> TcRn ()
    addErrTc (Name -> FieldLabelString -> TcRnMessage
    badFieldConErr (ConLike -> Name
    forall a. NamedThing a => a -> Name
    getName ConLike
    con_like) FieldLabelString
    field_lbl)
               ; Maybe
      (GenLocated SrcSpanAnnA (FieldOcc GhcTc),
       GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Maybe
            (GenLocated SrcSpanAnnA (FieldOcc GhcTc),
             GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe
      (GenLocated SrcSpanAnnA (FieldOcc GhcTc),
       GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall a. Maybe a
    Nothing }
      where
            field_lbl :: FieldLabelString
    field_lbl = FastString -> FieldLabelString
    FieldLabelString (FastString -> FieldLabelString) -> FastString -> FieldLabelString
    forall a b. (a -> b) -> a -> b
    $ OccName -> FastString
    occNameFS (OccName -> FastString) -> OccName -> FastString
    forall a b. (a -> b) -> a -> b
    $ RdrName -> OccName
    rdrNameOcc (GenLocated SrcSpanAnnN RdrName -> RdrName
    forall l e. GenLocated l e -> e
    unLoc XRec GhcRn RdrName
    GenLocated SrcSpanAnnN RdrName
    lbl)

    checkMissingFields ::  ConLike -> HsRecordBinds GhcRn -> [Scaled TcType] -> TcM ()
    checkMissingFields :: ConLike -> HsRecordBinds GhcRn -> [Scaled Type] -> TcRn ()
    checkMissingFields ConLike
    con_like HsRecordBinds GhcRn
    rbinds [Scaled Type]
    arg_tys
      | [FieldLabel] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldLabel]
    field_labels   -- Not declared as a record;
                            -- But C{} is still valid if no strict fields
      = if (HsImplBang -> Bool) -> [HsImplBang] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any HsImplBang -> Bool
    isBanged [HsImplBang]
    field_strs then
            -- Illegal if any arg is strict
            TcRnMessage -> TcRn ()
    addErrTc (ConLike -> [(FieldLabelString, Type)] -> TcRnMessage
    TcRnMissingStrictFields ConLike
    con_like [])
        else do
            Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([HsImplBang] -> Bool
    forall (f :: * -> *) a. Foldable f => f a -> Bool
    notNull [HsImplBang]
    field_strs Bool -> Bool -> Bool
    && [FieldLabel] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldLabel]
    field_labels) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ do
              let msg :: TcRnMessage
    msg = ConLike -> [(FieldLabelString, Type)] -> TcRnMessage
    TcRnMissingFields ConLike
    con_like []
              (Bool -> TcRnMessage -> TcRn ()
    diagnosticTc Bool
    True TcRnMessage
    msg)

      | Bool
    otherwise = do              -- A record
        Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([(FieldLabelString, Type)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(FieldLabelString, Type)]
    missing_s_fields) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ do
            fs <- ZonkM [(FieldLabelString, Type)] -> TcM [(FieldLabelString, Type)]
    forall a. ZonkM a -> TcM a
    liftZonkM (ZonkM [(FieldLabelString, Type)]
     -> TcM [(FieldLabelString, Type)])
    -> ZonkM [(FieldLabelString, Type)]
    -> TcM [(FieldLabelString, Type)]
    forall a b. (a -> b) -> a -> b
    $ [(FieldLabelString, Type)] -> ZonkM [(FieldLabelString, Type)]
    forall {t :: * -> *} {a}.
    Traversable t =>
    t (a, Type) -> ZonkM (t (a, Type))
    zonk_fields [(FieldLabelString, Type)]
    missing_s_fields
            -- It is an error to omit a strict field, because
            -- we can't substitute it with (error "Missing field f")
            addErrTc (TcRnMissingStrictFields con_like fs)

        warn <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnMissingFields
        when (warn && notNull missing_ns_fields) $ do
            fs <- liftZonkM $ zonk_fields missing_ns_fields
            -- It is not an error (though we may want) to omit a
            -- lazy field, because we can always use
            -- (error "Missing field f") instead.
            let msg = ConLike -> [(FieldLabelString, Type)] -> TcRnMessage
    TcRnMissingFields ConLike
    con_like [(FieldLabelString, Type)]
    fs
            diagnosticTc True msg

      where
        -- we zonk the fields to get better types in error messages (#18869)
        zonk_fields :: t (a, Type) -> ZonkM (t (a, Type))
    zonk_fields t (a, Type)
    fs = t (a, Type)
    -> ((a, Type) -> ZonkM (a, Type)) -> ZonkM (t (a, Type))
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM t (a, Type)
    fs (((a, Type) -> ZonkM (a, Type)) -> ZonkM (t (a, Type)))
    -> ((a, Type) -> ZonkM (a, Type)) -> ZonkM (t (a, Type))
    forall a b. (a -> b) -> a -> b
    $ \(a
    str,Type
    ty) -> do
            ty' <- Type -> ZonkM Type
    zonkTcType Type
    ty
            return (str,ty')
        missing_s_fields :: [(FieldLabelString, Type)]
    missing_s_fields
            = [ (FieldLabel -> FieldLabelString
    flLabel FieldLabel
    fl, Scaled Type -> Type
    forall a. Scaled a -> a
    scaledThing Scaled Type
    ty) | (FieldLabel
    fl,HsImplBang
    str,Scaled Type
    ty) <- [(FieldLabel, HsImplBang, Scaled Type)]
    field_info,
                     HsImplBang -> Bool
    isBanged HsImplBang
    str,
                     Bool -> Bool
    not (FieldLabel
    fl FieldLabel -> [Name] -> Bool
    forall {t :: * -> *}. Foldable t => FieldLabel -> t Name -> Bool
    `elemField` [XCFieldOcc GhcRn]
    [Name]
    field_names_used)
              ]
        missing_ns_fields :: [(FieldLabelString, Type)]
    missing_ns_fields
            = [ (FieldLabel -> FieldLabelString
    flLabel FieldLabel
    fl, Scaled Type -> Type
    forall a. Scaled a -> a
    scaledThing Scaled Type
    ty) | (FieldLabel
    fl,HsImplBang
    str,Scaled Type
    ty) <- [(FieldLabel, HsImplBang, Scaled Type)]
    field_info,
                     Bool -> Bool
    not (HsImplBang -> Bool
    isBanged HsImplBang
    str),
                     Bool -> Bool
    not (FieldLabel
    fl FieldLabel -> [Name] -> Bool
    forall {t :: * -> *}. Foldable t => FieldLabel -> t Name -> Bool
    `elemField` [XCFieldOcc GhcRn]
    [Name]
    field_names_used)
              ]

        field_names_used :: [XCFieldOcc GhcRn]
    field_names_used = HsRecFields GhcRn (LocatedA (HsExpr GhcRn)) -> [XCFieldOcc GhcRn]
    forall p arg. UnXRec p => HsRecFields p arg -> [XCFieldOcc p]
    hsRecFields HsRecordBinds GhcRn
    HsRecFields GhcRn (LocatedA (HsExpr GhcRn))
    rbinds
        field_labels :: [FieldLabel]
    field_labels     = ConLike -> [FieldLabel]
    conLikeFieldLabels ConLike
    con_like

        field_info :: [(FieldLabel, HsImplBang, Scaled Type)]
    field_info = [FieldLabel]
    -> [HsImplBang]
    -> [Scaled Type]
    -> [(FieldLabel, HsImplBang, Scaled Type)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [FieldLabel]
    field_labels [HsImplBang]
    field_strs [Scaled Type]
    arg_tys

        field_strs :: [HsImplBang]
    field_strs = ConLike -> [HsImplBang]
    conLikeImplBangs ConLike
    con_like

        FieldLabel
    fl elemField :: FieldLabel -> t Name -> Bool
    `elemField` t Name
    flds = (Name -> Bool) -> t Name -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\ Name
    fl' -> FieldLabel -> Name
    flSelector FieldLabel
    fl Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    fl') t Name
    flds

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Static Pointers}
    *                                                                      *
    ************************************************************************
    -}

    -- | Checks if the given name is closed and emits an error if not.
    --
    -- See Note [Not-closed error messages].
    checkClosedInStaticForm :: Name -> TcM ()
    checkClosedInStaticForm :: Name -> TcRn ()
    checkClosedInStaticForm Name
    name = do
        type_env <- TcM TcTypeEnv
    getLclTypeEnv
        case checkClosed type_env name of
          Maybe NotClosedReason
    Nothing -> () -> TcRn ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          Just NotClosedReason
    reason -> TcRnMessage -> TcRn ()
    addErrTc (TcRnMessage -> TcRn ()) -> TcRnMessage -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ Name -> NotClosedReason -> TcRnMessage
    explain Name
    name NotClosedReason
    reason
      where
        -- See Note [Checking closedness].
        checkClosed :: TcTypeEnv -> Name -> Maybe NotClosedReason
        checkClosed :: TcTypeEnv -> Name -> Maybe NotClosedReason
    checkClosed TcTypeEnv
    type_env Name
    n = TcTypeEnv -> UniqSet Name -> Name -> Maybe NotClosedReason
    checkLoop TcTypeEnv
    type_env (Name -> UniqSet Name
    unitNameSet Name
    n) Name
    n

        checkLoop :: TcTypeEnv -> NameSet -> Name -> Maybe NotClosedReason
        checkLoop :: TcTypeEnv -> UniqSet Name -> Name -> Maybe NotClosedReason
    checkLoop TcTypeEnv
    type_env UniqSet Name
    visited Name
    n =
          -- The @visited@ set is an accumulating parameter that contains the set of
          -- visited nodes, so we avoid repeating cycles in the traversal.
          case TcTypeEnv -> Name -> Maybe TcTyThing
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv TcTypeEnv
    type_env Name
    n of
            Just (ATcId { tct_id :: TcTyThing -> TyCoVar
    tct_id = TyCoVar
    tcid, tct_info :: TcTyThing -> IdBindingInfo
    tct_info = IdBindingInfo
    info }) -> case IdBindingInfo
    info of
              IdBindingInfo
    ClosedLet   -> Maybe NotClosedReason
    forall a. Maybe a
    Nothing
              IdBindingInfo
    NotLetBound -> NotClosedReason -> Maybe NotClosedReason
    forall a. a -> Maybe a
    Just NotClosedReason
    NotLetBoundReason
              NonClosedLet UniqSet Name
    fvs Bool
    type_closed -> [NotClosedReason] -> Maybe NotClosedReason
    forall a. [a] -> Maybe a
    listToMaybe ([NotClosedReason] -> Maybe NotClosedReason)
    -> [NotClosedReason] -> Maybe NotClosedReason
    forall a b. (a -> b) -> a -> b
    $
                -- Look for a non-closed variable in fvs
                [ Name -> NotClosedReason -> NotClosedReason
    NotClosed Name
    n' NotClosedReason
    reason
                | Name
    n' <- UniqSet Name -> [Name]
    nameSetElemsStable UniqSet Name
    fvs
                , Bool -> Bool
    not (Name -> UniqSet Name -> Bool
    elemNameSet Name
    n' UniqSet Name
    visited)
                , Just NotClosedReason
    reason <- [TcTypeEnv -> UniqSet Name -> Name -> Maybe NotClosedReason
    checkLoop TcTypeEnv
    type_env (UniqSet Name -> Name -> UniqSet Name
    extendNameSet UniqSet Name
    visited Name
    n') Name
    n']
                ] [NotClosedReason] -> [NotClosedReason] -> [NotClosedReason]
    forall a. [a] -> [a] -> [a]
    ++
                if Bool
    type_closed then
                  []
                else
                  -- We consider non-let-bound variables easier to figure out than
                  -- non-closed types, so we report non-closed types to the user
                  -- only if we cannot spot the former.
                  [ VarSet -> NotClosedReason
    NotTypeClosed (VarSet -> NotClosedReason) -> VarSet -> NotClosedReason
    forall a b. (a -> b) -> a -> b
    $ Type -> VarSet
    tyCoVarsOfType (TyCoVar -> Type
    idType TyCoVar
    tcid) ]
            -- The binding is closed.
            Maybe TcTyThing
    _ -> Maybe NotClosedReason
    forall a. Maybe a
    Nothing

        -- Converts a reason into a human-readable sentence.
        --
        -- @explain name reason@ starts with
        --
        -- "<name> is used in a static form but it is not closed because it"
        --
        -- and then follows a list of causes. For each id in the path, the text
        --
        -- "uses <id> which"
        --
        -- is appended, yielding something like
        --
        -- "uses <id> which uses <id1> which uses <id2> which"
        --
        -- until the end of the path is reached, which is reported as either
        --
        -- "is not let-bound"
        --
        -- when the final node is not let-bound, or
        --
        -- "has a non-closed type because it contains the type variables:
        -- v1, v2, v3"
        --
        -- when the final node has a non-closed type.
        --
        explain :: Name -> NotClosedReason -> TcRnMessage
        explain :: Name -> NotClosedReason -> TcRnMessage
    explain = Name -> NotClosedReason -> TcRnMessage
    TcRnStaticFormNotClosed

    -- Note [Not-closed error messages]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- When variables in a static form are not closed, we go through the trouble
    -- of explaining why they aren't.
    --
    -- Thus, the following program
    --
    -- > {-# LANGUAGE StaticPointers #-}
    -- > module M where
    -- >
    -- > f x = static g
    -- >   where
    -- >     g = h
    -- >     h = x
    --
    -- produces the error
    --
    --    'g' is used in a static form but it is not closed because it
    --    uses 'h' which uses 'x' which is not let-bound.
    --
    -- And a program like
    --
    -- > {-# LANGUAGE StaticPointers #-}
    -- > module M where
    -- >
    -- > import Data.Typeable
    -- > import GHC.StaticPtr
    -- >
    -- > f :: Typeable a => a -> StaticPtr TypeRep
    -- > f x = const (static (g undefined)) (h x)
    -- >   where
    -- >     g = h
    -- >     h = typeOf
    --
    -- produces the error
    --
    --    'g' is used in a static form but it is not closed because it
    --    uses 'h' which has a non-closed type because it contains the
    --    type variables: 'a'
    --

    -- Note [Checking closedness]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    -- @checkClosed@ checks if a binding is closed and returns a reason if it is
    -- not.
    --
    -- The bindings define a graph where the nodes are ids, and there is an edge
    -- from @id1@ to @id2@ if the rhs of @id1@ contains @id2@ among its free
    -- variables.
    --
    -- When @n@ is not closed, it has to exist in the graph some node reachable
    -- from @n@ that it is not a let-bound variable or that it has a non-closed
    -- type. Thus, the "reason" is a path from @n@ to this offending node.
    --
    -- When @n@ is not closed, we traverse the graph reachable from @n@ to build
    -- the reason.
    --