    {-# LANGUAGE CPP           #-}

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

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

    module GHC.Tc.Validity (
      Rank, UserTypeCtxt(..), checkValidType, checkValidMonoType,
      checkValidTheta,
      checkValidInstance, checkValidInstHead, validDerivPred,
      checkTySynRhs,
      checkValidCoAxiom, checkValidCoAxBranch,
      checkValidTyFamEqn, checkValidAssocTyFamDeflt, checkConsistentFamInst,
      badATErr, arityErr,
      checkTyConTelescope,
      allDistinctTyVars
      ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Data.Maybe

    -- friends:
    import GHC.Tc.Utils.Unify    ( tcSubTypeSigma )
    import GHC.Tc.Solver         ( simplifyAmbiguityCheck )
    import GHC.Tc.Instance.Class ( matchGlobalInst, ClsInstResult(..), InstanceWhat(..), AssocInstInfo(..) )
    import GHC.Core.TyCo.FVs
    import GHC.Core.TyCo.Rep
    import GHC.Core.TyCo.Ppr
    import GHC.Tc.Utils.TcType hiding ( sizeType, sizeTypes )
    import GHC.Builtin.Types ( heqTyConName, eqTyConName, coercibleTyConName, manyDataConTy )
    import GHC.Builtin.Names
    import GHC.Core.Type
    import GHC.Core.Unify ( tcMatchTyX_BM, BindFlag(..) )
    import GHC.Core.Coercion
    import GHC.Core.Coercion.Axiom
    import GHC.Core.Class
    import GHC.Core.TyCon
    import GHC.Core.Predicate
    import GHC.Tc.Types.Origin

    -- others:
    import GHC.Iface.Type    ( pprIfaceType, pprIfaceTypeApp )
    import GHC.CoreToIface   ( toIfaceTyCon, toIfaceTcArgs, toIfaceType )
    import GHC.Hs
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Utils.Env  ( tcInitTidyEnv, tcInitOpenTidyEnv )
    import GHC.Tc.Instance.FunDeps
    import GHC.Core.FamInstEnv
       ( isDominatedBy, injectiveBranches, InjectivityCheckResult(..) )
    import GHC.Tc.Instance.Family
    import GHC.Types.Name
    import GHC.Types.Var.Env
    import GHC.Types.Var.Set
    import GHC.Types.Var     ( VarBndr(..), mkTyVar )
    import GHC.Utils.FV
    import GHC.Utils.Error
    import GHC.Driver.Session
    import GHC.Utils.Misc
    import GHC.Data.List.SetOps
    import GHC.Types.SrcLoc
    import GHC.Utils.Outputable as Outputable
    import GHC.Utils.Panic
    import GHC.Builtin.Uniques  ( mkAlphaTyVarUnique )
    import GHC.Data.Bag      ( emptyBag )
    import qualified GHC.LanguageExtensions as LangExt

    import Control.Monad
    import Data.Foldable
    import Data.Function
    import Data.List        ( (\\), nub )
    import qualified Data.List.NonEmpty as NE

    {-
    ************************************************************************
    *                                                                      *
              Checking for ambiguity
    *                                                                      *
    ************************************************************************

    Note [The ambiguity check for type signatures]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    checkAmbiguity is a check on *user-supplied type signatures*.  It is
    *purely* there to report functions that cannot possibly be called.  So for
    example we want to reject:
       f :: C a => Int
    The idea is there can be no legal calls to 'f' because every call will
    give rise to an ambiguous constraint.  We could soundly omit the
    ambiguity check on type signatures entirely, at the expense of
    delaying ambiguity errors to call sites.  Indeed, the flag
    -XAllowAmbiguousTypes switches off the ambiguity check.

    What about things like this:
       class D a b | a -> b where ..
       h :: D Int b => Int
    The Int may well fix 'b' at the call site, so that signature should
    not be rejected.  Moreover, using *visible* fundeps is too
    conservative.  Consider
       class X a b where ...
       class D a b | a -> b where ...
       instance D a b => X [a] b where...
       h :: X a b => a -> a
    Here h's type looks ambiguous in 'b', but here's a legal call:
       ...(h [True])...
    That gives rise to a (X [Bool] beta) constraint, and using the
    instance means we need (D Bool beta) and that fixes 'beta' via D's
    fundep!

    Behind all these special cases there is a simple guiding principle.
    Consider

      f :: <type>
      f = ...blah...

      g :: <type>
      g = f

    You would think that the definition of g would surely typecheck!
    After all f has exactly the same type, and g=f. But in fact f's type
    is instantiated and the instantiated constraints are solved against
    the originals, so in the case of an ambiguous type it won't work.
    Consider our earlier example f :: C a => Int.  Then in g's definition,
    we'll instantiate to (C alpha) and try to deduce (C alpha) from (C a),
    and fail.

    So in fact we use this as our *definition* of ambiguity.  We use a
    very similar test for *inferred* types, to ensure that they are
    unambiguous. See Note [Impedance matching] in GHC.Tc.Gen.Bind.

    This test is very conveniently implemented by calling
        tcSubType <type> <type>
    This neatly takes account of the functional dependency stuff above,
    and implicit parameter (see Note [Implicit parameters and ambiguity]).
    And this is what checkAmbiguity does.

    What about this, though?
       g :: C [a] => Int
    Is every call to 'g' ambiguous?  After all, we might have
       instance C [a] where ...
    at the call site.  So maybe that type is ok!  Indeed even f's
    quintessentially ambiguous type might, just possibly be callable:
    with -XFlexibleInstances we could have
      instance C a where ...
    and now a call could be legal after all!  Well, we'll reject this
    unless the instance is available *here*.

    Note [When to call checkAmbiguity]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We call checkAmbiguity
       (a) on user-specified type signatures
       (b) in checkValidType

    Conncerning (b), you might wonder about nested foralls.  What about
        f :: forall b. (forall a. Eq a => b) -> b
    The nested forall is ambiguous.  Originally we called checkAmbiguity
    in the forall case of check_type, but that had two bad consequences:
      * We got two error messages about (Eq b) in a nested forall like this:
           g :: forall a. Eq a => forall b. Eq b => a -> a
      * If we try to check for ambiguity of a nested forall like
        (forall a. Eq a => b), the implication constraint doesn't bind
        all the skolems, which results in "No skolem info" in error
        messages (see #10432).

    To avoid this, we call checkAmbiguity once, at the top, in checkValidType.
    (I'm still a bit worried about unbound skolems when the type mentions
    in-scope type variables.)

    In fact, because of the co/contra-variance implemented in tcSubType,
    this *does* catch function f above. too.

    Concerning (a) the ambiguity check is only used for *user* types, not
    for types coming from interface files.  The latter can legitimately
    have ambiguous types. Example

       class S a where s :: a -> (Int,Int)
       instance S Char where s _ = (1,1)
       f:: S a => [a] -> Int -> (Int,Int)
       f (_::[a]) x = (a*x,b)
            where (a,b) = s (undefined::a)

    Here the worker for f gets the type
            fw :: forall a. S a => Int -> (# Int, Int #)

    Note [Implicit parameters and ambiguity]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Only a *class* predicate can give rise to ambiguity
    An *implicit parameter* cannot.  For example:
            foo :: (?x :: [a]) => Int
            foo = length ?x
    is fine.  The call site will supply a particular 'x'

    Furthermore, the type variables fixed by an implicit parameter
    propagate to the others.  E.g.
            foo :: (Show a, ?x::[a]) => Int
            foo = show (?x++?x)
    The type of foo looks ambiguous.  But it isn't, because at a call site
    we might have
            let ?x = 5::Int in foo
    and all is well.  In effect, implicit parameters are, well, parameters,
    so we can take their type variables into account as part of the
    "tau-tvs" stuff.  This is done in the function 'GHC.Tc.Instance.FunDeps.grow'.
    -}

    checkAmbiguity :: UserTypeCtxt -> Type -> TcM ()
    checkAmbiguity :: UserTypeCtxt -> Type -> TcM ()
    checkAmbiguity UserTypeCtxt
    ctxt Type
    ty
      | UserTypeCtxt -> Bool
    wantAmbiguityCheck UserTypeCtxt
    ctxt
      = do { String -> SDoc -> TcM ()
    traceTc String
    "Ambiguity check for" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty)
             -- Solve the constraints eagerly because an ambiguous type
             -- can cause a cascade of further errors.  Since the free
             -- tyvars are skolemised, we can safely use tcSimplifyTop
           ; Bool
    allow_ambiguous <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.AllowAmbiguousTypes
           ; (HsWrapper
    _wrap, WantedConstraints
    wanted) <- SDoc
    -> TcM (HsWrapper, WantedConstraints)
    -> TcM (HsWrapper, WantedConstraints)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (Bool -> SDoc
    mk_msg Bool
    allow_ambiguous) (TcM (HsWrapper, WantedConstraints)
     -> TcM (HsWrapper, WantedConstraints))
    -> TcM (HsWrapper, WantedConstraints)
    -> TcM (HsWrapper, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                                TcM HsWrapper -> TcM (HsWrapper, WantedConstraints)
    forall a. TcM a -> TcM (a, WantedConstraints)
    captureConstraints (TcM HsWrapper -> TcM (HsWrapper, WantedConstraints))
    -> TcM HsWrapper -> TcM (HsWrapper, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                                UserTypeCtxt -> Type -> Type -> TcM HsWrapper
    tcSubTypeSigma UserTypeCtxt
    ctxt Type
    ty Type
    ty
           ; Type -> WantedConstraints -> TcM ()
    simplifyAmbiguityCheck Type
    ty WantedConstraints
    wanted

           ; String -> SDoc -> TcM ()
    traceTc String
    "Done ambiguity check for" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty) }

      | Bool
    otherwise
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
     where
       mk_msg :: Bool -> SDoc
    mk_msg Bool
    allow_ambiguous
         = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "In the ambiguity check for" SDoc -> SDoc -> SDoc
    <+> SDoc
    what
                , Bool -> SDoc -> SDoc
    ppUnless Bool
    allow_ambiguous SDoc
    ambig_msg ]
       ambig_msg :: SDoc
    ambig_msg = String -> SDoc
    text String
    "To defer the ambiguity check to use sites, enable AllowAmbiguousTypes"
       what :: SDoc
    what | Just Name
    n <- UserTypeCtxt -> Maybe Name
    isSigMaybe UserTypeCtxt
    ctxt = SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n)
            | Bool
    otherwise                 = UserTypeCtxt -> SDoc
    pprUserTypeCtxt UserTypeCtxt
    ctxt

    wantAmbiguityCheck :: UserTypeCtxt -> Bool
    wantAmbiguityCheck :: UserTypeCtxt -> Bool
    wantAmbiguityCheck UserTypeCtxt
    ctxt
      = case UserTypeCtxt
    ctxt of  -- See Note [When we don't check for ambiguity]
          GhciCtxt {}  -> Bool
    False
          TySynCtxt {} -> Bool
    False
          UserTypeCtxt
    TypeAppCtxt  -> Bool
    False
          StandaloneKindSigCtxt{} -> Bool
    False
          UserTypeCtxt
    _            -> Bool
    True

    checkUserTypeError :: Type -> TcM ()
    -- Check to see if the type signature mentions "TypeError blah"
    -- anywhere in it, and fail if so.
    --
    -- Very unsatisfactorily (#11144) we need to tidy the type
    -- because it may have come from an /inferred/ signature, not a
    -- user-supplied one.  This is really only a half-baked fix;
    -- the other errors in checkValidType don't do tidying, and so
    -- may give bad error messages when given an inferred type.
    checkUserTypeError :: Type -> TcM ()
    checkUserTypeError = Type -> TcM ()
    check
      where
      check :: Type -> TcM ()
    check Type
    ty
        | Just Type
    msg     <- Type -> Maybe Type
    userTypeError_maybe Type
    ty      = Type -> TcM ()
    forall {b}. Type -> IOEnv (Env TcGblEnv TcLclEnv) b
    fail_with Type
    msg
        | Just (TyCon
    _,[Type]
    ts)  <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    ty      = (Type -> TcM ()) -> [Type] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Type -> TcM ()
    check [Type]
    ts
        | Just (Type
    t1,Type
    t2) <- Type -> Maybe (Type, Type)
    splitAppTy_maybe Type
    ty         = Type -> TcM ()
    check Type
    t1 TcM () -> TcM () -> TcM ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Type -> TcM ()
    check Type
    t2
        | Just (TyCoVar
    _,Type
    t1)  <- Type -> Maybe (TyCoVar, Type)
    splitForAllTyCoVar_maybe Type
    ty = Type -> TcM ()
    check Type
    t1
        | Bool
    otherwise                                   = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

      fail_with :: Type -> IOEnv (Env TcGblEnv TcLclEnv) b
    fail_with Type
    msg = do { TidyEnv
    env0 <- TcM TidyEnv
    tcInitTidyEnv
                         ; let (TidyEnv
    env1, Type
    tidy_msg) = TidyEnv -> Type -> (TidyEnv, Type)
    tidyOpenType TidyEnv
    env0 Type
    msg
                         ; (TidyEnv, SDoc) -> IOEnv (Env TcGblEnv TcLclEnv) b
    forall a. (TidyEnv, SDoc) -> TcM a
    failWithTcM (TidyEnv
    env1, Type -> SDoc
    pprUserTypeErrorTy Type
    tidy_msg) }

    {- Note [When we don't check for ambiguity]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In a few places we do not want to check a user-specified type for ambiguity

    * GhciCtxt: Allow ambiguous types in GHCi's :kind command
      E.g.   type family T a :: *  -- T :: forall k. k -> *
      Then :k T should work in GHCi, not complain that
      (T k) is ambiguous!

    * TySynCtxt: type T a b = C a b => blah
      It may be that when we /use/ T, we'll give an 'a' or 'b' that somehow
      cure the ambiguity.  So we defer the ambiguity check to the use site.

      There is also an implementation reason (#11608).  In the RHS of
      a type synonym we don't (currently) instantiate 'a' and 'b' with
      TcTyVars before calling checkValidType, so we get assertion failures
      from doing an ambiguity check on a type with TyVars in it.  Fixing this
      would not be hard, but let's wait till there's a reason.

    * TypeAppCtxt: visible type application
         f @ty
      No need to check ty for ambiguity

    * StandaloneKindSigCtxt: type T :: ksig
      Kinds need a different ambiguity check than types, and the currently
      implemented check is only good for types. See #14419, in particular
      https://gitlab.haskell.org/ghc/ghc/issues/14419#note_160844

    ************************************************************************
    *                                                                      *
              Checking validity of a user-defined type
    *                                                                      *
    ************************************************************************

    When dealing with a user-written type, we first translate it from an HsType
    to a Type, performing kind checking, and then check various things that should
    be true about it.  We don't want to perform these checks at the same time
    as the initial translation because (a) they are unnecessary for interface-file
    types and (b) when checking a mutually recursive group of type and class decls,
    we can't "look" at the tycons/classes yet.  Also, the checks are rather
    diverse, and used to really mess up the other code.

    One thing we check for is 'rank'.

            Rank 0:         monotypes (no foralls)
            Rank 1:         foralls at the front only, Rank 0 inside
            Rank 2:         foralls at the front, Rank 1 on left of fn arrow,

            basic ::= tyvar | T basic ... basic

            r2  ::= forall tvs. cxt => r2a
            r2a ::= r1 -> r2a | basic
            r1  ::= forall tvs. cxt => r0
            r0  ::= r0 -> r0 | basic

    Another thing is to check that type synonyms are saturated.
    This might not necessarily show up in kind checking.
            type A i = i
            data T k = MkT (k Int)
            f :: T A        -- BAD!
    -}

    checkValidType :: UserTypeCtxt -> Type -> TcM ()
    -- Checks that a user-written type is valid for the given context
    -- Assumes argument is fully zonked
    -- Not used for instance decls; checkValidInstance instead
    checkValidType :: UserTypeCtxt -> Type -> TcM ()
    checkValidType UserTypeCtxt
    ctxt Type
    ty
      = do { String -> SDoc -> TcM ()
    traceTc String
    "checkValidType" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "::" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (HasDebugCallStack => Type -> Type
    Type -> Type
    tcTypeKind Type
    ty))
           ; Bool
    rankn_flag  <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.RankNTypes
           ; Bool
    impred_flag <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.ImpredicativeTypes
           ; let gen_rank :: Rank -> Rank
                 gen_rank :: Rank -> Rank
    gen_rank Rank
    r | Bool
    rankn_flag = Rank
    ArbitraryRank
                            | Bool
    otherwise  = Rank
    r

                 rank1 :: Rank
    rank1 = Rank -> Rank
    gen_rank Rank
    r1
                 rank0 :: Rank
    rank0 = Rank -> Rank
    gen_rank Rank
    r0

                 r0 :: Rank
    r0 = Rank
    rankZeroMonoType
                 r1 :: Rank
    r1 = Bool -> Rank -> Rank
    LimitedRank Bool
    True Rank
    r0

                 rank :: Rank
    rank
                   = case UserTypeCtxt
    ctxt of
                     UserTypeCtxt
    DefaultDeclCtxt-> Rank
    MustBeMonoType
                     UserTypeCtxt
    PatSigCtxt     -> Rank
    rank0
                     RuleSigCtxt Name
    _  -> Rank
    rank1
                     TySynCtxt Name
    _    -> Rank
    rank0

                     UserTypeCtxt
    ExprSigCtxt    -> Rank
    rank1
                     UserTypeCtxt
    KindSigCtxt    -> Rank
    rank1
                     StandaloneKindSigCtxt{} -> Rank
    rank1
                     UserTypeCtxt
    TypeAppCtxt | Bool
    impred_flag -> Rank
    ArbitraryRank
                                 | Bool
    otherwise   -> Rank
    tyConArgMonoType
                        -- Normally, ImpredicativeTypes is handled in check_arg_type,
                        -- but visible type applications don't go through there.
                        -- So we do this check here.

                     FunSigCtxt {}  -> Rank
    rank1
                     InfSigCtxt {}  -> Rank
    rank1 -- Inferred types should obey the
                                             -- same rules as declared ones

                     ConArgCtxt Name
    _   -> Rank
    rank1 -- We are given the type of the entire
                                             -- constructor, hence rank 1
                     PatSynCtxt Name
    _   -> Rank
    rank1

                     ForSigCtxt Name
    _   -> Rank
    rank1
                     UserTypeCtxt
    SpecInstCtxt   -> Rank
    rank1
                     GhciCtxt {}    -> Rank
    ArbitraryRank

                     TyVarBndrKindCtxt Name
    _ -> Rank
    rank0
                     DataKindCtxt Name
    _      -> Rank
    rank1
                     TySynKindCtxt Name
    _     -> Rank
    rank1
                     TyFamResKindCtxt Name
    _  -> Rank
    rank1

                     UserTypeCtxt
    _              -> String -> Rank
    forall a. String -> a
    panic String
    "checkValidType"
                                              -- Can't happen; not used for *user* sigs

           ; TidyEnv
    env <- [TyCoVar] -> TcM TidyEnv
    tcInitOpenTidyEnv (Type -> [TyCoVar]
    tyCoVarsOfTypeList Type
    ty)
           ; ExpandMode
    expand <- TcM ExpandMode
    initialExpandMode
           ; let ve :: ValidityEnv
    ve = ValidityEnv{ ve_tidy_env :: TidyEnv
    ve_tidy_env = TidyEnv
    env, ve_ctxt :: UserTypeCtxt
    ve_ctxt = UserTypeCtxt
    ctxt
                                 , ve_rank :: Rank
    ve_rank = Rank
    rank, ve_expand :: ExpandMode
    ve_expand = ExpandMode
    expand }

           -- Check the internal validity of the type itself
           -- Fail if bad things happen, else we misleading
           -- (and more complicated) errors in checkAmbiguity
           ; TcM () -> TcM ()
    forall r. TcM r -> TcM r
    checkNoErrs (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
             do { ValidityEnv -> Type -> TcM ()
    check_type ValidityEnv
    ve Type
    ty
                ; Type -> TcM ()
    checkUserTypeError Type
    ty
                ; String -> SDoc -> TcM ()
    traceTc String
    "done ct" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty) }

           -- Check for ambiguous types.  See Note [When to call checkAmbiguity]
           -- NB: this will happen even for monotypes, but that should be cheap;
           --     and there may be nested foralls for the subtype test to examine
           ; UserTypeCtxt -> Type -> TcM ()
    checkAmbiguity UserTypeCtxt
    ctxt Type
    ty

           ; String -> SDoc -> TcM ()
    traceTc String
    "checkValidType done" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "::" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (HasDebugCallStack => Type -> Type
    Type -> Type
    tcTypeKind Type
    ty)) }

    checkValidMonoType :: Type -> TcM ()
    -- Assumes argument is fully zonked
    checkValidMonoType :: Type -> TcM ()
    checkValidMonoType Type
    ty
      = do { TidyEnv
    env <- [TyCoVar] -> TcM TidyEnv
    tcInitOpenTidyEnv (Type -> [TyCoVar]
    tyCoVarsOfTypeList Type
    ty)
           ; ExpandMode
    expand <- TcM ExpandMode
    initialExpandMode
           ; let ve :: ValidityEnv
    ve = ValidityEnv{ ve_tidy_env :: TidyEnv
    ve_tidy_env = TidyEnv
    env, ve_ctxt :: UserTypeCtxt
    ve_ctxt = UserTypeCtxt
    SigmaCtxt
                                 , ve_rank :: Rank
    ve_rank = Rank
    MustBeMonoType, ve_expand :: ExpandMode
    ve_expand = ExpandMode
    expand }
           ; ValidityEnv -> Type -> TcM ()
    check_type ValidityEnv
    ve Type
    ty }

    checkTySynRhs :: UserTypeCtxt -> TcType -> TcM ()
    checkTySynRhs :: UserTypeCtxt -> Type -> TcM ()
    checkTySynRhs UserTypeCtxt
    ctxt Type
    ty
      | Type -> Bool
    tcReturnsConstraintKind Type
    actual_kind
      = do { Bool
    ck <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.ConstraintKinds
           ; if Bool
    ck
             then  Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Type -> Bool
    tcIsConstraintKind Type
    actual_kind)
                        (do { DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
                            ; ExpandMode
    expand <- TcM ExpandMode
    initialExpandMode
                            ; TidyEnv -> DynFlags -> UserTypeCtxt -> ExpandMode -> Type -> TcM ()
    check_pred_ty TidyEnv
    emptyTidyEnv DynFlags
    dflags UserTypeCtxt
    ctxt ExpandMode
    expand Type
    ty })
             else (TidyEnv, SDoc) -> TcM ()
    addErrTcM (TidyEnv -> Type -> (TidyEnv, SDoc)
    constraintSynErr TidyEnv
    emptyTidyEnv Type
    actual_kind) }

      | Bool
    otherwise
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where
        actual_kind :: Type
    actual_kind = HasDebugCallStack => Type -> Type
    Type -> Type
    tcTypeKind Type
    ty

    {-
    Note [Higher rank types]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    Technically
                Int -> forall a. a->a
    is still a rank-1 type, but it's not Haskell 98 (#5957).  So the
    validity checker allow a forall after an arrow only if we allow it
    before -- that is, with Rank2Types or RankNTypes
    -}

    data Rank = ArbitraryRank         -- Any rank ok

              | LimitedRank   -- Note [Higher rank types]
                     Bool     -- Forall ok at top
                     Rank     -- Use for function arguments

              | MonoType SDoc   -- Monotype, with a suggestion of how it could be a polytype

              | MustBeMonoType  -- Monotype regardless of flags

    instance Outputable Rank where
      ppr :: Rank -> SDoc
    ppr Rank
    ArbitraryRank  = String -> SDoc
    text String
    "ArbitraryRank"
      ppr (LimitedRank Bool
    top_forall_ok Rank
    r)
                         = String -> SDoc
    text String
    "LimitedRank" SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    top_forall_ok
                                              SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (Rank -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Rank
    r)
      ppr (MonoType SDoc
    msg) = String -> SDoc
    text String
    "MonoType" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens SDoc
    msg
      ppr Rank
    MustBeMonoType = String -> SDoc
    text String
    "MustBeMonoType"

    rankZeroMonoType, tyConArgMonoType, synArgMonoType, constraintMonoType :: Rank
    rankZeroMonoType :: Rank
    rankZeroMonoType   = SDoc -> Rank
    MonoType (String -> SDoc
    text String
    "Perhaps you intended to use RankNTypes")
    tyConArgMonoType :: Rank
    tyConArgMonoType   = SDoc -> Rank
    MonoType (String -> SDoc
    text String
    "Perhaps you intended to use ImpredicativeTypes")
    synArgMonoType :: Rank
    synArgMonoType     = SDoc -> Rank
    MonoType (String -> SDoc
    text String
    "Perhaps you intended to use LiberalTypeSynonyms")
    constraintMonoType :: Rank
    constraintMonoType = SDoc -> Rank
    MonoType ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "A constraint must be a monotype"
                                        , String -> SDoc
    text String
    "Perhaps you intended to use QuantifiedConstraints" ])

    funArgResRank :: Rank -> (Rank, Rank)             -- Function argument and result
    funArgResRank :: Rank -> (Rank, Rank)
    funArgResRank (LimitedRank Bool
    _ Rank
    arg_rank) = (Rank
    arg_rank, Bool -> Rank -> Rank
    LimitedRank (Rank -> Bool
    forAllAllowed Rank
    arg_rank) Rank
    arg_rank)
    funArgResRank Rank
    other_rank               = (Rank
    other_rank, Rank
    other_rank)

    forAllAllowed :: Rank -> Bool
    forAllAllowed :: Rank -> Bool
    forAllAllowed Rank
    ArbitraryRank             = Bool
    True
    forAllAllowed (LimitedRank Bool
    forall_ok Rank
    _) = Bool
    forall_ok
    forAllAllowed Rank
    _                         = Bool
    False

    -- | Indicates whether a 'UserTypeCtxt' represents type-level contexts,
    -- kind-level contexts, or both.
    data TypeOrKindCtxt
      = OnlyTypeCtxt
        -- ^ A 'UserTypeCtxt' that only represents type-level positions.
      | OnlyKindCtxt
        -- ^ A 'UserTypeCtxt' that only represents kind-level positions.
      | BothTypeAndKindCtxt
        -- ^ A 'UserTypeCtxt' that can represent both type- and kind-level positions.
      deriving TypeOrKindCtxt -> TypeOrKindCtxt -> Bool
    (TypeOrKindCtxt -> TypeOrKindCtxt -> Bool)
    -> (TypeOrKindCtxt -> TypeOrKindCtxt -> Bool) -> Eq TypeOrKindCtxt
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: TypeOrKindCtxt -> TypeOrKindCtxt -> Bool
    $c/= :: TypeOrKindCtxt -> TypeOrKindCtxt -> Bool
    == :: TypeOrKindCtxt -> TypeOrKindCtxt -> Bool
    $c== :: TypeOrKindCtxt -> TypeOrKindCtxt -> Bool
    Eq

    instance Outputable TypeOrKindCtxt where
      ppr :: TypeOrKindCtxt -> SDoc
    ppr TypeOrKindCtxt
    ctxt = String -> SDoc
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ case TypeOrKindCtxt
    ctxt of
        TypeOrKindCtxt
    OnlyTypeCtxt        -> String
    "OnlyTypeCtxt"
        TypeOrKindCtxt
    OnlyKindCtxt        -> String
    "OnlyKindCtxt"
        TypeOrKindCtxt
    BothTypeAndKindCtxt -> String
    "BothTypeAndKindCtxt"

    -- | Determine whether a 'UserTypeCtxt' can represent type-level contexts,
    -- kind-level contexts, or both.
    typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt
    typeOrKindCtxt :: UserTypeCtxt -> TypeOrKindCtxt
    typeOrKindCtxt (FunSigCtxt {})      = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (InfSigCtxt {})      = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (ExprSigCtxt {})     = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (TypeAppCtxt {})     = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (PatSynCtxt {})      = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (PatSigCtxt {})      = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (RuleSigCtxt {})     = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (ForSigCtxt {})      = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (DefaultDeclCtxt {}) = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (InstDeclCtxt {})    = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (SpecInstCtxt {})    = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (GenSigCtxt {})      = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (ClassSCCtxt {})     = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (SigmaCtxt {})       = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (DataTyCtxt {})      = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (DerivClauseCtxt {}) = TypeOrKindCtxt
    OnlyTypeCtxt
    typeOrKindCtxt (ConArgCtxt {})      = TypeOrKindCtxt
    OnlyTypeCtxt
      -- Although data constructors can be promoted with DataKinds, we always
      -- validity-check them as though they are the types of terms. We may need
      -- to revisit this decision if we ever allow visible dependent quantification
      -- in the types of data constructors.

    typeOrKindCtxt (KindSigCtxt {})           = TypeOrKindCtxt
    OnlyKindCtxt
    typeOrKindCtxt (StandaloneKindSigCtxt {}) = TypeOrKindCtxt
    OnlyKindCtxt
    typeOrKindCtxt (TyVarBndrKindCtxt {})     = TypeOrKindCtxt
    OnlyKindCtxt
    typeOrKindCtxt (DataKindCtxt {})          = TypeOrKindCtxt
    OnlyKindCtxt
    typeOrKindCtxt (TySynKindCtxt {})         = TypeOrKindCtxt
    OnlyKindCtxt
    typeOrKindCtxt (TyFamResKindCtxt {})      = TypeOrKindCtxt
    OnlyKindCtxt

    typeOrKindCtxt (TySynCtxt {}) = TypeOrKindCtxt
    BothTypeAndKindCtxt
      -- Type synonyms can have types and kinds on their RHSs
    typeOrKindCtxt (GhciCtxt {})  = TypeOrKindCtxt
    BothTypeAndKindCtxt
      -- GHCi's :kind command accepts both types and kinds

    -- | Returns 'True' if the supplied 'UserTypeCtxt' is unambiguously not the
    -- context for a kind of a type.
    -- If the 'UserTypeCtxt' can refer to both types and kinds, this function
    -- conservatively returns 'True'.
    --
    -- An example of something that is unambiguously the kind of a type is the
    -- @Show a => a -> a@ in @type Foo :: Show a => a -> a@. On the other hand, the
    -- same type in @foo :: Show a => a -> a@ is unambiguously the type of a term,
    -- not the kind of a type, so it is permitted.
    typeLevelUserTypeCtxt :: UserTypeCtxt -> Bool
    typeLevelUserTypeCtxt :: UserTypeCtxt -> Bool
    typeLevelUserTypeCtxt UserTypeCtxt
    ctxt = case UserTypeCtxt -> TypeOrKindCtxt
    typeOrKindCtxt UserTypeCtxt
    ctxt of
      TypeOrKindCtxt
    OnlyTypeCtxt        -> Bool
    True
      TypeOrKindCtxt
    OnlyKindCtxt        -> Bool
    False
      TypeOrKindCtxt
    BothTypeAndKindCtxt -> Bool
    True

    -- | Returns 'True' if the supplied 'UserTypeCtxt' is unambiguously not the
    -- context for a kind of a type, where the arbitrary use of constraints is
    -- currently disallowed.
    -- (See @Note [Constraints in kinds]@ in "GHC.Core.TyCo.Rep".)
    allConstraintsAllowed :: UserTypeCtxt -> Bool
    allConstraintsAllowed :: UserTypeCtxt -> Bool
    allConstraintsAllowed = UserTypeCtxt -> Bool
    typeLevelUserTypeCtxt

    -- | Returns 'True' if the supplied 'UserTypeCtxt' is unambiguously not the
    -- context for a kind of a type, where all function arrows currently
    -- must be unrestricted.
    linearityAllowed :: UserTypeCtxt -> Bool
    linearityAllowed :: UserTypeCtxt -> Bool
    linearityAllowed = UserTypeCtxt -> Bool
    typeLevelUserTypeCtxt

    -- | Returns 'True' if the supplied 'UserTypeCtxt' is unambiguously not the
    -- context for the type of a term, where visible, dependent quantification is
    -- currently disallowed. If the 'UserTypeCtxt' can refer to both types and
    -- kinds, this function conservatively returns 'True'.
    --
    -- An example of something that is unambiguously the type of a term is the
    -- @forall a -> a -> a@ in @foo :: forall a -> a -> a@. On the other hand, the
    -- same type in @type family Foo :: forall a -> a -> a@ is unambiguously the
    -- kind of a type, not the type of a term, so it is permitted.
    --
    -- For more examples, see
    -- @testsuite/tests/dependent/should_compile/T16326_Compile*.hs@ (for places
    -- where VDQ is permitted) and
    -- @testsuite/tests/dependent/should_fail/T16326_Fail*.hs@ (for places where
    -- VDQ is disallowed).
    vdqAllowed :: UserTypeCtxt -> Bool
    vdqAllowed :: UserTypeCtxt -> Bool
    vdqAllowed UserTypeCtxt
    ctxt = case UserTypeCtxt -> TypeOrKindCtxt
    typeOrKindCtxt UserTypeCtxt
    ctxt of
      TypeOrKindCtxt
    OnlyTypeCtxt        -> Bool
    False
      TypeOrKindCtxt
    OnlyKindCtxt        -> Bool
    True
      TypeOrKindCtxt
    BothTypeAndKindCtxt -> Bool
    True

    {-
    Note [Correctness and performance of type synonym validity checking]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider the type A arg1 arg2, where A is a type synonym. How should we check
    this type for validity? We have three distinct choices, corresponding to the
    three constructors of ExpandMode:

    1. Expand the application of A, and check the resulting type (`Expand`).
    2. Don't expand the application of A. Only check the arguments (`NoExpand`).
    3. Check the arguments *and* check the expanded type (`Both`).

    It's tempting to think that we could always just pick choice (3), but this
    results in serious performance issues when checking a type like in the
    signature for `f` below:

      type S = ...
      f :: S (S (S (S (S (S ....(S Int)...))))

    When checking the type of `f`, we'll check the outer `S` application with and
    without expansion, and in *each* of those checks, we'll check the next `S`
    application with and without expansion... the result is exponential blowup! So
    clearly we don't want to use `Both` 100% of the time.

    On the other hand, neither is it correct to use exclusively `Expand` or
    exclusively `NoExpand` 100% of the time:

    * If one always expands, then one can miss erroneous programs like the one in
      the `tcfail129` test case:

        type Foo a = String -> Maybe a
        type Bar m = m Int
        blah = undefined :: Bar Foo

      If we expand `Bar Foo` immediately, we'll miss the fact that the `Foo` type
      synonyms is unsaturated.
    * If one never expands and only checks the arguments, then one can miss
      erroneous programs like the one in #16059:

        type Foo b = Eq b => b
        f :: forall b (a :: Foo b). Int

      The kind of `a` contains a constraint, which is illegal, but this will only
      be caught if `Foo b` is expanded.

    Therefore, it's impossible to have these validity checks be simultaneously
    correct and performant if one sticks exclusively to a single `ExpandMode`. In
    that case, the solution is to vary the `ExpandMode`s! In more detail:

    1. When we start validity checking, we start with `Expand` if
       LiberalTypeSynonyms is enabled (see Note [Liberal type synonyms] for why we
       do this), and we start with `Both` otherwise. The `initialExpandMode`
       function is responsible for this.
    2. When expanding an application of a type synonym (in `check_syn_tc_app`), we
       determine which things to check based on the current `ExpandMode` argument.
       Importantly, if the current mode is `Both`, then we check the arguments in
       `NoExpand` mode and check the expanded type in `Both` mode.

       Switching to `NoExpand` when checking the arguments is vital to avoid
       exponential blowup. One consequence of this choice is that if you have
       the following type synonym in one module (with RankNTypes enabled):

         {-# LANGUAGE RankNTypes #-}
         module A where
         type A = forall a. a

       And you define the following in a separate module *without* RankNTypes
       enabled:

         module B where

         import A

         type Const a b = a
         f :: Const Int A -> Int

       Then `f` will be accepted, even though `A` (which is technically a rank-n
       type) appears in its type. We view this as an acceptable compromise, since
       `A` never appears in the type of `f` post-expansion. If `A` _did_ appear in
       a type post-expansion, such as in the following variant:

         g :: Const A A -> Int

       Then that would be rejected unless RankNTypes were enabled.
    -}

    -- | When validity-checking an application of a type synonym, should we
    -- check the arguments, check the expanded type, or both?
    -- See Note [Correctness and performance of type synonym validity checking]
    data ExpandMode
      = Expand   -- ^ Only check the expanded type.
      | NoExpand -- ^ Only check the arguments.
      | Both     -- ^ Check both the arguments and the expanded type.

    instance Outputable ExpandMode where
      ppr :: ExpandMode -> SDoc
    ppr ExpandMode
    e = String -> SDoc
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ case ExpandMode
    e of
                       ExpandMode
    Expand   -> String
    "Expand"
                       ExpandMode
    NoExpand -> String
    "NoExpand"
                       ExpandMode
    Both     -> String
    "Both"

    -- | If @LiberalTypeSynonyms@ is enabled, we start in 'Expand' mode for the
    -- reasons explained in @Note [Liberal type synonyms]@. Otherwise, we start
    -- in 'Both' mode.
    initialExpandMode :: TcM ExpandMode
    initialExpandMode :: TcM ExpandMode
    initialExpandMode = do
      Bool
    liberal_flag <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.LiberalTypeSynonyms
      ExpandMode -> TcM ExpandMode
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ExpandMode -> TcM ExpandMode) -> ExpandMode -> TcM ExpandMode
    forall a b. (a -> b) -> a -> b
    $ if Bool
    liberal_flag then ExpandMode
    Expand else ExpandMode
    Both

    -- | Information about a type being validity-checked.
    data ValidityEnv = ValidityEnv
      { ValidityEnv -> TidyEnv
    ve_tidy_env :: TidyEnv
      , ValidityEnv -> UserTypeCtxt
    ve_ctxt     :: UserTypeCtxt
      , ValidityEnv -> Rank
    ve_rank     :: Rank
      , ValidityEnv -> ExpandMode
    ve_expand   :: ExpandMode }

    instance Outputable ValidityEnv where
      ppr :: ValidityEnv -> SDoc
    ppr (ValidityEnv{ ve_tidy_env :: ValidityEnv -> TidyEnv
    ve_tidy_env = TidyEnv
    env, ve_ctxt :: ValidityEnv -> UserTypeCtxt
    ve_ctxt = UserTypeCtxt
    ctxt
                      , ve_rank :: ValidityEnv -> Rank
    ve_rank = Rank
    rank, ve_expand :: ValidityEnv -> ExpandMode
    ve_expand = ExpandMode
    expand }) =
        SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "ValidityEnv")
           Int
    2 ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "ve_tidy_env" SDoc -> SDoc -> SDoc
    <+> TidyEnv -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TidyEnv
    env
                   , String -> SDoc
    text String
    "ve_ctxt"     SDoc -> SDoc -> SDoc
    <+> UserTypeCtxt -> SDoc
    pprUserTypeCtxt UserTypeCtxt
    ctxt
                   , String -> SDoc
    text String
    "ve_rank"     SDoc -> SDoc -> SDoc
    <+> Rank -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Rank
    rank
                   , String -> SDoc
    text String
    "ve_expand"   SDoc -> SDoc -> SDoc
    <+> ExpandMode -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ExpandMode
    expand ])

    ----------------------------------------
    check_type :: ValidityEnv -> Type -> TcM ()
    -- The args say what the *type context* requires, independent
    -- of *flag* settings.  You test the flag settings at usage sites.
    --
    -- Rank is allowed rank for function args
    -- Rank 0 means no for-alls anywhere

    check_type :: ValidityEnv -> Type -> TcM ()
    check_type ValidityEnv
    _ (TyVarTy TyCoVar
    _) = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    check_type ValidityEnv
    ve (AppTy Type
    ty1 Type
    ty2)
      = do  { ValidityEnv -> Type -> TcM ()
    check_type ValidityEnv
    ve Type
    ty1
            ; Bool -> ValidityEnv -> Type -> TcM ()
    check_arg_type Bool
    False ValidityEnv
    ve Type
    ty2 }

    check_type ValidityEnv
    ve ty :: Type
    ty@(TyConApp TyCon
    tc [Type]
    tys)
      | TyCon -> Bool
    isTypeSynonymTyCon TyCon
    tc Bool -> Bool -> Bool
    || TyCon -> Bool
    isTypeFamilyTyCon TyCon
    tc
      = ValidityEnv -> Type -> TyCon -> [Type] -> TcM ()
    check_syn_tc_app ValidityEnv
    ve Type
    ty TyCon
    tc [Type]
    tys
      | TyCon -> Bool
    isUnboxedTupleTyCon TyCon
    tc = ValidityEnv -> Type -> [Type] -> TcM ()
    check_ubx_tuple ValidityEnv
    ve Type
    ty [Type]
    tys
      | Bool
    otherwise              = (Type -> TcM ()) -> [Type] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Bool -> ValidityEnv -> Type -> TcM ()
    check_arg_type Bool
    False ValidityEnv
    ve) [Type]
    tys

    check_type ValidityEnv
    _ (LitTy {}) = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    check_type ValidityEnv
    ve (CastTy Type
    ty KindCoercion
    _) = ValidityEnv -> Type -> TcM ()
    check_type ValidityEnv
    ve Type
    ty

    -- Check for rank-n types, such as (forall x. x -> x) or (Show x => x).
    --
    -- Critically, this case must come *after* the case for TyConApp.
    -- See Note [Liberal type synonyms].
    check_type ve :: ValidityEnv
    ve@(ValidityEnv{ ve_tidy_env :: ValidityEnv -> TidyEnv
    ve_tidy_env = TidyEnv
    env, ve_ctxt :: ValidityEnv -> UserTypeCtxt
    ve_ctxt = UserTypeCtxt
    ctxt
                              , ve_rank :: ValidityEnv -> Rank
    ve_rank = Rank
    rank, ve_expand :: ValidityEnv -> ExpandMode
    ve_expand = ExpandMode
    expand }) Type
    ty
      | Bool -> Bool
    not ([TyVarBinder] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyVarBinder]
    tvbs Bool -> Bool -> Bool
    && [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    theta)
      = do  { String -> SDoc -> TcM ()
    traceTc String
    "check_type" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty SDoc -> SDoc -> SDoc
    $$ Rank -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Rank
    rank)
            ; Bool -> (TidyEnv, SDoc) -> TcM ()
    checkTcM (Rank -> Bool
    forAllAllowed Rank
    rank) (TidyEnv -> Rank -> Type -> (TidyEnv, SDoc)
    forAllTyErr TidyEnv
    env Rank
    rank Type
    ty)
                    -- Reject e.g. (Maybe (?x::Int => Int)),
                    -- with a decent error message

            ; ValidityEnv -> [Type] -> Type -> TcM ()
    checkConstraintsOK ValidityEnv
    ve [Type]
    theta Type
    ty
                    -- Reject forall (a :: Eq b => b). blah
                    -- In a kind signature we don't allow constraints

            ; Bool -> (TidyEnv, SDoc) -> TcM ()
    checkTcM ((TyVarBinder -> Bool) -> [TyVarBinder] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (ArgFlag -> Bool
    isInvisibleArgFlag (ArgFlag -> Bool)
    -> (TyVarBinder -> ArgFlag) -> TyVarBinder -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyVarBinder -> ArgFlag
    forall tv argf. VarBndr tv argf -> argf
    binderArgFlag) [TyVarBinder]
    tvbs
                             Bool -> Bool -> Bool
    || UserTypeCtxt -> Bool
    vdqAllowed UserTypeCtxt
    ctxt)
                       (TidyEnv -> Type -> (TidyEnv, SDoc)
    illegalVDQTyErr TidyEnv
    env Type
    ty)
                    -- Reject visible, dependent quantification in the type of a
                    -- term (e.g., `f :: forall a -> a -> Maybe a`)

            ; TidyEnv -> UserTypeCtxt -> ExpandMode -> [Type] -> TcM ()
    check_valid_theta TidyEnv
    env' UserTypeCtxt
    SigmaCtxt ExpandMode
    expand [Type]
    theta
                    -- Allow     type T = ?x::Int => Int -> Int
                    -- but not   type T = ?x::Int

            ; ValidityEnv -> Type -> TcM ()
    check_type (ValidityEnv
    ve{ve_tidy_env :: TidyEnv
    ve_tidy_env = TidyEnv
    env'}) Type
    tau
                    -- Allow foralls to right of arrow

            ; TidyEnv -> [TyVarBinder] -> [Type] -> Type -> TcM ()
    checkEscapingKind TidyEnv
    env' [TyVarBinder]
    tvbs' [Type]
    theta Type
    tau }
      where
        ([TyVarBinder]
    tvbs, Type
    phi)   = Type -> ([TyVarBinder], Type)
    tcSplitForAllTyVarBinders Type
    ty
        ([Type]
    theta, Type
    tau)  = Type -> ([Type], Type)
    tcSplitPhiTy Type
    phi
        (TidyEnv
    env', [TyVarBinder]
    tvbs') = TidyEnv -> [TyVarBinder] -> (TidyEnv, [TyVarBinder])
    forall vis.
    TidyEnv
    -> [VarBndr TyCoVar vis] -> (TidyEnv, [VarBndr TyCoVar vis])
    tidyTyCoVarBinders TidyEnv
    env [TyVarBinder]
    tvbs

    check_type (ve :: ValidityEnv
    ve@ValidityEnv{ ve_tidy_env :: ValidityEnv -> TidyEnv
    ve_tidy_env = TidyEnv
    env, ve_ctxt :: ValidityEnv -> UserTypeCtxt
    ve_ctxt = UserTypeCtxt
    ctxt
                              , ve_rank :: ValidityEnv -> Rank
    ve_rank = Rank
    rank })
               ty :: Type
    ty@(FunTy AnonArgFlag
    _ Type
    mult Type
    arg_ty Type
    res_ty)
      = do  { Bool -> (TidyEnv, SDoc) -> TcM ()
    failIfTcM (Bool -> Bool
    not (UserTypeCtxt -> Bool
    linearityAllowed UserTypeCtxt
    ctxt) Bool -> Bool -> Bool
    && Bool -> Bool
    not (Type -> Bool
    isManyDataConTy Type
    mult))
                         (TidyEnv -> Type -> (TidyEnv, SDoc)
    linearFunKindErr TidyEnv
    env Type
    ty)
            ; ValidityEnv -> Type -> TcM ()
    check_type (ValidityEnv
    ve{ve_rank :: Rank
    ve_rank = Rank
    arg_rank}) Type
    arg_ty
            ; ValidityEnv -> Type -> TcM ()
    check_type (ValidityEnv
    ve{ve_rank :: Rank
    ve_rank = Rank
    res_rank}) Type
    res_ty }
      where
        (Rank
    arg_rank, Rank
    res_rank) = Rank -> (Rank, Rank)
    funArgResRank Rank
    rank

    check_type ValidityEnv
    _ Type
    ty = String -> SDoc -> TcM ()
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "check_type" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty)

    ----------------------------------------
    check_syn_tc_app :: ValidityEnv
                     -> KindOrType -> TyCon -> [KindOrType] -> TcM ()
    -- Used for type synonyms and type synonym families,
    -- which must be saturated,
    -- but not data families, which need not be saturated
    check_syn_tc_app :: ValidityEnv -> Type -> TyCon -> [Type] -> TcM ()
    check_syn_tc_app (ve :: ValidityEnv
    ve@ValidityEnv{ ve_ctxt :: ValidityEnv -> UserTypeCtxt
    ve_ctxt = UserTypeCtxt
    ctxt, ve_expand :: ValidityEnv -> ExpandMode
    ve_expand = ExpandMode
    expand })
                     Type
    ty TyCon
    tc [Type]
    tys
      | [Type]
    tys [Type] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthAtLeast` Int
    tc_arity   -- Saturated
           -- Check that the synonym has enough args
           -- This applies equally to open and closed synonyms
           -- It's OK to have an *over-applied* type synonym
           --      data Tree a b = ...
           --      type Foo a = Tree [a]
           --      f :: Foo a b -> ...
      = case ExpandMode
    expand of
          ExpandMode
    _ |  TyCon -> Bool
    isTypeFamilyTyCon TyCon
    tc
            -> ExpandMode -> TcM ()
    check_args_only ExpandMode
    expand
          -- See Note [Correctness and performance of type synonym validity
          --           checking]
          ExpandMode
    Expand   -> ExpandMode -> TcM ()
    check_expansion_only ExpandMode
    expand
          ExpandMode
    NoExpand -> ExpandMode -> TcM ()
    check_args_only ExpandMode
    expand
          ExpandMode
    Both     -> ExpandMode -> TcM ()
    check_args_only ExpandMode
    NoExpand TcM () -> TcM () -> TcM ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ExpandMode -> TcM ()
    check_expansion_only ExpandMode
    Both

      | GhciCtxt Bool
    True <- UserTypeCtxt
    ctxt  -- Accept outermost under-saturated type synonym or
                               -- type family constructors in GHCi :kind commands.
                               -- See Note [Unsaturated type synonyms in GHCi]
      = ExpandMode -> TcM ()
    check_args_only ExpandMode
    expand

      | Bool
    otherwise
      = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc (TyCon -> [Type] -> SDoc
    tyConArityErr TyCon
    tc [Type]
    tys)
      where
        tc_arity :: Int
    tc_arity  = TyCon -> Int
    tyConArity TyCon
    tc

        check_arg :: ExpandMode -> KindOrType -> TcM ()
        check_arg :: ExpandMode -> Type -> TcM ()
    check_arg ExpandMode
    expand =
          Bool -> ValidityEnv -> Type -> TcM ()
    check_arg_type (TyCon -> Bool
    isTypeSynonymTyCon TyCon
    tc) (ValidityEnv
    ve{ve_expand :: ExpandMode
    ve_expand = ExpandMode
    expand})

        check_args_only, check_expansion_only :: ExpandMode -> TcM ()
        check_args_only :: ExpandMode -> TcM ()
    check_args_only ExpandMode
    expand = (Type -> TcM ()) -> [Type] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (ExpandMode -> Type -> TcM ()
    check_arg ExpandMode
    expand) [Type]
    tys

        check_expansion_only :: ExpandMode -> TcM ()
    check_expansion_only ExpandMode
    expand
          = ASSERT2( isTypeSynonymTyCon tc, ppr tc )
            case Type -> Maybe Type
    tcView Type
    ty of
             Just Type
    ty' -> let err_ctxt :: SDoc
    err_ctxt = String -> SDoc
    text String
    "In the expansion of type synonym"
                                        SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc)
                         in SDoc -> TcM () -> TcM ()
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt SDoc
    err_ctxt (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
                            ValidityEnv -> Type -> TcM ()
    check_type (ValidityEnv
    ve{ve_expand :: ExpandMode
    ve_expand = ExpandMode
    expand}) Type
    ty'
             Maybe Type
    Nothing  -> String -> SDoc -> TcM ()
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "check_syn_tc_app" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty)

    {-
    Note [Unsaturated type synonyms in GHCi]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Generally speaking, GHC disallows unsaturated uses of type synonyms or type
    families. For instance, if one defines `type Const a b = a`, then GHC will not
    permit using `Const` unless it is applied to (at least) two arguments. There is
    an exception to this rule, however: GHCi's :kind command. For instance, it
    is quite common to look up the kind of a type constructor like so:

      λ> :kind Const
      Const :: j -> k -> j
      λ> :kind Const Int
      Const Int :: k -> Type

    Strictly speaking, the two uses of `Const` above are unsaturated, but this
    is an extremely benign (and useful) example of unsaturation, so we allow it
    here as a special case.

    That being said, we do not allow unsaturation carte blanche in GHCi. Otherwise,
    this GHCi interaction would be possible:

      λ> newtype Fix f = MkFix (f (Fix f))
      λ> type Id a = a
      λ> :kind Fix Id
      Fix Id :: Type

    This is rather dodgy, so we move to disallow this. We only permit unsaturated
    synonyms in GHCi if they are *top-level*—that is, if the synonym is the
    outermost type being applied. This allows `Const` and `Const Int` in the
    first example, but not `Fix Id` in the second example, as `Id` is not the
    outermost type being applied (`Fix` is).

    We track this outermost property in the GhciCtxt constructor of UserTypeCtxt.
    A field of True in GhciCtxt indicates that we're in an outermost position. Any
    time we invoke `check_arg` to check the validity of an argument, we switch the
    field to False.
    -}

    ----------------------------------------
    check_ubx_tuple :: ValidityEnv -> KindOrType -> [KindOrType] -> TcM ()
    check_ubx_tuple :: ValidityEnv -> Type -> [Type] -> TcM ()
    check_ubx_tuple (ve :: ValidityEnv
    ve@ValidityEnv{ve_tidy_env :: ValidityEnv -> TidyEnv
    ve_tidy_env = TidyEnv
    env}) Type
    ty [Type]
    tys
      = do  { Bool
    ub_tuples_allowed <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.UnboxedTuples
            ; Bool -> (TidyEnv, SDoc) -> TcM ()
    checkTcM Bool
    ub_tuples_allowed (TidyEnv -> Type -> (TidyEnv, SDoc)
    ubxArgTyErr TidyEnv
    env Type
    ty)

            ; Bool
    impred <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.ImpredicativeTypes
            ; let rank' :: Rank
    rank' = if Bool
    impred then Rank
    ArbitraryRank else Rank
    tyConArgMonoType
                    -- c.f. check_arg_type
                    -- However, args are allowed to be unlifted, or
                    -- more unboxed tuples, so can't use check_arg_ty
            ; (Type -> TcM ()) -> [Type] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (ValidityEnv -> Type -> TcM ()
    check_type (ValidityEnv
    ve{ve_rank :: Rank
    ve_rank = Rank
    rank'})) [Type]
    tys }

    ----------------------------------------
    check_arg_type
      :: Bool -- ^ Is this the argument to a type synonym?
      -> ValidityEnv -> KindOrType -> TcM ()
    -- The sort of type that can instantiate a type variable,
    -- or be the argument of a type constructor.
    -- Not an unboxed tuple, but now *can* be a forall (since impredicativity)
    -- Other unboxed types are very occasionally allowed as type
    -- arguments depending on the kind of the type constructor
    --
    -- For example, we want to reject things like:
    --
    --      instance Ord a => Ord (forall s. T s a)
    -- and
    --      g :: T s (forall b.b)
    --
    -- NB: unboxed tuples can have polymorphic or unboxed args.
    --     This happens in the workers for functions returning
    --     product types with polymorphic components.
    --     But not in user code.
    -- Anyway, they are dealt with by a special case in check_tau_type

    check_arg_type :: Bool -> ValidityEnv -> Type -> TcM ()
    check_arg_type Bool
    _ ValidityEnv
    _ (CoercionTy {}) = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    check_arg_type Bool
    type_syn (ve :: ValidityEnv
    ve@ValidityEnv{ve_ctxt :: ValidityEnv -> UserTypeCtxt
    ve_ctxt = UserTypeCtxt
    ctxt, ve_rank :: ValidityEnv -> Rank
    ve_rank = Rank
    rank}) Type
    ty
      = do  { Bool
    impred <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.ImpredicativeTypes
            ; let rank' :: Rank
    rank' = case Rank
    rank of          -- Predictive => must be monotype
                            -- Rank-n arguments to type synonyms are OK, provided
                            -- that LiberalTypeSynonyms is enabled.
                            Rank
    _ | Bool
    type_syn       -> Rank
    synArgMonoType
                            Rank
    MustBeMonoType     -> Rank
    MustBeMonoType  -- Monotype, regardless
                            Rank
    _other | Bool
    impred    -> Rank
    ArbitraryRank
                                   | Bool
    otherwise -> Rank
    tyConArgMonoType
                            -- Make sure that MustBeMonoType is propagated,
                            -- so that we don't suggest -XImpredicativeTypes in
                            --    (Ord (forall a.a)) => a -> a
                            -- and so that if it Must be a monotype, we check that it is!
                  ctxt' :: UserTypeCtxt
                  ctxt' :: UserTypeCtxt
    ctxt'
                    | GhciCtxt Bool
    _ <- UserTypeCtxt
    ctxt = Bool -> UserTypeCtxt
    GhciCtxt Bool
    False
                        -- When checking an argument, set the field of GhciCtxt to
                        -- False to indicate that we are no longer in an outermost
                        -- position (and thus unsaturated synonyms are no longer
                        -- allowed).
                        -- See Note [Unsaturated type synonyms in GHCi]
                    | Bool
    otherwise          = UserTypeCtxt
    ctxt

            ; ValidityEnv -> Type -> TcM ()
    check_type (ValidityEnv
    ve{ve_ctxt :: UserTypeCtxt
    ve_ctxt = UserTypeCtxt
    ctxt', ve_rank :: Rank
    ve_rank = Rank
    rank'}) Type
    ty }

    ----------------------------------------
    forAllTyErr :: TidyEnv -> Rank -> Type -> (TidyEnv, SDoc)
    forAllTyErr :: TidyEnv -> Rank -> Type -> (TidyEnv, SDoc)
    forAllTyErr TidyEnv
    env Rank
    rank Type
    ty
       = ( TidyEnv
    env
         , [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    herald Int
    2 (TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    ty)
                , SDoc
    suggestion ] )
      where
        ([TyCoVar]
    tvs, Type
    _rho) = Type -> ([TyCoVar], Type)
    tcSplitForAllTyVars Type
    ty
        herald :: SDoc
    herald | [TyCoVar] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyCoVar]
    tvs  = String -> SDoc
    text String
    "Illegal qualified type:"
               | Bool
    otherwise = String -> SDoc
    text String
    "Illegal polymorphic type:"
        suggestion :: SDoc
    suggestion = case Rank
    rank of
                       LimitedRank {} -> String -> SDoc
    text String
    "Perhaps you intended to use RankNTypes"
                       MonoType SDoc
    d     -> SDoc
    d
                       Rank
    _              -> SDoc
    Outputable.empty -- Polytype is always illegal

    -- | Reject type variables that would escape their escape through a kind.
    -- See @Note [Type variables escaping through kinds]@.
    checkEscapingKind :: TidyEnv -> [TyVarBinder] -> ThetaType -> Type -> TcM ()
    checkEscapingKind :: TidyEnv -> [TyVarBinder] -> [Type] -> Type -> TcM ()
    checkEscapingKind TidyEnv
    env [TyVarBinder]
    tvbs [Type]
    theta Type
    tau =
      case [TyCoVar] -> Type -> Maybe Type
    occCheckExpand ([TyVarBinder] -> [TyCoVar]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [TyVarBinder]
    tvbs) Type
    phi_kind of
        -- Ensure that none of the tvs occur in the kind of the forall
        -- /after/ expanding type synonyms.
        -- See Note [Phantom type variables in kinds] in GHC.Core.Type
        Maybe Type
    Nothing -> (TidyEnv, SDoc) -> TcM ()
    forall a. (TidyEnv, SDoc) -> TcM a
    failWithTcM ((TidyEnv, SDoc) -> TcM ()) -> (TidyEnv, SDoc) -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ TidyEnv
    -> [TyVarBinder] -> [Type] -> Type -> Type -> (TidyEnv, SDoc)
    forAllEscapeErr TidyEnv
    env [TyVarBinder]
    tvbs [Type]
    theta Type
    tau Type
    tau_kind
        Just Type
    _  -> () -> TcM ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      where
        tau_kind :: Type
    tau_kind              = HasDebugCallStack => Type -> Type
    Type -> Type
    tcTypeKind Type
    tau
        phi_kind :: Type
    phi_kind | [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    theta = Type
    tau_kind
                 | Bool
    otherwise  = Type
    liftedTypeKind
            -- If there are any constraints, the kind is *. (#11405)

    forAllEscapeErr :: TidyEnv -> [TyVarBinder] -> ThetaType -> Type -> Kind
                    -> (TidyEnv, SDoc)
    forAllEscapeErr :: TidyEnv
    -> [TyVarBinder] -> [Type] -> Type -> Type -> (TidyEnv, SDoc)
    forAllEscapeErr TidyEnv
    env [TyVarBinder]
    tvbs [Type]
    theta Type
    tau Type
    tau_kind
      = ( TidyEnv
    env
        , [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Quantified type's kind mentions quantified type variable")
                    Int
    2 (String -> SDoc
    text String
    "type:" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([TyVarBinder] -> [Type] -> Type -> Type
    mkSigmaTy [TyVarBinder]
    tvbs [Type]
    theta Type
    tau)))
                    -- NB: Don't tidy this type since the tvbs were already tidied
                    -- previously, and re-tidying them will make the names of type
                    -- variables different from tau_kind.
               , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "where the body of the forall has this kind:")
                    Int
    2 (SDoc -> SDoc
    quotes (TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    tau_kind)) ] )

    {-
    Note [Type variables escaping through kinds]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider:

      type family T (r :: RuntimeRep) :: TYPE r
      foo :: forall r. T r

    Something smells funny about the type of `foo`. If you spell out the kind
    explicitly, it becomes clearer from where the smell originates:

      foo :: ((forall r. T r) :: TYPE r)

    The type variable `r` appears in the result kind, which escapes the scope of
    its binding site! This is not desirable, so we establish a validity check
    (`checkEscapingKind`) to catch any type variables that might escape through
    kinds in this way.
    -}

    ubxArgTyErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    ubxArgTyErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    ubxArgTyErr TidyEnv
    env Type
    ty
      = ( TidyEnv
    env, [SDoc] -> SDoc
    vcat [ [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Illegal unboxed tuple type as function argument:"
                          , TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    ty ]
                    , String -> SDoc
    text String
    "Perhaps you intended to use UnboxedTuples" ] )

    checkConstraintsOK :: ValidityEnv -> ThetaType -> Type -> TcM ()
    checkConstraintsOK :: ValidityEnv -> [Type] -> Type -> TcM ()
    checkConstraintsOK ValidityEnv
    ve [Type]
    theta Type
    ty
      | [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    theta                         = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | UserTypeCtxt -> Bool
    allConstraintsAllowed (ValidityEnv -> UserTypeCtxt
    ve_ctxt ValidityEnv
    ve) = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | Bool
    otherwise
      = -- We are in a kind, where we allow only equality predicates
        -- See Note [Constraints in kinds] in GHC.Core.TyCo.Rep, and #16263
        Bool -> (TidyEnv, SDoc) -> TcM ()
    checkTcM ((Type -> Bool) -> [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Type -> Bool
    isEqPred [Type]
    theta) ((TidyEnv, SDoc) -> TcM ()) -> (TidyEnv, SDoc) -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
        TidyEnv -> Type -> (TidyEnv, SDoc)
    constraintTyErr (ValidityEnv -> TidyEnv
    ve_tidy_env ValidityEnv
    ve) Type
    ty

    constraintTyErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    constraintTyErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    constraintTyErr TidyEnv
    env Type
    ty
      = (TidyEnv
    env, String -> SDoc
    text String
    "Illegal constraint in a kind:" SDoc -> SDoc -> SDoc
    <+> TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    ty)

    -- | Reject a use of visible, dependent quantification in the type of a term.
    illegalVDQTyErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    illegalVDQTyErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    illegalVDQTyErr TidyEnv
    env Type
    ty =
      (TidyEnv
    env, [SDoc] -> SDoc
    vcat
      [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Illegal visible, dependent quantification" SDoc -> SDoc -> SDoc
    <+>
              String -> SDoc
    text String
    "in the type of a term:")
           Int
    2 (TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    ty)
      , String -> SDoc
    text String
    "(GHC does not yet support this)" ] )

    -- | Reject uses of linear function arrows in kinds.
    linearFunKindErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    linearFunKindErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    linearFunKindErr TidyEnv
    env Type
    ty =
      (TidyEnv
    env, String -> SDoc
    text String
    "Illegal linear function in a kind:" SDoc -> SDoc -> SDoc
    <+> TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    ty)

    {-
    Note [Liberal type synonyms]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If -XLiberalTypeSynonyms is on, expand closed type synonyms *before*
    doing validity checking.  This allows us to instantiate a synonym defn
    with a for-all type, or with a partially-applied type synonym.
            e.g.   type T a b = a
                   type S m   = m ()
                   f :: S (T Int)
    Here, T is partially applied, so it's illegal in H98.  But if you
    expand S first, then T we get just
                   f :: Int
    which is fine.

    IMPORTANT: suppose T is a type synonym.  Then we must do validity
    checking on an application (T ty1 ty2)

            *either* before expansion (i.e. check ty1, ty2)
            *or* after expansion (i.e. expand T ty1 ty2, and then check)
            BUT NOT BOTH

    If we do both, we get exponential behaviour!!

      data TIACons1 i r c = c i ::: r c
      type TIACons2 t x = TIACons1 t (TIACons1 t x)
      type TIACons3 t x = TIACons2 t (TIACons1 t x)
      type TIACons4 t x = TIACons2 t (TIACons2 t x)
      type TIACons7 t x = TIACons4 t (TIACons3 t x)

    The order in which you do validity checking is also somewhat delicate. Consider
    the `check_type` function, which drives the validity checking for unsaturated
    uses of type synonyms. There is a special case for rank-n types, such as
    (forall x. x -> x) or (Show x => x), since those require at least one language
    extension to use. It used to be the case that this case came before every other
    case, but this can lead to bugs. Imagine you have this scenario (from #15954):

      type A a = Int
      type B (a :: Type -> Type) = forall x. x -> x
      type C = B A

    If the rank-n case came first, then in the process of checking for `forall`s
    or contexts, we would expand away `B A` to `forall x. x -> x`. This is because
    the functions that split apart `forall`s/contexts
    (tcSplitForAllTyVarBinders/tcSplitPhiTy) expand type synonyms! If `B A` is expanded
    away to `forall x. x -> x` before the actually validity checks occur, we will
    have completely obfuscated the fact that we had an unsaturated application of
    the `A` type synonym.

    We have since learned from our mistakes and now put this rank-n case /after/
    the case for TyConApp, which ensures that an unsaturated `A` TyConApp will be
    caught properly. But be careful! We can't make the rank-n case /last/ either,
    as the FunTy case must came after the rank-n case. Otherwise, something like
    (Eq a => Int) would be treated as a function type (FunTy), which just
    wouldn't do.

    ************************************************************************
    *                                                                      *
    \subsection{Checking a theta or source type}
    *                                                                      *
    ************************************************************************

    Note [Implicit parameters in instance decls]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Implicit parameters _only_ allowed in type signatures; not in instance
    decls, superclasses etc. The reason for not allowing implicit params in
    instances is a bit subtle.  If we allowed
      instance (?x::Int, Eq a) => Foo [a] where ...
    then when we saw
         (e :: (?x::Int) => t)
    it would be unclear how to discharge all the potential uses of the ?x
    in e.  For example, a constraint Foo [Int] might come out of e, and
    applying the instance decl would show up two uses of ?x.  #8912.
    -}

    checkValidTheta :: UserTypeCtxt -> ThetaType -> TcM ()
    -- Assumes argument is fully zonked
    checkValidTheta :: UserTypeCtxt -> [Type] -> TcM ()
    checkValidTheta UserTypeCtxt
    ctxt [Type]
    theta
      = (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM () -> TcM ()
    forall a. (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    addErrCtxtM (UserTypeCtxt -> [Type] -> TidyEnv -> TcM (TidyEnv, SDoc)
    checkThetaCtxt UserTypeCtxt
    ctxt [Type]
    theta) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
        do { TidyEnv
    env <- [TyCoVar] -> TcM TidyEnv
    tcInitOpenTidyEnv ([Type] -> [TyCoVar]
    tyCoVarsOfTypesList [Type]
    theta)
           ; ExpandMode
    expand <- TcM ExpandMode
    initialExpandMode
           ; TidyEnv -> UserTypeCtxt -> ExpandMode -> [Type] -> TcM ()
    check_valid_theta TidyEnv
    env UserTypeCtxt
    ctxt ExpandMode
    expand [Type]
    theta }

    -------------------------
    check_valid_theta :: TidyEnv -> UserTypeCtxt -> ExpandMode
                      -> [PredType] -> TcM ()
    check_valid_theta :: TidyEnv -> UserTypeCtxt -> ExpandMode -> [Type] -> TcM ()
    check_valid_theta TidyEnv
    _ UserTypeCtxt
    _ ExpandMode
    _ []
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    check_valid_theta TidyEnv
    env UserTypeCtxt
    ctxt ExpandMode
    expand [Type]
    theta
      = do { DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; WarnReason -> Bool -> (TidyEnv, SDoc) -> TcM ()
    warnTcM (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnDuplicateConstraints)
                     (WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnDuplicateConstraints DynFlags
    dflags Bool -> Bool -> Bool
    && [NonEmpty Type] -> Bool
    forall (f :: * -> *) a. Foldable f => f a -> Bool
    notNull [NonEmpty Type]
    dups)
                     (TidyEnv -> [NonEmpty Type] -> (TidyEnv, SDoc)
    dupPredWarn TidyEnv
    env [NonEmpty Type]
    dups)
           ; String -> SDoc -> TcM ()
    traceTc String
    "check_valid_theta" ([Type] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Type]
    theta)
           ; (Type -> TcM ()) -> [Type] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (TidyEnv -> DynFlags -> UserTypeCtxt -> ExpandMode -> Type -> TcM ()
    check_pred_ty TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt ExpandMode
    expand) [Type]
    theta }
      where
        ([Type]
    _,[NonEmpty Type]
    dups) = (Type -> Type -> Ordering) -> [Type] -> ([Type], [NonEmpty Type])
    forall a. (a -> a -> Ordering) -> [a] -> ([a], [NonEmpty a])
    removeDups Type -> Type -> Ordering
    nonDetCmpType [Type]
    theta
        -- It's OK to use nonDetCmpType because dups only appears in the
        -- warning

    -------------------------
    {- Note [Validity checking for constraints]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We look through constraint synonyms so that we can see the underlying
    constraint(s).  For example
       type Foo = ?x::Int
       instance Foo => C T
    We should reject the instance because it has an implicit parameter in
    the context.

    But we record, in 'under_syn', whether we have looked under a synonym
    to avoid requiring language extensions at the use site.  Main example
    (#9838):

       {-# LANGUAGE ConstraintKinds #-}
       module A where
          type EqShow a = (Eq a, Show a)

       module B where
          import A
          foo :: EqShow a => a -> String

    We don't want to require ConstraintKinds in module B.
    -}

    check_pred_ty :: TidyEnv -> DynFlags -> UserTypeCtxt -> ExpandMode
                  -> PredType -> TcM ()
    -- Check the validity of a predicate in a signature
    -- See Note [Validity checking for constraints]
    check_pred_ty :: TidyEnv -> DynFlags -> UserTypeCtxt -> ExpandMode -> Type -> TcM ()
    check_pred_ty TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt ExpandMode
    expand Type
    pred
      = do { ValidityEnv -> Type -> TcM ()
    check_type ValidityEnv
    ve Type
    pred
           ; Bool -> TidyEnv -> DynFlags -> UserTypeCtxt -> Type -> TcM ()
    check_pred_help Bool
    False TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt Type
    pred }
      where
        rank :: Rank
    rank | Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.QuantifiedConstraints DynFlags
    dflags
             = Rank
    ArbitraryRank
             | Bool
    otherwise
             = Rank
    constraintMonoType

        ve :: ValidityEnv
        ve :: ValidityEnv
    ve = ValidityEnv{ ve_tidy_env :: TidyEnv
    ve_tidy_env = TidyEnv
    env
                        , ve_ctxt :: UserTypeCtxt
    ve_ctxt     = UserTypeCtxt
    SigmaCtxt
                        , ve_rank :: Rank
    ve_rank     = Rank
    rank
                        , ve_expand :: ExpandMode
    ve_expand   = ExpandMode
    expand }

    check_pred_help :: Bool    -- True <=> under a type synonym
                    -> TidyEnv
                    -> DynFlags -> UserTypeCtxt
                    -> PredType -> TcM ()
    check_pred_help :: Bool -> TidyEnv -> DynFlags -> UserTypeCtxt -> Type -> TcM ()
    check_pred_help Bool
    under_syn TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt Type
    pred
      | Just Type
    pred' <- Type -> Maybe Type
    tcView Type
    pred  -- Switch on under_syn when going under a
                                     -- synonym (#9838, yuk)
      = Bool -> TidyEnv -> DynFlags -> UserTypeCtxt -> Type -> TcM ()
    check_pred_help Bool
    True TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt Type
    pred'

      | Bool
    otherwise  -- A bit like classifyPredType, but not the same
                   -- E.g. we treat (~) like (~#); and we look inside tuples
      = case Type -> Pred
    classifyPredType Type
    pred of
          ClassPred Class
    cls [Type]
    tys
            | Class -> Bool
    isCTupleClass Class
    cls   -> Bool
    -> TidyEnv -> DynFlags -> UserTypeCtxt -> Type -> [Type] -> TcM ()
    check_tuple_pred Bool
    under_syn TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt Type
    pred [Type]
    tys
            | Bool
    otherwise           -> TidyEnv
    -> DynFlags -> UserTypeCtxt -> Type -> Class -> [Type] -> TcM ()
    check_class_pred TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt Type
    pred Class
    cls [Type]
    tys

          EqPred EqRel
    _ Type
    _ Type
    _      -> String -> SDoc -> TcM ()
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "check_pred_help" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    pred)
                  -- EqPreds, such as (t1 ~ #t2) or (t1 ~R# t2), don't even have kind Constraint
                  -- and should never appear before the '=>' of a type.  Thus
                  --     f :: (a ~# b) => blah
                  -- is wrong.  For user written signatures, it'll be rejected by kind-checking
                  -- well before we get to validity checking.  For inferred types we are careful
                  -- to box such constraints in GHC.Tc.Utils.TcType.pickQuantifiablePreds, as described
                  -- in Note [Lift equality constraints when quantifying] in GHC.Tc.Utils.TcType

          ForAllPred [TyCoVar]
    _ [Type]
    theta Type
    head -> TidyEnv
    -> DynFlags -> UserTypeCtxt -> Type -> [Type] -> Type -> TcM ()
    check_quant_pred TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt Type
    pred [Type]
    theta Type
    head
          IrredPred {}            -> Bool -> TidyEnv -> DynFlags -> Type -> TcM ()
    check_irred_pred Bool
    under_syn TidyEnv
    env DynFlags
    dflags Type
    pred

    check_eq_pred :: TidyEnv -> DynFlags -> PredType -> TcM ()
    check_eq_pred :: TidyEnv -> DynFlags -> Type -> TcM ()
    check_eq_pred TidyEnv
    env DynFlags
    dflags Type
    pred
      =         -- Equational constraints are valid in all contexts if type
                -- families are permitted
        Bool -> (TidyEnv, SDoc) -> TcM ()
    checkTcM (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.TypeFamilies DynFlags
    dflags
                  Bool -> Bool -> Bool
    || Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.GADTs DynFlags
    dflags)
                 (TidyEnv -> Type -> (TidyEnv, SDoc)
    eqPredTyErr TidyEnv
    env Type
    pred)

    check_quant_pred :: TidyEnv -> DynFlags -> UserTypeCtxt
                     -> PredType -> ThetaType -> PredType -> TcM ()
    check_quant_pred :: TidyEnv
    -> DynFlags -> UserTypeCtxt -> Type -> [Type] -> Type -> TcM ()
    check_quant_pred TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt Type
    pred [Type]
    theta Type
    head_pred
      = SDoc -> TcM () -> TcM ()
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (String -> SDoc
    text String
    "In the quantified constraint" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    pred)) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
        do { -- Check the instance head
             case Type -> Pred
    classifyPredType Type
    head_pred of
                                     -- SigmaCtxt tells checkValidInstHead that
                                     -- this is the head of a quantified constraint
                ClassPred Class
    cls [Type]
    tys -> do { UserTypeCtxt -> Class -> [Type] -> TcM ()
    checkValidInstHead UserTypeCtxt
    SigmaCtxt Class
    cls [Type]
    tys
                                        ; Bool -> TidyEnv -> DynFlags -> UserTypeCtxt -> Type -> TcM ()
    check_pred_help Bool
    False TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt Type
    head_pred }
                                   -- need check_pred_help to do extra pred-only validity
                                   -- checks, such as for (~). Otherwise, we get #17563
                                   -- NB: checks for the context are covered by the check_type
                                   -- in check_pred_ty
                IrredPred {}      | Type -> Bool
    hasTyVarHead Type
    head_pred
                                  -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                Pred
    _                 -> (TidyEnv, SDoc) -> TcM ()
    forall a. (TidyEnv, SDoc) -> TcM a
    failWithTcM (TidyEnv -> Type -> (TidyEnv, SDoc)
    badQuantHeadErr TidyEnv
    env Type
    pred)

             -- Check for termination
           ; Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.UndecidableInstances DynFlags
    dflags) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
             [Type] -> Type -> TcM ()
    checkInstTermination [Type]
    theta Type
    head_pred
        }

    check_tuple_pred :: Bool -> TidyEnv -> DynFlags -> UserTypeCtxt -> PredType -> [PredType] -> TcM ()
    check_tuple_pred :: Bool
    -> TidyEnv -> DynFlags -> UserTypeCtxt -> Type -> [Type] -> TcM ()
    check_tuple_pred Bool
    under_syn TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt Type
    pred [Type]
    ts
      = do { -- See Note [ConstraintKinds in predicates]
             Bool -> (TidyEnv, SDoc) -> TcM ()
    checkTcM (Bool
    under_syn Bool -> Bool -> Bool
    || Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.ConstraintKinds DynFlags
    dflags)
                      (TidyEnv -> Type -> (TidyEnv, SDoc)
    predTupleErr TidyEnv
    env Type
    pred)
           ; (Type -> TcM ()) -> [Type] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Bool -> TidyEnv -> DynFlags -> UserTypeCtxt -> Type -> TcM ()
    check_pred_help Bool
    under_syn TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt) [Type]
    ts }
        -- This case will not normally be executed because without
        -- -XConstraintKinds tuple types are only kind-checked as *

    check_irred_pred :: Bool -> TidyEnv -> DynFlags -> PredType -> TcM ()
    check_irred_pred :: Bool -> TidyEnv -> DynFlags -> Type -> TcM ()
    check_irred_pred Bool
    under_syn TidyEnv
    env DynFlags
    dflags Type
    pred
        -- The predicate looks like (X t1 t2) or (x t1 t2) :: Constraint
        -- where X is a type function
      =      -- If it looks like (x t1 t2), require ConstraintKinds
             --   see Note [ConstraintKinds in predicates]
             -- But (X t1 t2) is always ok because we just require ConstraintKinds
             -- at the definition site (#9838)
        Bool -> (TidyEnv, SDoc) -> TcM ()
    failIfTcM (Bool -> Bool
    not Bool
    under_syn Bool -> Bool -> Bool
    && Bool -> Bool
    not (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.ConstraintKinds DynFlags
    dflags)
                                Bool -> Bool -> Bool
    && Type -> Bool
    hasTyVarHead Type
    pred)
                  (TidyEnv -> Type -> (TidyEnv, SDoc)
    predIrredErr TidyEnv
    env Type
    pred)

    {- Note [ConstraintKinds in predicates]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Don't check for -XConstraintKinds under a type synonym, because that
    was done at the type synonym definition site; see #9838
    e.g.   module A where
              type C a = (Eq a, Ix a)   -- Needs -XConstraintKinds
           module B where
              import A
              f :: C a => a -> a        -- Does *not* need -XConstraintKinds
    -}

    -------------------------
    check_class_pred :: TidyEnv -> DynFlags -> UserTypeCtxt
                     -> PredType -> Class -> [TcType] -> TcM ()
    check_class_pred :: TidyEnv
    -> DynFlags -> UserTypeCtxt -> Type -> Class -> [Type] -> TcM ()
    check_class_pred TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt Type
    pred Class
    cls [Type]
    tys
      | Class -> Bool
    isEqPredClass Class
    cls    -- (~) and (~~) are classified as classes,
                             -- but here we want to treat them as equalities
      = TidyEnv -> DynFlags -> Type -> TcM ()
    check_eq_pred TidyEnv
    env DynFlags
    dflags Type
    pred

      | Class -> Bool
    isIPClass Class
    cls
      = do { TcM ()
    check_arity
           ; Bool -> (TidyEnv, SDoc) -> TcM ()
    checkTcM (UserTypeCtxt -> Bool
    okIPCtxt UserTypeCtxt
    ctxt) (TidyEnv -> Type -> (TidyEnv, SDoc)
    badIPPred TidyEnv
    env Type
    pred) }

      | Bool
    otherwise     -- Includes Coercible
      = do { TcM ()
    check_arity
           ; TidyEnv -> DynFlags -> UserTypeCtxt -> Class -> [Type] -> TcM ()
    checkSimplifiableClassConstraint TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt Class
    cls [Type]
    tys
           ; Bool -> (TidyEnv, SDoc) -> TcM ()
    checkTcM Bool
    arg_tys_ok (TidyEnv -> Type -> (TidyEnv, SDoc)
    predTyVarErr TidyEnv
    env Type
    pred) }
      where
        check_arity :: TcM ()
    check_arity = Bool -> SDoc -> TcM ()
    checkTc ([Type]
    tys [Type] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthIs` Class -> Int
    classArity Class
    cls)
                              (TyCon -> [Type] -> SDoc
    tyConArityErr (Class -> TyCon
    classTyCon Class
    cls) [Type]
    tys)

        -- Check the arguments of a class constraint
        flexible_contexts :: Bool
    flexible_contexts = Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.FlexibleContexts     DynFlags
    dflags
        arg_tys_ok :: Bool
    arg_tys_ok = case UserTypeCtxt
    ctxt of
            UserTypeCtxt
    SpecInstCtxt -> Bool
    True    -- {-# SPECIALISE instance Eq (T Int) #-} is fine
            InstDeclCtxt {} -> Bool -> Class -> [Type] -> Bool
    checkValidClsArgs Bool
    flexible_contexts Class
    cls [Type]
    tys
                                    -- Further checks on head and theta
                                    -- in checkInstTermination
            UserTypeCtxt
    _               -> Bool -> Class -> [Type] -> Bool
    checkValidClsArgs Bool
    flexible_contexts Class
    cls [Type]
    tys

    checkSimplifiableClassConstraint :: TidyEnv -> DynFlags -> UserTypeCtxt
                                     -> Class -> [TcType] -> TcM ()
    -- See Note [Simplifiable given constraints]
    checkSimplifiableClassConstraint :: TidyEnv -> DynFlags -> UserTypeCtxt -> Class -> [Type] -> TcM ()
    checkSimplifiableClassConstraint TidyEnv
    env DynFlags
    dflags UserTypeCtxt
    ctxt Class
    cls [Type]
    tys
      | Bool -> Bool
    not (WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnSimplifiableClassConstraints DynFlags
    dflags)
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.MonoLocalBinds DynFlags
    dflags
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

      | DataTyCtxt {} <- UserTypeCtxt
    ctxt   -- Don't do this check for the "stupid theta"
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()               -- of a data type declaration

      | Class
    cls Class -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    coercibleTyConKey
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()   -- Oddly, we treat (Coercible t1 t2) as unconditionally OK
                    -- matchGlobalInst will reply "yes" because we can reduce
                    -- (Coercible a b) to (a ~R# b)

      | Bool
    otherwise
      = do { ClsInstResult
    result <- DynFlags -> Bool -> Class -> [Type] -> TcM ClsInstResult
    matchGlobalInst DynFlags
    dflags Bool
    False Class
    cls [Type]
    tys
           ; case ClsInstResult
    result of
               OneInst { cir_what :: ClsInstResult -> InstanceWhat
    cir_what = InstanceWhat
    what }
                  -> WarnReason -> SDoc -> TcM ()
    addWarnTc (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnSimplifiableClassConstraints)
                                       (InstanceWhat -> SDoc
    simplifiable_constraint_warn InstanceWhat
    what)
               ClsInstResult
    _          -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () }
      where
        pred :: Type
    pred = Class -> [Type] -> Type
    mkClassPred Class
    cls [Type]
    tys

        simplifiable_constraint_warn :: InstanceWhat -> SDoc
        simplifiable_constraint_warn :: InstanceWhat -> SDoc
    simplifiable_constraint_warn InstanceWhat
    what
         = [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "The constraint" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TidyEnv -> Type -> Type
    tidyType TidyEnv
    env Type
    pred))
                        SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "matches")
                     Int
    2 (InstanceWhat -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr InstanceWhat
    what)
                , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "This makes type inference for inner bindings fragile;")
                     Int
    2 (String -> SDoc
    text String
    "either use MonoLocalBinds, or simplify it using the instance") ]

    {- Note [Simplifiable given constraints]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    A type signature like
       f :: Eq [(a,b)] => a -> b
    is very fragile, for reasons described at length in GHC.Tc.Solver.Interact
    Note [Instance and Given overlap].  As that Note discusses, for the
    most part the clever stuff in GHC.Tc.Solver.Interact means that we don't use a
    top-level instance if a local Given might fire, so there is no
    fragility. But if we /infer/ the type of a local let-binding, things
    can go wrong (#11948 is an example, discussed in the Note).

    So this warning is switched on only if we have NoMonoLocalBinds; in
    that case the warning discourages users from writing simplifiable
    class constraints.

    The warning only fires if the constraint in the signature
    matches the top-level instances in only one way, and with no
    unifiers -- that is, under the same circumstances that
    GHC.Tc.Solver.Interact.matchInstEnv fires an interaction with the top
    level instances.  For example (#13526), consider

      instance {-# OVERLAPPABLE #-} Eq (T a) where ...
      instance                   Eq (T Char) where ..
      f :: Eq (T a) => ...

    We don't want to complain about this, even though the context
    (Eq (T a)) matches an instance, because the user may be
    deliberately deferring the choice so that the Eq (T Char)
    has a chance to fire when 'f' is called.  And the fragility
    only matters when there's a risk that the instance might
    fire instead of the local 'given'; and there is no such
    risk in this case.  Just use the same rules as for instance
    firing!
    -}

    -------------------------
    okIPCtxt :: UserTypeCtxt -> Bool
      -- See Note [Implicit parameters in instance decls]
    okIPCtxt :: UserTypeCtxt -> Bool
    okIPCtxt (FunSigCtxt {})        = Bool
    True
    okIPCtxt (InfSigCtxt {})        = Bool
    True
    okIPCtxt UserTypeCtxt
    ExprSigCtxt            = Bool
    True
    okIPCtxt UserTypeCtxt
    TypeAppCtxt            = Bool
    True
    okIPCtxt UserTypeCtxt
    PatSigCtxt             = Bool
    True
    okIPCtxt UserTypeCtxt
    GenSigCtxt             = Bool
    True
    okIPCtxt (ConArgCtxt {})        = Bool
    True
    okIPCtxt (ForSigCtxt {})        = Bool
    True  -- ??
    okIPCtxt (GhciCtxt {})          = Bool
    True
    okIPCtxt UserTypeCtxt
    SigmaCtxt              = Bool
    True
    okIPCtxt (DataTyCtxt {})        = Bool
    True
    okIPCtxt (PatSynCtxt {})        = Bool
    True
    okIPCtxt (TySynCtxt {})         = Bool
    True   -- e.g.   type Blah = ?x::Int
                                             -- #11466

    okIPCtxt (KindSigCtxt {})       = Bool
    False
    okIPCtxt (StandaloneKindSigCtxt {}) = Bool
    False
    okIPCtxt (ClassSCCtxt {})       = Bool
    False
    okIPCtxt (InstDeclCtxt {})      = Bool
    False
    okIPCtxt (SpecInstCtxt {})      = Bool
    False
    okIPCtxt (RuleSigCtxt {})       = Bool
    False
    okIPCtxt UserTypeCtxt
    DefaultDeclCtxt        = Bool
    False
    okIPCtxt UserTypeCtxt
    DerivClauseCtxt        = Bool
    False
    okIPCtxt (TyVarBndrKindCtxt {}) = Bool
    False
    okIPCtxt (DataKindCtxt {})      = Bool
    False
    okIPCtxt (TySynKindCtxt {})     = Bool
    False
    okIPCtxt (TyFamResKindCtxt {})  = Bool
    False

    {-
    Note [Kind polymorphic type classes]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    MultiParam check:

        class C f where...   -- C :: forall k. k -> Constraint
        instance C Maybe where...

      The dictionary gets type [C * Maybe] even if it's not a MultiParam
      type class.

    Flexibility check:

        class C f where...   -- C :: forall k. k -> Constraint
        data D a = D a
        instance C D where

      The dictionary gets type [C * (D *)]. IA0_TODO it should be
      generalized actually.
    -}

    checkThetaCtxt :: UserTypeCtxt -> ThetaType -> TidyEnv -> TcM (TidyEnv, SDoc)
    checkThetaCtxt :: UserTypeCtxt -> [Type] -> TidyEnv -> TcM (TidyEnv, SDoc)
    checkThetaCtxt UserTypeCtxt
    ctxt [Type]
    theta TidyEnv
    env
      = (TidyEnv, SDoc) -> TcM (TidyEnv, SDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( TidyEnv
    env
               , [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "In the context:" SDoc -> SDoc -> SDoc
    <+> [Type] -> SDoc
    pprTheta (TidyEnv -> [Type] -> [Type]
    tidyTypes TidyEnv
    env [Type]
    theta)
                      , String -> SDoc
    text String
    "While checking" SDoc -> SDoc -> SDoc
    <+> UserTypeCtxt -> SDoc
    pprUserTypeCtxt UserTypeCtxt
    ctxt ] )

    eqPredTyErr, predTupleErr, predIrredErr,
       badQuantHeadErr :: TidyEnv -> PredType -> (TidyEnv, SDoc)
    badQuantHeadErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    badQuantHeadErr TidyEnv
    env Type
    pred
      = ( TidyEnv
    env
        , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Quantified predicate must have a class or type variable head:")
             Int
    2 (TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    pred) )
    eqPredTyErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    eqPredTyErr  TidyEnv
    env Type
    pred
      = ( TidyEnv
    env
        , String -> SDoc
    text String
    "Illegal equational constraint" SDoc -> SDoc -> SDoc
    <+> TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    pred SDoc -> SDoc -> SDoc
    $$
          SDoc -> SDoc
    parens (String -> SDoc
    text String
    "Use GADTs or TypeFamilies to permit this") )
    predTupleErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    predTupleErr TidyEnv
    env Type
    pred
      = ( TidyEnv
    env
        , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Illegal tuple constraint:" SDoc -> SDoc -> SDoc
    <+> TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    pred)
             Int
    2 (SDoc -> SDoc
    parens SDoc
    constraintKindsMsg) )
    predIrredErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    predIrredErr TidyEnv
    env Type
    pred
      = ( TidyEnv
    env
        , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Illegal constraint:" SDoc -> SDoc -> SDoc
    <+> TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    pred)
             Int
    2 (SDoc -> SDoc
    parens SDoc
    constraintKindsMsg) )

    predTyVarErr :: TidyEnv -> PredType -> (TidyEnv, SDoc)
    predTyVarErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    predTyVarErr TidyEnv
    env Type
    pred
      = (TidyEnv
    env
        , [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Non type-variable argument")
                    Int
    2 (String -> SDoc
    text String
    "in the constraint:" SDoc -> SDoc -> SDoc
    <+> TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    pred)
               , SDoc -> SDoc
    parens (String -> SDoc
    text String
    "Use FlexibleContexts to permit this") ])

    badIPPred :: TidyEnv -> PredType -> (TidyEnv, SDoc)
    badIPPred :: TidyEnv -> Type -> (TidyEnv, SDoc)
    badIPPred TidyEnv
    env Type
    pred
      = ( TidyEnv
    env
        , String -> SDoc
    text String
    "Illegal implicit parameter" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    pred) )

    constraintSynErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    constraintSynErr :: TidyEnv -> Type -> (TidyEnv, SDoc)
    constraintSynErr TidyEnv
    env Type
    kind
      = ( TidyEnv
    env
        , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Illegal constraint synonym of kind:" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    kind))
             Int
    2 (SDoc -> SDoc
    parens SDoc
    constraintKindsMsg) )

    dupPredWarn :: TidyEnv -> [NE.NonEmpty PredType] -> (TidyEnv, SDoc)
    dupPredWarn :: TidyEnv -> [NonEmpty Type] -> (TidyEnv, SDoc)
    dupPredWarn TidyEnv
    env [NonEmpty Type]
    dups
      = ( TidyEnv
    env
        , String -> SDoc
    text String
    "Duplicate constraint" SDoc -> SDoc -> SDoc
    <> [Type] -> SDoc
    forall a. [a] -> SDoc
    plural [Type]
    primaryDups SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    ":"
          SDoc -> SDoc -> SDoc
    <+> (Type -> SDoc) -> [Type] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas (TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env) [Type]
    primaryDups )
      where
        primaryDups :: [Type]
    primaryDups = (NonEmpty Type -> Type) -> [NonEmpty Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map NonEmpty Type -> Type
    forall a. NonEmpty a -> a
    NE.head [NonEmpty Type]
    dups

    tyConArityErr :: TyCon -> [TcType] -> SDoc
    -- For type-constructor arity errors, be careful to report
    -- the number of /visible/ arguments required and supplied,
    -- ignoring the /invisible/ arguments, which the user does not see.
    -- (e.g. #10516)
    tyConArityErr :: TyCon -> [Type] -> SDoc
    tyConArityErr TyCon
    tc [Type]
    tks
      = SDoc -> Name -> Int -> Int -> SDoc
    forall a. Outputable a => SDoc -> a -> Int -> Int -> SDoc
    arityErr (TyConFlavour -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> TyConFlavour
    tyConFlavour TyCon
    tc)) (TyCon -> Name
    tyConName TyCon
    tc)
                 Int
    tc_type_arity Int
    tc_type_args
      where
        vis_tks :: [Type]
    vis_tks = TyCon -> [Type] -> [Type]
    filterOutInvisibleTypes TyCon
    tc [Type]
    tks

        -- tc_type_arity = number of *type* args expected
        -- tc_type_args  = number of *type* args encountered
        tc_type_arity :: Int
    tc_type_arity = (VarBndr TyCoVar TyConBndrVis -> Bool)
    -> [VarBndr TyCoVar TyConBndrVis] -> Int
    forall a. (a -> Bool) -> [a] -> Int
    count VarBndr TyCoVar TyConBndrVis -> Bool
    forall tv. VarBndr tv TyConBndrVis -> Bool
    isVisibleTyConBinder (TyCon -> [VarBndr TyCoVar TyConBndrVis]
    tyConBinders TyCon
    tc)
        tc_type_args :: Int
    tc_type_args  = [Type] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    vis_tks

    arityErr :: Outputable a => SDoc -> a -> Int -> Int -> SDoc
    arityErr :: forall a. Outputable a => SDoc -> a -> Int -> Int -> SDoc
    arityErr SDoc
    what a
    name Int
    n Int
    m
      = [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> SDoc
    what, SDoc -> SDoc
    quotes (a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    name), String -> SDoc
    text String
    "should have",
               SDoc
    n_arguments SDoc -> SDoc -> SDoc
    <> SDoc
    comma, String -> SDoc
    text String
    "but has been given",
               if Int
    mInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    0 then String -> SDoc
    text String
    "none" else Int -> SDoc
    int Int
    m]
        where
            n_arguments :: SDoc
    n_arguments | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = String -> SDoc
    text String
    "no arguments"
                        | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 = String -> SDoc
    text String
    "1 argument"
                        | Bool
    True   = [SDoc] -> SDoc
    hsep [Int -> SDoc
    int Int
    n, String -> SDoc
    text String
    "arguments"]

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Checking for a decent instance head type}
    *                                                                      *
    ************************************************************************

    @checkValidInstHead@ checks the type {\em and} its syntactic constraints:
    it must normally look like: @instance Foo (Tycon a b c ...) ...@

    The exceptions to this syntactic checking: (1)~if the @GlasgowExts@
    flag is on, or (2)~the instance is imported (they must have been
    compiled elsewhere). In these cases, we let them go through anyway.

    We can also have instances for functions: @instance Foo (a -> b) ...@.
    -}

    checkValidInstHead :: UserTypeCtxt -> Class -> [Type] -> TcM ()
    checkValidInstHead :: UserTypeCtxt -> Class -> [Type] -> TcM ()
    checkValidInstHead UserTypeCtxt
    ctxt Class
    clas [Type]
    cls_args
      = do { DynFlags
    dflags   <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; Bool
    is_boot  <- TcRnIf TcGblEnv TcLclEnv Bool
    tcIsHsBootOrSig
           ; Bool
    is_sig   <- TcRnIf TcGblEnv TcLclEnv Bool
    tcIsHsig
           ; DynFlags
    -> Bool -> Bool -> UserTypeCtxt -> Class -> [Type] -> TcM ()
    check_special_inst_head DynFlags
    dflags Bool
    is_boot Bool
    is_sig UserTypeCtxt
    ctxt Class
    clas [Type]
    cls_args
           ; TyCon -> [Type] -> TcM ()
    checkValidTypePats (Class -> TyCon
    classTyCon Class
    clas) [Type]
    cls_args
           }

    {-

    Note [Instances of built-in classes in signature files]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    User defined instances for KnownNat, KnownSymbol and Typeable are
    disallowed -- they are generated when needed by GHC itself on-the-fly.

    However, if they occur in a Backpack signature file, they have an
    entirely different meaning. Suppose in M.hsig we see

      signature M where
        data T :: Nat
        instance KnownNat T

    That says that any module satisfying M.hsig must provide a KnownNat
    instance for T.  We absolultely need that instance when compiling a
    module that imports M.hsig: see #15379 and
    Note [Fabricating Evidence for Literals in Backpack] in GHC.Tc.Instance.Class.

    Hence, checkValidInstHead accepts a user-written instance declaration
    in hsig files, where `is_sig` is True.

    -}

    check_special_inst_head :: DynFlags -> Bool -> Bool
                            -> UserTypeCtxt -> Class -> [Type] -> TcM ()
    -- Wow!  There are a surprising number of ad-hoc special cases here.
    check_special_inst_head :: DynFlags
    -> Bool -> Bool -> UserTypeCtxt -> Class -> [Type] -> TcM ()
    check_special_inst_head DynFlags
    dflags Bool
    is_boot Bool
    is_sig UserTypeCtxt
    ctxt Class
    clas [Type]
    cls_args

      -- If not in an hs-boot file, abstract classes cannot have instances
      | Class -> Bool
    isAbstractClass Class
    clas
      , Bool -> Bool
    not Bool
    is_boot
      = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc SDoc
    abstract_class_msg

      -- For Typeable, don't complain about instances for
      -- standalone deriving; they are no-ops, and we warn about
      -- it in GHC.Tc.Deriv.deriveStandalone.
      | Name
    clas_nm Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    typeableClassName
      , Bool -> Bool
    not Bool
    is_sig
        -- Note [Instances of built-in classes in signature files]
      , Bool
    hand_written_bindings
      = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc SDoc
    rejected_class_msg

      -- Handwritten instances of KnownNat/KnownSymbol class
      -- are always forbidden (#12837)
      | Name
    clas_nm Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ Name
    knownNatClassName, Name
    knownSymbolClassName ]
      , Bool -> Bool
    not Bool
    is_sig
        -- Note [Instances of built-in classes in signature files]
      , Bool
    hand_written_bindings
      = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc SDoc
    rejected_class_msg

      -- For the most part we don't allow
      -- instances for (~), (~~), or Coercible;
      -- but we DO want to allow them in quantified constraints:
      --   f :: (forall a b. Coercible a b => Coercible (m a) (m b)) => ...m...
      | Name
    clas_nm Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ Name
    heqTyConName, Name
    eqTyConName, Name
    coercibleTyConName ]
      , Bool -> Bool
    not Bool
    quantified_constraint
      = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc SDoc
    rejected_class_msg

      -- Check for hand-written Generic instances (disallowed in Safe Haskell)
      | Name
    clas_nm Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    genericClassNames
      , Bool
    hand_written_bindings
      =  do { Bool -> SDoc -> TcM ()
    failIfTc (DynFlags -> Bool
    safeLanguageOn DynFlags
    dflags) SDoc
    gen_inst_err
            ; Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DynFlags -> Bool
    safeInferOn DynFlags
    dflags) (WarningMessages -> TcM ()
    recordUnsafeInfer WarningMessages
    forall a. Bag a
    emptyBag) }

      | Name
    clas_nm Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    hasFieldClassName
      = Class -> [Type] -> TcM ()
    checkHasFieldInst Class
    clas [Type]
    cls_args

      | Class -> Bool
    isCTupleClass Class
    clas
      = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc SDoc
    tuple_class_msg

      -- Check language restrictions on the args to the class
      | Bool
    check_h98_arg_shape
      , Just SDoc
    msg <- Maybe SDoc
    mb_ty_args_msg
      = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc (Class -> [Type] -> SDoc -> SDoc
    instTypeErr Class
    clas [Type]
    cls_args SDoc
    msg)

      | Bool
    otherwise
      = () -> TcM ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
      where
        clas_nm :: Name
    clas_nm = Class -> Name
    forall a. NamedThing a => a -> Name
    getName Class
    clas
        ty_args :: [Type]
    ty_args = TyCon -> [Type] -> [Type]
    filterOutInvisibleTypes (Class -> TyCon
    classTyCon Class
    clas) [Type]
    cls_args

        hand_written_bindings :: Bool
    hand_written_bindings
            = case UserTypeCtxt
    ctxt of
                InstDeclCtxt Bool
    stand_alone -> Bool -> Bool
    not Bool
    stand_alone
                UserTypeCtxt
    SpecInstCtxt             -> Bool
    False
                UserTypeCtxt
    DerivClauseCtxt          -> Bool
    False
                UserTypeCtxt
    _                        -> Bool
    True

        check_h98_arg_shape :: Bool
    check_h98_arg_shape = case UserTypeCtxt
    ctxt of
                                UserTypeCtxt
    SpecInstCtxt    -> Bool
    False
                                UserTypeCtxt
    DerivClauseCtxt -> Bool
    False
                                UserTypeCtxt
    SigmaCtxt       -> Bool
    False
                                UserTypeCtxt
    _               -> Bool
    True
            -- SigmaCtxt: once we are in quantified-constraint land, we
            -- aren't so picky about enforcing H98-language restrictions
            -- E.g. we want to allow a head like Coercible (m a) (m b)

        -- When we are looking at the head of a quantified constraint,
        -- check_quant_pred sets ctxt to SigmaCtxt
        quantified_constraint :: Bool
    quantified_constraint = case UserTypeCtxt
    ctxt of
                                  UserTypeCtxt
    SigmaCtxt -> Bool
    True
                                  UserTypeCtxt
    _         -> Bool
    False

        head_type_synonym_msg :: SDoc
    head_type_synonym_msg = SDoc -> SDoc
    parens (
                    String -> SDoc
    text String
    "All instance types must be of the form (T t1 ... tn)" SDoc -> SDoc -> SDoc
    $$
                    String -> SDoc
    text String
    "where T is not a synonym." SDoc -> SDoc -> SDoc
    $$
                    String -> SDoc
    text String
    "Use TypeSynonymInstances if you want to disable this.")

        head_type_args_tyvars_msg :: SDoc
    head_type_args_tyvars_msg = SDoc -> SDoc
    parens ([SDoc] -> SDoc
    vcat [
                    String -> SDoc
    text String
    "All instance types must be of the form (T a1 ... an)",
                    String -> SDoc
    text String
    "where a1 ... an are *distinct type variables*,",
                    String -> SDoc
    text String
    "and each type variable appears at most once in the instance head.",
                    String -> SDoc
    text String
    "Use FlexibleInstances if you want to disable this."])

        head_one_type_msg :: SDoc
    head_one_type_msg = SDoc -> SDoc
    parens (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                            String -> SDoc
    text String
    "Only one type can be given in an instance head." SDoc -> SDoc -> SDoc
    $$
                            String -> SDoc
    text String
    "Use MultiParamTypeClasses if you want to allow more, or zero."

        rejected_class_msg :: SDoc
    rejected_class_msg = String -> SDoc
    text String
    "Class" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    clas_nm)
                             SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "does not support user-specified instances"
        tuple_class_msg :: SDoc
    tuple_class_msg    = String -> SDoc
    text String
    "You can't specify an instance for a tuple constraint"

        gen_inst_err :: SDoc
    gen_inst_err = SDoc
    rejected_class_msg SDoc -> SDoc -> SDoc
    $$ Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "(in Safe Haskell)")

        abstract_class_msg :: SDoc
    abstract_class_msg = String -> SDoc
    text String
    "Cannot define instance for abstract class"
                             SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    clas_nm)

        mb_ty_args_msg :: Maybe SDoc
    mb_ty_args_msg
          | Bool -> Bool
    not (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.TypeSynonymInstances DynFlags
    dflags)
          , Bool -> Bool
    not ((Type -> Bool) -> [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Type -> Bool
    tcInstHeadTyNotSynonym [Type]
    ty_args)
          = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just SDoc
    head_type_synonym_msg

          | Bool -> Bool
    not (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.FlexibleInstances DynFlags
    dflags)
          , Bool -> Bool
    not ((Type -> Bool) -> [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Type -> Bool
    tcInstHeadTyAppAllTyVars [Type]
    ty_args)
          = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just SDoc
    head_type_args_tyvars_msg

          | [Type] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    ty_args Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    1
          , Bool -> Bool
    not (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.MultiParamTypeClasses DynFlags
    dflags)
          , Bool -> Bool
    not (Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.NullaryTypeClasses DynFlags
    dflags Bool -> Bool -> Bool
    && [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Type]
    ty_args)
          = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just SDoc
    head_one_type_msg

          | Bool
    otherwise
          = Maybe SDoc
    forall a. Maybe a
    Nothing

    tcInstHeadTyNotSynonym :: Type -> Bool
    -- Used in Haskell-98 mode, for the argument types of an instance head
    -- These must not be type synonyms, but everywhere else type synonyms
    -- are transparent, so we need a special function here
    tcInstHeadTyNotSynonym :: Type -> Bool
    tcInstHeadTyNotSynonym Type
    ty
      = case Type
    ty of  -- Do not use splitTyConApp,
                    -- because that expands synonyms!
            TyConApp TyCon
    tc [Type]
    _ -> Bool -> Bool
    not (TyCon -> Bool
    isTypeSynonymTyCon TyCon
    tc) Bool -> Bool -> Bool
    || TyCon
    tc TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    unrestrictedFunTyCon
                    -- Allow (->), e.g. instance Category (->),
                    -- even though it's a type synonym for FUN 'Many
            Type
    _ -> Bool
    True

    tcInstHeadTyAppAllTyVars :: Type -> Bool
    -- Used in Haskell-98 mode, for the argument types of an instance head
    -- These must be a constructor applied to type variable arguments
    -- or a type-level literal.
    -- But we allow
    -- 1) kind instantiations
    -- 2) the type (->) = FUN 'Many, even though it's not in this form.
    tcInstHeadTyAppAllTyVars :: Type -> Bool
    tcInstHeadTyAppAllTyVars Type
    ty
      | Just (TyCon
    tc, [Type]
    tys) <- HasCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    tcSplitTyConApp_maybe (Type -> Type
    dropCasts Type
    ty)
      = let tys' :: [Type]
    tys' = TyCon -> [Type] -> [Type]
    filterOutInvisibleTypes TyCon
    tc [Type]
    tys  -- avoid kinds
            tys'' :: [Type]
    tys'' | TyCon
    tc TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    funTyCon, Type
    tys_h:[Type]
    tys_t <- [Type]
    tys', Type
    tys_h Type -> Type -> Bool
    `eqType` Type
    manyDataConTy = [Type]
    tys_t
                  | Bool
    otherwise = [Type]
    tys'
        in [Type] -> Bool
    ok [Type]
    tys''
      | LitTy TyLit
    _ <- Type
    ty = Bool
    True  -- accept type literals (#13833)
      | Bool
    otherwise
      = Bool
    False
      where
            -- Check that all the types are type variables,
            -- and that each is distinct
        ok :: [Type] -> Bool
    ok [Type]
    tys = [TyCoVar] -> [Type] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [TyCoVar]
    tvs [Type]
    tys Bool -> Bool -> Bool
    && [TyCoVar] -> Bool
    forall a. Eq a => [a] -> Bool
    hasNoDups [TyCoVar]
    tvs
               where
                 tvs :: [TyCoVar]
    tvs = (Type -> Maybe TyCoVar) -> [Type] -> [TyCoVar]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Type -> Maybe TyCoVar
    tcGetTyVar_maybe [Type]
    tys

    dropCasts :: Type -> Type
    -- See Note [Casts during validity checking]
    -- This function can turn a well-kinded type into an ill-kinded
    -- one, so I've kept it local to this module
    -- To consider: drop only HoleCo casts
    dropCasts :: Type -> Type
    dropCasts (CastTy Type
    ty KindCoercion
    _)       = Type -> Type
    dropCasts Type
    ty
    dropCasts (AppTy Type
    t1 Type
    t2)       = Type -> Type -> Type
    mkAppTy (Type -> Type
    dropCasts Type
    t1) (Type -> Type
    dropCasts Type
    t2)
    dropCasts ty :: Type
    ty@(FunTy AnonArgFlag
    _ Type
    w Type
    t1 Type
    t2)  = Type
    ty { ft_mult :: Type
    ft_mult = Type -> Type
    dropCasts Type
    w, ft_arg :: Type
    ft_arg = Type -> Type
    dropCasts Type
    t1, ft_res :: Type
    ft_res = Type -> Type
    dropCasts Type
    t2 }
    dropCasts (TyConApp TyCon
    tc [Type]
    tys)   = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    tc ((Type -> Type) -> [Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> Type
    dropCasts [Type]
    tys)
    dropCasts (ForAllTy TyVarBinder
    b Type
    ty)     = TyVarBinder -> Type -> Type
    ForAllTy (TyVarBinder -> TyVarBinder
    dropCastsB TyVarBinder
    b) (Type -> Type
    dropCasts Type
    ty)
    dropCasts Type
    ty                  = Type
    ty  -- LitTy, TyVarTy, CoercionTy

    dropCastsB :: TyVarBinder -> TyVarBinder
    dropCastsB :: TyVarBinder -> TyVarBinder
    dropCastsB TyVarBinder
    b = TyVarBinder
    b   -- Don't bother in the kind of a forall

    instTypeErr :: Class -> [Type] -> SDoc -> SDoc
    instTypeErr :: Class -> [Type] -> SDoc -> SDoc
    instTypeErr Class
    cls [Type]
    tys SDoc
    msg
      = SDoc -> Int -> SDoc -> SDoc
    hang (SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Illegal instance declaration for")
                 Int
    2 (SDoc -> SDoc
    quotes (Class -> [Type] -> SDoc
    pprClassPred Class
    cls [Type]
    tys)))
           Int
    2 SDoc
    msg

    -- | See Note [Validity checking of HasField instances]
    checkHasFieldInst :: Class -> [Type] -> TcM ()
    checkHasFieldInst :: Class -> [Type] -> TcM ()
    checkHasFieldInst Class
    cls tys :: [Type]
    tys@[Type
    _k_ty, Type
    x_ty, Type
    r_ty, Type
    _a_ty] =
      case HasDebugCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    splitTyConApp_maybe Type
    r_ty of
        Maybe (TyCon, [Type])
    Nothing -> SDoc -> TcM ()
    whoops (String -> SDoc
    text String
    "Record data type must be specified")
        Just (TyCon
    tc, [Type]
    _)
          | TyCon -> Bool
    isFamilyTyCon TyCon
    tc
                      -> SDoc -> TcM ()
    whoops (String -> SDoc
    text String
    "Record data type may not be a data family")
          | Bool
    otherwise -> case Type -> Maybe FastString
    isStrLitTy Type
    x_ty of
           Just FastString
    lbl
             | Maybe FieldLabel -> Bool
    forall a. Maybe a -> Bool
    isJust (FastString -> TyCon -> Maybe FieldLabel
    lookupTyConFieldLabel FastString
    lbl TyCon
    tc)
                         -> SDoc -> TcM ()
    whoops (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "already has a field"
                                           SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (FastString -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr FastString
    lbl))
             | Bool
    otherwise -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
           Maybe FastString
    Nothing
             | [FieldLabel] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (TyCon -> [FieldLabel]
    tyConFieldLabels TyCon
    tc) -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
             | Bool
    otherwise -> SDoc -> TcM ()
    whoops (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "has fields")
      where
        whoops :: SDoc -> TcM ()
    whoops = SDoc -> TcM ()
    addErrTc (SDoc -> TcM ()) -> (SDoc -> SDoc) -> SDoc -> TcM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Class -> [Type] -> SDoc -> SDoc
    instTypeErr Class
    cls [Type]
    tys
    checkHasFieldInst Class
    _ [Type]
    tys = String -> SDoc -> TcM ()
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "checkHasFieldInst" ([Type] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Type]
    tys)

    {- Note [Casts during validity checking]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider the (bogus)
         instance Eq Char#
    We elaborate to  'Eq (Char# |> UnivCo(hole))'  where the hole is an
    insoluble equality constraint for * ~ #.  We'll report the insoluble
    constraint separately, but we don't want to *also* complain that Eq is
    not applied to a type constructor.  So we look gaily look through
    CastTys here.

    Another example:  Eq (Either a).  Then we actually get a cast in
    the middle:
       Eq ((Either |> g) a)

    Note [Validity checking of HasField instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The HasField class has magic constraint solving behaviour (see Note
    [HasField instances] in GHC.Tc.Solver.Interact).  However, we permit users to
    declare their own instances, provided they do not clash with the
    built-in behaviour.  In particular, we forbid:

      1. `HasField _ r _` where r is a variable

      2. `HasField _ (T ...) _` if T is a data family
         (because it might have fields introduced later)

      3. `HasField x (T ...) _` where x is a variable,
          if T has any fields at all

      4. `HasField "foo" (T ...) _` if T has a "foo" field

    The usual functional dependency checks also apply.

    Note [Valid 'deriving' predicate]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    validDerivPred checks for OK 'deriving' context.  See Note [Exotic
    derived instance contexts] in GHC.Tc.Deriv.  However the predicate is
    here because it uses sizeTypes, fvTypes.

    It checks for three things

      * No repeated variables (hasNoDups fvs)

      * No type constructors.  This is done by comparing
            sizeTypes tys == length (fvTypes tys)
        sizeTypes counts variables and constructors; fvTypes returns variables.
        So if they are the same, there must be no constructors.  But there
        might be applications thus (f (g x)).

        Note that tys only includes the visible arguments of the class type
        constructor. Including the non-visible arguments can cause the following,
        perfectly valid instance to be rejected:
           class Category (cat :: k -> k -> *) where ...
           newtype T (c :: * -> * -> *) a b = MkT (c a b)
           instance Category c => Category (T c) where ...
        since the first argument to Category is a non-visible *, which sizeTypes
        would count as a constructor! See #11833.

      * Also check for a bizarre corner case, when the derived instance decl
        would look like
           instance C a b => D (T a) where ...
        Note that 'b' isn't a parameter of T.  This gives rise to all sorts of
        problems; in particular, it's hard to compare solutions for equality
        when finding the fixpoint, and that means the inferContext loop does
        not converge.  See #5287.

    Note [Equality class instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We can't have users writing instances for the equality classes. But we
    still need to be able to write instances for them ourselves. So we allow
    instances only in the defining module.

    -}

    validDerivPred :: TyVarSet -> PredType -> Bool
    -- See Note [Valid 'deriving' predicate]
    validDerivPred :: VarSet -> Type -> Bool
    validDerivPred VarSet
    tv_set Type
    pred
      = case Type -> Pred
    classifyPredType Type
    pred of
           ClassPred Class
    cls [Type]
    tys -> Class
    cls Class -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    typeableClassKey
                    -- Typeable constraints are bigger than they appear due
                    -- to kind polymorphism, but that's OK
                           Bool -> Bool -> Bool
    || Class -> [Type] -> Bool
    check_tys Class
    cls [Type]
    tys
           EqPred {}       -> Bool
    False  -- reject equality constraints
           Pred
    _               -> Bool
    True   -- Non-class predicates are ok
      where
        check_tys :: Class -> [Type] -> Bool
    check_tys Class
    cls [Type]
    tys
                  = [TyCoVar] -> Bool
    forall a. Eq a => [a] -> Bool
    hasNoDups [TyCoVar]
    fvs
                       -- use sizePred to ignore implicit args
                    Bool -> Bool -> Bool
    && [TyCoVar] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    lengthIs [TyCoVar]
    fvs (Type -> Int
    sizePred Type
    pred)
                    Bool -> Bool -> Bool
    && (TyCoVar -> Bool) -> [TyCoVar] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (TyCoVar -> VarSet -> Bool
    `elemVarSet` VarSet
    tv_set) [TyCoVar]
    fvs
          where tys' :: [Type]
    tys' = TyCon -> [Type] -> [Type]
    filterOutInvisibleTypes (Class -> TyCon
    classTyCon Class
    cls) [Type]
    tys
                fvs :: [TyCoVar]
    fvs  = [Type] -> [TyCoVar]
    fvTypes [Type]
    tys'

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Checking instance for termination}
    *                                                                      *
    ************************************************************************
    -}

    {- Note [Instances and constraint synonyms]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Currently, we don't allow instances for constraint synonyms at all.
    Consider these (#13267):
      type C1 a = Show (a -> Bool)
      instance C1 Int where    -- I1
        show _ = "ur"

    This elicits "show is not a (visible) method of class C1", which isn't
    a great message. But it comes from the renamer, so it's hard to improve.

    This needs a bit more care:
      type C2 a = (Show a, Show Int)
      instance C2 Int           -- I2

    If we use (splitTyConApp_maybe tau) in checkValidInstance to decompose
    the instance head, we'll expand the synonym on fly, and it'll look like
      instance (%,%) (Show Int, Show Int)
    and we /really/ don't want that.  So we carefully do /not/ expand
    synonyms, by matching on TyConApp directly.
    -}

    checkValidInstance :: UserTypeCtxt -> LHsSigType GhcRn -> Type -> TcM ()
    checkValidInstance :: UserTypeCtxt -> LHsSigType GhcRn -> Type -> TcM ()
    checkValidInstance UserTypeCtxt
    ctxt LHsSigType GhcRn
    hs_type Type
    ty
      | Bool -> Bool
    not Bool
    is_tc_app
      = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc (SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Instance head is not headed by a class:")
                       Int
    2 ( Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    tau))

      | Maybe Class -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe Class
    mb_cls
      = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Illegal instance for a" SDoc -> SDoc -> SDoc
    <+> TyConFlavour -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> TyConFlavour
    tyConFlavour TyCon
    tc)
                         , String -> SDoc
    text String
    "A class instance must be for a class" ])

      | Bool -> Bool
    not Bool
    arity_ok
      = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc (String -> SDoc
    text String
    "Arity mis-match in instance head")

      | Bool
    otherwise
      = do  { SrcSpanAnn' (EpAnn AnnListItem) -> TcM () -> TcM ()
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnn' (EpAnn AnnListItem)
    head_loc (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
              UserTypeCtxt -> Class -> [Type] -> TcM ()
    checkValidInstHead UserTypeCtxt
    ctxt Class
    clas [Type]
    inst_tys

            ; String -> SDoc -> TcM ()
    traceTc String
    "checkValidInstance {" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty)

            ; TidyEnv
    env0 <- TcM TidyEnv
    tcInitTidyEnv
            ; ExpandMode
    expand <- TcM ExpandMode
    initialExpandMode
            ; TidyEnv -> UserTypeCtxt -> ExpandMode -> [Type] -> TcM ()
    check_valid_theta TidyEnv
    env0 UserTypeCtxt
    ctxt ExpandMode
    expand [Type]
    theta

            -- The Termination and Coverate Conditions
            -- Check that instance inference will terminate (if we care)
            -- For Haskell 98 this will already have been done by checkValidTheta,
            -- but as we may be using other extensions we need to check.
            --
            -- Note that the Termination Condition is *more conservative* than
            -- the checkAmbiguity test we do on other type signatures
            --   e.g.  Bar a => Bar Int is ambiguous, but it also fails
            --   the termination condition, because 'a' appears more often
            --   in the constraint than in the head
            ; Bool
    undecidable_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.UndecidableInstances
            ; if Bool
    undecidable_ok
              then UserTypeCtxt -> Type -> TcM ()
    checkAmbiguity UserTypeCtxt
    ctxt Type
    ty
              else [Type] -> Type -> TcM ()
    checkInstTermination [Type]
    theta Type
    tau

            ; String -> SDoc -> TcM ()
    traceTc String
    "cvi 2" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty)

            ; case (Bool -> Class -> [Type] -> [Type] -> Validity
    checkInstCoverage Bool
    undecidable_ok Class
    clas [Type]
    theta [Type]
    inst_tys) of
                Validity
    IsValid      -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()   -- Check succeeded
                NotValid SDoc
    msg -> SDoc -> TcM ()
    addErrTc (Class -> [Type] -> SDoc -> SDoc
    instTypeErr Class
    clas [Type]
    inst_tys SDoc
    msg)

            ; String -> SDoc -> TcM ()
    traceTc String
    "End checkValidInstance }" SDoc
    empty

            ; () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () }
      where
        ([TyCoVar]
    _tvs, [Type]
    theta, Type
    tau)   = Type -> ([TyCoVar], [Type], Type)
    tcSplitSigmaTy Type
    ty
        is_tc_app :: Bool
    is_tc_app            = case Type
    tau of { TyConApp {} -> Bool
    True; Type
    _ -> Bool
    False }
        TyConApp TyCon
    tc [Type]
    inst_tys = Type
    tau   -- See Note [Instances and constraint synonyms]
        mb_cls :: Maybe Class
    mb_cls               = TyCon -> Maybe Class
    tyConClass_maybe TyCon
    tc
        Just Class
    clas            = Maybe Class
    mb_cls
        arity_ok :: Bool
    arity_ok             = [Type]
    inst_tys [Type] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthIs` Class -> Int
    classArity Class
    clas

            -- The location of the "head" of the instance
        head_loc :: SrcSpanAnn' (EpAnn AnnListItem)
    head_loc = GenLocated (SrcSpanAnn' (EpAnn AnnListItem)) (HsType GhcRn)
    -> SrcSpanAnn' (EpAnn AnnListItem)
    forall l e. GenLocated l e -> l
    getLoc (LHsSigType GhcRn -> LHsType GhcRn
    forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
    getLHsInstDeclHead LHsSigType GhcRn
    hs_type)

    {-
    Note [Paterson conditions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    Termination test: the so-called "Paterson conditions" (see Section 5 of
    "Understanding functional dependencies via Constraint Handling Rules,
    JFP Jan 2007).

    We check that each assertion in the context satisfies:
     (1) no variable has more occurrences in the assertion than in the head, and
     (2) the assertion has fewer constructors and variables (taken together
         and counting repetitions) than the head.
    This is only needed with -fglasgow-exts, as Haskell 98 restrictions
    (which have already been checked) guarantee termination.

    The underlying idea is that

        for any ground substitution, each assertion in the
        context has fewer type constructors than the head.
    -}

    checkInstTermination :: ThetaType -> TcPredType -> TcM ()
    -- See Note [Paterson conditions]
    checkInstTermination :: [Type] -> Type -> TcM ()
    checkInstTermination [Type]
    theta Type
    head_pred
      = VarSet -> [Type] -> TcM ()
    check_preds VarSet
    emptyVarSet [Type]
    theta
      where
       head_fvs :: [TyCoVar]
    head_fvs  = Type -> [TyCoVar]
    fvType Type
    head_pred
       head_size :: Int
    head_size = Type -> Int
    sizeType Type
    head_pred

       check_preds :: VarSet -> [PredType] -> TcM ()
       check_preds :: VarSet -> [Type] -> TcM ()
    check_preds VarSet
    foralld_tvs [Type]
    preds = (Type -> TcM ()) -> [Type] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (VarSet -> Type -> TcM ()
    check VarSet
    foralld_tvs) [Type]
    preds

       check :: VarSet -> PredType -> TcM ()
       check :: VarSet -> Type -> TcM ()
    check VarSet
    foralld_tvs Type
    pred
         = case Type -> Pred
    classifyPredType Type
    pred of
             EqPred {}    -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()  -- See #4200.
             IrredPred {} -> VarSet -> Type -> Int -> TcM ()
    check2 VarSet
    foralld_tvs Type
    pred (Type -> Int
    sizeType Type
    pred)
             ClassPred Class
    cls [Type]
    tys
               | Class -> Bool
    isTerminatingClass Class
    cls
               -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

               | Class -> Bool
    isCTupleClass Class
    cls  -- Look inside tuple predicates; #8359
               -> VarSet -> [Type] -> TcM ()
    check_preds VarSet
    foralld_tvs [Type]
    tys

               | Bool
    otherwise          -- Other ClassPreds
               -> VarSet -> Type -> Int -> TcM ()
    check2 VarSet
    foralld_tvs Type
    pred Int
    bogus_size
               where
                  bogus_size :: Int
    bogus_size = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Type] -> Int
    sizeTypes (TyCon -> [Type] -> [Type]
    filterOutInvisibleTypes (Class -> TyCon
    classTyCon Class
    cls) [Type]
    tys)
                                   -- See Note [Invisible arguments and termination]

             ForAllPred [TyCoVar]
    tvs [Type]
    _ Type
    head_pred'
               -> VarSet -> Type -> TcM ()
    check (VarSet
    foralld_tvs VarSet -> [TyCoVar] -> VarSet
    `extendVarSetList` [TyCoVar]
    tvs) Type
    head_pred'
                  -- Termination of the quantified predicate itself is checked
                  -- when the predicates are individually checked for validity

       check2 :: VarSet -> Type -> Int -> TcM ()
    check2 VarSet
    foralld_tvs Type
    pred Int
    pred_size
         | Bool -> Bool
    not ([TyCoVar] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyCoVar]
    bad_tvs)     = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc ([TyCoVar] -> SDoc -> SDoc -> SDoc
    noMoreMsg [TyCoVar]
    bad_tvs SDoc
    what (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    head_pred))
         | Bool -> Bool
    not (Type -> Bool
    isTyFamFree Type
    pred) = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc (SDoc -> SDoc
    nestedMsg SDoc
    what)
         | Int
    pred_size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    head_size = SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc (SDoc -> SDoc -> SDoc
    smallerMsg SDoc
    what (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    head_pred))
         | Bool
    otherwise              = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
         -- isTyFamFree: see Note [Type families in instance contexts]
         where
            what :: SDoc
    what    = String -> SDoc
    text String
    "constraint" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    pred)
            bad_tvs :: [TyCoVar]
    bad_tvs = (TyCoVar -> Bool) -> [TyCoVar] -> [TyCoVar]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (TyCoVar -> VarSet -> Bool
    `elemVarSet` VarSet
    foralld_tvs) (Type -> [TyCoVar]
    fvType Type
    pred)
                      [TyCoVar] -> [TyCoVar] -> [TyCoVar]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [TyCoVar]
    head_fvs

    smallerMsg :: SDoc -> SDoc -> SDoc
    smallerMsg :: SDoc -> SDoc -> SDoc
    smallerMsg SDoc
    what SDoc
    inst_head
      = [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> SDoc
    what)
                  Int
    2 ([SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "is no smaller than"
                         , String -> SDoc
    text String
    "the instance head" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes SDoc
    inst_head ])
             , SDoc -> SDoc
    parens SDoc
    undecidableMsg ]

    noMoreMsg :: [TcTyVar] -> SDoc -> SDoc -> SDoc
    noMoreMsg :: [TyCoVar] -> SDoc -> SDoc -> SDoc
    noMoreMsg [TyCoVar]
    tvs SDoc
    what SDoc
    inst_head
      = [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Variable" SDoc -> SDoc -> SDoc
    <> [TyCoVar] -> SDoc
    forall a. [a] -> SDoc
    plural [TyCoVar]
    tvs1 SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes ((TyCoVar -> SDoc) -> [TyCoVar] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas TyCoVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TyCoVar]
    tvs1)
                    SDoc -> SDoc -> SDoc
    <+> SDoc
    occurs SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "more often")
                  Int
    2 ([SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "in the" SDoc -> SDoc -> SDoc
    <+> SDoc
    what
                         , String -> SDoc
    text String
    "than in the instance head" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes SDoc
    inst_head ])
             , SDoc -> SDoc
    parens SDoc
    undecidableMsg ]
      where
       tvs1 :: [TyCoVar]
    tvs1   = [TyCoVar] -> [TyCoVar]
    forall a. Eq a => [a] -> [a]
    nub [TyCoVar]
    tvs
       occurs :: SDoc
    occurs = if [TyCoVar] -> Bool
    forall a. [a] -> Bool
    isSingleton [TyCoVar]
    tvs1 then String -> SDoc
    text String
    "occurs"
                                   else String -> SDoc
    text String
    "occur"

    undecidableMsg, constraintKindsMsg :: SDoc
    undecidableMsg :: SDoc
    undecidableMsg     = String -> SDoc
    text String
    "Use UndecidableInstances to permit this"
    constraintKindsMsg :: SDoc
    constraintKindsMsg = String -> SDoc
    text String
    "Use ConstraintKinds to permit this"

    {- Note [Type families in instance contexts]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Are these OK?
      type family F a
      instance F a    => C (Maybe [a]) where ...
      instance C (F a) => C [[[a]]]     where ...

    No: the type family in the instance head might blow up to an
    arbitrarily large type, depending on how 'a' is instantiated.
    So we require UndecidableInstances if we have a type family
    in the instance head.  #15172.

    Note [Invisible arguments and termination]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When checking the ​Paterson conditions for termination an instance
    declaration, we check for the number of "constructors and variables"
    in the instance head and constraints. Question: Do we look at

     * All the arguments, visible or invisible?
     * Just the visible arguments?

    I think both will ensure termination, provided we are consistent.
    Currently we are /not/ consistent, which is really a bug.  It's
    described in #15177, which contains a number of examples.
    The suspicious bits are the calls to filterOutInvisibleTypes.
    -}

    {-
    ************************************************************************
    *                                                                      *
            Checking type instance well-formedness and termination
    *                                                                      *
    ************************************************************************
    -}

    checkValidCoAxiom :: CoAxiom Branched -> TcM ()
    checkValidCoAxiom :: CoAxiom Branched -> TcM ()
    checkValidCoAxiom ax :: CoAxiom Branched
    ax@(CoAxiom { co_ax_tc :: forall (br :: BranchFlag). CoAxiom br -> TyCon
    co_ax_tc = TyCon
    fam_tc, co_ax_branches :: forall (br :: BranchFlag). CoAxiom br -> Branches br
    co_ax_branches = Branches Branched
    branches })
      = do { (CoAxBranch -> TcM ()) -> [CoAxBranch] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (TyCon -> CoAxBranch -> TcM ()
    checkValidCoAxBranch TyCon
    fam_tc) [CoAxBranch]
    branch_list
           ; ([CoAxBranch]
     -> CoAxBranch -> IOEnv (Env TcGblEnv TcLclEnv) [CoAxBranch])
    -> [CoAxBranch] -> [CoAxBranch] -> TcM ()
    forall (m :: * -> *) (t :: * -> *) a b.
    (Monad m, Foldable t) =>
    (a -> b -> m a) -> a -> t b -> m ()
    foldlM_ [CoAxBranch]
    -> CoAxBranch -> IOEnv (Env TcGblEnv TcLclEnv) [CoAxBranch]
    check_branch_compat [] [CoAxBranch]
    branch_list }
      where
        branch_list :: [CoAxBranch]
    branch_list = Branches Branched -> [CoAxBranch]
    forall (br :: BranchFlag). Branches br -> [CoAxBranch]
    fromBranches Branches Branched
    branches
        injectivity :: Injectivity
    injectivity = TyCon -> Injectivity
    tyConInjectivityInfo TyCon
    fam_tc

        check_branch_compat :: [CoAxBranch]    -- previous branches in reverse order
                            -> CoAxBranch      -- current branch
                            -> TcM [CoAxBranch]-- current branch : previous branches
        -- Check for
        --   (a) this branch is dominated by previous ones
        --   (b) failure of injectivity
        check_branch_compat :: [CoAxBranch]
    -> CoAxBranch -> IOEnv (Env TcGblEnv TcLclEnv) [CoAxBranch]
    check_branch_compat [CoAxBranch]
    prev_branches CoAxBranch
    cur_branch
          | CoAxBranch
    cur_branch CoAxBranch -> [CoAxBranch] -> Bool
    `isDominatedBy` [CoAxBranch]
    prev_branches
          = do { WarnReason -> SrcSpan -> SDoc -> TcM ()
    addWarnAt WarnReason
    NoReason (CoAxBranch -> SrcSpan
    coAxBranchSpan CoAxBranch
    cur_branch) (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
                 TyCon -> CoAxBranch -> SDoc
    inaccessibleCoAxBranch TyCon
    fam_tc CoAxBranch
    cur_branch
               ; [CoAxBranch] -> IOEnv (Env TcGblEnv TcLclEnv) [CoAxBranch]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [CoAxBranch]
    prev_branches }
          | Bool
    otherwise
          = do { [CoAxBranch] -> CoAxBranch -> TcM ()
    check_injectivity [CoAxBranch]
    prev_branches CoAxBranch
    cur_branch
               ; [CoAxBranch] -> IOEnv (Env TcGblEnv TcLclEnv) [CoAxBranch]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoAxBranch
    cur_branch CoAxBranch -> [CoAxBranch] -> [CoAxBranch]
    forall a. a -> [a] -> [a]
    : [CoAxBranch]
    prev_branches) }

         -- Injectivity check: check whether a new (CoAxBranch) can extend
         -- already checked equations without violating injectivity
         -- annotation supplied by the user.
         -- See Note [Verifying injectivity annotation] in GHC.Core.FamInstEnv
        check_injectivity :: [CoAxBranch] -> CoAxBranch -> TcM ()
    check_injectivity [CoAxBranch]
    prev_branches CoAxBranch
    cur_branch
          | Injective [Bool]
    inj <- Injectivity
    injectivity
          = do { DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
               ; let conflicts :: [CoAxBranch]
    conflicts =
                         ([CoAxBranch], Int) -> [CoAxBranch]
    forall a b. (a, b) -> a
    fst (([CoAxBranch], Int) -> [CoAxBranch])
    -> ([CoAxBranch], Int) -> [CoAxBranch]
    forall a b. (a -> b) -> a -> b
    $ (([CoAxBranch], Int) -> CoAxBranch -> ([CoAxBranch], Int))
    -> ([CoAxBranch], Int) -> [CoAxBranch] -> ([CoAxBranch], Int)
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' ([Bool]
    -> [CoAxBranch]
    -> CoAxBranch
    -> ([CoAxBranch], Int)
    -> CoAxBranch
    -> ([CoAxBranch], Int)
    gather_conflicts [Bool]
    inj [CoAxBranch]
    prev_branches CoAxBranch
    cur_branch)
                                     ([], Int
    0) [CoAxBranch]
    prev_branches
               ; TyCon -> [CoAxBranch] -> CoAxBranch -> TcM ()
    reportConflictingInjectivityErrs TyCon
    fam_tc [CoAxBranch]
    conflicts CoAxBranch
    cur_branch
               ; DynFlags -> CoAxiom Branched -> CoAxBranch -> [Bool] -> TcM ()
    forall (br :: BranchFlag).
    DynFlags -> CoAxiom br -> CoAxBranch -> [Bool] -> TcM ()
    reportInjectivityErrors DynFlags
    dflags CoAxiom Branched
    ax CoAxBranch
    cur_branch [Bool]
    inj }
          | Bool
    otherwise
          = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

        gather_conflicts :: [Bool]
    -> [CoAxBranch]
    -> CoAxBranch
    -> ([CoAxBranch], Int)
    -> CoAxBranch
    -> ([CoAxBranch], Int)
    gather_conflicts [Bool]
    inj [CoAxBranch]
    prev_branches CoAxBranch
    cur_branch ([CoAxBranch]
    acc, Int
    n) CoAxBranch
    branch
                   -- n is 0-based index of branch in prev_branches
          = case [Bool] -> CoAxBranch -> CoAxBranch -> InjectivityCheckResult
    injectiveBranches [Bool]
    inj CoAxBranch
    cur_branch CoAxBranch
    branch of
               -- Case 1B2 in Note [Verifying injectivity annotation] in GHC.Core.FamInstEnv
              InjectivityUnified CoAxBranch
    ax1 CoAxBranch
    ax2
                | CoAxBranch
    ax1 CoAxBranch -> [CoAxBranch] -> Bool
    `isDominatedBy` ([CoAxBranch] -> Int -> CoAxBranch -> [CoAxBranch]
    replace_br [CoAxBranch]
    prev_branches Int
    n CoAxBranch
    ax2)
                    -> ([CoAxBranch]
    acc, Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
                | Bool
    otherwise
                    -> (CoAxBranch
    branch CoAxBranch -> [CoAxBranch] -> [CoAxBranch]
    forall a. a -> [a] -> [a]
    : [CoAxBranch]
    acc, Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)
              InjectivityCheckResult
    InjectivityAccepted -> ([CoAxBranch]
    acc, Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1)

        -- Replace n-th element in the list. Assumes 0-based indexing.
        replace_br :: [CoAxBranch] -> Int -> CoAxBranch -> [CoAxBranch]
        replace_br :: [CoAxBranch] -> Int -> CoAxBranch -> [CoAxBranch]
    replace_br [CoAxBranch]
    brs Int
    n CoAxBranch
    br = Int -> [CoAxBranch] -> [CoAxBranch]
    forall a. Int -> [a] -> [a]
    take Int
    n [CoAxBranch]
    brs [CoAxBranch] -> [CoAxBranch] -> [CoAxBranch]
    forall a. [a] -> [a] -> [a]
    ++ [CoAxBranch
    br] [CoAxBranch] -> [CoAxBranch] -> [CoAxBranch]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [CoAxBranch] -> [CoAxBranch]
    forall a. Int -> [a] -> [a]
    drop (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) [CoAxBranch]
    brs

    -- Check that a "type instance" is well-formed (which includes decidability
    -- unless -XUndecidableInstances is given).
    --
    checkValidCoAxBranch :: TyCon -> CoAxBranch -> TcM ()
    checkValidCoAxBranch :: TyCon -> CoAxBranch -> TcM ()
    checkValidCoAxBranch TyCon
    fam_tc
                        (CoAxBranch { cab_tvs :: CoAxBranch -> [TyCoVar]
    cab_tvs = [TyCoVar]
    tvs, cab_cvs :: CoAxBranch -> [TyCoVar]
    cab_cvs = [TyCoVar]
    cvs
                                    , cab_lhs :: CoAxBranch -> [Type]
    cab_lhs = [Type]
    typats
                                    , cab_rhs :: CoAxBranch -> Type
    cab_rhs = Type
    rhs, cab_loc :: CoAxBranch -> SrcSpan
    cab_loc = SrcSpan
    loc })
      = SrcSpan -> TcM () -> TcM ()
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
        TyCon -> [TyCoVar] -> [Type] -> Type -> TcM ()
    checkValidTyFamEqn TyCon
    fam_tc ([TyCoVar]
    tvs[TyCoVar] -> [TyCoVar] -> [TyCoVar]
    forall a. [a] -> [a] -> [a]
    ++[TyCoVar]
    cvs) [Type]
    typats Type
    rhs

    -- | Do validity checks on a type family equation, including consistency
    -- with any enclosing class instance head, termination, and lack of
    -- polytypes.
    checkValidTyFamEqn :: TyCon   -- ^ of the type family
                       -> [Var]   -- ^ Bound variables in the equation
                       -> [Type]  -- ^ Type patterns
                       -> Type    -- ^ Rhs
                       -> TcM ()
    checkValidTyFamEqn :: TyCon -> [TyCoVar] -> [Type] -> Type -> TcM ()
    checkValidTyFamEqn TyCon
    fam_tc [TyCoVar]
    qvs [Type]
    typats Type
    rhs
      = do { TyCon -> [Type] -> TcM ()
    checkValidTypePats TyCon
    fam_tc [Type]
    typats

             -- Check for things used on the right but not bound on the left
           ; TyCon -> [TyCoVar] -> [Type] -> Type -> TcM ()
    checkFamPatBinders TyCon
    fam_tc [TyCoVar]
    qvs [Type]
    typats Type
    rhs

             -- Check for oversaturated visible kind arguments in a type family
             -- equation.
             -- See Note [Oversaturated type family equations]
           ; Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (TyCon -> Bool
    isTypeFamilyTyCon TyCon
    fam_tc) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
               case Int -> [Type] -> [Type]
    forall a. Int -> [a] -> [a]
    drop (TyCon -> Int
    tyConArity TyCon
    fam_tc) [Type]
    typats of
                 [] -> () -> TcM ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                 Type
    spec_arg:[Type]
    _ ->
                   SDoc -> TcM ()
    addErr (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "Illegal oversaturated visible kind argument:"
                        SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Char -> SDoc
    char Char
    '@' SDoc -> SDoc -> SDoc
    <> Type -> SDoc
    pprParendType Type
    spec_arg)

             -- The argument patterns, and RHS, are all boxed tau types
             -- E.g  Reject type family F (a :: k1) :: k2
             --             type instance F (forall a. a->a) = ...
             --             type instance F Int#             = ...
             --             type instance F Int              = forall a. a->a
             --             type instance F Int              = Int#
             -- See #9357
           ; Type -> TcM ()
    checkValidMonoType Type
    rhs

             -- We have a decidable instance unless otherwise permitted
           ; Bool
    undecidable_ok <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.UndecidableInstances
           ; String -> SDoc -> TcM ()
    traceTc String
    "checkVTFE" (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    fam_tc SDoc -> SDoc -> SDoc
    $$ Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    rhs SDoc -> SDoc -> SDoc
    $$ [(TyCon, [Type])] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Type -> [(TyCon, [Type])]
    tcTyFamInsts Type
    rhs))
           ; Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    undecidable_ok (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
             (SDoc -> TcM ()) -> [SDoc] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ SDoc -> TcM ()
    addErrTc (TyCon -> [Type] -> [(TyCon, [Type])] -> [SDoc]
    checkFamInstRhs TyCon
    fam_tc [Type]
    typats (Type -> [(TyCon, [Type])]
    tcTyFamInsts Type
    rhs)) }

    -- | Checks that an associated type family default:
    --
    -- 1. Only consists of arguments that are bare type variables, and
    --
    -- 2. Has a distinct type variable in each argument.
    --
    -- See @Note [Type-checking default assoc decls]@ in "GHC.Tc.TyCl".
    checkValidAssocTyFamDeflt :: TyCon  -- ^ of the type family
                              -> [Type] -- ^ Type patterns
                              -> TcM ()
    checkValidAssocTyFamDeflt :: TyCon -> [Type] -> TcM ()
    checkValidAssocTyFamDeflt TyCon
    fam_tc [Type]
    pats =
      do { [TyCoVar]
    cpt_tvs <- (Type -> ArgFlag -> IOEnv (Env TcGblEnv TcLclEnv) TyCoVar)
    -> [Type] -> [ArgFlag] -> IOEnv (Env TcGblEnv TcLclEnv) [TyCoVar]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Type -> ArgFlag -> IOEnv (Env TcGblEnv TcLclEnv) TyCoVar
    extract_tv [Type]
    pats [ArgFlag]
    pats_vis
         ; [(TyCoVar, ArgFlag)] -> TcM ()
    check_all_distinct_tvs ([(TyCoVar, ArgFlag)] -> TcM ()) -> [(TyCoVar, ArgFlag)] -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ [TyCoVar] -> [ArgFlag] -> [(TyCoVar, ArgFlag)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [TyCoVar]
    cpt_tvs [ArgFlag]
    pats_vis }
      where
        pats_vis :: [ArgFlag]
        pats_vis :: [ArgFlag]
    pats_vis = TyCon -> [Type] -> [ArgFlag]
    tyConArgFlags TyCon
    fam_tc [Type]
    pats

        -- Checks that a pattern on the LHS of a default is a type
        -- variable. If so, return the underlying type variable, and if
        -- not, throw an error.
        -- See Note [Type-checking default assoc decls]
        extract_tv :: Type    -- The particular type pattern from which to extract
                              -- its underlying type variable
                   -> ArgFlag -- The visibility of the type pattern
                              -- (only used for error message purposes)
                   -> TcM TyVar
        extract_tv :: Type -> ArgFlag -> IOEnv (Env TcGblEnv TcLclEnv) TyCoVar
    extract_tv Type
    pat ArgFlag
    pat_vis =
          case Type -> Maybe TyCoVar
    getTyVar_maybe Type
    pat of
            Just TyCoVar
    tv -> TyCoVar -> IOEnv (Env TcGblEnv TcLclEnv) TyCoVar
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TyCoVar
    tv
            Maybe TyCoVar
    Nothing -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) TyCoVar
    forall a. SDoc -> TcM a
    failWithTc (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) TyCoVar)
    -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) TyCoVar
    forall a b. (a -> b) -> a -> b
    $
              Bool -> SDoc -> SDoc
    pprWithExplicitKindsWhen (ArgFlag -> Bool
    isInvisibleArgFlag ArgFlag
    pat_vis) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
              SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Illegal argument" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    pat) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "in:")
                 Int
    2 ([SDoc] -> SDoc
    vcat [SDoc
    ppr_eqn, SDoc
    suggestion])

        -- Checks that no type variables in an associated default declaration are
        -- duplicated. If that is the case, throw an error.
        -- See Note [Type-checking default assoc decls]
        check_all_distinct_tvs ::
             [(TyVar, ArgFlag)] -- The type variable arguments in the associated
                                -- default declaration, along with their respective
                                -- visibilities (the latter are only used for error
                                -- message purposes)
          -> TcM ()
        check_all_distinct_tvs :: [(TyCoVar, ArgFlag)] -> TcM ()
    check_all_distinct_tvs [(TyCoVar, ArgFlag)]
    cpt_tvs_vis =
          let dups :: [NonEmpty (TyCoVar, ArgFlag)]
    dups = ((TyCoVar, ArgFlag) -> (TyCoVar, ArgFlag) -> Bool)
    -> [(TyCoVar, ArgFlag)] -> [NonEmpty (TyCoVar, ArgFlag)]
    forall a. (a -> a -> Bool) -> [a] -> [NonEmpty a]
    findDupsEq (TyCoVar -> TyCoVar -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (TyCoVar -> TyCoVar -> Bool)
    -> ((TyCoVar, ArgFlag) -> TyCoVar)
    -> (TyCoVar, ArgFlag)
    -> (TyCoVar, ArgFlag)
    -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (TyCoVar, ArgFlag) -> TyCoVar
    forall a b. (a, b) -> a
    fst) [(TyCoVar, ArgFlag)]
    cpt_tvs_vis in
          (NonEmpty (TyCoVar, ArgFlag) -> IOEnv (Env TcGblEnv TcLclEnv) Any)
    -> [NonEmpty (TyCoVar, ArgFlag)] -> TcM ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_
            (\NonEmpty (TyCoVar, ArgFlag)
    d -> let (TyCoVar
    pat_tv, ArgFlag
    pat_vis) = NonEmpty (TyCoVar, ArgFlag) -> (TyCoVar, ArgFlag)
    forall a. NonEmpty a -> a
    NE.head NonEmpty (TyCoVar, ArgFlag)
    d in SDoc -> IOEnv (Env TcGblEnv TcLclEnv) Any
    forall a. SDoc -> TcM a
    failWithTc (SDoc -> IOEnv (Env TcGblEnv TcLclEnv) Any)
    -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) Any
    forall a b. (a -> b) -> a -> b
    $
                   Bool -> SDoc -> SDoc
    pprWithExplicitKindsWhen (ArgFlag -> Bool
    isInvisibleArgFlag ArgFlag
    pat_vis) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                   SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Illegal duplicate variable"
                           SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCoVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCoVar
    pat_tv) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "in:")
                      Int
    2 ([SDoc] -> SDoc
    vcat [SDoc
    ppr_eqn, SDoc
    suggestion]))
            [NonEmpty (TyCoVar, ArgFlag)]
    dups

        ppr_eqn :: SDoc
        ppr_eqn :: SDoc
    ppr_eqn =
          SDoc -> SDoc
    quotes (String -> SDoc
    text String
    "type" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> [Type] -> Type
    mkTyConApp TyCon
    fam_tc [Type]
    pats)
                    SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "...")

        suggestion :: SDoc
        suggestion :: SDoc
    suggestion = String -> SDoc
    text String
    "The arguments to" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    fam_tc)
                 SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "must all be distinct type variables"

    -- Make sure that each type family application is
    --   (1) strictly smaller than the lhs,
    --   (2) mentions no type variable more often than the lhs, and
    --   (3) does not contain any further type family instances.
    --
    checkFamInstRhs :: TyCon -> [Type]         -- LHS
                    -> [(TyCon, [Type])]       -- type family calls in RHS
                    -> [SDoc]
    checkFamInstRhs :: TyCon -> [Type] -> [(TyCon, [Type])] -> [SDoc]
    checkFamInstRhs TyCon
    lhs_tc [Type]
    lhs_tys [(TyCon, [Type])]
    famInsts
      = ((TyCon, [Type]) -> Maybe SDoc) -> [(TyCon, [Type])] -> [SDoc]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (TyCon, [Type]) -> Maybe SDoc
    check [(TyCon, [Type])]
    famInsts
      where
       lhs_size :: Int
    lhs_size  = TyCon -> [Type] -> Int
    sizeTyConAppArgs TyCon
    lhs_tc [Type]
    lhs_tys
       inst_head :: SDoc
    inst_head = Type -> SDoc
    pprType (TyCon -> [Type] -> Type
    TyConApp TyCon
    lhs_tc [Type]
    lhs_tys)
       lhs_fvs :: [TyCoVar]
    lhs_fvs   = [Type] -> [TyCoVar]
    fvTypes [Type]
    lhs_tys
       check :: (TyCon, [Type]) -> Maybe SDoc
    check (TyCon
    tc, [Type]
    tys)
          | Bool -> Bool
    not ((Type -> Bool) -> [Type] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Type -> Bool
    isTyFamFree [Type]
    tys) = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> SDoc
    nestedMsg SDoc
    what)
          | Bool -> Bool
    not ([TyCoVar] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyCoVar]
    bad_tvs)        = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just ([TyCoVar] -> SDoc -> SDoc -> SDoc
    noMoreMsg [TyCoVar]
    bad_tvs SDoc
    what SDoc
    inst_head)
          | Int
    lhs_size Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    fam_app_size  = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> SDoc -> SDoc
    smallerMsg SDoc
    what SDoc
    inst_head)
          | Bool
    otherwise                 = Maybe SDoc
    forall a. Maybe a
    Nothing
          where
            what :: SDoc
    what = String -> SDoc
    text String
    "type family application"
                   SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    pprType (TyCon -> [Type] -> Type
    TyConApp TyCon
    tc [Type]
    tys))
            fam_app_size :: Int
    fam_app_size = TyCon -> [Type] -> Int
    sizeTyConAppArgs TyCon
    tc [Type]
    tys
            bad_tvs :: [TyCoVar]
    bad_tvs      = [Type] -> [TyCoVar]
    fvTypes [Type]
    tys [TyCoVar] -> [TyCoVar] -> [TyCoVar]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [TyCoVar]
    lhs_fvs
                           -- The (\\) is list difference; e.g.
                           --   [a,b,a,a] \\ [a,a] = [b,a]
                           -- So we are counting repetitions

    -----------------
    checkFamPatBinders :: TyCon
                       -> [TcTyVar]   -- Bound on LHS of family instance
                       -> [TcType]    -- LHS patterns
                       -> Type        -- RHS
                       -> TcM ()
    checkFamPatBinders :: TyCon -> [TyCoVar] -> [Type] -> Type -> TcM ()
    checkFamPatBinders TyCon
    fam_tc [TyCoVar]
    qtvs [Type]
    pats Type
    rhs
      = do { String -> SDoc -> TcM ()
    traceTc String
    "checkFamPatBinders" (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
             [SDoc] -> SDoc
    vcat [ Type -> SDoc
    debugPprType (TyCon -> [Type] -> Type
    mkTyConApp TyCon
    fam_tc [Type]
    pats)
                  , Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> [Type] -> Type
    mkTyConApp TyCon
    fam_tc [Type]
    pats)
                  , String -> SDoc
    text String
    "qtvs:" SDoc -> SDoc -> SDoc
    <+> [TyCoVar] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TyCoVar]
    qtvs
                  , String -> SDoc
    text String
    "rhs_tvs:" SDoc -> SDoc -> SDoc
    <+> VarSet -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (FV -> VarSet
    fvVarSet FV
    rhs_fvs)
                  , String -> SDoc
    text String
    "cpt_tvs:" SDoc -> SDoc -> SDoc
    <+> VarSet -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr VarSet
    cpt_tvs
                  , String -> SDoc
    text String
    "inj_cpt_tvs:" SDoc -> SDoc -> SDoc
    <+> VarSet -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr VarSet
    inj_cpt_tvs ]

             -- Check for implicitly-bound tyvars, mentioned on the
             -- RHS but not bound on the LHS
             --    data T            = MkT (forall (a::k). blah)
             --    data family D Int = MkD (forall (a::k). blah)
             -- In both cases, 'k' is not bound on the LHS, but is used on the RHS
             -- We catch the former in kcDeclHeader, and the latter right here
             -- See Note [Check type-family instance binders]
           ; [TyCoVar] -> SDoc -> SDoc -> TcM ()
    check_tvs [TyCoVar]
    bad_rhs_tvs (String -> SDoc
    text String
    "mentioned in the RHS")
                                   (String -> SDoc
    text String
    "bound on the LHS of")

             -- Check for explicitly forall'd variable that is not bound on LHS
             --    data instance forall a.  T Int = MkT Int
             -- See Note [Unused explicitly bound variables in a family pattern]
             -- See Note [Check type-family instance binders]
           ; [TyCoVar] -> SDoc -> SDoc -> TcM ()
    check_tvs [TyCoVar]
    bad_qtvs (String -> SDoc
    text String
    "bound by a forall")
                                (String -> SDoc
    text String
    "used in")
           }
      where
        cpt_tvs :: VarSet
    cpt_tvs     = [Type] -> VarSet
    tyCoVarsOfTypes [Type]
    pats
        inj_cpt_tvs :: VarSet
    inj_cpt_tvs = FV -> VarSet
    fvVarSet (FV -> VarSet) -> FV -> VarSet
    forall a b. (a -> b) -> a -> b
    $ Bool -> [Type] -> FV
    injectiveVarsOfTypes Bool
    False [Type]
    pats
          -- The type variables that are in injective positions.
          -- See Note [Dodgy binding sites in type family instances]
          -- NB: The False above is irrelevant, as we never have type families in
          -- patterns.
          --
          -- NB: It's OK to use the nondeterministic `fvVarSet` function here,
          -- since the order of `inj_cpt_tvs` is never revealed in an error
          -- message.
        rhs_fvs :: FV
    rhs_fvs     = Type -> FV
    tyCoFVsOfType Type
    rhs
        used_tvs :: VarSet
    used_tvs    = VarSet
    cpt_tvs VarSet -> VarSet -> VarSet
    `unionVarSet` FV -> VarSet
    fvVarSet FV
    rhs_fvs
        bad_qtvs :: [TyCoVar]
    bad_qtvs    = (TyCoVar -> Bool) -> [TyCoVar] -> [TyCoVar]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (TyCoVar -> VarSet -> Bool
    `elemVarSet` VarSet
    used_tvs) [TyCoVar]
    qtvs
                      -- Bound but not used at all
        bad_rhs_tvs :: [TyCoVar]
    bad_rhs_tvs = (TyCoVar -> Bool) -> [TyCoVar] -> [TyCoVar]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (TyCoVar -> VarSet -> Bool
    `elemVarSet` VarSet
    inj_cpt_tvs) (FV -> [TyCoVar]
    fvVarList FV
    rhs_fvs)
                      -- Used on RHS but not bound on LHS
        dodgy_tvs :: VarSet
    dodgy_tvs   = VarSet
    cpt_tvs VarSet -> VarSet -> VarSet
    `minusVarSet` VarSet
    inj_cpt_tvs

        check_tvs :: [TyCoVar] -> SDoc -> SDoc -> TcM ()
    check_tvs [TyCoVar]
    tvs SDoc
    what SDoc
    what2
          = Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([TyCoVar] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyCoVar]
    tvs) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> SDoc -> TcM ()
    addErrAt (TyCoVar -> SrcSpan
    forall a. NamedThing a => a -> SrcSpan
    getSrcSpan ([TyCoVar] -> TyCoVar
    forall a. [a] -> a
    head [TyCoVar]
    tvs)) (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
            SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Type variable" SDoc -> SDoc -> SDoc
    <> [TyCoVar] -> SDoc
    forall a. [a] -> SDoc
    plural [TyCoVar]
    tvs SDoc -> SDoc -> SDoc
    <+> [TyCoVar] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TyCoVar]
    tvs
                  SDoc -> SDoc -> SDoc
    <+> [TyCoVar] -> SDoc
    forall a. [a] -> SDoc
    isOrAre [TyCoVar]
    tvs SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <> SDoc
    comma)
               Int
    2 ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "but not" SDoc -> SDoc -> SDoc
    <+> SDoc
    what2 SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "the family instance"
                       , [TyCoVar] -> SDoc
    mk_extra [TyCoVar]
    tvs ])

        -- mk_extra: #7536: give a decent error message for
        --         type T a = Int
        --         type instance F (T a) = a
        mk_extra :: [TyCoVar] -> SDoc
    mk_extra [TyCoVar]
    tvs = Bool -> SDoc -> SDoc
    ppWhen ((TyCoVar -> Bool) -> [TyCoVar] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (TyCoVar -> VarSet -> Bool
    `elemVarSet` VarSet
    dodgy_tvs) [TyCoVar]
    tvs) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                       SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "The real LHS (expanding synonyms) is:")
                          Int
    2 (TyCon -> [Type] -> SDoc
    pprTypeApp TyCon
    fam_tc ((Type -> Type) -> [Type] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Type -> Type
    expandTypeSynonyms [Type]
    pats))

    -- | Checks that a list of type patterns is valid in a matching (LHS)
    -- position of a class instances or type/data family instance.
    --
    -- Specifically:
    --    * All monotypes
    --    * No type-family applications
    checkValidTypePats :: TyCon -> [Type] -> TcM ()
    checkValidTypePats :: TyCon -> [Type] -> TcM ()
    checkValidTypePats TyCon
    tc [Type]
    pat_ty_args
      = do { -- Check that each of pat_ty_args is a monotype.
             -- One could imagine generalising to allow
             --      instance C (forall a. a->a)
             -- but we don't know what all the consequences might be.
             (Type -> TcM ()) -> [Type] -> TcM ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    (a -> f b) -> t a -> f ()
    traverse_ Type -> TcM ()
    checkValidMonoType [Type]
    pat_ty_args

           -- Ensure that no type family applications occur a type pattern
           ; case TyCon -> [Type] -> [(Bool, TyCon, [Type])]
    tcTyConAppTyFamInstsAndVis TyCon
    tc [Type]
    pat_ty_args of
                [] -> () -> TcM ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
                ((Bool
    tf_is_invis_arg, TyCon
    tf_tc, [Type]
    tf_args):[(Bool, TyCon, [Type])]
    _) -> SDoc -> TcM ()
    forall a. SDoc -> TcM a
    failWithTc (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
                   Bool -> Type -> SDoc
    ty_fam_inst_illegal_err Bool
    tf_is_invis_arg
                                           (TyCon -> [Type] -> Type
    mkTyConApp TyCon
    tf_tc [Type]
    tf_args) }
      where
        inst_ty :: Type
    inst_ty = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    tc [Type]
    pat_ty_args

        ty_fam_inst_illegal_err :: Bool -> Type -> SDoc
        ty_fam_inst_illegal_err :: Bool -> Type -> SDoc
    ty_fam_inst_illegal_err Bool
    invis_arg Type
    ty
          = Bool -> SDoc -> SDoc
    pprWithExplicitKindsWhen Bool
    invis_arg (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
            SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Illegal type synonym family application"
                    SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    ty) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "in instance" SDoc -> SDoc -> SDoc
    <> SDoc
    colon)
               Int
    2 (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    inst_ty)

    -- Error messages

    inaccessibleCoAxBranch :: TyCon -> CoAxBranch -> SDoc
    inaccessibleCoAxBranch :: TyCon -> CoAxBranch -> SDoc
    inaccessibleCoAxBranch TyCon
    fam_tc CoAxBranch
    cur_branch
      = String -> SDoc
    text String
    "Type family instance equation is overlapped:" SDoc -> SDoc -> SDoc
    $$
        Int -> SDoc -> SDoc
    nest Int
    2 (TyCon -> CoAxBranch -> SDoc
    pprCoAxBranchUser TyCon
    fam_tc CoAxBranch
    cur_branch)

    nestedMsg :: SDoc -> SDoc
    nestedMsg :: SDoc -> SDoc
    nestedMsg SDoc
    what
      = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Illegal nested" SDoc -> SDoc -> SDoc
    <+> SDoc
    what
            , SDoc -> SDoc
    parens SDoc
    undecidableMsg ]

    badATErr :: Name -> Name -> SDoc
    badATErr :: Name -> Name -> SDoc
    badATErr Name
    clas Name
    op
      = [SDoc] -> SDoc
    hsep [String -> SDoc
    text String
    "Class", SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    clas),
              String -> SDoc
    text String
    "does not have an associated type", SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    op)]

    -------------------------
    checkConsistentFamInst :: AssocInstInfo
                           -> TyCon     -- ^ Family tycon
                           -> CoAxBranch
                           -> TcM ()
    -- See Note [Checking consistent instantiation]

    checkConsistentFamInst :: AssocInstInfo -> TyCon -> CoAxBranch -> TcM ()
    checkConsistentFamInst AssocInstInfo
    NotAssociated TyCon
    _ CoAxBranch
    _
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    checkConsistentFamInst (InClsInst { ai_class :: AssocInstInfo -> Class
    ai_class = Class
    clas
                                      , ai_tyvars :: AssocInstInfo -> [TyCoVar]
    ai_tyvars = [TyCoVar]
    inst_tvs
                                      , ai_inst_env :: AssocInstInfo -> VarEnv Type
    ai_inst_env = VarEnv Type
    mini_env })
                           TyCon
    fam_tc CoAxBranch
    branch
      = do { String -> SDoc -> TcM ()
    traceTc String
    "checkConsistentFamInst" ([SDoc] -> SDoc
    vcat [ [TyCoVar] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TyCoVar]
    inst_tvs
                                                    , [(Type, Type, ArgFlag)] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [(Type, Type, ArgFlag)]
    arg_triples
                                                    , VarEnv Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr VarEnv Type
    mini_env
                                                    , [TyCoVar] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TyCoVar]
    ax_tvs
                                                    , [Type] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Type]
    ax_arg_tys
                                                    , [(Type, Type, ArgFlag)] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [(Type, Type, ArgFlag)]
    arg_triples ])
           -- Check that the associated type indeed comes from this class
           -- See [Mismatched class methods and associated type families]
           -- in TcInstDecls.
           ; Bool -> SDoc -> TcM ()
    checkTc (TyCon -> Maybe TyCon
    forall a. a -> Maybe a
    Just (Class -> TyCon
    classTyCon Class
    clas) Maybe TyCon -> Maybe TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon -> Maybe TyCon
    tyConAssoc_maybe TyCon
    fam_tc)
                     (Name -> Name -> SDoc
    badATErr (Class -> Name
    className Class
    clas) (TyCon -> Name
    tyConName TyCon
    fam_tc))

           ; [(Type, Type, ArgFlag)] -> TcM ()
    check_match [(Type, Type, ArgFlag)]
    arg_triples
           }
      where
        ([TyCoVar]
    ax_tvs, [Type]
    ax_arg_tys, Type
    _) = CoAxBranch -> ([TyCoVar], [Type], Type)
    etaExpandCoAxBranch CoAxBranch
    branch

        arg_triples :: [(Type,Type, ArgFlag)]
        arg_triples :: [(Type, Type, ArgFlag)]
    arg_triples = [ (Type
    cls_arg_ty, Type
    at_arg_ty, ArgFlag
    vis)
                      | (TyCoVar
    fam_tc_tv, ArgFlag
    vis, Type
    at_arg_ty)
                           <- [TyCoVar] -> [ArgFlag] -> [Type] -> [(TyCoVar, ArgFlag, Type)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 (TyCon -> [TyCoVar]
    tyConTyVars TyCon
    fam_tc)
                                   (TyCon -> [Type] -> [ArgFlag]
    tyConArgFlags TyCon
    fam_tc [Type]
    ax_arg_tys)
                                   [Type]
    ax_arg_tys
                      , Just Type
    cls_arg_ty <- [VarEnv Type -> TyCoVar -> Maybe Type
    forall a. VarEnv a -> TyCoVar -> Maybe a
    lookupVarEnv VarEnv Type
    mini_env TyCoVar
    fam_tc_tv] ]

        pp_wrong_at_arg :: ArgFlag -> SDoc
    pp_wrong_at_arg ArgFlag
    vis
          = Bool -> SDoc -> SDoc
    pprWithExplicitKindsWhen (ArgFlag -> Bool
    isInvisibleArgFlag ArgFlag
    vis) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
            [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Type indexes must match class instance head"
                 , String -> SDoc
    text String
    "Expected:" SDoc -> SDoc -> SDoc
    <+> SDoc
    pp_expected_ty
                 , String -> SDoc
    text String
    "  Actual:" SDoc -> SDoc -> SDoc
    <+> SDoc
    pp_actual_ty ]

        -- Fiddling around to arrange that wildcards unconditionally print as "_"
        -- We only need to print the LHS, not the RHS at all
        -- See Note [Printing conflicts with class header]
        (TidyEnv
    tidy_env1, [TyCoVar]
    _) = TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])
    tidyVarBndrs TidyEnv
    emptyTidyEnv [TyCoVar]
    inst_tvs
        (TidyEnv
    tidy_env2, [TyCoVar]
    _) = TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])
    tidyCoAxBndrsForUser TidyEnv
    tidy_env1 ([TyCoVar]
    ax_tvs [TyCoVar] -> [TyCoVar] -> [TyCoVar]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [TyCoVar]
    inst_tvs)

        pp_expected_ty :: SDoc
    pp_expected_ty = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
    pprIfaceTypeApp PprPrec
    topPrec (TyCon -> IfaceTyCon
    toIfaceTyCon TyCon
    fam_tc) (IfaceAppArgs -> SDoc) -> IfaceAppArgs -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                         TyCon -> [Type] -> IfaceAppArgs
    toIfaceTcArgs TyCon
    fam_tc ([Type] -> IfaceAppArgs) -> [Type] -> IfaceAppArgs
    forall a b. (a -> b) -> a -> b
    $
                         [ case VarEnv Type -> TyCoVar -> Maybe Type
    forall a. VarEnv a -> TyCoVar -> Maybe a
    lookupVarEnv VarEnv Type
    mini_env TyCoVar
    at_tv of
                             Just Type
    cls_arg_ty -> TidyEnv -> Type -> Type
    tidyType TidyEnv
    tidy_env2 Type
    cls_arg_ty
                             Maybe Type
    Nothing         -> TyCoVar -> Type
    mk_wildcard TyCoVar
    at_tv
                         | TyCoVar
    at_tv <- TyCon -> [TyCoVar]
    tyConTyVars TyCon
    fam_tc ]

        pp_actual_ty :: SDoc
    pp_actual_ty = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
    pprIfaceTypeApp PprPrec
    topPrec (TyCon -> IfaceTyCon
    toIfaceTyCon TyCon
    fam_tc) (IfaceAppArgs -> SDoc) -> IfaceAppArgs -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                       TyCon -> [Type] -> IfaceAppArgs
    toIfaceTcArgs TyCon
    fam_tc ([Type] -> IfaceAppArgs) -> [Type] -> IfaceAppArgs
    forall a b. (a -> b) -> a -> b
    $
                       TidyEnv -> [Type] -> [Type]
    tidyTypes TidyEnv
    tidy_env2 [Type]
    ax_arg_tys

        mk_wildcard :: TyCoVar -> Type
    mk_wildcard TyCoVar
    at_tv = TyCoVar -> Type
    mkTyVarTy (Name -> Type -> TyCoVar
    mkTyVar Name
    tv_name (TyCoVar -> Type
    tyVarKind TyCoVar
    at_tv))
        tv_name :: Name
    tv_name = Unique -> OccName -> SrcSpan -> Name
    mkInternalName (Int -> Unique
    mkAlphaTyVarUnique Int
    1) (String -> OccName
    mkTyVarOcc String
    "_") SrcSpan
    noSrcSpan

        -- For check_match, bind_me, see
        -- Note [Matching in the consistent-instantiation check]
        check_match :: [(Type,Type,ArgFlag)] -> TcM ()
        check_match :: [(Type, Type, ArgFlag)] -> TcM ()
    check_match [(Type, Type, ArgFlag)]
    triples = TCvSubst -> TCvSubst -> [(Type, Type, ArgFlag)] -> TcM ()
    go TCvSubst
    emptyTCvSubst TCvSubst
    emptyTCvSubst [(Type, Type, ArgFlag)]
    triples

        go :: TCvSubst -> TCvSubst -> [(Type, Type, ArgFlag)] -> TcM ()
    go TCvSubst
    _ TCvSubst
    _ [] = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go TCvSubst
    lr_subst TCvSubst
    rl_subst ((Type
    ty1,Type
    ty2,ArgFlag
    vis):[(Type, Type, ArgFlag)]
    triples)
          | Just TCvSubst
    lr_subst1 <- BindFun -> TCvSubst -> Type -> Type -> Maybe TCvSubst
    tcMatchTyX_BM BindFun
    bind_me TCvSubst
    lr_subst Type
    ty1 Type
    ty2
          , Just TCvSubst
    rl_subst1 <- BindFun -> TCvSubst -> Type -> Type -> Maybe TCvSubst
    tcMatchTyX_BM BindFun
    bind_me TCvSubst
    rl_subst Type
    ty2 Type
    ty1
          = TCvSubst -> TCvSubst -> [(Type, Type, ArgFlag)] -> TcM ()
    go TCvSubst
    lr_subst1 TCvSubst
    rl_subst1 [(Type, Type, ArgFlag)]
    triples
          | Bool
    otherwise
          = SDoc -> TcM ()
    addErrTc (ArgFlag -> SDoc
    pp_wrong_at_arg ArgFlag
    vis)

        -- The /scoped/ type variables from the class-instance header
        -- should not be alpha-renamed.  Inferred ones can be.
        no_bind_set :: VarSet
    no_bind_set = [TyCoVar] -> VarSet
    mkVarSet [TyCoVar]
    inst_tvs
        bind_me :: BindFun
    bind_me TyCoVar
    tv Type
    _ty | TyCoVar
    tv TyCoVar -> VarSet -> Bool
    `elemVarSet` VarSet
    no_bind_set = BindFlag
    Apart
                       | Bool
    otherwise                   = BindFlag
    BindMe

    {- Note [Check type-family instance binders]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In a type family instance, we require (of course), type variables
    used on the RHS are matched on the LHS. This is checked by
    checkFamPatBinders.  Here is an interesting example:

        type family   T :: k
        type instance T = (Nothing :: Maybe a)

    Upon a cursory glance, it may appear that the kind variable `a` is unbound
    since there are no (visible) LHS patterns in `T`. However, there is an
    *invisible* pattern due to the return kind, so inside of GHC, the instance
    looks closer to this:

        type family T @k :: k
        type instance T @(Maybe a) = (Nothing :: Maybe a)

    Here, we can see that `a` really is bound by a LHS type pattern, so `a` is in
    fact not unbound. Contrast that with this example (#13985)

        type instance T = Proxy (Nothing :: Maybe a)

    This would looks like this inside of GHC:

        type instance T @(*) = Proxy (Nothing :: Maybe a)

    So this time, `a` is neither bound by a visible nor invisible type pattern on
    the LHS, so `a` would be reported as not in scope.

    Finally, here's one more brain-teaser (from #9574). In the example below:

        class Funct f where
          type Codomain f :: *
        instance Funct ('KProxy :: KProxy o) where
          type Codomain 'KProxy = NatTr (Proxy :: o -> *)

    As it turns out, `o` is in scope in this example. That is because `o` is
    bound by the kind signature of the LHS type pattern 'KProxy. To make this more
    obvious, one can also write the instance like so:

        instance Funct ('KProxy :: KProxy o) where
          type Codomain ('KProxy :: KProxy o) = NatTr (Proxy :: o -> *)

    Note [Dodgy binding sites in type family instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider the following example (from #7536):

      type T a = Int
      type instance F (T a) = a

    This `F` instance is extremely fishy, since the RHS, `a`, purports to be
    "bound" by the LHS pattern `T a`. "Bound" has scare quotes around it because
    `T a` expands to `Int`, which doesn't mention at all, so it's as if one had
    actually written:

      type instance F Int = a

    That is clearly bogus, so to reject this, we check that every type variable
    that is mentioned on the RHS is /actually/ bound on the LHS. In other words,
    we need to do something slightly more sophisticated that just compute the free
    variables of the LHS patterns.

    It's tempting to just expand all type synonyms on the LHS and then compute
    their free variables, but even that isn't sophisticated enough. After all,
    an impish user could write the following (#17008):

      type family ConstType (a :: Type) :: Type where
        ConstType _ = Type

      type family F (x :: ConstType a) :: Type where
        F (x :: ConstType a) = a

    Just like in the previous example, the `a` on the RHS isn't actually bound
    on the LHS, but this time a type family is responsible for the deception, not
    a type synonym.

    We avoid both issues by requiring that all RHS type variables are mentioned
    in injective positions on the left-hand side (by way of
    `injectiveVarsOfTypes`). For instance, the `a` in `T a` is not in an injective
    position, as `T` is not an injective type constructor, so we do not count that.
    Similarly for the `a` in `ConstType a`.

    Note [Matching in the consistent-instantiation check]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Matching the class-instance header to family-instance tyvars is
    tricker than it sounds.  Consider (#13972)
        class C (a :: k) where
          type T k :: Type
        instance C Left where
          type T (a -> Either a b) = Int

    Here there are no lexically-scoped variables from (C Left).
    Yet the real class-instance header is   C @(p -> Either @p @q)) (Left @p @q)
    while the type-family instance is       T (a -> Either @a @b)
    So we allow alpha-renaming of variables that don't come
    from the class-instance header.

    We track the lexically-scoped type variables from the
    class-instance header in ai_tyvars.

    Here's another example (#14045a)
        class C (a :: k) where
          data S (a :: k)
        instance C (z :: Bool) where
          data S :: Bool -> Type where

    Again, there is no lexical connection, but we will get
       class-instance header:   C @Bool (z::Bool)
       family instance          S @Bool (a::Bool)

    When looking for mis-matches, we check left-to-right,
    kinds first.  If we look at types first, we'll fail to
    suggest -fprint-explicit-kinds for a mis-match with
          T @k    vs    T @Type
    somewhere deep inside the type

    Note [Checking consistent instantiation]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    See #11450 for background discussion on this check.

      class C a b where
        type T a x b

    With this class decl, if we have an instance decl
      instance C ty1 ty2 where ...
    then the type instance must look like
         type T ty1 v ty2 = ...
    with exactly 'ty1' for 'a', 'ty2' for 'b', and some type 'v' for 'x'.
    For example:

      instance C [p] Int
        type T [p] y Int = (p,y,y)

    Note that

    * We used to allow completely different bound variables in the
      associated type instance; e.g.
        instance C [p] Int
          type T [q] y Int = ...
      But from GHC 8.2 onwards, we don't.  It's much simpler this way.
      See #11450.

    * When the class variable isn't used on the RHS of the type instance,
      it's tempting to allow wildcards, thus
        instance C [p] Int
          type T [_] y Int = (y,y)
      But it's awkward to do the test, and it doesn't work if the
      variable is repeated:
        instance C (p,p) Int
          type T (_,_) y Int = (y,y)
      Even though 'p' is not used on the RHS, we still need to use 'p'
      on the LHS to establish the repeated pattern.  So to keep it simple
      we just require equality.

    * For variables in associated type families that are not bound by the class
      itself, we do _not_ check if they are over-specific. In other words,
      it's perfectly acceptable to have an instance like this:

        instance C [p] Int where
          type T [p] (Maybe x) Int = x

      While the first and third arguments to T are required to be exactly [p] and
      Int, respectively, since they are bound by C, the second argument is allowed
      to be more specific than just a type variable. Furthermore, it is permissible
      to define multiple equations for T that differ only in the non-class-bound
      argument:

        instance C [p] Int where
          type T [p] (Maybe x)    Int = x
          type T [p] (Either x y) Int = x -> y

      We once considered requiring that non-class-bound variables in associated
      type family instances be instantiated with distinct type variables. However,
      that requirement proved too restrictive in practice, as there were examples
      of extremely simple associated type family instances that this check would
      reject, and fixing them required tiresome boilerplate in the form of
      auxiliary type families. For instance, you would have to define the above
      example as:

        instance C [p] Int where
          type T [p] x Int = CAux x

        type family CAux x where
          CAux (Maybe x)    = x
          CAux (Either x y) = x -> y

      We decided that this restriction wasn't buying us much, so we opted not
      to pursue that design (see also GHC #13398).

    Implementation
      * Form the mini-envt from the class type variables a,b
        to the instance decl types [p],Int:   [a->[p], b->Int]

      * Look at the tyvars a,x,b of the type family constructor T
        (it shares tyvars with the class C)

      * Apply the mini-evnt to them, and check that the result is
        consistent with the instance types [p] y Int. (where y can be any type, as
        it is not scoped over the class type variables.

    We make all the instance type variables scope over the
    type instances, of course, which picks up non-obvious kinds.  Eg
       class Foo (a :: k) where
          type F a
       instance Foo (b :: k -> k) where
          type F b = Int
    Here the instance is kind-indexed and really looks like
          type F (k->k) (b::k->k) = Int
    But if the 'b' didn't scope, we would make F's instance too
    poly-kinded.

    Note [Printing conflicts with class header]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    It's remarkably painful to give a decent error message for conflicts
    with the class header.  Consider
       clase C b where
         type F a b c
       instance C [b] where
         type F x Int _ _ = ...

    Here we want to report a conflict between
        Expected: F _ [b] _
        Actual:   F x Int _ _

    But if the type instance shadows the class variable like this
    (rename/should_fail/T15828):
       instance C [b] where
         type forall b. F x (Tree b) _ _ = ...

    then we must use a fresh variable name
        Expected: F _ [b] _
        Actual:   F x [b1] _ _

    Notice that:
      - We want to print an underscore in the "Expected" type in
        positions where the class header has no influence over the
        parameter.  Hence the fancy footwork in pp_expected_ty

      - Although the binders in the axiom are already tidy, we must
        re-tidy them to get a fresh variable name when we shadow

      - The (ax_tvs \\ inst_tvs) is to avoid tidying one of the
        class-instance variables a second time, from 'a' to 'a1' say.
        Remember, the ax_tvs of the axiom share identity with the
        class-instance variables, inst_tvs..

      - We use tidyCoAxBndrsForUser to get underscores rather than
        _1, _2, etc in the axiom tyvars; see the definition of
        tidyCoAxBndrsForUser

    This all seems absurdly complicated.

    Note [Unused explicitly bound variables in a family pattern]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    Why is 'unusedExplicitForAllErr' not just a warning?

    Consider the following examples:

      type instance F a = Maybe b
      type instance forall b. F a = Bool
      type instance forall b. F a = Maybe b

    In every case, b is a type variable not determined by the LHS pattern. The
    first is caught by the renamer, but we catch the last two here. Perhaps one
    could argue that the second should be accepted, albeit with a warning, but
    consider the fact that in a type family instance, there is no way to interact
    with such a varable. At least with @x :: forall a. Int@ we can use visibile
    type application, like @x \@Bool 1@. (Of course it does nothing, but it is
    permissible.) In the type family case, the only sensible explanation is that
    the user has made a mistake -- thus we throw an error.

    Note [Oversaturated type family equations]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Type family tycons have very rigid arities. We want to reject something like
    this:

      type family Foo :: Type -> Type where
        Foo x = ...

    Because Foo has arity zero (i.e., it doesn't bind anything to the left of the
    double colon), we want to disallow any equation for Foo that has more than zero
    arguments, such as `Foo x = ...`. The algorithm here is pretty simple: if an
    equation has more arguments than the arity of the type family, reject.

    Things get trickier when visible kind application enters the picture. Consider
    the following example:

      type family Bar (x :: j) :: forall k. Either j k where
        Bar 5 @Symbol = ...

    The arity of Bar is two, since it binds two variables, `j` and `x`. But even
    though Bar's equation has two arguments, it's still invalid. Imagine the same
    equation in Core:

        Bar Nat 5 Symbol = ...

    Here, it becomes apparent that Bar is actually taking /three/ arguments! So
    we can't just rely on a simple counting argument to reject
    `Bar 5 @Symbol = ...`, since it only has two user-written arguments.
    Moreover, there's one explicit argument (5) and one visible kind argument
    (@Symbol), which matches up perfectly with the fact that Bar has one required
    binder (x) and one specified binder (j), so that's not a valid way to detect
    oversaturation either.

    To solve this problem in a robust way, we do the following:

    1. When kind-checking, we count the number of user-written *required*
       arguments and check if there is an equal number of required tycon binders.
       If not, reject. (See `wrongNumberOfParmsErr` in GHC.Tc.TyCl.)

       We perform this step during kind-checking, not during validity checking,
       since we can give better error messages if we catch it early.
    2. When validity checking, take all of the (Core) type patterns from on
       equation, drop the first n of them (where n is the arity of the type family
       tycon), and check if there are any types leftover. If so, reject.

       Why does this work? We know that after dropping the first n type patterns,
       none of the leftover types can be required arguments, since step (1) would
       have already caught that. Moreover, the only places where visible kind
       applications should be allowed are in the first n types, since those are the
       only arguments that can correspond to binding forms. Therefore, the
       remaining arguments must correspond to oversaturated uses of visible kind
       applications, which are precisely what we want to reject.

    Note that we only perform this check for type families, and not for data
    families. This is because it is perfectly acceptable to oversaturate data
    family instance equations: see Note [Arity of data families] in GHC.Core.FamInstEnv.

    ************************************************************************
    *                                                                      *
       Telescope checking
    *                                                                      *
    ************************************************************************

    Note [Bad TyCon telescopes]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Now that we can mix type and kind variables, there are an awful lot of
    ways to shoot yourself in the foot. Here are some.

      data SameKind :: k -> k -> *   -- just to force unification

    1.  data T1 a k (b :: k) (x :: SameKind a b)

    The problem here is that we discover that a and b should have the same
    kind. But this kind mentions k, which is bound *after* a.
    (Testcase: dependent/should_fail/BadTelescope)

    2.  data T2 a (c :: Proxy b) (d :: Proxy a) (x :: SameKind b d)

    Note that b is not bound. Yet its kind mentions a. Because we have
    a nice rule that all implicitly bound variables come before others,
    this is bogus.

    To catch these errors, we call checkTyConTelescope during kind-checking
    datatype declarations.  This checks for

    * Ill-scoped binders. From (1) and (2) above we can get putative
      kinds like
           T1 :: forall (a:k) (k:*) (b:k). SameKind a b -> *
      where 'k' is mentioned a's kind before k is bound

      This is easy to check for: just look for
      out-of-scope variables in the kind

    * We should arguably also check for ambiguous binders
      but we don't.  See Note [Ambiguous kind vars].

    See also
      * Note [Required, Specified, and Inferred for types] in GHC.Tc.TyCl.
      * Note [Checking telescopes] in GHC.Tc.Types.Constraint discusses how
        this check works for `forall x y z.` written in a type.

    Note [Ambiguous kind vars]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~
    We used to be concerned about ambiguous binders. Suppose we have the kind
         S1 :: forall k -> * -> *
         S2 :: forall k. * -> *
    Here S1 is OK, because k is Required, and at a use of S1 we will
    see (S1 *) or (S1 (*->*)) or whatever.

    But S2 is /not/ OK because 'k' is Specfied (and hence invisible) and
    we have no way (ever) to figure out how 'k' should be instantiated.
    For example if we see (S2 Int), that tells us nothing about k's
    instantiation.  (In this case we'll instantiate it to Any, but that
    seems wrong.)  This is really the same test as we make for ambiguous
    type in term type signatures.

    Now, it's impossible for a Specified variable not to occur
    at all in the kind -- after all, it is Specified so it must have
    occurred.  (It /used/ to be possible; see tests T13983 and T7873.  But
    with the advent of the forall-or-nothing rule for kind variables,
    those strange cases went away. See Note [forall-or-nothing rule] in
    GHC.Hs.Type.)

    But one might worry about
        type v k = *
        S3 :: forall k. V k -> *
    which appears to mention 'k' but doesn't really.  Or
        S4 :: forall k. F k -> *
    where F is a type function.  But we simply don't check for
    those cases of ambiguity, yet anyway.  The worst that can happen
    is ambiguity at the call sites.

    Historical note: this test used to be called reportFloatingKvs.
    -}

    -- | Check a list of binders to see if they make a valid telescope.
    -- See Note [Bad TyCon telescopes]
    type TelescopeAcc
          = ( TyVarSet   -- Bound earlier in the telescope
            , Bool       -- At least one binder occurred (in a kind) before
                         -- it was bound in the telescope.  E.g.
            )            --    T :: forall (a::k) k. blah

    checkTyConTelescope :: TyCon -> TcM ()
    checkTyConTelescope :: TyCon -> TcM ()
    checkTyConTelescope TyCon
    tc
      | Bool
    bad_scope
      = -- See "Ill-scoped binders" in Note [Bad TyCon telescopes]
        SDoc -> TcM ()
    addErr (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
        [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "The kind of" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is ill-scoped")
                  Int
    2 SDoc
    pp_tc_kind
             , SDoc
    extra
             , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Perhaps try this order instead:")
                  Int
    2 ([TyCoVar] -> SDoc
    pprTyVars [TyCoVar]
    sorted_tvs) ]

      | Bool
    otherwise
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where
        tcbs :: [VarBndr TyCoVar TyConBndrVis]
    tcbs = TyCon -> [VarBndr TyCoVar TyConBndrVis]
    tyConBinders TyCon
    tc
        tvs :: [TyCoVar]
    tvs  = [VarBndr TyCoVar TyConBndrVis] -> [TyCoVar]
    forall tv argf. [VarBndr tv argf] -> [tv]
    binderVars [VarBndr TyCoVar TyConBndrVis]
    tcbs
        sorted_tvs :: [TyCoVar]
    sorted_tvs = [TyCoVar] -> [TyCoVar]
    scopedSort [TyCoVar]
    tvs

        (VarSet
    _, Bool
    bad_scope) = ((VarSet, Bool) -> VarBndr TyCoVar TyConBndrVis -> (VarSet, Bool))
    -> (VarSet, Bool)
    -> [VarBndr TyCoVar TyConBndrVis]
    -> (VarSet, Bool)
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (VarSet, Bool) -> VarBndr TyCoVar TyConBndrVis -> (VarSet, Bool)
    add_one (VarSet
    emptyVarSet, Bool
    False) [VarBndr TyCoVar TyConBndrVis]
    tcbs

        add_one :: TelescopeAcc -> TyConBinder -> TelescopeAcc
        add_one :: (VarSet, Bool) -> VarBndr TyCoVar TyConBndrVis -> (VarSet, Bool)
    add_one (VarSet
    bound, Bool
    bad_scope) VarBndr TyCoVar TyConBndrVis
    tcb
          = ( VarSet
    bound VarSet -> TyCoVar -> VarSet
    `extendVarSet` TyCoVar
    tv
            , Bool
    bad_scope Bool -> Bool -> Bool
    || Bool -> Bool
    not (VarSet -> Bool
    isEmptyVarSet (VarSet
    fkvs VarSet -> VarSet -> VarSet
    `minusVarSet` VarSet
    bound)) )
          where
            tv :: TyCoVar
    tv = VarBndr TyCoVar TyConBndrVis -> TyCoVar
    forall tv argf. VarBndr tv argf -> tv
    binderVar VarBndr TyCoVar TyConBndrVis
    tcb
            fkvs :: VarSet
    fkvs = Type -> VarSet
    tyCoVarsOfType (TyCoVar -> Type
    tyVarKind TyCoVar
    tv)

        inferred_tvs :: [TyCoVar]
    inferred_tvs  = [ VarBndr TyCoVar TyConBndrVis -> TyCoVar
    forall tv argf. VarBndr tv argf -> tv
    binderVar VarBndr TyCoVar TyConBndrVis
    tcb
                        | VarBndr TyCoVar TyConBndrVis
    tcb <- [VarBndr TyCoVar TyConBndrVis]
    tcbs, ArgFlag
    Inferred ArgFlag -> ArgFlag -> Bool
    forall a. Eq a => a -> a -> Bool
    == VarBndr TyCoVar TyConBndrVis -> ArgFlag
    tyConBinderArgFlag VarBndr TyCoVar TyConBndrVis
    tcb ]
        specified_tvs :: [TyCoVar]
    specified_tvs = [ VarBndr TyCoVar TyConBndrVis -> TyCoVar
    forall tv argf. VarBndr tv argf -> tv
    binderVar VarBndr TyCoVar TyConBndrVis
    tcb
                        | VarBndr TyCoVar TyConBndrVis
    tcb <- [VarBndr TyCoVar TyConBndrVis]
    tcbs, ArgFlag
    Specified ArgFlag -> ArgFlag -> Bool
    forall a. Eq a => a -> a -> Bool
    == VarBndr TyCoVar TyConBndrVis -> ArgFlag
    tyConBinderArgFlag VarBndr TyCoVar TyConBndrVis
    tcb ]

        pp_inf :: SDoc
    pp_inf  = SDoc -> SDoc
    parens (String -> SDoc
    text String
    "namely:" SDoc -> SDoc -> SDoc
    <+> [TyCoVar] -> SDoc
    pprTyVars [TyCoVar]
    inferred_tvs)
        pp_spec :: SDoc
    pp_spec = SDoc -> SDoc
    parens (String -> SDoc
    text String
    "namely:" SDoc -> SDoc -> SDoc
    <+> [TyCoVar] -> SDoc
    pprTyVars [TyCoVar]
    specified_tvs)

        pp_tc_kind :: SDoc
    pp_tc_kind = String -> SDoc
    text String
    "Inferred kind:" SDoc -> SDoc -> SDoc
    <+> TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    ppr_untidy (TyCon -> Type
    tyConKind TyCon
    tc)
        ppr_untidy :: Type -> SDoc
    ppr_untidy Type
    ty = IfaceType -> SDoc
    pprIfaceType (Type -> IfaceType
    toIfaceType Type
    ty)
          -- We need ppr_untidy here because pprType will tidy the type, which
          -- will turn the bogus kind we are trying to report
          --     T :: forall (a::k) k (b::k) -> blah
          -- into a misleadingly sanitised version
          --     T :: forall (a::k) k1 (b::k1) -> blah

        extra :: SDoc
    extra
          | [TyCoVar] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyCoVar]
    inferred_tvs Bool -> Bool -> Bool
    && [TyCoVar] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyCoVar]
    specified_tvs
          = SDoc
    empty
          | [TyCoVar] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyCoVar]
    inferred_tvs
          = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "NB: Specified variables")
               Int
    2 ([SDoc] -> SDoc
    sep [SDoc
    pp_spec, String -> SDoc
    text String
    "always come first"])
          | [TyCoVar] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TyCoVar]
    specified_tvs
          = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "NB: Inferred variables")
               Int
    2 ([SDoc] -> SDoc
    sep [SDoc
    pp_inf, String -> SDoc
    text String
    "always come first"])
          | Bool
    otherwise
          = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "NB: Inferred variables")
               Int
    2 ([SDoc] -> SDoc
    vcat [ [SDoc] -> SDoc
    sep [ SDoc
    pp_inf, String -> SDoc
    text String
    "always come first"]
                       , [SDoc] -> SDoc
    sep [String -> SDoc
    text String
    "then Specified variables", SDoc
    pp_spec]])

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Auxiliary functions}
    *                                                                      *
    ************************************************************************
    -}

    -- Free variables of a type, retaining repetitions, and expanding synonyms
    -- This ignores coercions, as coercions aren't user-written
    fvType :: Type -> [TyCoVar]
    fvType :: Type -> [TyCoVar]
    fvType Type
    ty | Just Type
    exp_ty <- Type -> Maybe Type
    tcView Type
    ty = Type -> [TyCoVar]
    fvType Type
    exp_ty
    fvType (TyVarTy TyCoVar
    tv)          = [TyCoVar
    tv]
    fvType (TyConApp TyCon
    _ [Type]
    tys)      = [Type] -> [TyCoVar]
    fvTypes [Type]
    tys
    fvType (LitTy {})            = []
    fvType (AppTy Type
    fun Type
    arg)       = Type -> [TyCoVar]
    fvType Type
    fun [TyCoVar] -> [TyCoVar] -> [TyCoVar]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [TyCoVar]
    fvType Type
    arg
    fvType (FunTy AnonArgFlag
    _ Type
    w Type
    arg Type
    res)   = Type -> [TyCoVar]
    fvType Type
    w [TyCoVar] -> [TyCoVar] -> [TyCoVar]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [TyCoVar]
    fvType Type
    arg [TyCoVar] -> [TyCoVar] -> [TyCoVar]
    forall a. [a] -> [a] -> [a]
    ++ Type -> [TyCoVar]
    fvType Type
    res
    fvType (ForAllTy (Bndr TyCoVar
    tv ArgFlag
    _) Type
    ty)
      = Type -> [TyCoVar]
    fvType (TyCoVar -> Type
    tyVarKind TyCoVar
    tv) [TyCoVar] -> [TyCoVar] -> [TyCoVar]
    forall a. [a] -> [a] -> [a]
    ++
        (TyCoVar -> Bool) -> [TyCoVar] -> [TyCoVar]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (TyCoVar -> TyCoVar -> Bool
    forall a. Eq a => a -> a -> Bool
    /= TyCoVar
    tv) (Type -> [TyCoVar]
    fvType Type
    ty)
    fvType (CastTy Type
    ty KindCoercion
    _)         = Type -> [TyCoVar]
    fvType Type
    ty
    fvType (CoercionTy {})       = []

    fvTypes :: [Type] -> [TyVar]
    fvTypes :: [Type] -> [TyCoVar]
    fvTypes [Type]
    tys                = (Type -> [TyCoVar]) -> [Type] -> [TyCoVar]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Type -> [TyCoVar]
    fvType [Type]
    tys

    sizeType :: Type -> Int
    -- Size of a type: the number of variables and constructors
    sizeType :: Type -> Int
    sizeType Type
    ty | Just Type
    exp_ty <- Type -> Maybe Type
    tcView Type
    ty = Type -> Int
    sizeType Type
    exp_ty
    sizeType (TyVarTy {})      = Int
    1
    sizeType (TyConApp TyCon
    tc [Type]
    tys) = Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + TyCon -> [Type] -> Int
    sizeTyConAppArgs TyCon
    tc [Type]
    tys
    sizeType (LitTy {})        = Int
    1
    sizeType (AppTy Type
    fun Type
    arg)   = Type -> Int
    sizeType Type
    fun Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Type -> Int
    sizeType Type
    arg
    sizeType (FunTy AnonArgFlag
    _ Type
    w Type
    arg Type
    res) = Type -> Int
    sizeType Type
    w Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Type -> Int
    sizeType Type
    arg Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Type -> Int
    sizeType Type
    res Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
    sizeType (ForAllTy TyVarBinder
    _ Type
    ty)   = Type -> Int
    sizeType Type
    ty
    sizeType (CastTy Type
    ty KindCoercion
    _)     = Type -> Int
    sizeType Type
    ty
    sizeType (CoercionTy KindCoercion
    _)    = Int
    0

    sizeTypes :: [Type] -> Int
    sizeTypes :: [Type] -> Int
    sizeTypes = (Type -> Int -> Int) -> Int -> [Type] -> Int
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) (Int -> Int -> Int) -> (Type -> Int) -> Type -> Int -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Type -> Int
    sizeType) Int
    0

    sizeTyConAppArgs :: TyCon -> [Type] -> Int
    sizeTyConAppArgs :: TyCon -> [Type] -> Int
    sizeTyConAppArgs TyCon
    _tc [Type]
    tys = [Type] -> Int
    sizeTypes [Type]
    tys -- (filterOutInvisibleTypes tc tys)
                               -- See Note [Invisible arguments and termination]

    -- Size of a predicate
    --
    -- We are considering whether class constraints terminate.
    -- Equality constraints and constraints for the implicit
    -- parameter class always terminate so it is safe to say "size 0".
    -- See #4200.
    sizePred :: PredType -> Int
    sizePred :: Type -> Int
    sizePred Type
    ty = Type -> Int
    goClass Type
    ty
      where
        goClass :: Type -> Int
    goClass Type
    p = Pred -> Int
    go (Type -> Pred
    classifyPredType Type
    p)

        go :: Pred -> Int
    go (ClassPred Class
    cls [Type]
    tys')
          | Class -> Bool
    isTerminatingClass Class
    cls = Int
    0
          | Bool
    otherwise = [Type] -> Int
    sizeTypes (TyCon -> [Type] -> [Type]
    filterOutInvisibleTypes (Class -> TyCon
    classTyCon Class
    cls) [Type]
    tys')
                        -- The filtering looks bogus
                        -- See Note [Invisible arguments and termination]
        go (EqPred {})           = Int
    0
        go (IrredPred Type
    ty)        = Type -> Int
    sizeType Type
    ty
        go (ForAllPred [TyCoVar]
    _ [Type]
    _ Type
    pred) = Type -> Int
    goClass Type
    pred

    -- | When this says "True", ignore this class constraint during
    -- a termination check
    isTerminatingClass :: Class -> Bool
    isTerminatingClass :: Class -> Bool
    isTerminatingClass Class
    cls
      = Class -> Bool
    isIPClass Class
    cls    -- Implicit parameter constraints always terminate because
                         -- there are no instances for them --- they are only solved
                         -- by "local instances" in expressions
        Bool -> Bool -> Bool
    || Class -> Bool
    isEqPredClass Class
    cls
        Bool -> Bool -> Bool
    || Class
    cls Class -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    typeableClassKey
        Bool -> Bool -> Bool
    || Class
    cls Class -> Unique -> Bool
    forall a. Uniquable a => a -> Unique -> Bool
    `hasKey` Unique
    coercibleTyConKey

    -- | Tidy before printing a type
    ppr_tidy :: TidyEnv -> Type -> SDoc
    ppr_tidy :: TidyEnv -> Type -> SDoc
    ppr_tidy TidyEnv
    env Type
    ty = Type -> SDoc
    pprType (TidyEnv -> Type -> Type
    tidyType TidyEnv
    env Type
    ty)

    allDistinctTyVars :: TyVarSet -> [KindOrType] -> Bool
    -- (allDistinctTyVars tvs tys) returns True if tys are
    -- a) all tyvars
    -- b) all distinct
    -- c) disjoint from tvs
    allDistinctTyVars :: VarSet -> [Type] -> Bool
    allDistinctTyVars VarSet
    _    [] = Bool
    True
    allDistinctTyVars VarSet
    tkvs (Type
    ty : [Type]
    tys)
      = case Type -> Maybe TyCoVar
    getTyVar_maybe Type
    ty of
          Maybe TyCoVar
    Nothing -> Bool
    False
          Just TyCoVar
    tv | TyCoVar
    tv TyCoVar -> VarSet -> Bool
    `elemVarSet` VarSet
    tkvs -> Bool
    False
                  | Bool
    otherwise -> VarSet -> [Type] -> Bool
    allDistinctTyVars (VarSet
    tkvs VarSet -> TyCoVar -> VarSet
    `extendVarSet` TyCoVar
    tv) [Type]
    tys