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

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

    -}

    module GHC.Tc.Gen.Expr
           ( tcCheckPolyExpr, tcCheckPolyExprNC,
             tcCheckMonoExpr, tcCheckMonoExprNC,
             tcMonoExpr, tcMonoExprNC,
             tcInferRho, tcInferRhoNC,
             tcPolyExpr, 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.Hs
    import GHC.Rename.Utils
    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.App
    import GHC.Tc.Gen.Head
    import GHC.Tc.Gen.Bind        ( tcLocalBinds )
    import GHC.Tc.Instance.Family ( tcGetFamInstEnvs )
    import GHC.Core.FamInstEnv    ( FamInstEnvs )
    import GHC.Rename.Env         ( addUsedGRE )
    import GHC.Tc.Utils.Env
    import GHC.Tc.Gen.Arrow
    import GHC.Tc.Gen.Match
    import GHC.Tc.Gen.HsType
    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.Type
    import GHC.Tc.Types.Evidence
    import GHC.Types.Var.Set
    import GHC.Builtin.Types
    import GHC.Builtin.Names
    import GHC.Driver.Session
    import GHC.Types.SrcLoc
    import GHC.Utils.Misc
    import GHC.Data.List.SetOps
    import GHC.Data.Maybe
    import GHC.Utils.Outputable as Outputable
    import GHC.Utils.Panic
    import GHC.Data.FastString
    import Control.Monad
    import GHC.Core.Class(classTyCon)
    import GHC.Types.Unique.Set ( UniqSet, mkUniqSet, elementOfUniqSet, nonDetEltsUniqSet )

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

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

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

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

    tcCheckPolyExpr :: LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr   LHsExpr GhcRn
    expr TcType
    res_ty = LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcPolyLExpr   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)
    tcPolyLExprNC LHsExpr GhcRn
    expr (TcType -> ExpRhoType
    mkCheckExpType TcType
    res_ty)

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

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

    tcPolyLExprNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcPolyLExprNC (L SrcSpanAnnA
    loc HsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = SrcSpanAnnA -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc    (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do { HsExpr GhcTc
    expr' <- HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcPolyExpr HsExpr GhcRn
    expr ExpRhoType
    res_ty
           ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpanAnnA
    -> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc HsExpr GhcTc
    expr') }

    ---------------
    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 (L SrcSpanAnnA
    loc HsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = SrcSpanAnnA -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc   (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $  -- Set location /first/; see GHC.Tc.Utils.Monad
        HsExpr GhcRn -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a. HsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt HsExpr GhcRn
    expr (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $  -- Note [Error contexts in generated code]
        do  { HsExpr GhcTc
    expr' <- HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    expr ExpRhoType
    res_ty
            ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpanAnnA
    -> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc HsExpr GhcTc
    expr') }

    tcMonoExprNC :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC (L SrcSpanAnnA
    loc HsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = SrcSpanAnnA -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do  { HsExpr GhcTc
    expr' <- HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcExpr HsExpr GhcRn
    expr ExpRhoType
    res_ty
            ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpanAnnA
    -> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    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 (L SrcSpanAnnA
    loc HsExpr GhcRn
    expr)
      = SrcSpanAnnA
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc   (TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType))
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a b. (a -> b) -> a -> b
    $  -- Set location /first/; see GHC.Tc.Utils.Monad
        HsExpr GhcRn
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a. HsExpr GhcRn -> TcRn a -> TcRn a
    addExprCtxt HsExpr GhcRn
    expr (TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType))
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall a b. (a -> b) -> a -> b
    $  -- Note [Error contexts in generated code]
        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)
           ; (GenLocated SrcSpanAnnA (HsExpr GhcTc), TcType)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated SrcSpanAnnA (HsExpr GhcTc), TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpanAnnA
    -> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc HsExpr GhcTc
    expr', TcType
    rho) }

    tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
    tcInferRhoNC (L SrcSpanAnnA
    loc HsExpr GhcRn
    expr)
      = SrcSpanAnnA
    -> TcM (LHsExpr GhcTc, TcType) -> TcM (LHsExpr GhcTc, TcType)
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    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)
           ; (GenLocated SrcSpanAnnA (HsExpr GhcTc), TcType)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated SrcSpanAnnA (HsExpr GhcTc), TcType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpanAnnA
    -> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc HsExpr GhcTc
    expr', TcType
    rho) }

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

    tcPolyExpr :: HsExpr GhcRn -> ExpSigmaType -> TcM (HsExpr GhcTc)
    tcPolyExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcPolyExpr HsExpr GhcRn
    expr ExpRhoType
    res_ty
      = do { String -> SDoc -> TcRn ()
    traceTc String
    "tcPolyExpr" (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
           ; 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
    expr' }

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

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

    tcExpr e :: HsExpr GhcRn
    e@(HsOverLit XOverLitE GhcRn
    _ HsOverLit GhcRn
    lit) ExpRhoType
    res_ty
      = do { Maybe (HsOverLit GhcTc)
    mb_res <- HsOverLit GhcRn -> ExpRhoType -> TcM (Maybe (HsOverLit GhcTc))
    tcShortCutLit HsOverLit GhcRn
    lit ExpRhoType
    res_ty
             -- See Note [Short cut for overloaded literals] in GHC.Tc.Utils.Zonk
           ; case Maybe (HsOverLit GhcTc)
    mb_res of
               Just HsOverLit GhcTc
    lit' -> 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 GhcTc
    forall a. EpAnn a
    noAnn HsOverLit GhcTc
    lit')
               Maybe (HsOverLit GhcTc)
    Nothing   -> HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcApp HsExpr GhcRn
    e ExpRhoType
    res_ty }

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

    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 { GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr' <- LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExprNC 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 GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    expr') }

    tcExpr (HsPragE XPragE GhcRn
    x HsPragE GhcRn
    prag LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do { GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr' <- LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcMonoExpr 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) GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    expr') }

    tcExpr (NegApp XNegApp GhcRn
    x LHsExpr GhcRn
    expr SyntaxExpr GhcRn
    neg_expr) ExpRhoType
    res_ty
      = do  { (GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr', SyntaxExprTc
    neg_expr')
                <- CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([TcType]
        -> [TcType]
        -> IOEnv
             (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> TcM (GenLocated SrcSpanAnnA (HsExpr 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]
      -> IOEnv
           (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
     -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc), SyntaxExprTc))
    -> ([TcType]
        -> [TcType]
        -> IOEnv
             (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> TcM (GenLocated SrcSpanAnnA (HsExpr 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 -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    expr 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 GenLocated SrcSpanAnnA (HsExpr GhcTc)
    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 -> LIdP GhcTc -> HsExpr GhcTc
    forall p. XVar p -> LIdP p -> HsExpr p
    HsVar NoExtField
    XVar GhcTc
    noExtField (Var -> LocatedAn NameAnn Var
    forall a an. a -> LocatedAn an a
    noLocA 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 (HsLam XLam GhcRn
    _ MatchGroup GhcRn (LHsExpr GhcRn)
    match) ExpRhoType
    res_ty
      = do  { (HsWrapper
    wrap, MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr 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 NoExtField
    XLam GhcTc
    noExtField MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    MatchGroup GhcTc (LHsExpr GhcTc)
    match')) }
      where
        match_ctxt :: TcMatchCtxt HsExpr
    match_ctxt = MC { mc_what :: HsMatchContext GhcRn
    mc_what = HsMatchContext GhcRn
    forall p. HsMatchContext p
    LambdaExpr, mc_body :: GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> ExpRhoType
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    mc_body = GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> ExpRhoType
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    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 (Int -> Depth
    PartWay Int
    1) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                               MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)) -> SDoc
    forall (idR :: Pass) body.
    (OutputableBndrId idR, Outputable body) =>
    MatchGroup (GhcPass idR) body -> SDoc
    pprMatches MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    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 (GenLocated SrcSpanAnnA (HsExpr 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 (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    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 { mc_what :: HsMatchContext GhcRn
    mc_what = HsMatchContext GhcRn
    forall p. HsMatchContext p
    CaseAlt, mc_body :: GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> ExpRhoType
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    mc_body = GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> ExpRhoType
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
    tcBody }

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

    -- Explict lists [e1,e2,e3] have been expanded already in the renamer
    -- The expansion includes an ExplicitList, but it is always the built-in
    -- list type, so that's all we need concern ourselves with here.  See
    -- GHC.Rename.Expr. Note [Handling overloaded and rebindable constructs]
    tcExpr (ExplicitList XExplicitList GhcRn
    _ [LHsExpr GhcRn]
    exprs) ExpRhoType
    res_ty
      = do  { TcType
    res_ty <- ExpRhoType -> TcM TcType
    expTypeToType ExpRhoType
    res_ty
            ; (TcCoercionR
    coi, TcType
    elt_ty) <- TcType -> TcM (TcCoercionR, TcType)
    matchExpectedListTy TcType
    res_ty
            ; let tc_elt :: GenLocated SrcSpanAnnA (HsExpr GhcRn) -> TcM (LHsExpr GhcTc)
    tc_elt GenLocated SrcSpanAnnA (HsExpr GhcRn)
    expr = LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr GenLocated SrcSpanAnnA (HsExpr GhcRn)
    LHsExpr GhcRn
    expr TcType
    elt_ty
            ; [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    exprs' <- (GenLocated SrcSpanAnnA (HsExpr GhcRn)
     -> IOEnv
          (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    GenLocated SrcSpanAnnA (HsExpr GhcRn) -> TcM (LHsExpr GhcTc)
    tc_elt [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
    [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 -> [LHsExpr GhcTc] -> HsExpr GhcTc
    forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
    ExplicitList TcType
    XExplicitList GhcTc
    elt_ty [GenLocated SrcSpanAnnA (HsExpr GhcTc)]
    [LHsExpr GhcTc]
    exprs' }

    tcExpr expr :: HsExpr GhcRn
    expr@(ExplicitTuple XExplicitTuple GhcRn
    x [HsTupArg GhcRn]
    tup_args Boxity
    boxity) ExpRhoType
    res_ty
      | (HsTupArg GhcRn -> Bool) -> [HsTupArg GhcRn] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all HsTupArg GhcRn -> Bool
    forall (p :: Pass). HsTupArg (GhcPass p) -> Bool
    tupArgPresent [HsTupArg GhcRn]
    tup_args
      = do { let arity :: Int
    arity  = [HsTupArg GhcRn] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [HsTupArg GhcRn]
    tup_args
                 tup_tc :: TyCon
    tup_tc = Boxity -> Int -> TyCon
    tupleTyCon Boxity
    boxity Int
    arity
                   -- NB: tupleTyCon doesn't flatten 1-tuples
                   -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make
           ; 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 -> Int -> [TcType] -> [TcType]
    forall a. Int -> [a] -> [a]
    drop Int
    arity [TcType]
    arg_tys
                                           Boxity
    Boxed   -> [TcType]
    arg_tys
           ; [HsTupArg GhcTc]
    tup_args1 <- [HsTupArg GhcRn] -> [TcType] -> TcM [HsTupArg GhcTc]
    tcTupArgs [HsTupArg 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 -> [HsTupArg GhcTc] -> Boxity -> HsExpr GhcTc
    forall p. XExplicitTuple p -> [HsTupArg p] -> Boxity -> HsExpr p
    ExplicitTuple XExplicitTuple GhcRn
    XExplicitTuple GhcTc
    x [HsTupArg GhcTc]
    tup_args1 Boxity
    boxity) }

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

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

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

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

                 -- See Note [Linear fields generalization] in GHC.Tc.Gen.App
                 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
    _ Int
    alt Int
    arity LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do { let sum_tc :: TyCon
    sum_tc = Int -> TyCon
    sumTyCon Int
    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' = Int -> [TcType] -> [TcType]
    forall a. Int -> [a] -> [a]
    drop Int
    arity [TcType]
    arg_tys
           ; GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr' <- LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr ([TcType]
    arg_tys' [TcType] -> Int -> TcType
    forall a. Outputable a => [a] -> Int -> a
    `getNth` (Int
    alt Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    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 -> Int -> Int -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XExplicitSum p -> Int -> Int -> LHsExpr p -> HsExpr p
    ExplicitSum [TcType]
    XExplicitSum GhcTc
    arg_tys' Int
    alt Int
    arity GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    expr' ) }

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

    tcExpr (HsLet XLet GhcRn
    x HsLocalBinds GhcRn
    binds LHsExpr GhcRn
    expr) ExpRhoType
    res_ty
      = do  { (HsLocalBinds GhcTc
    binds', GenLocated SrcSpanAnnA (HsExpr 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)
    tcMonoExpr LHsExpr GhcRn
    expr ExpRhoType
    res_ty
            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XLet GhcTc -> HsLocalBinds GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XLet p -> HsLocalBinds p -> LHsExpr p -> HsExpr p
    HsLet XLet GhcRn
    XLet GhcTc
    x HsLocalBinds GhcTc
    binds' GenLocated SrcSpanAnnA (HsExpr GhcTc)
    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
              TcType
    mult <- TcType -> TcM TcType
    newFlexiTyVarTy TcType
    multiplicityTy

              -- 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
            ; (GenLocated SrcSpanAnnA (HsExpr 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 (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    matches' <- TcMatchCtxt HsExpr
    -> Scaled TcType
    -> MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> ExpRhoType
    -> TcM (MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall (body :: * -> *).
    AnnoBody body =>
    TcMatchCtxt body
    -> Scaled TcType
    -> MatchGroup GhcRn (LocatedA (body GhcRn))
    -> ExpRhoType
    -> TcM (MatchGroup GhcTc (LocatedA (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 (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    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 GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    scrut' MatchGroup GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    MatchGroup GhcTc (LHsExpr GhcTc)
    matches') }
     where
        match_ctxt :: TcMatchCtxt HsExpr
    match_ctxt = MC { mc_what :: HsMatchContext GhcRn
    mc_what = HsMatchContext GhcRn
    forall p. HsMatchContext p
    CaseAlt,
                          mc_body :: GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> ExpRhoType
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    mc_body = GenLocated SrcSpanAnnA (HsExpr GhcRn)
    -> ExpRhoType
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    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 { GenLocated SrcSpanAnnA (HsExpr GhcTc)
    pred'    <- LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr LHsExpr GhcRn
    pred TcType
    boolTy
           ; (UsageEnv
    u1,GenLocated SrcSpanAnnA (HsExpr 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)
    tcMonoExpr LHsExpr GhcRn
    b1 ExpRhoType
    res_ty
           ; (UsageEnv
    u2,GenLocated SrcSpanAnnA (HsExpr 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)
    tcMonoExpr 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 GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    pred' GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    b1' GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    b2') }

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

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

    tcExpr (HsProc XProc GhcRn
    x LPat GhcRn
    pat LHsCmdTop GhcRn
    cmd) ExpRhoType
    res_ty
      = do  { (GenLocated SrcSpanAnnA (Pat GhcTc)
    pat', GenLocated SrcSpan (HsCmdTop 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 GenLocated SrcSpanAnnA (Pat GhcTc)
    LPat GhcTc
    pat' GenLocated SrcSpan (HsCmdTop GhcTc)
    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
            ; (GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr', WantedConstraints
    lie)    <- IOEnv
      (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc), WantedConstraints)
    forall a. TcM a -> TcM (a, WantedConstraints)
    captureConstraints (IOEnv
       (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
     -> TcM (GenLocated SrcSpanAnnA (HsExpr GhcTc), WantedConstraints))
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> TcM (GenLocated SrcSpanAnnA (HsExpr 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 -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "In the body of a static form:")
                                 Int
    2 (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GenLocated SrcSpanAnnA (HsExpr GhcRn)
    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 EpAnnCO
    XApp GhcTc
    noComments
                                (SrcSpanAnnA
    -> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall l e. l -> e -> GenLocated l e
    L (SrcSpan -> SrcSpanAnnA
    forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan SrcSpan
    loc) (HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap HsExpr GhcTc
    fromStaticPtr)
                                (SrcSpanAnnA
    -> HsExpr GhcTc -> GenLocated SrcSpanAnnA (HsExpr GhcTc)
    forall l e. l -> e -> GenLocated l e
    L (SrcSpan -> SrcSpanAnnA
    forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan SrcSpan
    loc) (XStatic GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XStatic p -> LHsExpr p -> HsExpr p
    HsStatic XStatic GhcRn
    XStatic GhcTc
    fvs GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    expr'))
            }

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

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

            ; (HsExpr GhcTc
    con_expr, TcType
    con_sigma) <- Name -> TcM (HsExpr GhcTc, TcType)
    tcInferId Name
    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 :: Int
    arity = ConLike -> Int
    conLikeArity ConLike
    con_like
                  Right ([Scaled TcType]
    arg_tys, TcType
    actual_res_ty) = Int -> TcType -> Either Int ([Scaled TcType], TcType)
    tcSplitFunTysN Int
    arity TcType
    con_tau

            ; Bool -> SDoc -> TcRn ()
    checkTc (ConLike -> Bool
    conLikeHasBuilder ConLike
    con_like) (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
              Name -> SDoc
    forall a. Outputable a => a -> SDoc
    nonBidirectionalErr (ConLike -> Name
    conLikeName ConLike
    con_like)

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

            ; HsExpr GhcTc
    ret <- HsExpr GhcRn
    -> HsExpr GhcTc -> TcType -> ExpRhoType -> TcM (HsExpr GhcTc)
    tcWrapResultMono HsExpr GhcRn
    expr HsExpr GhcTc
    expr' TcType
    actual_res_ty ExpRhoType
    res_ty

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

            ; HsExpr GhcTc -> TcM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    ret }
      where
        orig :: CtOrigin
    orig = Name -> CtOrigin
    OccurrenceOf Name
    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"

    -}

    -- Record updates via dot syntax are replaced by desugared expressions
    -- in the renamer. See Note [Overview of record dot syntax] in
    -- GHC.Hs.Expr. This is why we match on 'rupd_flds = Left rbnds' here
    -- and panic otherwise.
    tcExpr expr :: HsExpr GhcRn
    expr@(RecordUpd { rupd_expr :: forall p. HsExpr p -> LHsExpr p
    rupd_expr = LHsExpr GhcRn
    record_expr, rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
    rupd_flds = Left [LHsRecUpdField GhcRn]
    rbnds }) ExpRhoType
    res_ty
      = ASSERT( notNull rbnds )
        do  { -- STEP -2: typecheck the record_expr, the record to be updated
              (GenLocated SrcSpanAnnA (HsExpr 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] in GHC.Tc.Gen.Head
            -- After this we know that rbinds is unambiguous
            ; [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    rbinds <- LHsExpr GhcRn
    -> TcType
    -> [LHsRecUpdField GhcRn]
    -> ExpRhoType
    -> TcM
         [LHsRecField' GhcTc (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 = (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
     -> AmbiguousFieldOcc GhcTc)
    -> [GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr 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)
    -> (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
        -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc))
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> AmbiguousFieldOcc GhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsRecField'
      (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl (HsRecField'
       (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
     -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc))
    -> (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
        -> HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    forall l e. GenLocated l e -> e
    unLoc) [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr 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)
                             | GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    fld <- [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    rbinds,
                               -- Excludes class ops
                               let L SrcSpan
    loc Var
    sel_id = HsRecField'
      (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> GenLocated SrcSpan Var
    forall arg.
    HsRecField' (AmbiguousFieldOcc GhcTc) arg -> GenLocated SrcSpan Var
    hsRecUpdFieldId (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    forall l e. GenLocated l e -> e
    unLoc GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr 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' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> [ConLike] -> SDoc
    badFieldsUpd [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    [LHsRecField' GhcTc (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   = (FieldLabel -> FieldLabelString)
    -> [FieldLabel] -> [FieldLabelString]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLabel -> FieldLabelString
    flLabel ([FieldLabel] -> [FieldLabelString])
    -> [FieldLabel] -> [FieldLabelString]
    forall a b. (a -> b) -> a -> b
    $ ConLike -> [FieldLabel]
    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 -> SDoc -> TcRn ()
    checkTc (ConLike -> Bool
    conLikeHasBuilder ConLike
    con1) (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
              Name -> SDoc
    forall a. Outputable a => a -> SDoc
    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 SDoc -> TcType -> TcType -> TcM TcCoercionR
    unifyType (SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GenLocated SrcSpanAnnA (HsExpr GhcRn)
    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
            ; [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    rbinds'      <- ConLike
    -> [TcType]
    -> [LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> TcM [LHsRecUpdField GhcTc]
    tcRecordUpd ConLike
    con1 [TcType]
    con1_arg_tys' [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    [LHsRecField' GhcTc (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 { 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 { 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 GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    record_expr'
                                    , rupd_flds :: Either [LHsRecUpdField GhcTc] [LHsRecUpdProj GhcTc]
    rupd_flds = [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    -> Either
         [GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
         [GenLocated
            SrcSpanAnnA
            (HsRecField'
               (FieldLabelStrings GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    forall a b. a -> Either a b
    Left [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr 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 (RecordUpd {}) ExpRhoType
    _ = String -> TcM (HsExpr GhcTc)
    forall a. String -> a
    panic String
    "GHC.Tc.Gen.Expr: tcExpr: The impossible happened!"

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

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

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

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

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

    {-
    ************************************************************************
    *                                                                      *
                    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 (HsBracketRn GhcRn)
    brack [PendingRnSplice' GhcRn]
    ps) ExpRhoType
    res_ty = HsExpr GhcRn
    -> HsBracket GhcRn
    -> [PendingRnSplice]
    -> ExpRhoType
    -> TcM (HsExpr GhcTc)
    tcUntypedBracket HsExpr GhcRn
    e HsBracket GhcRn
    HsBracket (HsBracketRn GhcRn)
    brack [PendingRnSplice' GhcRn]
    [PendingRnSplice]
    ps ExpRhoType
    res_ty

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

    tcExpr (HsConLikeOut {})   ExpRhoType
    ty = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcExpr:HsConLikeOut" (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    ty)
    tcExpr (HsOverLabel {})    ExpRhoType
    ty = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcExpr:HsOverLabel"  (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    ty)
    tcExpr (SectionL {})       ExpRhoType
    ty = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcExpr:SectionL"    (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    ty)
    tcExpr (SectionR {})       ExpRhoType
    ty = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcExpr:SectionR"    (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    ty)
    tcExpr (HsTcBracketOut {}) ExpRhoType
    ty = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcExpr:HsTcBracketOut"    (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    ty)
    tcExpr (HsTick {})         ExpRhoType
    ty = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcExpr:HsTick"    (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    ty)
    tcExpr (HsBinTick {})      ExpRhoType
    ty = String -> SDoc -> TcM (HsExpr GhcTc)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcExpr:HsBinTick"    (ExpRhoType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpRhoType
    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
           ; GenLocated SrcSpanAnnA (HsExpr 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 GenLocated SrcSpanAnnA (HsExpr GhcTc)
    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
           ; GenLocated SrcSpanAnnA (HsExpr 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
           ; GenLocated SrcSpanAnnA (HsExpr 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 GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    expr1' GenLocated SrcSpanAnnA (HsExpr GhcTc)
    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
           ; GenLocated SrcSpanAnnA (HsExpr 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
           ; GenLocated SrcSpanAnnA (HsExpr 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 GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    expr1' GenLocated SrcSpanAnnA (HsExpr GhcTc)
    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
            ; GenLocated SrcSpanAnnA (HsExpr 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
            ; GenLocated SrcSpanAnnA (HsExpr 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
            ; GenLocated SrcSpanAnnA (HsExpr 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 GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    expr1' GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    expr2' GenLocated SrcSpanAnnA (HsExpr GhcTc)
    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') }

    ----------------
    tcTupArgs :: [HsTupArg GhcRn] -> [TcSigmaType] -> TcM [HsTupArg GhcTc]
    tcTupArgs :: [HsTupArg GhcRn] -> [TcType] -> TcM [HsTupArg GhcTc]
    tcTupArgs [HsTupArg GhcRn]
    args [TcType]
    tys
      = do MASSERT( equalLength args tys )
           Int -> TcRn ()
    checkTupSize ([HsTupArg GhcRn] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [HsTupArg GhcRn]
    args)
           ((HsTupArg GhcRn, TcType)
     -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc))
    -> [(HsTupArg GhcRn, TcType)] -> TcM [HsTupArg GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (HsTupArg GhcRn, TcType)
    -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
    go ([HsTupArg GhcRn]
    args [HsTupArg GhcRn] -> [TcType] -> [(HsTupArg GhcRn, TcType)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [TcType]
    tys)
      where
        go :: (HsTupArg GhcRn, TcType)
    -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
    go (Missing {},     TcType
    arg_ty) = do { TcType
    mult <- TcType -> TcM TcType
    newFlexiTyVarTy TcType
    multiplicityTy
                                         ; HsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (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 (Present XPresent GhcRn
    x LHsExpr GhcRn
    expr, TcType
    arg_ty) = do { GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr' <- LHsExpr GhcRn -> TcType -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr LHsExpr GhcRn
    expr TcType
    arg_ty
                                         ; HsTupArg GhcTc -> IOEnv (Env TcGblEnv TcLclEnv) (HsTupArg GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XPresent GhcTc -> LHsExpr GhcTc -> HsTupArg GhcTc
    forall id. XPresent id -> LHsExpr id -> HsTupArg id
    Present XPresent GhcRn
    XPresent GhcTc
    x GenLocated SrcSpanAnnA (HsExpr GhcTc)
    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)t
    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, AppCtxt)
    -> [HsExprArg 'TcpRn] -> Maybe TcType -> TcM (HsExpr GhcTc, TcType)
    tcInferAppHead (HsExpr GhcRn
    op, HsExpr GhcRn -> Int -> SrcSpan -> AppCtxt
    VACall HsExpr GhcRn
    op Int
    0 SrcSpan
    noSrcSpan) [] Maybe TcType
    forall a. Maybe a
    Nothing
                 -- Ugh!! But all this code is scheduled for demolition anyway
           ; 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 { 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
    -> Int
    -> 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
    -> Int
    -> ExpRhoType
    -> ([Scaled ExpRhoType] -> ExpRhoType -> TcM a)
    -> TcM (HsWrapper, a)
    matchExpectedFunTys SDoc
    herald UserTypeCtxt
    GenSigCtxt Int
    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 SDoc
    -> Int
    -> TcType
    -> TcM (HsWrapper, [Scaled TcType], TcType)
    matchActualFunTysRho SDoc
    herald CtOrigin
    orig Maybe SDoc
    forall a. Maybe a
    Nothing
                                       ([SyntaxOpType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    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.
    -}

    {- *********************************************************************
    *                                                                      *
                     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 :: [FieldLabel]
    flds = ConLike -> [FieldLabel]
    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 | (FieldLabel
    fl, Scaled TcType
    ty) <- [FieldLabel] -> [Scaled TcType] -> [(FieldLabel, Scaled TcType)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [FieldLabel]
    flds [Scaled TcType]
    arg_tys
                                                , Bool -> Bool
    not (FieldLabel -> FieldLabelString
    flLabel FieldLabel
    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 ]

    -- Disambiguate the fields in a record update.
    -- See Note [Disambiguating record fields] in GHC.Tc.Gen.Head
    disambiguateRecordBinds :: LHsExpr GhcRn -> TcRhoType
                     -> [LHsRecUpdField GhcRn] -> ExpRhoType
                     -> TcM [LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    disambiguateRecordBinds :: LHsExpr GhcRn
    -> TcType
    -> [LHsRecUpdField GhcRn]
    -> ExpRhoType
    -> TcM
         [LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    disambiguateRecordBinds LHsExpr GhcRn
    record_expr TcType
    record_rho [LHsRecUpdField GhcRn]
    rbnds ExpRhoType
    res_ty
        -- Are all the fields unambiguous?
      = case (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
     -> Maybe
          (GenLocated
             SrcSpanAnnA
             (HsRecField'
                (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
           Name))
    -> [GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> Maybe
         [(GenLocated
             SrcSpanAnnA
             (HsRecField'
                (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
           Name)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> Maybe
         (GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
          Name)
    LHsRecUpdField GhcRn -> Maybe (LHsRecUpdField GhcRn, Name)
    isUnambiguous [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    [LHsRecUpdField GhcRn]
    rbnds of
                         -- If so, just skip to looking up the Ids
                         -- Always the case if DuplicateRecordFields is off
          Just [(GenLocated
        SrcSpanAnnA
        (HsRecField'
           (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      Name)]
    rbnds' -> ((GenLocated
        SrcSpanAnnA
        (HsRecField'
           (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      Name)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (GenLocated
             SrcSpanAnnA
             (HsRecField'
                (AmbiguousFieldOcc GhcTc)
                (GenLocated SrcSpanAnnA (HsExpr GhcRn)))))
    -> [(GenLocated
           SrcSpanAnnA
           (HsRecField'
              (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
         Name)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     Name)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    (LHsRecUpdField GhcRn, Name)
    -> TcM
         (LHsRecField' GhcRn (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    lookupSelector [(GenLocated
        SrcSpanAnnA
        (HsRecField'
           (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      Name)]
    rbnds'
          Maybe
      [(GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr 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
               ; [(GenLocated
        SrcSpanAnnA
        (HsRecField'
           (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      [(RecSelParent, GlobalRdrElt)])]
    rbnds_with_parents <- IOEnv
      (Env TcGblEnv TcLclEnv)
      [(GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
        [(RecSelParent, GlobalRdrElt)])]
    TcM [(LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])]
    getUpdFieldsParents
               ; let possible_parents :: [[RecSelParent]]
    possible_parents = ((GenLocated
        SrcSpanAnnA
        (HsRecField'
           (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      [(RecSelParent, GlobalRdrElt)])
     -> [RecSelParent])
    -> [(GenLocated
           SrcSpanAnnA
           (HsRecField'
              (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr 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])
    -> ((GenLocated
           SrcSpanAnnA
           (HsRecField'
              (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
         [(RecSelParent, GlobalRdrElt)])
        -> [(RecSelParent, GlobalRdrElt)])
    -> (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
        [(RecSelParent, GlobalRdrElt)])
    -> [RecSelParent]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     [(RecSelParent, GlobalRdrElt)])
    -> [(RecSelParent, GlobalRdrElt)]
    forall a b. (a, b) -> b
    snd) [(GenLocated
        SrcSpanAnnA
        (HsRecField'
           (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr 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
               ; IOEnv
      (Env TcGblEnv TcLclEnv)
      [GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    forall r. TcM r -> TcM r
    checkNoErrs (IOEnv
       (Env TcGblEnv TcLclEnv)
       [GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          [GenLocated
             SrcSpanAnnA
             (HsRecField'
                (AmbiguousFieldOcc GhcTc)
                (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    forall a b. (a -> b) -> a -> b
    $ ((GenLocated
        SrcSpanAnnA
        (HsRecField'
           (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
      [(RecSelParent, GlobalRdrElt)])
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (GenLocated
             SrcSpanAnnA
             (HsRecField'
                (AmbiguousFieldOcc GhcTc)
                (GenLocated SrcSpanAnnA (HsExpr GhcRn)))))
    -> [(GenLocated
           SrcSpanAnnA
           (HsRecField'
              (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
         [(RecSelParent, GlobalRdrElt)])]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (RecSelParent
    -> (LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])
    -> TcM
         (LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    pickParent RecSelParent
    p) [(GenLocated
        SrcSpanAnnA
        (HsRecField'
           (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr 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) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> Located (AmbiguousFieldOcc GhcRn)
    forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    forall l e. GenLocated l e -> e
    unLoc GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    LHsRecUpdField GhcRn
    x)) of
                            Unambiguous XUnambiguous GhcRn
    sel_name LocatedN RdrName
    _ -> (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
     Name)
    -> Maybe
         (GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
          Name)
    forall a. a -> Maybe a
    Just (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    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 ([GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> [[(RecSelParent, GlobalRdrElt)]]
    -> [(GenLocated
           SrcSpanAnnA
           (HsRecField'
              (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))),
         [(RecSelParent, GlobalRdrElt)])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    [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
    $ (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
     -> IOEnv (Env TcGblEnv TcLclEnv) [(RecSelParent, GlobalRdrElt)])
    -> [GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr 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
              (Bool
    -> RdrName
    -> IOEnv (Env TcGblEnv TcLclEnv) [(RecSelParent, GlobalRdrElt)]
    lookupParents Bool
    False (RdrName
     -> IOEnv (Env TcGblEnv TcLclEnv) [(RecSelParent, GlobalRdrElt)])
    -> (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
        -> RdrName)
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> IOEnv (Env TcGblEnv TcLclEnv) [(RecSelParent, GlobalRdrElt)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated SrcSpan RdrName -> RdrName
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpan RdrName -> RdrName)
    -> (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
        -> GenLocated SrcSpan RdrName)
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> RdrName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsRecField'
      (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> GenLocated SrcSpan RdrName
    forall (p :: Pass).
    HsRecUpdField (GhcPass p) -> GenLocated SrcSpan RdrName
    hsRecUpdFieldRdr (HsRecField'
       (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
     -> GenLocated SrcSpan RdrName)
    -> (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
        -> HsRecField'
             (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> GenLocated SrcSpan RdrName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    forall l e. GenLocated l e -> e
    unLoc)
              [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    [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 -> TcM 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 ->
                  do { TyCon -> TcRn ()
    reportAmbiguousField TyCon
    p
                     ; 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 (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpanAnnA (HsExpr GhcRn)
    LHsExpr GhcRn
    record_expr)
                , Just TyCon
    tc <- FamInstEnvs -> TcType -> Maybe TyCon
    tyConOf FamInstEnvs
    fam_inst_envs TcType
    record_rho
                -> do { TyCon -> TcRn ()
    reportAmbiguousField TyCon
    tc
                      ; 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 -> TcM 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' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
        pickParent :: RecSelParent
    -> (LHsRecUpdField GhcRn, [(RecSelParent, GlobalRdrElt)])
    -> TcM
         (LHsRecField' GhcTc (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) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> Located (AmbiguousFieldOcc GhcRn)
    forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    forall l e. GenLocated l e -> e
    unLoc GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    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)
    -> TcM
         (LHsRecField' GhcRn (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    lookupSelector (LHsRecUpdField GhcRn
    upd, GlobalRdrElt -> Name
    greMangledName 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
                                          (GenLocated SrcSpan RdrName -> RdrName
    forall l e. GenLocated l e -> e
    unLoc (HsRecUpdField GhcRn -> GenLocated SrcSpan RdrName
    forall (p :: Pass).
    HsRecUpdField (GhcPass p) -> GenLocated SrcSpan RdrName
    hsRecUpdFieldRdr (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    forall l e. GenLocated l e -> e
    unLoc GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    LHsRecUpdField GhcRn
    upd))))
                             ; (LHsRecUpdField GhcRn, Name)
    -> TcM
         (LHsRecField' GhcRn (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    lookupSelector (LHsRecUpdField GhcRn
    upd, GlobalRdrElt -> Name
    greMangledName ((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' GhcRn (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
        lookupSelector :: (LHsRecUpdField GhcRn, Name)
    -> TcM
         (LHsRecField' GhcRn (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn))
    lookupSelector (L SrcSpanAnnA
    l HsRecField'
      (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    upd, Name
    n)
          = do { Var
    i <- Name -> TcM Var
    tcLookupId Name
    n
               ; let L SrcSpan
    loc AmbiguousFieldOcc GhcRn
    af = HsRecField'
      (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> Located (AmbiguousFieldOcc GhcRn)
    forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl HsRecField'
      (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    upd
                     lbl :: RdrName
    lbl      = AmbiguousFieldOcc GhcRn -> RdrName
    forall (p :: Pass). AmbiguousFieldOcc (GhcPass p) -> RdrName
    rdrNameAmbiguousFieldOcc AmbiguousFieldOcc GhcRn
    af
               -- ; return $ L l upd { hsRecFieldLbl
               --                = L loc (Unambiguous i (L (noAnnSrcSpan loc) lbl)) }
               ; GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (GenLocated
             SrcSpanAnnA
             (HsRecField'
                (AmbiguousFieldOcc GhcTc)
                (GenLocated SrcSpanAnnA (HsExpr GhcRn)))))
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
    forall a b. (a -> b) -> a -> b
    $ SrcSpanAnnA
    -> HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    l HsRecField
                   { hsRecFieldAnn :: XHsRecField (AmbiguousFieldOcc GhcTc)
    hsRecFieldAnn = HsRecField'
      (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> XHsRecField (AmbiguousFieldOcc GhcRn)
    forall id arg. HsRecField' id arg -> XHsRecField id
    hsRecFieldAnn HsRecField'
      (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr 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 -> LocatedN RdrName -> AmbiguousFieldOcc GhcTc
    forall pass.
    XUnambiguous pass -> LocatedN RdrName -> AmbiguousFieldOcc pass
    Unambiguous Var
    XUnambiguous GhcTc
    i (SrcSpanAnnN -> RdrName -> LocatedN RdrName
    forall l e. l -> e -> GenLocated l e
    L (SrcSpan -> SrcSpanAnnN
    forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan SrcSpan
    loc) RdrName
    lbl))
                   , hsRecFieldArg :: GenLocated SrcSpanAnnA (HsExpr GhcRn)
    hsRecFieldArg = HsRecField'
      (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
    forall id arg. HsRecField' id arg -> arg
    hsRecFieldArg HsRecField'
      (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    upd
                   , hsRecPun :: Bool
    hsRecPun = HsRecField'
      (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> Bool
    forall id arg. HsRecField' id arg -> Bool
    hsRecPun HsRecField'
      (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    upd
                   }
               }

        -- See Note [Deprecating ambiguous fields] in GHC.Tc.Gen.Head
        reportAmbiguousField :: TyCon -> TcM ()
        reportAmbiguousField :: TyCon -> TcRn ()
    reportAmbiguousField TyCon
    parent_type =
            SrcSpan -> TcRn () -> TcRn ()
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ WarningFlag -> Bool -> SDoc -> TcRn ()
    warnIfFlag WarningFlag
    Opt_WarnAmbiguousFields Bool
    True (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
              [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "The record update" SDoc -> SDoc -> SDoc
    <+> HsExpr GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    rupd
                       SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "with type" SDoc -> SDoc -> SDoc
    <+> TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    parent_type
                       SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is ambiguous."
                   , String -> SDoc
    text String
    "This will not be supported by -XDuplicateRecordFields in future releases of GHC."
                   ]
          where
            rupd :: HsExpr GhcRn
    rupd = RecordUpd { rupd_expr :: LHsExpr GhcRn
    rupd_expr = LHsExpr GhcRn
    record_expr, rupd_flds :: Either [LHsRecUpdField GhcRn] [LHsRecUpdProj GhcRn]
    rupd_flds = [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> Either
         [GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
         [GenLocated
            SrcSpanAnnA
            (HsRecField'
               (FieldLabelStrings GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    forall a b. a -> Either a b
    Left [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    [LHsRecUpdField GhcRn]
    rbnds, rupd_ext :: XRecordUpd GhcRn
    rupd_ext = NoExtField
    XRecordUpd GhcRn
    noExtField }
            loc :: SrcSpan
    loc  = GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> SrcSpan
    forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
    getLocA ([GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    forall a. [a] -> a
    head [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    [LHsRecUpdField GhcRn]
    rbnds)

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

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

    For each binding field = value

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

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

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

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

    tcRecordBinds :: ConLike
    -> [TcType] -> HsRecordBinds GhcRn -> TcM (HsRecordBinds GhcTc)
    tcRecordBinds ConLike
    con_like [TcType]
    arg_tys (HsRecFields [LHsRecField GhcRn (LHsExpr GhcRn)]
    rbinds Maybe (Located Int)
    dd)
      = do  { [Maybe
       (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (FieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))))]
    mb_binds <- (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (FieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (Maybe
             (GenLocated
                SrcSpanAnnA
                (HsRecField'
                   (FieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))))))
    -> [GenLocated
          SrcSpanAnnA
          (HsRecField'
             (FieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [Maybe
            (GenLocated
               SrcSpanAnnA
               (HsRecField'
                  (FieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GenLocated
      SrcSpanAnnA
      (HsRecField'
         (FieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Maybe
            (GenLocated
               SrcSpanAnnA
               (HsRecField'
                  (FieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
    LHsRecField GhcRn (LHsExpr GhcRn)
    -> TcM (Maybe (LHsRecField GhcTc (LHsExpr GhcTc)))
    do_bind [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (FieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    [LHsRecField GhcRn (LHsExpr GhcRn)]
    rbinds
            ; HsRecFields GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (HsRecFields GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([LHsRecField GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))]
    -> Maybe (Located Int)
    -> HsRecFields GhcTc (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall p arg.
    [LHsRecField p arg] -> Maybe (Located Int) -> HsRecFields p arg
    HsRecFields ([Maybe
       (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (FieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))))]
    -> [GenLocated
          SrcSpanAnnA
          (HsRecField'
             (FieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe
       (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (FieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))))]
    mb_binds) Maybe (Located Int)
    dd) }
      where
        fields :: [Name]
    fields = (FieldLabel -> Name) -> [FieldLabel] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLabel -> Name
    flSelector ([FieldLabel] -> [Name]) -> [FieldLabel] -> [Name]
    forall a b. (a -> b) -> a -> b
    $ ConLike -> [FieldLabel]
    conLikeFieldLabels ConLike
    con_like
        flds_w_tys :: [(Name, 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)
    -> TcM (Maybe (LHsRecField GhcTc (LHsExpr GhcTc)))
    do_bind (L SrcSpanAnnA
    l fld :: HsRecField'
      (FieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr 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 = GenLocated SrcSpanAnnA (HsExpr GhcRn)
    rhs }))

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

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

    tcRecordUpd :: ConLike
    -> [TcType]
    -> [LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> TcM [LHsRecUpdField GhcTc]
    tcRecordUpd ConLike
    con_like [TcType]
    arg_tys [LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds = ([Maybe
        (GenLocated
           SrcSpanAnnA
           (HsRecField'
              (AmbiguousFieldOcc GhcTc)
              (GenLocated SrcSpanAnnA (HsExpr GhcTc))))]
     -> [LHsRecUpdField GhcTc])
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [Maybe
            (GenLocated
               SrcSpanAnnA
               (HsRecField'
                  (AmbiguousFieldOcc GhcTc)
                  (GenLocated SrcSpanAnnA (HsExpr GhcTc))))]
    -> TcM [LHsRecUpdField GhcTc]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Maybe
       (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc)
             (GenLocated SrcSpanAnnA (HsExpr GhcTc))))]
    -> [LHsRecUpdField GhcTc]
    forall a. [Maybe a] -> [a]
    catMaybes (IOEnv
       (Env TcGblEnv TcLclEnv)
       [Maybe
          (GenLocated
             SrcSpanAnnA
             (HsRecField'
                (AmbiguousFieldOcc GhcTc)
                (GenLocated SrcSpanAnnA (HsExpr GhcTc))))]
     -> TcM [LHsRecUpdField GhcTc])
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [Maybe
            (GenLocated
               SrcSpanAnnA
               (HsRecField'
                  (AmbiguousFieldOcc GhcTc)
                  (GenLocated SrcSpanAnnA (HsExpr GhcTc))))]
    -> TcM [LHsRecUpdField GhcTc]
    forall a b. (a -> b) -> a -> b
    $ (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (Maybe
             (GenLocated
                SrcSpanAnnA
                (HsRecField'
                   (AmbiguousFieldOcc GhcTc)
                   (GenLocated SrcSpanAnnA (HsExpr GhcTc))))))
    -> [GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [Maybe
            (GenLocated
               SrcSpanAnnA
               (HsRecField'
                  (AmbiguousFieldOcc GhcTc)
                  (GenLocated SrcSpanAnnA (HsExpr GhcTc))))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Maybe
            (GenLocated
               SrcSpanAnnA
               (HsRecField'
                  (AmbiguousFieldOcc GhcTc)
                  (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
    LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> TcM (Maybe (LHsRecUpdField GhcTc))
    do_bind [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    [LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds
      where
        fields :: [Name]
    fields = (FieldLabel -> Name) -> [FieldLabel] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLabel -> Name
    flSelector ([FieldLabel] -> [Name]) -> [FieldLabel] -> [Name]
    forall a b. (a -> b) -> a -> b
    $ ConLike -> [FieldLabel]
    conLikeFieldLabels ConLike
    con_like
        flds_w_tys :: [(Name, 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' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
                -> TcM (Maybe (LHsRecUpdField GhcTc))
        do_bind :: LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)
    -> TcM (Maybe (LHsRecUpdField GhcTc))
    do_bind (L SrcSpanAnnA
    l fld :: HsRecField'
      (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr 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 = GenLocated SrcSpanAnnA (HsExpr 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 -> LocatedN RdrName -> FieldOcc GhcRn
    forall pass. XCFieldOcc pass -> LocatedN RdrName -> FieldOcc pass
    FieldOcc (Var -> Name
    idName Var
    sel_id) (SrcSpanAnnN -> RdrName -> LocatedN RdrName
    forall l e. l -> e -> GenLocated l e
    L (SrcSpan -> SrcSpanAnnN
    forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan SrcSpan
    loc) RdrName
    lbl))
               ; Maybe
      (Located (FieldOcc GhcTc), GenLocated SrcSpanAnnA (HsExpr GhcTc))
    mb <- ConLike
    -> [(Name, TcType)]
    -> LFieldOcc GhcRn
    -> LHsExpr GhcRn
    -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    tcRecordField ConLike
    con_like [(Name, TcType)]
    flds_w_tys Located (FieldOcc GhcRn)
    LFieldOcc GhcRn
    f GenLocated SrcSpanAnnA (HsExpr GhcRn)
    LHsExpr GhcRn
    rhs
               ; case Maybe
      (Located (FieldOcc GhcTc), GenLocated SrcSpanAnnA (HsExpr GhcTc))
    mb of
                   Maybe
      (Located (FieldOcc GhcTc), GenLocated SrcSpanAnnA (HsExpr GhcTc))
    Nothing         -> Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Maybe
            (GenLocated
               SrcSpanAnnA
               (HsRecField'
                  (AmbiguousFieldOcc GhcTc)
                  (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    forall a. Maybe a
    Nothing
                   Just (Located (FieldOcc GhcTc)
    f', GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs') ->
                     Maybe
      (GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Maybe
            (GenLocated
               SrcSpanAnnA
               (HsRecField'
                  (AmbiguousFieldOcc GhcTc)
                  (GenLocated SrcSpanAnnA (HsExpr GhcTc)))))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    -> Maybe
         (GenLocated
            SrcSpanAnnA
            (HsRecField'
               (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))))
    forall a. a -> Maybe a
    Just
                             (SrcSpanAnnA
    -> HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    l (HsRecField'
      (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr 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 -> LocatedN RdrName -> AmbiguousFieldOcc GhcTc
    forall pass.
    XUnambiguous pass -> LocatedN RdrName -> AmbiguousFieldOcc pass
    Unambiguous
                                                   (FieldOcc GhcTc -> XCFieldOcc GhcTc
    forall pass. FieldOcc pass -> XCFieldOcc pass
    extFieldOcc (Located (FieldOcc GhcTc) -> FieldOcc GhcTc
    forall l e. GenLocated l e -> e
    unLoc Located (FieldOcc GhcTc)
    f'))
                                                   (SrcSpanAnnN -> RdrName -> LocatedN RdrName
    forall l e. l -> e -> GenLocated l e
    L (SrcSpan -> SrcSpanAnnN
    forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan SrcSpan
    loc) RdrName
    lbl))
                                       , hsRecFieldArg :: GenLocated SrcSpanAnnA (HsExpr GhcTc)
    hsRecFieldArg = GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs' }))) }

    tcRecordField :: ConLike -> Assoc Name Type
                  -> LFieldOcc GhcRn -> LHsExpr GhcRn
                  -> TcM (Maybe (LFieldOcc GhcTc, LHsExpr GhcTc))
    tcRecordField :: ConLike
    -> [(Name, TcType)]
    -> LFieldOcc 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 LocatedN 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 { GenLocated SrcSpanAnnA (HsExpr 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
      (Located (FieldOcc GhcTc), GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Maybe
            (Located (FieldOcc GhcTc), GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Located (FieldOcc GhcTc), GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> Maybe
         (Located (FieldOcc GhcTc), GenLocated SrcSpanAnnA (HsExpr GhcTc))
    forall a. a -> Maybe a
    Just (SrcSpan -> FieldOcc GhcTc -> Located (FieldOcc GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XCFieldOcc GhcTc -> LocatedN RdrName -> FieldOcc GhcTc
    forall pass. XCFieldOcc pass -> LocatedN RdrName -> FieldOcc pass
    FieldOcc Var
    XCFieldOcc GhcTc
    field_id LocatedN RdrName
    lbl), GenLocated SrcSpanAnnA (HsExpr GhcTc)
    rhs')) }
          | Bool
    otherwise
          = do { SDoc -> TcRn ()
    addErrTc (ConLike -> FieldLabelString -> SDoc
    badFieldCon ConLike
    con_like FieldLabelString
    field_lbl)
               ; Maybe
      (Located (FieldOcc GhcTc), GenLocated SrcSpanAnnA (HsExpr GhcTc))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Maybe
            (Located (FieldOcc GhcTc), GenLocated SrcSpanAnnA (HsExpr GhcTc)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe
      (Located (FieldOcc GhcTc), GenLocated SrcSpanAnnA (HsExpr 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 (LocatedN RdrName -> RdrName
    forall l e. GenLocated l e -> e
    unLoc LocatedN RdrName
    lbl)

    checkMissingFields ::  ConLike -> HsRecordBinds GhcRn -> [Scaled TcType] -> TcM ()
    checkMissingFields :: ConLike -> HsRecordBinds GhcRn -> [Scaled TcType] -> TcRn ()
    checkMissingFields ConLike
    con_like HsRecordBinds GhcRn
    rbinds [Scaled TcType]
    arg_tys
      | [FieldLabel] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldLabel]
    field_labels   -- Not declared as a record;
                            -- But C{} is still valid if no strict fields
      = if (HsImplBang -> Bool) -> [HsImplBang] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any HsImplBang -> Bool
    isBanged [HsImplBang]
    field_strs then
            -- Illegal if any arg is strict
            SDoc -> TcRn ()
    addErrTc (ConLike -> [(FieldLabelString, TcType)] -> SDoc
    missingStrictFields ConLike
    con_like [])
        else do
            Bool
    warn <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv 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 (f :: * -> *) a. Foldable f => f a -> Bool
    notNull [HsImplBang]
    field_strs Bool -> Bool -> Bool
    && [FieldLabel] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FieldLabel]
    field_labels)
                 (WarnReason -> Bool -> SDoc -> TcRn ()
    warnTc (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnMissingFields) Bool
    True
                     (ConLike -> [(FieldLabelString, TcType)] -> SDoc
    missingFields ConLike
    con_like []))

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

        Bool
    warn <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv 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, TcType)] -> Bool
    forall (f :: * -> *) a. Foldable f => f a -> Bool
    notNull [(FieldLabelString, TcType)]
    missing_ns_fields) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ do
            [(FieldLabelString, TcType)]
    fs <- [(FieldLabelString, TcType)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [(FieldLabelString, TcType)]
    forall {t :: * -> *} {a}.
    Traversable t =>
    t (a, TcType) -> IOEnv (Env TcGblEnv TcLclEnv) (t (a, TcType))
    zonk_fields [(FieldLabelString, TcType)]
    missing_ns_fields
            -- It is not an error (though we may want) to omit a
            -- lazy field, because we can always use
            -- (error "Missing field f") instead.
            WarnReason -> Bool -> SDoc -> TcRn ()
    warnTc (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnMissingFields) Bool
    True
                 (ConLike -> [(FieldLabelString, TcType)] -> SDoc
    missingFields ConLike
    con_like [(FieldLabelString, TcType)]
    fs)

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

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

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

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

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

    {-
    ************************************************************************
    *                                                                      *
    \subsection{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")

    badFieldTypes :: [(FieldLabelString,TcType)] -> SDoc
    badFieldTypes :: [(FieldLabelString, TcType)] -> SDoc
    badFieldTypes [(FieldLabelString, TcType)]
    prs
      = SDoc -> Int -> 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)
           Int
    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' GhcTc (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' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    -> [ConLike] -> SDoc
    badFieldsUpd [LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds [ConLike]
    data_cons
      = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "No constructor has all these fields:")
           Int
    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, (UniqSet FieldLabelString -> Bool)
    -> [UniqSet FieldLabelString] -> [Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map (FieldLabelString
    fld FieldLabelString -> UniqSet FieldLabelString -> Bool
    forall a. Uniquable a => a -> UniqSet a -> Bool
    `elementOfUniqSet`) [UniqSet FieldLabelString]
    fieldLabelSets)) ([FieldLabelString] -> [(FieldLabelString, [Bool])])
    -> [FieldLabelString] -> [(FieldLabelString, [Bool])]
    forall a b. (a -> b) -> a -> b
    $
              (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
     -> FieldLabelString)
    -> [GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> [FieldLabelString]
    forall a b. (a -> b) -> [a] -> [b]
    map (OccName -> FieldLabelString
    occNameFS (OccName -> FieldLabelString)
    -> (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
        -> OccName)
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> FieldLabelString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RdrName -> OccName
    rdrNameOcc (RdrName -> OccName)
    -> (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
        -> RdrName)
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr 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)
    -> (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
        -> AmbiguousFieldOcc GhcTc)
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr 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)
    -> (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
        -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc))
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> AmbiguousFieldOcc GhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsRecField'
      (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl (HsRecField'
       (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
     -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc))
    -> (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
        -> HsRecField'
             (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> GenLocated SrcSpan (AmbiguousFieldOcc GhcTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> HsRecField'
         (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    forall l e. GenLocated l e -> e
    unLoc) [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcTc) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    [LHsRecField' GhcTc (AmbiguousFieldOcc GhcTc) (LHsExpr GhcRn)]
    rbinds

        fieldLabelSets :: [UniqSet FieldLabelString]
        fieldLabelSets :: [UniqSet FieldLabelString]
    fieldLabelSets = (ConLike -> UniqSet FieldLabelString)
    -> [ConLike] -> [UniqSet FieldLabelString]
    forall a b. (a -> b) -> [a] -> [b]
    map ([FieldLabelString] -> UniqSet FieldLabelString
    forall a. Uniquable a => [a] -> UniqSet a
    mkUniqSet ([FieldLabelString] -> UniqSet FieldLabelString)
    -> (ConLike -> [FieldLabelString])
    -> ConLike
    -> UniqSet FieldLabelString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FieldLabel -> FieldLabelString)
    -> [FieldLabel] -> [FieldLabelString]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLabel -> FieldLabelString
    flLabel ([FieldLabel] -> [FieldLabelString])
    -> (ConLike -> [FieldLabel]) -> ConLike -> [FieldLabelString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConLike -> [FieldLabel]
    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 =
          ((Int, (a, [Bool])) -> (a, [Bool]))
    -> [(Int, (a, [Bool]))] -> [(a, [Bool])]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int, (a, [Bool])) -> (a, [Bool])
    forall a b. (a, b) -> b
    snd ([(Int, (a, [Bool]))] -> [(a, [Bool])])
    -> ([(a, [Bool])] -> [(Int, (a, [Bool]))])
    -> [(a, [Bool])]
    -> [(a, [Bool])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          ((Int, (a, [Bool])) -> (Int, (a, [Bool])) -> Ordering)
    -> [(Int, (a, [Bool]))] -> [(Int, (a, [Bool]))]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Int -> Int -> Ordering)
    -> ((Int, (a, [Bool])) -> Int)
    -> (Int, (a, [Bool]))
    -> (Int, (a, [Bool]))
    -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (Int, (a, [Bool])) -> Int
    forall a b. (a, b) -> a
    fst) ([(Int, (a, [Bool]))] -> [(Int, (a, [Bool]))])
    -> ([(a, [Bool])] -> [(Int, (a, [Bool]))])
    -> [(a, [Bool])]
    -> [(Int, (a, [Bool]))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          ((a, [Bool]) -> (Int, (a, [Bool])))
    -> [(a, [Bool])] -> [(Int, (a, [Bool]))]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ item :: (a, [Bool])
    item@(a
    _, [Bool]
    membershipRow) -> ([Bool] -> Int
    countTrue [Bool]
    membershipRow, (a, [Bool])
    item))

        countTrue :: [Bool] -> Int
    countTrue = (Bool -> Bool) -> [Bool] -> Int
    forall a. (a -> Bool) -> [a] -> Int
    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.
    -}

    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, TcType)] -> SDoc
    missingStrictFields :: ConLike -> [(FieldLabelString, TcType)] -> SDoc
    missingStrictFields ConLike
    con [(FieldLabelString, TcType)]
    fields
      = [SDoc] -> SDoc
    vcat [SDoc
    header, Int -> SDoc -> SDoc
    nest Int
    2 SDoc
    rest]
      where
        pprField :: (a, a) -> SDoc
    pprField (a
    f,a
    ty) = a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    f SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    ty
        rest :: SDoc
    rest | [(FieldLabelString, TcType)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(FieldLabelString, TcType)]
    fields = SDoc
    Outputable.empty  -- Happens for non-record constructors
                                               -- with strict fields
             | Bool
    otherwise   = [SDoc] -> SDoc
    vcat (((FieldLabelString, TcType) -> SDoc)
    -> [(FieldLabelString, TcType)] -> [SDoc]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (FieldLabelString, TcType) -> SDoc
    forall {a} {a}. (Outputable a, Outputable a) => (a, a) -> SDoc
    pprField [(FieldLabelString, TcType)]
    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)" SDoc -> SDoc -> SDoc
    <>
                 if [(FieldLabelString, TcType)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(FieldLabelString, TcType)]
    fields then SDoc
    Outputable.empty else SDoc
    colon

    missingFields :: ConLike -> [(FieldLabelString, TcType)] -> SDoc
    missingFields :: ConLike -> [(FieldLabelString, TcType)] -> SDoc
    missingFields ConLike
    con [(FieldLabelString, TcType)]
    fields
      = [SDoc] -> SDoc
    vcat [SDoc
    header, Int -> SDoc -> SDoc
    nest Int
    2 SDoc
    rest]
      where
        pprField :: (a, a) -> SDoc
    pprField (a
    f,a
    ty) = a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    f SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "::" SDoc -> SDoc -> SDoc
    <+> a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    ty
        rest :: SDoc
    rest | [(FieldLabelString, TcType)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(FieldLabelString, TcType)]
    fields = SDoc
    Outputable.empty
             | Bool
    otherwise   = [SDoc] -> SDoc
    vcat (((FieldLabelString, TcType) -> SDoc)
    -> [(FieldLabelString, TcType)] -> [SDoc]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (FieldLabelString, TcType) -> SDoc
    forall {a} {a}. (Outputable a, Outputable a) => (a, a) -> SDoc
    pprField [(FieldLabelString, TcType)]
    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" SDoc -> SDoc -> SDoc
    <>
                 if [(FieldLabelString, TcType)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(FieldLabelString, TcType)]
    fields then SDoc
    Outputable.empty else SDoc
    colon

    -- 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 -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "No type has all these fields:")
           Int
    2 ([Located (AmbiguousFieldOcc GhcRn)] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [Located (AmbiguousFieldOcc GhcRn)]
    fields)
      where
        fields :: [Located (AmbiguousFieldOcc GhcRn)]
    fields = (GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
     -> Located (AmbiguousFieldOcc GhcRn))
    -> [GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> [Located (AmbiguousFieldOcc GhcRn)]
    forall a b. (a -> b) -> [a] -> [b]
    map (HsRecField'
      (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> Located (AmbiguousFieldOcc GhcRn)
    forall id arg. HsRecField' id arg -> Located id
    hsRecFieldLbl (HsRecField'
       (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
     -> Located (AmbiguousFieldOcc GhcRn))
    -> (GenLocated
          SrcSpanAnnA
          (HsRecField'
             (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
        -> HsRecField'
             (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> GenLocated
         SrcSpanAnnA
         (HsRecField'
            (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> Located (AmbiguousFieldOcc GhcRn)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated
      SrcSpanAnnA
      (HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> HsRecField'
         (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    forall l e. GenLocated l e -> e
    unLoc) [GenLocated
       SrcSpanAnnA
       (HsRecField'
          (AmbiguousFieldOcc GhcRn) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    [LHsRecUpdField GhcRn]
    rbinds

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

    {-
    ************************************************************************
    *                                                                      *
    \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 =
          -- 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) = Int -> [SDoc] -> ([SDoc], [SDoc])
    forall a. Int -> [a] -> ([a], [a])
    splitAt Int
    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.
    --