    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE DataKinds           #-}
    {-# LANGUAGE FlexibleContexts    #-}
    {-# LANGUAGE GADTs               #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TupleSections       #-}
    {-# LANGUAGE TypeFamilies        #-}
    {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]

    {-# 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.Head
           ( HsExprArg(..), EValArg(..), TcPass(..)
           , AppCtxt(..), appCtxtLoc, insideExpansion
           , splitHsApps, rebuildHsApps
           , addArgWrap, isHsValArg
           , countLeadingValArgs, isVisibleArg, pprHsExprArgTc

           , tcInferAppHead, tcInferAppHead_maybe
           , tcInferId, tcCheckId
           , obviousSig, addAmbiguousNameErr
           , tyConOf, tyConOfET, lookupParents, fieldNotInType
           , notSelector, nonBidirectionalErr

           , addExprCtxt, addFunResCtxt ) where

    import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckMonoExprNC, tcCheckPolyExprNC )

    import GHC.Tc.Gen.HsType
    import GHC.Tc.Gen.Pat
    import GHC.Tc.Gen.Bind( chooseInferredQuantifiers )
    import GHC.Tc.Gen.Sig( tcUserTypeSig, tcInstSig )
    import GHC.Tc.TyCl.PatSyn( patSynBuilderOcc )
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Utils.Unify
    import GHC.Types.Basic
    import GHC.Tc.Utils.Instantiate
    import GHC.Tc.Instance.Family ( tcGetFamInstEnvs, tcLookupDataFamInst )
    import GHC.Core.FamInstEnv    ( FamInstEnvs )
    import GHC.Core.UsageEnv      ( unitUE )
    import GHC.Rename.Env         ( addUsedGRE )
    import GHC.Rename.Utils       ( addNameClashErrRn, unknownSubordinateErr )
    import GHC.Tc.Solver          ( InferMode(..), simplifyInfer )
    import GHC.Tc.Utils.Env
    import GHC.Tc.Utils.Zonk      ( hsLitType )
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Types.Origin
    import GHC.Tc.Utils.TcType as TcType
    import GHC.Hs
    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.Reader
    import GHC.Core.TyCon
    import GHC.Core.TyCo.Rep
    import GHC.Core.Type
    import GHC.Tc.Types.Evidence
    import GHC.Builtin.Types( multiplicityTy )
    import GHC.Builtin.Names
    import GHC.Builtin.Names.TH( liftStringName, liftName )
    import GHC.Driver.Session
    import GHC.Types.SrcLoc
    import GHC.Utils.Misc
    import GHC.Data.Maybe
    import GHC.Utils.Outputable as Outputable
    import GHC.Utils.Panic
    import Control.Monad

    import Data.Function
    import qualified Data.List.NonEmpty as NE

    #include "HsVersions.h"

    import GHC.Prelude

    {- *********************************************************************
    *                                                                      *
                  HsExprArg: auxiliary data type
    *                                                                      *
    ********************************************************************* -}

    {- Note [HsExprArg]
    ~~~~~~~~~~~~~~~~~~~
    The data type HsExprArg :: TcPass -> Type
    is a very local type, used only within this module and GHC.Tc.Gen.App

    * It's really a zipper for an application chain
      See Note [Application chains and heads] in GHC.Tc.Gen.App for
      what an "application chain" is.

    * It's a GHC-specific type, so using TTG only where necessary

    * It is indexed by TcPass, meaning
      - HsExprArg TcpRn:
          The result of splitHsApps, which decomposes a HsExpr GhcRn

      - HsExprArg TcpInst:
          The result of tcInstFun, which instantiates the function type
          Adds EWrap nodes, the argument type in EValArg,
          and the kind-checked type in ETypeArg

      - HsExprArg TcpTc:
          The result of tcArg, which typechecks the value args
          In EValArg we now have a (LHsExpr GhcTc)

    * rebuildPrefixApps is dual to splitHsApps, and zips an application
      back into a HsExpr

    Note [EValArg]
    ~~~~~~~~~~~~~~
    The data type EValArg is the payload of the EValArg constructor of
    HsExprArg; i.e. a value argument of the application.  EValArg has two
    forms:

    * ValArg: payload is just the expression itself. Simple.

    * ValArgQL: captures the results of applying quickLookArg to the
      argument in a ValArg.  When we later want to typecheck that argument
      we can just carry on from where quick-look left off.  The fields of
      ValArgQL exactly capture what is needed to complete the job.

    Invariants:

    1. With QL switched off, all arguments are ValArg; no ValArgQL

    2. With QL switched on, tcInstFun converts some ValArgs to ValArgQL,
       under the conditions when quick-look should happen (eg the argument
       type is guarded) -- see quickLookArg

    Note [splitHsApps]
    ~~~~~~~~~~~~~~~~~~
    The key function
      splitHsApps :: HsExpr GhcRn -> (HsExpr GhcRn, HsExpr GhcRn, [HsExprArg 'TcpRn])
    takes apart either an HsApp, or an infix OpApp, returning

    * The "head" of the application, an expression that is often a variable;
      this is used for typechecking

    * The "user head" or "error head" of the application, to be reported to the
      user in case of an error.  Example:
             (`op` e)
      expands (via HsExpanded) to
             (rightSection op e)
      but we don't want to see 'rightSection' in error messages. So we keep the
      innermost un-expanded head as the "error head".

    * A list of HsExprArg, the arguments
    -}

    data TcPass = TcpRn     -- Arguments decomposed
                | TcpInst   -- Function instantiated
                | TcpTc     -- Typechecked

    data HsExprArg (p :: TcPass)
      = -- See Note [HsExprArg]
        EValArg  { forall (p :: TcPass). HsExprArg p -> AppCtxt
    eva_ctxt   :: AppCtxt
                 , forall (p :: TcPass). HsExprArg p -> EValArg p
    eva_arg    :: EValArg p
                 , forall (p :: TcPass). HsExprArg p -> XEVAType p
    eva_arg_ty :: !(XEVAType p) }

      | ETypeArg { eva_ctxt  :: AppCtxt
                 , forall (p :: TcPass). HsExprArg p -> LHsWcType (GhcPass 'Renamed)
    eva_hs_ty :: LHsWcType GhcRn  -- The type arg
                 , forall (p :: TcPass). HsExprArg p -> XETAType p
    eva_ty    :: !(XETAType p) }  -- Kind-checked type arg

      | EPrag    AppCtxt
                 (HsPragE (GhcPass (XPass p)))

      | EWrap    EWrap

    data EWrap = EPar    AppCtxt
               | EExpand (HsExpr GhcRn)
               | EHsWrap HsWrapper

    data EValArg (p :: TcPass) where  -- See Note [EValArg]
      ValArg   :: LHsExpr (GhcPass (XPass p))
               -> EValArg p

      ValArgQL :: { EValArg 'TcpInst -> LHsExpr (GhcPass 'Renamed)
    va_expr :: LHsExpr GhcRn        -- Original application
                                                    -- For location and error msgs
                  , EValArg 'TcpInst -> (HsExpr GhcTc, AppCtxt)
    va_fun  :: (HsExpr GhcTc, AppCtxt) -- Function of the application,
                                                       -- typechecked, plus its context
                  , EValArg 'TcpInst -> [HsExprArg 'TcpInst]
    va_args :: [HsExprArg 'TcpInst] -- Args, instantiated
                  , EValArg 'TcpInst -> TcSigmaType
    va_ty   :: TcRhoType }          -- Result type
               -> EValArg 'TcpInst  -- Only exists in TcpInst phase

    data AppCtxt
      = VAExpansion
           (HsExpr GhcRn)    -- Inside an expansion of this expression
           SrcSpan           -- The SrcSpan of the expression
                             --    noSrcSpan if outermost

      | VACall
           (HsExpr GhcRn) Int  -- In the third argument of function f
           SrcSpan             -- The SrcSpan of the application (f e1 e2 e3)

    appCtxtLoc :: AppCtxt -> SrcSpan
    appCtxtLoc :: AppCtxt -> SrcSpan
    appCtxtLoc (VAExpansion HsExpr (GhcPass 'Renamed)
    _ SrcSpan
    l) = SrcSpan
    l
    appCtxtLoc (VACall HsExpr (GhcPass 'Renamed)
    _ ThLevel
    _ SrcSpan
    l)    = SrcSpan
    l

    insideExpansion :: AppCtxt -> Bool
    insideExpansion :: AppCtxt -> Bool
    insideExpansion (VAExpansion {}) = Bool
    True
    insideExpansion (VACall {})      = Bool
    False

    instance Outputable AppCtxt where
      ppr :: AppCtxt -> SDoc
    ppr (VAExpansion HsExpr (GhcPass 'Renamed)
    e SrcSpan
    _) = String -> SDoc
    text String
    "VAExpansion" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr HsExpr (GhcPass 'Renamed)
    e
      ppr (VACall HsExpr (GhcPass 'Renamed)
    f ThLevel
    n SrcSpan
    _)    = String -> SDoc
    text String
    "VACall" SDoc -> SDoc -> SDoc
    <+> ThLevel -> SDoc
    int ThLevel
    n SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr HsExpr (GhcPass 'Renamed)
    f

    type family XPass p where
      XPass 'TcpRn   = 'Renamed
      XPass 'TcpInst = 'Renamed
      XPass 'TcpTc   = 'Typechecked

    type family XETAType p where  -- Type arguments
      XETAType 'TcpRn = NoExtField
      XETAType _      = Type

    type family XEVAType p where  -- Value arguments
      XEVAType 'TcpRn = NoExtField
      XEVAType _      = Scaled Type

    mkEValArg :: AppCtxt -> LHsExpr GhcRn -> HsExprArg 'TcpRn
    mkEValArg :: AppCtxt -> LHsExpr (GhcPass 'Renamed) -> HsExprArg 'TcpRn
    mkEValArg AppCtxt
    ctxt LHsExpr (GhcPass 'Renamed)
    e = EValArg { eva_arg :: EValArg 'TcpRn
    eva_arg = forall (p :: TcPass). LHsExpr (GhcPass (XPass p)) -> EValArg p
    ValArg LHsExpr (GhcPass 'Renamed)
    e, eva_ctxt :: AppCtxt
    eva_ctxt = AppCtxt
    ctxt
                               , eva_arg_ty :: XEVAType 'TcpRn
    eva_arg_ty = NoExtField
    noExtField }

    mkETypeArg :: AppCtxt -> LHsWcType GhcRn -> HsExprArg 'TcpRn
    mkETypeArg :: AppCtxt -> LHsWcType (GhcPass 'Renamed) -> HsExprArg 'TcpRn
    mkETypeArg AppCtxt
    ctxt LHsWcType (GhcPass 'Renamed)
    hs_ty = ETypeArg { eva_ctxt :: AppCtxt
    eva_ctxt = AppCtxt
    ctxt, eva_hs_ty :: LHsWcType (GhcPass 'Renamed)
    eva_hs_ty = LHsWcType (GhcPass 'Renamed)
    hs_ty
                                     , eva_ty :: XETAType 'TcpRn
    eva_ty = NoExtField
    noExtField }

    addArgWrap :: HsWrapper -> [HsExprArg 'TcpInst] -> [HsExprArg 'TcpInst]
    addArgWrap :: HsWrapper -> [HsExprArg 'TcpInst] -> [HsExprArg 'TcpInst]
    addArgWrap HsWrapper
    wrap [HsExprArg 'TcpInst]
    args
     | HsWrapper -> Bool
    isIdHsWrapper HsWrapper
    wrap = [HsExprArg 'TcpInst]
    args
     | Bool
    otherwise          = forall (p :: TcPass). EWrap -> HsExprArg p
    EWrap (HsWrapper -> EWrap
    EHsWrap HsWrapper
    wrap) forall a. a -> [a] -> [a]
    : [HsExprArg 'TcpInst]
    args

    splitHsApps :: HsExpr GhcRn
                -> ( (HsExpr GhcRn, AppCtxt)  -- Head
                   , [HsExprArg 'TcpRn])      -- Args
    -- See Note [splitHsApps]
    splitHsApps :: HsExpr (GhcPass 'Renamed)
    -> ((HsExpr (GhcPass 'Renamed), AppCtxt), [HsExprArg 'TcpRn])
    splitHsApps HsExpr (GhcPass 'Renamed)
    e = HsExpr (GhcPass 'Renamed)
    -> AppCtxt
    -> [HsExprArg 'TcpRn]
    -> ((HsExpr (GhcPass 'Renamed), AppCtxt), [HsExprArg 'TcpRn])
    go HsExpr (GhcPass 'Renamed)
    e (ThLevel -> HsExpr (GhcPass 'Renamed) -> AppCtxt
    top_ctxt ThLevel
    0 HsExpr (GhcPass 'Renamed)
    e) []
      where
        top_ctxt :: ThLevel -> HsExpr (GhcPass 'Renamed) -> AppCtxt
    top_ctxt ThLevel
    n (HsPar XPar (GhcPass 'Renamed)
    _ LHsExpr (GhcPass 'Renamed)
    fun)               = ThLevel
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)) -> AppCtxt
    top_lctxt ThLevel
    n LHsExpr (GhcPass 'Renamed)
    fun
        top_ctxt ThLevel
    n (HsPragE XPragE (GhcPass 'Renamed)
    _ HsPragE (GhcPass 'Renamed)
    _ LHsExpr (GhcPass 'Renamed)
    fun)           = ThLevel
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)) -> AppCtxt
    top_lctxt ThLevel
    n LHsExpr (GhcPass 'Renamed)
    fun
        top_ctxt ThLevel
    n (HsAppType XAppTypeE (GhcPass 'Renamed)
    _ LHsExpr (GhcPass 'Renamed)
    fun LHsWcType (NoGhcTc (GhcPass 'Renamed))
    _)         = ThLevel
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)) -> AppCtxt
    top_lctxt (ThLevel
    nforall a. Num a => a -> a -> a
    +ThLevel
    1) LHsExpr (GhcPass 'Renamed)
    fun
        top_ctxt ThLevel
    n (HsApp XApp (GhcPass 'Renamed)
    _ LHsExpr (GhcPass 'Renamed)
    fun LHsExpr (GhcPass 'Renamed)
    _)             = ThLevel
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)) -> AppCtxt
    top_lctxt (ThLevel
    nforall a. Num a => a -> a -> a
    +ThLevel
    1) LHsExpr (GhcPass 'Renamed)
    fun
        top_ctxt ThLevel
    n (XExpr (HsExpanded HsExpr (GhcPass 'Renamed)
    orig HsExpr (GhcPass 'Renamed)
    _)) = HsExpr (GhcPass 'Renamed) -> ThLevel -> SrcSpan -> AppCtxt
    VACall HsExpr (GhcPass 'Renamed)
    orig      ThLevel
    n SrcSpan
    noSrcSpan
        top_ctxt ThLevel
    n HsExpr (GhcPass 'Renamed)
    other_fun                   = HsExpr (GhcPass 'Renamed) -> ThLevel -> SrcSpan -> AppCtxt
    VACall HsExpr (GhcPass 'Renamed)
    other_fun ThLevel
    n SrcSpan
    noSrcSpan

        top_lctxt :: ThLevel
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)) -> AppCtxt
    top_lctxt ThLevel
    n (L SrcSpanAnnA
    _ HsExpr (GhcPass 'Renamed)
    fun) = ThLevel -> HsExpr (GhcPass 'Renamed) -> AppCtxt
    top_ctxt ThLevel
    n HsExpr (GhcPass 'Renamed)
    fun

        go :: HsExpr GhcRn -> AppCtxt -> [HsExprArg 'TcpRn]
           -> ((HsExpr GhcRn, AppCtxt), [HsExprArg 'TcpRn])
        go :: HsExpr (GhcPass 'Renamed)
    -> AppCtxt
    -> [HsExprArg 'TcpRn]
    -> ((HsExpr (GhcPass 'Renamed), AppCtxt), [HsExprArg 'TcpRn])
    go (HsPar XPar (GhcPass 'Renamed)
    _     (L SrcSpanAnnA
    l HsExpr (GhcPass 'Renamed)
    fun))    AppCtxt
    ctxt [HsExprArg 'TcpRn]
    args = HsExpr (GhcPass 'Renamed)
    -> AppCtxt
    -> [HsExprArg 'TcpRn]
    -> ((HsExpr (GhcPass 'Renamed), AppCtxt), [HsExprArg 'TcpRn])
    go HsExpr (GhcPass 'Renamed)
    fun (SrcSpanAnnA -> AppCtxt -> AppCtxt
    set SrcSpanAnnA
    l AppCtxt
    ctxt) (forall (p :: TcPass). EWrap -> HsExprArg p
    EWrap (AppCtxt -> EWrap
    EPar AppCtxt
    ctxt)   forall a. a -> [a] -> [a]
    : [HsExprArg 'TcpRn]
    args)
        go (HsPragE XPragE (GhcPass 'Renamed)
    _ HsPragE (GhcPass 'Renamed)
    p (L SrcSpanAnnA
    l HsExpr (GhcPass 'Renamed)
    fun))    AppCtxt
    ctxt [HsExprArg 'TcpRn]
    args = HsExpr (GhcPass 'Renamed)
    -> AppCtxt
    -> [HsExprArg 'TcpRn]
    -> ((HsExpr (GhcPass 'Renamed), AppCtxt), [HsExprArg 'TcpRn])
    go HsExpr (GhcPass 'Renamed)
    fun (SrcSpanAnnA -> AppCtxt -> AppCtxt
    set SrcSpanAnnA
    l AppCtxt
    ctxt) (forall (p :: TcPass).
    AppCtxt -> HsPragE (GhcPass (XPass p)) -> HsExprArg p
    EPrag      AppCtxt
    ctxt HsPragE (GhcPass 'Renamed)
    p   forall a. a -> [a] -> [a]
    : [HsExprArg 'TcpRn]
    args)
        go (HsAppType XAppTypeE (GhcPass 'Renamed)
    _ (L SrcSpanAnnA
    l HsExpr (GhcPass 'Renamed)
    fun) LHsWcType (NoGhcTc (GhcPass 'Renamed))
    ty) AppCtxt
    ctxt [HsExprArg 'TcpRn]
    args = HsExpr (GhcPass 'Renamed)
    -> AppCtxt
    -> [HsExprArg 'TcpRn]
    -> ((HsExpr (GhcPass 'Renamed), AppCtxt), [HsExprArg 'TcpRn])
    go HsExpr (GhcPass 'Renamed)
    fun (SrcSpanAnnA -> AppCtxt -> AppCtxt
    dec SrcSpanAnnA
    l AppCtxt
    ctxt) (AppCtxt -> LHsWcType (GhcPass 'Renamed) -> HsExprArg 'TcpRn
    mkETypeArg AppCtxt
    ctxt LHsWcType (NoGhcTc (GhcPass 'Renamed))
    ty  forall a. a -> [a] -> [a]
    : [HsExprArg 'TcpRn]
    args)
        go (HsApp XApp (GhcPass 'Renamed)
    _ (L SrcSpanAnnA
    l HsExpr (GhcPass 'Renamed)
    fun) LHsExpr (GhcPass 'Renamed)
    arg)    AppCtxt
    ctxt [HsExprArg 'TcpRn]
    args = HsExpr (GhcPass 'Renamed)
    -> AppCtxt
    -> [HsExprArg 'TcpRn]
    -> ((HsExpr (GhcPass 'Renamed), AppCtxt), [HsExprArg 'TcpRn])
    go HsExpr (GhcPass 'Renamed)
    fun (SrcSpanAnnA -> AppCtxt -> AppCtxt
    dec SrcSpanAnnA
    l AppCtxt
    ctxt) (AppCtxt -> LHsExpr (GhcPass 'Renamed) -> HsExprArg 'TcpRn
    mkEValArg  AppCtxt
    ctxt LHsExpr (GhcPass 'Renamed)
    arg forall a. a -> [a] -> [a]
    : [HsExprArg 'TcpRn]
    args)

        -- See Note [Looking through HsExpanded]
        go (XExpr (HsExpanded HsExpr (GhcPass 'Renamed)
    orig HsExpr (GhcPass 'Renamed)
    fun)) AppCtxt
    ctxt [HsExprArg 'TcpRn]
    args
          = HsExpr (GhcPass 'Renamed)
    -> AppCtxt
    -> [HsExprArg 'TcpRn]
    -> ((HsExpr (GhcPass 'Renamed), AppCtxt), [HsExprArg 'TcpRn])
    go HsExpr (GhcPass 'Renamed)
    fun (HsExpr (GhcPass 'Renamed) -> SrcSpan -> AppCtxt
    VAExpansion HsExpr (GhcPass 'Renamed)
    orig (AppCtxt -> SrcSpan
    appCtxtLoc AppCtxt
    ctxt)) (forall (p :: TcPass). EWrap -> HsExprArg p
    EWrap (HsExpr (GhcPass 'Renamed) -> EWrap
    EExpand HsExpr (GhcPass 'Renamed)
    orig) forall a. a -> [a] -> [a]
    : [HsExprArg 'TcpRn]
    args)

        -- See Note [Desugar OpApp in the typechecker]
        go e :: HsExpr (GhcPass 'Renamed)
    e@(OpApp XOpApp (GhcPass 'Renamed)
    _ LHsExpr (GhcPass 'Renamed)
    arg1 (L SrcSpanAnnA
    l HsExpr (GhcPass 'Renamed)
    op) LHsExpr (GhcPass 'Renamed)
    arg2) AppCtxt
    _ [HsExprArg 'TcpRn]
    args
          = ( (HsExpr (GhcPass 'Renamed)
    op, HsExpr (GhcPass 'Renamed) -> ThLevel -> SrcSpan -> AppCtxt
    VACall HsExpr (GhcPass 'Renamed)
    op ThLevel
    0 (forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    l))
            ,   AppCtxt -> LHsExpr (GhcPass 'Renamed) -> HsExprArg 'TcpRn
    mkEValArg (HsExpr (GhcPass 'Renamed) -> ThLevel -> SrcSpan -> AppCtxt
    VACall HsExpr (GhcPass 'Renamed)
    op ThLevel
    1 SrcSpan
    generatedSrcSpan) LHsExpr (GhcPass 'Renamed)
    arg1
              forall a. a -> [a] -> [a]
    : AppCtxt -> LHsExpr (GhcPass 'Renamed) -> HsExprArg 'TcpRn
    mkEValArg (HsExpr (GhcPass 'Renamed) -> ThLevel -> SrcSpan -> AppCtxt
    VACall HsExpr (GhcPass 'Renamed)
    op ThLevel
    2 SrcSpan
    generatedSrcSpan) LHsExpr (GhcPass 'Renamed)
    arg2
              forall a. a -> [a] -> [a]
    : forall (p :: TcPass). EWrap -> HsExprArg p
    EWrap (HsExpr (GhcPass 'Renamed) -> EWrap
    EExpand HsExpr (GhcPass 'Renamed)
    e)
              forall a. a -> [a] -> [a]
    : [HsExprArg 'TcpRn]
    args )

        go HsExpr (GhcPass 'Renamed)
    e AppCtxt
    ctxt [HsExprArg 'TcpRn]
    args = ((HsExpr (GhcPass 'Renamed)
    e,AppCtxt
    ctxt), [HsExprArg 'TcpRn]
    args)

        set :: SrcSpanAnnA -> AppCtxt -> AppCtxt
        set :: SrcSpanAnnA -> AppCtxt -> AppCtxt
    set SrcSpanAnnA
    l (VACall HsExpr (GhcPass 'Renamed)
    f ThLevel
    n SrcSpan
    _)        = HsExpr (GhcPass 'Renamed) -> ThLevel -> SrcSpan -> AppCtxt
    VACall HsExpr (GhcPass 'Renamed)
    f ThLevel
    n (forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    l)
        set SrcSpanAnnA
    _ ctxt :: AppCtxt
    ctxt@(VAExpansion {}) = AppCtxt
    ctxt

        dec :: SrcSpanAnnA -> AppCtxt -> AppCtxt
        dec :: SrcSpanAnnA -> AppCtxt -> AppCtxt
    dec SrcSpanAnnA
    l (VACall HsExpr (GhcPass 'Renamed)
    f ThLevel
    n SrcSpan
    _)        = HsExpr (GhcPass 'Renamed) -> ThLevel -> SrcSpan -> AppCtxt
    VACall HsExpr (GhcPass 'Renamed)
    f (ThLevel
    nforall a. Num a => a -> a -> a
    -ThLevel
    1) (forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    l)
        dec SrcSpanAnnA
    _ ctxt :: AppCtxt
    ctxt@(VAExpansion {}) = AppCtxt
    ctxt

    rebuildHsApps :: HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc]-> HsExpr GhcTc
    rebuildHsApps :: HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] -> HsExpr GhcTc
    rebuildHsApps HsExpr GhcTc
    fun AppCtxt
    _ [] = HsExpr GhcTc
    fun
    rebuildHsApps HsExpr GhcTc
    fun AppCtxt
    ctxt (HsExprArg 'TcpTc
    arg : [HsExprArg 'TcpTc]
    args)
      = case HsExprArg 'TcpTc
    arg of
          EValArg { eva_arg :: forall (p :: TcPass). HsExprArg p -> EValArg p
    eva_arg = ValArg LHsExpr (GhcPass (XPass 'TcpTc))
    arg, eva_ctxt :: forall (p :: TcPass). HsExprArg p -> AppCtxt
    eva_ctxt = AppCtxt
    ctxt' }
            -> HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] -> HsExpr GhcTc
    rebuildHsApps (forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
    HsApp forall a. EpAnn a
    noAnn GenLocated SrcSpanAnnA (HsExpr GhcTc)
    lfun LHsExpr (GhcPass (XPass 'TcpTc))
    arg) AppCtxt
    ctxt' [HsExprArg 'TcpTc]
    args
          ETypeArg { eva_hs_ty :: forall (p :: TcPass). HsExprArg p -> LHsWcType (GhcPass 'Renamed)
    eva_hs_ty = LHsWcType (GhcPass 'Renamed)
    hs_ty, eva_ty :: forall (p :: TcPass). HsExprArg p -> XETAType p
    eva_ty  = XETAType 'TcpTc
    ty, eva_ctxt :: forall (p :: TcPass). HsExprArg p -> AppCtxt
    eva_ctxt = AppCtxt
    ctxt' }
            -> HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] -> HsExpr GhcTc
    rebuildHsApps (forall p.
    XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
    HsAppType XETAType 'TcpTc
    ty GenLocated SrcSpanAnnA (HsExpr GhcTc)
    lfun LHsWcType (GhcPass 'Renamed)
    hs_ty) AppCtxt
    ctxt' [HsExprArg 'TcpTc]
    args
          EPrag AppCtxt
    ctxt' HsPragE (GhcPass (XPass 'TcpTc))
    p
            -> HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] -> HsExpr GhcTc
    rebuildHsApps (forall p. XPragE p -> HsPragE p -> LHsExpr p -> HsExpr p
    HsPragE NoExtField
    noExtField HsPragE (GhcPass (XPass 'TcpTc))
    p GenLocated SrcSpanAnnA (HsExpr GhcTc)
    lfun) AppCtxt
    ctxt' [HsExprArg 'TcpTc]
    args
          EWrap (EPar AppCtxt
    ctxt')
            -> HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] -> HsExpr GhcTc
    rebuildHsApps (forall p. XPar p -> LHsExpr p -> HsExpr p
    HsPar forall a. EpAnn a
    noAnn GenLocated SrcSpanAnnA (HsExpr GhcTc)
    lfun) AppCtxt
    ctxt' [HsExprArg 'TcpTc]
    args
          EWrap (EExpand HsExpr (GhcPass 'Renamed)
    orig)
            -> HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] -> HsExpr GhcTc
    rebuildHsApps (forall p. XXExpr p -> HsExpr p
    XExpr (HsExpansion (HsExpr (GhcPass 'Renamed)) (HsExpr GhcTc)
    -> XXExprGhcTc
    ExpansionExpr (forall a b. a -> b -> HsExpansion a b
    HsExpanded HsExpr (GhcPass 'Renamed)
    orig HsExpr GhcTc
    fun))) AppCtxt
    ctxt [HsExprArg 'TcpTc]
    args
          EWrap (EHsWrap HsWrapper
    wrap)
            -> HsExpr GhcTc -> AppCtxt -> [HsExprArg 'TcpTc] -> HsExpr GhcTc
    rebuildHsApps (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap HsExpr GhcTc
    fun) AppCtxt
    ctxt [HsExprArg 'TcpTc]
    args
      where
        lfun :: GenLocated SrcSpanAnnA (HsExpr GhcTc)
    lfun = forall l e. l -> e -> GenLocated l e
    L (forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan forall a b. (a -> b) -> a -> b
    $ AppCtxt -> SrcSpan
    appCtxtLoc AppCtxt
    ctxt) HsExpr GhcTc
    fun

    isHsValArg :: HsExprArg id -> Bool
    isHsValArg :: forall (id :: TcPass). HsExprArg id -> Bool
    isHsValArg (EValArg {}) = Bool
    True
    isHsValArg HsExprArg id
    _            = Bool
    False

    countLeadingValArgs :: [HsExprArg id] -> Int
    countLeadingValArgs :: forall (id :: TcPass). [HsExprArg id] -> ThLevel
    countLeadingValArgs []                   = ThLevel
    0
    countLeadingValArgs (EValArg {}  : [HsExprArg id]
    args) = ThLevel
    1 forall a. Num a => a -> a -> a
    + forall (id :: TcPass). [HsExprArg id] -> ThLevel
    countLeadingValArgs [HsExprArg id]
    args
    countLeadingValArgs (EWrap {}    : [HsExprArg id]
    args) = forall (id :: TcPass). [HsExprArg id] -> ThLevel
    countLeadingValArgs [HsExprArg id]
    args
    countLeadingValArgs (EPrag {}    : [HsExprArg id]
    args) = forall (id :: TcPass). [HsExprArg id] -> ThLevel
    countLeadingValArgs [HsExprArg id]
    args
    countLeadingValArgs (ETypeArg {} : [HsExprArg id]
    _)    = ThLevel
    0

    isValArg :: HsExprArg id -> Bool
    isValArg :: forall (id :: TcPass). HsExprArg id -> Bool
    isValArg (EValArg {}) = Bool
    True
    isValArg HsExprArg id
    _            = Bool
    False

    isVisibleArg :: HsExprArg id -> Bool
    isVisibleArg :: forall (id :: TcPass). HsExprArg id -> Bool
    isVisibleArg (EValArg {})  = Bool
    True
    isVisibleArg (ETypeArg {}) = Bool
    True
    isVisibleArg HsExprArg id
    _             = Bool
    False

    instance OutputableBndrId (XPass p) => Outputable (HsExprArg p) where
      ppr :: HsExprArg p -> SDoc
    ppr (EValArg { eva_arg :: forall (p :: TcPass). HsExprArg p -> EValArg p
    eva_arg = EValArg p
    arg })      = String -> SDoc
    text String
    "EValArg" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr EValArg p
    arg
      ppr (EPrag AppCtxt
    _ HsPragE (GhcPass (XPass p))
    p)                      = String -> SDoc
    text String
    "EPrag" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr HsPragE (GhcPass (XPass p))
    p
      ppr (ETypeArg { eva_hs_ty :: forall (p :: TcPass). HsExprArg p -> LHsWcType (GhcPass 'Renamed)
    eva_hs_ty = LHsWcType (GhcPass 'Renamed)
    hs_ty }) = Char -> SDoc
    char Char
    '@' SDoc -> SDoc -> SDoc
    <> forall a. Outputable a => a -> SDoc
    ppr LHsWcType (GhcPass 'Renamed)
    hs_ty
      ppr (EWrap EWrap
    wrap)                     = forall a. Outputable a => a -> SDoc
    ppr EWrap
    wrap

    instance Outputable EWrap where
      ppr :: EWrap -> SDoc
    ppr (EPar AppCtxt
    _)       = String -> SDoc
    text String
    "EPar"
      ppr (EHsWrap HsWrapper
    w)    = String -> SDoc
    text String
    "EHsWrap" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr HsWrapper
    w
      ppr (EExpand HsExpr (GhcPass 'Renamed)
    orig) = String -> SDoc
    text String
    "EExpand" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr HsExpr (GhcPass 'Renamed)
    orig

    instance OutputableBndrId (XPass p) => Outputable (EValArg p) where
      ppr :: EValArg p -> SDoc
    ppr (ValArg LHsExpr (GhcPass (XPass p))
    e) = forall a. Outputable a => a -> SDoc
    ppr LHsExpr (GhcPass (XPass p))
    e
      ppr (ValArgQL { va_fun :: EValArg 'TcpInst -> (HsExpr GhcTc, AppCtxt)
    va_fun = (HsExpr GhcTc, AppCtxt)
    fun, va_args :: EValArg 'TcpInst -> [HsExprArg 'TcpInst]
    va_args = [HsExprArg 'TcpInst]
    args, va_ty :: EValArg 'TcpInst -> TcSigmaType
    va_ty = TcSigmaType
    ty})
        = SDoc -> ThLevel -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "ValArgQL" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr (HsExpr GhcTc, AppCtxt)
    fun)
             ThLevel
    2 ([SDoc] -> SDoc
    vcat [ forall a. Outputable a => a -> SDoc
    ppr [HsExprArg 'TcpInst]
    args, String -> SDoc
    text String
    "va_ty:" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcSigmaType
    ty ])

    pprHsExprArgTc :: HsExprArg 'TcpInst -> SDoc
    pprHsExprArgTc :: HsExprArg 'TcpInst -> SDoc
    pprHsExprArgTc (EValArg { eva_arg :: forall (p :: TcPass). HsExprArg p -> EValArg p
    eva_arg = EValArg 'TcpInst
    tm, eva_arg_ty :: forall (p :: TcPass). HsExprArg p -> XEVAType p
    eva_arg_ty = XEVAType 'TcpInst
    ty })
      = String -> SDoc
    text String
    "EValArg" SDoc -> SDoc -> SDoc
    <+> SDoc -> ThLevel -> SDoc -> SDoc
    hang (forall a. Outputable a => a -> SDoc
    ppr EValArg 'TcpInst
    tm) ThLevel
    2 (SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr XEVAType 'TcpInst
    ty)
    pprHsExprArgTc HsExprArg 'TcpInst
    arg = forall a. Outputable a => a -> SDoc
    ppr HsExprArg 'TcpInst
    arg

    {- Note [Desugar OpApp in the typechecker]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Operator sections are desugared in the renamer; see GHC.Rename.Expr
    Note [Handling overloaded and rebindable constructs].
    But for reasons explained there, we rename OpApp to OpApp.  Then,
    here in the typechecker, we desugar it to a use of HsExpanded.
    That makes it possible to typecheck something like
         e1 `f` e2
    where
       f :: forall a. t1 -> forall b. t2 -> t3

    Note [Looking through HsExpanded]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When creating an application chain in splitHsApps, we must deal with
         HsExpanded f1 (f `HsApp` e1) `HsApp` e2 `HsApp` e3

    as a single application chain `f e1 e2 e3`.  Otherwise stuff like overloaded
    labels (#19154) won't work.

    It's easy to achieve this: `splitHsApps` unwraps `HsExpanded`.
    -}

    {- *********************************************************************
    *                                                                      *
                     tcInferAppHead
    *                                                                      *
    ********************************************************************* -}

    tcInferAppHead :: (HsExpr GhcRn, AppCtxt)
                   -> [HsExprArg 'TcpRn] -> Maybe TcRhoType
                   -- These two args are solely for tcInferRecSelId
                   -> TcM (HsExpr GhcTc, TcSigmaType)
    -- Infer type of the head of an application
    --   i.e. the 'f' in (f e1 ... en)
    -- See Note [Application chains and heads] in GHC.Tc.Gen.App
    -- We get back a /SigmaType/ because we have special cases for
    --   * A bare identifier (just look it up)
    --     This case also covers a record selector HsRecFld
    --   * An expression with a type signature (e :: ty)
    -- See Note [Application chains and heads] in GHC.Tc.Gen.App
    --
    -- Why do we need the arguments to infer the type of the head of
    -- the application?  For two reasons:
    --   * (Legitimate) The first arg has the source location of the head
    --   * (Disgusting) Needed for record disambiguation; see tcInferRecSelId
    --
    -- Note that [] and (,,) are both HsVar:
    --   see Note [Empty lists] and [ExplicitTuple] in GHC.Hs.Expr
    --
    -- NB: 'e' cannot be HsApp, HsTyApp, HsPrag, HsPar, because those
    --     cases are dealt with by splitHsApps.
    --
    -- See Note [tcApp: typechecking applications] in GHC.Tc.Gen.App
    tcInferAppHead :: (HsExpr (GhcPass 'Renamed), AppCtxt)
    -> [HsExprArg 'TcpRn]
    -> Maybe TcSigmaType
    -> TcM (HsExpr GhcTc, TcSigmaType)
    tcInferAppHead (HsExpr (GhcPass 'Renamed)
    fun,AppCtxt
    ctxt) [HsExprArg 'TcpRn]
    args Maybe TcSigmaType
    mb_res_ty
      = forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (AppCtxt -> SrcSpan
    appCtxtLoc AppCtxt
    ctxt) forall a b. (a -> b) -> a -> b
    $
        do { Maybe (HsExpr GhcTc, TcSigmaType)
    mb_tc_fun <- HsExpr (GhcPass 'Renamed)
    -> [HsExprArg 'TcpRn]
    -> Maybe TcSigmaType
    -> TcM (Maybe (HsExpr GhcTc, TcSigmaType))
    tcInferAppHead_maybe HsExpr (GhcPass 'Renamed)
    fun [HsExprArg 'TcpRn]
    args Maybe TcSigmaType
    mb_res_ty
           ; case Maybe (HsExpr GhcTc, TcSigmaType)
    mb_tc_fun of
                Just (HsExpr GhcTc
    fun', TcSigmaType
    fun_sigma) -> forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc
    fun', TcSigmaType
    fun_sigma)
                Maybe (HsExpr GhcTc, TcSigmaType)
    Nothing -> forall a.
    HsExpr (GhcPass 'Renamed) -> [HsExprArg 'TcpRn] -> TcM a -> TcM a
    add_head_ctxt HsExpr (GhcPass 'Renamed)
    fun [HsExprArg 'TcpRn]
    args forall a b. (a -> b) -> a -> b
    $
                           forall a. (ExpRhoType -> TcM a) -> TcM (a, TcSigmaType)
    tcInfer (HsExpr (GhcPass 'Renamed) -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr (GhcPass 'Renamed)
    fun) }

    tcInferAppHead_maybe :: HsExpr GhcRn
                         -> [HsExprArg 'TcpRn] -> Maybe TcRhoType
                            -- These two args are solely for tcInferRecSelId
                         -> TcM (Maybe (HsExpr GhcTc, TcSigmaType))
    -- See Note [Application chains and heads] in GHC.Tc.Gen.App
    -- Returns Nothing for a complicated head
    tcInferAppHead_maybe :: HsExpr (GhcPass 'Renamed)
    -> [HsExprArg 'TcpRn]
    -> Maybe TcSigmaType
    -> TcM (Maybe (HsExpr GhcTc, TcSigmaType))
    tcInferAppHead_maybe HsExpr (GhcPass 'Renamed)
    fun [HsExprArg 'TcpRn]
    args Maybe TcSigmaType
    mb_res_ty
      = case HsExpr (GhcPass 'Renamed)
    fun of
          HsVar XVar (GhcPass 'Renamed)
    _ (L SrcAnn NameAnn
    _ Name
    nm)          -> forall a. a -> Maybe a
    Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> TcM (HsExpr GhcTc, TcSigmaType)
    tcInferId Name
    nm
          HsRecFld XRecFld (GhcPass 'Renamed)
    _ AmbiguousFieldOcc (GhcPass 'Renamed)
    f              -> forall a. a -> Maybe a
    Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> AmbiguousFieldOcc (GhcPass 'Renamed)
    -> [HsExprArg 'TcpRn]
    -> Maybe TcSigmaType
    -> TcM (HsExpr GhcTc, TcSigmaType)
    tcInferRecSelId AmbiguousFieldOcc (GhcPass 'Renamed)
    f [HsExprArg 'TcpRn]
    args Maybe TcSigmaType
    mb_res_ty
          ExprWithTySig XExprWithTySig (GhcPass 'Renamed)
    _ LHsExpr (GhcPass 'Renamed)
    e LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
    hs_ty   -> forall a.
    HsExpr (GhcPass 'Renamed) -> [HsExprArg 'TcpRn] -> TcM a -> TcM a
    add_head_ctxt HsExpr (GhcPass 'Renamed)
    fun [HsExprArg 'TcpRn]
    args forall a b. (a -> b) -> a -> b
    $
                                       forall a. a -> Maybe a
    Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> LHsExpr (GhcPass 'Renamed)
    -> LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
    -> TcM (HsExpr GhcTc, TcSigmaType)
    tcExprWithSig LHsExpr (GhcPass 'Renamed)
    e LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
    hs_ty
          HsOverLit XOverLitE (GhcPass 'Renamed)
    _ HsOverLit (GhcPass 'Renamed)
    lit           -> forall a. a -> Maybe a
    Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HsOverLit (GhcPass 'Renamed) -> TcM (HsExpr GhcTc, TcSigmaType)
    tcInferOverLit HsOverLit (GhcPass 'Renamed)
    lit
          HsSpliceE XSpliceE (GhcPass 'Renamed)
    _ (HsSpliced XSpliced (GhcPass 'Renamed)
    _ ThModFinalizers
    _ (HsSplicedExpr HsExpr (GhcPass 'Renamed)
    e))
                                    -> HsExpr (GhcPass 'Renamed)
    -> [HsExprArg 'TcpRn]
    -> Maybe TcSigmaType
    -> TcM (Maybe (HsExpr GhcTc, TcSigmaType))
    tcInferAppHead_maybe HsExpr (GhcPass 'Renamed)
    e [HsExprArg 'TcpRn]
    args Maybe TcSigmaType
    mb_res_ty
          HsExpr (GhcPass 'Renamed)
    _                         -> forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing

    add_head_ctxt :: HsExpr GhcRn -> [HsExprArg 'TcpRn] -> TcM a -> TcM a
    -- Don't push an expression context if the arguments are empty,
    -- because it has already been pushed by tcExpr
    add_head_ctxt :: forall a.
    HsExpr (GhcPass 'Renamed) -> [HsExprArg 'TcpRn] -> TcM a -> TcM a
    add_head_ctxt HsExpr (GhcPass 'Renamed)
    fun [HsExprArg 'TcpRn]
    args TcM a
    thing_inside
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [HsExprArg 'TcpRn]
    args = TcM a
    thing_inside
      | Bool
    otherwise = forall a. HsExpr (GhcPass 'Renamed) -> TcRn a -> TcRn a
    addExprCtxt HsExpr (GhcPass 'Renamed)
    fun TcM a
    thing_inside

    {- *********************************************************************
    *                                                                      *
                     Record selectors
    *                                                                      *
    ********************************************************************* -}

    {-
    Note [Deprecating ambiguous fields]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In the future, the -XDuplicateRecordFields extension will no longer support
    disambiguating record fields during type-checking (as described in Note
    [Disambiguating record fields]).  For now, the -Wambiguous-fields option will
    emit a warning whenever an ambiguous field is resolved using type information.
    In a subsequent GHC release, this functionality will be removed and the warning
    will turn into an ambiguity error in the renamer.

    For background information, see GHC proposal #366
    (https://github.com/ghc-proposals/ghc-proposals/pull/366).

    Note [Disambiguating record fields]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    NB. The following is going to be removed: see
    Note [Deprecating ambiguous fields].

    When the -XDuplicateRecordFields extension is used, and the renamer
    encounters a record selector or update that it cannot immediately
    disambiguate (because it involves fields that belong to multiple
    datatypes), it will defer resolution of the ambiguity to the
    typechecker.  In this case, the `Ambiguous` constructor of
    `AmbiguousFieldOcc` is used.

    Consider the following definitions:

            data S = MkS { foo :: Int }
            data T = MkT { foo :: Int, bar :: Int }
            data U = MkU { bar :: Int, baz :: Int }

    When the renamer sees `foo` as a selector or an update, it will not
    know which parent datatype is in use.

    For selectors, there are two possible ways to disambiguate:

    1. Check if the pushed-in type is a function whose domain is a
       datatype, for example:

           f s = (foo :: S -> Int) s

           g :: T -> Int
           g = foo

        This is checked by `tcCheckRecSelId` when checking `HsRecFld foo`.

    2. Check if the selector is applied to an argument that has a type
       signature, for example:

           h = foo (s :: S)

        This is checked by `tcInferRecSelId`.

    Updates are slightly more complex.  The `disambiguateRecordBinds`
    function tries to determine the parent datatype in three ways:

    1. Check for types that have all the fields being updated. For example:

            f x = x { foo = 3, bar = 2 }

       Here `f` must be updating `T` because neither `S` nor `U` have
       both fields. This may also discover that no possible type exists.
       For example the following will be rejected:

            f' x = x { foo = 3, baz = 3 }

    2. Use the type being pushed in, if it is already a TyConApp. The
       following are valid updates to `T`:

            g :: T -> T
            g x = x { foo = 3 }

            g' x = x { foo = 3 } :: T

    3. Use the type signature of the record expression, if it exists and
       is a TyConApp. Thus this is valid update to `T`:

            h x = (x :: T) { foo = 3 }

    Note that we do not look up the types of variables being updated, and
    no constraint-solving is performed, so for example the following will
    be rejected as ambiguous:

         let bad (s :: S) = foo s

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

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

    We could add further tests, of a more heuristic nature. For example,
    rather than looking for an explicit signature, we could try to infer
    the type of the argument to a selector or the record expression being
    updated, in case we are lucky enough to get a TyConApp straight
    away. However, it might be hard for programmers to predict whether a
    particular update is sufficiently obvious for the signature to be
    omitted. Moreover, this might change the behaviour of typechecker in
    non-obvious ways.

    See also Note [HsRecField and HsRecUpdField] in GHC.Hs.Pat.
    -}

    tcInferRecSelId :: AmbiguousFieldOcc GhcRn
                    -> [HsExprArg 'TcpRn] -> Maybe TcRhoType
                    -> TcM (HsExpr GhcTc, TcSigmaType)
    tcInferRecSelId :: AmbiguousFieldOcc (GhcPass 'Renamed)
    -> [HsExprArg 'TcpRn]
    -> Maybe TcSigmaType
    -> TcM (HsExpr GhcTc, TcSigmaType)
    tcInferRecSelId (Unambiguous XUnambiguous (GhcPass 'Renamed)
    sel_name LocatedN RdrName
    lbl) [HsExprArg 'TcpRn]
    _args Maybe TcSigmaType
    _mb_res_ty
       = do { Id
    sel_id <- LocatedN RdrName -> Name -> TcM Id
    tc_rec_sel_id LocatedN RdrName
    lbl XUnambiguous (GhcPass 'Renamed)
    sel_name
            ; let expr :: HsExpr GhcTc
    expr = forall p. XRecFld p -> AmbiguousFieldOcc p -> HsExpr p
    HsRecFld NoExtField
    noExtField (forall pass.
    XUnambiguous pass -> LocatedN RdrName -> AmbiguousFieldOcc pass
    Unambiguous Id
    sel_id LocatedN RdrName
    lbl)
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc
    expr, Id -> TcSigmaType
    idType Id
    sel_id) }

    tcInferRecSelId (Ambiguous XAmbiguous (GhcPass 'Renamed)
    _ LocatedN RdrName
    lbl) [HsExprArg 'TcpRn]
    args Maybe TcSigmaType
    mb_res_ty
       = do { Name
    sel_name <- LocatedN RdrName
    -> [HsExprArg 'TcpRn] -> Maybe TcSigmaType -> TcM Name
    tcInferAmbiguousRecSelId LocatedN RdrName
    lbl [HsExprArg 'TcpRn]
    args Maybe TcSigmaType
    mb_res_ty
            ; Id
    sel_id   <- LocatedN RdrName -> Name -> TcM Id
    tc_rec_sel_id LocatedN RdrName
    lbl Name
    sel_name
            ; let expr :: HsExpr GhcTc
    expr = forall p. XRecFld p -> AmbiguousFieldOcc p -> HsExpr p
    HsRecFld NoExtField
    noExtField (forall pass.
    XAmbiguous pass -> LocatedN RdrName -> AmbiguousFieldOcc pass
    Ambiguous Id
    sel_id LocatedN RdrName
    lbl)
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc
    expr, Id -> TcSigmaType
    idType Id
    sel_id) }

    ------------------------
    tc_rec_sel_id :: LocatedN RdrName -> Name -> TcM TcId
    -- Like tc_infer_id, but returns an Id not a HsExpr,
    -- so we can wrap it back up into a HsRecFld
    tc_rec_sel_id :: LocatedN RdrName -> Name -> TcM Id
    tc_rec_sel_id LocatedN RdrName
    lbl Name
    sel_name
      = do { TcTyThing
    thing <- Name -> TcM TcTyThing
    tcLookup Name
    sel_name
           ; case TcTyThing
    thing of
                 ATcId { tct_id :: TcTyThing -> Id
    tct_id = Id
    id }
                   -> do { OccName -> Id -> TcM ()
    check_naughty OccName
    occ Id
    id
                         ; Id -> TcM ()
    check_local_id Id
    id
                         ; forall (m :: * -> *) a. Monad m => a -> m a
    return Id
    id }

                 AGlobal (AnId Id
    id)
                   -> do { OccName -> Id -> TcM ()
    check_naughty OccName
    occ Id
    id
                         ; forall (m :: * -> *) a. Monad m => a -> m a
    return Id
    id }
                        -- A global cannot possibly be ill-staged
                        -- nor does it need the 'lifting' treatment
                        -- hence no checkTh stuff here

                 TcTyThing
    _ -> forall a. SDoc -> TcM a
    failWithTc forall a b. (a -> b) -> a -> b
    $
                      forall a. Outputable a => a -> SDoc
    ppr TcTyThing
    thing SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "used where a value identifier was expected" }
      where
        occ :: OccName
    occ = RdrName -> OccName
    rdrNameOcc (forall l e. GenLocated l e -> e
    unLoc LocatedN RdrName
    lbl)

    ------------------------
    tcInferAmbiguousRecSelId :: LocatedN RdrName
                             -> [HsExprArg 'TcpRn] -> Maybe TcRhoType
                             -> TcM Name
    -- Disgusting special case for ambiguous record selectors
    -- Given a RdrName that refers to multiple record fields, and the type
    -- of its argument, try to determine the name of the selector that is
    -- meant.
    -- See Note [Disambiguating record fields]
    tcInferAmbiguousRecSelId :: LocatedN RdrName
    -> [HsExprArg 'TcpRn] -> Maybe TcSigmaType -> TcM Name
    tcInferAmbiguousRecSelId LocatedN RdrName
    lbl [HsExprArg 'TcpRn]
    args Maybe TcSigmaType
    mb_res_ty
      | HsExprArg 'TcpRn
    arg1 : [HsExprArg 'TcpRn]
    _ <- forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall (id :: TcPass). HsExprArg id -> Bool
    isVisibleArg) [HsExprArg 'TcpRn]
    args -- A value arg is first
      , EValArg { eva_arg :: forall (p :: TcPass). HsExprArg p -> EValArg p
    eva_arg = ValArg (L SrcSpanAnnA
    _ HsExpr (GhcPass 'Renamed)
    arg) } <- HsExprArg 'TcpRn
    arg1
      , Just LHsSigWcType (GhcPass 'Renamed)
    sig_ty <- HsExpr (GhcPass 'Renamed)
    -> Maybe (LHsSigWcType (GhcPass 'Renamed))
    obviousSig HsExpr (GhcPass 'Renamed)
    arg  -- A type sig on the arg disambiguates
      = do { TcSigmaType
    sig_tc_ty <- UserTypeCtxt -> LHsSigWcType (GhcPass 'Renamed) -> TcM TcSigmaType
    tcHsSigWcType UserTypeCtxt
    ExprSigCtxt LHsSigWcType (GhcPass 'Renamed)
    sig_ty
           ; LocatedN RdrName -> TcSigmaType -> TcM Name
    finish_ambiguous_selector LocatedN RdrName
    lbl TcSigmaType
    sig_tc_ty }

      | Just TcSigmaType
    res_ty <- Maybe TcSigmaType
    mb_res_ty
      , Just (Scaled TcSigmaType
    arg_ty,TcSigmaType
    _) <- TcSigmaType -> Maybe (Scaled TcSigmaType, TcSigmaType)
    tcSplitFunTy_maybe TcSigmaType
    res_ty
      = LocatedN RdrName -> TcSigmaType -> TcM Name
    finish_ambiguous_selector LocatedN RdrName
    lbl (forall a. Scaled a -> a
    scaledThing Scaled TcSigmaType
    arg_ty)

      | Bool
    otherwise
      = forall a. LocatedN RdrName -> TcM a
    ambiguousSelector LocatedN RdrName
    lbl

    finish_ambiguous_selector :: LocatedN RdrName -> Type -> TcM Name
    finish_ambiguous_selector :: LocatedN RdrName -> TcSigmaType -> TcM Name
    finish_ambiguous_selector lr :: LocatedN RdrName
    lr@(L SrcAnn NameAnn
    _ RdrName
    rdr) TcSigmaType
    parent_type
     = do { FamInstEnvs
    fam_inst_envs <- TcM FamInstEnvs
    tcGetFamInstEnvs
          ; case FamInstEnvs -> TcSigmaType -> Maybe TyCon
    tyConOf FamInstEnvs
    fam_inst_envs TcSigmaType
    parent_type of {
              Maybe TyCon
    Nothing -> forall a. LocatedN RdrName -> TcM a
    ambiguousSelector LocatedN RdrName
    lr ;
              Just TyCon
    p  ->

        do { [(RecSelParent, GlobalRdrElt)]
    xs <- Bool -> RdrName -> RnM [(RecSelParent, GlobalRdrElt)]
    lookupParents Bool
    True RdrName
    rdr
           ; let parent :: RecSelParent
    parent = TyCon -> RecSelParent
    RecSelData TyCon
    p
           ; case forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup RecSelParent
    parent [(RecSelParent, GlobalRdrElt)]
    xs of {
               Maybe GlobalRdrElt
    Nothing  -> forall a. SDoc -> TcM a
    failWithTc (RecSelParent -> RdrName -> SDoc
    fieldNotInType RecSelParent
    parent RdrName
    rdr) ;
               Just GlobalRdrElt
    gre ->

        -- See Note [Unused name reporting and HasField] in GHC.Tc.Instance.Class
        do { Bool -> GlobalRdrElt -> TcM ()
    addUsedGRE Bool
    True GlobalRdrElt
    gre
           ; Name -> TcM ()
    keepAlive (GlobalRdrElt -> Name
    greMangledName GlobalRdrElt
    gre)
             -- See Note [Deprecating ambiguous fields]
           ; WarningFlag -> Bool -> SDoc -> TcM ()
    warnIfFlag WarningFlag
    Opt_WarnAmbiguousFields Bool
    True forall a b. (a -> b) -> a -> b
    $
              [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "The field" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr RdrName
    rdr)
                       SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "belonging to type" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcSigmaType
    parent_type
                       SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is ambiguous."
                   , String -> SDoc
    text String
    "This will not be supported by -XDuplicateRecordFields in future releases of GHC."
                   , if GlobalRdrElt -> Bool
    isLocalGRE GlobalRdrElt
    gre
                     then String -> SDoc
    text String
    "You can use explicit case analysis to resolve the ambiguity."
                     else String -> SDoc
    text String
    "You can use a qualified import or explicit case analysis to resolve the ambiguity."
                   ]
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (GlobalRdrElt -> Name
    greMangledName GlobalRdrElt
    gre) } } } } }

    -- This field name really is ambiguous, so add a suitable "ambiguous
    -- occurrence" error, then give up.
    ambiguousSelector :: LocatedN RdrName -> TcM a
    ambiguousSelector :: forall a. LocatedN RdrName -> TcM a
    ambiguousSelector (L SrcAnn NameAnn
    _ RdrName
    rdr)
      = do { RdrName -> TcM ()
    addAmbiguousNameErr RdrName
    rdr
           ; forall env a. IOEnv env a
    failM }

    -- | This name really is ambiguous, so add a suitable "ambiguous
    -- occurrence" error, then continue
    addAmbiguousNameErr :: RdrName -> TcM ()
    addAmbiguousNameErr :: RdrName -> TcM ()
    addAmbiguousNameErr RdrName
    rdr
      = do { GlobalRdrEnv
    env <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
           ; let gres :: [GlobalRdrElt]
    gres = RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
    lookupGRE_RdrName RdrName
    rdr GlobalRdrEnv
    env
           ; case [GlobalRdrElt]
    gres of
             [] -> forall a. String -> a
    panic String
    "addAmbiguousNameErr: not found"
             GlobalRdrElt
    gre : [GlobalRdrElt]
    gres -> forall a. [ErrCtxt] -> TcM a -> TcM a
    setErrCtxt [] forall a b. (a -> b) -> a -> b
    $ RdrName -> NonEmpty GlobalRdrElt -> TcM ()
    addNameClashErrRn RdrName
    rdr forall a b. (a -> b) -> a -> b
    $ GlobalRdrElt
    gre forall a. a -> [a] -> NonEmpty a
    NE.:| [GlobalRdrElt]
    gres}

    -- A type signature on the argument of an ambiguous record selector or
    -- the record expression in an update must be "obvious", i.e. the
    -- outermost constructor ignoring parentheses.
    obviousSig :: HsExpr GhcRn -> Maybe (LHsSigWcType GhcRn)
    obviousSig :: HsExpr (GhcPass 'Renamed)
    -> Maybe (LHsSigWcType (GhcPass 'Renamed))
    obviousSig (ExprWithTySig XExprWithTySig (GhcPass 'Renamed)
    _ LHsExpr (GhcPass 'Renamed)
    _ LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
    ty) = forall a. a -> Maybe a
    Just LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
    ty
    obviousSig (HsPar XPar (GhcPass 'Renamed)
    _ LHsExpr (GhcPass 'Renamed)
    p)            = HsExpr (GhcPass 'Renamed)
    -> Maybe (LHsSigWcType (GhcPass 'Renamed))
    obviousSig (forall l e. GenLocated l e -> e
    unLoc LHsExpr (GhcPass 'Renamed)
    p)
    obviousSig (HsPragE XPragE (GhcPass 'Renamed)
    _ HsPragE (GhcPass 'Renamed)
    _ LHsExpr (GhcPass 'Renamed)
    p)        = HsExpr (GhcPass 'Renamed)
    -> Maybe (LHsSigWcType (GhcPass 'Renamed))
    obviousSig (forall l e. GenLocated l e -> e
    unLoc LHsExpr (GhcPass 'Renamed)
    p)
    obviousSig HsExpr (GhcPass 'Renamed)
    _                      = forall a. Maybe a
    Nothing

    -- Extract the outermost TyCon of a type, if there is one; for
    -- data families this is the representation tycon (because that's
    -- where the fields live).
    tyConOf :: FamInstEnvs -> TcSigmaType -> Maybe TyCon
    tyConOf :: FamInstEnvs -> TcSigmaType -> Maybe TyCon
    tyConOf FamInstEnvs
    fam_inst_envs TcSigmaType
    ty0
      = case HasCallStack => TcSigmaType -> Maybe (TyCon, [TcSigmaType])
    tcSplitTyConApp_maybe TcSigmaType
    ty of
          Just (TyCon
    tc, [TcSigmaType]
    tys) -> forall a. a -> Maybe a
    Just (forall a b c. (a, b, c) -> a
    fstOf3 (FamInstEnvs
    -> TyCon -> [TcSigmaType] -> (TyCon, [TcSigmaType], Coercion)
    tcLookupDataFamInst FamInstEnvs
    fam_inst_envs TyCon
    tc [TcSigmaType]
    tys))
          Maybe (TyCon, [TcSigmaType])
    Nothing        -> forall a. Maybe a
    Nothing
      where
        ([Id]
    _, [TcSigmaType]
    _, TcSigmaType
    ty) = TcSigmaType -> ([Id], [TcSigmaType], TcSigmaType)
    tcSplitSigmaTy TcSigmaType
    ty0

    -- Variant of tyConOf that works for ExpTypes
    tyConOfET :: FamInstEnvs -> ExpRhoType -> Maybe TyCon
    tyConOfET :: FamInstEnvs -> ExpRhoType -> Maybe TyCon
    tyConOfET FamInstEnvs
    fam_inst_envs ExpRhoType
    ty0 = FamInstEnvs -> TcSigmaType -> Maybe TyCon
    tyConOf FamInstEnvs
    fam_inst_envs forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExpRhoType -> Maybe TcSigmaType
    checkingExpType_maybe ExpRhoType
    ty0

    -- For an ambiguous record field, find all the candidate record
    -- selectors (as GlobalRdrElts) and their parents.
    lookupParents :: Bool -> RdrName -> RnM [(RecSelParent, GlobalRdrElt)]
    lookupParents :: Bool -> RdrName -> RnM [(RecSelParent, GlobalRdrElt)]
    lookupParents Bool
    is_selector RdrName
    rdr
      = do { GlobalRdrEnv
    env <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
            -- Filter by isRecFldGRE because otherwise a non-selector variable with
            -- an overlapping name can get through when NoFieldSelectors is enabled.
            -- See Note [NoFieldSelectors] in GHC.Rename.Env.
           ; let all_gres :: [GlobalRdrElt]
    all_gres = RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
    lookupGRE_RdrName' RdrName
    rdr GlobalRdrEnv
    env
           ; let gres :: [GlobalRdrElt]
    gres | Bool
    is_selector = forall a. (a -> Bool) -> [a] -> [a]
    filter GlobalRdrElt -> Bool
    isFieldSelectorGRE [GlobalRdrElt]
    all_gres
                      | Bool
    otherwise   = forall a. (a -> Bool) -> [a] -> [a]
    filter GlobalRdrElt -> Bool
    isRecFldGRE [GlobalRdrElt]
    all_gres
           ; forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GlobalRdrElt -> RnM (RecSelParent, GlobalRdrElt)
    lookupParent [GlobalRdrElt]
    gres }
      where
        lookupParent :: GlobalRdrElt -> RnM (RecSelParent, GlobalRdrElt)
        lookupParent :: GlobalRdrElt -> RnM (RecSelParent, GlobalRdrElt)
    lookupParent GlobalRdrElt
    gre = do { Id
    id <- Name -> TcM Id
    tcLookupId (GlobalRdrElt -> Name
    greMangledName GlobalRdrElt
    gre)
                              ; case Id -> Maybe RecSelParent
    recordSelectorTyCon_maybe Id
    id of
                                  Just RecSelParent
    rstc -> forall (m :: * -> *) a. Monad m => a -> m a
    return (RecSelParent
    rstc, GlobalRdrElt
    gre)
                                  Maybe RecSelParent
    Nothing -> forall a. SDoc -> TcM a
    failWithTc (Name -> SDoc
    notSelector (GlobalRdrElt -> Name
    greMangledName GlobalRdrElt
    gre)) }

    fieldNotInType :: RecSelParent -> RdrName -> SDoc
    fieldNotInType :: RecSelParent -> RdrName -> SDoc
    fieldNotInType RecSelParent
    p RdrName
    rdr
      = SDoc -> RdrName -> SDoc
    unknownSubordinateErr (String -> SDoc
    text String
    "field of type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr RecSelParent
    p)) RdrName
    rdr

    notSelector :: Name -> SDoc
    notSelector :: Name -> SDoc
    notSelector Name
    field
      = [SDoc] -> SDoc
    hsep [SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr Name
    field), String -> SDoc
    text String
    "is not a record selector"]

    naughtyRecordSel :: OccName -> SDoc
    naughtyRecordSel :: OccName -> SDoc
    naughtyRecordSel OccName
    lbl
      = String -> SDoc
    text String
    "Cannot use record selector" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr OccName
    lbl) SDoc -> SDoc -> SDoc
    <+>
        String -> SDoc
    text String
    "as a function due to escaped type variables" SDoc -> SDoc -> SDoc
    $$
        String -> SDoc
    text String
    "Probable fix: use pattern-matching syntax instead"

    {- *********************************************************************
    *                                                                      *
                    Expressions with a type signature
                            expr :: type
    *                                                                      *
    ********************************************************************* -}

    tcExprWithSig :: LHsExpr GhcRn -> LHsSigWcType (NoGhcTc GhcRn)
                  -> TcM (HsExpr GhcTc, TcSigmaType)
    tcExprWithSig :: LHsExpr (GhcPass 'Renamed)
    -> LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
    -> TcM (HsExpr GhcTc, TcSigmaType)
    tcExprWithSig LHsExpr (GhcPass 'Renamed)
    expr LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
    hs_ty
      = do { TcIdSigInfo
    sig_info <- forall r. TcM r -> TcM r
    checkNoErrs forall a b. (a -> b) -> a -> b
    $  -- Avoid error cascade
                         SrcSpan
    -> LHsSigWcType (GhcPass 'Renamed) -> Maybe Name -> TcM TcIdSigInfo
    tcUserTypeSig SrcSpan
    loc LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
    hs_ty forall a. Maybe a
    Nothing
           ; (GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr', TcSigmaType
    poly_ty) <- LHsExpr (GhcPass 'Renamed)
    -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcSigmaType)
    tcExprSig LHsExpr (GhcPass 'Renamed)
    expr TcIdSigInfo
    sig_info
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall p.
    XExprWithTySig p
    -> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
    ExprWithTySig NoExtField
    noExtField GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr' LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
    hs_ty, TcSigmaType
    poly_ty) }
      where
        loc :: SrcSpan
    loc = forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
    getLocA (forall pass. LHsSigWcType pass -> LHsSigType pass
    dropWildCards LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
    hs_ty)

    tcExprSig :: LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType)
    tcExprSig :: LHsExpr (GhcPass 'Renamed)
    -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcSigmaType)
    tcExprSig LHsExpr (GhcPass 'Renamed)
    expr (CompleteSig { sig_bndr :: TcIdSigInfo -> Id
    sig_bndr = Id
    poly_id, sig_loc :: TcIdSigInfo -> SrcSpan
    sig_loc = SrcSpan
    loc })
      = forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc forall a b. (a -> b) -> a -> b
    $   -- Sets the location for the implication constraint
        do { let poly_ty :: TcSigmaType
    poly_ty = Id -> TcSigmaType
    idType Id
    poly_id
           ; (HsWrapper
    wrap, GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr') <- forall result.
    UserTypeCtxt
    -> TcSigmaType
    -> (TcSigmaType -> TcM result)
    -> TcM (HsWrapper, result)
    tcSkolemiseScoped UserTypeCtxt
    ExprSigCtxt TcSigmaType
    poly_ty forall a b. (a -> b) -> a -> b
    $ \TcSigmaType
    rho_ty ->
                              LHsExpr (GhcPass 'Renamed) -> TcSigmaType -> TcM (LHsExpr GhcTc)
    tcCheckMonoExprNC LHsExpr (GhcPass 'Renamed)
    expr TcSigmaType
    rho_ty
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap HsWrapper
    wrap GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr', TcSigmaType
    poly_ty) }

    tcExprSig LHsExpr (GhcPass 'Renamed)
    expr sig :: TcIdSigInfo
    sig@(PartialSig { psig_name :: TcIdSigInfo -> Name
    psig_name = Name
    name, sig_loc :: TcIdSigInfo -> SrcSpan
    sig_loc = SrcSpan
    loc })
      = forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc forall a b. (a -> b) -> a -> b
    $   -- Sets the location for the implication constraint
        do { (TcLevel
    tclvl, WantedConstraints
    wanted, (GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr', TcIdSigInst
    sig_inst))
                 <- forall a. TcM a -> TcM (TcLevel, WantedConstraints, a)
    pushLevelAndCaptureConstraints  forall a b. (a -> b) -> a -> b
    $
                    do { TcIdSigInst
    sig_inst <- TcIdSigInfo -> TcM TcIdSigInst
    tcInstSig TcIdSigInfo
    sig
                       ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr' <- forall r. [(Name, Id)] -> TcM r -> TcM r
    tcExtendNameTyVarEnv (forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
    mapSnd forall tv argf. VarBndr tv argf -> tv
    binderVar forall a b. (a -> b) -> a -> b
    $ TcIdSigInst -> [(Name, InvisTVBinder)]
    sig_inst_skols TcIdSigInst
    sig_inst) forall a b. (a -> b) -> a -> b
    $
                                  forall r. [(Name, Id)] -> TcM r -> TcM r
    tcExtendNameTyVarEnv (TcIdSigInst -> [(Name, Id)]
    sig_inst_wcs   TcIdSigInst
    sig_inst) forall a b. (a -> b) -> a -> b
    $
                                  LHsExpr (GhcPass 'Renamed) -> TcSigmaType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExprNC LHsExpr (GhcPass 'Renamed)
    expr (TcIdSigInst -> TcSigmaType
    sig_inst_tau TcIdSigInst
    sig_inst)
                       ; forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr', TcIdSigInst
    sig_inst) }
           -- See Note [Partial expression signatures]
           ; let tau :: TcSigmaType
    tau = TcIdSigInst -> TcSigmaType
    sig_inst_tau TcIdSigInst
    sig_inst
                 infer_mode :: InferMode
    infer_mode | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (TcIdSigInst -> [TcSigmaType]
    sig_inst_theta TcIdSigInst
    sig_inst)
                            , forall a. Maybe a -> Bool
    isNothing (TcIdSigInst -> Maybe TcSigmaType
    sig_inst_wcx TcIdSigInst
    sig_inst)
                            = InferMode
    ApplyMR
                            | Bool
    otherwise
                            = InferMode
    NoRestrictions
           ; ([Id]
    qtvs, [Id]
    givens, TcEvBinds
    ev_binds, Bool
    _)
                     <- TcLevel
    -> InferMode
    -> [TcIdSigInst]
    -> [(Name, TcSigmaType)]
    -> WantedConstraints
    -> TcM ([Id], [Id], TcEvBinds, Bool)
    simplifyInfer TcLevel
    tclvl InferMode
    infer_mode [TcIdSigInst
    sig_inst] [(Name
    name, TcSigmaType
    tau)] WantedConstraints
    wanted

           ; TcSigmaType
    tau <- TcSigmaType -> TcM TcSigmaType
    zonkTcType TcSigmaType
    tau
           ; let inferred_theta :: [TcSigmaType]
    inferred_theta = forall a b. (a -> b) -> [a] -> [b]
    map Id -> TcSigmaType
    evVarPred [Id]
    givens
                 tau_tvs :: TyCoVarSet
    tau_tvs        = TcSigmaType -> TyCoVarSet
    tyCoVarsOfType TcSigmaType
    tau
           ; ([InvisTVBinder]
    binders, [TcSigmaType]
    my_theta) <- [TcSigmaType]
    -> TyCoVarSet
    -> [Id]
    -> Maybe TcIdSigInst
    -> TcM ([InvisTVBinder], [TcSigmaType])
    chooseInferredQuantifiers [TcSigmaType]
    inferred_theta
                                       TyCoVarSet
    tau_tvs [Id]
    qtvs (forall a. a -> Maybe a
    Just TcIdSigInst
    sig_inst)
           ; let inferred_sigma :: TcSigmaType
    inferred_sigma = [Id] -> [TcSigmaType] -> TcSigmaType -> TcSigmaType
    mkInfSigmaTy [Id]
    qtvs [TcSigmaType]
    inferred_theta TcSigmaType
    tau
                 my_sigma :: TcSigmaType
    my_sigma       = [InvisTVBinder] -> TcSigmaType -> TcSigmaType
    mkInvisForAllTys [InvisTVBinder]
    binders ([TcSigmaType] -> TcSigmaType -> TcSigmaType
    mkPhiTy  [TcSigmaType]
    my_theta TcSigmaType
    tau)
           ; HsWrapper
    wrap <- if TcSigmaType
    inferred_sigma TcSigmaType -> TcSigmaType -> Bool
    `eqType` TcSigmaType
    my_sigma -- NB: eqType ignores vis.
                     then forall (m :: * -> *) a. Monad m => a -> m a
    return HsWrapper
    idHsWrapper  -- Fast path; also avoids complaint when we infer
                                              -- an ambiguous type and have AllowAmbiguousType
                                              -- e..g infer  x :: forall a. F a -> Int
                     else CtOrigin
    -> UserTypeCtxt -> TcSigmaType -> TcSigmaType -> TcM HsWrapper
    tcSubTypeSigma CtOrigin
    ExprSigOrigin UserTypeCtxt
    ExprSigCtxt TcSigmaType
    inferred_sigma TcSigmaType
    my_sigma

           ; String -> SDoc -> TcM ()
    traceTc String
    "tcExpSig" (forall a. Outputable a => a -> SDoc
    ppr [Id]
    qtvs SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr [Id]
    givens SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr TcSigmaType
    inferred_sigma SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr TcSigmaType
    my_sigma)
           ; let poly_wrap :: HsWrapper
    poly_wrap = HsWrapper
    wrap
                             HsWrapper -> HsWrapper -> HsWrapper
    <.> [Id] -> HsWrapper
    mkWpTyLams [Id]
    qtvs
                             HsWrapper -> HsWrapper -> HsWrapper
    <.> [Id] -> HsWrapper
    mkWpLams [Id]
    givens
                             HsWrapper -> HsWrapper -> HsWrapper
    <.> TcEvBinds -> HsWrapper
    mkWpLet  TcEvBinds
    ev_binds
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap HsWrapper
    poly_wrap GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr', TcSigmaType
    my_sigma) }

    {- Note [Partial expression signatures]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Partial type signatures on expressions are easy to get wrong.  But
    here is a guiding principile
        e :: ty
    should behave like
        let x :: ty
            x = e
        in x

    So for partial signatures we apply the MR if no context is given.  So
       e :: IO _          apply the MR
       e :: _ => IO _     do not apply the MR
    just like in GHC.Tc.Gen.Bind.decideGeneralisationPlan

    This makes a difference (#11670):
       peek :: Ptr a -> IO CLong
       peek ptr = peekElemOff undefined 0 :: _
    from (peekElemOff undefined 0) we get
              type: IO w
       constraints: Storable w

    We must NOT try to generalise over 'w' because the signature specifies
    no constraints so we'll complain about not being able to solve
    Storable w.  Instead, don't generalise; then _ gets instantiated to
    CLong, as it should.
    -}

    {- *********************************************************************
    *                                                                      *
                     Overloaded literals
    *                                                                      *
    ********************************************************************* -}

    tcInferOverLit :: HsOverLit GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
    tcInferOverLit :: HsOverLit (GhcPass 'Renamed) -> TcM (HsExpr GhcTc, TcSigmaType)
    tcInferOverLit lit :: HsOverLit (GhcPass 'Renamed)
    lit@(OverLit { ol_val :: forall p. HsOverLit p -> OverLitVal
    ol_val = OverLitVal
    val
                                , ol_witness :: forall p. HsOverLit p -> HsExpr p
    ol_witness = HsVar XVar (GhcPass 'Renamed)
    _ (L SrcAnn NameAnn
    loc Name
    from_name)
                                , ol_ext :: forall p. HsOverLit p -> XOverLit p
    ol_ext = XOverLit (GhcPass 'Renamed)
    rebindable })
      = -- Desugar "3" to (fromInteger (3 :: Integer))
        --   where fromInteger is gotten by looking up from_name, and
        --   the (3 :: Integer) is returned by mkOverLit
        -- Ditto the string literal "foo" to (fromString ("foo" :: String))
        do { Id
    from_id <- Name -> TcM Id
    tcLookupId Name
    from_name
           ; (HsWrapper
    wrap1, TcSigmaType
    from_ty) <- CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcSigmaType)
    topInstantiate CtOrigin
    orig (Id -> TcSigmaType
    idType Id
    from_id)

           ; (HsWrapper
    wrap2, Scaled TcSigmaType
    sarg_ty, TcSigmaType
    res_ty) <- SDoc
    -> Maybe SDoc
    -> (ThLevel, [Scaled TcSigmaType])
    -> TcSigmaType
    -> TcM (HsWrapper, Scaled TcSigmaType, TcSigmaType)
    matchActualFunTySigma SDoc
    herald Maybe SDoc
    mb_doc
                                                               (ThLevel
    1, []) TcSigmaType
    from_ty
           ; HsLit GhcTc
    hs_lit <- OverLitVal -> TcM (HsLit GhcTc)
    mkOverLit OverLitVal
    val
           ; Coercion
    co <- Maybe SDoc -> TcSigmaType -> TcSigmaType -> TcM Coercion
    unifyType Maybe SDoc
    mb_doc (forall (p :: Pass). HsLit (GhcPass p) -> TcSigmaType
    hsLitType HsLit GhcTc
    hs_lit) (forall a. Scaled a -> a
    scaledThing Scaled TcSigmaType
    sarg_ty)

           ; let lit_expr :: GenLocated SrcSpanAnnA (HsExpr GhcTc)
    lit_expr = forall l e. l -> e -> GenLocated l e
    L (forall a ann. SrcSpanAnn' a -> SrcAnn ann
    l2l SrcAnn NameAnn
    loc) forall a b. (a -> b) -> a -> b
    $ Coercion -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrapCo Coercion
    co forall a b. (a -> b) -> a -> b
    $
                            forall p. XLitE p -> HsLit p -> HsExpr p
    HsLit forall a. EpAnn a
    noAnn HsLit GhcTc
    hs_lit
                 from_expr :: HsExpr GhcTc
    from_expr = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap (HsWrapper
    wrap2 HsWrapper -> HsWrapper -> HsWrapper
    <.> HsWrapper
    wrap1) forall a b. (a -> b) -> a -> b
    $
                             forall p. XVar p -> LIdP p -> HsExpr p
    HsVar NoExtField
    noExtField (forall l e. l -> e -> GenLocated l e
    L SrcAnn NameAnn
    loc Id
    from_id)
                 lit' :: HsOverLit GhcTc
    lit' = HsOverLit (GhcPass 'Renamed)
    lit { ol_witness :: HsExpr GhcTc
    ol_witness = forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
    HsApp forall a. EpAnn a
    noAnn (forall l e. l -> e -> GenLocated l e
    L (forall a ann. SrcSpanAnn' a -> SrcAnn ann
    l2l SrcAnn NameAnn
    loc) HsExpr GhcTc
    from_expr) GenLocated SrcSpanAnnA (HsExpr GhcTc)
    lit_expr
                            , ol_ext :: XOverLit GhcTc
    ol_ext = Bool -> TcSigmaType -> OverLitTc
    OverLitTc XOverLit (GhcPass 'Renamed)
    rebindable TcSigmaType
    res_ty }
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall p. XOverLitE p -> HsOverLit p -> HsExpr p
    HsOverLit forall a. EpAnn a
    noAnn HsOverLit GhcTc
    lit', TcSigmaType
    res_ty) }
      where
        orig :: CtOrigin
    orig   = HsOverLit (GhcPass 'Renamed) -> CtOrigin
    LiteralOrigin HsOverLit (GhcPass 'Renamed)
    lit
        mb_doc :: Maybe SDoc
    mb_doc = forall a. a -> Maybe a
    Just (forall a. Outputable a => a -> SDoc
    ppr Name
    from_name)
        herald :: SDoc
    herald = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "The function" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr Name
    from_name)
                     , String -> SDoc
    text String
    "is applied to"]

    tcInferOverLit HsOverLit (GhcPass 'Renamed)
    lit
      = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcInferOverLit" (forall a. Outputable a => a -> SDoc
    ppr HsOverLit (GhcPass 'Renamed)
    lit)

    {- *********************************************************************
    *                                                                      *
                     tcInferId, tcCheckId
    *                                                                      *
    ********************************************************************* -}

    tcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcCheckId Name
    name ExpRhoType
    res_ty
      = do { (HsExpr GhcTc
    expr, TcSigmaType
    actual_res_ty) <- Name -> TcM (HsExpr GhcTc, TcSigmaType)
    tcInferId Name
    name
           ; String -> SDoc -> TcM ()
    traceTc String
    "tcCheckId" ([SDoc] -> SDoc
    vcat [forall a. Outputable a => a -> SDoc
    ppr Name
    name, forall a. Outputable a => a -> SDoc
    ppr TcSigmaType
    actual_res_ty, forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    res_ty])
           ; forall a.
    HsExpr (GhcPass 'Renamed)
    -> [HsExprArg 'TcpRn]
    -> TcSigmaType
    -> ExpRhoType
    -> TcM a
    -> TcM a
    addFunResCtxt HsExpr (GhcPass 'Renamed)
    rn_fun [] TcSigmaType
    actual_res_ty ExpRhoType
    res_ty forall a b. (a -> b) -> a -> b
    $
             CtOrigin
    -> HsExpr (GhcPass 'Renamed)
    -> HsExpr GhcTc
    -> TcSigmaType
    -> ExpRhoType
    -> TcM (HsExpr GhcTc)
    tcWrapResultO (Name -> CtOrigin
    OccurrenceOf Name
    name) HsExpr (GhcPass 'Renamed)
    rn_fun HsExpr GhcTc
    expr TcSigmaType
    actual_res_ty ExpRhoType
    res_ty }
      where
        rn_fun :: HsExpr (GhcPass 'Renamed)
    rn_fun = forall p. XVar p -> LIdP p -> HsExpr p
    HsVar NoExtField
    noExtField (forall a an. a -> LocatedAn an a
    noLocA Name
    name)

    ------------------------
    tcInferId :: Name -> TcM (HsExpr GhcTc, TcSigmaType)
    -- Look up an occurrence of an Id
    -- Do not instantiate its type
    tcInferId :: Name -> TcM (HsExpr GhcTc, TcSigmaType)
    tcInferId Name
    id_name
      | Name
    id_name forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    assertIdKey
      = do { DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; if GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_IgnoreAsserts DynFlags
    dflags
             then Name -> TcM (HsExpr GhcTc, TcSigmaType)
    tc_infer_id Name
    id_name
             else Name -> TcM (HsExpr GhcTc, TcSigmaType)
    tc_infer_assert Name
    id_name }

      | Bool
    otherwise
      = do { (HsExpr GhcTc
    expr, TcSigmaType
    ty) <- Name -> TcM (HsExpr GhcTc, TcSigmaType)
    tc_infer_id Name
    id_name
           ; String -> SDoc -> TcM ()
    traceTc String
    "tcInferId" (forall a. Outputable a => a -> SDoc
    ppr Name
    id_name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr TcSigmaType
    ty)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc
    expr, TcSigmaType
    ty) }

    tc_infer_assert :: Name -> TcM (HsExpr GhcTc, TcSigmaType)
    -- Deal with an occurrence of 'assert'
    -- See Note [Adding the implicit parameter to 'assert']
    tc_infer_assert :: Name -> TcM (HsExpr GhcTc, TcSigmaType)
    tc_infer_assert Name
    assert_name
      = do { Id
    assert_error_id <- Name -> TcM Id
    tcLookupId Name
    assertErrorName
           ; (HsWrapper
    wrap, TcSigmaType
    id_rho) <- CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcSigmaType)
    topInstantiate (Name -> CtOrigin
    OccurrenceOf Name
    assert_name)
                                              (Id -> TcSigmaType
    idType Id
    assert_error_id)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap (forall p. XVar p -> LIdP p -> HsExpr p
    HsVar NoExtField
    noExtField (forall a an. a -> LocatedAn an a
    noLocA Id
    assert_error_id)), TcSigmaType
    id_rho)
           }

    tc_infer_id :: Name -> TcM (HsExpr GhcTc, TcSigmaType)
    tc_infer_id :: Name -> TcM (HsExpr GhcTc, TcSigmaType)
    tc_infer_id Name
    id_name
     = do { TcTyThing
    thing <- Name -> TcM TcTyThing
    tcLookup Name
    id_name
          ; GlobalRdrEnv
    global_env <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
          ; case TcTyThing
    thing of
                 ATcId { tct_id :: TcTyThing -> Id
    tct_id = Id
    id }
                   -> do { Id -> TcM ()
    check_local_id Id
    id
                         ; forall {p} {an} {m :: * -> *}.
    (XVar p ~ NoExtField, XRec p (IdP p) ~ GenLocated (SrcAnn an) Id,
     Monad m) =>
    Id -> m (HsExpr p, TcSigmaType)
    return_id Id
    id }

                 AGlobal (AnId Id
    id)
                   -> forall {p} {an} {m :: * -> *}.
    (XVar p ~ NoExtField, XRec p (IdP p) ~ GenLocated (SrcAnn an) Id,
     Monad m) =>
    Id -> m (HsExpr p, TcSigmaType)
    return_id Id
    id
                   -- A global cannot possibly be ill-staged
                   -- nor does it need the 'lifting' treatment
                   -- Hence no checkTh stuff here

                 AGlobal (AConLike ConLike
    cl) -> case ConLike
    cl of
                     RealDataCon DataCon
    con -> DataCon -> TcM (HsExpr GhcTc, TcSigmaType)
    return_data_con DataCon
    con
                     PatSynCon PatSyn
    ps
                       | Just (HsExpr GhcTc
    expr, TcSigmaType
    ty) <- PatSyn -> Maybe (HsExpr GhcTc, TcSigmaType)
    patSynBuilderOcc PatSyn
    ps
                       -> forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc
    expr, TcSigmaType
    ty)
                       | Bool
    otherwise
                       -> forall a. SDoc -> TcM a
    failWithTc (forall a. Outputable a => a -> SDoc
    nonBidirectionalErr Name
    id_name)

                 AGlobal (ATyCon TyCon
    ty_con)
                   -> forall {a}. GlobalRdrEnv -> TyCon -> TcM a
    fail_tycon GlobalRdrEnv
    global_env TyCon
    ty_con

                 ATyVar Name
    name Id
    _
                    -> forall a. SDoc -> TcM a
    failWithTc forall a b. (a -> b) -> a -> b
    $
                         String -> SDoc
    text String
    "Illegal term-level use of the type variable"
                           SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr Name
    name)
                           SDoc -> SDoc -> SDoc
    $$ ThLevel -> SDoc -> SDoc
    nest ThLevel
    2 (String -> SDoc
    text String
    "bound at" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr (forall a. NamedThing a => a -> SrcLoc
    getSrcLoc Name
    name))

                 ATcTyCon TyCon
    ty_con
                   -> forall {a}. GlobalRdrEnv -> TyCon -> TcM a
    fail_tycon GlobalRdrEnv
    global_env TyCon
    ty_con

                 TcTyThing
    _ -> forall a. SDoc -> TcM a
    failWithTc forall a b. (a -> b) -> a -> b
    $
                      forall a. Outputable a => a -> SDoc
    ppr TcTyThing
    thing SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "used where a value identifier was expected" }
      where
        fail_tycon :: GlobalRdrEnv -> TyCon -> TcM a
    fail_tycon GlobalRdrEnv
    global_env TyCon
    ty_con =
          let pprov :: SDoc
    pprov = case GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
    lookupGRE_Name GlobalRdrEnv
    global_env (TyCon -> Name
    tyConName TyCon
    ty_con) of
                Just GlobalRdrElt
    gre -> ThLevel -> SDoc -> SDoc
    nest ThLevel
    2 (GlobalRdrElt -> SDoc
    pprNameProvenance GlobalRdrElt
    gre)
                Maybe GlobalRdrElt
    Nothing  -> SDoc
    empty
          in forall a. SDoc -> TcM a
    failWithTc (TyCon -> SDoc
    term_level_tycons TyCon
    ty_con SDoc -> SDoc -> SDoc
    $$ SDoc
    pprov)

        term_level_tycons :: TyCon -> SDoc
    term_level_tycons TyCon
    ty_con
          = String -> SDoc
    text String
    "Illegal term-level use of the type constructor"
              SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr (TyCon -> Name
    tyConName TyCon
    ty_con))

        return_id :: Id -> m (HsExpr p, TcSigmaType)
    return_id Id
    id = forall (m :: * -> *) a. Monad m => a -> m a
    return (forall p. XVar p -> LIdP p -> HsExpr p
    HsVar NoExtField
    noExtField (forall a an. a -> LocatedAn an a
    noLocA Id
    id), Id -> TcSigmaType
    idType Id
    id)

        return_data_con :: DataCon -> TcM (HsExpr GhcTc, TcSigmaType)
    return_data_con DataCon
    con
          = do { let tvs :: [InvisTVBinder]
    tvs = DataCon -> [InvisTVBinder]
    dataConUserTyVarBinders DataCon
    con
                     theta :: [TcSigmaType]
    theta = DataCon -> [TcSigmaType]
    dataConOtherTheta DataCon
    con
                     args :: [Scaled TcSigmaType]
    args = DataCon -> [Scaled TcSigmaType]
    dataConOrigArgTys DataCon
    con
                     res :: TcSigmaType
    res = DataCon -> TcSigmaType
    dataConOrigResTy DataCon
    con

               -- See Note [Linear fields generalization]
               ; [TcSigmaType]
    mul_vars <- ThLevel -> TcSigmaType -> TcM [TcSigmaType]
    newFlexiTyVarTys (forall (t :: * -> *) a. Foldable t => t a -> ThLevel
    length [Scaled TcSigmaType]
    args) TcSigmaType
    multiplicityTy
               ; let scaleArgs :: [Scaled TcSigmaType] -> [Scaled TcSigmaType]
    scaleArgs [Scaled TcSigmaType]
    args' = forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithEqual String
    "return_data_con" forall {a}. TcSigmaType -> Scaled a -> Scaled a
    combine [TcSigmaType]
    mul_vars [Scaled TcSigmaType]
    args'
                     combine :: TcSigmaType -> Scaled a -> Scaled a
    combine TcSigmaType
    var (Scaled TcSigmaType
    One a
    ty) = forall a. TcSigmaType -> a -> Scaled a
    Scaled TcSigmaType
    var a
    ty
                     combine TcSigmaType
    _   Scaled a
    scaled_ty       = Scaled a
    scaled_ty
                       -- The combine function implements the fact that, as
                       -- described in Note [Linear fields generalization], if a
                       -- field is not linear (last line) it isn't made polymorphic.

                     etaWrapper :: t (Scaled TcSigmaType) -> HsWrapper
    etaWrapper t (Scaled TcSigmaType)
    arg_tys = forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\Scaled TcSigmaType
    scaled_ty HsWrapper
    wr -> HsWrapper -> HsWrapper -> Scaled TcSigmaType -> SDoc -> HsWrapper
    WpFun HsWrapper
    WpHole HsWrapper
    wr Scaled TcSigmaType
    scaled_ty SDoc
    empty) HsWrapper
    WpHole t (Scaled TcSigmaType)
    arg_tys

               -- See Note [Instantiating stupid theta]
               ; let shouldInstantiate :: Bool
    shouldInstantiate = (Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (DataCon -> [TcSigmaType]
    dataConStupidTheta DataCon
    con)) Bool -> Bool -> Bool
    ||
                                          TcSigmaType -> Bool
    isKindLevPoly (TyCon -> TcSigmaType
    tyConResKind (DataCon -> TyCon
    dataConTyCon DataCon
    con)))
               ; case Bool
    shouldInstantiate of
                   Bool
    True -> do { (TCvSubst
    subst, [Id]
    tvs') <- [Id] -> TcM (TCvSubst, [Id])
    newMetaTyVars (forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [InvisTVBinder]
    tvs)
                               ; let tys' :: [TcSigmaType]
    tys'   = [Id] -> [TcSigmaType]
    mkTyVarTys [Id]
    tvs'
                                     theta' :: [TcSigmaType]
    theta' = HasCallStack => TCvSubst -> [TcSigmaType] -> [TcSigmaType]
    substTheta TCvSubst
    subst [TcSigmaType]
    theta
                                     args' :: [Scaled TcSigmaType]
    args'  = HasCallStack =>
    TCvSubst -> [Scaled TcSigmaType] -> [Scaled TcSigmaType]
    substScaledTys TCvSubst
    subst [Scaled TcSigmaType]
    args
                                     res' :: TcSigmaType
    res'   = HasCallStack => TCvSubst -> TcSigmaType -> TcSigmaType
    substTy TCvSubst
    subst TcSigmaType
    res
                               ; HsWrapper
    wrap <- CtOrigin -> [TcSigmaType] -> [TcSigmaType] -> TcM HsWrapper
    instCall (Name -> CtOrigin
    OccurrenceOf Name
    id_name) [TcSigmaType]
    tys' [TcSigmaType]
    theta'
                               ; let scaled_arg_tys :: [Scaled TcSigmaType]
    scaled_arg_tys = [Scaled TcSigmaType] -> [Scaled TcSigmaType]
    scaleArgs [Scaled TcSigmaType]
    args'
                                     eta_wrap :: HsWrapper
    eta_wrap = forall {t :: * -> *}.
    Foldable t =>
    t (Scaled TcSigmaType) -> HsWrapper
    etaWrapper [Scaled TcSigmaType]
    scaled_arg_tys
                               ; DataCon -> [TcSigmaType] -> TcM ()
    addDataConStupidTheta DataCon
    con [TcSigmaType]
    tys'
                               ; forall (m :: * -> *) a. Monad m => a -> m a
    return ( HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap (HsWrapper
    eta_wrap HsWrapper -> HsWrapper -> HsWrapper
    <.> HsWrapper
    wrap)
                                                   (forall p. XConLikeOut p -> ConLike -> HsExpr p
    HsConLikeOut NoExtField
    noExtField (DataCon -> ConLike
    RealDataCon DataCon
    con))
                                        , [Scaled TcSigmaType] -> TcSigmaType -> TcSigmaType
    mkVisFunTys [Scaled TcSigmaType]
    scaled_arg_tys TcSigmaType
    res')
                               }
                   Bool
    False -> let scaled_arg_tys :: [Scaled TcSigmaType]
    scaled_arg_tys = [Scaled TcSigmaType] -> [Scaled TcSigmaType]
    scaleArgs [Scaled TcSigmaType]
    args
                                wrap1 :: HsWrapper
    wrap1 = [TcSigmaType] -> HsWrapper
    mkWpTyApps ([Id] -> [TcSigmaType]
    mkTyVarTys forall a b. (a -> b) -> a -> b
    $ forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [InvisTVBinder]
    tvs)
                                eta_wrap :: HsWrapper
    eta_wrap = forall {t :: * -> *}.
    Foldable t =>
    t (Scaled TcSigmaType) -> HsWrapper
    etaWrapper (forall a b. (a -> b) -> [a] -> [b]
    map forall a. a -> Scaled a
    unrestricted [TcSigmaType]
    theta forall a. [a] -> [a] -> [a]
    ++ [Scaled TcSigmaType]
    scaled_arg_tys)
                                wrap2 :: HsWrapper
    wrap2 = [Id] -> HsWrapper
    mkWpTyLams forall a b. (a -> b) -> a -> b
    $ forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [InvisTVBinder]
    tvs
                            in forall (m :: * -> *) a. Monad m => a -> m a
    return ( HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap (HsWrapper
    wrap2 HsWrapper -> HsWrapper -> HsWrapper
    <.> HsWrapper
    eta_wrap HsWrapper -> HsWrapper -> HsWrapper
    <.> HsWrapper
    wrap1)
                                                 (forall p. XConLikeOut p -> ConLike -> HsExpr p
    HsConLikeOut NoExtField
    noExtField (DataCon -> ConLike
    RealDataCon DataCon
    con))
                                      , [InvisTVBinder] -> TcSigmaType -> TcSigmaType
    mkInvisForAllTys [InvisTVBinder]
    tvs forall a b. (a -> b) -> a -> b
    $ [TcSigmaType] -> TcSigmaType -> TcSigmaType
    mkInvisFunTysMany [TcSigmaType]
    theta forall a b. (a -> b) -> a -> b
    $ [Scaled TcSigmaType] -> TcSigmaType -> TcSigmaType
    mkVisFunTys [Scaled TcSigmaType]
    scaled_arg_tys TcSigmaType
    res)
               }

    check_local_id :: Id -> TcM ()
    check_local_id :: Id -> TcM ()
    check_local_id Id
    id
      = do { Id -> TcM ()
    checkThLocalId Id
    id
           ; UsageEnv -> TcM ()
    tcEmitBindingUsage forall a b. (a -> b) -> a -> b
    $ forall n. NamedThing n => n -> TcSigmaType -> UsageEnv
    unitUE (Id -> Name
    idName Id
    id) TcSigmaType
    One }

    check_naughty :: OccName -> TcId -> TcM ()
    check_naughty :: OccName -> Id -> TcM ()
    check_naughty OccName
    lbl Id
    id
      | Id -> Bool
    isNaughtyRecordSelector Id
    id = forall a. SDoc -> TcM a
    failWithTc (OccName -> SDoc
    naughtyRecordSel OccName
    lbl)
      | Bool
    otherwise                  = forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    nonBidirectionalErr :: Outputable name => name -> SDoc
    nonBidirectionalErr :: forall a. Outputable a => a -> SDoc
    nonBidirectionalErr name
    name = String -> SDoc
    text String
    "non-bidirectional pattern synonym"
                               SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr name
    name) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "used in an expression"

    {-
    Note [Linear fields generalization]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    As per Note [Polymorphisation of linear fields], linear field of data
    constructors get a polymorphic type when the data constructor is used as a term.

        Just :: forall {p} a. a #p-> Maybe a

    This rule is known only to the typechecker: Just keeps its linear type in Core.

    In order to desugar this generalised typing rule, we simply eta-expand:

        \a (x # p :: a) -> Just @a x

    has the appropriate type. We insert these eta-expansion with WpFun wrappers.

    A small hitch: if the constructor is levity-polymorphic (unboxed tuples, sums,
    certain newtypes with -XUnliftedNewtypes) then this strategy produces

        \r1 r2 a b (x # p :: a) (y # q :: b) -> (# a, b #)

    Which has type

        forall r1 r2 a b. a #p-> b #q-> (# a, b #)

    Which violates the levity-polymorphism restriction see Note [Levity polymorphism
    checking] in DsMonad.

    So we really must instantiate r1 and r2 rather than quantify over them.  For
    simplicity, we just instantiate the entire type, as described in Note
    [Instantiating stupid theta]. It breaks visible type application with unboxed
    tuples, sums and levity-polymorphic newtypes, but this doesn't appear to be used
    anywhere.

    A better plan: let's force all representation variable to be *inferred*, so that
    they are not subject to visible type applications. Then we can instantiate
    inferred argument eagerly.

    Note [Adding the implicit parameter to 'assert']
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The typechecker transforms (assert e1 e2) to (assertError e1 e2).
    This isn't really the Right Thing because there's no way to "undo"
    if you want to see the original source code in the typechecker
    output.  We'll have fix this in due course, when we care more about
    being able to reconstruct the exact original program.

    Note [Instantiating stupid theta]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Normally, when we infer the type of an Id, we don't instantiate,
    because we wish to allow for visible type application later on.
    But if a datacon has a stupid theta, we're a bit stuck. We need
    to emit the stupid theta constraints with instantiated types. It's
    difficult to defer this to the lazy instantiation, because a stupid
    theta has no spot to put it in a type. So we just instantiate eagerly
    in this case. Thus, users cannot use visible type application with
    a data constructor sporting a stupid theta. I won't feel so bad for
    the users that complain.
    -}

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

    checkThLocalId :: Id -> TcM ()
    -- The renamer has already done checkWellStaged,
    --   in RnSplice.checkThLocalName, so don't repeat that here.
    -- Here we just add constraints for cross-stage lifting
    checkThLocalId :: Id -> TcM ()
    checkThLocalId Id
    id
      = do  { Maybe (TopLevelFlag, ThLevel, ThStage)
    mb_local_use <- Name -> TcRn (Maybe (TopLevelFlag, ThLevel, ThStage))
    getStageAndBindLevel (Id -> Name
    idName Id
    id)
            ; case Maybe (TopLevelFlag, ThLevel, ThStage)
    mb_local_use of
                 Just (TopLevelFlag
    top_lvl, ThLevel
    bind_lvl, ThStage
    use_stage)
                    | ThStage -> ThLevel
    thLevel ThStage
    use_stage forall a. Ord a => a -> a -> Bool
    > ThLevel
    bind_lvl
                    -> TopLevelFlag -> Id -> ThStage -> TcM ()
    checkCrossStageLifting TopLevelFlag
    top_lvl Id
    id ThStage
    use_stage
                 Maybe (TopLevelFlag, ThLevel, ThStage)
    _  -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()   -- Not a locally-bound thing, or
                                   -- no cross-stage link
        }

    --------------------------------------
    checkCrossStageLifting :: TopLevelFlag -> Id -> ThStage -> TcM ()
    -- If we are inside typed brackets, and (use_lvl > bind_lvl)
    -- we must check whether there's a cross-stage lift to do
    -- Examples   \x -> [|| x ||]
    --            [|| map ||]
    --
    -- This is similar to checkCrossStageLifting in GHC.Rename.Splice, but
    -- this code is applied to *typed* brackets.

    checkCrossStageLifting :: TopLevelFlag -> Id -> ThStage -> TcM ()
    checkCrossStageLifting TopLevelFlag
    top_lvl Id
    id (Brack ThStage
    _ (TcPending TcRef [PendingTcSplice]
    ps_var TcRef WantedConstraints
    lie_var QuoteWrapper
    q))
      | TopLevelFlag -> Bool
    isTopLevel TopLevelFlag
    top_lvl
      = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Name -> Bool
    isExternalName Name
    id_name) (Name -> TcM ()
    keepAlive Name
    id_name)
        -- See Note [Keeping things alive for Template Haskell] in GHC.Rename.Splice

      | Bool
    otherwise
      =     -- Nested identifiers, such as 'x' in
            -- E.g. \x -> [|| h x ||]
            -- We must behave as if the reference to x was
            --      h $(lift x)
            -- We use 'x' itself as the splice proxy, used by
            -- the desugarer to stitch it all back together.
            -- If 'x' occurs many times we may get many identical
            -- bindings of the same splice proxy, but that doesn't
            -- matter, although it's a mite untidy.
        do  { let id_ty :: TcSigmaType
    id_ty = Id -> TcSigmaType
    idType Id
    id
            ; Bool -> SDoc -> TcM ()
    checkTc (TcSigmaType -> Bool
    isTauTy TcSigmaType
    id_ty) (Id -> SDoc
    polySpliceErr Id
    id)
                   -- If x is polymorphic, its occurrence sites might
                   -- have different instantiations, so we can't use plain
                   -- 'x' as the splice proxy name.  I don't know how to
                   -- solve this, and it's probably unimportant, so I'm
                   -- just going to flag an error for now

            ; HsExpr GhcTc
    lift <- if TcSigmaType -> Bool
    isStringTy TcSigmaType
    id_ty then
                         do { Id
    sid <- Name -> TcM Id
    tcLookupId Name
    GHC.Builtin.Names.TH.liftStringName
                                         -- See Note [Lifting strings]
                            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall p. XVar p -> LIdP p -> HsExpr p
    HsVar NoExtField
    noExtField (forall a an. a -> LocatedAn an a
    noLocA Id
    sid)) }
                      else
                         forall a. TcRef WantedConstraints -> TcM a -> TcM a
    setConstraintVar TcRef WantedConstraints
    lie_var   forall a b. (a -> b) -> a -> b
    $
                              -- Put the 'lift' constraint into the right LIE
                         CtOrigin -> Name -> [TcSigmaType] -> TcM (HsExpr GhcTc)
    newMethodFromName (Name -> CtOrigin
    OccurrenceOf Name
    id_name)
                                           Name
    GHC.Builtin.Names.TH.liftName
                                           [HasDebugCallStack => TcSigmaType -> TcSigmaType
    getRuntimeRep TcSigmaType
    id_ty, TcSigmaType
    id_ty]

                       -- Warning for implicit lift (#17804)
            ; forall gbl lcl.
    WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenWOptM WarningFlag
    Opt_WarnImplicitLift forall a b. (a -> b) -> a -> b
    $
                WarnReason -> SDoc -> TcM ()
    addWarnTc (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnImplicitLift)
                           (String -> SDoc
    text String
    "The variable" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr Id
    id) SDoc -> SDoc -> SDoc
    <+>
                            String -> SDoc
    text String
    "is implicitly lifted in the TH quotation")

                       -- Update the pending splices
            ; [PendingTcSplice]
    ps <- forall a env. IORef a -> IOEnv env a
    readMutVar TcRef [PendingTcSplice]
    ps_var
            ; let pending_splice :: PendingTcSplice
    pending_splice = Name -> LHsExpr GhcTc -> PendingTcSplice
    PendingTcSplice Name
    id_name
                                     (forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsApp (HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap (QuoteWrapper -> HsWrapper
    applyQuoteWrapper QuoteWrapper
    q) (forall a an. a -> LocatedAn an a
    noLocA HsExpr GhcTc
    lift))
                                              (forall (p :: Pass) a.
    IsSrcSpanAnn p a =>
    IdP (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsVar Id
    id))
            ; forall a env. IORef a -> a -> IOEnv env ()
    writeMutVar TcRef [PendingTcSplice]
    ps_var (PendingTcSplice
    pending_splice forall a. a -> [a] -> [a]
    : [PendingTcSplice]
    ps)

            ; forall (m :: * -> *) a. Monad m => a -> m a
    return () }
      where
        id_name :: Name
    id_name = Id -> Name
    idName Id
    id

    checkCrossStageLifting TopLevelFlag
    _ Id
    _ ThStage
    _ = forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    polySpliceErr :: Id -> SDoc
    polySpliceErr :: Id -> SDoc
    polySpliceErr Id
    id
      = String -> SDoc
    text String
    "Can't splice the polymorphic local variable" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr Id
    id)

    {-
    Note [Lifting strings]
    ~~~~~~~~~~~~~~~~~~~~~~
    If we see $(... [| s |] ...) where s::String, we don't want to
    generate a mass of Cons (CharL 'x') (Cons (CharL 'y') ...)) etc.
    So this conditional short-circuits the lifting mechanism to generate
    (liftString "xy") in that case.  I didn't want to use overlapping instances
    for the Lift class in TH.Syntax, because that can lead to overlapping-instance
    errors in a polymorphic situation.

    If this check fails (which isn't impossible) we get another chance; see
    Note [Converting strings] in Convert.hs

    Local record selectors
    ~~~~~~~~~~~~~~~~~~~~~~
    Record selectors for TyCons in this module are ordinary local bindings,
    which show up as ATcIds rather than AGlobals.  So we need to check for
    naughtiness in both branches.  c.f. TcTyClsBindings.mkAuxBinds.
    -}

    {- *********************************************************************
    *                                                                      *
             Error reporting for function result mis-matches
    *                                                                      *
    ********************************************************************* -}

    addFunResCtxt :: HsExpr GhcRn -> [HsExprArg 'TcpRn]
                  -> TcType -> ExpRhoType
                  -> TcM a -> TcM a
    -- When we have a mis-match in the return type of a function
    -- try to give a helpful message about too many/few arguments
    -- But not in generated code, where we don't want
    -- to mention internal (rebindable syntax) function names
    addFunResCtxt :: forall a.
    HsExpr (GhcPass 'Renamed)
    -> [HsExprArg 'TcpRn]
    -> TcSigmaType
    -> ExpRhoType
    -> TcM a
    -> TcM a
    addFunResCtxt HsExpr (GhcPass 'Renamed)
    fun [HsExprArg 'TcpRn]
    args TcSigmaType
    fun_res_ty ExpRhoType
    env_ty TcM a
    thing_inside
      = forall a. (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    addLandmarkErrCtxtM (\TidyEnv
    env -> (TidyEnv
    env, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IOEnv (Env TcGblEnv TcLclEnv) SDoc
    mk_msg) TcM a
    thing_inside
          -- NB: use a landmark error context, so that an empty context
          -- doesn't suppress some more useful context
      where
        mk_msg :: IOEnv (Env TcGblEnv TcLclEnv) SDoc
    mk_msg
          = do { Maybe TcSigmaType
    mb_env_ty <- ExpRhoType -> TcM (Maybe TcSigmaType)
    readExpType_maybe ExpRhoType
    env_ty
                         -- by the time the message is rendered, the ExpType
                         -- will be filled in (except if we're debugging)
               ; TcSigmaType
    fun_res' <- TcSigmaType -> TcM TcSigmaType
    zonkTcType TcSigmaType
    fun_res_ty
               ; TcSigmaType
    env'     <- case Maybe TcSigmaType
    mb_env_ty of
                               Just TcSigmaType
    env_ty -> TcSigmaType -> TcM TcSigmaType
    zonkTcType TcSigmaType
    env_ty
                               Maybe TcSigmaType
    Nothing     ->
                                 do { Bool
    dumping <- forall gbl lcl. DumpFlag -> TcRnIf gbl lcl Bool
    doptM DumpFlag
    Opt_D_dump_tc_trace
                                    ; MASSERT( dumping )
                                    ; TcSigmaType -> TcM TcSigmaType
    newFlexiTyVarTy TcSigmaType
    liftedTypeKind }
               ; let -- See Note [Splitting nested sigma types in mismatched
                     --           function types]
                     ([Id]
    _, [TcSigmaType]
    _, TcSigmaType
    fun_tau) = TcSigmaType -> ([Id], [TcSigmaType], TcSigmaType)
    tcSplitNestedSigmaTys TcSigmaType
    fun_res'
                     ([Id]
    _, [TcSigmaType]
    _, TcSigmaType
    env_tau) = TcSigmaType -> ([Id], [TcSigmaType], TcSigmaType)
    tcSplitNestedSigmaTys TcSigmaType
    env'
                         -- env_ty is an ExpRhoTy, but with simple subsumption it
                         -- is not deeply skolemised, so still use tcSplitNestedSigmaTys
                     ([Scaled TcSigmaType]
    args_fun, TcSigmaType
    res_fun) = TcSigmaType -> ([Scaled TcSigmaType], TcSigmaType)
    tcSplitFunTys TcSigmaType
    fun_tau
                     ([Scaled TcSigmaType]
    args_env, TcSigmaType
    res_env) = TcSigmaType -> ([Scaled TcSigmaType], TcSigmaType)
    tcSplitFunTys TcSigmaType
    env_tau
                     n_fun :: ThLevel
    n_fun = forall (t :: * -> *) a. Foldable t => t a -> ThLevel
    length [Scaled TcSigmaType]
    args_fun
                     n_env :: ThLevel
    n_env = forall (t :: * -> *) a. Foldable t => t a -> ThLevel
    length [Scaled TcSigmaType]
    args_env
                     info :: SDoc
    info  | -- Check for too few args
                             --  fun_tau = a -> b, res_tau = Int
                             ThLevel
    n_fun forall a. Ord a => a -> a -> Bool
    > ThLevel
    n_env
                           , TcSigmaType -> Bool
    not_fun TcSigmaType
    res_env
                           = String -> SDoc
    text String
    "Probable cause:" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr HsExpr (GhcPass 'Renamed)
    fun)
                             SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is applied to too few arguments"

                           | -- Check for too many args
                             -- fun_tau = a -> Int,   res_tau = a -> b -> c -> d
                             -- The final guard suppresses the message when there
                             -- aren't enough args to drop; eg. the call is (f e1)
                             ThLevel
    n_fun forall a. Ord a => a -> a -> Bool
    < ThLevel
    n_env
                           , TcSigmaType -> Bool
    not_fun TcSigmaType
    res_fun
                           , (ThLevel
    n_fun forall a. Num a => a -> a -> a
    + forall a. (a -> Bool) -> [a] -> ThLevel
    count forall (id :: TcPass). HsExprArg id -> Bool
    isValArg [HsExprArg 'TcpRn]
    args) forall a. Ord a => a -> a -> Bool
    >= ThLevel
    n_env
                              -- Never suggest that a naked variable is
                                               -- applied to too many args!
                           = String -> SDoc
    text String
    "Possible cause:" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr HsExpr (GhcPass 'Renamed)
    fun)
                             SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is applied to too many arguments"

                           | Bool
    otherwise
                           = SDoc
    Outputable.empty

               ; forall (m :: * -> *) a. Monad m => a -> m a
    return SDoc
    info }

        not_fun :: TcSigmaType -> Bool
    not_fun TcSigmaType
    ty   -- ty is definitely not an arrow type,
                     -- and cannot conceivably become one
          = case HasCallStack => TcSigmaType -> Maybe (TyCon, [TcSigmaType])
    tcSplitTyConApp_maybe TcSigmaType
    ty of
              Just (TyCon
    tc, [TcSigmaType]
    _) -> TyCon -> Bool
    isAlgTyCon TyCon
    tc
              Maybe (TyCon, [TcSigmaType])
    Nothing      -> Bool
    False

    {-
    Note [Splitting nested sigma types in mismatched function types]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When one applies a function to too few arguments, GHC tries to determine this
    fact if possible so that it may give a helpful error message. It accomplishes
    this by checking if the type of the applied function has more argument types
    than supplied arguments.

    Previously, GHC computed the number of argument types through tcSplitSigmaTy.
    This is incorrect in the face of nested foralls, however!
    This caused Ticket #13311, for instance:

      f :: forall a. (Monoid a) => Int -> forall b. (Monoid b) => Maybe a -> Maybe b

    If one uses `f` like so:

      do { f; putChar 'a' }

    Then tcSplitSigmaTy will decompose the type of `f` into:

      Tyvars: [a]
      Context: (Monoid a)
      Argument types: []
      Return type: Int -> forall b. Monoid b => Maybe a -> Maybe b

    That is, it will conclude that there are *no* argument types, and since `f`
    was given no arguments, it won't print a helpful error message. On the other
    hand, tcSplitNestedSigmaTys correctly decomposes `f`'s type down to:

      Tyvars: [a, b]
      Context: (Monoid a, Monoid b)
      Argument types: [Int, Maybe a]
      Return type: Maybe b

    So now GHC recognizes that `f` has one more argument type than it was actually
    provided.

    Notice that tcSplitNestedSigmaTys looks through function arrows too, regardless
    of simple/deep subsumption.  Here we are concerned only whether there is a
    mis-match in the number of value arguments.
    -}

    {- *********************************************************************
    *                                                                      *
                 Misc utility functions
    *                                                                      *
    ********************************************************************* -}

    addExprCtxt :: HsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt :: forall a. HsExpr (GhcPass 'Renamed) -> TcRn a -> TcRn a
    addExprCtxt HsExpr (GhcPass 'Renamed)
    e TcRn a
    thing_inside
      = case HsExpr (GhcPass 'Renamed)
    e of
          HsUnboundVar {} -> TcRn a
    thing_inside
          HsExpr (GhcPass 'Renamed)
    _ -> forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (HsExpr (GhcPass 'Renamed) -> SDoc
    exprCtxt HsExpr (GhcPass 'Renamed)
    e) TcRn a
    thing_inside
       -- The HsUnboundVar special case addresses situations like
       --    f x = _
       -- when we don't want to say "In the expression: _",
       -- because it is mentioned in the error message itself

    exprCtxt :: HsExpr GhcRn -> SDoc
    exprCtxt :: HsExpr (GhcPass 'Renamed) -> SDoc
    exprCtxt HsExpr (GhcPass 'Renamed)
    expr = SDoc -> ThLevel -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "In the expression:") ThLevel
    2 (forall a. Outputable a => a -> SDoc
    ppr (forall (p :: Pass). HsExpr (GhcPass p) -> HsExpr (GhcPass p)
    stripParensHsExpr HsExpr (GhcPass 'Renamed)
    expr))