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

    -}

    {-# LANGUAGE CPP, TupleSections, ScopedTypeVariables #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeFamilies, DataKinds, TypeApplications #-}
    {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
                                          -- in module GHC.Hs.Extension

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

    module GHC.Tc.Gen.Expr
           ( tcCheckPolyExpr,
             tcCheckMonoExpr, tcCheckMonoExprNC, tcMonoExpr, tcMonoExprNC,
             tcInferSigma, tcInferRho, tcInferRhoNC,
             tcExpr,
             tcSyntaxOp, tcSyntaxOpGen, SyntaxOpType(..), synKnownType,
             tcCheckId,
             addAmbiguousNameErr,
             getFixedTyVars ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import {-# SOURCE #-}   GHC.Tc.Gen.Splice( tcSpliceExpr, tcTypedBracket, tcUntypedBracket )
    import GHC.Builtin.Names.TH( liftStringName, liftName )

    import GHC.Hs
    import GHC.Tc.Utils.Zonk
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Utils.Unify
    import GHC.Types.Basic
    import GHC.Core.Multiplicity
    import GHC.Core.UsageEnv
    import GHC.Tc.Utils.Instantiate
    import GHC.Tc.Gen.Bind        ( chooseInferredQuantifiers, tcLocalBinds )
    import GHC.Tc.Gen.Sig         ( tcUserTypeSig, tcInstSig )
    import GHC.Tc.Solver          ( simplifyInfer, InferMode(..) )
    import GHC.Tc.Instance.Family ( tcGetFamInstEnvs, tcLookupDataFamInst, tcLookupDataFamInst_maybe )
    import GHC.Core.FamInstEnv    ( FamInstEnvs )
    import GHC.Rename.Env         ( addUsedGRE )
    import GHC.Rename.Utils       ( addNameClashErrRn, unknownSubordinateErr )
    import GHC.Tc.Utils.Env
    import GHC.Tc.Gen.Arrow
    import GHC.Tc.Gen.Match
    import GHC.Tc.Gen.HsType
    import GHC.Tc.TyCl.PatSyn     ( tcPatSynBuilderOcc, nonBidirectionalErr )
    import GHC.Tc.Gen.Pat
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Types.Origin
    import GHC.Tc.Utils.TcType as TcType
    import GHC.Types.Id
    import GHC.Types.Id.Info
    import GHC.Core.ConLike
    import GHC.Core.DataCon
    import GHC.Core.PatSyn
    import GHC.Types.Name
    import GHC.Types.Name.Env
    import GHC.Types.Name.Set
    import GHC.Types.Name.Reader
    import GHC.Core.TyCon
    import GHC.Core.TyCo.Rep
    import GHC.Core.TyCo.Ppr
    import GHC.Core.TyCo.Subst (substTyWithInScope)
    import GHC.Core.Type
    import GHC.Tc.Types.Evidence
    import GHC.Types.Var.Set
    import GHC.Builtin.Types
    import GHC.Builtin.PrimOps( tagToEnumKey )
    import GHC.Builtin.Names
    import GHC.Driver.Session
    import GHC.Types.SrcLoc
    import GHC.Utils.Misc
    import GHC.Types.Var.Env  ( emptyTidyEnv, mkInScopeSet )
    import GHC.Data.List.SetOps
    import GHC.Data.Maybe
    import GHC.Utils.Outputable as Outputable
    import GHC.Data.FastString
    import Control.Monad
    import GHC.Core.Class(classTyCon)
    import GHC.Types.Unique.Set ( nonDetEltsUniqSet )
    import qualified GHC.LanguageExtensions as LangExt

    import Data.Function
    import Data.List (partition, sortBy, groupBy, intersect)
    import qualified Data.Set as Set

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

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

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

    tcCheckPolyExpr :: LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr   LHsExpr GhcRn
    expr TcType
    res_ty = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcPolyExpr   LHsExpr GhcRn
    expr (TcType -> ExpRhoType
    mkCheckExpType TcType
    res_ty)
    tcCheckPolyExprNC :: LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExprNC LHsExpr GhcRn
    expr TcType
    res_ty = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcPolyExprNC LHsExpr GhcRn
    expr (TcType -> ExpRhoType
    mkCheckExpType TcType
    res_ty)

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

    tcPolyExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcPolyExpr LHsExpr GhcRn
    expr ExpRhoType
    res_ty
      = LHsExpr GhcRn -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. LHsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt LHsExpr GhcRn
    expr (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do { String -> SDoc -> TcRn ()
    traceTc String
    "tcPolyExpr" (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    res_ty)
           ; LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcPolyExprNC LHsExpr GhcRn
    expr ExpRhoType
    res_ty }

    tcPolyExprNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcPolyExprNC (L SrcSpan
    loc HsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = SrcSpan
    -> HsExpr GhcRn -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall {a}. SrcSpan -> HsExpr GhcRn -> TcRn a -> TcRn a
    set_loc_and_ctxt SrcSpan
    loc HsExpr GhcRn
    expr (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do { String -> SDoc -> TcRn ()
    traceTc String
    "tcPolyExprNC" (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    res_ty)
           ; (HsWrapper
    wrap, HsExpr GhcTc
    expr') <- UserTypeCtxt
    -> ExpRhoType
    -> (ExpRhoType -> TcM (HsExpr GhcTc))
    -> TcM (HsWrapper, HsExpr GhcTc)
    forall result.
    UserTypeCtxt
    -> ExpRhoType
    -> (ExpRhoType -> TcM result)
    -> TcM (HsWrapper, result)
    tcSkolemiseET UserTypeCtxt
    GenSigCtxt ExpRhoType
    res_ty ((ExpRhoType -> TcM (HsExpr GhcTc))
     -> TcM (HsWrapper, HsExpr GhcTc))
    -> (ExpRhoType -> TcM (HsExpr GhcTc))
    -> TcM (HsWrapper, HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ \ ExpRhoType
    res_ty ->
                              HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    expr ExpRhoType
    res_ty
           ; LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsExpr GhcTc -> TcM (LHsExpr GhcTc))
    -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap HsExpr GhcTc
    expr') }

      where -- See Note [Rebindable syntax and HsExpansion), which describes
            -- the logic behind this location/context tweaking.
            set_loc_and_ctxt :: SrcSpan -> HsExpr GhcRn -> TcRn a -> TcRn a
    set_loc_and_ctxt SrcSpan
    l HsExpr GhcRn
    e TcRn a
    m = do
              Bool
    inGenCode <- TcRn Bool
    inGeneratedCode
              if Bool
    inGenCode Bool -> Bool -> Bool
    && Bool -> Bool
    not (SrcSpan -> Bool
    isGeneratedSrcSpan SrcSpan
    l)
                then SrcSpan -> TcRn a -> TcRn a
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    l (TcRn a -> TcRn a) -> TcRn a -> TcRn a
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcRn a -> TcRn a
    forall a. LHsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt (SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsExpr GhcRn
    e) TcRn a
    m
                else SrcSpan -> TcRn a -> TcRn a
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    l TcRn a
    m

    ---------------
    tcInferSigma :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcSigmaType)
    -- Used by tcRnExpr to implement GHCi :type
    -- It goes against the principle of eager instantiation,
    -- so we expect very very few calls to this function
    -- Most clients will want tcInferRho
    tcInferSigma :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
    tcInferSigma le :: LHsExpr GhcRn
    le@(L SrcSpan
    loc HsExpr GhcRn
    expr)
      = LHsExpr GhcRn
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a. LHsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt LHsExpr GhcRn
    le (TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType))
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a b. (a -> b) -> a -> b
    $ SrcSpan
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType))
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a b. (a -> b) -> a -> b
    $
        do { (HsExpr GhcTc
    fun, [LHsExprArgOut]
    args, TcType
    ty) <- HsExpr GhcRn -> TcM (HsExpr GhcTc, [LHsExprArgOut], TcType)
    tcInferApp HsExpr GhcRn
    expr
           ; (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (HsExpr GhcTc -> [LHsExprArgOut] -> HsExpr GhcTc
    applyHsArgs HsExpr GhcTc
    fun [LHsExprArgOut]
    args), TcType
    ty) }

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

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

    tcMonoExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExpr LHsExpr GhcRn
    expr ExpRhoType
    res_ty
      = LHsExpr GhcRn -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. LHsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt LHsExpr GhcRn
    expr (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC LHsExpr GhcRn
    expr ExpRhoType
    res_ty

    tcMonoExprNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC (L SrcSpan
    loc HsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = SrcSpan -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do  { HsExpr GhcTc
    expr' <- HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    expr ExpRhoType
    res_ty
            ; LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc HsExpr GhcTc
    expr') }

    ---------------
    tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType)
    -- Infer a *rho*-type. The return type is always instantiated.
    tcInferRho :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
    tcInferRho LHsExpr GhcRn
    le = LHsExpr GhcRn
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a. LHsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt LHsExpr GhcRn
    le (LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
    tcInferRhoNC LHsExpr GhcRn
    le)

    tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
    tcInferRhoNC (L SrcSpan
    loc HsExpr GhcRn
    expr)
      = SrcSpan
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType))
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a b. (a -> b) -> a -> b
    $
        do { (HsExpr GhcTc
    expr', TcType
    rho) <- (ExpRhoType -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc, TcType)
    forall a. (ExpRhoType -> TcM a) -> TcM (a, TcType)
    tcInfer (HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    expr)
           ; (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc HsExpr GhcTc
    expr', TcType
    rho) }

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

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

    tcLExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcLExpr LHsExpr GhcRn
    expr ExpRhoType
    res_ty
      = SrcSpan -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (LHsExpr GhcRn -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc LHsExpr GhcRn
    expr) (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. LHsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt LHsExpr GhcRn
    expr (LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcLExprNC LHsExpr GhcRn
    expr ExpRhoType
    res_ty)

    tcLExprNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcLExprNC (L SrcSpan
    loc HsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = SrcSpan -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do  { HsExpr GhcTc
    expr' <- HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    expr ExpRhoType
    res_ty
            ; LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc HsExpr GhcTc
    expr') }

    tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr (HsVar XVar GhcRn
    _ (L SrcSpan
    _ IdP GhcRn
    name))   ExpRhoType
    res_ty = Name -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcCheckId Name
    IdP GhcRn
    name ExpRhoType
    res_ty
    tcExpr e :: HsExpr GhcRn
    e@(HsUnboundVar XUnboundVar GhcRn
    _ OccName
    uv)  ExpRhoType
    res_ty = HsExpr GhcRn -> OccName -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcUnboundId HsExpr GhcRn
    e OccName
    uv ExpRhoType
    res_ty

    tcExpr e :: HsExpr GhcRn
    e@(HsApp {})     ExpRhoType
    res_ty = HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp HsExpr GhcRn
    e ExpRhoType
    res_ty
    tcExpr e :: HsExpr GhcRn
    e@(HsAppType {}) ExpRhoType
    res_ty = HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp HsExpr GhcRn
    e ExpRhoType
    res_ty

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

    tcExpr (HsPar XPar GhcRn
    x LHsExpr GhcRn
    expr) ExpRhoType
    res_ty = do { LHsExpr GhcTc
    expr' <- LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcLExprNC LHsExpr GhcRn
    expr ExpRhoType
    res_ty
                                      ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XPar GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XPar p -> LHsExpr p -> HsExpr p
    HsPar XPar GhcRn
    XPar GhcTc
    x LHsExpr GhcTc
    expr') }

    tcExpr (HsPragE XPragE GhcRn
    x HsPragE GhcRn
    prag LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do { LHsExpr GhcTc
    expr' <- LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcLExpr LHsExpr GhcRn
    expr ExpRhoType
    res_ty
           ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XPragE GhcTc -> HsPragE GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XPragE p -> HsPragE p -> LHsExpr p -> HsExpr p
    HsPragE XPragE GhcRn
    XPragE GhcTc
    x (HsPragE GhcRn -> HsPragE GhcTc
    tcExprPrag HsPragE GhcRn
    prag) LHsExpr GhcTc
    expr') }

    tcExpr (HsOverLit XOverLitE GhcRn
    x HsOverLit GhcRn
    lit) ExpRhoType
    res_ty
      = do  { HsOverLit GhcTc
    lit' <- HsOverLit GhcRn -> ExpRhoType -> TcM (HsOverLit GhcTc)
    newOverloadedLit HsOverLit GhcRn
    lit ExpRhoType
    res_ty
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XOverLitE GhcTc -> HsOverLit GhcTc -> HsExpr GhcTc
    forall p. XOverLitE p -> HsOverLit p -> HsExpr p
    HsOverLit XOverLitE GhcRn
    XOverLitE GhcTc
    x HsOverLit GhcTc
    lit') }

    tcExpr (NegApp XNegApp GhcRn
    x LHsExpr GhcRn
    expr SyntaxExpr GhcRn
    neg_expr) ExpRhoType
    res_ty
      = do  { (LHsExpr GhcTc
    expr', SyntaxExprTc
    neg_expr')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([TcType] -> [TcType] -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc, SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([TcType] -> [TcType] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    NegateOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    neg_expr [SyntaxOpType
    SynAny] ExpRhoType
    res_ty (([TcType] -> [TcType] -> TcM (LHsExpr GhcTc))
     -> TcM (LHsExpr GhcTc, SyntaxExprTc))
    -> ([TcType] -> [TcType] -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc, SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                   \[TcType
    arg_ty] [TcType
    arg_mult] ->
                   TcType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    arg_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcLExpr LHsExpr GhcRn
    expr (TcType -> ExpRhoType
    mkCheckExpType TcType
    arg_ty)
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XNegApp GhcTc -> LHsExpr GhcTc -> SyntaxExpr GhcTc -> HsExpr GhcTc
    forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
    NegApp XNegApp GhcRn
    XNegApp GhcTc
    x LHsExpr GhcTc
    expr' SyntaxExpr GhcTc
    SyntaxExprTc
    neg_expr') }

    tcExpr e :: HsExpr GhcRn
    e@(HsIPVar XIPVar GhcRn
    _ HsIPName
    x) ExpRhoType
    res_ty
      = do {   {- Implicit parameters must have a *tau-type* not a
                  type scheme.  We enforce this by creating a fresh
                  type variable as its type.  (Because res_ty may not
                  be a tau-type.) -}
             TcType
    ip_ty <- TcM TcType
    newOpenFlexiTyVarTy
           ; let ip_name :: TcType
    ip_name = FieldLabelString -> TcType
    mkStrLitTy (HsIPName -> FieldLabelString
    hsIPNameFS HsIPName
    x)
           ; Class
    ipClass <- Name -> TcM Class
    tcLookupClass Name
    ipClassName
           ; Var
    ip_var <- CtOrigin -> TcType -> TcM Var
    emitWantedEvVar CtOrigin
    origin (Class -> [TcType] -> TcType
    mkClassPred Class
    ipClass [TcType
    ip_name, TcType
    ip_ty])
           ; HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResult HsExpr GhcRn
    e
                       (Class -> TcType -> TcType -> HsExpr GhcTc -> HsExpr GhcTc
    fromDict Class
    ipClass TcType
    ip_name TcType
    ip_ty (XVar GhcTc -> Located (IdP GhcTc) -> HsExpr GhcTc
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar GhcTc
    noExtField (Var -> Located Var
    forall e. e -> Located e
    noLoc Var
    ip_var)))
                       TcType
    ip_ty ExpRhoType
    res_ty }
      where
      -- Coerces a dictionary for `IP "x" t` into `t`.
      fromDict :: Class -> TcType -> TcType -> HsExpr GhcTc -> HsExpr GhcTc
    fromDict Class
    ipClass TcType
    x TcType
    ty = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc)
    -> HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $ TcCoercionR -> HsWrapper
    mkWpCastR (TcCoercionR -> HsWrapper) -> TcCoercionR -> HsWrapper
    forall a b. (a -> b) -> a -> b
    $
                              TcType -> TcCoercionR
    unwrapIP (TcType -> TcCoercionR) -> TcType -> TcCoercionR
    forall a b. (a -> b) -> a -> b
    $ Class -> [TcType] -> TcType
    mkClassPred Class
    ipClass [TcType
    x,TcType
    ty]
      origin :: CtOrigin
    origin = HsIPName -> CtOrigin
    IPOccOrigin HsIPName
    x

    tcExpr e :: HsExpr GhcRn
    e@(HsOverLabel XOverLabel GhcRn
    _ Maybe (IdP GhcRn)
    mb_fromLabel FieldLabelString
    l) ExpRhoType
    res_ty
      = do { -- See Note [Type-checking overloaded labels]
             SrcSpan
    loc <- TcRn SrcSpan
    getSrcSpanM
           ; case Maybe (IdP GhcRn)
    mb_fromLabel of
               Just IdP GhcRn
    fromLabel -> HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr (SrcSpan -> Name -> HsExpr GhcRn
    applyFromLabel SrcSpan
    loc Name
    IdP GhcRn
    fromLabel) ExpRhoType
    res_ty
               Maybe (IdP GhcRn)
    Nothing -> do { Class
    isLabelClass <- Name -> TcM Class
    tcLookupClass Name
    isLabelClassName
                             ; TcType
    alpha <- TcType -> TcM TcType
    newFlexiTyVarTy TcType
    liftedTypeKind
                             ; let pred :: TcType
    pred = Class -> [TcType] -> TcType
    mkClassPred Class
    isLabelClass [TcType
    lbl, TcType
    alpha]
                             ; SrcSpan
    loc <- TcRn SrcSpan
    getSrcSpanM
                             ; Var
    var <- CtOrigin -> TcType -> TcM Var
    emitWantedEvVar CtOrigin
    origin TcType
    pred
                             ; HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResult HsExpr GhcRn
    e
                                           (TcType -> HsExpr GhcTc -> HsExpr GhcTc
    fromDict TcType
    pred (XVar GhcTc -> Located (IdP GhcTc) -> HsExpr GhcTc
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar GhcTc
    noExtField (SrcSpan -> Var -> Located Var
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc Var
    var)))
                                            TcType
    alpha ExpRhoType
    res_ty } }
      where
      -- Coerces a dictionary for `IsLabel "x" t` into `t`,
      -- or `HasField "x" r a into `r -> a`.
      fromDict :: TcType -> HsExpr GhcTc -> HsExpr GhcTc
    fromDict TcType
    pred = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc)
    -> HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $ TcCoercionR -> HsWrapper
    mkWpCastR (TcCoercionR -> HsWrapper) -> TcCoercionR -> HsWrapper
    forall a b. (a -> b) -> a -> b
    $ TcType -> TcCoercionR
    unwrapIP TcType
    pred
      origin :: CtOrigin
    origin = FieldLabelString -> CtOrigin
    OverLabelOrigin FieldLabelString
    l
      lbl :: TcType
    lbl = FieldLabelString -> TcType
    mkStrLitTy FieldLabelString
    l

      applyFromLabel :: SrcSpan -> Name -> HsExpr GhcRn
    applyFromLabel SrcSpan
    loc Name
    fromLabel =
        XAppTypeE GhcRn
    -> LHsExpr GhcRn -> LHsWcType (NoGhcTc GhcRn) -> HsExpr GhcRn
    forall p.
    XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
    HsAppType NoExtField
    XAppTypeE GhcRn
    noExtField
             (SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XVar GhcRn -> GenLocated SrcSpan (IdP GhcRn) -> HsExpr GhcRn
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar GhcRn
    noExtField (SrcSpan -> Name -> GenLocated SrcSpan Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc Name
    fromLabel)))
             (GenLocated SrcSpan (HsType GhcRn) -> LHsWcType GhcRn
    forall thing. thing -> HsWildCardBndrs GhcRn thing
    mkEmptyWildCardBndrs (SrcSpan -> HsType GhcRn -> GenLocated SrcSpan (HsType GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XTyLit GhcRn -> HsTyLit -> HsType GhcRn
    forall pass. XTyLit pass -> HsTyLit -> HsType pass
    HsTyLit NoExtField
    XTyLit GhcRn
    noExtField (SourceText -> FieldLabelString -> HsTyLit
    HsStrTy SourceText
    NoSourceText FieldLabelString
    l))))

    tcExpr (HsLam XLam GhcRn
    x MatchGroup GhcRn (LHsExpr GhcRn)
    match) ExpRhoType
    res_ty
      = do  { (HsWrapper
    wrap, MatchGroup GhcTc (LHsExpr GhcTc)
    match') <- SDoc
    -> TcMatchCtxt HsExpr
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    tcMatchLambda SDoc
    herald TcMatchCtxt HsExpr
    match_ctxt MatchGroup GhcRn (LHsExpr GhcRn)
    match ExpRhoType
    res_ty
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap (XLam GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
    forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
    HsLam XLam GhcRn
    XLam GhcTc
    x MatchGroup GhcTc (LHsExpr GhcTc)
    match')) }
      where
        match_ctxt :: TcMatchCtxt HsExpr
    match_ctxt = MC :: forall (body :: * -> *).
    HsMatchContext GhcRn
    -> (Located (body GhcRn)
        -> ExpRhoType -> TcM (Located (body GhcTc)))
    -> TcMatchCtxt body
    MC { mc_what :: HsMatchContext GhcRn
    mc_what = HsMatchContext GhcRn
    forall p. HsMatchContext p
    LambdaExpr, mc_body :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    mc_body = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBody }
        herald :: SDoc
    herald = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "The lambda expression" SDoc -> SDoc -> SDoc
    <+>
                       SDoc -> SDoc
    quotes (Depth -> SDoc -> SDoc
    pprSetDepth (ThLevel -> Depth
    PartWay ThLevel
    1) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                               MatchGroup GhcRn (LHsExpr GhcRn) -> SDoc
    forall (idR :: Pass) body.
    (OutputableBndrId idR, Outputable body) =>
    MatchGroup (GhcPass idR) body -> SDoc
    pprMatches MatchGroup GhcRn (LHsExpr GhcRn)
    match),
                            -- The pprSetDepth makes the abstraction print briefly
                       String -> SDoc
    text String
    "has"]

    tcExpr e :: HsExpr GhcRn
    e@(HsLamCase XLamCase GhcRn
    x MatchGroup GhcRn (LHsExpr GhcRn)
    matches) ExpRhoType
    res_ty
      = do { (HsWrapper
    wrap, MatchGroup GhcTc (LHsExpr GhcTc)
    matches')
               <- SDoc
    -> TcMatchCtxt HsExpr
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
    tcMatchLambda SDoc
    msg TcMatchCtxt HsExpr
    match_ctxt MatchGroup GhcRn (LHsExpr GhcRn)
    matches ExpRhoType
    res_ty
               -- The laziness annotation is because we don't want to fail here
               -- if there are multiple arguments
           ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap (HsExpr GhcTc -> HsExpr GhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $ XLamCase GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
    forall p. XLamCase p -> MatchGroup p (LHsExpr p) -> HsExpr p
    HsLamCase XLamCase GhcRn
    XLamCase GhcTc
    x MatchGroup GhcTc (LHsExpr GhcTc)
    matches') }
      where
        msg :: SDoc
    msg = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "The function" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    e)
                  , String -> SDoc
    text String
    "requires"]
        match_ctxt :: TcMatchCtxt HsExpr
    match_ctxt = MC :: forall (body :: * -> *).
    HsMatchContext GhcRn
    -> (Located (body GhcRn)
        -> ExpRhoType -> TcM (Located (body GhcTc)))
    -> TcMatchCtxt body
    MC { mc_what :: HsMatchContext GhcRn
    mc_what = HsMatchContext GhcRn
    forall p. HsMatchContext p
    CaseAlt, mc_body :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    mc_body = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBody }

    tcExpr e :: HsExpr GhcRn
    e@(ExprWithTySig XExprWithTySig GhcRn
    _ LHsExpr GhcRn
    expr LHsSigWcType (NoGhcTc GhcRn)
    hs_ty) ExpRhoType
    res_ty
      = do { (HsExpr GhcTc
    expr', TcType
    poly_ty) <- LHsExpr GhcRn
    -> LHsSigWcType (NoGhcTc GhcRn) -> TcM (HsExpr GhcTc, TcType)
    tcExprWithSig LHsExpr GhcRn
    expr LHsSigWcType (NoGhcTc GhcRn)
    hs_ty
           ; HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResult HsExpr GhcRn
    e HsExpr GhcTc
    expr' TcType
    poly_ty ExpRhoType
    res_ty }

    {-
    Note [Type-checking overloaded labels]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Recall that we have

      module GHC.OverloadedLabels where
        class IsLabel (x :: Symbol) a where
          fromLabel :: a

    We translate `#foo` to `fromLabel @"foo"`, where we use

     * the in-scope `fromLabel` if `RebindableSyntax` is enabled; or if not
     * `GHC.OverloadedLabels.fromLabel`.

    In the `RebindableSyntax` case, the renamer will have filled in the
    first field of `HsOverLabel` with the `fromLabel` function to use, and
    we simply apply it to the appropriate visible type argument.

    In the `OverloadedLabels` case, when we see an overloaded label like
    `#foo`, we generate a fresh variable `alpha` for the type and emit an
    `IsLabel "foo" alpha` constraint.  Because the `IsLabel` class has a
    single method, it is represented by a newtype, so we can coerce
    `IsLabel "foo" alpha` to `alpha` (just like for implicit parameters).

    -}

    {-
    ************************************************************************
    *                                                                      *
                    Infix operators and sections
    *                                                                      *
    ************************************************************************

    Note [Left sections]
    ~~~~~~~~~~~~~~~~~~~~
    Left sections, like (4 *), are equivalent to
            \ x -> (*) 4 x,
    or, if PostfixOperators is enabled, just
            (*) 4
    With PostfixOperators we don't actually require the function to take
    two arguments at all.  For example, (x `not`) means (not x); you get
    postfix operators!  Not Haskell 98, but it's less work and kind of
    useful.

    Note [Typing rule for ($)]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    People write
       runST $ blah
    so much, where
       runST :: (forall s. ST s a) -> a
    that I have finally given in and written a special type-checking
    rule just for saturated applications of ($).
      * Infer the type of the first argument
      * Decompose it; should be of form (arg2_ty -> res_ty),
           where arg2_ty might be a polytype
      * Use arg2_ty to typecheck arg2
    -}

    tcExpr expr :: HsExpr GhcRn
    expr@(OpApp XOpApp GhcRn
    fix LHsExpr GhcRn
    arg1 LHsExpr GhcRn
    op LHsExpr GhcRn
    arg2) ExpRhoType
    res_ty
      | (L SrcSpan
    loc (HsVar XVar GhcRn
    _ (L SrcSpan
    lv IdP GhcRn
    op_name))) <- LHsExpr GhcRn
    op
      , Name
    IdP GhcRn
    op_name Name -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    dollarIdKey        -- Note [Typing rule for ($)]
      = do { String -> SDoc -> TcRn ()
    traceTc String
    "Application rule" (LHsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsExpr GhcRn
    op)
           ; (LHsExpr GhcTc
    arg1', TcType
    arg1_ty) <- SDoc -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (LHsExpr GhcRn -> LHsExpr GhcRn -> ThLevel -> SDoc
    forall fun arg.
    (Outputable fun, Outputable arg) =>
    fun -> arg -> ThLevel -> SDoc
    funAppCtxt LHsExpr GhcRn
    op LHsExpr GhcRn
    arg1 ThLevel
    1) (TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType))
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a b. (a -> b) -> a -> b
    $
                                 LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
    tcInferRhoNC LHsExpr GhcRn
    arg1

           ; let doc :: SDoc
    doc   = String -> SDoc
    text String
    "The first argument of ($) takes"
                 orig1 :: CtOrigin
    orig1 = LHsExpr GhcRn -> CtOrigin
    lexprCtOrigin LHsExpr GhcRn
    arg1
           ; (HsWrapper
    wrap_arg1, [Scaled TcType
    arg2_sigma], TcType
    op_res_ty) <-
               SDoc
    -> CtOrigin
    -> Maybe (HsExpr GhcRn)
    -> ThLevel
    -> TcType
    -> TcM (HsWrapper, [Scaled TcType], TcType)
    matchActualFunTysRho SDoc
    doc CtOrigin
    orig1 (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
    forall a. a -> Maybe a
    Just (LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    arg1)) ThLevel
    1 TcType
    arg1_ty

           ; HsWrapper
    mult_wrap <- CtOrigin -> TcType -> TcType -> TcM HsWrapper
    tcSubMult CtOrigin
    AppOrigin TcType
    Many (Scaled TcType -> TcType
    forall a. Scaled a -> TcType
    scaledMult Scaled TcType
    arg2_sigma)
             -- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
             --
             -- When ($) becomes multiplicity-polymorphic, then the above check will
             -- need to go. But in the meantime, it would produce ill-typed
             -- desugared code to accept linear functions to the left of a ($).

             -- We have (arg1 $ arg2)
             -- So: arg1_ty = arg2_ty -> op_res_ty
             -- where arg2_sigma maybe polymorphic; that's the point

           ; LHsExpr GhcTc
    arg2' <- HsExpr GhcRn
    -> LHsExpr GhcRn -> Scaled TcType -> ThLevel -> TcM (LHsExpr GhcTc)
    tcArg HsExpr GhcRn
    nl_op LHsExpr GhcRn
    arg2 Scaled TcType
    arg2_sigma ThLevel
    2

           -- Make sure that the argument type has kind '*'
           --   ($) :: forall (r:RuntimeRep) (a:*) (b:TYPE r). (a->b) -> a -> b
           -- Eg we do not want to allow  (D#  $  4.0#)   #5570
           --    (which gives a seg fault)
           ; TcCoercionR
    _ <- Maybe (HsType GhcRn) -> TcType -> TcType -> TcM TcCoercionR
    unifyKind (HsType GhcRn -> Maybe (HsType GhcRn)
    forall a. a -> Maybe a
    Just (XXType GhcRn -> HsType GhcRn
    forall pass. XXType pass -> HsType pass
    XHsType (XXType GhcRn -> HsType GhcRn) -> XXType GhcRn -> HsType GhcRn
    forall a b. (a -> b) -> a -> b
    $ TcType -> NewHsTypeX
    NHsCoreTy (Scaled TcType -> TcType
    forall a. Scaled a -> a
    scaledThing Scaled TcType
    arg2_sigma)))
                            (HasDebugCallStack => TcType -> TcType
    TcType -> TcType
    tcTypeKind (Scaled TcType -> TcType
    forall a. Scaled a -> a
    scaledThing Scaled TcType
    arg2_sigma)) TcType
    liftedTypeKind
               -- Ignore the evidence. arg2_sigma must have type * or #,
               -- because we know (arg2_sigma -> op_res_ty) is well-kinded
               -- (because otherwise matchActualFunTysRho would fail)
               -- So this 'unifyKind' will either succeed with Refl, or will
               -- produce an insoluble constraint * ~ #, which we'll report later.

           -- NB: unlike the argument type, the *result* type, op_res_ty can
           -- have any kind (#8739), so we don't need to check anything for that

           ; Var
    op_id  <- Name -> TcM Var
    tcLookupId Name
    IdP GhcRn
    op_name
           ; let op' :: LHsExpr GhcTc
    op' = SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap ([TcType] -> HsWrapper
    mkWpTyApps [ HasDebugCallStack => TcType -> TcType
    TcType -> TcType
    getRuntimeRep TcType
    op_res_ty
                                                   , Scaled TcType -> TcType
    forall a. Scaled a -> a
    scaledThing Scaled TcType
    arg2_sigma
                                                   , TcType
    op_res_ty])
                                       (XVar GhcTc -> Located (IdP GhcTc) -> HsExpr GhcTc
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar GhcTc
    noExtField (SrcSpan -> Var -> Located Var
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    lv Var
    op_id)))
                 -- arg1' :: arg1_ty
                 -- wrap_arg1 :: arg1_ty "->" (arg2_sigma -> op_res_ty)
                 -- op' :: (a2_ty -> op_res_ty) -> a2_ty -> op_res_ty

                 expr' :: HsExpr GhcTc
    expr' = XOpApp GhcTc
    -> LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p.
    XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
    OpApp XOpApp GhcRn
    XOpApp GhcTc
    fix (HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap (HsWrapper
    wrap_arg1 HsWrapper -> HsWrapper -> HsWrapper
    <.> HsWrapper
    mult_wrap) LHsExpr GhcTc
    arg1') LHsExpr GhcTc
    op' LHsExpr GhcTc
    arg2'

           ; HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResult HsExpr GhcRn
    expr HsExpr GhcTc
    expr' TcType
    op_res_ty ExpRhoType
    res_ty }

      | L SrcSpan
    loc (HsRecFld XRecFld GhcRn
    _ (Ambiguous XAmbiguous GhcRn
    _ Located RdrName
    lbl)) <- LHsExpr GhcRn
    op
      , Just LHsSigWcType GhcRn
    sig_ty <- HsExpr GhcRn -> Maybe (LHsSigWcType GhcRn)
    obviousSig (LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    arg1)
        -- See Note [Disambiguating record fields]
      = do { TcType
    sig_tc_ty <- UserTypeCtxt -> LHsSigWcType GhcRn -> TcM TcType
    tcHsSigWcType UserTypeCtxt
    ExprSigCtxt LHsSigWcType GhcRn
    sig_ty
           ; Name
    sel_name <- Located RdrName -> TcType -> TcM Name
    disambiguateSelector Located RdrName
    lbl TcType
    sig_tc_ty
           ; let op' :: LHsExpr GhcRn
    op' = SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XRecFld GhcRn -> AmbiguousFieldOcc GhcRn -> HsExpr GhcRn
    forall p. XRecFld p -> AmbiguousFieldOcc p -> HsExpr p
    HsRecFld NoExtField
    XRecFld GhcRn
    noExtField (XUnambiguous GhcRn -> Located RdrName -> AmbiguousFieldOcc GhcRn
    forall pass.
    XUnambiguous pass -> Located RdrName -> AmbiguousFieldOcc pass
    Unambiguous Name
    XUnambiguous GhcRn
    sel_name Located RdrName
    lbl))
           ; HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr (XOpApp GhcRn
    -> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
    forall p.
    XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
    OpApp XOpApp GhcRn
    fix LHsExpr GhcRn
    arg1 LHsExpr GhcRn
    op' LHsExpr GhcRn
    arg2) ExpRhoType
    res_ty
           }

      | Bool
    otherwise
      = do { String -> SDoc -> TcRn ()
    traceTc String
    "Non Application rule" (LHsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsExpr GhcRn
    op)
           ; (LHsExpr GhcTc
    op', TcType
    op_ty) <- LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
    tcInferRhoNC LHsExpr GhcRn
    op

           ; (HsWrapper
    wrap_fun, [Scaled TcType
    arg1_ty, Scaled TcType
    arg2_ty], TcType
    op_res_ty)
                      <- SDoc
    -> CtOrigin
    -> Maybe (HsExpr GhcRn)
    -> ThLevel
    -> TcType
    -> TcM (HsWrapper, [Scaled TcType], TcType)
    matchActualFunTysRho (LHsExpr GhcRn -> SDoc
    mk_op_msg LHsExpr GhcRn
    op) CtOrigin
    fn_orig
                                              (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
    forall a. a -> Maybe a
    Just (LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    op)) ThLevel
    2 TcType
    op_ty
             -- You might think we should use tcInferApp here, but there is
             -- too much impedance-matching, because tcApp may return wrappers as
             -- well as type-checked arguments.

           ; LHsExpr GhcTc
    arg1' <- HsExpr GhcRn
    -> LHsExpr GhcRn -> Scaled TcType -> ThLevel -> TcM (LHsExpr GhcTc)
    tcArg HsExpr GhcRn
    nl_op LHsExpr GhcRn
    arg1 Scaled TcType
    arg1_ty ThLevel
    1
           ; LHsExpr GhcTc
    arg2' <- HsExpr GhcRn
    -> LHsExpr GhcRn -> Scaled TcType -> ThLevel -> TcM (LHsExpr GhcTc)
    tcArg HsExpr GhcRn
    nl_op LHsExpr GhcRn
    arg2 Scaled TcType
    arg2_ty ThLevel
    2

           ; let expr' :: HsExpr GhcTc
    expr' = XOpApp GhcTc
    -> LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p.
    XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
    OpApp XOpApp GhcRn
    XOpApp GhcTc
    fix LHsExpr GhcTc
    arg1' (HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap HsWrapper
    wrap_fun LHsExpr GhcTc
    op') LHsExpr GhcTc
    arg2'
           ; HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResult HsExpr GhcRn
    expr HsExpr GhcTc
    expr' TcType
    op_res_ty ExpRhoType
    res_ty }
      where
        fn_orig :: CtOrigin
    fn_orig = HsExpr GhcRn -> CtOrigin
    exprCtOrigin HsExpr GhcRn
    nl_op
        nl_op :: HsExpr GhcRn
    nl_op   = LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    op

    -- Right sections, equivalent to \ x -> x `op` expr, or
    --      \ x -> op x expr

    tcExpr expr :: HsExpr GhcRn
    expr@(SectionR XSectionR GhcRn
    x LHsExpr GhcRn
    op LHsExpr GhcRn
    arg2) ExpRhoType
    res_ty
      = do { (LHsExpr GhcTc
    op', TcType
    op_ty) <- LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
    tcInferRhoNC LHsExpr GhcRn
    op
           ; (HsWrapper
    wrap_fun, [Scaled TcType
    arg1_mult TcType
    arg1_ty, Scaled TcType
    arg2_ty], TcType
    op_res_ty)
                      <- SDoc
    -> CtOrigin
    -> Maybe (HsExpr GhcRn)
    -> ThLevel
    -> TcType
    -> TcM (HsWrapper, [Scaled TcType], TcType)
    matchActualFunTysRho (LHsExpr GhcRn -> SDoc
    mk_op_msg LHsExpr GhcRn
    op) CtOrigin
    fn_orig
                                              (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
    forall a. a -> Maybe a
    Just (LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    op)) ThLevel
    2 TcType
    op_ty
           ; LHsExpr GhcTc
    arg2' <- HsExpr GhcRn
    -> LHsExpr GhcRn -> Scaled TcType -> ThLevel -> TcM (LHsExpr GhcTc)
    tcArg (LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    op) LHsExpr GhcRn
    arg2 Scaled TcType
    arg2_ty ThLevel
    2
           ; let expr' :: HsExpr GhcTc
    expr'      = XSectionR GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
    SectionR XSectionR GhcRn
    XSectionR GhcTc
    x (HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap HsWrapper
    wrap_fun LHsExpr GhcTc
    op') LHsExpr GhcTc
    arg2'
                 act_res_ty :: TcType
    act_res_ty = TcType -> TcType -> TcType -> TcType
    mkVisFunTy TcType
    arg1_mult TcType
    arg1_ty TcType
    op_res_ty
           ; HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResultMono HsExpr GhcRn
    expr HsExpr GhcTc
    expr' TcType
    act_res_ty ExpRhoType
    res_ty }

      where
        fn_orig :: CtOrigin
    fn_orig = LHsExpr GhcRn -> CtOrigin
    lexprCtOrigin LHsExpr GhcRn
    op
        -- It's important to use the origin of 'op', so that call-stacks
        -- come out right; they are driven by the OccurrenceOf CtOrigin
        -- See #13285

    tcExpr expr :: HsExpr GhcRn
    expr@(SectionL XSectionL GhcRn
    x LHsExpr GhcRn
    arg1 LHsExpr GhcRn
    op) ExpRhoType
    res_ty
      = do { (LHsExpr GhcTc
    op', TcType
    op_ty) <- LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
    tcInferRhoNC LHsExpr GhcRn
    op
           ; DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags      -- Note [Left sections]
           ; let n_reqd_args :: ThLevel
    n_reqd_args | Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.PostfixOperators DynFlags
    dflags = ThLevel
    1
                             | Bool
    otherwise                            = ThLevel
    2

           ; (HsWrapper
    wrap_fn, (Scaled TcType
    arg1_ty:[Scaled TcType]
    arg_tys), TcType
    op_res_ty)
               <- SDoc
    -> CtOrigin
    -> Maybe (HsExpr GhcRn)
    -> ThLevel
    -> TcType
    -> TcM (HsWrapper, [Scaled TcType], TcType)
    matchActualFunTysRho (LHsExpr GhcRn -> SDoc
    mk_op_msg LHsExpr GhcRn
    op) CtOrigin
    fn_orig
                                       (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
    forall a. a -> Maybe a
    Just (LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    op)) ThLevel
    n_reqd_args TcType
    op_ty
           ; LHsExpr GhcTc
    arg1' <- HsExpr GhcRn
    -> LHsExpr GhcRn -> Scaled TcType -> ThLevel -> TcM (LHsExpr GhcTc)
    tcArg (LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    op) LHsExpr GhcRn
    arg1 Scaled TcType
    arg1_ty ThLevel
    1
           ; let expr' :: HsExpr GhcTc
    expr'      = XSectionL GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XSectionL p -> LHsExpr p -> LHsExpr p -> HsExpr p
    SectionL XSectionL GhcRn
    XSectionL GhcTc
    x LHsExpr GhcTc
    arg1' (HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap HsWrapper
    wrap_fn LHsExpr GhcTc
    op')
                 act_res_ty :: TcType
    act_res_ty = [Scaled TcType] -> TcType -> TcType
    mkVisFunTys [Scaled TcType]
    arg_tys TcType
    op_res_ty
           ; HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResultMono HsExpr GhcRn
    expr HsExpr GhcTc
    expr' TcType
    act_res_ty ExpRhoType
    res_ty }
      where
        fn_orig :: CtOrigin
    fn_orig = LHsExpr GhcRn -> CtOrigin
    lexprCtOrigin LHsExpr GhcRn
    op
        -- It's important to use the origin of 'op', so that call-stacks
        -- come out right; they are driven by the OccurrenceOf CtOrigin
        -- See #13285

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

      | Bool
    otherwise
      = -- The tup_args are a mixture of Present and Missing (for tuple sections)
        do { let arity :: ThLevel
    arity = [LHsTupArg GhcRn] -> ThLevel
    forall (t :: * -> *) a. Foldable t => t a -> ThLevel
    length [LHsTupArg GhcRn]
    tup_args

           ; [TcType]
    arg_tys <- case Boxity
    boxity of
               { Boxity
    Boxed   -> ThLevel -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) [TcType]
    newFlexiTyVarTys ThLevel
    arity TcType
    liftedTypeKind
               ; Boxity
    Unboxed -> ThLevel -> TcM TcType -> IOEnv (Env TcGblEnv TcLclEnv) [TcType]
    forall (m :: * -> *) a. Applicative m => ThLevel -> m a -> m [a]
    replicateM ThLevel
    arity TcM TcType
    newOpenFlexiTyVarTy }

           -- Handle tuple sections where
           ; [LHsTupArg GhcTc]
    tup_args1 <- [LHsTupArg GhcRn] -> [TcType] -> TcM [LHsTupArg GhcTc]
    tcTupArgs [LHsTupArg GhcRn]
    tup_args [TcType]
    arg_tys

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

                 -- See Note [Linear fields generalization]
                 act_res_ty :: TcType
    act_res_ty
                     = [Scaled TcType] -> TcType -> TcType
    mkVisFunTys [Scaled TcType]
    missing_tys (Boxity -> [TcType] -> TcType
    mkTupleTy1 Boxity
    boxity [TcType]
    arg_tys)
                       -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make

           ; String -> SDoc -> TcRn ()
    traceTc String
    "ExplicitTuple" (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    act_res_ty SDoc -> SDoc -> SDoc
    $$ ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    res_ty)

           ; HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResultMono HsExpr GhcRn
    expr HsExpr GhcTc
    expr' TcType
    act_res_ty ExpRhoType
    res_ty }

    tcExpr (ExplicitSum XExplicitSum GhcRn
    _ ThLevel
    alt ThLevel
    arity LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do { let sum_tc :: TyCon
    sum_tc = ThLevel -> TyCon
    sumTyCon ThLevel
    arity
           ; TcType
    res_ty <- ExpRhoType -> TcM TcType
    expTypeToType ExpRhoType
    res_ty
           ; (TcCoercionR
    coi, [TcType]
    arg_tys) <- TyCon -> TcType -> TcM (TcCoercionR, [TcType])
    matchExpectedTyConApp TyCon
    sum_tc TcType
    res_ty
           ; -- Drop levity vars, we don't care about them here
             let arg_tys' :: [TcType]
    arg_tys' = ThLevel -> [TcType] -> [TcType]
    forall a. ThLevel -> [a] -> [a]
    drop ThLevel
    arity [TcType]
    arg_tys
           ; LHsExpr GhcTc
    expr' <- LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr ([TcType]
    arg_tys' [TcType] -> ThLevel -> TcType
    forall a. Outputable a => [a] -> ThLevel -> a
    `getNth` (ThLevel
    alt ThLevel -> ThLevel -> ThLevel
    forall a. Num a => a -> a -> a
    - ThLevel
    1))
           ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
    -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ TcCoercionR -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrapCo TcCoercionR
    coi (XExplicitSum GhcTc
    -> ThLevel -> ThLevel -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p.
    XExplicitSum p -> ThLevel -> ThLevel -> LHsExpr p -> HsExpr p
    ExplicitSum [TcType]
    XExplicitSum GhcTc
    arg_tys' ThLevel
    alt ThLevel
    arity LHsExpr GhcTc
    expr' ) }

    -- This will see the empty list only when -XOverloadedLists.
    -- See Note [Empty lists] in GHC.Hs.Expr.
    tcExpr (ExplicitList XExplicitList GhcRn
    _ Maybe (SyntaxExpr GhcRn)
    witness [LHsExpr GhcRn]
    exprs) ExpRhoType
    res_ty
      = case Maybe (SyntaxExpr GhcRn)
    witness of
          Maybe (SyntaxExpr GhcRn)
    Nothing   -> do  { TcType
    res_ty <- ExpRhoType -> TcM TcType
    expTypeToType ExpRhoType
    res_ty
                           ; (TcCoercionR
    coi, TcType
    elt_ty) <- TcType -> TcM (TcCoercionR, TcType)
    matchExpectedListTy TcType
    res_ty
                           ; [LHsExpr GhcTc]
    exprs' <- (LHsExpr GhcRn -> TcM (LHsExpr GhcTc))
    -> [LHsExpr GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) [LHsExpr GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (TcType -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc)
    tc_elt TcType
    elt_ty) [LHsExpr GhcRn]
    exprs
                           ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
    -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                             TcCoercionR -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrapCo TcCoercionR
    coi (HsExpr GhcTc -> HsExpr GhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $ XExplicitList GhcTc
    -> Maybe (SyntaxExpr GhcTc) -> [LHsExpr GhcTc] -> HsExpr GhcTc
    forall p.
    XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
    ExplicitList TcType
    XExplicitList GhcTc
    elt_ty Maybe (SyntaxExpr GhcTc)
    forall a. Maybe a
    Nothing [LHsExpr GhcTc]
    exprs' }

          Just SyntaxExpr GhcRn
    fln -> do { (([LHsExpr GhcTc]
    exprs', TcType
    elt_ty), SyntaxExprTc
    fln')
                             <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([TcType] -> [TcType] -> TcM ([LHsExpr GhcTc], TcType))
    -> TcM (([LHsExpr GhcTc], TcType), SyntaxExprTc)
    forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([TcType] -> [TcType] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    ListOrigin SyntaxExpr GhcRn
    SyntaxExprRn
    fln
                                           [TcType -> SyntaxOpType
    synKnownType TcType
    intTy, SyntaxOpType
    SynList] ExpRhoType
    res_ty (([TcType] -> [TcType] -> TcM ([LHsExpr GhcTc], TcType))
     -> TcM (([LHsExpr GhcTc], TcType), SyntaxExprTc))
    -> ([TcType] -> [TcType] -> TcM ([LHsExpr GhcTc], TcType))
    -> TcM (([LHsExpr GhcTc], TcType), SyntaxExprTc)
    forall a b. (a -> b) -> a -> b
    $
                                \ [TcType
    elt_ty] [TcType
    _int_mul, TcType
    list_mul] ->
                                  -- We ignore _int_mul because the integer (first
                                  -- argument of fromListN) is statically known: it
                                  -- is desugared to a literal. Therefore there is
                                  -- no variable of which to scale the usage in that
                                  -- first argument, and `_int_mul` is completely
                                  -- free in this expression.
                                do { [LHsExpr GhcTc]
    exprs' <-
                                        (LHsExpr GhcRn -> TcM (LHsExpr GhcTc))
    -> [LHsExpr GhcRn] -> IOEnv (Env TcGblEnv TcLclEnv) [LHsExpr GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (TcType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    list_mul (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> (LHsExpr GhcRn -> TcM (LHsExpr GhcTc))
    -> LHsExpr GhcRn
    -> TcM (LHsExpr GhcTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcType -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc)
    tc_elt TcType
    elt_ty) [LHsExpr GhcRn]
    exprs
                                   ; ([LHsExpr GhcTc], TcType) -> TcM ([LHsExpr GhcTc], TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([LHsExpr GhcTc]
    exprs', TcType
    elt_ty) }

                         ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
    -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ XExplicitList GhcTc
    -> Maybe (SyntaxExpr GhcTc) -> [LHsExpr GhcTc] -> HsExpr GhcTc
    forall p.
    XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
    ExplicitList TcType
    XExplicitList GhcTc
    elt_ty (SyntaxExprTc -> Maybe SyntaxExprTc
    forall a. a -> Maybe a
    Just SyntaxExprTc
    fln') [LHsExpr GhcTc]
    exprs' }
         where tc_elt :: TcType -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc)
    tc_elt TcType
    elt_ty LHsExpr GhcRn
    expr = LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr TcType
    elt_ty

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

    tcExpr (HsLet XLet GhcRn
    x (L SrcSpan
    l HsLocalBinds GhcRn
    binds) LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do  { (HsLocalBinds GhcTc
    binds', LHsExpr GhcTc
    expr') <- HsLocalBinds GhcRn
    -> TcM (LHsExpr GhcTc) -> TcM (HsLocalBinds GhcTc, LHsExpr GhcTc)
    forall thing.
    HsLocalBinds GhcRn -> TcM thing -> TcM (HsLocalBinds GhcTc, thing)
    tcLocalBinds HsLocalBinds GhcRn
    binds (TcM (LHsExpr GhcTc) -> TcM (HsLocalBinds GhcTc, LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (HsLocalBinds GhcTc, LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                                 LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcLExpr LHsExpr GhcRn
    expr ExpRhoType
    res_ty
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XLet GhcTc -> LHsLocalBinds GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XLet p -> LHsLocalBinds p -> LHsExpr p -> HsExpr p
    HsLet XLet GhcRn
    XLet GhcTc
    x (SrcSpan -> HsLocalBinds GhcTc -> LHsLocalBinds GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsLocalBinds GhcTc
    binds') LHsExpr GhcTc
    expr') }

    tcExpr (HsCase XCase GhcRn
    x LHsExpr GhcRn
    scrut MatchGroup GhcRn (LHsExpr GhcRn)
    matches) ExpRhoType
    res_ty
      = do  {  -- We used to typecheck the case alternatives first.
               -- The case patterns tend to give good type info to use
               -- when typechecking the scrutinee.  For example
               --   case (map f) of
               --     (x:xs) -> ...
               -- will report that map is applied to too few arguments
               --
               -- But now, in the GADT world, we need to typecheck the scrutinee
               -- first, to get type info that may be refined in the case alternatives
              let mult :: TcType
    mult = TcType
    Many
                -- There is not yet syntax or inference mechanism for case
                -- expressions to be anything else than unrestricted.

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

            ; String -> SDoc -> TcRn ()
    traceTc String
    "HsCase" (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    scrut_ty)
            ; MatchGroup GhcTc (LHsExpr GhcTc)
    matches' <- TcMatchCtxt HsExpr
    -> Scaled TcType
    -> MatchGroup GhcRn (LHsExpr GhcRn)
    -> ExpRhoType
    -> TcM (MatchGroup GhcTc (LHsExpr GhcTc))
    forall (body :: * -> *).
    Outputable (body GhcRn) =>
    TcMatchCtxt body
    -> Scaled TcType
    -> MatchGroup GhcRn (Located (body GhcRn))
    -> ExpRhoType
    -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
    tcMatchesCase TcMatchCtxt HsExpr
    match_ctxt (TcType -> TcType -> Scaled TcType
    forall a. TcType -> a -> Scaled a
    Scaled TcType
    mult TcType
    scrut_ty) MatchGroup GhcRn (LHsExpr GhcRn)
    matches ExpRhoType
    res_ty
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCase GhcTc
    -> LHsExpr GhcTc
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> HsExpr GhcTc
    forall p.
    XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
    HsCase XCase GhcRn
    XCase GhcTc
    x LHsExpr GhcTc
    scrut' MatchGroup GhcTc (LHsExpr GhcTc)
    matches') }
     where
        match_ctxt :: TcMatchCtxt HsExpr
    match_ctxt = MC :: forall (body :: * -> *).
    HsMatchContext GhcRn
    -> (Located (body GhcRn)
        -> ExpRhoType -> TcM (Located (body GhcTc)))
    -> TcMatchCtxt body
    MC { mc_what :: HsMatchContext GhcRn
    mc_what = HsMatchContext GhcRn
    forall p. HsMatchContext p
    CaseAlt,
                          mc_body :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    mc_body = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBody }

    tcExpr (HsIf XIf GhcRn
    x LHsExpr GhcRn
    pred LHsExpr GhcRn
    b1 LHsExpr GhcRn
    b2) ExpRhoType
    res_ty
      = do { LHsExpr GhcTc
    pred' <- LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcLExpr LHsExpr GhcRn
    pred (TcType -> ExpRhoType
    mkCheckExpType TcType
    boolTy)
           ; (UsageEnv
    u1,LHsExpr GhcTc
    b1') <- TcM (LHsExpr GhcTc) -> TcM (UsageEnv, LHsExpr GhcTc)
    forall a. TcM a -> TcM (UsageEnv, a)
    tcCollectingUsage (TcM (LHsExpr GhcTc) -> TcM (UsageEnv, LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (UsageEnv, LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcLExpr LHsExpr GhcRn
    b1 ExpRhoType
    res_ty
           ; (UsageEnv
    u2,LHsExpr GhcTc
    b2') <- TcM (LHsExpr GhcTc) -> TcM (UsageEnv, LHsExpr GhcTc)
    forall a. TcM a -> TcM (UsageEnv, a)
    tcCollectingUsage (TcM (LHsExpr GhcTc) -> TcM (UsageEnv, LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (UsageEnv, LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcLExpr LHsExpr GhcRn
    b2 ExpRhoType
    res_ty
           ; UsageEnv -> TcRn ()
    tcEmitBindingUsage (UsageEnv -> UsageEnv -> UsageEnv
    supUE UsageEnv
    u1 UsageEnv
    u2)
           ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XIf GhcTc
    -> LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XIf p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
    HsIf XIf GhcRn
    XIf GhcTc
    x LHsExpr GhcTc
    pred' LHsExpr GhcTc
    b1' LHsExpr GhcTc
    b2') }

    tcExpr (HsMultiIf XMultiIf GhcRn
    _ [LGRHS GhcRn (LHsExpr GhcRn)]
    alts) ExpRhoType
    res_ty
      = do { [Located (GRHS GhcTc (LHsExpr GhcTc))]
    alts' <- (LGRHS GhcRn (LHsExpr GhcRn)
     -> IOEnv
          (Env TcGblEnv TcLclEnv) (Located (GRHS GhcTc (LHsExpr GhcTc))))
    -> [LGRHS GhcRn (LHsExpr GhcRn)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) [Located (GRHS GhcTc (LHsExpr GhcTc))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((GRHS GhcRn (LHsExpr GhcRn) -> TcM (GRHS GhcTc (LHsExpr GhcTc)))
    -> LGRHS GhcRn (LHsExpr GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Located (GRHS GhcTc (LHsExpr GhcTc)))
    forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
    wrapLocM ((GRHS GhcRn (LHsExpr GhcRn) -> TcM (GRHS GhcTc (LHsExpr GhcTc)))
     -> LGRHS GhcRn (LHsExpr GhcRn)
     -> IOEnv
          (Env TcGblEnv TcLclEnv) (Located (GRHS GhcTc (LHsExpr GhcTc))))
    -> (GRHS GhcRn (LHsExpr GhcRn) -> TcM (GRHS GhcTc (LHsExpr GhcTc)))
    -> LGRHS GhcRn (LHsExpr GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Located (GRHS GhcTc (LHsExpr GhcTc)))
    forall a b. (a -> b) -> a -> b
    $ TcMatchCtxt HsExpr
    -> ExpRhoType
    -> GRHS GhcRn (LHsExpr GhcRn)
    -> TcM (GRHS GhcTc (LHsExpr GhcTc))
    forall (body :: * -> *).
    TcMatchCtxt body
    -> ExpRhoType
    -> GRHS GhcRn (Located (body GhcRn))
    -> TcM (GRHS GhcTc (Located (body GhcTc)))
    tcGRHS TcMatchCtxt HsExpr
    match_ctxt ExpRhoType
    res_ty) [LGRHS GhcRn (LHsExpr GhcRn)]
    alts
           ; TcType
    res_ty <- ExpRhoType -> TcM TcType
    readExpType ExpRhoType
    res_ty
           ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XMultiIf GhcTc
    -> [Located (GRHS GhcTc (LHsExpr GhcTc))] -> HsExpr GhcTc
    forall p. XMultiIf p -> [LGRHS p (LHsExpr p)] -> HsExpr p
    HsMultiIf TcType
    XMultiIf GhcTc
    res_ty [Located (GRHS GhcTc (LHsExpr GhcTc))]
    alts') }
      where match_ctxt :: TcMatchCtxt HsExpr
    match_ctxt = MC :: forall (body :: * -> *).
    HsMatchContext GhcRn
    -> (Located (body GhcRn)
        -> ExpRhoType -> TcM (Located (body GhcTc)))
    -> TcMatchCtxt body
    MC { mc_what :: HsMatchContext GhcRn
    mc_what = HsMatchContext GhcRn
    forall p. HsMatchContext p
    IfAlt, mc_body :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    mc_body = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBody }

    tcExpr (HsDo XDo GhcRn
    _ HsStmtContext GhcRn
    do_or_lc Located [ExprLStmt GhcRn]
    stmts) ExpRhoType
    res_ty
      = do { HsExpr GhcTc
    expr' <- HsStmtContext GhcRn
    -> Located [ExprLStmt GhcRn] -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcDoStmts HsStmtContext GhcRn
    do_or_lc Located [ExprLStmt GhcRn]
    stmts ExpRhoType
    res_ty
           ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    expr' }

    tcExpr (HsProc XProc GhcRn
    x LPat GhcRn
    pat LHsCmdTop GhcRn
    cmd) ExpRhoType
    res_ty
      = do  { (Located (Pat GhcTc)
    pat', LHsCmdTop GhcTc
    cmd', TcCoercionR
    coi) <- LPat GhcRn
    -> LHsCmdTop GhcRn
    -> ExpRhoType
    -> TcM (LPat GhcTc, LHsCmdTop GhcTc, TcCoercionR)
    tcProc LPat GhcRn
    pat LHsCmdTop GhcRn
    cmd ExpRhoType
    res_ty
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
    -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ TcCoercionR -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrapCo TcCoercionR
    coi (XProc GhcTc -> LPat GhcTc -> LHsCmdTop GhcTc -> HsExpr GhcTc
    forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
    HsProc XProc GhcRn
    XProc GhcTc
    x Located (Pat GhcTc)
    LPat GhcTc
    pat' LHsCmdTop GhcTc
    cmd') }

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

    tcExpr (HsStatic XStatic GhcRn
    fvs LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do  { TcType
    res_ty          <- ExpRhoType -> TcM TcType
    expTypeToType ExpRhoType
    res_ty
            ; (TcCoercionR
    co, (TcType
    p_ty, TcType
    expr_ty)) <- TcType -> TcM (TcCoercionR, (TcType, TcType))
    matchExpectedAppTy TcType
    res_ty
            ; (LHsExpr GhcTc
    expr', WantedConstraints
    lie)    <- TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc, WantedConstraints)
    forall a. TcM a -> TcM (a, WantedConstraints)
    captureConstraints (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc, WantedConstraints))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                SDoc -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (SDoc -> ThLevel -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "In the body of a static form:")
                                 ThLevel
    2 (LHsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsExpr GhcRn
    expr)
                           ) (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExprNC LHsExpr GhcRn
    expr TcType
    expr_ty

            -- Check that the free variables of the static form are closed.
            -- It's OK to use nonDetEltsUniqSet here as the only side effects of
            -- checkClosedInStaticForm are error messages.
            ; (Name -> TcRn ()) -> [Name] -> TcRn ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Name -> TcRn ()
    checkClosedInStaticForm ([Name] -> TcRn ()) -> [Name] -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ UniqSet Name -> [Name]
    forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet UniqSet Name
    XStatic GhcRn
    fvs

            -- Require the type of the argument to be Typeable.
            -- The evidence is not used, but asking the constraint ensures that
            -- the current implementation is as restrictive as future versions
            -- of the StaticPointers extension.
            ; Class
    typeableClass <- Name -> TcM Class
    tcLookupClass Name
    typeableClassName
            ; Var
    _ <- CtOrigin -> TcType -> TcM Var
    emitWantedEvVar CtOrigin
    StaticOrigin (TcType -> TcM Var) -> TcType -> TcM Var
    forall a b. (a -> b) -> a -> b
    $
                      TyCon -> [TcType] -> TcType
    mkTyConApp (Class -> TyCon
    classTyCon Class
    typeableClass)
                                 [TcType
    liftedTypeKind, TcType
    expr_ty]

            -- Insert the constraints of the static form in a global list for later
            -- validation.
            ; WantedConstraints -> TcRn ()
    emitStaticConstraints WantedConstraints
    lie

            -- Wrap the static form with the 'fromStaticPtr' call.
            ; HsExpr GhcTc
    fromStaticPtr <- CtOrigin -> Name -> [TcType] -> TcM (HsExpr GhcTc)
    newMethodFromName CtOrigin
    StaticOrigin Name
    fromStaticPtrName
                                                 [TcType
    p_ty]
            ; let wrap :: HsWrapper
    wrap = [TcType] -> HsWrapper
    mkWpTyApps [TcType
    expr_ty]
            ; SrcSpan
    loc <- TcRn SrcSpan
    getSrcSpanM
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
    -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ TcCoercionR -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrapCo TcCoercionR
    co (HsExpr GhcTc -> HsExpr GhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $ XApp GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
    HsApp NoExtField
    XApp GhcTc
    noExtField
                                             (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (HsExpr GhcTc -> LHsExpr GhcTc) -> HsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $ HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap HsExpr GhcTc
    fromStaticPtr)
                                             (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XStatic GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XStatic p -> LHsExpr p -> HsExpr p
    HsStatic XStatic GhcRn
    XStatic GhcTc
    fvs LHsExpr GhcTc
    expr'))
            }

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

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

            -- Check for missing fields
            ; ConLike -> HsRecordBinds GhcRn -> TcRn ()
    checkMissingFields ConLike
    con_like HsRecordBinds GhcRn
    rbinds

            ; (HsExpr GhcTc
    con_expr, TcType
    con_sigma) <- Name -> TcM (HsExpr GhcTc, TcType)
    tcInferId Name
    IdP GhcRn
    con_name
            ; (HsWrapper
    con_wrap, TcType
    con_tau)   <- CtOrigin -> TcType -> TcM (HsWrapper, TcType)
    topInstantiate CtOrigin
    orig TcType
    con_sigma
                  -- a shallow instantiation should really be enough for
                  -- a data constructor.
            ; let arity :: ThLevel
    arity = ConLike -> ThLevel
    conLikeArity ConLike
    con_like
                  Right ([Scaled TcType]
    arg_tys, TcType
    actual_res_ty) = ThLevel -> TcType -> Either ThLevel ([Scaled TcType], TcType)
    tcSplitFunTysN ThLevel
    arity TcType
    con_tau
            ; case ConLike -> Maybe Var
    conLikeWrapId_maybe ConLike
    con_like of {
                   Maybe Var
    Nothing -> Name -> TcM (HsExpr GhcTc)
    forall name a. Outputable name => name -> TcM a
    nonBidirectionalErr (ConLike -> Name
    conLikeName ConLike
    con_like) ;
                   Just Var
    con_id ->

         do { HsRecordBinds GhcTc
    rbinds' <- ConLike
    -> [TcType] -> HsRecordBinds GhcRn -> TcM (HsRecordBinds GhcTc)
    tcRecordBinds ConLike
    con_like ((Scaled TcType -> TcType) -> [Scaled TcType] -> [TcType]
    forall a b. (a -> b) -> [a] -> [b]
    map Scaled TcType -> TcType
    forall a. Scaled a -> a
    scaledThing [Scaled TcType]
    arg_tys) HsRecordBinds GhcRn
    rbinds
                       -- It is currently not possible for a record to have
                       -- multiplicities. When they do, `tcRecordBinds` will take
                       -- scaled types instead. Meanwhile, it's safe to take
                       -- `scaledThing` above, as we know all the multiplicities are
                       -- Many.
            ; let rcon_tc :: RecordConTc
    rcon_tc = RecordConTc :: ConLike -> HsExpr GhcTc -> RecordConTc
    RecordConTc
                               { rcon_con_like :: ConLike
    rcon_con_like = ConLike
    con_like
                               , rcon_con_expr :: HsExpr GhcTc
    rcon_con_expr = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    con_wrap HsExpr GhcTc
    con_expr }
                  expr' :: HsExpr GhcTc
    expr' = RecordCon :: forall p.
    XRecordCon p -> Located (IdP p) -> HsRecordBinds p -> HsExpr p
    RecordCon { rcon_ext :: XRecordCon GhcTc
    rcon_ext = XRecordCon GhcTc
    RecordConTc
    rcon_tc
                                    , rcon_con_name :: Located (IdP GhcTc)
    rcon_con_name = SrcSpan -> Var -> Located Var
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc Var
    con_id
                                    , rcon_flds :: HsRecordBinds GhcTc
    rcon_flds = HsRecordBinds GhcTc
    rbinds' }

            ; HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResultMono HsExpr GhcRn
    expr HsExpr GhcTc
    expr' TcType
    actual_res_ty ExpRhoType
    res_ty } } }
      where
        orig :: CtOrigin
    orig = Name -> CtOrigin
    OccurrenceOf Name
    IdP GhcRn
    con_name

    {-
    Note [Type of a record update]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The main complication with RecordUpd is that we need to explicitly
    handle the *non-updated* fields.  Consider:

            data T a b c = MkT1 { fa :: a, fb :: (b,c) }
                         | MkT2 { fa :: a, fb :: (b,c), fc :: c -> c }
                         | MkT3 { fd :: a }

            upd :: T a b c -> (b',c) -> T a b' c
            upd t x = t { fb = x}

    The result type should be (T a b' c)
    not (T a b c),   because 'b' *is not* mentioned in a non-updated field
    not (T a b' c'), because 'c' *is*     mentioned in a non-updated field
    NB that it's not good enough to look at just one constructor; we must
    look at them all; cf #3219

    After all, upd should be equivalent to:
            upd t x = case t of
                            MkT1 p q -> MkT1 p x
                            MkT2 a b -> MkT2 p b
                            MkT3 d   -> error ...

    So we need to give a completely fresh type to the result record,
    and then constrain it by the fields that are *not* updated ("p" above).
    We call these the "fixed" type variables, and compute them in getFixedTyVars.

    Note that because MkT3 doesn't contain all the fields being updated,
    its RHS is simply an error, so it doesn't impose any type constraints.
    Hence the use of 'relevant_cont'.

    Note [Implicit type sharing]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We also take into account any "implicit" non-update fields.  For example
            data T a b where { MkT { f::a } :: T a a; ... }
    So the "real" type of MkT is: forall ab. (a~b) => a -> T a b

    Then consider
            upd t x = t { f=x }
    We infer the type
            upd :: T a b -> a -> T a b
            upd (t::T a b) (x::a)
               = case t of { MkT (co:a~b) (_:a) -> MkT co x }
    We can't give it the more general type
            upd :: T a b -> c -> T c b

    Note [Criteria for update]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    We want to allow update for existentials etc, provided the updated
    field isn't part of the existential. For example, this should be ok.
      data T a where { MkT { f1::a, f2::b->b } :: T a }
      f :: T a -> b -> T b
      f t b = t { f1=b }

    The criterion we use is this:

      The types of the updated fields
      mention only the universally-quantified type variables
      of the data constructor

    NB: this is not (quite) the same as being a "naughty" record selector
    (See Note [Naughty record selectors]) in GHC.Tc.TyCl), at least
    in the case of GADTs. Consider
       data T a where { MkT :: { f :: a } :: T [a] }
    Then f is not "naughty" because it has a well-typed record selector.
    But we don't allow updates for 'f'.  (One could consider trying to
    allow this, but it makes my head hurt.  Badly.  And no one has asked
    for it.)

    In principle one could go further, and allow
      g :: T a -> T a
      g t = t { f2 = \x -> x }
    because the expression is polymorphic...but that seems a bridge too far.

    Note [Data family example]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
        data instance T (a,b) = MkT { x::a, y::b }
      --->
        data :TP a b = MkT { a::a, y::b }
        coTP a b :: T (a,b) ~ :TP a b

    Suppose r :: T (t1,t2), e :: t3
    Then  r { x=e } :: T (t3,t1)
      --->
          case r |> co1 of
            MkT x y -> MkT e y |> co2
          where co1 :: T (t1,t2) ~ :TP t1 t2
                co2 :: :TP t3 t2 ~ T (t3,t2)
    The wrapping with co2 is done by the constructor wrapper for MkT

    Outgoing invariants
    ~~~~~~~~~~~~~~~~~~~
    In the outgoing (HsRecordUpd scrut binds cons in_inst_tys out_inst_tys):

      * cons are the data constructors to be updated

      * in_inst_tys, out_inst_tys have same length, and instantiate the
            *representation* tycon of the data cons.  In Note [Data
            family example], in_inst_tys = [t1,t2], out_inst_tys = [t3,t2]

    Note [Mixed Record Field Updates]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider the following pattern synonym.

      data MyRec = MyRec { foo :: Int, qux :: String }

      pattern HisRec{f1, f2} = MyRec{foo = f1, qux=f2}

    This allows updates such as the following

      updater :: MyRec -> MyRec
      updater a = a {f1 = 1 }

    It would also make sense to allow the following update (which we reject).

      updater a = a {f1 = 1, qux = "two" } ==? MyRec 1 "two"

    This leads to confusing behaviour when the selectors in fact refer the same
    field.

      updater a = a {f1 = 1, foo = 2} ==? ???

    For this reason, we reject a mixture of pattern synonym and normal record
    selectors in the same update block. Although of course we still allow the
    following.

      updater a = (a {f1 = 1}) {foo = 2}

      > updater (MyRec 0 "str")
      MyRec 2 "str"

    -}

    tcExpr expr :: HsExpr GhcRn
    expr@(RecordUpd { rupd_expr :: forall p. HsExpr p -> LHsExpr p
    rupd_expr = LHsExpr GhcRn
    record_expr, rupd_flds :: forall p. HsExpr p -> [LHsRecUpdField p]
    rupd_flds = [LHsRecUpdField GhcRn]
    rbnds }) ExpRhoType
    res_ty
      = ASSERT( notNull rbnds )
        do  { -- STEP -2: typecheck the record_expr, the record to be updated
              (LHsExpr GhcTc
    record_expr', TcType
    record_rho) <- TcType
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    Many (TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType))
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
    tcInferRho LHsExpr GhcRn
    record_expr
                -- Record update drops some of the content of the record (namely the
                -- content of the field being updated). As a consequence, unless the
                -- field being updated is unrestricted in the record, or we need an
                -- unrestricted record. Currently, we simply always require an
                -- unrestricted record.
                --
                -- Consider the following example:
                --
                -- data R a = R { self :: a }
                -- bad :: a ⊸ ()
                -- bad x = let r = R x in case r { self = () } of { R x' -> x' }
                --
                -- This should definitely *not* typecheck.

            -- STEP -1  See Note [Disambiguating record fields]
            -- After this we know that rbinds is unambiguous
            ; [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds <- LHsExpr GhcRn
    -> TcType
    -> [LHsRecUpdField GhcRn]
    -> ExpRhoType
    -> TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    disambiguateRecordBinds LHsExpr GhcRn
    record_expr TcType
    record_rho [LHsRecUpdField GhcRn]
    rbnds ExpRhoType
    res_ty
            ; let upd_flds :: [AmbiguousFieldOcc GhcTc]
    upd_flds = (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
     -> AmbiguousFieldOcc GhcTc)
    -> [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> [AmbiguousFieldOcc GhcTc]
    forall a b. (a -> b) -> [a] -> [b]
    map (GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    -> AmbiguousFieldOcc GhcTc
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
     -> AmbiguousFieldOcc GhcTc)
    -> (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
        -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc))
    -> LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> AmbiguousFieldOcc GhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl (HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
     -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc))
    -> (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
        -> HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    -> LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    forall l e. GenLocated l e -> e
    unLoc) [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds
                  upd_fld_occs :: [FieldLabelString]
    upd_fld_occs = (AmbiguousFieldOcc GhcTc -> FieldLabelString)
    -> [AmbiguousFieldOcc GhcTc] -> [FieldLabelString]
    forall a b. (a -> b) -> [a] -> [b]
    map (OccName -> FieldLabelString
    occNameFS (OccName -> FieldLabelString)
    -> (AmbiguousFieldOcc GhcTc -> OccName)
    -> AmbiguousFieldOcc GhcTc
    -> FieldLabelString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RdrName -> OccName
    rdrNameOcc (RdrName -> OccName)
    -> (AmbiguousFieldOcc GhcTc -> RdrName)
    -> AmbiguousFieldOcc GhcTc
    -> OccName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AmbiguousFieldOcc GhcTc -> RdrName
    forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
    rdrNameAmbiguousFieldOcc) [AmbiguousFieldOcc GhcTc]
    upd_flds
                  sel_ids :: [Var]
    sel_ids      = (AmbiguousFieldOcc GhcTc -> Var)
    -> [AmbiguousFieldOcc GhcTc] -> [Var]
    forall a b. (a -> b) -> [a] -> [b]
    map AmbiguousFieldOcc GhcTc -> Var
    selectorAmbiguousFieldOcc [AmbiguousFieldOcc GhcTc]
    upd_flds
            -- STEP 0
            -- Check that the field names are really field names
            -- and they are all field names for proper records or
            -- all field names for pattern synonyms.
            ; let bad_guys :: [TcRn ()]
    bad_guys = [ SrcSpan -> TcRn () -> TcRn ()
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ SDoc -> TcRn ()
    addErrTc (Name -> SDoc
    notSelector Name
    fld_name)
                             | LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    fld <- [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds,
                               -- Excludes class ops
                               let L SrcSpan
    loc Var
    sel_id = HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> Located Var
    forall arg.
    HsRecField' (AmbiguousFieldOcc GhcTc) arg -> Located Var
    hsRecUpdFieldId (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    forall l e. GenLocated l e -> e
    unLoc LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    fld),
                               Bool -> Bool
    not (Var -> Bool
    isRecordSelector Var
    sel_id),
                               let fld_name :: Name
    fld_name = Var -> Name
    idName Var
    sel_id ]
            ; Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([TcRn ()] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcRn ()]
    bad_guys) ([TcRn ()] -> IOEnv (Env TcGblEnv TcLclEnv) [()]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [TcRn ()]
    bad_guys IOEnv (Env TcGblEnv TcLclEnv) [()] -> TcRn () -> TcRn ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TcRn ()
    forall env a. IOEnv env a
    failM)
            -- See note [Mixed Record Selectors]
            ; let ([Var]
    data_sels, [Var]
    pat_syn_sels) =
                    (Var -> Bool) -> [Var] -> ([Var], [Var])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition Var -> Bool
    isDataConRecordSelector [Var]
    sel_ids
            ; MASSERT( all isPatSynRecordSelector pat_syn_sels )
            ; Bool -> SDoc -> TcRn ()
    checkTc ( [Var] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Var]
    data_sels Bool -> Bool -> Bool
    || [Var] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Var]
    pat_syn_sels )
                      ( [Var] -> [Var] -> SDoc
    mixedSelectors [Var]
    data_sels [Var]
    pat_syn_sels )

            -- STEP 1
            -- Figure out the tycon and data cons from the first field name
            ; let   -- It's OK to use the non-tc splitters here (for a selector)
                  Var
    sel_id : [Var]
    _  = [Var]
    sel_ids

                  mtycon :: Maybe TyCon
                  mtycon :: Maybe TyCon
    mtycon = case Var -> IdDetails
    idDetails Var
    sel_id of
                              RecSelId (RecSelData TyCon
    tycon) Bool
    _ -> TyCon -> Maybe TyCon
    forall a. a -> Maybe a
    Just TyCon
    tycon
                              IdDetails
    _ -> Maybe TyCon
    forall a. Maybe a
    Nothing

                  con_likes :: [ConLike]
                  con_likes :: [ConLike]
    con_likes = case Var -> IdDetails
    idDetails Var
    sel_id of
                                 RecSelId (RecSelData TyCon
    tc) Bool
    _
                                    -> (DataCon -> ConLike) -> [DataCon] -> [ConLike]
    forall a b. (a -> b) -> [a] -> [b]
    map DataCon -> ConLike
    RealDataCon (TyCon -> [DataCon]
    tyConDataCons TyCon
    tc)
                                 RecSelId (RecSelPatSyn PatSyn
    ps) Bool
    _
                                    -> [PatSyn -> ConLike
    PatSynCon PatSyn
    ps]
                                 IdDetails
    _  -> String -> [ConLike]
    forall a. String -> a
    panic String
    "tcRecordUpd"
                    -- NB: for a data type family, the tycon is the instance tycon

                  relevant_cons :: [ConLike]
    relevant_cons = [ConLike] -> [FieldLabelString] -> [ConLike]
    conLikesWithFields [ConLike]
    con_likes [FieldLabelString]
    upd_fld_occs
                    -- A constructor is only relevant to this process if
                    -- it contains *all* the fields that are being updated
                    -- Other ones will cause a runtime error if they occur

            -- Step 2
            -- Check that at least one constructor has all the named fields
            -- i.e. has an empty set of bad fields returned by badFields
            ; Bool -> SDoc -> TcRn ()
    checkTc (Bool -> Bool
    not ([ConLike] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ConLike]
    relevant_cons)) ([LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> [ConLike] -> SDoc
    badFieldsUpd [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds [ConLike]
    con_likes)

            -- Take apart a representative constructor
            ; let con1 :: ConLike
    con1 = ASSERT( not (null relevant_cons) ) head relevant_cons
                  ([Var]
    con1_tvs, [Var]
    _, [EqSpec]
    _, [TcType]
    _prov_theta, [TcType]
    req_theta, [Scaled TcType]
    scaled_con1_arg_tys, TcType
    _)
                     = ConLike
    -> ([Var], [Var], [EqSpec], [TcType], [TcType], [Scaled TcType],
        TcType)
    conLikeFullSig ConLike
    con1
                  con1_arg_tys :: [TcType]
    con1_arg_tys = (Scaled TcType -> TcType) -> [Scaled TcType] -> [TcType]
    forall a b. (a -> b) -> [a] -> [b]
    map Scaled TcType -> TcType
    forall a. Scaled a -> a
    scaledThing [Scaled TcType]
    scaled_con1_arg_tys
                    -- We can safely drop the fields' multiplicities because
                    -- they are currently always 1: there is no syntax for record
                    -- fields with other multiplicities yet. This way we don't need
                    -- to handle it in the rest of the function
                  con1_flds :: [FieldLabelString]
    con1_flds   = (FieldLbl Name -> FieldLabelString)
    -> [FieldLbl Name] -> [FieldLabelString]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLbl Name -> FieldLabelString
    forall a. FieldLbl a -> FieldLabelString
    flLabel ([FieldLbl Name] -> [FieldLabelString])
    -> [FieldLbl Name] -> [FieldLabelString]
    forall a b. (a -> b) -> a -> b
    $ ConLike -> [FieldLbl Name]
    conLikeFieldLabels ConLike
    con1
                  con1_tv_tys :: [TcType]
    con1_tv_tys = [Var] -> [TcType]
    mkTyVarTys [Var]
    con1_tvs
                  con1_res_ty :: TcType
    con1_res_ty = case Maybe TyCon
    mtycon of
                                  Just TyCon
    tc -> TyCon -> [TcType] -> TcType
    mkFamilyTyConApp TyCon
    tc [TcType]
    con1_tv_tys
                                  Maybe TyCon
    Nothing -> ConLike -> [TcType] -> TcType
    conLikeResTy ConLike
    con1 [TcType]
    con1_tv_tys

            -- Check that we're not dealing with a unidirectional pattern
            -- synonym
            ; Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Maybe Var -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe Var -> Bool) -> Maybe Var -> Bool
    forall a b. (a -> b) -> a -> b
    $ ConLike -> Maybe Var
    conLikeWrapId_maybe ConLike
    con1)
                      (Name -> TcRn ()
    forall name a. Outputable name => name -> TcM a
    nonBidirectionalErr (ConLike -> Name
    conLikeName ConLike
    con1))

            -- STEP 3    Note [Criteria for update]
            -- Check that each updated field is polymorphic; that is, its type
            -- mentions only the universally-quantified variables of the data con
            ; let flds1_w_tys :: [(FieldLabelString, TcType)]
    flds1_w_tys  = String
    -> [FieldLabelString] -> [TcType] -> [(FieldLabelString, TcType)]
    forall a b. String -> [a] -> [b] -> [(a, b)]
    zipEqual String
    "tcExpr:RecConUpd" [FieldLabelString]
    con1_flds [TcType]
    con1_arg_tys
                  bad_upd_flds :: [(FieldLabelString, TcType)]
    bad_upd_flds = ((FieldLabelString, TcType) -> Bool)
    -> [(FieldLabelString, TcType)] -> [(FieldLabelString, TcType)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (FieldLabelString, TcType) -> Bool
    bad_fld [(FieldLabelString, TcType)]
    flds1_w_tys
                  con1_tv_set :: VarSet
    con1_tv_set  = [Var] -> VarSet
    mkVarSet [Var]
    con1_tvs
                  bad_fld :: (FieldLabelString, TcType) -> Bool
    bad_fld (FieldLabelString
    fld, TcType
    ty) = FieldLabelString
    fld FieldLabelString -> [FieldLabelString] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [FieldLabelString]
    upd_fld_occs Bool -> Bool -> Bool
    &&
                                          Bool -> Bool
    not (TcType -> VarSet
    tyCoVarsOfType TcType
    ty VarSet -> VarSet -> Bool
    `subVarSet` VarSet
    con1_tv_set)
            ; Bool -> SDoc -> TcRn ()
    checkTc ([(FieldLabelString, TcType)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(FieldLabelString, TcType)]
    bad_upd_flds) ([(FieldLabelString, TcType)] -> SDoc
    badFieldTypes [(FieldLabelString, TcType)]
    bad_upd_flds)

            -- STEP 4  Note [Type of a record update]
            -- Figure out types for the scrutinee and result
            -- Both are of form (T a b c), with fresh type variables, but with
            -- common variables where the scrutinee and result must have the same type
            -- These are variables that appear in *any* arg of *any* of the
            -- relevant constructors *except* in the updated fields
            --
            ; let fixed_tvs :: VarSet
    fixed_tvs = [FieldLabelString] -> [Var] -> [ConLike] -> VarSet
    getFixedTyVars [FieldLabelString]
    upd_fld_occs [Var]
    con1_tvs [ConLike]
    relevant_cons
                  is_fixed_tv :: Var -> Bool
    is_fixed_tv Var
    tv = Var
    tv Var -> VarSet -> Bool
    `elemVarSet` VarSet
    fixed_tvs

                  mk_inst_ty :: TCvSubst -> (TyVar, TcType) -> TcM (TCvSubst, TcType)
                  -- Deals with instantiation of kind variables
                  --   c.f. GHC.Tc.Utils.TcMType.newMetaTyVars
                  mk_inst_ty :: TCvSubst -> (Var, TcType) -> TcM (TCvSubst, TcType)
    mk_inst_ty TCvSubst
    subst (Var
    tv, TcType
    result_inst_ty)
                    | Var -> Bool
    is_fixed_tv Var
    tv   -- Same as result type
                    = (TCvSubst, TcType) -> TcM (TCvSubst, TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TCvSubst -> Var -> TcType -> TCvSubst
    extendTvSubst TCvSubst
    subst Var
    tv TcType
    result_inst_ty, TcType
    result_inst_ty)
                    | Bool
    otherwise        -- Fresh type, of correct kind
                    = do { (TCvSubst
    subst', Var
    new_tv) <- TCvSubst -> Var -> TcM (TCvSubst, Var)
    newMetaTyVarX TCvSubst
    subst Var
    tv
                         ; (TCvSubst, TcType) -> TcM (TCvSubst, TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TCvSubst
    subst', Var -> TcType
    mkTyVarTy Var
    new_tv) }

            ; (TCvSubst
    result_subst, [Var]
    con1_tvs') <- [Var] -> TcM (TCvSubst, [Var])
    newMetaTyVars [Var]
    con1_tvs
            ; let result_inst_tys :: [TcType]
    result_inst_tys = [Var] -> [TcType]
    mkTyVarTys [Var]
    con1_tvs'
                  init_subst :: TCvSubst
    init_subst = InScopeSet -> TCvSubst
    mkEmptyTCvSubst (TCvSubst -> InScopeSet
    getTCvInScope TCvSubst
    result_subst)

            ; (TCvSubst
    scrut_subst, [TcType]
    scrut_inst_tys) <- (TCvSubst -> (Var, TcType) -> TcM (TCvSubst, TcType))
    -> TCvSubst
    -> [(Var, TcType)]
    -> IOEnv (Env TcGblEnv TcLclEnv) (TCvSubst, [TcType])
    forall (m :: * -> *) acc x y.
    Monad m =>
    (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
    mapAccumLM TCvSubst -> (Var, TcType) -> TcM (TCvSubst, TcType)
    mk_inst_ty TCvSubst
    init_subst
                                                          ([Var]
    con1_tvs [Var] -> [TcType] -> [(Var, TcType)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [TcType]
    result_inst_tys)

            ; let rec_res_ty :: TcType
    rec_res_ty    = HasCallStack => TCvSubst -> TcType -> TcType
    TCvSubst -> TcType -> TcType
    TcType.substTy TCvSubst
    result_subst TcType
    con1_res_ty
                  scrut_ty :: TcType
    scrut_ty      = HasCallStack => TCvSubst -> TcType -> TcType
    TCvSubst -> TcType -> TcType
    TcType.substTy TCvSubst
    scrut_subst  TcType
    con1_res_ty
                  con1_arg_tys' :: [TcType]
    con1_arg_tys' = (TcType -> TcType) -> [TcType] -> [TcType]
    forall a b. (a -> b) -> [a] -> [b]
    map (HasCallStack => TCvSubst -> TcType -> TcType
    TCvSubst -> TcType -> TcType
    TcType.substTy TCvSubst
    result_subst) [TcType]
    con1_arg_tys

            ; TcCoercionR
    co_scrut <- Maybe (HsExpr GhcRn) -> TcType -> TcType -> TcM TcCoercionR
    unifyType (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
    forall a. a -> Maybe a
    Just (LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    record_expr)) TcType
    record_rho TcType
    scrut_ty
                    -- NB: normal unification is OK here (as opposed to subsumption),
                    -- because for this to work out, both record_rho and scrut_ty have
                    -- to be normal datatypes -- no contravariant stuff can go on

            -- STEP 5
            -- Typecheck the bindings
            ; [LHsRecUpdField GhcTc]
    rbinds'      <- ConLike
    -> [TcType]
    -> [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> TcM [LHsRecUpdField GhcTc]
    tcRecordUpd ConLike
    con1 [TcType]
    con1_arg_tys' [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds

            -- STEP 6: Deal with the stupid theta
            ; let theta' :: [TcType]
    theta' = TCvSubst -> [TcType] -> [TcType]
    substThetaUnchecked TCvSubst
    scrut_subst (ConLike -> [TcType]
    conLikeStupidTheta ConLike
    con1)
            ; CtOrigin -> [TcType] -> TcRn ()
    instStupidTheta CtOrigin
    RecordUpdOrigin [TcType]
    theta'

            -- Step 7: make a cast for the scrutinee, in the
            --         case that it's from a data family
            ; let fam_co :: HsWrapper   -- RepT t1 .. tn ~R scrut_ty
                  fam_co :: HsWrapper
    fam_co | Just TyCon
    tycon <- Maybe TyCon
    mtycon
                         , Just CoAxiom Unbranched
    co_con <- TyCon -> Maybe (CoAxiom Unbranched)
    tyConFamilyCoercion_maybe TyCon
    tycon
                         = TcCoercionR -> HsWrapper
    mkWpCastR (CoAxiom Unbranched -> [TcType] -> [TcCoercionR] -> TcCoercionR
    mkTcUnbranchedAxInstCo CoAxiom Unbranched
    co_con [TcType]
    scrut_inst_tys [])
                         | Bool
    otherwise
                         = HsWrapper
    idHsWrapper

            -- Step 8: Check that the req constraints are satisfied
            -- For normal data constructors req_theta is empty but we must do
            -- this check for pattern synonyms.
            ; let req_theta' :: [TcType]
    req_theta' = TCvSubst -> [TcType] -> [TcType]
    substThetaUnchecked TCvSubst
    scrut_subst [TcType]
    req_theta
            ; HsWrapper
    req_wrap <- CtOrigin -> [TcType] -> TcM HsWrapper
    instCallConstraints CtOrigin
    RecordUpdOrigin [TcType]
    req_theta'

            -- Phew!
            ; let upd_tc :: RecordUpdTc
    upd_tc = RecordUpdTc :: [ConLike] -> [TcType] -> [TcType] -> HsWrapper -> RecordUpdTc
    RecordUpdTc { rupd_cons :: [ConLike]
    rupd_cons = [ConLike]
    relevant_cons
                                       , rupd_in_tys :: [TcType]
    rupd_in_tys = [TcType]
    scrut_inst_tys
                                       , rupd_out_tys :: [TcType]
    rupd_out_tys = [TcType]
    result_inst_tys
                                       , rupd_wrap :: HsWrapper
    rupd_wrap = HsWrapper
    req_wrap }
                  expr' :: HsExpr GhcTc
    expr' = RecordUpd :: forall p.
    XRecordUpd p -> LHsExpr p -> [LHsRecUpdField p] -> HsExpr p
    RecordUpd { rupd_expr :: LHsExpr GhcTc
    rupd_expr = HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap HsWrapper
    fam_co (LHsExpr GhcTc -> LHsExpr GhcTc) -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                                                  TcCoercionR -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrapCo TcCoercionR
    co_scrut LHsExpr GhcTc
    record_expr'
                                    , rupd_flds :: [LHsRecUpdField GhcTc]
    rupd_flds = [LHsRecUpdField GhcTc]
    rbinds'
                                    , rupd_ext :: XRecordUpd GhcTc
    rupd_ext = XRecordUpd GhcTc
    RecordUpdTc
    upd_tc }

            ; HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResult HsExpr GhcRn
    expr HsExpr GhcTc
    expr' TcType
    rec_res_ty ExpRhoType
    res_ty }

    tcExpr e :: HsExpr GhcRn
    e@(HsRecFld XRecFld GhcRn
    _ AmbiguousFieldOcc GhcRn
    f) ExpRhoType
    res_ty
        = HsExpr GhcRn
    -> AmbiguousFieldOcc GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcCheckRecSelId HsExpr GhcRn
    e AmbiguousFieldOcc GhcRn
    f ExpRhoType
    res_ty

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

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

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

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

    -- HsSpliced is an annotation produced by 'GHC.Rename.Splice.rnSpliceExpr'.
    -- Here we get rid of it and add the finalizers to the global environment.
    --
    -- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice.
    tcExpr (HsSpliceE XSpliceE GhcRn
    _ (HsSpliced XSpliced GhcRn
    _ ThModFinalizers
    mod_finalizers (HsSplicedExpr HsExpr GhcRn
    expr)))
           ExpRhoType
    res_ty
      = do ThModFinalizers -> TcRn ()
    addModFinalizersWithLclEnv ThModFinalizers
    mod_finalizers
           HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    expr ExpRhoType
    res_ty
    tcExpr (HsSpliceE XSpliceE GhcRn
    _ HsSplice GhcRn
    splice)          ExpRhoType
    res_ty = HsSplice GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcSpliceExpr HsSplice GhcRn
    splice ExpRhoType
    res_ty
    tcExpr e :: HsExpr GhcRn
    e@(HsBracket XBracket GhcRn
    _ HsBracket GhcRn
    brack)         ExpRhoType
    res_ty = HsExpr GhcRn -> HsBracket GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcTypedBracket HsExpr GhcRn
    e HsBracket GhcRn
    brack ExpRhoType
    res_ty
    tcExpr e :: HsExpr GhcRn
    e@(HsRnBracketOut XRnBracketOut GhcRn
    _ HsBracket GhcRn
    brack [PendingRnSplice]
    ps) ExpRhoType
    res_ty = HsExpr GhcRn
    -> HsBracket GhcRn
    -> [PendingRnSplice]
    -> ExpRhoType
    -> TcM (HsExpr GhcTc)
    tcUntypedBracket HsExpr GhcRn
    e HsBracket GhcRn
    brack [PendingRnSplice]
    ps ExpRhoType
    res_ty

    {-
    ************************************************************************
    *                                                                      *
                    Rebindable syntax
    *                                                                      *
    ************************************************************************
    -}

    -- See Note [Rebindable syntax and HsExpansion].
    tcExpr (XExpr (HsExpanded HsExpr GhcRn
    a HsExpr GhcRn
    b)) ExpRhoType
    t
      = (HsExpr GhcTc -> HsExpr GhcTc)
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (XXExprGhcTc -> HsExpr GhcTc
    forall p. XXExpr p -> HsExpr p
    XExpr (XXExprGhcTc -> HsExpr GhcTc)
    -> (HsExpr GhcTc -> XXExprGhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsExpansion (HsExpr GhcRn) (HsExpr GhcTc) -> XXExprGhcTc
    ExpansionExpr (HsExpansion (HsExpr GhcRn) (HsExpr GhcTc) -> XXExprGhcTc)
    -> (HsExpr GhcTc -> HsExpansion (HsExpr GhcRn) (HsExpr GhcTc))
    -> HsExpr GhcTc
    -> XXExprGhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsExpr GhcRn
    -> HsExpr GhcTc -> HsExpansion (HsExpr GhcRn) (HsExpr GhcTc)
    forall a b. a -> b -> HsExpansion a b
    HsExpanded HsExpr GhcRn
    a) (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
          SrcSpan -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    generatedSrcSpan (HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    b ExpRhoType
    t)

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

    tcExpr HsExpr GhcRn
    other ExpRhoType
    _ = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcLExpr" (HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    other)
      -- Include ArrForm, ArrApp, which shouldn't appear at all
      -- Also HsTcBracketOut, HsQuasiQuoteE

    {- *********************************************************************
    *                                                                      *
                 Pragmas on expressions
    *                                                                      *
    ********************************************************************* -}

    tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc
    tcExprPrag :: HsPragE GhcRn -> HsPragE GhcTc
    tcExprPrag (HsPragSCC XSCC GhcRn
    x1 SourceText
    src StringLiteral
    ann) = XSCC GhcTc -> SourceText -> StringLiteral -> HsPragE GhcTc
    forall p. XSCC p -> SourceText -> StringLiteral -> HsPragE p
    HsPragSCC XSCC GhcRn
    XSCC GhcTc
    x1 SourceText
    src StringLiteral
    ann
    tcExprPrag (HsPragTick XTickPragma GhcRn
    x1 SourceText
    src (StringLiteral, (ThLevel, ThLevel), (ThLevel, ThLevel))
    info ((SourceText, SourceText), (SourceText, SourceText))
    srcInfo) = XTickPragma GhcTc
    -> SourceText
    -> (StringLiteral, (ThLevel, ThLevel), (ThLevel, ThLevel))
    -> ((SourceText, SourceText), (SourceText, SourceText))
    -> HsPragE GhcTc
    forall p.
    XTickPragma p
    -> SourceText
    -> (StringLiteral, (ThLevel, ThLevel), (ThLevel, ThLevel))
    -> ((SourceText, SourceText), (SourceText, SourceText))
    -> HsPragE p
    HsPragTick XTickPragma GhcRn
    XTickPragma GhcTc
    x1 SourceText
    src (StringLiteral, (ThLevel, ThLevel), (ThLevel, ThLevel))
    info ((SourceText, SourceText), (SourceText, SourceText))
    srcInfo

    {- *********************************************************************
    *                                                                      *
                 Expression with type signature e::ty
    *                                                                      *
    ********************************************************************* -}

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

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

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

    tcArithSeq :: Maybe (SyntaxExpr GhcRn)
    -> ArithSeqInfo GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcArithSeq Maybe (SyntaxExpr GhcRn)
    witness seq :: ArithSeqInfo GhcRn
    seq@(From LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do { (HsWrapper
    wrap, TcType
    elt_mult, TcType
    elt_ty, Maybe SyntaxExprTc
    wit') <- Maybe (SyntaxExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, TcType, TcType, Maybe (SyntaxExpr GhcTc))
    arithSeqEltType Maybe (SyntaxExpr GhcRn)
    witness ExpRhoType
    res_ty
           ; LHsExpr GhcTc
    expr' <-TcType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    elt_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr TcType
    elt_ty
           ; HsExpr GhcTc
    enum_from <- CtOrigin -> Name -> [TcType] -> TcM (HsExpr GhcTc)
    newMethodFromName (ArithSeqInfo GhcRn -> CtOrigin
    ArithSeqOrigin ArithSeqInfo GhcRn
    seq)
                                  Name
    enumFromName [TcType
    elt_ty]
           ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
    -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap (HsExpr GhcTc -> HsExpr GhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
             XArithSeq GhcTc
    -> Maybe (SyntaxExpr GhcTc) -> ArithSeqInfo GhcTc -> HsExpr GhcTc
    forall p.
    XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
    ArithSeq XArithSeq GhcTc
    HsExpr GhcTc
    enum_from Maybe (SyntaxExpr GhcTc)
    Maybe SyntaxExprTc
    wit' (LHsExpr GhcTc -> ArithSeqInfo GhcTc
    forall id. LHsExpr id -> ArithSeqInfo id
    From LHsExpr GhcTc
    expr') }

    tcArithSeq Maybe (SyntaxExpr GhcRn)
    witness seq :: ArithSeqInfo GhcRn
    seq@(FromThen LHsExpr GhcRn
    expr1 LHsExpr GhcRn
    expr2) ExpRhoType
    res_ty
      = do { (HsWrapper
    wrap, TcType
    elt_mult, TcType
    elt_ty, Maybe SyntaxExprTc
    wit') <- Maybe (SyntaxExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, TcType, TcType, Maybe (SyntaxExpr GhcTc))
    arithSeqEltType Maybe (SyntaxExpr GhcRn)
    witness ExpRhoType
    res_ty
           ; LHsExpr GhcTc
    expr1' <- TcType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    elt_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr1 TcType
    elt_ty
           ; LHsExpr GhcTc
    expr2' <- TcType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    elt_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr2 TcType
    elt_ty
           ; HsExpr GhcTc
    enum_from_then <- CtOrigin -> Name -> [TcType] -> TcM (HsExpr GhcTc)
    newMethodFromName (ArithSeqInfo GhcRn -> CtOrigin
    ArithSeqOrigin ArithSeqInfo GhcRn
    seq)
                                  Name
    enumFromThenName [TcType
    elt_ty]
           ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
    -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap (HsExpr GhcTc -> HsExpr GhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
             XArithSeq GhcTc
    -> Maybe (SyntaxExpr GhcTc) -> ArithSeqInfo GhcTc -> HsExpr GhcTc
    forall p.
    XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
    ArithSeq XArithSeq GhcTc
    HsExpr GhcTc
    enum_from_then Maybe (SyntaxExpr GhcTc)
    Maybe SyntaxExprTc
    wit' (LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
    forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
    FromThen LHsExpr GhcTc
    expr1' LHsExpr GhcTc
    expr2') }

    tcArithSeq Maybe (SyntaxExpr GhcRn)
    witness seq :: ArithSeqInfo GhcRn
    seq@(FromTo LHsExpr GhcRn
    expr1 LHsExpr GhcRn
    expr2) ExpRhoType
    res_ty
      = do { (HsWrapper
    wrap, TcType
    elt_mult, TcType
    elt_ty, Maybe SyntaxExprTc
    wit') <- Maybe (SyntaxExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, TcType, TcType, Maybe (SyntaxExpr GhcTc))
    arithSeqEltType Maybe (SyntaxExpr GhcRn)
    witness ExpRhoType
    res_ty
           ; LHsExpr GhcTc
    expr1' <- TcType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    elt_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr1 TcType
    elt_ty
           ; LHsExpr GhcTc
    expr2' <- TcType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    elt_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr2 TcType
    elt_ty
           ; HsExpr GhcTc
    enum_from_to <- CtOrigin -> Name -> [TcType] -> TcM (HsExpr GhcTc)
    newMethodFromName (ArithSeqInfo GhcRn -> CtOrigin
    ArithSeqOrigin ArithSeqInfo GhcRn
    seq)
                                  Name
    enumFromToName [TcType
    elt_ty]
           ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
    -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap (HsExpr GhcTc -> HsExpr GhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
             XArithSeq GhcTc
    -> Maybe (SyntaxExpr GhcTc) -> ArithSeqInfo GhcTc -> HsExpr GhcTc
    forall p.
    XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
    ArithSeq XArithSeq GhcTc
    HsExpr GhcTc
    enum_from_to Maybe (SyntaxExpr GhcTc)
    Maybe SyntaxExprTc
    wit' (LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
    forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
    FromTo LHsExpr GhcTc
    expr1' LHsExpr GhcTc
    expr2') }

    tcArithSeq Maybe (SyntaxExpr GhcRn)
    witness seq :: ArithSeqInfo GhcRn
    seq@(FromThenTo LHsExpr GhcRn
    expr1 LHsExpr GhcRn
    expr2 LHsExpr GhcRn
    expr3) ExpRhoType
    res_ty
      = do { (HsWrapper
    wrap, TcType
    elt_mult, TcType
    elt_ty, Maybe SyntaxExprTc
    wit') <- Maybe (SyntaxExpr GhcRn)
    -> ExpRhoType
    -> TcM (HsWrapper, TcType, TcType, Maybe (SyntaxExpr GhcTc))
    arithSeqEltType Maybe (SyntaxExpr GhcRn)
    witness ExpRhoType
    res_ty
            ; LHsExpr GhcTc
    expr1' <- TcType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    elt_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr1 TcType
    elt_ty
            ; LHsExpr GhcTc
    expr2' <- TcType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    elt_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr2 TcType
    elt_ty
            ; LHsExpr GhcTc
    expr3' <- TcType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    elt_mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr3 TcType
    elt_ty
            ; HsExpr GhcTc
    eft <- CtOrigin -> Name -> [TcType] -> TcM (HsExpr GhcTc)
    newMethodFromName (ArithSeqInfo GhcRn -> CtOrigin
    ArithSeqOrigin ArithSeqInfo GhcRn
    seq)
                                  Name
    enumFromThenToName [TcType
    elt_ty]
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> TcM (HsExpr GhcTc))
    -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap (HsExpr GhcTc -> HsExpr GhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
              XArithSeq GhcTc
    -> Maybe (SyntaxExpr GhcTc) -> ArithSeqInfo GhcTc -> HsExpr GhcTc
    forall p.
    XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
    ArithSeq XArithSeq GhcTc
    HsExpr GhcTc
    eft Maybe (SyntaxExpr GhcTc)
    Maybe SyntaxExprTc
    wit' (LHsExpr GhcTc
    -> LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
    forall id.
    LHsExpr id -> LHsExpr id -> LHsExpr id -> ArithSeqInfo id
    FromThenTo LHsExpr GhcTc
    expr1' LHsExpr GhcTc
    expr2' LHsExpr GhcTc
    expr3') }

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

    {-
    ************************************************************************
    *                                                                      *
                    Applications
    *                                                                      *
    ************************************************************************
    -}

    {- Note [Typechecking applications]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We typecheck application chains (f e1 @ty e2) specially:

    * So we can report errors like "in the third arument of a call of f"

    * So we can do Visible Type Application (VTA), for which we must not
      eagerly instantiate the function part of the application.

    * So that we can do Quick Look impredicativity.

    The idea is:

    * Use collectHsArgs, which peels off
         HsApp, HsTypeApp, HsPrag, HsPar
      returning the function in the corner and the arguments

    * Use tcInferAppHead to infer the type of the fuction,
        as an (uninstantiated) TcSigmaType
      There are special cases for
         HsVar, HsREcFld, and ExprWithTySig
      Otherwise, delegate back to tcExpr, which
        infers an (instantiated) TcRhoType

    Some cases that /won't/ work:

    1. Consider this (which uses visible type application):

        (let { f :: forall a. a -> a; f x = x } in f) @Int

       Since 'let' is not among the special cases for tcInferAppHead,
       we'll delegate back to tcExpr, which will instantiate f's type
       and the type application to @Int will fail.  Too bad!

    -}

    -- HsExprArg is a very local type, used only within this module.
    -- It's really a zipper for an application chain
    -- It's a GHC-specific type, so using TTG only where necessary
    data HsExprArg id
      = HsEValArg  SrcSpan        -- Of the function
                   (LHsExpr (GhcPass id))
      | HsETypeArg SrcSpan        -- Of the function
                   (LHsWcType (NoGhcTc (GhcPass id)))
                   !(XExprTypeArg id)
      | HsEPrag    SrcSpan
                   (HsPragE (GhcPass id))
      | HsEPar     SrcSpan         -- Of the nested expr
      | HsEWrap    !(XArgWrap id)  -- Wrapper, after typechecking only

    -- The outer location is the location of the application itself
    type LHsExprArgIn  = HsExprArg 'Renamed
    type LHsExprArgOut = HsExprArg 'Typechecked

    instance OutputableBndrId id => Outputable (HsExprArg id) where
      ppr :: HsExprArg id -> SDoc
    ppr (HsEValArg SrcSpan
    _ LHsExpr (GhcPass id)
    tm)       = LHsExpr (GhcPass id) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsExpr (GhcPass id)
    tm
      ppr (HsEPrag SrcSpan
    _ HsPragE (GhcPass id)
    p)          = String -> SDoc
    text String
    "HsPrag" SDoc -> SDoc -> SDoc
    <+> HsPragE (GhcPass id) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsPragE (GhcPass id)
    p
      ppr (HsETypeArg SrcSpan
    _ LHsWcType (NoGhcTc (GhcPass id))
    hs_ty XExprTypeArg id
    _) = Char -> SDoc
    char Char
    '@' SDoc -> SDoc -> SDoc
    <> LHsWcType (GhcPass (NoGhcTcPass id)) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsWcType (GhcPass (NoGhcTcPass id))
    LHsWcType (NoGhcTc (GhcPass id))
    hs_ty
      ppr (HsEPar SrcSpan
    _)             = String -> SDoc
    text String
    "HsEPar"
      ppr (HsEWrap XArgWrap id
    w)             = case forall (p :: Pass). IsPass p => GhcPass p
    ghcPass @id of
                                        GhcPass id
    GhcTc -> String -> SDoc
    text String
    "HsEWrap" SDoc -> SDoc -> SDoc
    <+> HsWrapper -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsWrapper
    XArgWrap id
    w
                                        GhcPass id
    _     -> SDoc
    empty

    type family XExprTypeArg id where
      XExprTypeArg 'Parsed      = NoExtField
      XExprTypeArg 'Renamed     = NoExtField
      XExprTypeArg 'Typechecked = Type

    type family XArgWrap id where
      XArgWrap 'Parsed      = NoExtCon
      XArgWrap 'Renamed     = NoExtCon
      XArgWrap 'Typechecked = HsWrapper

    addArgWrap :: HsWrapper -> [LHsExprArgOut] -> [LHsExprArgOut]
    addArgWrap :: HsWrapper -> [LHsExprArgOut] -> [LHsExprArgOut]
    addArgWrap HsWrapper
    wrap [LHsExprArgOut]
    args
     | HsWrapper -> Bool
    isIdHsWrapper HsWrapper
    wrap = [LHsExprArgOut]
    args
     | Bool
    otherwise          = XArgWrap 'Typechecked -> LHsExprArgOut
    forall (id :: Pass). XArgWrap id -> HsExprArg id
    HsEWrap HsWrapper
    XArgWrap 'Typechecked
    wrap LHsExprArgOut -> [LHsExprArgOut] -> [LHsExprArgOut]
    forall a. a -> [a] -> [a]
    : [LHsExprArgOut]
    args

    collectHsArgs :: HsExpr GhcRn -> (HsExpr GhcRn, [LHsExprArgIn])
    collectHsArgs :: HsExpr GhcRn -> (HsExpr GhcRn, [LHsExprArgIn])
    collectHsArgs HsExpr GhcRn
    e = HsExpr GhcRn -> [LHsExprArgIn] -> (HsExpr GhcRn, [LHsExprArgIn])
    forall {id :: Pass}.
    (XExprTypeArg id ~ NoExtField) =>
    HsExpr (GhcPass id)
    -> [HsExprArg id] -> (HsExpr (GhcPass id), [HsExprArg id])
    go HsExpr GhcRn
    e []
      where
        go :: HsExpr (GhcPass id)
    -> [HsExprArg id] -> (HsExpr (GhcPass id), [HsExprArg id])
    go (HsPar XPar (GhcPass id)
    _     (L SrcSpan
    l HsExpr (GhcPass id)
    fun))       [HsExprArg id]
    args = HsExpr (GhcPass id)
    -> [HsExprArg id] -> (HsExpr (GhcPass id), [HsExprArg id])
    go HsExpr (GhcPass id)
    fun (SrcSpan -> HsExprArg id
    forall (id :: Pass). SrcSpan -> HsExprArg id
    HsEPar SrcSpan
    l HsExprArg id -> [HsExprArg id] -> [HsExprArg id]
    forall a. a -> [a] -> [a]
    : [HsExprArg id]
    args)
        go (HsPragE XPragE (GhcPass id)
    _ HsPragE (GhcPass id)
    p (L SrcSpan
    l HsExpr (GhcPass id)
    fun))       [HsExprArg id]
    args = HsExpr (GhcPass id)
    -> [HsExprArg id] -> (HsExpr (GhcPass id), [HsExprArg id])
    go HsExpr (GhcPass id)
    fun (SrcSpan -> HsPragE (GhcPass id) -> HsExprArg id
    forall (id :: Pass).
    SrcSpan -> HsPragE (GhcPass id) -> HsExprArg id
    HsEPrag SrcSpan
    l HsPragE (GhcPass id)
    p HsExprArg id -> [HsExprArg id] -> [HsExprArg id]
    forall a. a -> [a] -> [a]
    : [HsExprArg id]
    args)
        go (HsApp XApp (GhcPass id)
    _     (L SrcSpan
    l HsExpr (GhcPass id)
    fun) GenLocated SrcSpan (HsExpr (GhcPass id))
    arg)   [HsExprArg id]
    args = HsExpr (GhcPass id)
    -> [HsExprArg id] -> (HsExpr (GhcPass id), [HsExprArg id])
    go HsExpr (GhcPass id)
    fun (SrcSpan -> GenLocated SrcSpan (HsExpr (GhcPass id)) -> HsExprArg id
    forall (id :: Pass).
    SrcSpan -> LHsExpr (GhcPass id) -> HsExprArg id
    HsEValArg SrcSpan
    l GenLocated SrcSpan (HsExpr (GhcPass id))
    arg HsExprArg id -> [HsExprArg id] -> [HsExprArg id]
    forall a. a -> [a] -> [a]
    : [HsExprArg id]
    args)
        go (HsAppType XAppTypeE (GhcPass id)
    _ (L SrcSpan
    l HsExpr (GhcPass id)
    fun) LHsWcType (NoGhcTc (GhcPass id))
    hs_ty) [HsExprArg id]
    args = HsExpr (GhcPass id)
    -> [HsExprArg id] -> (HsExpr (GhcPass id), [HsExprArg id])
    go HsExpr (GhcPass id)
    fun (SrcSpan
    -> LHsWcType (NoGhcTc (GhcPass id))
    -> XExprTypeArg id
    -> HsExprArg id
    forall (id :: Pass).
    SrcSpan
    -> LHsWcType (NoGhcTc (GhcPass id))
    -> XExprTypeArg id
    -> HsExprArg id
    HsETypeArg SrcSpan
    l LHsWcType (NoGhcTc (GhcPass id))
    hs_ty NoExtField
    XExprTypeArg id
    noExtField HsExprArg id -> [HsExprArg id] -> [HsExprArg id]
    forall a. a -> [a] -> [a]
    : [HsExprArg id]
    args)
        go HsExpr (GhcPass id)
    e                             [HsExprArg id]
    args = (HsExpr (GhcPass id)
    e,[HsExprArg id]
    args)

    applyHsArgs :: HsExpr GhcTc -> [LHsExprArgOut]-> HsExpr GhcTc
    applyHsArgs :: HsExpr GhcTc -> [LHsExprArgOut] -> HsExpr GhcTc
    applyHsArgs HsExpr GhcTc
    fun [LHsExprArgOut]
    args
      = HsExpr GhcTc -> [LHsExprArgOut] -> HsExpr GhcTc
    go HsExpr GhcTc
    fun [LHsExprArgOut]
    args
      where
        go :: HsExpr GhcTc -> [LHsExprArgOut] -> HsExpr GhcTc
    go HsExpr GhcTc
    fun [] = HsExpr GhcTc
    fun
        go HsExpr GhcTc
    fun (HsEWrap XArgWrap 'Typechecked
    wrap : [LHsExprArgOut]
    args)          = HsExpr GhcTc -> [LHsExprArgOut] -> HsExpr GhcTc
    go (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    XArgWrap 'Typechecked
    wrap HsExpr GhcTc
    fun) [LHsExprArgOut]
    args
        go HsExpr GhcTc
    fun (HsEValArg SrcSpan
    l LHsExpr GhcTc
    arg : [LHsExprArgOut]
    args)       = HsExpr GhcTc -> [LHsExprArgOut] -> HsExpr GhcTc
    go (XApp GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
    HsApp NoExtField
    XApp GhcTc
    noExtField (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsExpr GhcTc
    fun) LHsExpr GhcTc
    arg) [LHsExprArgOut]
    args
        go HsExpr GhcTc
    fun (HsETypeArg SrcSpan
    l LHsWcType (NoGhcTc GhcTc)
    hs_ty XExprTypeArg 'Typechecked
    ty : [LHsExprArgOut]
    args) = HsExpr GhcTc -> [LHsExprArgOut] -> HsExpr GhcTc
    go (XAppTypeE GhcTc
    -> LHsExpr GhcTc -> LHsWcType (NoGhcTc GhcTc) -> HsExpr GhcTc
    forall p.
    XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
    HsAppType XAppTypeE GhcTc
    XExprTypeArg 'Typechecked
    ty (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsExpr GhcTc
    fun) LHsWcType (NoGhcTc GhcTc)
    hs_ty) [LHsExprArgOut]
    args
        go HsExpr GhcTc
    fun (HsEPar SrcSpan
    l : [LHsExprArgOut]
    args)              = HsExpr GhcTc -> [LHsExprArgOut] -> HsExpr GhcTc
    go (XPar GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XPar p -> LHsExpr p -> HsExpr p
    HsPar NoExtField
    XPar GhcTc
    noExtField (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsExpr GhcTc
    fun)) [LHsExprArgOut]
    args
        go HsExpr GhcTc
    fun (HsEPrag SrcSpan
    l HsPragE GhcTc
    p : [LHsExprArgOut]
    args)           = HsExpr GhcTc -> [LHsExprArgOut] -> HsExpr GhcTc
    go (XPragE GhcTc -> HsPragE GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XPragE p -> HsPragE p -> LHsExpr p -> HsExpr p
    HsPragE NoExtField
    XPragE GhcTc
    noExtField HsPragE GhcTc
    p (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsExpr GhcTc
    fun)) [LHsExprArgOut]
    args

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

    isArgPar :: HsExprArg id -> Bool
    isArgPar :: forall (id :: Pass). HsExprArg id -> Bool
    isArgPar (HsEPar {}) = Bool
    True
    isArgPar HsExprArg id
    _           = Bool
    False

    getFunLoc :: [HsExprArg 'Renamed] -> Maybe SrcSpan
    getFunLoc :: [LHsExprArgIn] -> Maybe SrcSpan
    getFunLoc []    = Maybe SrcSpan
    forall a. Maybe a
    Nothing
    getFunLoc (LHsExprArgIn
    a:[LHsExprArgIn]
    _) = SrcSpan -> Maybe SrcSpan
    forall a. a -> Maybe a
    Just (SrcSpan -> Maybe SrcSpan) -> SrcSpan -> Maybe SrcSpan
    forall a b. (a -> b) -> a -> b
    $ case LHsExprArgIn
    a of
                               HsEValArg SrcSpan
    l LHsExpr GhcRn
    _    -> SrcSpan
    l
                               HsETypeArg SrcSpan
    l LHsWcType (NoGhcTc GhcRn)
    _ XExprTypeArg 'Renamed
    _ -> SrcSpan
    l
                               HsEPrag SrcSpan
    l HsPragE GhcRn
    _      -> SrcSpan
    l
                               HsEPar SrcSpan
    l         -> SrcSpan
    l

    ---------------------------
    tcApp :: HsExpr GhcRn  -- either HsApp or HsAppType
           -> ExpRhoType -> TcM (HsExpr GhcTc)
    -- See Note [Typechecking applications]
    tcApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp HsExpr GhcRn
    expr ExpRhoType
    res_ty
      = do { (HsExpr GhcTc
    fun, [LHsExprArgOut]
    args, TcType
    app_res_ty) <- HsExpr GhcRn -> TcM (HsExpr GhcTc, [LHsExprArgOut], TcType)
    tcInferApp HsExpr GhcRn
    expr
           ; if HsExpr GhcTc -> Bool
    isTagToEnum HsExpr GhcTc
    fun
             then HsExpr GhcRn
    -> HsExpr GhcTc
    -> [LHsExprArgOut]
    -> TcType
    -> ExpRhoType
    -> TcM (HsExpr GhcTc)
    tcTagToEnum HsExpr GhcRn
    expr HsExpr GhcTc
    fun [LHsExprArgOut]
    args TcType
    app_res_ty ExpRhoType
    res_ty
                  -- Done here because we have res_ty,
                  -- whereas tcInferApp does not
             else

        -- The wildly common case
        do { let expr' :: HsExpr GhcTc
    expr' = HsExpr GhcTc -> [LHsExprArgOut] -> HsExpr GhcTc
    applyHsArgs HsExpr GhcTc
    fun [LHsExprArgOut]
    args
           ; Bool
    -> HsExpr GhcTc
    -> TcType
    -> ExpRhoType
    -> TcM (HsExpr GhcTc)
    -> TcM (HsExpr GhcTc)
    forall a.
    Bool -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM a -> TcM a
    addFunResCtxt Bool
    True HsExpr GhcTc
    fun TcType
    app_res_ty ExpRhoType
    res_ty (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
             HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResult HsExpr GhcRn
    expr HsExpr GhcTc
    expr' TcType
    app_res_ty ExpRhoType
    res_ty } }

    ---------------------------
    tcInferApp :: HsExpr GhcRn
               -> TcM ( HsExpr GhcTc    -- Function
                      , [LHsExprArgOut]  -- Arguments
                      , TcSigmaType)     -- Inferred type: a sigma-type!
    -- Also used by Module.tcRnExpr to implement GHCi :type
    tcInferApp :: HsExpr GhcRn -> TcM (HsExpr GhcTc, [LHsExprArgOut], TcType)
    tcInferApp HsExpr GhcRn
    expr
      | -- Gruesome special case for ambiguous record selectors
        HsRecFld XRecFld GhcRn
    _ AmbiguousFieldOcc GhcRn
    fld_lbl        <- HsExpr GhcRn
    fun
      , Ambiguous XAmbiguous GhcRn
    _ Located RdrName
    lbl           <- AmbiguousFieldOcc GhcRn
    fld_lbl  -- Still ambiguous
      , HsEValArg SrcSpan
    _ (L SrcSpan
    _ HsExpr GhcRn
    arg) : [LHsExprArgIn]
    _ <- (LHsExprArgIn -> Bool) -> [LHsExprArgIn] -> [LHsExprArgIn]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut LHsExprArgIn -> Bool
    forall (id :: Pass). HsExprArg id -> Bool
    isArgPar [LHsExprArgIn]
    args -- A value arg is first
      , Just LHsSigWcType GhcRn
    sig_ty               <- HsExpr GhcRn -> Maybe (LHsSigWcType GhcRn)
    obviousSig HsExpr GhcRn
    arg  -- A type sig on the arg disambiguates
      = do { TcType
    sig_tc_ty <- UserTypeCtxt -> LHsSigWcType GhcRn -> TcM TcType
    tcHsSigWcType UserTypeCtxt
    ExprSigCtxt LHsSigWcType GhcRn
    sig_ty
           ; Name
    sel_name  <- Located RdrName -> TcType -> TcM Name
    disambiguateSelector Located RdrName
    lbl TcType
    sig_tc_ty
           ; (HsExpr GhcTc
    tc_fun, TcType
    fun_ty) <- AmbiguousFieldOcc GhcRn -> TcM (HsExpr GhcTc, TcType)
    tcInferRecSelId (XUnambiguous GhcRn -> Located RdrName -> AmbiguousFieldOcc GhcRn
    forall pass.
    XUnambiguous pass -> Located RdrName -> AmbiguousFieldOcc pass
    Unambiguous Name
    XUnambiguous GhcRn
    sel_name Located RdrName
    lbl)
           ; HsExpr GhcRn
    -> HsExpr GhcTc
    -> TcType
    -> [LHsExprArgIn]
    -> TcM (HsExpr GhcTc, [LHsExprArgOut], TcType)
    tcInferApp_finish HsExpr GhcRn
    fun HsExpr GhcTc
    tc_fun TcType
    fun_ty [LHsExprArgIn]
    args }

      | Bool
    otherwise  -- The wildly common case
      = do { (HsExpr GhcTc
    tc_fun, TcType
    fun_ty) <- TcM (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType)
    set_fun_loc (HsExpr GhcRn -> TcM (HsExpr GhcTc, TcType)
    tcInferAppHead HsExpr GhcRn
    fun)
           ; HsExpr GhcRn
    -> HsExpr GhcTc
    -> TcType
    -> [LHsExprArgIn]
    -> TcM (HsExpr GhcTc, [LHsExprArgOut], TcType)
    tcInferApp_finish HsExpr GhcRn
    fun HsExpr GhcTc
    tc_fun TcType
    fun_ty [LHsExprArgIn]
    args }
      where
        (HsExpr GhcRn
    fun, [LHsExprArgIn]
    args) = HsExpr GhcRn -> (HsExpr GhcRn, [LHsExprArgIn])
    collectHsArgs HsExpr GhcRn
    expr
        set_fun_loc :: TcM (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType)
    set_fun_loc TcM (HsExpr GhcTc, TcType)
    thing_inside
          = case [LHsExprArgIn] -> Maybe SrcSpan
    getFunLoc [LHsExprArgIn]
    args of
              Maybe SrcSpan
    Nothing  -> TcM (HsExpr GhcTc, TcType)
    thing_inside  -- Don't set the location twice
              Just SrcSpan
    loc -> SrcSpan -> TcM (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc TcM (HsExpr GhcTc, TcType)
    thing_inside

    tcInferApp_finish
        :: HsExpr GhcRn                 -- Renamed function
        -> HsExpr GhcTc -> TcSigmaType  -- Function and its type
        -> [LHsExprArgIn]               -- Arguments
        -> TcM (HsExpr GhcTc, [LHsExprArgOut], TcSigmaType)
    tcInferApp_finish :: HsExpr GhcRn
    -> HsExpr GhcTc
    -> TcType
    -> [LHsExprArgIn]
    -> TcM (HsExpr GhcTc, [LHsExprArgOut], TcType)
    tcInferApp_finish HsExpr GhcRn
    rn_fun HsExpr GhcTc
    tc_fun TcType
    fun_sigma [LHsExprArgIn]
    rn_args
      = do { ([LHsExprArgOut]
    tc_args, TcType
    actual_res_ty) <- HsExpr GhcRn
    -> TcType -> [LHsExprArgIn] -> TcM ([LHsExprArgOut], TcType)
    tcArgs HsExpr GhcRn
    rn_fun TcType
    fun_sigma [LHsExprArgIn]
    rn_args
           ; (HsExpr GhcTc, [LHsExprArgOut], TcType)
    -> TcM (HsExpr GhcTc, [LHsExprArgOut], TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc
    tc_fun, [LHsExprArgOut]
    tc_args, TcType
    actual_res_ty) }

    mk_op_msg :: LHsExpr GhcRn -> SDoc
    mk_op_msg :: LHsExpr GhcRn -> SDoc
    mk_op_msg LHsExpr GhcRn
    op = String -> SDoc
    text String
    "The operator" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (LHsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsExpr GhcRn
    op) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "takes"

    ----------------
    tcInferAppHead :: HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
    -- Infer type of the head of an application, returning a /SigmaType/
    --   i.e. the 'f' in (f e1 ... en)
    -- We get back a SigmaType because we have special cases for
    --   * A bare identifier (just look it up)
    --     This case also covers a record selectro HsRecFld
    --   * An expression with a type signature (e :: ty)
    --
    -- 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 collectHsArgs.
    --
    -- See Note [Typechecking applications]
    tcInferAppHead :: HsExpr GhcRn -> TcM (HsExpr GhcTc, TcType)
    tcInferAppHead HsExpr GhcRn
    e
      = case HsExpr GhcRn
    e of
          HsVar XVar GhcRn
    _ (L SrcSpan
    _ IdP GhcRn
    nm)        -> Name -> TcM (HsExpr GhcTc, TcType)
    tcInferId Name
    IdP GhcRn
    nm
          HsRecFld XRecFld GhcRn
    _ AmbiguousFieldOcc GhcRn
    f            -> AmbiguousFieldOcc GhcRn -> TcM (HsExpr GhcTc, TcType)
    tcInferRecSelId AmbiguousFieldOcc GhcRn
    f
          ExprWithTySig XExprWithTySig GhcRn
    _ LHsExpr GhcRn
    e LHsSigWcType (NoGhcTc GhcRn)
    hs_ty -> TcM (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType)
    add_ctxt (TcM (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType))
    -> TcM (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn
    -> LHsSigWcType (NoGhcTc GhcRn) -> TcM (HsExpr GhcTc, TcType)
    tcExprWithSig LHsExpr GhcRn
    e LHsSigWcType (NoGhcTc GhcRn)
    hs_ty
          HsExpr GhcRn
    _                       -> TcM (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType)
    add_ctxt (TcM (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType))
    -> TcM (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType)
    forall a b. (a -> b) -> a -> b
    $ (ExpRhoType -> TcM (HsExpr GhcTc)) -> TcM (HsExpr GhcTc, TcType)
    forall a. (ExpRhoType -> TcM a) -> TcM (a, TcType)
    tcInfer (HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    e)
      where
        add_ctxt :: TcM (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType)
    add_ctxt TcM (HsExpr GhcTc, TcType)
    thing = SDoc -> TcM (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (HsExpr GhcRn -> SDoc
    exprCtxt HsExpr GhcRn
    e) TcM (HsExpr GhcTc, TcType)
    thing

    ----------------
    -- | Type-check the arguments to a function, possibly including visible type
    -- applications
    tcArgs :: HsExpr GhcRn   -- ^ The function itself (for err msgs only)
           -> TcSigmaType    -- ^ the (uninstantiated) type of the function
           -> [LHsExprArgIn] -- ^ the args
           -> TcM ([LHsExprArgOut], TcSigmaType)
              -- ^ (a wrapper for the function, the tc'd args, result type)
    tcArgs :: HsExpr GhcRn
    -> TcType -> [LHsExprArgIn] -> TcM ([LHsExprArgOut], TcType)
    tcArgs HsExpr GhcRn
    fun TcType
    orig_fun_ty [LHsExprArgIn]
    orig_args
      = ThLevel
    -> [Scaled TcType]
    -> TcType
    -> [LHsExprArgIn]
    -> TcM ([LHsExprArgOut], TcType)
    go ThLevel
    1 [] TcType
    orig_fun_ty [LHsExprArgIn]
    orig_args
      where
        fun_orig :: CtOrigin
    fun_orig = HsExpr GhcRn -> CtOrigin
    exprCtOrigin HsExpr GhcRn
    fun
        herald :: SDoc
    herald = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "The function" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    fun)
                     , String -> SDoc
    text String
    "is applied to"]

        -- Count value args only when complaining about a function
        -- applied to too many value args
        -- See Note [Herald for matchExpectedFunTys] in GHC.Tc.Utils.Unify.
        n_val_args :: ThLevel
    n_val_args = (LHsExprArgIn -> Bool) -> [LHsExprArgIn] -> ThLevel
    forall a. (a -> Bool) -> [a] -> ThLevel
    count LHsExprArgIn -> Bool
    forall (id :: Pass). HsExprArg id -> Bool
    isHsValArg [LHsExprArgIn]
    orig_args

        fun_is_out_of_scope :: Bool
    fun_is_out_of_scope  -- See Note [VTA for out-of-scope functions]
          = case HsExpr GhcRn
    fun of
              HsUnboundVar {} -> Bool
    True
              HsExpr GhcRn
    _               -> Bool
    False

        go :: Int           -- Which argment number this is (incl type args)
           -> [Scaled TcSigmaType] -- Value args to which applied so far
           -> TcSigmaType
           -> [LHsExprArgIn] -> TcM ([LHsExprArgOut], TcSigmaType)
        go :: ThLevel
    -> [Scaled TcType]
    -> TcType
    -> [LHsExprArgIn]
    -> TcM ([LHsExprArgOut], TcType)
    go ThLevel
    _ [Scaled TcType]
    _ TcType
    fun_ty [] = String -> SDoc -> TcRn ()
    traceTc String
    "tcArgs:ret" (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    fun_ty) TcRn ()
    -> TcM ([LHsExprArgOut], TcType) -> TcM ([LHsExprArgOut], TcType)
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> ([LHsExprArgOut], TcType) -> TcM ([LHsExprArgOut], TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], TcType
    fun_ty)

        go ThLevel
    n [Scaled TcType]
    so_far TcType
    fun_ty (HsEPar SrcSpan
    sp : [LHsExprArgIn]
    args)
          = do { ([LHsExprArgOut]
    args', TcType
    res_ty) <- ThLevel
    -> [Scaled TcType]
    -> TcType
    -> [LHsExprArgIn]
    -> TcM ([LHsExprArgOut], TcType)
    go ThLevel
    n [Scaled TcType]
    so_far TcType
    fun_ty [LHsExprArgIn]
    args
               ; ([LHsExprArgOut], TcType) -> TcM ([LHsExprArgOut], TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> LHsExprArgOut
    forall (id :: Pass). SrcSpan -> HsExprArg id
    HsEPar SrcSpan
    sp LHsExprArgOut -> [LHsExprArgOut] -> [LHsExprArgOut]
    forall a. a -> [a] -> [a]
    : [LHsExprArgOut]
    args', TcType
    res_ty) }

        go ThLevel
    n [Scaled TcType]
    so_far TcType
    fun_ty (HsEPrag SrcSpan
    sp HsPragE GhcRn
    prag : [LHsExprArgIn]
    args)
          = do { ([LHsExprArgOut]
    args', TcType
    res_ty) <- ThLevel
    -> [Scaled TcType]
    -> TcType
    -> [LHsExprArgIn]
    -> TcM ([LHsExprArgOut], TcType)
    go ThLevel
    n [Scaled TcType]
    so_far TcType
    fun_ty [LHsExprArgIn]
    args
               ; ([LHsExprArgOut], TcType) -> TcM ([LHsExprArgOut], TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> HsPragE GhcTc -> LHsExprArgOut
    forall (id :: Pass).
    SrcSpan -> HsPragE (GhcPass id) -> HsExprArg id
    HsEPrag SrcSpan
    sp (HsPragE GhcRn -> HsPragE GhcTc
    tcExprPrag HsPragE GhcRn
    prag) LHsExprArgOut -> [LHsExprArgOut] -> [LHsExprArgOut]
    forall a. a -> [a] -> [a]
    : [LHsExprArgOut]
    args', TcType
    res_ty) }

        go ThLevel
    n [Scaled TcType]
    so_far TcType
    fun_ty (HsETypeArg SrcSpan
    loc LHsWcType (NoGhcTc GhcRn)
    hs_ty_arg XExprTypeArg 'Renamed
    _ : [LHsExprArgIn]
    args)
          | Bool
    fun_is_out_of_scope   -- See Note [VTA for out-of-scope functions]
          = ThLevel
    -> [Scaled TcType]
    -> TcType
    -> [LHsExprArgIn]
    -> TcM ([LHsExprArgOut], TcType)
    go (ThLevel
    nThLevel -> ThLevel -> ThLevel
    forall a. Num a => a -> a -> a
    +ThLevel
    1) [Scaled TcType]
    so_far TcType
    fun_ty [LHsExprArgIn]
    args

          | Bool
    otherwise
          = do { (HsWrapper
    wrap1, TcType
    upsilon_ty) <- CtOrigin -> TcType -> TcM (HsWrapper, TcType)
    topInstantiateInferred CtOrigin
    fun_orig TcType
    fun_ty
                   -- wrap1 :: fun_ty "->" upsilon_ty
               ; case TcType -> Maybe (TyVarBinder, TcType)
    tcSplitForAllTy_maybe TcType
    upsilon_ty of
                   Just (TyVarBinder
    tvb, TcType
    inner_ty)
                     | TyVarBinder -> ArgFlag
    forall tv argf. VarBndr tv argf -> argf
    binderArgFlag TyVarBinder
    tvb ArgFlag -> ArgFlag -> Bool
    forall a. Eq a => a -> a -> Bool
    == ArgFlag
    Specified ->
                       -- It really can't be Inferred, because we've justn
                       -- instantiated those. But, oddly, it might just be Required.
                       -- See Note [Required quantifiers in the type of a term]
                     do { let tv :: Var
    tv   = TyVarBinder -> Var
    forall tv argf. VarBndr tv argf -> tv
    binderVar TyVarBinder
    tvb
                              kind :: TcType
    kind = Var -> TcType
    tyVarKind Var
    tv
                        ; TcType
    ty_arg <- LHsWcType GhcRn -> TcType -> TcM TcType
    tcHsTypeApp LHsWcType GhcRn
    LHsWcType (NoGhcTc GhcRn)
    hs_ty_arg TcType
    kind

                        ; TcType
    inner_ty <- TcType -> TcM TcType
    zonkTcType TcType
    inner_ty
                              -- See Note [Visible type application zonk]
                        ; let in_scope :: InScopeSet
    in_scope  = VarSet -> InScopeSet
    mkInScopeSet ([TcType] -> VarSet
    tyCoVarsOfTypes [TcType
    upsilon_ty, TcType
    ty_arg])
                              insted_ty :: TcType
    insted_ty = InScopeSet -> [Var] -> [TcType] -> TcType -> TcType
    substTyWithInScope InScopeSet
    in_scope [Var
    tv] [TcType
    ty_arg] TcType
    inner_ty
                                          -- NB: tv and ty_arg have the same kind, so this
                                          --     substitution is kind-respecting
                        ; String -> SDoc -> TcRn ()
    traceTc String
    "VTA" ([SDoc] -> SDoc
    vcat [Var -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Var
    tv, TcType -> SDoc
    debugPprType TcType
    kind
                                              , TcType -> SDoc
    debugPprType TcType
    ty_arg
                                              , TcType -> SDoc
    debugPprType (HasDebugCallStack => TcType -> TcType
    TcType -> TcType
    tcTypeKind TcType
    ty_arg)
                                              , TcType -> SDoc
    debugPprType TcType
    inner_ty
                                              , TcType -> SDoc
    debugPprType TcType
    insted_ty ])

                        ; ([LHsExprArgOut]
    args', TcType
    res_ty) <- ThLevel
    -> [Scaled TcType]
    -> TcType
    -> [LHsExprArgIn]
    -> TcM ([LHsExprArgOut], TcType)
    go (ThLevel
    nThLevel -> ThLevel -> ThLevel
    forall a. Num a => a -> a -> a
    +ThLevel
    1) [Scaled TcType]
    so_far TcType
    insted_ty [LHsExprArgIn]
    args
                        ; ([LHsExprArgOut], TcType) -> TcM ([LHsExprArgOut], TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( HsWrapper -> [LHsExprArgOut] -> [LHsExprArgOut]
    addArgWrap HsWrapper
    wrap1 ([LHsExprArgOut] -> [LHsExprArgOut])
    -> [LHsExprArgOut] -> [LHsExprArgOut]
    forall a b. (a -> b) -> a -> b
    $ SrcSpan
    -> LHsWcType (NoGhcTc GhcTc)
    -> XExprTypeArg 'Typechecked
    -> LHsExprArgOut
    forall (id :: Pass).
    SrcSpan
    -> LHsWcType (NoGhcTc (GhcPass id))
    -> XExprTypeArg id
    -> HsExprArg id
    HsETypeArg SrcSpan
    loc LHsWcType (NoGhcTc GhcRn)
    LHsWcType (NoGhcTc GhcTc)
    hs_ty_arg TcType
    XExprTypeArg 'Typechecked
    ty_arg LHsExprArgOut -> [LHsExprArgOut] -> [LHsExprArgOut]
    forall a. a -> [a] -> [a]
    : [LHsExprArgOut]
    args'
                                 , TcType
    res_ty ) }
                   Maybe (TyVarBinder, TcType)
    _ -> TcType -> LHsWcType GhcRn -> TcM ([LHsExprArgOut], TcType)
    forall {a} {b}.
    Outputable a =>
    TcType -> a -> IOEnv (Env TcGblEnv TcLclEnv) b
    ty_app_err TcType
    upsilon_ty LHsWcType GhcRn
    LHsWcType (NoGhcTc GhcRn)
    hs_ty_arg }

        go ThLevel
    n [Scaled TcType]
    so_far TcType
    fun_ty (HsEValArg SrcSpan
    loc LHsExpr GhcRn
    arg : [LHsExprArgIn]
    args)
          = do { (HsWrapper
    wrap, Scaled TcType
    arg_ty, TcType
    res_ty)
                   <- SDoc
    -> CtOrigin
    -> Maybe (HsExpr GhcRn)
    -> (ThLevel, [Scaled TcType])
    -> TcType
    -> TcM (HsWrapper, Scaled TcType, TcType)
    matchActualFunTySigma SDoc
    herald CtOrigin
    fun_orig (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
    forall a. a -> Maybe a
    Just HsExpr GhcRn
    fun)
                                            (ThLevel
    n_val_args, [Scaled TcType]
    so_far) TcType
    fun_ty
               ; LHsExpr GhcTc
    arg' <- HsExpr GhcRn
    -> LHsExpr GhcRn -> Scaled TcType -> ThLevel -> TcM (LHsExpr GhcTc)
    tcArg HsExpr GhcRn
    fun LHsExpr GhcRn
    arg Scaled TcType
    arg_ty ThLevel
    n
               ; ([LHsExprArgOut]
    args', TcType
    inner_res_ty) <- ThLevel
    -> [Scaled TcType]
    -> TcType
    -> [LHsExprArgIn]
    -> TcM ([LHsExprArgOut], TcType)
    go (ThLevel
    nThLevel -> ThLevel -> ThLevel
    forall a. Num a => a -> a -> a
    +ThLevel
    1) (Scaled TcType
    arg_tyScaled TcType -> [Scaled TcType] -> [Scaled TcType]
    forall a. a -> [a] -> [a]
    :[Scaled TcType]
    so_far) TcType
    res_ty [LHsExprArgIn]
    args
               ; ([LHsExprArgOut], TcType) -> TcM ([LHsExprArgOut], TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( HsWrapper -> [LHsExprArgOut] -> [LHsExprArgOut]
    addArgWrap HsWrapper
    wrap ([LHsExprArgOut] -> [LHsExprArgOut])
    -> [LHsExprArgOut] -> [LHsExprArgOut]
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> LHsExpr GhcTc -> LHsExprArgOut
    forall (id :: Pass).
    SrcSpan -> LHsExpr (GhcPass id) -> HsExprArg id
    HsEValArg SrcSpan
    loc LHsExpr GhcTc
    arg' LHsExprArgOut -> [LHsExprArgOut] -> [LHsExprArgOut]
    forall a. a -> [a] -> [a]
    : [LHsExprArgOut]
    args'
                        , TcType
    inner_res_ty ) }

        ty_app_err :: TcType -> a -> IOEnv (Env TcGblEnv TcLclEnv) b
    ty_app_err TcType
    ty a
    arg
          = do { (TidyEnv
    _, TcType
    ty) <- TidyEnv -> TcType -> TcM (TidyEnv, TcType)
    zonkTidyTcType TidyEnv
    emptyTidyEnv TcType
    ty
               ; SDoc -> IOEnv (Env TcGblEnv TcLclEnv) b
    forall a. SDoc -> TcRn a
    failWith (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) b)
    -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) b
    forall a b. (a -> b) -> a -> b
    $
                   String -> SDoc
    text String
    "Cannot apply expression of type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    ty) SDoc -> SDoc -> SDoc
    $$
                   String -> SDoc
    text String
    "to a visible type argument" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    arg) }

    {- Note [Required quantifiers in the type of a term]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider (#15859)

      data A k :: k -> Type      -- A      :: forall k -> k -> Type
      type KindOf (a :: k) = k   -- KindOf :: forall k. k -> Type
      a = (undefind :: KindOf A) @Int

    With ImpredicativeTypes (thin ice, I know), we instantiate
    KindOf at type (forall k -> k -> Type), so
      KindOf A = forall k -> k -> Type
    whose first argument is Required

    We want to reject this type application to Int, but in earlier
    GHCs we had an ASSERT that Required could not occur here.

    The ice is thin; c.f. Note [No Required TyCoBinder in terms]
    in GHC.Core.TyCo.Rep.

    Note [VTA for out-of-scope functions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose 'wurble' is not in scope, and we have
       (wurble @Int @Bool True 'x')

    Then the renamer will make (HsUnboundVar "wurble) for 'wurble',
    and the typechecker will typecheck it with tcUnboundId, giving it
    a type 'alpha', and emitting a deferred Hole, to be reported later.

    But then comes the visible type application. If we do nothing, we'll
    generate an immediate failure (in tc_app_err), saying that a function
    of type 'alpha' can't be applied to Bool.  That's insane!  And indeed
    users complain bitterly (#13834, #17150.)

    The right error is the Hole, which has /already/ been emitted by
    tcUnboundId.  It later reports 'wurble' as out of scope, and tries to
    give its type.

    Fortunately in tcArgs we still have access to the function, so we can
    check if it is a HsUnboundVar.  We use this info to simply skip over
    any visible type arguments.  We've already inferred the type of the
    function, so we'll /already/ have emitted a Hole;
    failing preserves that constraint.

    We do /not/ want to fail altogether in this case (via failM) becuase
    that may abandon an entire instance decl, which (in the presence of
    -fdefer-type-errors) leads to leading to #17792.

    Downside; the typechecked term has lost its visible type arguments; we
    don't even kind-check them.  But let's jump that bridge if we come to
    it.  Meanwhile, let's not crash!

    Note [Visible type application zonk]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    * Substitutions should be kind-preserving, so we need kind(tv) = kind(ty_arg).

    * tcHsTypeApp only guarantees that
        - ty_arg is zonked
        - kind(zonk(tv)) = kind(ty_arg)
      (checkExpectedKind zonks as it goes).

    So we must zonk inner_ty as well, to guarantee consistency between zonk(tv)
    and inner_ty.  Otherwise we can build an ill-kinded type.  An example was
    #14158, where we had:
       id :: forall k. forall (cat :: k -> k -> *). forall (a :: k). cat a a
    and we had the visible type application
      id @(->)

    * We instantiated k := kappa, yielding
        forall (cat :: kappa -> kappa -> *). forall (a :: kappa). cat a a
    * Then we called tcHsTypeApp (->) with expected kind (kappa -> kappa -> *).
    * That instantiated (->) as ((->) q1 q1), and unified kappa := q1,
      Here q1 :: RuntimeRep
    * Now we substitute
         cat  :->  (->) q1 q1 :: TYPE q1 -> TYPE q1 -> *
      but we must first zonk the inner_ty to get
          forall (a :: TYPE q1). cat a a
      so that the result of substitution is well-kinded
      Failing to do so led to #14158.
    -}

    ----------------
    tcArg :: HsExpr GhcRn                   -- The function (for error messages)
          -> LHsExpr GhcRn                   -- Actual arguments
          -> Scaled TcSigmaType              -- expected arg type
          -> Int                             -- # of argument
          -> TcM (LHsExpr GhcTc)           -- Resulting argument
    tcArg :: HsExpr GhcRn
    -> LHsExpr GhcRn -> Scaled TcType -> ThLevel -> TcM (LHsExpr GhcTc)
    tcArg HsExpr GhcRn
    fun LHsExpr GhcRn
    arg (Scaled TcType
    mult TcType
    ty) ThLevel
    arg_no
       = SDoc -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (HsExpr GhcRn -> LHsExpr GhcRn -> ThLevel -> SDoc
    forall fun arg.
    (Outputable fun, Outputable arg) =>
    fun -> arg -> ThLevel -> SDoc
    funAppCtxt HsExpr GhcRn
    fun LHsExpr GhcRn
    arg ThLevel
    arg_no) (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
         do { String -> SDoc -> TcRn ()
    traceTc String
    "tcArg" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
              [SDoc] -> SDoc
    vcat [ ThLevel -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ThLevel
    arg_no SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "of" SDoc -> SDoc -> SDoc
    <+> HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    fun
                   , String -> SDoc
    text String
    "arg type:" SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    ty
                   , String -> SDoc
    text String
    "arg:" SDoc -> SDoc -> SDoc
    <+> LHsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsExpr GhcRn
    arg ]
            ; TcType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. TcType -> TcM a -> TcM a
    tcScalingUsage TcType
    mult (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExprNC LHsExpr GhcRn
    arg TcType
    ty }

    ----------------
    tcTupArgs :: [LHsTupArg GhcRn] -> [TcSigmaType] -> TcM [LHsTupArg GhcTc]
    tcTupArgs :: [LHsTupArg GhcRn] -> [TcType] -> TcM [LHsTupArg GhcTc]
    tcTupArgs [LHsTupArg GhcRn]
    args [TcType]
    tys
      = ASSERT( equalLength args tys ) mapM go (args `zip` tys)
      where
        go :: (GenLocated l (HsTupArg GhcRn), TcType)
    -> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated l (HsTupArg GhcTc))
    go (L l
    l (Missing {}),   TcType
    arg_ty) = do { TcType
    mult <- TcType -> TcM TcType
    newFlexiTyVarTy TcType
    multiplicityTy
                                             ; GenLocated l (HsTupArg GhcTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated l (HsTupArg GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (l -> HsTupArg GhcTc -> GenLocated l (HsTupArg GhcTc)
    forall l e. l -> e -> GenLocated l e
    L l
    l (XMissing GhcTc -> HsTupArg GhcTc
    forall id. XMissing id -> HsTupArg id
    Missing (TcType -> TcType -> Scaled TcType
    forall a. TcType -> a -> Scaled a
    Scaled TcType
    mult TcType
    arg_ty))) }
        go (L l
    l (Present XPresent GhcRn
    x LHsExpr GhcRn
    expr), TcType
    arg_ty) = do { LHsExpr GhcTc
    expr' <- LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr TcType
    arg_ty
                                               ; GenLocated l (HsTupArg GhcTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (GenLocated l (HsTupArg GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (l -> HsTupArg GhcTc -> GenLocated l (HsTupArg GhcTc)
    forall l e. l -> e -> GenLocated l e
    L l
    l (XPresent GhcTc -> LHsExpr GhcTc -> HsTupArg GhcTc
    forall id. XPresent id -> LHsExpr id -> HsTupArg id
    Present XPresent GhcRn
    XPresent GhcTc
    x LHsExpr GhcTc
    expr')) }

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

    -- | Slightly more general version of 'tcSyntaxOp' that allows the caller
    -- to specify the shape of the result of the syntax operator
    tcSyntaxOpGen :: CtOrigin
                  -> SyntaxExprRn
                  -> [SyntaxOpType]
                  -> SyntaxOpType
                  -> ([TcSigmaType] -> [Mult] -> TcM a)
                  -> TcM (a, SyntaxExprTc)
    tcSyntaxOpGen :: forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> SyntaxOpType
    -> ([TcType] -> [TcType] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOpGen CtOrigin
    orig (SyntaxExprRn HsExpr GhcRn
    op) [SyntaxOpType]
    arg_tys SyntaxOpType
    res_ty [TcType] -> [TcType] -> TcM a
    thing_inside
      = do { (HsExpr GhcTc
    expr, TcType
    sigma) <- HsExpr GhcRn -> TcM (HsExpr GhcTc, TcType)
    tcInferAppHead HsExpr GhcRn
    op
           ; String -> SDoc -> TcRn ()
    traceTc String
    "tcSyntaxOpGen" (HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    op SDoc -> SDoc -> SDoc
    $$ HsExpr GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcTc
    expr SDoc -> SDoc -> SDoc
    $$ TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    sigma)
           ; (a
    result, HsWrapper
    expr_wrap, [HsWrapper]
    arg_wraps, HsWrapper
    res_wrap)
               <- CtOrigin
    -> TcType
    -> [SyntaxOpType]
    -> SyntaxOpType
    -> ([TcType] -> [TcType] -> TcM a)
    -> TcM (a, HsWrapper, [HsWrapper], HsWrapper)
    forall a.
    CtOrigin
    -> TcType
    -> [SyntaxOpType]
    -> SyntaxOpType
    -> ([TcType] -> [TcType] -> TcM a)
    -> TcM (a, HsWrapper, [HsWrapper], HsWrapper)
    tcSynArgA CtOrigin
    orig TcType
    sigma [SyntaxOpType]
    arg_tys SyntaxOpType
    res_ty (([TcType] -> [TcType] -> TcM a)
     -> TcM (a, HsWrapper, [HsWrapper], HsWrapper))
    -> ([TcType] -> [TcType] -> TcM a)
    -> TcM (a, HsWrapper, [HsWrapper], HsWrapper)
    forall a b. (a -> b) -> a -> b
    $
                  [TcType] -> [TcType] -> TcM a
    thing_inside
           ; String -> SDoc -> TcRn ()
    traceTc String
    "tcSyntaxOpGen" (HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    op SDoc -> SDoc -> SDoc
    $$ HsExpr GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcTc
    expr SDoc -> SDoc -> SDoc
    $$ TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    sigma )
           ; (a, SyntaxExprTc) -> TcM (a, SyntaxExprTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    result, SyntaxExprTc :: HsExpr GhcTc -> [HsWrapper] -> HsWrapper -> SyntaxExprTc
    SyntaxExprTc { syn_expr :: HsExpr GhcTc
    syn_expr = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    expr_wrap HsExpr GhcTc
    expr
                                          , syn_arg_wraps :: [HsWrapper]
    syn_arg_wraps = [HsWrapper]
    arg_wraps
                                          , syn_res_wrap :: HsWrapper
    syn_res_wrap  = HsWrapper
    res_wrap }) }
    tcSyntaxOpGen CtOrigin
    _ SyntaxExprRn
    NoSyntaxExprRn [SyntaxOpType]
    _ SyntaxOpType
    _ [TcType] -> [TcType] -> TcM a
    _ = String -> TcM (a, SyntaxExprTc)
    forall a. String -> a
    panic String
    "tcSyntaxOpGen"

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

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

        go TcType
    rho_ty SyntaxOpType
    SynRho   -- same as SynAny, because we skolemise eagerly
          = do { a
    result <- [TcType] -> [TcType] -> TcM a
    thing_inside [TcType
    rho_ty] []
               ; (a, HsWrapper) -> TcM (a, HsWrapper)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    result, HsWrapper
    idHsWrapper) }

        go TcType
    rho_ty SyntaxOpType
    SynList
          = do { (TcCoercionR
    list_co, TcType
    elt_ty) <- TcType -> TcM (TcCoercionR, TcType)
    matchExpectedListTy TcType
    rho_ty
               ; a
    result <- [TcType] -> [TcType] -> TcM a
    thing_inside [TcType
    elt_ty] []
               ; (a, HsWrapper) -> TcM (a, HsWrapper)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    result, TcCoercionR -> HsWrapper
    mkWpCastN TcCoercionR
    list_co) }

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

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

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

               ; (a, HsWrapper) -> TcM (a, HsWrapper)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( a
    result
                        , HsWrapper
    match_wrapper HsWrapper -> HsWrapper -> HsWrapper
    <.>
                          HsWrapper
    -> HsWrapper -> Scaled TcType -> TcType -> SDoc -> HsWrapper
    mkWpFun (HsWrapper
    arg_wrapper2 HsWrapper -> HsWrapper -> HsWrapper
    <.> HsWrapper
    arg_wrapper1) HsWrapper
    res_wrapper
                                  (TcType -> TcType -> Scaled TcType
    forall a. TcType -> a -> Scaled a
    Scaled TcType
    op_mult TcType
    arg_ty) TcType
    res_ty SDoc
    doc ) }
          where
            herald :: SDoc
    herald = String -> SDoc
    text String
    "This rebindable syntax expects a function with"
            doc :: SDoc
    doc = String -> SDoc
    text String
    "When checking a rebindable syntax operator arising from" SDoc -> SDoc -> SDoc
    <+> CtOrigin -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CtOrigin
    orig

        go TcType
    rho_ty (SynType ExpRhoType
    the_ty)
          = do { HsWrapper
    wrap   <- CtOrigin -> UserTypeCtxt -> ExpRhoType -> TcType -> TcM HsWrapper
    tcSubTypePat CtOrigin
    orig UserTypeCtxt
    GenSigCtxt ExpRhoType
    the_ty TcType
    rho_ty
               ; a
    result <- [TcType] -> [TcType] -> TcM a
    thing_inside [] []
               ; (a, HsWrapper) -> TcM (a, HsWrapper)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    result, HsWrapper
    wrap) }

    -- works on "actual" types, instantiating where necessary
    -- See Note [tcSynArg]
    tcSynArgA :: CtOrigin
              -> TcSigmaType
              -> [SyntaxOpType]              -- ^ argument shapes
              -> SyntaxOpType                -- ^ result shape
              -> ([TcSigmaType] -> [Mult] -> TcM a) -- ^ check the arguments
              -> TcM (a, HsWrapper, [HsWrapper], HsWrapper)
                -- ^ returns a wrapper to be applied to the original function,
                -- wrappers to be applied to arguments
                -- and a wrapper to be applied to the overall expression
    tcSynArgA :: forall a.
    CtOrigin
    -> TcType
    -> [SyntaxOpType]
    -> SyntaxOpType
    -> ([TcType] -> [TcType] -> TcM a)
    -> TcM (a, HsWrapper, [HsWrapper], HsWrapper)
    tcSynArgA CtOrigin
    orig TcType
    sigma_ty [SyntaxOpType]
    arg_shapes SyntaxOpType
    res_shape [TcType] -> [TcType] -> TcM a
    thing_inside
      = do { (HsWrapper
    match_wrapper, [Scaled TcType]
    arg_tys, TcType
    res_ty)
               <- SDoc
    -> CtOrigin
    -> Maybe (HsExpr GhcRn)
    -> ThLevel
    -> TcType
    -> TcM (HsWrapper, [Scaled TcType], TcType)
    matchActualFunTysRho SDoc
    herald CtOrigin
    orig Maybe (HsExpr GhcRn)
    forall a. Maybe a
    Nothing
                                       ([SyntaxOpType] -> ThLevel
    forall (t :: * -> *) a. Foldable t => t a -> ThLevel
    length [SyntaxOpType]
    arg_shapes) TcType
    sigma_ty
                  -- match_wrapper :: sigma_ty "->" (arg_tys -> res_ty)
           ; ((a
    result, HsWrapper
    res_wrapper), [HsWrapper]
    arg_wrappers)
               <- [TcType]
    -> [SyntaxOpType]
    -> ([TcType] -> [TcType] -> TcM (a, HsWrapper))
    -> TcM ((a, HsWrapper), [HsWrapper])
    forall a.
    [TcType]
    -> [SyntaxOpType]
    -> ([TcType] -> [TcType] -> TcM a)
    -> TcM (a, [HsWrapper])
    tc_syn_args_e ((Scaled TcType -> TcType) -> [Scaled TcType] -> [TcType]
    forall a b. (a -> b) -> [a] -> [b]
    map Scaled TcType -> TcType
    forall a. Scaled a -> a
    scaledThing [Scaled TcType]
    arg_tys) [SyntaxOpType]
    arg_shapes (([TcType] -> [TcType] -> TcM (a, HsWrapper))
     -> TcM ((a, HsWrapper), [HsWrapper]))
    -> ([TcType] -> [TcType] -> TcM (a, HsWrapper))
    -> TcM ((a, HsWrapper), [HsWrapper])
    forall a b. (a -> b) -> a -> b
    $ \ [TcType]
    arg_results [TcType]
    arg_res_mults ->
                  TcType -> SyntaxOpType -> ([TcType] -> TcM a) -> TcM (a, HsWrapper)
    forall a.
    TcType -> SyntaxOpType -> ([TcType] -> TcM a) -> TcM (a, HsWrapper)
    tc_syn_arg    TcType
    res_ty  SyntaxOpType
    res_shape  (([TcType] -> TcM a) -> TcM (a, HsWrapper))
    -> ([TcType] -> TcM a) -> TcM (a, HsWrapper)
    forall a b. (a -> b) -> a -> b
    $ \ [TcType]
    res_results ->
                  [TcType] -> [TcType] -> TcM a
    thing_inside ([TcType]
    arg_results [TcType] -> [TcType] -> [TcType]
    forall a. [a] -> [a] -> [a]
    ++ [TcType]
    res_results) ((Scaled TcType -> TcType) -> [Scaled TcType] -> [TcType]
    forall a b. (a -> b) -> [a] -> [b]
    map Scaled TcType -> TcType
    forall a. Scaled a -> TcType
    scaledMult [Scaled TcType]
    arg_tys [TcType] -> [TcType] -> [TcType]
    forall a. [a] -> [a] -> [a]
    ++ [TcType]
    arg_res_mults)
           ; (a, HsWrapper, [HsWrapper], HsWrapper)
    -> TcM (a, HsWrapper, [HsWrapper], HsWrapper)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    result, HsWrapper
    match_wrapper, [HsWrapper]
    arg_wrappers, HsWrapper
    res_wrapper) }
      where
        herald :: SDoc
    herald = String -> SDoc
    text String
    "This rebindable syntax expects a function with"

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

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

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

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

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

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

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

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

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

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

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

           ; TcType
    tau <- TcType -> TcM TcType
    zonkTcType TcType
    tau
           ; let inferred_theta :: [TcType]
    inferred_theta = (Var -> TcType) -> [Var] -> [TcType]
    forall a b. (a -> b) -> [a] -> [b]
    map Var -> TcType
    evVarPred [Var]
    givens
                 tau_tvs :: VarSet
    tau_tvs        = TcType -> VarSet
    tyCoVarsOfType TcType
    tau
           ; ([VarBndr Var Specificity]
    binders, [TcType]
    my_theta) <- [TcType]
    -> VarSet
    -> [Var]
    -> Maybe TcIdSigInst
    -> TcM ([VarBndr Var Specificity], [TcType])
    chooseInferredQuantifiers [TcType]
    inferred_theta
                                       VarSet
    tau_tvs [Var]
    qtvs (TcIdSigInst -> Maybe TcIdSigInst
    forall a. a -> Maybe a
    Just TcIdSigInst
    sig_inst)
           ; let inferred_sigma :: TcType
    inferred_sigma = [Var] -> [TcType] -> TcType -> TcType
    mkInfSigmaTy [Var]
    qtvs [TcType]
    inferred_theta TcType
    tau
                 my_sigma :: TcType
    my_sigma       = [VarBndr Var Specificity] -> TcType -> TcType
    mkInvisForAllTys [VarBndr Var Specificity]
    binders ([TcType] -> TcType -> TcType
    mkPhiTy  [TcType]
    my_theta TcType
    tau)
           ; HsWrapper
    wrap <- if TcType
    inferred_sigma TcType -> TcType -> Bool
    `eqType` TcType
    my_sigma -- NB: eqType ignores vis.
                     then HsWrapper -> TcM HsWrapper
    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 UserTypeCtxt -> TcType -> TcType -> TcM HsWrapper
    tcSubTypeSigma UserTypeCtxt
    ExprSigCtxt TcType
    inferred_sigma TcType
    my_sigma

           ; String -> SDoc -> TcRn ()
    traceTc String
    "tcExpSig" ([Var] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Var]
    qtvs SDoc -> SDoc -> SDoc
    $$ [Var] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Var]
    givens SDoc -> SDoc -> SDoc
    $$ TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    inferred_sigma SDoc -> SDoc -> SDoc
    $$ TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    my_sigma)
           ; let poly_wrap :: HsWrapper
    poly_wrap = HsWrapper
    wrap
                             HsWrapper -> HsWrapper -> HsWrapper
    <.> [Var] -> HsWrapper
    mkWpTyLams [Var]
    qtvs
                             HsWrapper -> HsWrapper -> HsWrapper
    <.> [Var] -> HsWrapper
    mkWpLams [Var]
    givens
                             HsWrapper -> HsWrapper -> HsWrapper
    <.> TcEvBinds -> HsWrapper
    mkWpLet  TcEvBinds
    ev_binds
           ; (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap HsWrapper
    poly_wrap LHsExpr GhcTc
    expr', TcType
    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.
    -}

    {- *********************************************************************
    *                                                                      *
                     tcInferId
    *                                                                      *
    ********************************************************************* -}

    tcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcCheckId Name
    name ExpRhoType
    res_ty
      | Name
    name Name -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    tagToEnumKey
      = SDoc -> TcM (HsExpr GhcTc)
    forall a. SDoc -> TcRn a
    failWithTc (String -> SDoc
    text String
    "tagToEnum# must appear applied to one argument")
        -- tcApp catches the case (tagToEnum# arg)

      | Bool
    otherwise
      = do { (HsExpr GhcTc
    expr, TcType
    actual_res_ty) <- Name -> TcM (HsExpr GhcTc, TcType)
    tcInferId Name
    name
           ; String -> SDoc -> TcRn ()
    traceTc String
    "tcCheckId" ([SDoc] -> SDoc
    vcat [Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name, TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    actual_res_ty, ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    res_ty])
           ; Bool
    -> HsExpr GhcTc
    -> TcType
    -> ExpRhoType
    -> TcM (HsExpr GhcTc)
    -> TcM (HsExpr GhcTc)
    forall a.
    Bool -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM a -> TcM a
    addFunResCtxt Bool
    False HsExpr GhcTc
    expr TcType
    actual_res_ty ExpRhoType
    res_ty (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
             CtOrigin
    -> HsExpr GhcRn
    -> HsExpr GhcTc
    -> TcType
    -> ExpRhoType
    -> TcM (HsExpr GhcTc)
    tcWrapResultO (Name -> CtOrigin
    OccurrenceOf Name
    name) (XVar GhcRn -> GenLocated SrcSpan (IdP GhcRn) -> HsExpr GhcRn
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar GhcRn
    noExtField (Name -> GenLocated SrcSpan Name
    forall e. e -> Located e
    noLoc Name
    name)) HsExpr GhcTc
    expr
                                               TcType
    actual_res_ty ExpRhoType
    res_ty }

    tcCheckRecSelId :: HsExpr GhcRn -> AmbiguousFieldOcc GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcCheckRecSelId :: HsExpr GhcRn
    -> AmbiguousFieldOcc GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcCheckRecSelId HsExpr GhcRn
    rn_expr f :: AmbiguousFieldOcc GhcRn
    f@(Unambiguous {}) ExpRhoType
    res_ty
      = do { (HsExpr GhcTc
    expr, TcType
    actual_res_ty) <- AmbiguousFieldOcc GhcRn -> TcM (HsExpr GhcTc, TcType)
    tcInferRecSelId AmbiguousFieldOcc GhcRn
    f
           ; HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResult HsExpr GhcRn
    rn_expr HsExpr GhcTc
    expr TcType
    actual_res_ty ExpRhoType
    res_ty }
    tcCheckRecSelId HsExpr GhcRn
    rn_expr (Ambiguous XAmbiguous GhcRn
    _ Located RdrName
    lbl) ExpRhoType
    res_ty
      = case TcType -> Maybe (Scaled TcType, TcType)
    tcSplitFunTy_maybe (TcType -> Maybe (Scaled TcType, TcType))
    -> Maybe TcType -> Maybe (Scaled TcType, TcType)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExpRhoType -> Maybe TcType
    checkingExpType_maybe ExpRhoType
    res_ty of
          Maybe (Scaled TcType, TcType)
    Nothing       -> Located RdrName -> TcM (HsExpr GhcTc)
    forall a. Located RdrName -> TcM a
    ambiguousSelector Located RdrName
    lbl
          Just (Scaled TcType
    arg, TcType
    _) -> do { Name
    sel_name <- Located RdrName -> TcType -> TcM Name
    disambiguateSelector Located RdrName
    lbl (Scaled TcType -> TcType
    forall a. Scaled a -> a
    scaledThing Scaled TcType
    arg)
                              ; HsExpr GhcRn
    -> AmbiguousFieldOcc GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcCheckRecSelId HsExpr GhcRn
    rn_expr (XUnambiguous GhcRn -> Located RdrName -> AmbiguousFieldOcc GhcRn
    forall pass.
    XUnambiguous pass -> Located RdrName -> AmbiguousFieldOcc pass
    Unambiguous Name
    XUnambiguous GhcRn
    sel_name Located RdrName
    lbl)
                                                        ExpRhoType
    res_ty }

    ------------------------
    tcInferRecSelId :: AmbiguousFieldOcc GhcRn -> TcM (HsExpr GhcTc, TcRhoType)
    tcInferRecSelId :: AmbiguousFieldOcc GhcRn -> TcM (HsExpr GhcTc, TcType)
    tcInferRecSelId (Unambiguous XUnambiguous GhcRn
    sel (L SrcSpan
    _ RdrName
    lbl))
      = do { (HsExpr GhcTc
    expr', TcType
    ty) <- RdrName -> Name -> TcM (HsExpr GhcTc, TcType)
    tc_infer_id RdrName
    lbl Name
    XUnambiguous GhcRn
    sel
           ; (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc
    expr', TcType
    ty) }
    tcInferRecSelId (Ambiguous XAmbiguous GhcRn
    _ Located RdrName
    lbl)
      = Located RdrName -> TcM (HsExpr GhcTc, TcType)
    forall a. Located RdrName -> TcM a
    ambiguousSelector Located RdrName
    lbl

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

      | Bool
    otherwise
      = do { (HsExpr GhcTc
    expr, TcType
    ty) <- RdrName -> Name -> TcM (HsExpr GhcTc, TcType)
    tc_infer_id (Name -> RdrName
    nameRdrName Name
    id_name) Name
    id_name
           ; String -> SDoc -> TcRn ()
    traceTc String
    "tcInferId" (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    id_name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    ty)
           ; (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc
    expr, TcType
    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, TcType)
    tc_infer_assert Name
    assert_name
      = do { Var
    assert_error_id <- Name -> TcM Var
    tcLookupId Name
    assertErrorName
           ; (HsWrapper
    wrap, TcType
    id_rho) <- CtOrigin -> TcType -> TcM (HsWrapper, TcType)
    topInstantiate (Name -> CtOrigin
    OccurrenceOf Name
    assert_name)
                                              (Var -> TcType
    idType Var
    assert_error_id)
           ; (HsExpr GhcTc, TcType) -> TcM (HsExpr GhcTc, TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap (XVar GhcTc -> Located (IdP GhcTc) -> HsExpr GhcTc
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar GhcTc
    noExtField (Var -> Located Var
    forall e. e -> Located e
    noLoc Var
    assert_error_id)), TcType
    id_rho)
           }

    tc_infer_id :: RdrName -> Name -> TcM (HsExpr GhcTc, TcSigmaType)
    tc_infer_id :: RdrName -> Name -> TcM (HsExpr GhcTc, TcType)
    tc_infer_id RdrName
    lbl Name
    id_name
     = do { TcTyThing
    thing <- Name -> TcM TcTyThing
    tcLookup Name
    id_name
          ; case TcTyThing
    thing of
                 ATcId { tct_id :: TcTyThing -> Var
    tct_id = Var
    id }
                   -> do { Var -> TcRn ()
    check_naughty Var
    id        -- Note [Local record selectors]
                         ; Var -> TcRn ()
    checkThLocalId Var
    id
                         ; UsageEnv -> TcRn ()
    tcEmitBindingUsage (UsageEnv -> TcRn ()) -> UsageEnv -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ Name -> TcType -> UsageEnv
    forall n. NamedThing n => n -> TcType -> UsageEnv
    unitUE Name
    id_name TcType
    One
                         ; Var -> TcM (HsExpr GhcTc, TcType)
    forall {m :: * -> *} {p}.
    (Monad m, XVar p ~ NoExtField, IdP p ~ Var) =>
    Var -> m (HsExpr p, TcType)
    return_id Var
    id }

                 AGlobal (AnId Var
    id)
                   -> do { Var -> TcRn ()
    check_naughty Var
    id
                         ; Var -> TcM (HsExpr GhcTc, TcType)
    forall {m :: * -> *} {p}.
    (Monad m, XVar p ~ NoExtField, IdP p ~ Var) =>
    Var -> m (HsExpr p, TcType)
    return_id Var
    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, TcType)
    return_data_con DataCon
    con
                     PatSynCon PatSyn
    ps    -> PatSyn -> TcM (HsExpr GhcTc, TcType)
    tcPatSynBuilderOcc PatSyn
    ps

                 TcTyThing
    _ -> SDoc -> TcM (HsExpr GhcTc, TcType)
    forall a. SDoc -> TcRn a
    failWithTc (SDoc -> TcM (HsExpr GhcTc, TcType))
    -> SDoc -> TcM (HsExpr GhcTc, TcType)
    forall a b. (a -> b) -> a -> b
    $
                      TcTyThing -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcTyThing
    thing SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "used where a value identifier was expected" }
      where
        return_id :: Var -> m (HsExpr p, TcType)
    return_id Var
    id = (HsExpr p, TcType) -> m (HsExpr p, TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XVar p -> Located (IdP p) -> HsExpr p
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar p
    noExtField (Var -> Located Var
    forall e. e -> Located e
    noLoc Var
    id), Var -> TcType
    idType Var
    id)

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

               -- See Note [Linear fields generalization]
               ; [TcType]
    mul_vars <- ThLevel -> TcType -> IOEnv (Env TcGblEnv TcLclEnv) [TcType]
    newFlexiTyVarTys ([Scaled TcType] -> ThLevel
    forall (t :: * -> *) a. Foldable t => t a -> ThLevel
    length [Scaled TcType]
    args) TcType
    multiplicityTy
               ; let scaleArgs :: [Scaled TcType] -> [Scaled TcType]
    scaleArgs [Scaled TcType]
    args' = String
    -> (TcType -> Scaled TcType -> Scaled TcType)
    -> [TcType]
    -> [Scaled TcType]
    -> [Scaled TcType]
    forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithEqual String
    "return_data_con" TcType -> Scaled TcType -> Scaled TcType
    forall {a}. TcType -> Scaled a -> Scaled a
    combine [TcType]
    mul_vars [Scaled TcType]
    args'
                     combine :: TcType -> Scaled a -> Scaled a
    combine TcType
    var (Scaled TcType
    One a
    ty) = TcType -> a -> Scaled a
    forall a. TcType -> a -> Scaled a
    Scaled TcType
    var a
    ty
                     combine TcType
    _   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 TcType) -> HsWrapper
    etaWrapper t (Scaled TcType)
    arg_tys = (Scaled TcType -> HsWrapper -> HsWrapper)
    -> HsWrapper -> t (Scaled TcType) -> HsWrapper
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\Scaled TcType
    scaled_ty HsWrapper
    wr -> HsWrapper -> HsWrapper -> Scaled TcType -> SDoc -> HsWrapper
    WpFun HsWrapper
    WpHole HsWrapper
    wr Scaled TcType
    scaled_ty SDoc
    empty) HsWrapper
    WpHole t (Scaled TcType)
    arg_tys

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

        check_naughty :: Var -> TcRn ()
    check_naughty Var
    id
          | Var -> Bool
    isNaughtyRecordSelector Var
    id = SDoc -> TcRn ()
    forall a. SDoc -> TcRn a
    failWithTc (RdrName -> SDoc
    naughtyRecordSel RdrName
    lbl)
          | Bool
    otherwise                  = () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    tcUnboundId :: HsExpr GhcRn -> OccName -> ExpRhoType -> TcM (HsExpr GhcTc)
    -- Typecheck an occurrence of an unbound Id
    --
    -- Some of these started life as a true expression hole "_".
    -- Others might simply be variables that accidentally have no binding site
    --
    -- We turn all of them into HsVar, since HsUnboundVar can't contain an
    -- Id; and indeed the evidence for the ExprHole does bind it, so it's
    -- not unbound any more!
    tcUnboundId :: HsExpr GhcRn -> OccName -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcUnboundId HsExpr GhcRn
    rn_expr OccName
    occ ExpRhoType
    res_ty
     = do { TcType
    ty <- TcM TcType
    newOpenFlexiTyVarTy  -- Allow Int# etc (#12531)
          ; Name
    name <- OccName -> TcM Name
    forall gbl lcl. OccName -> TcRnIf gbl lcl Name
    newSysName OccName
    occ
          ; let ev :: Var
    ev = HasDebugCallStack => Name -> TcType -> TcType -> Var
    Name -> TcType -> TcType -> Var
    mkLocalId Name
    name TcType
    Many TcType
    ty
          ; OccName -> Var -> TcType -> TcRn ()
    emitNewExprHole OccName
    occ Var
    ev TcType
    ty
          ; CtOrigin
    -> HsExpr GhcRn
    -> HsExpr GhcTc
    -> TcType
    -> ExpRhoType
    -> TcM (HsExpr GhcTc)
    tcWrapResultO (OccName -> CtOrigin
    UnboundOccurrenceOf OccName
    occ) HsExpr GhcRn
    rn_expr
              (XVar GhcTc -> Located (IdP GhcTc) -> HsExpr GhcTc
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar GhcTc
    noExtField (Var -> Located Var
    forall e. e -> Located e
    noLoc Var
    ev)) TcType
    ty ExpRhoType
    res_ty }

    {-
    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 [tagToEnum#]
    ~~~~~~~~~~~~~~~~~
    Nasty check to ensure that tagToEnum# is applied to a type that is an
    enumeration TyCon.  Unification may refine the type later, but this
    check won't see that, alas.  It's crude, because it relies on our
    knowing *now* that the type is ok, which in turn relies on the
    eager-unification part of the type checker pushing enough information
    here.  In theory the Right Thing to do is to have a new form of
    constraint but I definitely cannot face that!  And it works ok as-is.

    Here's are two cases that should fail
            f :: forall a. a
            f = tagToEnum# 0        -- Can't do tagToEnum# at a type variable

            g :: Int
            g = tagToEnum# 0        -- Int is not an enumeration

    When data type families are involved it's a bit more complicated.
         data family F a
         data instance F [Int] = A | B | C
    Then we want to generate something like
         tagToEnum# R:FListInt 3# |> co :: R:FListInt ~ F [Int]
    Usually that coercion is hidden inside the wrappers for
    constructors of F [Int] but here we have to do it explicitly.

    It's all grotesquely complicated.

    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.

    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.
    -}

    isTagToEnum :: HsExpr GhcTc -> Bool
    isTagToEnum :: HsExpr GhcTc -> Bool
    isTagToEnum (HsVar XVar GhcTc
    _ (L SrcSpan
    _ IdP GhcTc
    fun_id)) = Var
    IdP GhcTc
    fun_id Var -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    tagToEnumKey
    isTagToEnum HsExpr GhcTc
    _ = Bool
    False

    tcTagToEnum :: HsExpr GhcRn -> HsExpr GhcTc -> [LHsExprArgOut]
                -> TcSigmaType -> ExpRhoType
                -> TcM (HsExpr GhcTc)
    -- tagToEnum# :: forall a. Int# -> a
    -- See Note [tagToEnum#]   Urgh!
    tcTagToEnum :: HsExpr GhcRn
    -> HsExpr GhcTc
    -> [LHsExprArgOut]
    -> TcType
    -> ExpRhoType
    -> TcM (HsExpr GhcTc)
    tcTagToEnum HsExpr GhcRn
    expr HsExpr GhcTc
    fun [LHsExprArgOut]
    args TcType
    app_res_ty ExpRhoType
    res_ty
      = do { TcType
    res_ty <- ExpRhoType -> TcM TcType
    readExpType ExpRhoType
    res_ty
           ; TcType
    ty'    <- TcType -> TcM TcType
    zonkTcType TcType
    res_ty

           -- Check that the type is algebraic
           ; case HasCallStack => TcType -> Maybe (TyCon, [TcType])
    TcType -> Maybe (TyCon, [TcType])
    tcSplitTyConApp_maybe TcType
    ty' of {
               Maybe (TyCon, [TcType])
    Nothing -> do { SDoc -> TcRn ()
    addErrTc (TcType -> SDoc -> SDoc
    mk_error TcType
    ty' SDoc
    doc1)
                             ; TcM (HsExpr GhcTc)
    vanilla_result } ;
               Just (TyCon
    tc, [TcType]
    tc_args) ->

        do { -- Look through any type family
           ; FamInstEnvs
    fam_envs <- TcM FamInstEnvs
    tcGetFamInstEnvs
           ; case FamInstEnvs
    -> TyCon -> [TcType] -> Maybe (TyCon, [TcType], TcCoercionR)
    tcLookupDataFamInst_maybe FamInstEnvs
    fam_envs TyCon
    tc [TcType]
    tc_args of {
               Maybe (TyCon, [TcType], TcCoercionR)
    Nothing -> do { TcType -> TyCon -> TcRn ()
    check_enumeration TcType
    ty' TyCon
    tc
                             ; TcM (HsExpr GhcTc)
    vanilla_result } ;
               Just (TyCon
    rep_tc, [TcType]
    rep_args, TcCoercionR
    coi) ->

        do { -- coi :: tc tc_args ~R rep_tc rep_args
             TcType -> TyCon -> TcRn ()
    check_enumeration TcType
    ty' TyCon
    rep_tc
           ; let val_arg :: [LHsExprArgOut]
    val_arg = (LHsExprArgOut -> Bool) -> [LHsExprArgOut] -> [LHsExprArgOut]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (LHsExprArgOut -> Bool) -> LHsExprArgOut -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsExprArgOut -> Bool
    forall (id :: Pass). HsExprArg id -> Bool
    isHsValArg) [LHsExprArgOut]
    args
                 rep_ty :: TcType
    rep_ty  = TyCon -> [TcType] -> TcType
    mkTyConApp TyCon
    rep_tc [TcType]
    rep_args
                 fun' :: HsExpr GhcTc
    fun'    = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap (TcType -> HsWrapper
    WpTyApp TcType
    rep_ty) HsExpr GhcTc
    fun
                 expr' :: HsExpr GhcTc
    expr'   = HsExpr GhcTc -> [LHsExprArgOut] -> HsExpr GhcTc
    applyHsArgs HsExpr GhcTc
    fun' [LHsExprArgOut]
    val_arg
                 df_wrap :: HsWrapper
    df_wrap = TcCoercionR -> HsWrapper
    mkWpCastR (TcCoercionR -> TcCoercionR
    mkTcSymCo TcCoercionR
    coi)
           ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    df_wrap HsExpr GhcTc
    expr') }}}}}

      where
        vanilla_result :: TcM (HsExpr GhcTc)
    vanilla_result
          = do { let expr' :: HsExpr GhcTc
    expr' = HsExpr GhcTc -> [LHsExprArgOut] -> HsExpr GhcTc
    applyHsArgs HsExpr GhcTc
    fun [LHsExprArgOut]
    args
               ; HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResult HsExpr GhcRn
    expr HsExpr GhcTc
    expr' TcType
    app_res_ty ExpRhoType
    res_ty }

        check_enumeration :: TcType -> TyCon -> TcRn ()
    check_enumeration TcType
    ty' TyCon
    tc
          | TyCon -> Bool
    isEnumerationTyCon TyCon
    tc = () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          | Bool
    otherwise             = SDoc -> TcRn ()
    addErrTc (TcType -> SDoc -> SDoc
    mk_error TcType
    ty' SDoc
    doc2)

        doc1 :: SDoc
    doc1 = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Specify the type by giving a type signature"
                    , String -> SDoc
    text String
    "e.g. (tagToEnum# x) :: Bool" ]
        doc2 :: SDoc
    doc2 = String -> SDoc
    text String
    "Result type must be an enumeration type"

        mk_error :: TcType -> SDoc -> SDoc
        mk_error :: TcType -> SDoc -> SDoc
    mk_error TcType
    ty SDoc
    what
          = SDoc -> ThLevel -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Bad call to tagToEnum#"
                   SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "at type" SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    ty)
               ThLevel
    2 SDoc
    what

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

    checkThLocalId :: Id -> TcM ()
    -- The renamer has already done checkWellStaged,
    --   in 'GHC.Rename.Splice.checkThLocalName', so don't repeat that here.
    -- Here we just add constraints fro cross-stage lifting
    checkThLocalId :: Var -> TcRn ()
    checkThLocalId Var
    id
      = do  { Maybe (TopLevelFlag, ThLevel, ThStage)
    mb_local_use <- Name -> TcRn (Maybe (TopLevelFlag, ThLevel, ThStage))
    getStageAndBindLevel (Var -> Name
    idName Var
    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 ThLevel -> ThLevel -> Bool
    forall a. Ord a => a -> a -> Bool
    > ThLevel
    bind_lvl
                    -> TopLevelFlag -> Var -> ThStage -> TcRn ()
    checkCrossStageLifting TopLevelFlag
    top_lvl Var
    id ThStage
    use_stage
                 Maybe (TopLevelFlag, ThLevel, ThStage)
    _  -> () -> TcRn ()
    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 -> Var -> ThStage -> TcRn ()
    checkCrossStageLifting TopLevelFlag
    top_lvl Var
    id (Brack ThStage
    _ (TcPending TcRef [PendingTcSplice]
    ps_var TcRef WantedConstraints
    lie_var QuoteWrapper
    q))
      | TopLevelFlag -> Bool
    isTopLevel TopLevelFlag
    top_lvl
      = Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Name -> Bool
    isExternalName Name
    id_name) (Name -> TcRn ()
    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 :: TcType
    id_ty = Var -> TcType
    idType Var
    id
            ; Bool -> SDoc -> TcRn ()
    checkTc (TcType -> Bool
    isTauTy TcType
    id_ty) (Var -> SDoc
    polySpliceErr Var
    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 TcType -> Bool
    isStringTy TcType
    id_ty then
                         do { Var
    sid <- Name -> TcM Var
    tcLookupId Name
    GHC.Builtin.Names.TH.liftStringName
                                         -- See Note [Lifting strings]
                            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XVar GhcTc -> Located (IdP GhcTc) -> HsExpr GhcTc
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar GhcTc
    noExtField (Var -> Located Var
    forall e. e -> Located e
    noLoc Var
    sid)) }
                      else
                         TcRef WantedConstraints -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a. TcRef WantedConstraints -> TcM a -> TcM a
    setConstraintVar TcRef WantedConstraints
    lie_var   (TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc))
    -> TcM (HsExpr GhcTc) -> TcM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                              -- Put the 'lift' constraint into the right LIE
                         CtOrigin -> Name -> [TcType] -> TcM (HsExpr GhcTc)
    newMethodFromName (Name -> CtOrigin
    OccurrenceOf Name
    id_name)
                                           Name
    GHC.Builtin.Names.TH.liftName
                                           [HasDebugCallStack => TcType -> TcType
    TcType -> TcType
    getRuntimeRep TcType
    id_ty, TcType
    id_ty]

                       -- Update the pending splices
            ; [PendingTcSplice]
    ps <- TcRef [PendingTcSplice]
    -> IOEnv (Env TcGblEnv TcLclEnv) [PendingTcSplice]
    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
                                     (LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc
    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) (HsExpr GhcTc -> LHsExpr GhcTc
    forall e. e -> Located e
    noLoc HsExpr GhcTc
    lift))
                                              (IdP GhcTc -> LHsExpr GhcTc
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Var
    IdP GhcTc
    id))
            ; TcRef [PendingTcSplice] -> [PendingTcSplice] -> TcRn ()
    forall a env. IORef a -> a -> IOEnv env ()
    writeMutVar TcRef [PendingTcSplice]
    ps_var (PendingTcSplice
    pending_splice PendingTcSplice -> [PendingTcSplice] -> [PendingTcSplice]
    forall a. a -> [a] -> [a]
    : [PendingTcSplice]
    ps)

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

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

    polySpliceErr :: Id -> SDoc
    polySpliceErr :: Var -> SDoc
    polySpliceErr Var
    id
      = String -> SDoc
    text String
    "Can't splice the polymorphic local variable" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Var -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Var
    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 "GHC.ThToHs"

    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.

    ************************************************************************
    *                                                                      *
    \subsection{Record bindings}
    *                                                                      *
    ************************************************************************
    -}

    getFixedTyVars :: [FieldLabelString] -> [TyVar] -> [ConLike] -> TyVarSet
    -- These tyvars must not change across the updates
    getFixedTyVars :: [FieldLabelString] -> [Var] -> [ConLike] -> VarSet
    getFixedTyVars [FieldLabelString]
    upd_fld_occs [Var]
    univ_tvs [ConLike]
    cons
          = [Var] -> VarSet
    mkVarSet [Var
    tv1 | ConLike
    con <- [ConLike]
    cons
                          , let ([Var]
    u_tvs, [Var]
    _, [EqSpec]
    eqspec, [TcType]
    prov_theta
                                 , [TcType]
    req_theta, [Scaled TcType]
    arg_tys, TcType
    _)
                                  = ConLike
    -> ([Var], [Var], [EqSpec], [TcType], [TcType], [Scaled TcType],
        TcType)
    conLikeFullSig ConLike
    con
                                theta :: [TcType]
    theta = [EqSpec] -> [TcType]
    eqSpecPreds [EqSpec]
    eqspec
                                         [TcType] -> [TcType] -> [TcType]
    forall a. [a] -> [a] -> [a]
    ++ [TcType]
    prov_theta
                                         [TcType] -> [TcType] -> [TcType]
    forall a. [a] -> [a] -> [a]
    ++ [TcType]
    req_theta
                                flds :: [FieldLbl Name]
    flds = ConLike -> [FieldLbl Name]
    conLikeFieldLabels ConLike
    con
                                fixed_tvs :: VarSet
    fixed_tvs = [TcType] -> VarSet
    exactTyCoVarsOfTypes ((Scaled TcType -> TcType) -> [Scaled TcType] -> [TcType]
    forall a b. (a -> b) -> [a] -> [b]
    map Scaled TcType -> TcType
    forall a. Scaled a -> a
    scaledThing [Scaled TcType]
    fixed_tys)
                                        -- fixed_tys: See Note [Type of a record update]
                                            VarSet -> VarSet -> VarSet
    `unionVarSet` [TcType] -> VarSet
    tyCoVarsOfTypes [TcType]
    theta
                                        -- Universally-quantified tyvars that
                                        -- appear in any of the *implicit*
                                        -- arguments to the constructor are fixed
                                        -- See Note [Implicit type sharing]

                                fixed_tys :: [Scaled TcType]
    fixed_tys = [Scaled TcType
    ty | (FieldLbl Name
    fl, Scaled TcType
    ty) <- [FieldLbl Name]
    -> [Scaled TcType] -> [(FieldLbl Name, Scaled TcType)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [FieldLbl Name]
    flds [Scaled TcType]
    arg_tys
                                                , Bool -> Bool
    not (FieldLbl Name -> FieldLabelString
    forall a. FieldLbl a -> FieldLabelString
    flLabel FieldLbl Name
    fl FieldLabelString -> [FieldLabelString] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [FieldLabelString]
    upd_fld_occs)]
                          , (Var
    tv1,Var
    tv) <- [Var]
    univ_tvs [Var] -> [Var] -> [(Var, Var)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Var]
    u_tvs
                          , Var
    tv Var -> VarSet -> Bool
    `elemVarSet` VarSet
    fixed_tvs ]

    {-
    Note [Disambiguating record 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 `tcApp`.

    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.
    -}

    -- 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.
    disambiguateSelector :: Located RdrName -> Type -> TcM Name
    disambiguateSelector :: Located RdrName -> TcType -> TcM Name
    disambiguateSelector lr :: Located RdrName
    lr@(L SrcSpan
    _ RdrName
    rdr) TcType
    parent_type
     = do { FamInstEnvs
    fam_inst_envs <- TcM FamInstEnvs
    tcGetFamInstEnvs
          ; case FamInstEnvs -> TcType -> Maybe TyCon
    tyConOf FamInstEnvs
    fam_inst_envs TcType
    parent_type of
              Maybe TyCon
    Nothing -> Located RdrName -> TcM Name
    forall a. Located RdrName -> TcM a
    ambiguousSelector Located RdrName
    lr
              Just TyCon
    p  ->
                do { [(RecSelParent, GlobalRdrElt)]
    xs <- RdrName -> RnM [(RecSelParent, GlobalRdrElt)]
    lookupParents RdrName
    rdr
                   ; let parent :: RecSelParent
    parent = TyCon -> RecSelParent
    RecSelData TyCon
    p
                   ; case RecSelParent
    -> [(RecSelParent, GlobalRdrElt)] -> Maybe GlobalRdrElt
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup RecSelParent
    parent [(RecSelParent, GlobalRdrElt)]
    xs of
                       Just GlobalRdrElt
    gre -> do { Bool -> GlobalRdrElt -> TcRn ()
    addUsedGRE Bool
    True GlobalRdrElt
    gre
                                      ; Name -> TcM Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GlobalRdrElt -> Name
    gre_name GlobalRdrElt
    gre) }
                       Maybe GlobalRdrElt
    Nothing  -> SDoc -> TcM Name
    forall a. SDoc -> TcRn a
    failWithTc (RecSelParent -> RdrName -> SDoc
    fieldNotInType RecSelParent
    parent RdrName
    rdr) } }

    -- This field name really is ambiguous, so add a suitable "ambiguous
    -- occurrence" error, then give up.
    ambiguousSelector :: Located RdrName -> TcM a
    ambiguousSelector :: forall a. Located RdrName -> TcM a
    ambiguousSelector (L SrcSpan
    _ RdrName
    rdr)
      = do { RdrName -> TcRn ()
    addAmbiguousNameErr RdrName
    rdr
           ; TcM a
    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 -> TcRn ()
    addAmbiguousNameErr RdrName
    rdr
      = do { GlobalRdrEnv
    env <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
           ; let gres :: [GlobalRdrElt]
    gres = RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
    lookupGRE_RdrName RdrName
    rdr GlobalRdrEnv
    env
           ; [ErrCtxt] -> TcRn () -> TcRn ()
    forall a. [ErrCtxt] -> TcM a -> TcM a
    setErrCtxt [] (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ RdrName -> [GlobalRdrElt] -> TcRn ()
    addNameClashErrRn RdrName
    rdr [GlobalRdrElt]
    gres}

    -- Disambiguate the fields in a record update.
    -- See Note [Disambiguating record fields]
    disambiguateRecordBinds :: LHsExpr GhcRn -> TcRhoType
                     -> [LHsRecUpdField GhcRn] -> ExpRhoType
                     -> TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    disambiguateRecordBinds :: LHsExpr GhcRn
    -> TcType
    -> [LHsRecUpdField GhcRn]
    -> ExpRhoType
    -> TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    disambiguateRecordBinds LHsExpr GhcRn
    record_expr TcType
    record_rho [LHsRecUpdField GhcRn]
    rbnds ExpRhoType
    res_ty
        -- Are all the fields unambiguous?
      = case (LHsRecUpdField GhcRn -> Maybe (LHsRecUpdField GhcRn, Name))
    -> [LHsRecUpdField GhcRn] -> Maybe [(LHsRecUpdField GhcRn, Name)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM LHsRecUpdField GhcRn -> Maybe (LHsRecUpdField GhcRn, Name)
    isUnambiguous [LHsRecUpdField GhcRn]
    rbnds of
                         -- If so, just skip to looking up the Ids
                         -- Always the case if DuplicateRecordFields is off
          Just [(LHsRecUpdField GhcRn, Name)]
    rbnds' -> ((LHsRecUpdField GhcRn, Name)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)))
    -> [(LHsRecUpdField GhcRn, Name)]
    -> TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (LHsRecUpdField GhcRn, Name)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    lookupSelector [(LHsRecUpdField GhcRn, Name)]
    rbnds'
          Maybe [(LHsRecUpdField GhcRn, Name)]
    Nothing     -> -- If not, try to identify a single parent
            do { FamInstEnvs
    fam_inst_envs <- TcM FamInstEnvs
    tcGetFamInstEnvs
                 -- Look up the possible parents for each field
               ; [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])]
    rbnds_with_parents <- TcM [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])]
    getUpdFieldsParents
               ; let possible_parents :: [[RecSelParent]]
    possible_parents = ((LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])
     -> [RecSelParent])
    -> [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])]
    -> [[RecSelParent]]
    forall a b. (a -> b) -> [a] -> [b]
    map (((RecSelParent, GlobalRdrElt) -> RecSelParent)
    -> [(RecSelParent, GlobalRdrElt)] -> [RecSelParent]
    forall a b. (a -> b) -> [a] -> [b]
    map (RecSelParent, GlobalRdrElt) -> RecSelParent
    forall a b. (a, b) -> a
    fst ([(RecSelParent, GlobalRdrElt)] -> [RecSelParent])
    -> ((LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])
        -> [(RecSelParent, GlobalRdrElt)])
    -> (LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])
    -> [RecSelParent]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])
    -> [(RecSelParent, GlobalRdrElt)]
    forall a b. (a, b) -> b
    snd) [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])]
    rbnds_with_parents
                 -- Identify a single parent
               ; RecSelParent
    p <- FamInstEnvs -> [[RecSelParent]] -> TcM RecSelParent
    identifyParent FamInstEnvs
    fam_inst_envs [[RecSelParent]]
    possible_parents
                 -- Pick the right selector with that parent for each field
               ; TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    forall r. TcM r -> TcM r
    checkNoErrs (TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
     -> TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)])
    -> TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    forall a b. (a -> b) -> a -> b
    $ ((LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)))
    -> [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])]
    -> TcM [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (RecSelParent
    -> (LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    pickParent RecSelParent
    p) [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])]
    rbnds_with_parents }
      where
        -- Extract the selector name of a field update if it is unambiguous
        isUnambiguous :: LHsRecUpdField GhcRn -> Maybe (LHsRecUpdField GhcRn,Name)
        isUnambiguous :: LHsRecUpdField GhcRn -> Maybe (LHsRecUpdField GhcRn, Name)
    isUnambiguous LHsRecUpdField GhcRn
    x = case Located (AmbiguousFieldOcc GhcRn) -> AmbiguousFieldOcc GhcRn
    forall l e. GenLocated l e -> e
    unLoc (HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    -> Located (AmbiguousFieldOcc GhcRn)
    forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl (LHsRecUpdField GhcRn
    -> HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    forall l e. GenLocated l e -> e
    unLoc LHsRecUpdField GhcRn
    x)) of
                            Unambiguous XUnambiguous GhcRn
    sel_name Located RdrName
    _ -> (LHsRecUpdField GhcRn, Name) -> Maybe (LHsRecUpdField GhcRn, Name)
    forall a. a -> Maybe a
    Just (LHsRecUpdField GhcRn
    x, Name
    XUnambiguous GhcRn
    sel_name)
                            Ambiguous{}            -> Maybe (LHsRecUpdField GhcRn, Name)
    forall a. Maybe a
    Nothing

        -- Look up the possible parents and selector GREs for each field
        getUpdFieldsParents :: TcM [(LHsRecUpdField GhcRn
                                    , [(RecSelParent, GlobalRdrElt)])]
        getUpdFieldsParents :: TcM [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])]
    getUpdFieldsParents
          = ([[(RecSelParent, GlobalRdrElt)]]
     -> [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])])
    -> IOEnv (Env TcGblEnv TcLclEnv) [[(RecSelParent, GlobalRdrElt)]]
    -> TcM [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([LHsRecUpdField GhcRn]
    -> [[(RecSelParent, GlobalRdrElt)]]
    -> [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [LHsRecUpdField GhcRn]
    rbnds) (IOEnv (Env TcGblEnv TcLclEnv) [[(RecSelParent, GlobalRdrElt)]]
     -> TcM [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])])
    -> IOEnv (Env TcGblEnv TcLclEnv) [[(RecSelParent, GlobalRdrElt)]]
    -> TcM [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])]
    forall a b. (a -> b) -> a -> b
    $ (LHsRecUpdField GhcRn -> RnM [(RecSelParent, GlobalRdrElt)])
    -> [LHsRecUpdField GhcRn]
    -> IOEnv (Env TcGblEnv TcLclEnv) [[(RecSelParent, GlobalRdrElt)]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM
              (RdrName -> RnM [(RecSelParent, GlobalRdrElt)]
    lookupParents (RdrName -> RnM [(RecSelParent, GlobalRdrElt)])
    -> (LHsRecUpdField GhcRn -> RdrName)
    -> LHsRecUpdField GhcRn
    -> RnM [(RecSelParent, GlobalRdrElt)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located RdrName -> RdrName
    forall l e. GenLocated l e -> e
    unLoc (Located RdrName -> RdrName)
    -> (LHsRecUpdField GhcRn -> Located RdrName)
    -> LHsRecUpdField GhcRn
    -> RdrName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    -> Located RdrName
    forall (p :: Pass). HsRecUpdField (GhcPass p) -> Located RdrName
    hsRecUpdFieldRdr (HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
     -> Located RdrName)
    -> (LHsRecUpdField GhcRn
        -> HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn))
    -> LHsRecUpdField GhcRn
    -> Located RdrName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsRecUpdField GhcRn
    -> HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    forall l e. GenLocated l e -> e
    unLoc)
              [LHsRecUpdField GhcRn]
    rbnds

        -- Given a the lists of possible parents for each field,
        -- identify a single parent
        identifyParent :: FamInstEnvs -> [[RecSelParent]] -> TcM RecSelParent
        identifyParent :: FamInstEnvs -> [[RecSelParent]] -> TcM RecSelParent
    identifyParent FamInstEnvs
    fam_inst_envs [[RecSelParent]]
    possible_parents
          = case ([RecSelParent] -> [RecSelParent] -> [RecSelParent])
    -> [[RecSelParent]] -> [RecSelParent]
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 [RecSelParent] -> [RecSelParent] -> [RecSelParent]
    forall a. Eq a => [a] -> [a] -> [a]
    intersect [[RecSelParent]]
    possible_parents of
            -- No parents for all fields: record update is ill-typed
            []  -> SDoc -> TcM RecSelParent
    forall a. SDoc -> TcRn a
    failWithTc ([LHsRecUpdField GhcRn] -> SDoc
    noPossibleParents [LHsRecUpdField GhcRn]
    rbnds)

            -- Exactly one datatype with all the fields: use that
            [RecSelParent
    p] -> RecSelParent -> TcM RecSelParent
    forall (m :: * -> *) a. Monad m => a -> m a
    return RecSelParent
    p

            -- Multiple possible parents: try harder to disambiguate
            -- Can we get a parent TyCon from the pushed-in type?
            RecSelParent
    _:[RecSelParent]
    _ | Just TyCon
    p <- FamInstEnvs -> ExpRhoType -> Maybe TyCon
    tyConOfET FamInstEnvs
    fam_inst_envs ExpRhoType
    res_ty -> RecSelParent -> TcM RecSelParent
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TyCon -> RecSelParent
    RecSelData TyCon
    p)

            -- Does the expression being updated have a type signature?
            -- If so, try to extract a parent TyCon from it
                | Just {} <- HsExpr GhcRn -> Maybe (LHsSigWcType GhcRn)
    obviousSig (LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    record_expr)
                , Just TyCon
    tc <- FamInstEnvs -> TcType -> Maybe TyCon
    tyConOf FamInstEnvs
    fam_inst_envs TcType
    record_rho
                -> RecSelParent -> TcM RecSelParent
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TyCon -> RecSelParent
    RecSelData TyCon
    tc)

            -- Nothing else we can try...
            [RecSelParent]
    _ -> SDoc -> TcM RecSelParent
    forall a. SDoc -> TcRn a
    failWithTc SDoc
    badOverloadedUpdate

        -- Make a field unambiguous by choosing the given parent.
        -- Emits an error if the field cannot have that parent,
        -- e.g. if the user writes
        --     r { x = e } :: T
        -- where T does not have field x.
        pickParent :: RecSelParent
                   -> (LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])
                   -> TcM (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
        pickParent :: RecSelParent
    -> (LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    pickParent RecSelParent
    p (LHsRecUpdField GhcRn
    upd, [(RecSelParent, GlobalRdrElt)]
    xs)
          = case RecSelParent
    -> [(RecSelParent, GlobalRdrElt)] -> Maybe GlobalRdrElt
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup RecSelParent
    p [(RecSelParent, GlobalRdrElt)]
    xs of
                          -- Phew! The parent is valid for this field.
                          -- Previously ambiguous fields must be marked as
                          -- used now that we know which one is meant, but
                          -- unambiguous ones shouldn't be recorded again
                          -- (giving duplicate deprecation warnings).
              Just GlobalRdrElt
    gre -> do { Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([(RecSelParent, GlobalRdrElt)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([(RecSelParent, GlobalRdrElt)] -> [(RecSelParent, GlobalRdrElt)]
    forall a. [a] -> [a]
    tail [(RecSelParent, GlobalRdrElt)]
    xs)) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ do
                                 let L SrcSpan
    loc AmbiguousFieldOcc GhcRn
    _ = HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    -> Located (AmbiguousFieldOcc GhcRn)
    forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl (LHsRecUpdField GhcRn
    -> HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    forall l e. GenLocated l e -> e
    unLoc LHsRecUpdField GhcRn
    upd)
                                 SrcSpan -> TcRn () -> TcRn ()
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> GlobalRdrElt -> TcRn ()
    addUsedGRE Bool
    True GlobalRdrElt
    gre
                             ; (LHsRecUpdField GhcRn, Name)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    lookupSelector (LHsRecUpdField GhcRn
    upd, GlobalRdrElt -> Name
    gre_name GlobalRdrElt
    gre) }
                          -- The field doesn't belong to this parent, so report
                          -- an error but keep going through all the fields
              Maybe GlobalRdrElt
    Nothing  -> do { SDoc -> TcRn ()
    addErrTc (RecSelParent -> RdrName -> SDoc
    fieldNotInType RecSelParent
    p
                                          (Located RdrName -> RdrName
    forall l e. GenLocated l e -> e
    unLoc (HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    -> Located RdrName
    forall (p :: Pass). HsRecUpdField (GhcPass p) -> Located RdrName
    hsRecUpdFieldRdr (LHsRecUpdField GhcRn
    -> HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    forall l e. GenLocated l e -> e
    unLoc LHsRecUpdField GhcRn
    upd))))
                             ; (LHsRecUpdField GhcRn, Name)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    lookupSelector (LHsRecUpdField GhcRn
    upd, GlobalRdrElt -> Name
    gre_name ((RecSelParent, GlobalRdrElt) -> GlobalRdrElt
    forall a b. (a, b) -> b
    snd ([(RecSelParent, GlobalRdrElt)] -> (RecSelParent, GlobalRdrElt)
    forall a. [a] -> a
    head [(RecSelParent, GlobalRdrElt)]
    xs))) }

        -- Given a (field update, selector name) pair, look up the
        -- selector to give a field update with an unambiguous Id
        lookupSelector :: (LHsRecUpdField GhcRn, Name)
                     -> TcM (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
        lookupSelector :: (LHsRecUpdField GhcRn, Name)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    lookupSelector (L SrcSpan
    l HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    upd, Name
    n)
          = do { Var
    i <- Name -> TcM Var
    tcLookupId Name
    n
               ; let L SrcSpan
    loc AmbiguousFieldOcc GhcRn
    af = HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    -> Located (AmbiguousFieldOcc GhcRn)
    forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    upd
                     lbl :: RdrName
    lbl      = AmbiguousFieldOcc GhcRn -> RdrName
    forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
    rdrNameAmbiguousFieldOcc AmbiguousFieldOcc GhcRn
    af
               ; LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)))
    -> LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    forall a b. (a -> b) -> a -> b
    $ SrcSpan
    -> HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    upd { hsRecFieldLbl :: GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    hsRecFieldLbl
                                      = SrcSpan
    -> AmbiguousFieldOcc GhcTc
    -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XUnambiguous GhcTc -> Located RdrName -> AmbiguousFieldOcc GhcTc
    forall pass.
    XUnambiguous pass -> Located RdrName -> AmbiguousFieldOcc pass
    Unambiguous Var
    XUnambiguous GhcTc
    i (SrcSpan -> RdrName -> Located RdrName
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc RdrName
    lbl)) } }

    -- 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 -> TcType -> Maybe TyCon
    tyConOf FamInstEnvs
    fam_inst_envs TcType
    ty0
      = case HasCallStack => TcType -> Maybe (TyCon, [TcType])
    TcType -> Maybe (TyCon, [TcType])
    tcSplitTyConApp_maybe TcType
    ty of
          Just (TyCon
    tc, [TcType]
    tys) -> TyCon -> Maybe TyCon
    forall a. a -> Maybe a
    Just ((TyCon, [TcType], TcCoercionR) -> TyCon
    forall a b c. (a, b, c) -> a
    fstOf3 (FamInstEnvs -> TyCon -> [TcType] -> (TyCon, [TcType], TcCoercionR)
    tcLookupDataFamInst FamInstEnvs
    fam_inst_envs TyCon
    tc [TcType]
    tys))
          Maybe (TyCon, [TcType])
    Nothing        -> Maybe TyCon
    forall a. Maybe a
    Nothing
      where
        ([Var]
    _, [TcType]
    _, TcType
    ty) = TcType -> ([Var], [TcType], TcType)
    tcSplitSigmaTy TcType
    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 -> TcType -> Maybe TyCon
    tyConOf FamInstEnvs
    fam_inst_envs (TcType -> Maybe TyCon) -> Maybe TcType -> Maybe TyCon
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ExpRhoType -> Maybe TcType
    checkingExpType_maybe ExpRhoType
    ty0

    -- For an ambiguous record field, find all the candidate record
    -- selectors (as GlobalRdrElts) and their parents.
    lookupParents :: RdrName -> RnM [(RecSelParent, GlobalRdrElt)]
    lookupParents :: RdrName -> RnM [(RecSelParent, GlobalRdrElt)]
    lookupParents RdrName
    rdr
      = do { GlobalRdrEnv
    env <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
           ; let gres :: [GlobalRdrElt]
    gres = RdrName -> GlobalRdrEnv -> [GlobalRdrElt]
    lookupGRE_RdrName RdrName
    rdr GlobalRdrEnv
    env
           ; (GlobalRdrElt
     -> IOEnv (Env TcGblEnv TcLclEnv) (RecSelParent, GlobalRdrElt))
    -> [GlobalRdrElt] -> RnM [(RecSelParent, GlobalRdrElt)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GlobalRdrElt
    -> IOEnv (Env TcGblEnv TcLclEnv) (RecSelParent, GlobalRdrElt)
    lookupParent [GlobalRdrElt]
    gres }
      where
        lookupParent :: GlobalRdrElt -> RnM (RecSelParent, GlobalRdrElt)
        lookupParent :: GlobalRdrElt
    -> IOEnv (Env TcGblEnv TcLclEnv) (RecSelParent, GlobalRdrElt)
    lookupParent GlobalRdrElt
    gre = do { Var
    id <- Name -> TcM Var
    tcLookupId (GlobalRdrElt -> Name
    gre_name GlobalRdrElt
    gre)
                              ; if Var -> Bool
    isRecordSelector Var
    id
                                  then (RecSelParent, GlobalRdrElt)
    -> IOEnv (Env TcGblEnv TcLclEnv) (RecSelParent, GlobalRdrElt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Var -> RecSelParent
    recordSelectorTyCon Var
    id, GlobalRdrElt
    gre)
                                  else SDoc -> IOEnv (Env TcGblEnv TcLclEnv) (RecSelParent, GlobalRdrElt)
    forall a. SDoc -> TcRn a
    failWithTc (Name -> SDoc
    notSelector (GlobalRdrElt -> Name
    gre_name GlobalRdrElt
    gre)) }

    -- 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 GhcRn -> Maybe (LHsSigWcType GhcRn)
    obviousSig (ExprWithTySig XExprWithTySig GhcRn
    _ LHsExpr GhcRn
    _ LHsSigWcType (NoGhcTc GhcRn)
    ty) = LHsSigWcType GhcRn -> Maybe (LHsSigWcType GhcRn)
    forall a. a -> Maybe a
    Just LHsSigWcType GhcRn
    LHsSigWcType (NoGhcTc GhcRn)
    ty
    obviousSig (HsPar XPar GhcRn
    _ LHsExpr GhcRn
    p)          = HsExpr GhcRn -> Maybe (LHsSigWcType GhcRn)
    obviousSig (LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    p)
    obviousSig HsExpr GhcRn
    _                    = Maybe (LHsSigWcType GhcRn)
    forall a. Maybe a
    Nothing

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

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

    For each binding field = value

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

    4  Type check the value using tcArg, passing the field type as
       the expected argument type.

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

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

    tcRecordBinds :: ConLike
    -> [TcType] -> HsRecordBinds GhcRn -> TcM (HsRecordBinds GhcTc)
    tcRecordBinds ConLike
    con_like [TcType]
    arg_tys (HsRecFields [LHsRecField GhcRn (LHsExpr GhcRn)]
    rbinds Maybe (Located ThLevel)
    dd)
      = do  { [Maybe (LHsRecField GhcTc (LHsExpr GhcTc))]
    mb_binds <- (LHsRecField GhcRn (LHsExpr GhcRn)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (Maybe (LHsRecField GhcTc (LHsExpr GhcTc))))
    -> [LHsRecField GhcRn (LHsExpr GhcRn)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) [Maybe (LHsRecField GhcTc (LHsExpr GhcTc))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM LHsRecField GhcRn (LHsExpr GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Maybe (LHsRecField GhcTc (LHsExpr GhcTc)))
    do_bind [LHsRecField GhcRn (LHsExpr GhcRn)]
    rbinds
            ; HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([LHsRecField GhcTc (LHsExpr GhcTc)]
    -> Maybe (Located ThLevel) -> HsRecordBinds GhcTc
    forall p arg.
    [LHsRecField p arg] -> Maybe (Located ThLevel) -> HsRecFields p arg
    HsRecFields ([Maybe (LHsRecField GhcTc (LHsExpr GhcTc))]
    -> [LHsRecField GhcTc (LHsExpr GhcTc)]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe (LHsRecField GhcTc (LHsExpr GhcTc))]
    mb_binds) Maybe (Located ThLevel)
    dd) }
      where
        fields :: [Name]
    fields = (FieldLbl Name -> Name) -> [FieldLbl Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLbl Name -> Name
    forall a. FieldLbl a -> a
    flSelector ([FieldLbl Name] -> [Name]) -> [FieldLbl Name] -> [Name]
    forall a b. (a -> b) -> a -> b
    $ ConLike -> [FieldLbl Name]
    conLikeFieldLabels ConLike
    con_like
        flds_w_tys :: [(Name, TcType)]
    flds_w_tys = String -> [Name] -> [TcType] -> [(Name, TcType)]
    forall a b. String -> [a] -> [b] -> [(a, b)]
    zipEqual String
    "tcRecordBinds" [Name]
    fields [TcType]
    arg_tys

        do_bind :: LHsRecField GhcRn (LHsExpr GhcRn)
                -> TcM (Maybe (LHsRecField GhcTc (LHsExpr GhcTc)))
        do_bind :: LHsRecField GhcRn (LHsExpr GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Maybe (LHsRecField GhcTc (LHsExpr GhcTc)))
    do_bind (L SrcSpan
    l fld :: HsRecField GhcRn (LHsExpr GhcRn)
    fld@(HsRecField { hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl = Located (FieldOcc GhcRn)
    f
                                     , hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
    hsRecFieldArg = LHsExpr GhcRn
    rhs }))

          = do { Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)
    mb <- ConLike
    -> [(Name, TcType)]
    -> Located (FieldOcc GhcRn)
    -> LHsExpr GhcRn
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    tcRecordField ConLike
    con_like [(Name, TcType)]
    flds_w_tys Located (FieldOcc GhcRn)
    f LHsExpr GhcRn
    rhs
               ; case Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)
    mb of
                   Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)
    Nothing         -> Maybe (LHsRecField GhcTc (LHsExpr GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Maybe (LHsRecField GhcTc (LHsExpr GhcTc)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (LHsRecField GhcTc (LHsExpr GhcTc))
    forall a. Maybe a
    Nothing
                   Just (LFieldOcc GhcTc
    f', LHsExpr GhcTc
    rhs') -> Maybe (LHsRecField GhcTc (LHsExpr GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Maybe (LHsRecField GhcTc (LHsExpr GhcTc)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsRecField GhcTc (LHsExpr GhcTc)
    -> Maybe (LHsRecField GhcTc (LHsExpr GhcTc))
    forall a. a -> Maybe a
    Just (SrcSpan
    -> HsRecField' (FieldOcc GhcTc) (LHsExpr GhcTc)
    -> LHsRecField GhcTc (LHsExpr GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l (HsRecField GhcRn (LHsExpr GhcRn)
    fld { hsRecFieldLbl :: LFieldOcc GhcTc
    hsRecFieldLbl = LFieldOcc GhcTc
    f'
                                                              , hsRecFieldArg :: LHsExpr GhcTc
    hsRecFieldArg = LHsExpr GhcTc
    rhs' }))) }

    tcRecordUpd
            :: ConLike
            -> [TcType]     -- Expected type for each field
            -> [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
            -> TcM [LHsRecUpdField GhcTc]

    tcRecordUpd :: ConLike
    -> [TcType]
    -> [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> TcM [LHsRecUpdField GhcTc]
    tcRecordUpd ConLike
    con_like [TcType]
    arg_tys [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds = ([Maybe (LHsRecUpdField GhcTc)] -> [LHsRecUpdField GhcTc])
    -> IOEnv (Env TcGblEnv TcLclEnv) [Maybe (LHsRecUpdField GhcTc)]
    -> TcM [LHsRecUpdField GhcTc]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Maybe (LHsRecUpdField GhcTc)] -> [LHsRecUpdField GhcTc]
    forall a. [Maybe a] -> [a]
    catMaybes (IOEnv (Env TcGblEnv TcLclEnv) [Maybe (LHsRecUpdField GhcTc)]
     -> TcM [LHsRecUpdField GhcTc])
    -> IOEnv (Env TcGblEnv TcLclEnv) [Maybe (LHsRecUpdField GhcTc)]
    -> TcM [LHsRecUpdField GhcTc]
    forall a b. (a -> b) -> a -> b
    $ (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (LHsRecUpdField GhcTc)))
    -> [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [Maybe (LHsRecUpdField GhcTc)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (LHsRecUpdField GhcTc))
    do_bind [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds
      where
        fields :: [Name]
    fields = (FieldLbl Name -> Name) -> [FieldLbl Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLbl Name -> Name
    forall a. FieldLbl a -> a
    flSelector ([FieldLbl Name] -> [Name]) -> [FieldLbl Name] -> [Name]
    forall a b. (a -> b) -> a -> b
    $ ConLike -> [FieldLbl Name]
    conLikeFieldLabels ConLike
    con_like
        flds_w_tys :: [(Name, TcType)]
    flds_w_tys = String -> [Name] -> [TcType] -> [(Name, TcType)]
    forall a b. String -> [a] -> [b] -> [(a, b)]
    zipEqual String
    "tcRecordUpd" [Name]
    fields [TcType]
    arg_tys

        do_bind :: LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
                -> TcM (Maybe (LHsRecUpdField GhcTc))
        do_bind :: LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (LHsRecUpdField GhcTc))
    do_bind (L SrcSpan
    l fld :: HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    fld@(HsRecField { hsRecFieldLbl :: forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl = L SrcSpan
    loc AmbiguousFieldOcc GhcTc
    af
                                     , hsRecFieldArg :: forall id arg. HsRecField' id arg -> arg
    hsRecFieldArg = LHsExpr GhcRn
    rhs }))
          = do { let lbl :: RdrName
    lbl = AmbiguousFieldOcc GhcTc -> RdrName
    forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
    rdrNameAmbiguousFieldOcc AmbiguousFieldOcc GhcTc
    af
                     sel_id :: Var
    sel_id = AmbiguousFieldOcc GhcTc -> Var
    selectorAmbiguousFieldOcc AmbiguousFieldOcc GhcTc
    af
                     f :: Located (FieldOcc GhcRn)
    f = SrcSpan -> FieldOcc GhcRn -> Located (FieldOcc GhcRn)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XCFieldOcc GhcRn -> Located RdrName -> FieldOcc GhcRn
    forall pass. XCFieldOcc pass -> Located RdrName -> FieldOcc pass
    FieldOcc (Var -> Name
    idName Var
    sel_id) (SrcSpan -> RdrName -> Located RdrName
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc RdrName
    lbl))
               ; Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)
    mb <- ConLike
    -> [(Name, TcType)]
    -> Located (FieldOcc GhcRn)
    -> LHsExpr GhcRn
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    tcRecordField ConLike
    con_like [(Name, TcType)]
    flds_w_tys Located (FieldOcc GhcRn)
    f LHsExpr GhcRn
    rhs
               ; case Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)
    mb of
                   Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)
    Nothing         -> Maybe (LHsRecUpdField GhcTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (LHsRecUpdField GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (LHsRecUpdField GhcTc)
    forall a. Maybe a
    Nothing
                   Just (LFieldOcc GhcTc
    f', LHsExpr GhcTc
    rhs') ->
                     Maybe (LHsRecUpdField GhcTc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (LHsRecUpdField GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsRecUpdField GhcTc -> Maybe (LHsRecUpdField GhcTc)
    forall a. a -> Maybe a
    Just
                             (SrcSpan
    -> HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcTc)
    -> LHsRecUpdField GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l (HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    fld { hsRecFieldLbl :: GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    hsRecFieldLbl
                                          = SrcSpan
    -> AmbiguousFieldOcc GhcTc
    -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XUnambiguous GhcTc -> Located RdrName -> AmbiguousFieldOcc GhcTc
    forall pass.
    XUnambiguous pass -> Located RdrName -> AmbiguousFieldOcc pass
    Unambiguous
                                                   (FieldOcc GhcTc -> XCFieldOcc GhcTc
    forall pass. FieldOcc pass -> XCFieldOcc pass
    extFieldOcc (LFieldOcc GhcTc -> FieldOcc GhcTc
    forall l e. GenLocated l e -> e
    unLoc LFieldOcc GhcTc
    f'))
                                                   (SrcSpan -> RdrName -> Located RdrName
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc RdrName
    lbl))
                                       , hsRecFieldArg :: LHsExpr GhcTc
    hsRecFieldArg = LHsExpr GhcTc
    rhs' }))) }

    tcRecordField :: ConLike -> Assoc Name Type
                  -> LFieldOcc GhcRn -> LHsExpr GhcRn
                  -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    tcRecordField :: ConLike
    -> [(Name, TcType)]
    -> Located (FieldOcc GhcRn)
    -> LHsExpr GhcRn
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    tcRecordField ConLike
    con_like [(Name, TcType)]
    flds_w_tys (L SrcSpan
    loc (FieldOcc XCFieldOcc GhcRn
    sel_name Located RdrName
    lbl)) LHsExpr GhcRn
    rhs
      | Just TcType
    field_ty <- [(Name, TcType)] -> Name -> Maybe TcType
    forall a b. Eq a => Assoc a b -> a -> Maybe b
    assocMaybe [(Name, TcType)]
    flds_w_tys Name
    XCFieldOcc GhcRn
    sel_name
          = SDoc
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (FieldLabelString -> SDoc
    fieldCtxt FieldLabelString
    field_lbl) (TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
     -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)))
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $
            do { LHsExpr GhcTc
    rhs' <- LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExprNC LHsExpr GhcRn
    rhs TcType
    field_ty
               ; let field_id :: Var
    field_id = OccName -> Unique -> TcType -> TcType -> SrcSpan -> Var
    mkUserLocal (Name -> OccName
    nameOccName Name
    XCFieldOcc GhcRn
    sel_name)
                                            (Name -> Unique
    nameUnique Name
    XCFieldOcc GhcRn
    sel_name)
                                            TcType
    Many TcType
    field_ty SrcSpan
    loc
                    -- Yuk: the field_id has the *unique* of the selector Id
                    --          (so we can find it easily)
                    --      but is a LocalId with the appropriate type of the RHS
                    --          (so the desugarer knows the type of local binder to make)
               ; Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((LFieldOcc GhcTc, LHsExpr GhcTc)
    -> Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)
    forall a. a -> Maybe a
    Just (SrcSpan -> FieldOcc GhcTc -> LFieldOcc GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XCFieldOcc GhcTc -> Located RdrName -> FieldOcc GhcTc
    forall pass. XCFieldOcc pass -> Located RdrName -> FieldOcc pass
    FieldOcc Var
    XCFieldOcc GhcTc
    field_id Located RdrName
    lbl), LHsExpr GhcTc
    rhs')) }
          | Bool
    otherwise
          = do { SDoc -> TcRn ()
    addErrTc (ConLike -> FieldLabelString -> SDoc
    badFieldCon ConLike
    con_like FieldLabelString
    field_lbl)
               ; Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (LFieldOcc GhcTc, LHsExpr GhcTc)
    forall a. Maybe a
    Nothing }
      where
            field_lbl :: FieldLabelString
    field_lbl = OccName -> FieldLabelString
    occNameFS (OccName -> FieldLabelString) -> OccName -> FieldLabelString
    forall a b. (a -> b) -> a -> b
    $ RdrName -> OccName
    rdrNameOcc (Located RdrName -> RdrName
    forall l e. GenLocated l e -> e
    unLoc Located RdrName
    lbl)

    checkMissingFields ::  ConLike -> HsRecordBinds GhcRn -> TcM ()
    checkMissingFields :: ConLike -> HsRecordBinds GhcRn -> TcRn ()
    checkMissingFields ConLike
    con_like HsRecordBinds GhcRn
    rbinds
      | [FieldLbl Name] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldLbl Name]
    field_labels   -- Not declared as a record;
                            -- But C{} is still valid if no strict fields
      = if (HsImplBang -> Bool) -> [HsImplBang] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any HsImplBang -> Bool
    isBanged [HsImplBang]
    field_strs then
            -- Illegal if any arg is strict
            SDoc -> TcRn ()
    addErrTc (ConLike -> [FieldLabelString] -> SDoc
    missingStrictFields ConLike
    con_like [])
        else do
            Bool
    warn <- WarningFlag -> TcRn Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnMissingFields
            Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    warn Bool -> Bool -> Bool
    && [HsImplBang] -> Bool
    forall a. [a] -> Bool
    notNull [HsImplBang]
    field_strs Bool -> Bool -> Bool
    && [FieldLbl Name] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldLbl Name]
    field_labels)
                 (WarnReason -> Bool -> SDoc -> TcRn ()
    warnTc (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnMissingFields) Bool
    True
                     (ConLike -> [FieldLabelString] -> SDoc
    missingFields ConLike
    con_like []))

      | Bool
    otherwise = do              -- A record
        Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([FieldLabelString] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldLabelString]
    missing_s_fields)
               (SDoc -> TcRn ()
    addErrTc (ConLike -> [FieldLabelString] -> SDoc
    missingStrictFields ConLike
    con_like [FieldLabelString]
    missing_s_fields))

        Bool
    warn <- WarningFlag -> TcRn Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnMissingFields
        Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    warn Bool -> Bool -> Bool
    && [FieldLabelString] -> Bool
    forall a. [a] -> Bool
    notNull [FieldLabelString]
    missing_ns_fields)
             (WarnReason -> Bool -> SDoc -> TcRn ()
    warnTc (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnMissingFields) Bool
    True
                 (ConLike -> [FieldLabelString] -> SDoc
    missingFields ConLike
    con_like [FieldLabelString]
    missing_ns_fields))

      where
        missing_s_fields :: [FieldLabelString]
    missing_s_fields
            = [ FieldLbl Name -> FieldLabelString
    forall a. FieldLbl a -> FieldLabelString
    flLabel FieldLbl Name
    fl | (FieldLbl Name
    fl, HsImplBang
    str) <- [(FieldLbl Name, HsImplBang)]
    field_info,
                     HsImplBang -> Bool
    isBanged HsImplBang
    str,
                     Bool -> Bool
    not (FieldLbl Name
    fl FieldLbl Name -> [Name] -> Bool
    forall {t :: * -> *} {a}.
    (Foldable t, Eq a) =>
    FieldLbl a -> t a -> Bool
    `elemField` [Name]
    [XCFieldOcc GhcRn]
    field_names_used)
              ]
        missing_ns_fields :: [FieldLabelString]
    missing_ns_fields
            = [ FieldLbl Name -> FieldLabelString
    forall a. FieldLbl a -> FieldLabelString
    flLabel FieldLbl Name
    fl | (FieldLbl Name
    fl, HsImplBang
    str) <- [(FieldLbl Name, HsImplBang)]
    field_info,
                     Bool -> Bool
    not (HsImplBang -> Bool
    isBanged HsImplBang
    str),
                     Bool -> Bool
    not (FieldLbl Name
    fl FieldLbl Name -> [Name] -> Bool
    forall {t :: * -> *} {a}.
    (Foldable t, Eq a) =>
    FieldLbl a -> t a -> Bool
    `elemField` [Name]
    [XCFieldOcc GhcRn]
    field_names_used)
              ]

        field_names_used :: [XCFieldOcc GhcRn]
    field_names_used = HsRecordBinds GhcRn -> [XCFieldOcc GhcRn]
    forall p arg. HsRecFields p arg -> [XCFieldOcc p]
    hsRecFields HsRecordBinds GhcRn
    rbinds
        field_labels :: [FieldLbl Name]
    field_labels     = ConLike -> [FieldLbl Name]
    conLikeFieldLabels ConLike
    con_like

        field_info :: [(FieldLbl Name, HsImplBang)]
    field_info = String
    -> [FieldLbl Name] -> [HsImplBang] -> [(FieldLbl Name, HsImplBang)]
    forall a b. String -> [a] -> [b] -> [(a, b)]
    zipEqual String
    "missingFields"
                              [FieldLbl Name]
    field_labels
                              [HsImplBang]
    field_strs

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

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

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

    Boring and alphabetical:
    -}

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

    addExprCtxt :: LHsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt :: forall a. LHsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt LHsExpr GhcRn
    e TcRn a
    thing_inside = SDoc -> TcRn a -> TcRn a
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (HsExpr GhcRn -> SDoc
    exprCtxt (LHsExpr GhcRn -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcRn
    e)) TcRn a
    thing_inside

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

    addFunResCtxt :: Bool  -- There is at least one argument
                  -> HsExpr GhcTc -> 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
    --
    -- Used for naked variables too; but with has_args = False
    addFunResCtxt :: forall a.
    Bool -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM a -> TcM a
    addFunResCtxt Bool
    has_args HsExpr GhcTc
    fun TcType
    fun_res_ty ExpRhoType
    env_ty
      = (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    forall a. (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    addLandmarkErrCtxtM (\TidyEnv
    env -> (TidyEnv
    env, ) (SDoc -> (TidyEnv, SDoc))
    -> IOEnv (Env TcGblEnv TcLclEnv) SDoc -> TcM (TidyEnv, SDoc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IOEnv (Env TcGblEnv TcLclEnv) SDoc
    mk_msg)
          -- 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 TcType
    mb_env_ty <- ExpRhoType -> TcM (Maybe TcType)
    readExpType_maybe ExpRhoType
    env_ty
                         -- by the time the message is rendered, the ExpType
                         -- will be filled in (except if we're debugging)
               ; TcType
    fun_res' <- TcType -> TcM TcType
    zonkTcType TcType
    fun_res_ty
               ; TcType
    env'     <- case Maybe TcType
    mb_env_ty of
                               Just TcType
    env_ty -> TcType -> TcM TcType
    zonkTcType TcType
    env_ty
                               Maybe TcType
    Nothing     ->
                                 do { Bool
    dumping <- DumpFlag -> TcRn Bool
    forall gbl lcl. DumpFlag -> TcRnIf gbl lcl Bool
    doptM DumpFlag
    Opt_D_dump_tc_trace
                                    ; MASSERT( dumping )
                                    ; TcType -> TcM TcType
    newFlexiTyVarTy TcType
    liftedTypeKind }
               ; let -- See Note [Splitting nested sigma types in mismatched
                     --           function types]
                     ([Var]
    _, [TcType]
    _, TcType
    fun_tau) = TcType -> ([Var], [TcType], TcType)
    tcSplitNestedSigmaTys TcType
    fun_res'
                     -- No need to call tcSplitNestedSigmaTys here, since env_ty is
                     -- an ExpRhoTy, i.e., it's already instantiated.
                     ([Var]
    _, [TcType]
    _, TcType
    env_tau) = TcType -> ([Var], [TcType], TcType)
    tcSplitSigmaTy TcType
    env'
                     ([Scaled TcType]
    args_fun, TcType
    res_fun) = TcType -> ([Scaled TcType], TcType)
    tcSplitFunTys TcType
    fun_tau
                     ([Scaled TcType]
    args_env, TcType
    res_env) = TcType -> ([Scaled TcType], TcType)
    tcSplitFunTys TcType
    env_tau
                     n_fun :: ThLevel
    n_fun = [Scaled TcType] -> ThLevel
    forall (t :: * -> *) a. Foldable t => t a -> ThLevel
    length [Scaled TcType]
    args_fun
                     n_env :: ThLevel
    n_env = [Scaled TcType] -> ThLevel
    forall (t :: * -> *) a. Foldable t => t a -> ThLevel
    length [Scaled TcType]
    args_env
                     info :: SDoc
    info  | ThLevel
    n_fun ThLevel -> ThLevel -> Bool
    forall a. Eq a => a -> a -> Bool
    == ThLevel
    n_env = SDoc
    Outputable.empty
                           | ThLevel
    n_fun ThLevel -> ThLevel -> Bool
    forall a. Ord a => a -> a -> Bool
    > ThLevel
    n_env
                           , TcType -> Bool
    not_fun TcType
    res_env
                           = String -> SDoc
    text String
    "Probable cause:" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (HsExpr GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcTc
    fun)
                             SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is applied to too few arguments"

                           | Bool
    has_args
                           , TcType -> Bool
    not_fun TcType
    res_fun
                           = String -> SDoc
    text String
    "Possible cause:" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (HsExpr GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcTc
    fun)
                             SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is applied to too many arguments"

                           | Bool
    otherwise
                           = SDoc
    Outputable.empty  -- Never suggest that a naked variable is                                         -- applied to too many args!
               ; SDoc -> IOEnv (Env TcGblEnv TcLclEnv) SDoc
    forall (m :: * -> *) a. Monad m => a -> m a
    return SDoc
    info }
          where
            not_fun :: TcType -> Bool
    not_fun TcType
    ty   -- ty is definitely not an arrow type,
                         -- and cannot conceivably become one
              = case HasCallStack => TcType -> Maybe (TyCon, [TcType])
    TcType -> Maybe (TyCon, [TcType])
    tcSplitTyConApp_maybe TcType
    ty of
                  Just (TyCon
    tc, [TcType]
    _) -> TyCon -> Bool
    isAlgTyCon TyCon
    tc
                  Maybe (TyCon, [TcType])
    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 Trac
    #13311, for instance:

      f :: forall a. (Monoid a) => 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: 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: [Maybe a]
      Return type: Maybe b

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

    badFieldTypes :: [(FieldLabelString,TcType)] -> SDoc
    badFieldTypes :: [(FieldLabelString, TcType)] -> SDoc
    badFieldTypes [(FieldLabelString, TcType)]
    prs
      = SDoc -> ThLevel -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Record update for insufficiently polymorphic field"
                             SDoc -> SDoc -> SDoc
    <> [(FieldLabelString, TcType)] -> SDoc
    forall a. [a] -> SDoc
    plural [(FieldLabelString, TcType)]
    prs SDoc -> SDoc -> SDoc
    <> SDoc
    colon)
           ThLevel
    2 ([SDoc] -> SDoc
    vcat [ FieldLabelString -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr FieldLabelString
    f SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    ty | (FieldLabelString
    f,TcType
    ty) <- [(FieldLabelString, TcType)]
    prs ])

    badFieldsUpd
      :: [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
                   -- Field names that don't belong to a single datacon
      -> [ConLike] -- Data cons of the type which the first field name belongs to
      -> SDoc
    badFieldsUpd :: [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> [ConLike] -> SDoc
    badFieldsUpd [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds [ConLike]
    data_cons
      = SDoc -> ThLevel -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "No constructor has all these fields:")
           ThLevel
    2 ([FieldLabelString] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [FieldLabelString]
    conflictingFields)
              -- See Note [Finding the conflicting fields]
      where
        -- A (preferably small) set of fields such that no constructor contains
        -- all of them.  See Note [Finding the conflicting fields]
        conflictingFields :: [FieldLabelString]
    conflictingFields = case [(FieldLabelString, [Bool])]
    nonMembers of
            -- nonMember belongs to a different type.
            (FieldLabelString
    nonMember, [Bool]
    _) : [(FieldLabelString, [Bool])]
    _ -> [FieldLabelString
    aMember, FieldLabelString
    nonMember]
            [] -> let
                -- All of rbinds belong to one type. In this case, repeatedly add
                -- a field to the set until no constructor contains the set.

                -- Each field, together with a list indicating which constructors
                -- have all the fields so far.
                growingSets :: [(FieldLabelString, [Bool])]
                growingSets :: [(FieldLabelString, [Bool])]
    growingSets = ((FieldLabelString, [Bool])
     -> (FieldLabelString, [Bool]) -> (FieldLabelString, [Bool]))
    -> [(FieldLabelString, [Bool])] -> [(FieldLabelString, [Bool])]
    forall a. (a -> a -> a) -> [a] -> [a]
    scanl1 (FieldLabelString, [Bool])
    -> (FieldLabelString, [Bool]) -> (FieldLabelString, [Bool])
    forall {a} {a}. (a, [Bool]) -> (a, [Bool]) -> (a, [Bool])
    combine [(FieldLabelString, [Bool])]
    membership
                combine :: (a, [Bool]) -> (a, [Bool]) -> (a, [Bool])
    combine (a
    _, [Bool]
    setMem) (a
    field, [Bool]
    fldMem)
                  = (a
    field, (Bool -> Bool -> Bool) -> [Bool] -> [Bool] -> [Bool]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Bool -> Bool -> Bool
    (&&) [Bool]
    setMem [Bool]
    fldMem)
                in
                -- Fields that don't change the membership status of the set
                -- are redundant and can be dropped.
                ([(FieldLabelString, [Bool])] -> FieldLabelString)
    -> [[(FieldLabelString, [Bool])]] -> [FieldLabelString]
    forall a b. (a -> b) -> [a] -> [b]
    map ((FieldLabelString, [Bool]) -> FieldLabelString
    forall a b. (a, b) -> a
    fst ((FieldLabelString, [Bool]) -> FieldLabelString)
    -> ([(FieldLabelString, [Bool])] -> (FieldLabelString, [Bool]))
    -> [(FieldLabelString, [Bool])]
    -> FieldLabelString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(FieldLabelString, [Bool])] -> (FieldLabelString, [Bool])
    forall a. [a] -> a
    head) ([[(FieldLabelString, [Bool])]] -> [FieldLabelString])
    -> [[(FieldLabelString, [Bool])]] -> [FieldLabelString]
    forall a b. (a -> b) -> a -> b
    $ ((FieldLabelString, [Bool]) -> (FieldLabelString, [Bool]) -> Bool)
    -> [(FieldLabelString, [Bool])] -> [[(FieldLabelString, [Bool])]]
    forall a. (a -> a -> Bool) -> [a] -> [[a]]
    groupBy ([Bool] -> [Bool] -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ([Bool] -> [Bool] -> Bool)
    -> ((FieldLabelString, [Bool]) -> [Bool])
    -> (FieldLabelString, [Bool])
    -> (FieldLabelString, [Bool])
    -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (FieldLabelString, [Bool]) -> [Bool]
    forall a b. (a, b) -> b
    snd) [(FieldLabelString, [Bool])]
    growingSets

        aMember :: FieldLabelString
    aMember = ASSERT( not (null members) ) fst (head members)
        ([(FieldLabelString, [Bool])]
    members, [(FieldLabelString, [Bool])]
    nonMembers) = ((FieldLabelString, [Bool]) -> Bool)
    -> [(FieldLabelString, [Bool])]
    -> ([(FieldLabelString, [Bool])], [(FieldLabelString, [Bool])])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ([Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or ([Bool] -> Bool)
    -> ((FieldLabelString, [Bool]) -> [Bool])
    -> (FieldLabelString, [Bool])
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FieldLabelString, [Bool]) -> [Bool]
    forall a b. (a, b) -> b
    snd) [(FieldLabelString, [Bool])]
    membership

        -- For each field, which constructors contain the field?
        membership :: [(FieldLabelString, [Bool])]
        membership :: [(FieldLabelString, [Bool])]
    membership = [(FieldLabelString, [Bool])] -> [(FieldLabelString, [Bool])]
    forall {a}. [(a, [Bool])] -> [(a, [Bool])]
    sortMembership ([(FieldLabelString, [Bool])] -> [(FieldLabelString, [Bool])])
    -> [(FieldLabelString, [Bool])] -> [(FieldLabelString, [Bool])]
    forall a b. (a -> b) -> a -> b
    $
            (FieldLabelString -> (FieldLabelString, [Bool]))
    -> [FieldLabelString] -> [(FieldLabelString, [Bool])]
    forall a b. (a -> b) -> [a] -> [b]
    map (\FieldLabelString
    fld -> (FieldLabelString
    fld, (Set FieldLabelString -> Bool) -> [Set FieldLabelString] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map (FieldLabelString -> Set FieldLabelString -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member FieldLabelString
    fld) [Set FieldLabelString]
    fieldLabelSets)) ([FieldLabelString] -> [(FieldLabelString, [Bool])])
    -> [FieldLabelString] -> [(FieldLabelString, [Bool])]
    forall a b. (a -> b) -> a -> b
    $
              (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
     -> FieldLabelString)
    -> [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> [FieldLabelString]
    forall a b. (a -> b) -> [a] -> [b]
    map (OccName -> FieldLabelString
    occNameFS (OccName -> FieldLabelString)
    -> (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
        -> OccName)
    -> LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> FieldLabelString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RdrName -> OccName
    rdrNameOcc (RdrName -> OccName)
    -> (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
        -> RdrName)
    -> LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> OccName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AmbiguousFieldOcc GhcTc -> RdrName
    forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
    rdrNameAmbiguousFieldOcc (AmbiguousFieldOcc GhcTc -> RdrName)
    -> (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
        -> AmbiguousFieldOcc GhcTc)
    -> LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> RdrName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    -> AmbiguousFieldOcc GhcTc
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
     -> AmbiguousFieldOcc GhcTc)
    -> (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
        -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc))
    -> LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> AmbiguousFieldOcc GhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl (HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
     -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc))
    -> (LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
        -> HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    -> LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> HsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    forall l e. GenLocated l e -> e
    unLoc) [LHsRecField' (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds

        fieldLabelSets :: [Set.Set FieldLabelString]
        fieldLabelSets :: [Set FieldLabelString]
    fieldLabelSets = (ConLike -> Set FieldLabelString)
    -> [ConLike] -> [Set FieldLabelString]
    forall a b. (a -> b) -> [a] -> [b]
    map ([FieldLabelString] -> Set FieldLabelString
    forall a. Ord a => [a] -> Set a
    Set.fromList ([FieldLabelString] -> Set FieldLabelString)
    -> (ConLike -> [FieldLabelString])
    -> ConLike
    -> Set FieldLabelString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FieldLbl Name -> FieldLabelString)
    -> [FieldLbl Name] -> [FieldLabelString]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLbl Name -> FieldLabelString
    forall a. FieldLbl a -> FieldLabelString
    flLabel ([FieldLbl Name] -> [FieldLabelString])
    -> (ConLike -> [FieldLbl Name]) -> ConLike -> [FieldLabelString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConLike -> [FieldLbl Name]
    conLikeFieldLabels) [ConLike]
    data_cons

        -- Sort in order of increasing number of True, so that a smaller
        -- conflicting set can be found.
        sortMembership :: [(a, [Bool])] -> [(a, [Bool])]
    sortMembership =
          ((ThLevel, (a, [Bool])) -> (a, [Bool]))
    -> [(ThLevel, (a, [Bool]))] -> [(a, [Bool])]
    forall a b. (a -> b) -> [a] -> [b]
    map (ThLevel, (a, [Bool])) -> (a, [Bool])
    forall a b. (a, b) -> b
    snd ([(ThLevel, (a, [Bool]))] -> [(a, [Bool])])
    -> ([(a, [Bool])] -> [(ThLevel, (a, [Bool]))])
    -> [(a, [Bool])]
    -> [(a, [Bool])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          ((ThLevel, (a, [Bool])) -> (ThLevel, (a, [Bool])) -> Ordering)
    -> [(ThLevel, (a, [Bool]))] -> [(ThLevel, (a, [Bool]))]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (ThLevel -> ThLevel -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (ThLevel -> ThLevel -> Ordering)
    -> ((ThLevel, (a, [Bool])) -> ThLevel)
    -> (ThLevel, (a, [Bool]))
    -> (ThLevel, (a, [Bool]))
    -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (ThLevel, (a, [Bool])) -> ThLevel
    forall a b. (a, b) -> a
    fst) ([(ThLevel, (a, [Bool]))] -> [(ThLevel, (a, [Bool]))])
    -> ([(a, [Bool])] -> [(ThLevel, (a, [Bool]))])
    -> [(a, [Bool])]
    -> [(ThLevel, (a, [Bool]))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          ((a, [Bool]) -> (ThLevel, (a, [Bool])))
    -> [(a, [Bool])] -> [(ThLevel, (a, [Bool]))]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ item :: (a, [Bool])
    item@(a
    _, [Bool]
    membershipRow) -> ([Bool] -> ThLevel
    countTrue [Bool]
    membershipRow, (a, [Bool])
    item))

        countTrue :: [Bool] -> ThLevel
    countTrue = (Bool -> Bool) -> [Bool] -> ThLevel
    forall a. (a -> Bool) -> [a] -> ThLevel
    count Bool -> Bool
    forall a. a -> a
    id

    {-
    Note [Finding the conflicting fields]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we have
      data A = A {a0, a1 :: Int}
             | B {b0, b1 :: Int}
    and we see a record update
      x { a0 = 3, a1 = 2, b0 = 4, b1 = 5 }
    Then we'd like to find the smallest subset of fields that no
    constructor has all of.  Here, say, {a0,b0}, or {a0,b1}, etc.
    We don't really want to report that no constructor has all of
    {a0,a1,b0,b1}, because when there are hundreds of fields it's
    hard to see what was really wrong.

    We may need more than two fields, though; eg
      data T = A { x,y :: Int, v::Int }
              | B { y,z :: Int, v::Int }
              | C { z,x :: Int, v::Int }
    with update
       r { x=e1, y=e2, z=e3 }, we

    Finding the smallest subset is hard, so the code here makes
    a decent stab, no more.  See #7989.
    -}

    naughtyRecordSel :: RdrName -> SDoc
    naughtyRecordSel :: RdrName -> SDoc
    naughtyRecordSel RdrName
    sel_id
      = String -> SDoc
    text String
    "Cannot use record selector" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RdrName
    sel_id) 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"

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

    mixedSelectors :: [Id] -> [Id] -> SDoc
    mixedSelectors :: [Var] -> [Var] -> SDoc
    mixedSelectors data_sels :: [Var]
    data_sels@(Var
    dc_rep_id:[Var]
    _) pat_syn_sels :: [Var]
    pat_syn_sels@(Var
    ps_rep_id:[Var]
    _)
      = PtrString -> SDoc
    ptext
          (String -> PtrString
    sLit String
    "Cannot use a mixture of pattern synonym and record selectors") SDoc -> SDoc -> SDoc
    $$
        String -> SDoc
    text String
    "Record selectors defined by"
          SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> Name
    tyConName TyCon
    rep_dc))
          SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    ":"
          SDoc -> SDoc -> SDoc
    <+> (Var -> SDoc) -> [Var] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas Var -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Var]
    data_sels SDoc -> SDoc -> SDoc
    $$
        String -> SDoc
    text String
    "Pattern synonym selectors defined by"
          SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (PatSyn -> Name
    patSynName PatSyn
    rep_ps))
          SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    ":"
          SDoc -> SDoc -> SDoc
    <+> (Var -> SDoc) -> [Var] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas Var -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Var]
    pat_syn_sels
      where
        RecSelPatSyn PatSyn
    rep_ps = Var -> RecSelParent
    recordSelectorTyCon Var
    ps_rep_id
        RecSelData TyCon
    rep_dc = Var -> RecSelParent
    recordSelectorTyCon Var
    dc_rep_id
    mixedSelectors [Var]
    _ [Var]
    _ = String -> SDoc
    forall a. String -> a
    panic String
    "GHC.Tc.Gen.Expr: mixedSelectors emptylists"

    missingStrictFields :: ConLike -> [FieldLabelString] -> SDoc
    missingStrictFields :: ConLike -> [FieldLabelString] -> SDoc
    missingStrictFields ConLike
    con [FieldLabelString]
    fields
      = SDoc
    header SDoc -> SDoc -> SDoc
    <> SDoc
    rest
      where
        rest :: SDoc
    rest | [FieldLabelString] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldLabelString]
    fields = SDoc
    Outputable.empty  -- Happens for non-record constructors
                                               -- with strict fields
             | Bool
    otherwise   = SDoc
    colon SDoc -> SDoc -> SDoc
    <+> (FieldLabelString -> SDoc) -> [FieldLabelString] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas FieldLabelString -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [FieldLabelString]
    fields

        header :: SDoc
    header = String -> SDoc
    text String
    "Constructor" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ConLike
    con) SDoc -> SDoc -> SDoc
    <+>
                 String -> SDoc
    text String
    "does not have the required strict field(s)"

    missingFields :: ConLike -> [FieldLabelString] -> SDoc
    missingFields :: ConLike -> [FieldLabelString] -> SDoc
    missingFields ConLike
    con [FieldLabelString]
    fields
      = SDoc
    header SDoc -> SDoc -> SDoc
    <> SDoc
    rest
      where
        rest :: SDoc
    rest | [FieldLabelString] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldLabelString]
    fields = SDoc
    Outputable.empty
             | Bool
    otherwise = SDoc
    colon SDoc -> SDoc -> SDoc
    <+> (FieldLabelString -> SDoc) -> [FieldLabelString] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas FieldLabelString -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [FieldLabelString]
    fields
        header :: SDoc
    header = String -> SDoc
    text String
    "Fields of" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ConLike
    con) SDoc -> SDoc -> SDoc
    <+>
                 String -> SDoc
    text String
    "not initialised"

    -- callCtxt fun args = text "In the call" <+> parens (ppr (foldl' mkHsApp fun args))

    noPossibleParents :: [LHsRecUpdField GhcRn] -> SDoc
    noPossibleParents :: [LHsRecUpdField GhcRn] -> SDoc
    noPossibleParents [LHsRecUpdField GhcRn]
    rbinds
      = SDoc -> ThLevel -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "No type has all these fields:")
           ThLevel
    2 ([Located (AmbiguousFieldOcc GhcRn)] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [Located (AmbiguousFieldOcc GhcRn)]
    fields)
      where
        fields :: [Located (AmbiguousFieldOcc GhcRn)]
    fields = (LHsRecUpdField GhcRn -> Located (AmbiguousFieldOcc GhcRn))
    -> [LHsRecUpdField GhcRn] -> [Located (AmbiguousFieldOcc GhcRn)]
    forall a b. (a -> b) -> [a] -> [b]
    map (HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    -> Located (AmbiguousFieldOcc GhcRn)
    forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl (HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
     -> Located (AmbiguousFieldOcc GhcRn))
    -> (LHsRecUpdField GhcRn
        -> HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn))
    -> LHsRecUpdField GhcRn
    -> Located (AmbiguousFieldOcc GhcRn)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsRecUpdField GhcRn
    -> HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn)
    forall l e. GenLocated l e -> e
    unLoc) [LHsRecUpdField GhcRn]
    rbinds

    badOverloadedUpdate :: SDoc
    badOverloadedUpdate :: SDoc
    badOverloadedUpdate = String -> SDoc
    text String
    "Record update is ambiguous, and requires a type signature"

    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 (RecSelParent -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RecSelParent
    p)) RdrName
    rdr

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

    -- | A data type to describe why a variable is not closed.
    data NotClosedReason = NotLetBoundReason
                         | NotTypeClosed VarSet
                         | NotClosed Name NotClosedReason

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

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

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

        causes :: NotClosedReason -> [SDoc]
        causes :: NotClosedReason -> [SDoc]
    causes NotClosedReason
    NotLetBoundReason = [String -> SDoc
    text String
    "is not let-bound."]
        causes (NotTypeClosed VarSet
    vs) =
          [ String -> SDoc
    text String
    "has a non-closed type because it contains the"
          , String -> SDoc
    text String
    "type variables:" SDoc -> SDoc -> SDoc
    <+>
            VarSet -> ([Var] -> SDoc) -> SDoc
    pprVarSet VarSet
    vs ([SDoc] -> SDoc
    hsep ([SDoc] -> SDoc) -> ([Var] -> [SDoc]) -> [Var] -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma ([SDoc] -> [SDoc]) -> ([Var] -> [SDoc]) -> [Var] -> [SDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Var -> SDoc) -> [Var] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SDoc -> SDoc
    quotes (SDoc -> SDoc) -> (Var -> SDoc) -> Var -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Var -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr))
          ]
        causes (NotClosed Name
    n NotClosedReason
    reason) =
          let msg :: SDoc
    msg = String -> SDoc
    text String
    "uses" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "which"
           in case NotClosedReason
    reason of
                NotClosed Name
    _ NotClosedReason
    _ -> SDoc
    msg SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : NotClosedReason -> [SDoc]
    causes NotClosedReason
    reason
                NotClosedReason
    _   -> let ([SDoc]
    xs0, [SDoc]
    xs1) = ThLevel -> [SDoc] -> ([SDoc], [SDoc])
    forall a. ThLevel -> [a] -> ([a], [a])
    splitAt ThLevel
    1 ([SDoc] -> ([SDoc], [SDoc])) -> [SDoc] -> ([SDoc], [SDoc])
    forall a b. (a -> b) -> a -> b
    $ NotClosedReason -> [SDoc]
    causes NotClosedReason
    reason
                        in (SDoc -> SDoc) -> [SDoc] -> [SDoc]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (SDoc
    msg SDoc -> SDoc -> SDoc
    <+>) [SDoc]
    xs0 [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [SDoc]
    xs1

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

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