    {-# LANGUAGE CPP              #-}
    {-# LANGUAGE FlexibleContexts #-}

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

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

    -}

    module GHC.Tc.Utils.Instantiate (
         topSkolemise,
         topInstantiate,
         instantiateSigma,
         instCall, instDFunType, instStupidTheta, instTyVarsWith,
         newWanted, newWanteds,

         tcInstType, tcInstTypeBndrs,
         tcInstSkolTyVars, tcInstSkolTyVarsX, tcInstSkolTyVarsAt,
         tcSkolDFunType, tcSuperSkolTyVars, tcInstSuperSkolTyVarsX,

         freshenTyVarBndrs, freshenCoVarBndrsX,

         tcInstInvisibleTyBindersN, tcInstInvisibleTyBinders, tcInstInvisibleTyBinder,

         newOverloadedLit, mkOverLit,

         newClsInst,
         tcGetInsts, tcGetInstEnvs, getOverlapFlag,
         tcExtendLocalInstEnv,
         instCallConstraints, newMethodFromName,
         tcSyntaxName,

         -- Simple functions over evidence variables
         tyCoVarsOfWC,
         tyCoVarsOfCt, tyCoVarsOfCts,
      ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Driver.Session
    import GHC.Driver.Env

    import GHC.Builtin.Types  ( heqDataCon, eqDataCon, integerTyConName )
    import GHC.Builtin.Names

    import GHC.Hs

    import GHC.Core.InstEnv
    import GHC.Core.Predicate
    import GHC.Core ( Expr(..), isOrphan ) -- For the Coercion constructor
    import GHC.Core.Type
    import GHC.Core.Multiplicity
    import GHC.Core.TyCo.Rep
    import GHC.Core.TyCo.Ppr ( debugPprType )
    import GHC.Core.Class( Class )
    import GHC.Core.DataCon

    import {-# SOURCE #-}   GHC.Tc.Gen.Expr( tcCheckPolyExpr, tcSyntaxOp )
    import {-# SOURCE #-}   GHC.Tc.Utils.Unify( unifyType, unifyKind )
    import GHC.Tc.Utils.Zonk
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Types.Constraint
    import GHC.Tc.Types.Origin
    import GHC.Tc.Utils.Env
    import GHC.Tc.Types.Evidence
    import GHC.Tc.Instance.FunDeps
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Utils.TcType

    import GHC.Types.Id.Make( mkDictFunId )
    import GHC.Types.Basic ( TypeOrKind(..) )
    import GHC.Types.SourceText
    import GHC.Types.SrcLoc as SrcLoc
    import GHC.Types.Var.Env
    import GHC.Types.Var.Set
    import GHC.Types.Id
    import GHC.Types.Name
    import GHC.Types.Var
    import qualified GHC.LanguageExtensions as LangExt

    import GHC.Utils.Misc
    import GHC.Utils.Panic
    import GHC.Utils.Outputable

    import GHC.Unit.State
    import GHC.Unit.External

    import Data.List ( sortBy, mapAccumL )
    import Control.Monad( unless )
    import Data.Function ( on )

    {-
    ************************************************************************
    *                                                                      *
                    Creating and emittind constraints
    *                                                                      *
    ************************************************************************
    -}

    newMethodFromName
      :: CtOrigin              -- ^ why do we need this?
      -> Name                  -- ^ name of the method
      -> [TcRhoType]           -- ^ types with which to instantiate the class
      -> TcM (HsExpr GhcTc)
    -- ^ Used when 'Name' is the wired-in name for a wired-in class method,
    -- so the caller knows its type for sure, which should be of form
    --
    -- > forall a. C a => <blah>
    --
    -- 'newMethodFromName' is supposed to instantiate just the outer
    -- type variable and constraint

    newMethodFromName :: CtOrigin -> Name -> [Type] -> TcM (HsExpr GhcTc)
    newMethodFromName CtOrigin
    origin Name
    name [Type]
    ty_args
      = do { DFunId
    id <- Name -> TcM DFunId
    tcLookupId Name
    name
                  -- Use tcLookupId not tcLookupGlobalId; the method is almost
                  -- always a class op, but with -XRebindableSyntax GHC is
                  -- meant to find whatever thing is in scope, and that may
                  -- be an ordinary function.

           ; let ty :: Type
    ty = HasDebugCallStack => Type -> [Type] -> Type
    piResultTys (DFunId -> Type
    idType DFunId
    id) [Type]
    ty_args
                 ([Type]
    theta, Type
    _caller_knows_this) = Type -> ([Type], Type)
    tcSplitPhiTy Type
    ty
           ; HsWrapper
    wrap <- ASSERT( not (isForAllTy ty) && isSingleton theta )
                     CtOrigin -> [Type] -> [Type] -> TcM HsWrapper
    instCall CtOrigin
    origin [Type]
    ty_args [Type]
    theta

           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrap (forall p. XVar p -> LIdP p -> HsExpr p
    HsVar NoExtField
    noExtField (forall a an. a -> LocatedAn an a
    noLocA DFunId
    id))) }

    {-
    ************************************************************************
    *                                                                      *
             Instantiation and skolemisation
    *                                                                      *
    ************************************************************************

    Note [Skolemisation]
    ~~~~~~~~~~~~~~~~~~~~
    topSkolemise decomposes and skolemises a type, returning a type
    with no top level foralls or (=>)

    Examples:

      topSkolemise (forall a. Ord a => a -> a)
        =  ( wp, [a], [d:Ord a], a->a )
        where wp = /\a. \(d:Ord a). <hole> a d

      topSkolemise  (forall a. Ord a => forall b. Eq b => a->b->b)
        =  ( wp, [a,b], [d1:Ord a,d2:Eq b], a->b->b )
        where wp = /\a.\(d1:Ord a)./\b.\(d2:Ord b). <hole> a d1 b d2

    This second example is the reason for the recursive 'go'
    function in topSkolemise: we must remove successive layers
    of foralls and (=>).

    In general,
      if      topSkolemise ty = (wrap, tvs, evs, rho)
        and   e :: rho
      then    wrap e :: ty
        and   'wrap' binds {tvs, evs}

    -}

    topSkolemise :: TcSigmaType
                 -> TcM ( HsWrapper
                        , [(Name,TyVar)]     -- All skolemised variables
                        , [EvVar]            -- All "given"s
                        , TcRhoType )
    -- See Note [Skolemisation]
    topSkolemise :: Type -> TcM (HsWrapper, [(Name, DFunId)], [DFunId], Type)
    topSkolemise Type
    ty
      = TCvSubst
    -> HsWrapper
    -> [(Name, DFunId)]
    -> [DFunId]
    -> Type
    -> TcM (HsWrapper, [(Name, DFunId)], [DFunId], Type)
    go TCvSubst
    init_subst HsWrapper
    idHsWrapper [] [] Type
    ty
      where
        init_subst :: TCvSubst
    init_subst = InScopeSet -> TCvSubst
    mkEmptyTCvSubst (VarSet -> InScopeSet
    mkInScopeSet (Type -> VarSet
    tyCoVarsOfType Type
    ty))

        -- Why recursive?  See Note [Skolemisation]
        go :: TCvSubst
    -> HsWrapper
    -> [(Name, DFunId)]
    -> [DFunId]
    -> Type
    -> TcM (HsWrapper, [(Name, DFunId)], [DFunId], Type)
    go TCvSubst
    subst HsWrapper
    wrap [(Name, DFunId)]
    tv_prs [DFunId]
    ev_vars Type
    ty
          | ([DFunId]
    tvs, [Type]
    theta, Type
    inner_ty) <- Type -> ([DFunId], [Type], Type)
    tcSplitSigmaTy Type
    ty
          , Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [DFunId]
    tvs Bool -> Bool -> Bool
    && forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    theta)
          = do { (TCvSubst
    subst', [DFunId]
    tvs1) <- TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSkolTyVarsX TCvSubst
    subst [DFunId]
    tvs
               ; [DFunId]
    ev_vars1       <- [Type] -> TcM [DFunId]
    newEvVars (HasCallStack => TCvSubst -> [Type] -> [Type]
    substTheta TCvSubst
    subst' [Type]
    theta)
               ; TCvSubst
    -> HsWrapper
    -> [(Name, DFunId)]
    -> [DFunId]
    -> Type
    -> TcM (HsWrapper, [(Name, DFunId)], [DFunId], Type)
    go TCvSubst
    subst'
                    (HsWrapper
    wrap HsWrapper -> HsWrapper -> HsWrapper
    <.> [DFunId] -> HsWrapper
    mkWpTyLams [DFunId]
    tvs1 HsWrapper -> HsWrapper -> HsWrapper
    <.> [DFunId] -> HsWrapper
    mkWpLams [DFunId]
    ev_vars1)
                    ([(Name, DFunId)]
    tv_prs forall a. [a] -> [a] -> [a]
    ++ (forall a b. (a -> b) -> [a] -> [b]
    map DFunId -> Name
    tyVarName [DFunId]
    tvs forall a b. [a] -> [b] -> [(a, b)]
    `zip` [DFunId]
    tvs1))
                    ([DFunId]
    ev_vars forall a. [a] -> [a] -> [a]
    ++ [DFunId]
    ev_vars1)
                    Type
    inner_ty }

          | Bool
    otherwise
          = forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper
    wrap, [(Name, DFunId)]
    tv_prs, [DFunId]
    ev_vars, HasCallStack => TCvSubst -> Type -> Type
    substTy TCvSubst
    subst Type
    ty)
            -- substTy is a quick no-op on an empty substitution

    topInstantiate ::CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
    -- Instantiate outer invisible binders (both Inferred and Specified)
    -- If    top_instantiate ty = (wrap, inner_ty)
    -- then  wrap :: inner_ty "->" ty
    -- NB: returns a type with no (=>),
    --     and no invisible forall at the top
    topInstantiate :: CtOrigin -> Type -> TcM (HsWrapper, Type)
    topInstantiate CtOrigin
    orig Type
    sigma
      | ([DFunId]
    tvs,   Type
    body1) <- (ArgFlag -> Bool) -> Type -> ([DFunId], Type)
    tcSplitSomeForAllTyVars ArgFlag -> Bool
    isInvisibleArgFlag Type
    sigma
      , ([Type]
    theta, Type
    body2) <- Type -> ([Type], Type)
    tcSplitPhiTy Type
    body1
      , Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [DFunId]
    tvs Bool -> Bool -> Bool
    && forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    theta)
      = do { ([DFunId]
    _, HsWrapper
    wrap1, Type
    body3) <- CtOrigin
    -> [DFunId] -> [Type] -> Type -> TcM ([DFunId], HsWrapper, Type)
    instantiateSigma CtOrigin
    orig [DFunId]
    tvs [Type]
    theta Type
    body2

           -- Loop, to account for types like
           --       forall a. Num a => forall b. Ord b => ...
           ; (HsWrapper
    wrap2, Type
    body4) <- CtOrigin -> Type -> TcM (HsWrapper, Type)
    topInstantiate CtOrigin
    orig Type
    body3

           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper
    wrap2 HsWrapper -> HsWrapper -> HsWrapper
    <.> HsWrapper
    wrap1, Type
    body4) }

      | Bool
    otherwise = forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper
    idHsWrapper, Type
    sigma)

    instantiateSigma :: CtOrigin -> [TyVar] -> TcThetaType -> TcSigmaType
                     -> TcM ([TcTyVar], HsWrapper, TcSigmaType)
    -- (instantiate orig tvs theta ty)
    -- instantiates the the type variables tvs, emits the (instantiated)
    -- constraints theta, and returns the (instantiated) type ty
    instantiateSigma :: CtOrigin
    -> [DFunId] -> [Type] -> Type -> TcM ([DFunId], HsWrapper, Type)
    instantiateSigma CtOrigin
    orig [DFunId]
    tvs [Type]
    theta Type
    body_ty
      = do { (TCvSubst
    subst, [DFunId]
    inst_tvs) <- forall (m :: * -> *) acc x y.
    Monad m =>
    (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
    mapAccumLM TCvSubst -> DFunId -> TcM (TCvSubst, DFunId)
    newMetaTyVarX TCvSubst
    empty_subst [DFunId]
    tvs
           ; let inst_theta :: [Type]
    inst_theta  = HasCallStack => TCvSubst -> [Type] -> [Type]
    substTheta TCvSubst
    subst [Type]
    theta
                 inst_body :: Type
    inst_body   = HasCallStack => TCvSubst -> Type -> Type
    substTy TCvSubst
    subst Type
    body_ty
                 inst_tv_tys :: [Type]
    inst_tv_tys = [DFunId] -> [Type]
    mkTyVarTys [DFunId]
    inst_tvs

           ; HsWrapper
    wrap <- CtOrigin -> [Type] -> [Type] -> TcM HsWrapper
    instCall CtOrigin
    orig [Type]
    inst_tv_tys [Type]
    inst_theta
           ; String -> SDoc -> TcRn ()
    traceTc String
    "Instantiating"
                     ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "origin" SDoc -> SDoc -> SDoc
    <+> CtOrigin -> SDoc
    pprCtOrigin CtOrigin
    orig
                           , String -> SDoc
    text String
    "tvs"   SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr [DFunId]
    tvs
                           , String -> SDoc
    text String
    "theta" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr [Type]
    theta
                           , String -> SDoc
    text String
    "type" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    debugPprType Type
    body_ty
                           , String -> SDoc
    text String
    "with" SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    vcat (forall a b. (a -> b) -> [a] -> [b]
    map Type -> SDoc
    debugPprType [Type]
    inst_tv_tys)
                           , String -> SDoc
    text String
    "theta:" SDoc -> SDoc -> SDoc
    <+>  forall a. Outputable a => a -> SDoc
    ppr [Type]
    inst_theta ])

          ; forall (m :: * -> *) a. Monad m => a -> m a
    return ([DFunId]
    inst_tvs, HsWrapper
    wrap, Type
    inst_body) }
      where
        free_tvs :: VarSet
    free_tvs = Type -> VarSet
    tyCoVarsOfType Type
    body_ty VarSet -> VarSet -> VarSet
    `unionVarSet` [Type] -> VarSet
    tyCoVarsOfTypes [Type]
    theta
        in_scope :: InScopeSet
    in_scope = VarSet -> InScopeSet
    mkInScopeSet (VarSet
    free_tvs VarSet -> [DFunId] -> VarSet
    `delVarSetList` [DFunId]
    tvs)
        empty_subst :: TCvSubst
    empty_subst = InScopeSet -> TCvSubst
    mkEmptyTCvSubst InScopeSet
    in_scope

    instTyVarsWith :: CtOrigin -> [TyVar] -> [TcType] -> TcM TCvSubst
    -- Use this when you want to instantiate (forall a b c. ty) with
    -- types [ta, tb, tc], but when the kinds of 'a' and 'ta' might
    -- not yet match (perhaps because there are unsolved constraints; #14154)
    -- If they don't match, emit a kind-equality to promise that they will
    -- eventually do so, and thus make a kind-homongeneous substitution.
    instTyVarsWith :: CtOrigin -> [DFunId] -> [Type] -> TcM TCvSubst
    instTyVarsWith CtOrigin
    orig [DFunId]
    tvs [Type]
    tys
      = TCvSubst -> [DFunId] -> [Type] -> TcM TCvSubst
    go TCvSubst
    emptyTCvSubst [DFunId]
    tvs [Type]
    tys
      where
        go :: TCvSubst -> [DFunId] -> [Type] -> TcM TCvSubst
    go TCvSubst
    subst [] []
          = forall (m :: * -> *) a. Monad m => a -> m a
    return TCvSubst
    subst
        go TCvSubst
    subst (DFunId
    tv:[DFunId]
    tvs) (Type
    ty:[Type]
    tys)
          | Type
    tv_kind HasDebugCallStack => Type -> Type -> Bool
    `tcEqType` Type
    ty_kind
          = TCvSubst -> [DFunId] -> [Type] -> TcM TCvSubst
    go (TCvSubst -> DFunId -> Type -> TCvSubst
    extendTvSubstAndInScope TCvSubst
    subst DFunId
    tv Type
    ty) [DFunId]
    tvs [Type]
    tys
          | Bool
    otherwise
          = do { Coercion
    co <- CtOrigin -> TypeOrKind -> Role -> Type -> Type -> TcM Coercion
    emitWantedEq CtOrigin
    orig TypeOrKind
    KindLevel Role
    Nominal Type
    ty_kind Type
    tv_kind
               ; TCvSubst -> [DFunId] -> [Type] -> TcM TCvSubst
    go (TCvSubst -> DFunId -> Type -> TCvSubst
    extendTvSubstAndInScope TCvSubst
    subst DFunId
    tv (Type
    ty Type -> Coercion -> Type
    `mkCastTy` Coercion
    co)) [DFunId]
    tvs [Type]
    tys }
          where
            tv_kind :: Type
    tv_kind = HasCallStack => TCvSubst -> Type -> Type
    substTy TCvSubst
    subst (DFunId -> Type
    tyVarKind DFunId
    tv)
            ty_kind :: Type
    ty_kind = HasDebugCallStack => Type -> Type
    tcTypeKind Type
    ty

        go TCvSubst
    _ [DFunId]
    _ [Type]
    _ = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "instTysWith" (forall a. Outputable a => a -> SDoc
    ppr [DFunId]
    tvs SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr [Type]
    tys)

    {-
    ************************************************************************
    *                                                                      *
                Instantiating a call
    *                                                                      *
    ************************************************************************

    Note [Handling boxed equality]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The solver deals entirely in terms of unboxed (primitive) equality.
    There should never be a boxed Wanted equality. Ever. But, what if
    we are calling `foo :: forall a. (F a ~ Bool) => ...`? That equality
    is boxed, so naive treatment here would emit a boxed Wanted equality.

    So we simply check for this case and make the right boxing of evidence.

    -}

    ----------------
    instCall :: CtOrigin -> [TcType] -> TcThetaType -> TcM HsWrapper
    -- Instantiate the constraints of a call
    --      (instCall o tys theta)
    -- (a) Makes fresh dictionaries as necessary for the constraints (theta)
    -- (b) Throws these dictionaries into the LIE
    -- (c) Returns an HsWrapper ([.] tys dicts)

    instCall :: CtOrigin -> [Type] -> [Type] -> TcM HsWrapper
    instCall CtOrigin
    orig [Type]
    tys [Type]
    theta
      = do  { HsWrapper
    dict_app <- CtOrigin -> [Type] -> TcM HsWrapper
    instCallConstraints CtOrigin
    orig [Type]
    theta
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsWrapper
    dict_app HsWrapper -> HsWrapper -> HsWrapper
    <.> [Type] -> HsWrapper
    mkWpTyApps [Type]
    tys) }

    ----------------
    instCallConstraints :: CtOrigin -> TcThetaType -> TcM HsWrapper
    -- Instantiates the TcTheta, puts all constraints thereby generated
    -- into the LIE, and returns a HsWrapper to enclose the call site.

    instCallConstraints :: CtOrigin -> [Type] -> TcM HsWrapper
    instCallConstraints CtOrigin
    orig [Type]
    preds
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    preds
      = forall (m :: * -> *) a. Monad m => a -> m a
    return HsWrapper
    idHsWrapper
      | Bool
    otherwise
      = do { [EvTerm]
    evs <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> TcM EvTerm
    go [Type]
    preds
           ; String -> SDoc -> TcRn ()
    traceTc String
    "instCallConstraints" (forall a. Outputable a => a -> SDoc
    ppr [EvTerm]
    evs)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return ([EvTerm] -> HsWrapper
    mkWpEvApps [EvTerm]
    evs) }
      where
        go :: TcPredType -> TcM EvTerm
        go :: Type -> TcM EvTerm
    go Type
    pred
         | Just (Role
    Nominal, Type
    ty1, Type
    ty2) <- Type -> Maybe (Role, Type, Type)
    getEqPredTys_maybe Type
    pred -- Try short-cut #1
         = do  { Coercion
    co <- Maybe SDoc -> Type -> Type -> TcM Coercion
    unifyType forall a. Maybe a
    Nothing Type
    ty1 Type
    ty2
               ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Coercion -> EvTerm
    evCoercion Coercion
    co) }

           -- Try short-cut #2
         | Just (TyCon
    tc, args :: [Type]
    args@[Type
    _, Type
    _, Type
    ty1, Type
    ty2]) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    pred
         , TyCon
    tc forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    heqTyConKey
         = do { Coercion
    co <- Maybe SDoc -> Type -> Type -> TcM Coercion
    unifyType forall a. Maybe a
    Nothing Type
    ty1 Type
    ty2
              ; forall (m :: * -> *) a. Monad m => a -> m a
    return (DFunId -> [Type] -> [EvExpr] -> EvTerm
    evDFunApp (DataCon -> DFunId
    dataConWrapId DataCon
    heqDataCon) [Type]
    args [forall b. Coercion -> Expr b
    Coercion Coercion
    co]) }

         | Bool
    otherwise
         = CtOrigin -> Type -> TcM EvTerm
    emitWanted CtOrigin
    orig Type
    pred

    instDFunType :: DFunId -> [DFunInstType]
                 -> TcM ( [TcType]      -- instantiated argument types
                        , TcThetaType ) -- instantiated constraint
    -- See Note [DFunInstType: instantiating types] in GHC.Core.InstEnv
    instDFunType :: DFunId -> [DFunInstType] -> TcM ([Type], [Type])
    instDFunType DFunId
    dfun_id [DFunInstType]
    dfun_inst_tys
      = do { (TCvSubst
    subst, [Type]
    inst_tys) <- TCvSubst -> [DFunId] -> [DFunInstType] -> TcM (TCvSubst, [Type])
    go TCvSubst
    empty_subst [DFunId]
    dfun_tvs [DFunInstType]
    dfun_inst_tys
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return ([Type]
    inst_tys, HasCallStack => TCvSubst -> [Type] -> [Type]
    substTheta TCvSubst
    subst [Type]
    dfun_theta) }
      where
        dfun_ty :: Type
    dfun_ty = DFunId -> Type
    idType DFunId
    dfun_id
        ([DFunId]
    dfun_tvs, [Type]
    dfun_theta, Type
    _) = Type -> ([DFunId], [Type], Type)
    tcSplitSigmaTy Type
    dfun_ty
        empty_subst :: TCvSubst
    empty_subst = InScopeSet -> TCvSubst
    mkEmptyTCvSubst (VarSet -> InScopeSet
    mkInScopeSet (Type -> VarSet
    tyCoVarsOfType Type
    dfun_ty))
                      -- With quantified constraints, the
                      -- type of a dfun may not be closed

        go :: TCvSubst -> [TyVar] -> [DFunInstType] -> TcM (TCvSubst, [TcType])
        go :: TCvSubst -> [DFunId] -> [DFunInstType] -> TcM (TCvSubst, [Type])
    go TCvSubst
    subst [] [] = forall (m :: * -> *) a. Monad m => a -> m a
    return (TCvSubst
    subst, [])
        go TCvSubst
    subst (DFunId
    tv:[DFunId]
    tvs) (Just Type
    ty : [DFunInstType]
    mb_tys)
          = do { (TCvSubst
    subst', [Type]
    tys) <- TCvSubst -> [DFunId] -> [DFunInstType] -> TcM (TCvSubst, [Type])
    go (TCvSubst -> DFunId -> Type -> TCvSubst
    extendTvSubstAndInScope TCvSubst
    subst DFunId
    tv Type
    ty)
                                     [DFunId]
    tvs
                                     [DFunInstType]
    mb_tys
               ; forall (m :: * -> *) a. Monad m => a -> m a
    return (TCvSubst
    subst', Type
    ty forall a. a -> [a] -> [a]
    : [Type]
    tys) }
        go TCvSubst
    subst (DFunId
    tv:[DFunId]
    tvs) (DFunInstType
    Nothing : [DFunInstType]
    mb_tys)
          = do { (TCvSubst
    subst', DFunId
    tv') <- TCvSubst -> DFunId -> TcM (TCvSubst, DFunId)
    newMetaTyVarX TCvSubst
    subst DFunId
    tv
               ; (TCvSubst
    subst'', [Type]
    tys) <- TCvSubst -> [DFunId] -> [DFunInstType] -> TcM (TCvSubst, [Type])
    go TCvSubst
    subst' [DFunId]
    tvs [DFunInstType]
    mb_tys
               ; forall (m :: * -> *) a. Monad m => a -> m a
    return (TCvSubst
    subst'', DFunId -> Type
    mkTyVarTy DFunId
    tv' forall a. a -> [a] -> [a]
    : [Type]
    tys) }
        go TCvSubst
    _ [DFunId]
    _ [DFunInstType]
    _ = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "instDFunTypes" (forall a. Outputable a => a -> SDoc
    ppr DFunId
    dfun_id SDoc -> SDoc -> SDoc
    $$ forall a. Outputable a => a -> SDoc
    ppr [DFunInstType]
    dfun_inst_tys)

    ----------------
    instStupidTheta :: CtOrigin -> TcThetaType -> TcM ()
    -- Similar to instCall, but only emit the constraints in the LIE
    -- Used exclusively for the 'stupid theta' of a data constructor
    instStupidTheta :: CtOrigin -> [Type] -> TcRn ()
    instStupidTheta CtOrigin
    orig [Type]
    theta
      = do  { HsWrapper
    _co <- CtOrigin -> [Type] -> TcM HsWrapper
    instCallConstraints CtOrigin
    orig [Type]
    theta -- Discard the coercion
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return () }

    {- *********************************************************************
    *                                                                      *
             Instantiating Kinds
    *                                                                      *
    ********************************************************************* -}

    -- | Given ty::forall k1 k2. k, instantiate all the invisible forall-binders
    --   returning ty @kk1 @kk2 :: k[kk1/k1, kk2/k1]
    tcInstInvisibleTyBinders :: TcType -> TcKind -> TcM (TcType, TcKind)
    tcInstInvisibleTyBinders :: Type -> Type -> TcM (Type, Type)
    tcInstInvisibleTyBinders Type
    ty Type
    kind
      = do { ([Type]
    extra_args, Type
    kind') <- Int -> Type -> TcM ([Type], Type)
    tcInstInvisibleTyBindersN Int
    n_invis Type
    kind
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> [Type] -> Type
    mkAppTys Type
    ty [Type]
    extra_args, Type
    kind') }
      where
        n_invis :: Int
    n_invis = Type -> Int
    invisibleTyBndrCount Type
    kind

    tcInstInvisibleTyBindersN :: Int -> TcKind -> TcM ([TcType], TcKind)
    tcInstInvisibleTyBindersN :: Int -> Type -> TcM ([Type], Type)
    tcInstInvisibleTyBindersN Int
    0 Type
    kind
      = forall (m :: * -> *) a. Monad m => a -> m a
    return ([], Type
    kind)
    tcInstInvisibleTyBindersN Int
    n Type
    ty
      = forall {t}.
    (Ord t, Num t) =>
    t -> TCvSubst -> Type -> TcM ([Type], Type)
    go Int
    n TCvSubst
    empty_subst Type
    ty
      where
        empty_subst :: TCvSubst
    empty_subst = InScopeSet -> TCvSubst
    mkEmptyTCvSubst (VarSet -> InScopeSet
    mkInScopeSet (Type -> VarSet
    tyCoVarsOfType Type
    ty))

        go :: t -> TCvSubst -> Type -> TcM ([Type], Type)
    go t
    n TCvSubst
    subst Type
    kind
          | t
    n forall a. Ord a => a -> a -> Bool
    > t
    0
          , Just (TyBinder
    bndr, Type
    body) <- Type -> Maybe (TyBinder, Type)
    tcSplitPiTy_maybe Type
    kind
          , TyBinder -> Bool
    isInvisibleBinder TyBinder
    bndr
          = do { (TCvSubst
    subst', Type
    arg) <- TCvSubst -> TyBinder -> TcM (TCvSubst, Type)
    tcInstInvisibleTyBinder TCvSubst
    subst TyBinder
    bndr
               ; ([Type]
    args, Type
    inner_ty) <- t -> TCvSubst -> Type -> TcM ([Type], Type)
    go (t
    nforall a. Num a => a -> a -> a
    -t
    1) TCvSubst
    subst' Type
    body
               ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Type
    argforall a. a -> [a] -> [a]
    :[Type]
    args, Type
    inner_ty) }
          | Bool
    otherwise
          = forall (m :: * -> *) a. Monad m => a -> m a
    return ([], HasCallStack => TCvSubst -> Type -> Type
    substTy TCvSubst
    subst Type
    kind)

    -- | Used only in *types*
    tcInstInvisibleTyBinder :: TCvSubst -> TyBinder -> TcM (TCvSubst, TcType)
    tcInstInvisibleTyBinder :: TCvSubst -> TyBinder -> TcM (TCvSubst, Type)
    tcInstInvisibleTyBinder TCvSubst
    subst (Named (Bndr DFunId
    tv ArgFlag
    _))
      = do { (TCvSubst
    subst', DFunId
    tv') <- TCvSubst -> DFunId -> TcM (TCvSubst, DFunId)
    newMetaTyVarX TCvSubst
    subst DFunId
    tv
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (TCvSubst
    subst', DFunId -> Type
    mkTyVarTy DFunId
    tv') }

    tcInstInvisibleTyBinder TCvSubst
    subst (Anon AnonArgFlag
    af Scaled Type
    ty)
      | Just (Coercion -> TcM Type
    mk, Type
    k1, Type
    k2) <- Type -> Maybe (Coercion -> TcM Type, Type, Type)
    get_eq_tys_maybe (HasCallStack => TCvSubst -> Type -> Type
    substTy TCvSubst
    subst (forall a. Scaled a -> a
    scaledThing Scaled Type
    ty))
        -- Equality is the *only* constraint currently handled in types.
        -- See Note [Constraints in kinds] in GHC.Core.TyCo.Rep
      = ASSERT( af == InvisArg )
        do { Coercion
    co <- Maybe SDoc -> Type -> Type -> TcM Coercion
    unifyKind forall a. Maybe a
    Nothing Type
    k1 Type
    k2
           ; Type
    arg' <- Coercion -> TcM Type
    mk Coercion
    co
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (TCvSubst
    subst, Type
    arg') }

      | Bool
    otherwise  -- This should never happen
                   -- See GHC.Core.TyCo.Rep Note [Constraints in kinds]
      = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcInvisibleTyBinder" (forall a. Outputable a => a -> SDoc
    ppr Scaled Type
    ty)

    -------------------------------
    get_eq_tys_maybe :: Type
                     -> Maybe ( Coercion -> TcM Type
                                 -- given a coercion proving t1 ~# t2, produce the
                                 -- right instantiation for the TyBinder at hand
                              , Type  -- t1
                              , Type  -- t2
                              )
    -- See Note [Constraints in kinds] in GHC.Core.TyCo.Rep
    get_eq_tys_maybe :: Type -> Maybe (Coercion -> TcM Type, Type, Type)
    get_eq_tys_maybe Type
    ty
      -- Lifted heterogeneous equality (~~)
      | Just (TyCon
    tc, [Type
    _, Type
    _, Type
    k1, Type
    k2]) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    ty
      , TyCon
    tc forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    heqTyConKey
      = forall a. a -> Maybe a
    Just (\Coercion
    co -> Coercion -> Type -> Type -> TcM Type
    mkHEqBoxTy Coercion
    co Type
    k1 Type
    k2, Type
    k1, Type
    k2)

      -- Lifted homogeneous equality (~)
      | Just (TyCon
    tc, [Type
    _, Type
    k1, Type
    k2]) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    ty
      , TyCon
    tc forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    eqTyConKey
      = forall a. a -> Maybe a
    Just (\Coercion
    co -> Coercion -> Type -> Type -> TcM Type
    mkEqBoxTy Coercion
    co Type
    k1 Type
    k2, Type
    k1, Type
    k2)

      | Bool
    otherwise
      = forall a. Maybe a
    Nothing

    -- | This takes @a ~# b@ and returns @a ~~ b@.
    mkHEqBoxTy :: TcCoercion -> Type -> Type -> TcM Type
    -- monadic just for convenience with mkEqBoxTy
    mkHEqBoxTy :: Coercion -> Type -> Type -> TcM Type
    mkHEqBoxTy Coercion
    co Type
    ty1 Type
    ty2
      = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $
        TyCon -> [Type] -> Type
    mkTyConApp (DataCon -> TyCon
    promoteDataCon DataCon
    heqDataCon) [Type
    k1, Type
    k2, Type
    ty1, Type
    ty2, Coercion -> Type
    mkCoercionTy Coercion
    co]
      where k1 :: Type
    k1 = HasDebugCallStack => Type -> Type
    tcTypeKind Type
    ty1
            k2 :: Type
    k2 = HasDebugCallStack => Type -> Type
    tcTypeKind Type
    ty2

    -- | This takes @a ~# b@ and returns @a ~ b@.
    mkEqBoxTy :: TcCoercion -> Type -> Type -> TcM Type
    mkEqBoxTy :: Coercion -> Type -> Type -> TcM Type
    mkEqBoxTy Coercion
    co Type
    ty1 Type
    ty2
      = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $
        TyCon -> [Type] -> Type
    mkTyConApp (DataCon -> TyCon
    promoteDataCon DataCon
    eqDataCon) [Type
    k, Type
    ty1, Type
    ty2, Coercion -> Type
    mkCoercionTy Coercion
    co]
      where k :: Type
    k = HasDebugCallStack => Type -> Type
    tcTypeKind Type
    ty1

    {- *********************************************************************
    *                                                                      *
            SkolemTvs (immutable)
    *                                                                      *
    ********************************************************************* -}

    tcInstType :: ([TyVar] -> TcM (TCvSubst, [TcTyVar]))
                       -- ^ How to instantiate the type variables
               -> Id                                           -- ^ Type to instantiate
               -> TcM ([(Name, TcTyVar)], TcThetaType, TcType) -- ^ Result
                    -- (type vars, preds (incl equalities), rho)
    tcInstType :: ([DFunId] -> TcM (TCvSubst, [DFunId]))
    -> DFunId -> TcM ([(Name, DFunId)], [Type], Type)
    tcInstType [DFunId] -> TcM (TCvSubst, [DFunId])
    inst_tyvars DFunId
    id
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [DFunId]
    tyvars   -- There may be overloading despite no type variables;
                      --      (?x :: Int) => Int -> Int
      = forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [Type]
    theta, Type
    tau)
      | Bool
    otherwise
      = do { (TCvSubst
    subst, [DFunId]
    tyvars') <- [DFunId] -> TcM (TCvSubst, [DFunId])
    inst_tyvars [DFunId]
    tyvars
           ; let tv_prs :: [(Name, DFunId)]
    tv_prs  = forall a b. (a -> b) -> [a] -> [b]
    map DFunId -> Name
    tyVarName [DFunId]
    tyvars forall a b. [a] -> [b] -> [(a, b)]
    `zip` [DFunId]
    tyvars'
                 subst' :: TCvSubst
    subst'  = TCvSubst -> VarSet -> TCvSubst
    extendTCvInScopeSet TCvSubst
    subst (Type -> VarSet
    tyCoVarsOfType Type
    rho)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Name, DFunId)]
    tv_prs, HasCallStack => TCvSubst -> [Type] -> [Type]
    substTheta TCvSubst
    subst' [Type]
    theta, HasCallStack => TCvSubst -> Type -> Type
    substTy TCvSubst
    subst' Type
    tau) }
      where
        ([DFunId]
    tyvars, Type
    rho) = Type -> ([DFunId], Type)
    tcSplitForAllInvisTyVars (DFunId -> Type
    idType DFunId
    id)
        ([Type]
    theta, Type
    tau)  = Type -> ([Type], Type)
    tcSplitPhiTy Type
    rho

    tcInstTypeBndrs :: Id -> TcM ([(Name, InvisTVBinder)], TcThetaType, TcType)
                         -- (type vars, preds (incl equalities), rho)
    -- Instantiate the binders of a type signature with TyVarTvs
    tcInstTypeBndrs :: DFunId -> TcM ([(Name, InvisTVBinder)], [Type], Type)
    tcInstTypeBndrs DFunId
    id
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [InvisTVBinder]
    tyvars   -- There may be overloading despite no type variables;
                      --      (?x :: Int) => Int -> Int
      = forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [Type]
    theta, Type
    tau)
      | Bool
    otherwise
      = do { (TCvSubst
    subst, [InvisTVBinder]
    tyvars') <- forall (m :: * -> *) acc x y.
    Monad m =>
    (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
    mapAccumLM TCvSubst -> InvisTVBinder -> TcM (TCvSubst, InvisTVBinder)
    inst_invis_bndr TCvSubst
    emptyTCvSubst [InvisTVBinder]
    tyvars
           ; let tv_prs :: [(Name, InvisTVBinder)]
    tv_prs  = forall a b. (a -> b) -> [a] -> [b]
    map (DFunId -> Name
    tyVarName forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall tv argf. VarBndr tv argf -> tv
    binderVar) [InvisTVBinder]
    tyvars forall a b. [a] -> [b] -> [(a, b)]
    `zip` [InvisTVBinder]
    tyvars'
                 subst' :: TCvSubst
    subst'  = TCvSubst -> VarSet -> TCvSubst
    extendTCvInScopeSet TCvSubst
    subst (Type -> VarSet
    tyCoVarsOfType Type
    rho)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return ([(Name, InvisTVBinder)]
    tv_prs, HasCallStack => TCvSubst -> [Type] -> [Type]
    substTheta TCvSubst
    subst' [Type]
    theta, HasCallStack => TCvSubst -> Type -> Type
    substTy TCvSubst
    subst' Type
    tau) }
      where
        ([InvisTVBinder]
    tyvars, Type
    rho) = Type -> ([InvisTVBinder], Type)
    splitForAllInvisTVBinders (DFunId -> Type
    idType DFunId
    id)
        ([Type]
    theta, Type
    tau)  = Type -> ([Type], Type)
    tcSplitPhiTy Type
    rho

        inst_invis_bndr :: TCvSubst -> InvisTVBinder
                        -> TcM (TCvSubst, InvisTVBinder)
        inst_invis_bndr :: TCvSubst -> InvisTVBinder -> TcM (TCvSubst, InvisTVBinder)
    inst_invis_bndr TCvSubst
    subst (Bndr DFunId
    tv Specificity
    spec)
          = do { (TCvSubst
    subst', DFunId
    tv') <- TCvSubst -> DFunId -> TcM (TCvSubst, DFunId)
    newMetaTyVarTyVarX TCvSubst
    subst DFunId
    tv
               ; forall (m :: * -> *) a. Monad m => a -> m a
    return (TCvSubst
    subst', forall var argf. var -> argf -> VarBndr var argf
    Bndr DFunId
    tv' Specificity
    spec) }

    tcSkolDFunType :: DFunId -> TcM ([TcTyVar], TcThetaType, TcType)
    -- Instantiate a type signature with skolem constants.
    -- This freshens the names, but no need to do so
    tcSkolDFunType :: DFunId -> TcM ([DFunId], [Type], Type)
    tcSkolDFunType DFunId
    dfun
      = do { ([(Name, DFunId)]
    tv_prs, [Type]
    theta, Type
    tau) <- ([DFunId] -> TcM (TCvSubst, [DFunId]))
    -> DFunId -> TcM ([(Name, DFunId)], [Type], Type)
    tcInstType [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSuperSkolTyVars DFunId
    dfun
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> b
    snd [(Name, DFunId)]
    tv_prs, [Type]
    theta, Type
    tau) }

    tcSuperSkolTyVars :: [TyVar] -> (TCvSubst, [TcTyVar])
    -- Make skolem constants, but do *not* give them new names, as above
    -- Moreover, make them "super skolems"; see comments with superSkolemTv
    -- see Note [Kind substitution when instantiating]
    -- Precondition: tyvars should be ordered by scoping
    tcSuperSkolTyVars :: [DFunId] -> (TCvSubst, [DFunId])
    tcSuperSkolTyVars = forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL TCvSubst -> DFunId -> (TCvSubst, DFunId)
    tcSuperSkolTyVar TCvSubst
    emptyTCvSubst

    tcSuperSkolTyVar :: TCvSubst -> TyVar -> (TCvSubst, TcTyVar)
    tcSuperSkolTyVar :: TCvSubst -> DFunId -> (TCvSubst, DFunId)
    tcSuperSkolTyVar TCvSubst
    subst DFunId
    tv
      = (TCvSubst -> DFunId -> DFunId -> TCvSubst
    extendTvSubstWithClone TCvSubst
    subst DFunId
    tv DFunId
    new_tv, DFunId
    new_tv)
      where
        kind :: Type
    kind   = TCvSubst -> Type -> Type
    substTyUnchecked TCvSubst
    subst (DFunId -> Type
    tyVarKind DFunId
    tv)
        new_tv :: DFunId
    new_tv = Name -> Type -> TcTyVarDetails -> DFunId
    mkTcTyVar (DFunId -> Name
    tyVarName DFunId
    tv) Type
    kind TcTyVarDetails
    superSkolemTv

    -- | Given a list of @['TyVar']@, skolemize the type variables,
    -- returning a substitution mapping the original tyvars to the
    -- skolems, and the list of newly bound skolems.
    tcInstSkolTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
    -- See Note [Skolemising type variables]
    tcInstSkolTyVars :: [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSkolTyVars = TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSkolTyVarsX TCvSubst
    emptyTCvSubst

    tcInstSkolTyVarsX :: TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])
    -- See Note [Skolemising type variables]
    tcInstSkolTyVarsX :: TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSkolTyVarsX = Bool -> TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSkolTyVarsPushLevel Bool
    False

    tcInstSuperSkolTyVars :: [TyVar] -> TcM (TCvSubst, [TcTyVar])
    -- See Note [Skolemising type variables]
    -- This version freshens the names and creates "super skolems";
    -- see comments around superSkolemTv.
    tcInstSuperSkolTyVars :: [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSuperSkolTyVars = TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSuperSkolTyVarsX TCvSubst
    emptyTCvSubst

    tcInstSuperSkolTyVarsX :: TCvSubst -> [TyVar] -> TcM (TCvSubst, [TcTyVar])
    -- See Note [Skolemising type variables]
    -- This version freshens the names and creates "super skolems";
    -- see comments around superSkolemTv.
    tcInstSuperSkolTyVarsX :: TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSuperSkolTyVarsX TCvSubst
    subst = Bool -> TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSkolTyVarsPushLevel Bool
    True TCvSubst
    subst

    tcInstSkolTyVarsPushLevel :: Bool  -- True <=> make "super skolem"
                              -> TCvSubst -> [TyVar]
                              -> TcM (TCvSubst, [TcTyVar])
    -- Skolemise one level deeper, hence pushTcLevel
    -- See Note [Skolemising type variables]
    tcInstSkolTyVarsPushLevel :: Bool -> TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSkolTyVarsPushLevel Bool
    overlappable TCvSubst
    subst [DFunId]
    tvs
      = do { TcLevel
    tc_lvl <- TcM TcLevel
    getTcLevel
           -- Do not retain the whole TcLclEnv
           ; let !pushed_lvl :: TcLevel
    pushed_lvl = TcLevel -> TcLevel
    pushTcLevel TcLevel
    tc_lvl
           ; TcLevel -> Bool -> TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSkolTyVarsAt TcLevel
    pushed_lvl Bool
    overlappable TCvSubst
    subst [DFunId]
    tvs }

    tcInstSkolTyVarsAt :: TcLevel -> Bool
                       -> TCvSubst -> [TyVar]
                       -> TcM (TCvSubst, [TcTyVar])
    tcInstSkolTyVarsAt :: TcLevel -> Bool -> TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    tcInstSkolTyVarsAt TcLevel
    lvl Bool
    overlappable TCvSubst
    subst [DFunId]
    tvs
      = (Name -> Type -> DFunId)
    -> TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    freshenTyCoVarsX Name -> Type -> DFunId
    new_skol_tv TCvSubst
    subst [DFunId]
    tvs
      where
        details :: TcTyVarDetails
    details = TcLevel -> Bool -> TcTyVarDetails
    SkolemTv TcLevel
    lvl Bool
    overlappable
        new_skol_tv :: Name -> Type -> DFunId
    new_skol_tv Name
    name Type
    kind = Name -> Type -> TcTyVarDetails -> DFunId
    mkTcTyVar Name
    name Type
    kind TcTyVarDetails
    details

    ------------------
    freshenTyVarBndrs :: [TyVar] -> TcM (TCvSubst, [TyVar])
    -- ^ Give fresh uniques to a bunch of TyVars, but they stay
    --   as TyVars, rather than becoming TcTyVars
    -- Used in 'GHC.Tc.Instance.Family.newFamInst', and 'GHC.Tc.Utils.Instantiate.newClsInst'
    freshenTyVarBndrs :: [DFunId] -> TcM (TCvSubst, [DFunId])
    freshenTyVarBndrs = (Name -> Type -> DFunId) -> [DFunId] -> TcM (TCvSubst, [DFunId])
    freshenTyCoVars Name -> Type -> DFunId
    mkTyVar

    freshenCoVarBndrsX :: TCvSubst -> [CoVar] -> TcM (TCvSubst, [CoVar])
    -- ^ Give fresh uniques to a bunch of CoVars
    -- Used in "GHC.Tc.Instance.Family.newFamInst"
    freshenCoVarBndrsX :: TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    freshenCoVarBndrsX TCvSubst
    subst = (Name -> Type -> DFunId)
    -> TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    freshenTyCoVarsX Name -> Type -> DFunId
    mkCoVar TCvSubst
    subst

    ------------------
    freshenTyCoVars :: (Name -> Kind -> TyCoVar)
                    -> [TyVar] -> TcM (TCvSubst, [TyCoVar])
    freshenTyCoVars :: (Name -> Type -> DFunId) -> [DFunId] -> TcM (TCvSubst, [DFunId])
    freshenTyCoVars Name -> Type -> DFunId
    mk_tcv = (Name -> Type -> DFunId)
    -> TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    freshenTyCoVarsX Name -> Type -> DFunId
    mk_tcv TCvSubst
    emptyTCvSubst

    freshenTyCoVarsX :: (Name -> Kind -> TyCoVar)
                     -> TCvSubst -> [TyCoVar]
                     -> TcM (TCvSubst, [TyCoVar])
    freshenTyCoVarsX :: (Name -> Type -> DFunId)
    -> TCvSubst -> [DFunId] -> TcM (TCvSubst, [DFunId])
    freshenTyCoVarsX Name -> Type -> DFunId
    mk_tcv = forall (m :: * -> *) acc x y.
    Monad m =>
    (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
    mapAccumLM ((Name -> Type -> DFunId)
    -> TCvSubst -> DFunId -> TcM (TCvSubst, DFunId)
    freshenTyCoVarX Name -> Type -> DFunId
    mk_tcv)

    freshenTyCoVarX :: (Name -> Kind -> TyCoVar)
                    -> TCvSubst -> TyCoVar -> TcM (TCvSubst, TyCoVar)
    -- This a complete freshening operation:
    -- the skolems have a fresh unique, and a location from the monad
    -- See Note [Skolemising type variables]
    freshenTyCoVarX :: (Name -> Type -> DFunId)
    -> TCvSubst -> DFunId -> TcM (TCvSubst, DFunId)
    freshenTyCoVarX Name -> Type -> DFunId
    mk_tcv TCvSubst
    subst DFunId
    tycovar
      = do { SrcSpan
    loc  <- TcRn SrcSpan
    getSrcSpanM
           ; Unique
    uniq <- forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
           ; let old_name :: Name
    old_name = DFunId -> Name
    tyVarName DFunId
    tycovar
                 new_name :: Name
    new_name = Unique -> OccName -> SrcSpan -> Name
    mkInternalName Unique
    uniq (forall a. NamedThing a => a -> OccName
    getOccName Name
    old_name) SrcSpan
    loc
                 new_kind :: Type
    new_kind = TCvSubst -> Type -> Type
    substTyUnchecked TCvSubst
    subst (DFunId -> Type
    tyVarKind DFunId
    tycovar)
                 new_tcv :: DFunId
    new_tcv  = Name -> Type -> DFunId
    mk_tcv Name
    new_name Type
    new_kind
                 subst1 :: TCvSubst
    subst1   = TCvSubst -> DFunId -> DFunId -> TCvSubst
    extendTCvSubstWithClone TCvSubst
    subst DFunId
    tycovar DFunId
    new_tcv
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (TCvSubst
    subst1, DFunId
    new_tcv) }

    {- Note [Skolemising type variables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The tcInstSkolTyVars family of functions instantiate a list of TyVars
    to fresh skolem TcTyVars. Important notes:

    a) Level allocation. We generally skolemise /before/ calling
       pushLevelAndCaptureConstraints.  So we want their level to the level
       of the soon-to-be-created implication, which has a level ONE HIGHER
       than the current level.  Hence the pushTcLevel.  It feels like a
       slight hack.

    b) The [TyVar] should be ordered (kind vars first)
       See Note [Kind substitution when instantiating]

    c) Clone the variable to give a fresh unique.  This is essential.
       Consider (tc160)
           type Foo x = forall a. a -> x
       And typecheck the expression
           (e :: Foo (Foo ())
       We will skolemise the signature, but after expanding synonyms it
       looks like
            forall a. a -> forall a. a -> x
       We don't want to make two big-lambdas with the same unique!

    d) We retain locations. Because the location of the variable is the correct
       location to report in errors (e.g. in the signature). We don't want the
       location to change to the body of the function, which does *not* explicitly
       bind the variable.

    e) The resulting skolems are
            non-overlappable for tcInstSkolTyVars,
       but overlappable for tcInstSuperSkolTyVars
       See GHC.Tc.Deriv.Infer Note [Overlap and deriving] for an example
       of where this matters.

    Note [Kind substitution when instantiating]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When we instantiate a bunch of kind and type variables, first we
    expect them to be topologically sorted.
    Then we have to instantiate the kind variables, build a substitution
    from old variables to the new variables, then instantiate the type
    variables substituting the original kind.

    Exemple: If we want to instantiate
      [(k1 :: *), (k2 :: *), (a :: k1 -> k2), (b :: k1)]
    we want
      [(?k1 :: *), (?k2 :: *), (?a :: ?k1 -> ?k2), (?b :: ?k1)]
    instead of the bogus
      [(?k1 :: *), (?k2 :: *), (?a :: k1 -> k2), (?b :: k1)]
    -}

    {- *********************************************************************
    *                                                                      *
                    Literals
    *                                                                      *
    ********************************************************************* -}

    {-
    In newOverloadedLit we convert directly to an Int or Integer if we
    know that's what we want.  This may save some time, by not
    temporarily generating overloaded literals, but it won't catch all
    cases (the rest are caught in lookupInst).

    -}

    newOverloadedLit :: HsOverLit GhcRn
                     -> ExpRhoType
                     -> TcM (HsOverLit GhcTc)
    newOverloadedLit :: HsOverLit GhcRn -> ExpRhoType -> TcM (HsOverLit GhcTc)
    newOverloadedLit HsOverLit GhcRn
    lit ExpRhoType
    res_ty
      = do { Maybe (HsOverLit GhcTc)
    mb_lit' <- HsOverLit GhcRn -> ExpRhoType -> TcM (Maybe (HsOverLit GhcTc))
    tcShortCutLit HsOverLit GhcRn
    lit ExpRhoType
    res_ty
           ; case Maybe (HsOverLit GhcTc)
    mb_lit' of
                Just HsOverLit GhcTc
    lit' -> forall (m :: * -> *) a. Monad m => a -> m a
    return HsOverLit GhcTc
    lit'
                Maybe (HsOverLit GhcTc)
    Nothing   -> HsOverLit GhcRn -> ExpRhoType -> TcM (HsOverLit GhcTc)
    newNonTrivialOverloadedLit HsOverLit GhcRn
    lit ExpRhoType
    res_ty }

    -- Does not handle things that 'shortCutLit' can handle. See also
    -- newOverloadedLit in GHC.Tc.Utils.Unify
    newNonTrivialOverloadedLit :: HsOverLit GhcRn
                               -> ExpRhoType
                               -> TcM (HsOverLit GhcTc)
    newNonTrivialOverloadedLit :: HsOverLit GhcRn -> ExpRhoType -> TcM (HsOverLit GhcTc)
    newNonTrivialOverloadedLit
      lit :: HsOverLit GhcRn
    lit@(OverLit { ol_val :: forall p. HsOverLit p -> OverLitVal
    ol_val = OverLitVal
    val, ol_witness :: forall p. HsOverLit p -> HsExpr p
    ol_witness = HsVar XVar GhcRn
    _ (L SrcSpanAnnN
    _ Name
    meth_name)
                   , ol_ext :: forall p. HsOverLit p -> XOverLit p
    ol_ext = XOverLit GhcRn
    rebindable }) ExpRhoType
    res_ty
      = do  { HsLit GhcTc
    hs_lit <- OverLitVal -> TcM (HsLit GhcTc)
    mkOverLit OverLitVal
    val
            ; let lit_ty :: Type
    lit_ty = forall (p :: Pass). HsLit (GhcPass p) -> Type
    hsLitType HsLit GhcTc
    hs_lit
            ; (()
    _, SyntaxExprTc
    fi') <- forall a.
    CtOrigin
    -> SyntaxExprRn
    -> [SyntaxOpType]
    -> ExpRhoType
    -> ([Type] -> [Type] -> TcM a)
    -> TcM (a, SyntaxExprTc)
    tcSyntaxOp CtOrigin
    orig (Name -> SyntaxExprRn
    mkRnSyntaxExpr Name
    meth_name)
                                          [Type -> SyntaxOpType
    synKnownType Type
    lit_ty] ExpRhoType
    res_ty forall a b. (a -> b) -> a -> b
    $
                          \[Type]
    _ [Type]
    _ -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            ; let L SrcSpanAnnA
    _ HsExpr GhcTc
    witness = SyntaxExprTc -> [LHsExpr GhcTc] -> LHsExpr GhcTc
    nlHsSyntaxApps SyntaxExprTc
    fi' [forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
    nlHsLit HsLit GhcTc
    hs_lit]
            ; Type
    res_ty <- ExpRhoType -> TcM Type
    readExpType ExpRhoType
    res_ty
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (HsOverLit GhcRn
    lit { ol_witness :: HsExpr GhcTc
    ol_witness = HsExpr GhcTc
    witness
                          , ol_ext :: XOverLit GhcTc
    ol_ext = Bool -> Type -> OverLitTc
    OverLitTc XOverLit GhcRn
    rebindable Type
    res_ty }) }
      where
        orig :: CtOrigin
    orig = HsOverLit GhcRn -> CtOrigin
    LiteralOrigin HsOverLit GhcRn
    lit

    newNonTrivialOverloadedLit HsOverLit GhcRn
    lit ExpRhoType
    _
      = forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "newNonTrivialOverloadedLit" (forall a. Outputable a => a -> SDoc
    ppr HsOverLit GhcRn
    lit)

    ------------
    mkOverLit ::OverLitVal -> TcM (HsLit GhcTc)
    mkOverLit :: OverLitVal -> TcM (HsLit GhcTc)
    mkOverLit (HsIntegral IntegralLit
    i)
      = do  { Type
    integer_ty <- Name -> TcM Type
    tcMetaTy Name
    integerTyConName
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall x. XHsInteger x -> Integer -> Type -> HsLit x
    HsInteger (IntegralLit -> SourceText
    il_text IntegralLit
    i)
                                (IntegralLit -> Integer
    il_value IntegralLit
    i) Type
    integer_ty) }

    mkOverLit (HsFractional FractionalLit
    r)
      = do  { Type
    rat_ty <- Name -> TcM Type
    tcMetaTy Name
    rationalTyConName
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (forall x. XHsRat x -> FractionalLit -> Type -> HsLit x
    HsRat NoExtField
    noExtField FractionalLit
    r Type
    rat_ty) }

    mkOverLit (HsIsString SourceText
    src FastString
    s) = forall (m :: * -> *) a. Monad m => a -> m a
    return (forall x. XHsString x -> FastString -> HsLit x
    HsString SourceText
    src FastString
    s)

    {-
    ************************************************************************
    *                                                                      *
                    Re-mappable syntax

         Used only for arrow syntax -- find a way to nuke this
    *                                                                      *
    ************************************************************************

    Suppose we are doing the -XRebindableSyntax thing, and we encounter
    a do-expression.  We have to find (>>) in the current environment, which is
    done by the rename. Then we have to check that it has the same type as
    Control.Monad.(>>).  Or, more precisely, a compatible type. One 'customer' had
    this:

      (>>) :: HB m n mn => m a -> n b -> mn b

    So the idea is to generate a local binding for (>>), thus:

            let then72 :: forall a b. m a -> m b -> m b
                then72 = ...something involving the user's (>>)...
            in
            ...the do-expression...

    Now the do-expression can proceed using then72, which has exactly
    the expected type.

    In fact tcSyntaxName just generates the RHS for then72, because we only
    want an actual binding in the do-expression case. For literals, we can
    just use the expression inline.
    -}

    tcSyntaxName :: CtOrigin
                 -> TcType                 -- ^ Type to instantiate it at
                 -> (Name, HsExpr GhcRn)   -- ^ (Standard name, user name)
                 -> TcM (Name, HsExpr GhcTc)
                                           -- ^ (Standard name, suitable expression)
    -- USED ONLY FOR CmdTop (sigh) ***
    -- See Note [CmdSyntaxTable] in "GHC.Hs.Expr"

    tcSyntaxName :: CtOrigin
    -> Type -> (Name, HsExpr GhcRn) -> TcM (Name, HsExpr GhcTc)
    tcSyntaxName CtOrigin
    orig Type
    ty (Name
    std_nm, HsVar XVar GhcRn
    _ (L SrcSpanAnnN
    _ Name
    user_nm))
      | Name
    std_nm forall a. Eq a => a -> a -> Bool
    == Name
    user_nm
      = do HsExpr GhcTc
    rhs <- CtOrigin -> Name -> [Type] -> TcM (HsExpr GhcTc)
    newMethodFromName CtOrigin
    orig Name
    std_nm [Type
    ty]
           forall (m :: * -> *) a. Monad m => a -> m a
    return (Name
    std_nm, HsExpr GhcTc
    rhs)

    tcSyntaxName CtOrigin
    orig Type
    ty (Name
    std_nm, HsExpr GhcRn
    user_nm_expr) = do
        DFunId
    std_id <- Name -> TcM DFunId
    tcLookupId Name
    std_nm
        let
            -- C.f. newMethodAtLoc
            ([DFunId
    tv], [Type]
    _, Type
    tau) = Type -> ([DFunId], [Type], Type)
    tcSplitSigmaTy (DFunId -> Type
    idType DFunId
    std_id)
            sigma1 :: Type
    sigma1         = HasCallStack => [DFunId] -> [Type] -> Type -> Type
    substTyWith [DFunId
    tv] [Type
    ty] Type
    tau
            -- Actually, the "tau-type" might be a sigma-type in the
            -- case of locally-polymorphic methods.

        forall a. (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    addErrCtxtM (HsExpr GhcRn -> CtOrigin -> Type -> TidyEnv -> TcM (TidyEnv, SDoc)
    syntaxNameCtxt HsExpr GhcRn
    user_nm_expr CtOrigin
    orig Type
    sigma1) forall a b. (a -> b) -> a -> b
    $ do

            -- Check that the user-supplied thing has the
            -- same type as the standard one.
            -- Tiresome jiggling because tcCheckSigma takes a located expression
         SrcSpan
    span <- TcRn SrcSpan
    getSrcSpanM
         GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr <- LHsExpr GhcRn -> Type -> TcM (LHsExpr GhcTc)
    tcCheckPolyExpr (forall l e. l -> e -> GenLocated l e
    L (forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan SrcSpan
    span) HsExpr GhcRn
    user_nm_expr) Type
    sigma1
         forall (m :: * -> *) a. Monad m => a -> m a
    return (Name
    std_nm, forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpanAnnA (HsExpr GhcTc)
    expr)

    syntaxNameCtxt :: HsExpr GhcRn -> CtOrigin -> Type -> TidyEnv
                   -> TcRn (TidyEnv, SDoc)
    syntaxNameCtxt :: HsExpr GhcRn -> CtOrigin -> Type -> TidyEnv -> TcM (TidyEnv, SDoc)
    syntaxNameCtxt HsExpr GhcRn
    name CtOrigin
    orig Type
    ty TidyEnv
    tidy_env
      = do { CtLoc
    inst_loc <- CtOrigin -> Maybe TypeOrKind -> TcM CtLoc
    getCtLocM CtOrigin
    orig (forall a. a -> Maybe a
    Just TypeOrKind
    TypeLevel)
           ; let msg :: SDoc
    msg = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "When checking that" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcRn
    name)
                              SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "(needed by a syntactic construct)"
                            , Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "has the required type:"
                                      SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr (TidyEnv -> Type -> Type
    tidyType TidyEnv
    tidy_env Type
    ty))
                            , Int -> SDoc -> SDoc
    nest Int
    2 (CtLoc -> SDoc
    pprCtLoc CtLoc
    inst_loc) ]
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (TidyEnv
    tidy_env, SDoc
    msg) }

    {-
    ************************************************************************
    *                                                                      *
                    Instances
    *                                                                      *
    ************************************************************************
    -}

    getOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag
    -- Construct the OverlapFlag from the global module flags,
    -- but if the overlap_mode argument is (Just m),
    --     set the OverlapMode to 'm'
    getOverlapFlag :: Maybe OverlapMode -> TcM OverlapFlag
    getOverlapFlag Maybe OverlapMode
    overlap_mode
      = do  { DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            ; let overlap_ok :: Bool
    overlap_ok    = Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.OverlappingInstances DynFlags
    dflags
                  incoherent_ok :: Bool
    incoherent_ok = Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.IncoherentInstances  DynFlags
    dflags
                  use :: OverlapMode -> OverlapFlag
    use OverlapMode
    x = OverlapFlag { isSafeOverlap :: Bool
    isSafeOverlap = DynFlags -> Bool
    safeLanguageOn DynFlags
    dflags
                                      , overlapMode :: OverlapMode
    overlapMode   = OverlapMode
    x }
                  default_oflag :: OverlapFlag
    default_oflag | Bool
    incoherent_ok = OverlapMode -> OverlapFlag
    use (SourceText -> OverlapMode
    Incoherent SourceText
    NoSourceText)
                                | Bool
    overlap_ok    = OverlapMode -> OverlapFlag
    use (SourceText -> OverlapMode
    Overlaps SourceText
    NoSourceText)
                                | Bool
    otherwise     = OverlapMode -> OverlapFlag
    use (SourceText -> OverlapMode
    NoOverlap SourceText
    NoSourceText)

                  final_oflag :: OverlapFlag
    final_oflag = OverlapFlag -> Maybe OverlapMode -> OverlapFlag
    setOverlapModeMaybe OverlapFlag
    default_oflag Maybe OverlapMode
    overlap_mode
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return OverlapFlag
    final_oflag }

    tcGetInsts :: TcM [ClsInst]
    -- Gets the local class instances.
    tcGetInsts :: TcM [ClsInst]
    tcGetInsts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TcGblEnv -> [ClsInst]
    tcg_insts forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv

    newClsInst :: Maybe OverlapMode -> Name -> [TyVar] -> ThetaType
               -> Class -> [Type] -> TcM ClsInst
    newClsInst :: Maybe OverlapMode
    -> Name -> [DFunId] -> [Type] -> Class -> [Type] -> TcM ClsInst
    newClsInst Maybe OverlapMode
    overlap_mode Name
    dfun_name [DFunId]
    tvs [Type]
    theta Class
    clas [Type]
    tys
      = do { (TCvSubst
    subst, [DFunId]
    tvs') <- [DFunId] -> TcM (TCvSubst, [DFunId])
    freshenTyVarBndrs [DFunId]
    tvs
                 -- Be sure to freshen those type variables,
                 -- so they are sure not to appear in any lookup
           ; let tys' :: [Type]
    tys' = HasCallStack => TCvSubst -> [Type] -> [Type]
    substTys TCvSubst
    subst [Type]
    tys

                 dfun :: DFunId
    dfun = Name -> [DFunId] -> [Type] -> Class -> [Type] -> DFunId
    mkDictFunId Name
    dfun_name [DFunId]
    tvs [Type]
    theta Class
    clas [Type]
    tys
                 -- The dfun uses the original 'tvs' because
                 -- (a) they don't need to be fresh
                 -- (b) they may be mentioned in the ib_binds field of
                 --     an InstInfo, and in GHC.Tc.Utils.Env.pprInstInfoDetails it's
                 --     helpful to use the same names

           ; OverlapFlag
    oflag <- Maybe OverlapMode -> TcM OverlapFlag
    getOverlapFlag Maybe OverlapMode
    overlap_mode
           ; let inst :: ClsInst
    inst = DFunId -> OverlapFlag -> [DFunId] -> Class -> [Type] -> ClsInst
    mkLocalInstance DFunId
    dfun OverlapFlag
    oflag [DFunId]
    tvs' Class
    clas [Type]
    tys'
           ; WarningFlag -> Bool -> SDoc -> TcRn ()
    warnIfFlag WarningFlag
    Opt_WarnOrphans
                        (IsOrphan -> Bool
    isOrphan (ClsInst -> IsOrphan
    is_orphan ClsInst
    inst))
                        (ClsInst -> SDoc
    instOrphWarn ClsInst
    inst)
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return ClsInst
    inst }

    instOrphWarn :: ClsInst -> SDoc
    instOrphWarn :: ClsInst -> SDoc
    instOrphWarn ClsInst
    inst
      = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Orphan instance:") Int
    2 (ClsInst -> SDoc
    pprInstanceHdr ClsInst
    inst)
        SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "To avoid this"
        SDoc -> SDoc -> SDoc
    $$ Int -> SDoc -> SDoc
    nest Int
    4 ([SDoc] -> SDoc
    vcat [SDoc]
    possibilities)
      where
        possibilities :: [SDoc]
    possibilities =
          String -> SDoc
    text String
    "move the instance declaration to the module of the class or of the type, or" forall a. a -> [a] -> [a]
    :
          String -> SDoc
    text String
    "wrap the type with a newtype and declare the instance on the new type." forall a. a -> [a] -> [a]
    :
          []

    tcExtendLocalInstEnv :: [ClsInst] -> TcM a -> TcM a
      -- Add new locally-defined instances
    tcExtendLocalInstEnv :: forall a. [ClsInst] -> TcM a -> TcM a
    tcExtendLocalInstEnv [ClsInst]
    dfuns TcM a
    thing_inside
     = do { [ClsInst] -> TcRn ()
    traceDFuns [ClsInst]
    dfuns
          ; TcGblEnv
    env <- forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
          ; (InstEnv
    inst_env', [ClsInst]
    cls_insts') <- forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldlM (InstEnv, [ClsInst]) -> ClsInst -> TcM (InstEnv, [ClsInst])
    addLocalInst
                                              (TcGblEnv -> InstEnv
    tcg_inst_env TcGblEnv
    env, TcGblEnv -> [ClsInst]
    tcg_insts TcGblEnv
    env)
                                              [ClsInst]
    dfuns
          ; let env' :: TcGblEnv
    env' = TcGblEnv
    env { tcg_insts :: [ClsInst]
    tcg_insts    = [ClsInst]
    cls_insts'
                           , tcg_inst_env :: InstEnv
    tcg_inst_env = InstEnv
    inst_env' }
          ; forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    env' TcM a
    thing_inside }

    addLocalInst :: (InstEnv, [ClsInst]) -> ClsInst -> TcM (InstEnv, [ClsInst])
    -- Check that the proposed new instance is OK,
    -- and then add it to the home inst env
    -- If overwrite_inst, then we can overwrite a direct match
    addLocalInst :: (InstEnv, [ClsInst]) -> ClsInst -> TcM (InstEnv, [ClsInst])
    addLocalInst (InstEnv
    home_ie, [ClsInst]
    my_insts) ClsInst
    ispec
       = do {
                 -- Load imported instances, so that we report
                 -- duplicates correctly

                 -- 'matches'  are existing instance declarations that are less
                 --            specific than the new one
                 -- 'dups'     are those 'matches' that are equal to the new one
             ; Bool
    isGHCi <- TcRn Bool
    getIsGHCi
             ; ExternalPackageState
    eps    <- forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
    getEps
             ; TcGblEnv
    tcg_env <- forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv

               -- In GHCi, we *override* any identical instances
               -- that are also defined in the interactive context
               -- See Note [Override identical instances in GHCi]
             ; let home_ie' :: InstEnv
    home_ie'
                     | Bool
    isGHCi    = InstEnv -> ClsInst -> InstEnv
    deleteFromInstEnv InstEnv
    home_ie ClsInst
    ispec
                     | Bool
    otherwise = InstEnv
    home_ie

                   global_ie :: InstEnv
    global_ie = ExternalPackageState -> InstEnv
    eps_inst_env ExternalPackageState
    eps
                   inst_envs :: InstEnvs
    inst_envs = InstEnvs { ie_global :: InstEnv
    ie_global  = InstEnv
    global_ie
                                        , ie_local :: InstEnv
    ie_local   = InstEnv
    home_ie'
                                        , ie_visible :: VisibleOrphanModules
    ie_visible = TcGblEnv -> VisibleOrphanModules
    tcVisibleOrphanMods TcGblEnv
    tcg_env }

                 -- Check for inconsistent functional dependencies
             ; let inconsistent_ispecs :: [ClsInst]
    inconsistent_ispecs = InstEnvs -> ClsInst -> [ClsInst]
    checkFunDeps InstEnvs
    inst_envs ClsInst
    ispec
             ; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    inconsistent_ispecs) forall a b. (a -> b) -> a -> b
    $
               ClsInst -> [ClsInst] -> TcRn ()
    funDepErr ClsInst
    ispec [ClsInst]
    inconsistent_ispecs

                 -- Check for duplicate instance decls.
             ; let ([DFunId]
    _tvs, Class
    cls, [Type]
    tys) = ClsInst -> ([DFunId], Class, [Type])
    instanceHead ClsInst
    ispec
                   ([InstMatch]
    matches, [ClsInst]
    _, [InstMatch]
    _)  = Bool
    -> InstEnvs
    -> Class
    -> [Type]
    -> ([InstMatch], [ClsInst], [InstMatch])
    lookupInstEnv Bool
    False InstEnvs
    inst_envs Class
    cls [Type]
    tys
                   dups :: [ClsInst]
    dups             = forall a. (a -> Bool) -> [a] -> [a]
    filter (ClsInst -> ClsInst -> Bool
    identicalClsInstHead ClsInst
    ispec) (forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> a
    fst [InstMatch]
    matches)
             ; forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    dups) forall a b. (a -> b) -> a -> b
    $
               ClsInst -> ClsInst -> TcRn ()
    dupInstErr ClsInst
    ispec (forall a. [a] -> a
    head [ClsInst]
    dups)

             ; forall (m :: * -> *) a. Monad m => a -> m a
    return (InstEnv -> ClsInst -> InstEnv
    extendInstEnv InstEnv
    home_ie' ClsInst
    ispec, ClsInst
    ispec forall a. a -> [a] -> [a]
    : [ClsInst]
    my_insts) }

    {-
    Note [Signature files and type class instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Instances in signature files do not have an effect when compiling:
    when you compile a signature against an implementation, you will
    see the instances WHETHER OR NOT the instance is declared in
    the file (this is because the signatures go in the EPS and we
    can't filter them out easily.)  This is also why we cannot
    place the instance in the hi file: it would show up as a duplicate,
    and we don't have instance reexports anyway.

    However, you might find them useful when typechecking against
    a signature: the instance is a way of indicating to GHC that
    some instance exists, in case downstream code uses it.

    Implementing this is a little tricky.  Consider the following
    situation (sigof03):

     module A where
         instance C T where ...

     module ASig where
         instance C T

    When compiling ASig, A.hi is loaded, which brings its instances
    into the EPS.  When we process the instance declaration in ASig,
    we should ignore it for the purpose of doing a duplicate check,
    since it's not actually a duplicate. But don't skip the check
    entirely, we still want this to fail (tcfail221):

     module ASig where
         instance C T
         instance C T

    Note that in some situations, the interface containing the type
    class instances may not have been loaded yet at all.  The usual
    situation when A imports another module which provides the
    instances (sigof02m):

     module A(module B) where
         import B

    See also Note [Signature lazy interface loading].  We can't
    rely on this, however, since sometimes we'll have spurious
    type class instances in the EPS, see #9422 (sigof02dm)

    ************************************************************************
    *                                                                      *
            Errors and tracing
    *                                                                      *
    ************************************************************************
    -}

    traceDFuns :: [ClsInst] -> TcRn ()
    traceDFuns :: [ClsInst] -> TcRn ()
    traceDFuns [ClsInst]
    ispecs
      = String -> SDoc -> TcRn ()
    traceTc String
    "Adding instances:" ([SDoc] -> SDoc
    vcat (forall a b. (a -> b) -> [a] -> [b]
    map ClsInst -> SDoc
    pp [ClsInst]
    ispecs))
      where
        pp :: ClsInst -> SDoc
    pp ClsInst
    ispec = SDoc -> Int -> SDoc -> SDoc
    hang (forall a. Outputable a => a -> SDoc
    ppr (ClsInst -> DFunId
    instanceDFunId ClsInst
    ispec) SDoc -> SDoc -> SDoc
    <+> SDoc
    colon)
                      Int
    2 (forall a. Outputable a => a -> SDoc
    ppr ClsInst
    ispec)
            -- Print the dfun name itself too

    funDepErr :: ClsInst -> [ClsInst] -> TcRn ()
    funDepErr :: ClsInst -> [ClsInst] -> TcRn ()
    funDepErr ClsInst
    ispec [ClsInst]
    ispecs
      = SDoc -> [ClsInst] -> TcRn ()
    addClsInstsErr (String -> SDoc
    text String
    "Functional dependencies conflict between instance declarations:")
                        (ClsInst
    ispec forall a. a -> [a] -> [a]
    : [ClsInst]
    ispecs)

    dupInstErr :: ClsInst -> ClsInst -> TcRn ()
    dupInstErr :: ClsInst -> ClsInst -> TcRn ()
    dupInstErr ClsInst
    ispec ClsInst
    dup_ispec
      = SDoc -> [ClsInst] -> TcRn ()
    addClsInstsErr (String -> SDoc
    text String
    "Duplicate instance declarations:")
                        [ClsInst
    ispec, ClsInst
    dup_ispec]

    addClsInstsErr :: SDoc -> [ClsInst] -> TcRn ()
    addClsInstsErr :: SDoc -> [ClsInst] -> TcRn ()
    addClsInstsErr SDoc
    herald [ClsInst]
    ispecs = do
       UnitState
    unit_state <- HscEnv -> UnitState
    hsc_units forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv
       forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (forall a. NamedThing a => a -> SrcSpan
    getSrcSpan (forall a. [a] -> a
    head [ClsInst]
    sorted)) forall a b. (a -> b) -> a -> b
    $
          SDoc -> TcRn ()
    addErr forall a b. (a -> b) -> a -> b
    $ UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    unit_state forall a b. (a -> b) -> a -> b
    $ (SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    herald Int
    2 ([ClsInst] -> SDoc
    pprInstances [ClsInst]
    sorted))
     where
       sorted :: [ClsInst]
    sorted = forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (SrcSpan -> SrcSpan -> Ordering
    SrcLoc.leftmost_smallest forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` forall a. NamedThing a => a -> SrcSpan
    getSrcSpan) [ClsInst]
    ispecs
       -- The sortBy just arranges that instances are displayed in order
       -- of source location, which reduced wobbling in error messages,
       -- and is better for users