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

    -}

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

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

    -- | Typechecking instance declarations
    module GHC.Tc.TyCl.Instance
       ( tcInstDecls1
       , tcInstDeclsDeriv
       , tcInstDecls2
       )
    where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Hs
    import GHC.Tc.Gen.Bind
    import GHC.Tc.TyCl
    import GHC.Tc.TyCl.Utils ( addTyConsToGblEnv )
    import GHC.Tc.TyCl.Class ( tcClassDecl2, tcATDefault,
                               HsSigFun, mkHsSigFun, badMethodErr,
                               findMethodBind, instantiateMethod )
    import GHC.Tc.Gen.Sig
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Validity
    import GHC.Tc.Utils.Zonk
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Types.Constraint
    import GHC.Tc.Types.Origin
    import GHC.Tc.TyCl.Build
    import GHC.Tc.Utils.Instantiate
    import GHC.Tc.Instance.Class( AssocInstInfo(..), isNotAssociated )
    import GHC.Core.Multiplicity
    import GHC.Core.InstEnv
    import GHC.Tc.Instance.Family
    import GHC.Core.FamInstEnv
    import GHC.Tc.Deriv
    import GHC.Tc.Utils.Env
    import GHC.Tc.Gen.HsType
    import GHC.Tc.Utils.Unify
    import GHC.Core        ( Expr(..), mkApps, mkVarApps, mkLams )
    import GHC.Core.Make   ( nO_METHOD_BINDING_ERROR_ID )
    import GHC.Core.Unfold ( mkInlineUnfoldingWithArity, mkDFunUnfolding )
    import GHC.Core.Type
    import GHC.Core.Predicate( classMethodInstTy )
    import GHC.Tc.Types.Evidence
    import GHC.Core.TyCon
    import GHC.Core.Coercion.Axiom
    import GHC.Core.DataCon
    import GHC.Core.ConLike
    import GHC.Core.Class
    import GHC.Types.Var as Var
    import GHC.Types.Var.Env
    import GHC.Types.Var.Set
    import GHC.Data.Bag
    import GHC.Types.Basic
    import GHC.Driver.Session
    import GHC.Utils.Error
    import GHC.Data.FastString
    import GHC.Types.Id
    import GHC.Data.List.SetOps
    import GHC.Types.Name
    import GHC.Types.Name.Set
    import GHC.Utils.Outputable
    import GHC.Types.SrcLoc
    import GHC.Utils.Misc
    import GHC.Data.BooleanFormula ( isUnsatisfied, pprBooleanFormulaNice )
    import qualified GHC.LanguageExtensions as LangExt

    import Control.Monad
    import Data.Tuple
    import GHC.Data.Maybe
    import Data.List( mapAccumL )

    {-
    Typechecking instance declarations is done in two passes. The first
    pass, made by @tcInstDecls1@, collects information to be used in the
    second pass.

    This pre-processed info includes the as-yet-unprocessed bindings
    inside the instance declaration.  These are type-checked in the second
    pass, when the class-instance envs and GVE contain all the info from
    all the instance and value decls.  Indeed that's the reason we need
    two passes over the instance decls.

    Note [How instance declarations are translated]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Here is how we translate instance declarations into Core

    Running example:
            class C a where
               op1, op2 :: Ix b => a -> b -> b
               op2 = <dm-rhs>

            instance C a => C [a]
               {-# INLINE [2] op1 #-}
               op1 = <rhs>
    ===>
            -- Method selectors
            op1,op2 :: forall a. C a => forall b. Ix b => a -> b -> b
            op1 = ...
            op2 = ...

            -- Default methods get the 'self' dictionary as argument
            -- so they can call other methods at the same type
            -- Default methods get the same type as their method selector
            $dmop2 :: forall a. C a => forall b. Ix b => a -> b -> b
            $dmop2 = /\a. \(d:C a). /\b. \(d2: Ix b). <dm-rhs>
                   -- NB: type variables 'a' and 'b' are *both* in scope in <dm-rhs>
                   -- Note [Tricky type variable scoping]

            -- A top-level definition for each instance method
            -- Here op1_i, op2_i are the "instance method Ids"
            -- The INLINE pragma comes from the user pragma
            {-# INLINE [2] op1_i #-}  -- From the instance decl bindings
            op1_i, op2_i :: forall a. C a => forall b. Ix b => [a] -> b -> b
            op1_i = /\a. \(d:C a).
                   let this :: C [a]
                       this = df_i a d
                         -- Note [Subtle interaction of recursion and overlap]

                       local_op1 :: forall b. Ix b => [a] -> b -> b
                       local_op1 = <rhs>
                         -- Source code; run the type checker on this
                         -- NB: Type variable 'a' (but not 'b') is in scope in <rhs>
                         -- Note [Tricky type variable scoping]

                   in local_op1 a d

            op2_i = /\a \d:C a. $dmop2 [a] (df_i a d)

            -- The dictionary function itself
            {-# NOINLINE CONLIKE df_i #-}   -- Never inline dictionary functions
            df_i :: forall a. C a -> C [a]
            df_i = /\a. \d:C a. MkC (op1_i a d) (op2_i a d)
                    -- But see Note [Default methods in instances]
                    -- We can't apply the type checker to the default-method call

            -- Use a RULE to short-circuit applications of the class ops
            {-# RULE "op1@C[a]" forall a, d:C a.
                                op1 [a] (df_i d) = op1_i a d #-}

    Note [Instances and loop breakers]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    * Note that df_i may be mutually recursive with both op1_i and op2_i.
      It's crucial that df_i is not chosen as the loop breaker, even
      though op1_i has a (user-specified) INLINE pragma.

    * Instead the idea is to inline df_i into op1_i, which may then select
      methods from the MkC record, and thereby break the recursion with
      df_i, leaving a *self*-recursive op1_i.  (If op1_i doesn't call op at
      the same type, it won't mention df_i, so there won't be recursion in
      the first place.)

    * If op1_i is marked INLINE by the user there's a danger that we won't
      inline df_i in it, and that in turn means that (since it'll be a
      loop-breaker because df_i isn't), op1_i will ironically never be
      inlined.  But this is OK: the recursion breaking happens by way of
      a RULE (the magic ClassOp rule above), and RULES work inside InlineRule
      unfoldings. See Note [RULEs enabled in InitialPhase] in GHC.Core.Opt.Simplify.Utils

    Note [ClassOp/DFun selection]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    One thing we see a lot is stuff like
        op2 (df d1 d2)
    where 'op2' is a ClassOp and 'df' is DFun.  Now, we could inline *both*
    'op2' and 'df' to get
         case (MkD ($cop1 d1 d2) ($cop2 d1 d2) ... of
           MkD _ op2 _ _ _ -> op2
    And that will reduce to ($cop2 d1 d2) which is what we wanted.

    But it's tricky to make this work in practice, because it requires us to
    inline both 'op2' and 'df'.  But neither is keen to inline without having
    seen the other's result; and it's very easy to get code bloat (from the
    big intermediate) if you inline a bit too much.

    Instead we use a cunning trick.
     * We arrange that 'df' and 'op2' NEVER inline.

     * We arrange that 'df' is ALWAYS defined in the sylised form
          df d1 d2 = MkD ($cop1 d1 d2) ($cop2 d1 d2) ...

     * We give 'df' a magical unfolding (DFunUnfolding [$cop1, $cop2, ..])
       that lists its methods.

     * We make GHC.Core.Unfold.exprIsConApp_maybe spot a DFunUnfolding and return
       a suitable constructor application -- inlining df "on the fly" as it
       were.

     * ClassOp rules: We give the ClassOp 'op2' a BuiltinRule that
       extracts the right piece iff its argument satisfies
       exprIsConApp_maybe.  This is done in GHC.Types.Id.Make.mkDictSelId

     * We make 'df' CONLIKE, so that shared uses still match; eg
          let d = df d1 d2
          in ...(op2 d)...(op1 d)...

    Note [Single-method classes]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If the class has just one method (or, more accurately, just one element
    of {superclasses + methods}), then we use a different strategy.

       class C a where op :: a -> a
       instance C a => C [a] where op = <blah>

    We translate the class decl into a newtype, which just gives a
    top-level axiom. The "constructor" MkC expands to a cast, as does the
    class-op selector.

       axiom Co:C a :: C a ~ (a->a)

       op :: forall a. C a -> (a -> a)
       op a d = d |> (Co:C a)

       MkC :: forall a. (a->a) -> C a
       MkC = /\a.\op. op |> (sym Co:C a)

    The clever RULE stuff doesn't work now, because ($df a d) isn't
    a constructor application, so exprIsConApp_maybe won't return
    Just <blah>.

    Instead, we simply rely on the fact that casts are cheap:

       $df :: forall a. C a => C [a]
       {-# INLINE df #-}  -- NB: INLINE this
       $df = /\a. \d. MkC [a] ($cop_list a d)
           = $cop_list |> forall a. C a -> (sym (Co:C [a]))

       $cop_list :: forall a. C a => [a] -> [a]
       $cop_list = <blah>

    So if we see
       (op ($df a d))
    we'll inline 'op' and '$df', since both are simply casts, and
    good things happen.

    Why do we use this different strategy?  Because otherwise we
    end up with non-inlined dictionaries that look like
        $df = $cop |> blah
    which adds an extra indirection to every use, which seems stupid.  See
    #4138 for an example (although the regression reported there
    wasn't due to the indirection).

    There is an awkward wrinkle though: we want to be very
    careful when we have
        instance C a => C [a] where
          {-# INLINE op #-}
          op = ...
    then we'll get an INLINE pragma on $cop_list but it's important that
    $cop_list only inlines when it's applied to *two* arguments (the
    dictionary and the list argument).  So we must not eta-expand $df
    above.  We ensure that this doesn't happen by putting an INLINE
    pragma on the dfun itself; after all, it ends up being just a cast.

    There is one more dark corner to the INLINE story, even more deeply
    buried.  Consider this (#3772):

        class DeepSeq a => C a where
          gen :: Int -> a

        instance C a => C [a] where
          gen n = ...

        class DeepSeq a where
          deepSeq :: a -> b -> b

        instance DeepSeq a => DeepSeq [a] where
          {-# INLINE deepSeq #-}
          deepSeq xs b = foldr deepSeq b xs

    That gives rise to these defns:

        $cdeepSeq :: DeepSeq a -> [a] -> b -> b
        -- User INLINE( 3 args )!
        $cdeepSeq a (d:DS a) b (x:[a]) (y:b) = ...

        $fDeepSeq[] :: DeepSeq a -> DeepSeq [a]
        -- DFun (with auto INLINE pragma)
        $fDeepSeq[] a d = $cdeepSeq a d |> blah

        $cp1 a d :: C a => DeepSep [a]
        -- We don't want to eta-expand this, lest
        -- $cdeepSeq gets inlined in it!
        $cp1 a d = $fDeepSep[] a (scsel a d)

        $fC[] :: C a => C [a]
        -- Ordinary DFun
        $fC[] a d = MkC ($cp1 a d) ($cgen a d)

    Here $cp1 is the code that generates the superclass for C [a].  The
    issue is this: we must not eta-expand $cp1 either, or else $fDeepSeq[]
    and then $cdeepSeq will inline there, which is definitely wrong.  Like
    on the dfun, we solve this by adding an INLINE pragma to $cp1.

    Note [Subtle interaction of recursion and overlap]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider this
      class C a where { op1,op2 :: a -> a }
      instance C a => C [a] where
        op1 x = op2 x ++ op2 x
        op2 x = ...
      instance C [Int] where
        ...

    When type-checking the C [a] instance, we need a C [a] dictionary (for
    the call of op2).  If we look up in the instance environment, we find
    an overlap.  And in *general* the right thing is to complain (see Note
    [Overlapping instances] in GHC.Core.InstEnv).  But in *this* case it's wrong to
    complain, because we just want to delegate to the op2 of this same
    instance.

    Why is this justified?  Because we generate a (C [a]) constraint in
    a context in which 'a' cannot be instantiated to anything that matches
    other overlapping instances, or else we would not be executing this
    version of op1 in the first place.

    It might even be a bit disguised:

      nullFail :: C [a] => [a] -> [a]
      nullFail x = op2 x ++ op2 x

      instance C a => C [a] where
        op1 x = nullFail x

    Precisely this is used in package 'regex-base', module Context.hs.
    See the overlapping instances for RegexContext, and the fact that they
    call 'nullFail' just like the example above.  The DoCon package also
    does the same thing; it shows up in module Fraction.hs.

    Conclusion: when typechecking the methods in a C [a] instance, we want to
    treat the 'a' as an *existential* type variable, in the sense described
    by Note [Binding when looking up instances].  That is why isOverlappableTyVar
    responds True to an InstSkol, which is the kind of skolem we use in
    tcInstDecl2.

    Note [Tricky type variable scoping]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In our example
            class C a where
               op1, op2 :: Ix b => a -> b -> b
               op2 = <dm-rhs>

            instance C a => C [a]
               {-# INLINE [2] op1 #-}
               op1 = <rhs>

    note that 'a' and 'b' are *both* in scope in <dm-rhs>, but only 'a' is
    in scope in <rhs>.  In particular, we must make sure that 'b' is in
    scope when typechecking <dm-rhs>.  This is achieved by subFunTys,
    which brings appropriate tyvars into scope. This happens for both
    <dm-rhs> and for <rhs>, but that doesn't matter: the *renamer* will have
    complained if 'b' is mentioned in <rhs>.

    ************************************************************************
    *                                                                      *
    \subsection{Extracting instance decls}
    *                                                                      *
    ************************************************************************

    Gather up the instance declarations from their various sources
    -}

    tcInstDecls1    -- Deal with both source-code and imported instance decls
       :: [LInstDecl GhcRn]         -- Source code instance decls
       -> TcM (TcGblEnv,            -- The full inst env
               [InstInfo GhcRn],    -- Source-code instance decls to process;
                                    -- contains all dfuns for this module
               [DerivInfo])         -- From data family instances

    tcInstDecls1 :: [LInstDecl (GhcPass 'Renamed)]
    -> TcM (TcGblEnv, [InstInfo (GhcPass 'Renamed)], [DerivInfo])
    tcInstDecls1 [LInstDecl (GhcPass 'Renamed)]
    inst_decls
      = do {    -- Do class and family instance declarations
           ; [([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])]
    stuff <- (LInstDecl (GhcPass 'Renamed)
     -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo]))
    -> [LInstDecl (GhcPass 'Renamed)]
    -> TcRn [([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])]
    forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
    mapAndRecoverM LInstDecl (GhcPass 'Renamed)
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    tcLocalInstDecl [LInstDecl (GhcPass 'Renamed)]
    inst_decls

           ; let ([[InstInfo (GhcPass 'Renamed)]]
    local_infos_s, [[FamInst]]
    fam_insts_s, [[DerivInfo]]
    datafam_deriv_infos) = [([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])]
    -> ([[InstInfo (GhcPass 'Renamed)]], [[FamInst]], [[DerivInfo]])
    forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 [([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])]
    stuff
                 fam_insts :: [FamInst]
    fam_insts   = [[FamInst]] -> [FamInst]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[FamInst]]
    fam_insts_s
                 local_infos :: [InstInfo (GhcPass 'Renamed)]
    local_infos = [[InstInfo (GhcPass 'Renamed)]] -> [InstInfo (GhcPass 'Renamed)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[InstInfo (GhcPass 'Renamed)]]
    local_infos_s

           ; TcGblEnv
    gbl_env <- [InstInfo (GhcPass 'Renamed)] -> TcM TcGblEnv -> TcM TcGblEnv
    forall a. [InstInfo (GhcPass 'Renamed)] -> TcM a -> TcM a
    addClsInsts [InstInfo (GhcPass 'Renamed)]
    local_infos (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $
                        [FamInst] -> TcM TcGblEnv -> TcM TcGblEnv
    forall a. [FamInst] -> TcM a -> TcM a
    addFamInsts [FamInst]
    fam_insts   (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $
                        TcM TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv

           ; (TcGblEnv, [InstInfo (GhcPass 'Renamed)], [DerivInfo])
    -> TcM (TcGblEnv, [InstInfo (GhcPass 'Renamed)], [DerivInfo])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( TcGblEnv
    gbl_env
                    , [InstInfo (GhcPass 'Renamed)]
    local_infos
                    , [[DerivInfo]] -> [DerivInfo]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[DerivInfo]]
    datafam_deriv_infos ) }

    -- | Use DerivInfo for data family instances (produced by tcInstDecls1),
    --   datatype declarations (TyClDecl), and standalone deriving declarations
    --   (DerivDecl) to check and process all derived class instances.
    tcInstDeclsDeriv
      :: [DerivInfo]
      -> [LDerivDecl GhcRn]
      -> TcM (TcGblEnv, [InstInfo GhcRn], HsValBinds GhcRn)
    tcInstDeclsDeriv :: [DerivInfo]
    -> [LDerivDecl (GhcPass 'Renamed)]
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBinds (GhcPass 'Renamed))
    tcInstDeclsDeriv [DerivInfo]
    deriv_infos [LDerivDecl (GhcPass 'Renamed)]
    derivds
      = do ThStage
    th_stage <- TcM ThStage
    getStage -- See Note [Deriving inside TH brackets]
           if ThStage -> Bool
    isBrackStage ThStage
    th_stage
           then do { TcGblEnv
    gbl_env <- TcM TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
                   ; (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
     HsValBinds (GhcPass 'Renamed))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBinds (GhcPass 'Renamed))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    gbl_env, Bag (InstInfo (GhcPass 'Renamed)) -> [InstInfo (GhcPass 'Renamed)]
    forall a. Bag a -> [a]
    bagToList Bag (InstInfo (GhcPass 'Renamed))
    forall a. Bag a
    emptyBag, HsValBinds (GhcPass 'Renamed)
    forall (a :: Pass) (b :: Pass).
    HsValBindsLR (GhcPass a) (GhcPass b)
    emptyValBindsOut) }
           else do { (TcGblEnv
    tcg_env, Bag (InstInfo (GhcPass 'Renamed))
    info_bag, HsValBinds (GhcPass 'Renamed)
    valbinds) <- [DerivInfo]
    -> [LDerivDecl (GhcPass 'Renamed)]
    -> TcM
         (TcGblEnv, Bag (InstInfo (GhcPass 'Renamed)),
          HsValBinds (GhcPass 'Renamed))
    tcDeriving [DerivInfo]
    deriv_infos [LDerivDecl (GhcPass 'Renamed)]
    derivds
                   ; (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
     HsValBinds (GhcPass 'Renamed))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBinds (GhcPass 'Renamed))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    tcg_env, Bag (InstInfo (GhcPass 'Renamed)) -> [InstInfo (GhcPass 'Renamed)]
    forall a. Bag a -> [a]
    bagToList Bag (InstInfo (GhcPass 'Renamed))
    info_bag, HsValBinds (GhcPass 'Renamed)
    valbinds) }

    addClsInsts :: [InstInfo GhcRn] -> TcM a -> TcM a
    addClsInsts :: forall a. [InstInfo (GhcPass 'Renamed)] -> TcM a -> TcM a
    addClsInsts [InstInfo (GhcPass 'Renamed)]
    infos TcM a
    thing_inside
      = [ClsInst] -> TcM a -> TcM a
    forall a. [ClsInst] -> TcM a -> TcM a
    tcExtendLocalInstEnv ((InstInfo (GhcPass 'Renamed) -> ClsInst)
    -> [InstInfo (GhcPass 'Renamed)] -> [ClsInst]
    forall a b. (a -> b) -> [a] -> [b]
    map InstInfo (GhcPass 'Renamed) -> ClsInst
    forall a. InstInfo a -> ClsInst
    iSpec [InstInfo (GhcPass 'Renamed)]
    infos) TcM a
    thing_inside

    addFamInsts :: [FamInst] -> TcM a -> TcM a
    -- Extend (a) the family instance envt
    --        (b) the type envt with stuff from data type decls
    addFamInsts :: forall a. [FamInst] -> TcM a -> TcM a
    addFamInsts [FamInst]
    fam_insts TcM a
    thing_inside
      = [FamInst] -> TcM a -> TcM a
    forall a. [FamInst] -> TcM a -> TcM a
    tcExtendLocalFamInstEnv [FamInst]
    fam_insts (TcM a -> TcM a) -> TcM a -> TcM a
    forall a b. (a -> b) -> a -> b
    $
        [TyThing] -> TcM a -> TcM a
    forall r. [TyThing] -> TcM r -> TcM r
    tcExtendGlobalEnv [TyThing]
    axioms          (TcM a -> TcM a) -> TcM a -> TcM a
    forall a b. (a -> b) -> a -> b
    $
        do { String -> SDoc -> TcRn ()
    traceTc String
    "addFamInsts" ([FamInst] -> SDoc
    pprFamInsts [FamInst]
    fam_insts)
           ; TcGblEnv
    gbl_env <- [TyCon] -> TcM TcGblEnv
    addTyConsToGblEnv [TyCon]
    data_rep_tycons
                        -- Does not add its axiom; that comes
                        -- from adding the 'axioms' above
           ; TcGblEnv -> TcM a -> TcM a
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    gbl_env TcM a
    thing_inside }
      where
        axioms :: [TyThing]
    axioms = (FamInst -> TyThing) -> [FamInst] -> [TyThing]
    forall a b. (a -> b) -> [a] -> [b]
    map (CoAxiom Branched -> TyThing
    ACoAxiom (CoAxiom Branched -> TyThing)
    -> (FamInst -> CoAxiom Branched) -> FamInst -> TyThing
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CoAxiom Unbranched -> CoAxiom Branched
    forall (br :: BranchFlag). CoAxiom br -> CoAxiom Branched
    toBranchedAxiom (CoAxiom Unbranched -> CoAxiom Branched)
    -> (FamInst -> CoAxiom Unbranched) -> FamInst -> CoAxiom Branched
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FamInst -> CoAxiom Unbranched
    famInstAxiom) [FamInst]
    fam_insts
        data_rep_tycons :: [TyCon]
    data_rep_tycons = [FamInst] -> [TyCon]
    famInstsRepTyCons [FamInst]
    fam_insts
          -- The representation tycons for 'data instances' declarations

    {-
    Note [Deriving inside TH brackets]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Given a declaration bracket
      [d| data T = A | B deriving( Show ) |]

    there is really no point in generating the derived code for deriving(
    Show) and then type-checking it. This will happen at the call site
    anyway, and the type check should never fail!  Moreover (#6005)
    the scoping of the generated code inside the bracket does not seem to
    work out.

    The easy solution is simply not to generate the derived instances at
    all.  (A less brutal solution would be to generate them with no
    bindings.)  This will become moot when we shift to the new TH plan, so
    the brutal solution will do.
    -}

    tcLocalInstDecl :: LInstDecl GhcRn
                    -> TcM ([InstInfo GhcRn], [FamInst], [DerivInfo])
            -- A source-file instance declaration
            -- Type-check all the stuff before the "where"
            --
            -- We check for respectable instance type, and context
    tcLocalInstDecl :: LInstDecl (GhcPass 'Renamed)
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    tcLocalInstDecl (L SrcSpan
    loc (TyFamInstD { tfid_inst :: forall pass. InstDecl pass -> TyFamInstDecl pass
    tfid_inst = TyFamInstDecl (GhcPass 'Renamed)
    decl }))
      = do { FamInst
    fam_inst <- AssocInstInfo -> LTyFamInstDecl (GhcPass 'Renamed) -> TcM FamInst
    tcTyFamInstDecl AssocInstInfo
    NotAssociated (SrcSpan
    -> TyFamInstDecl (GhcPass 'Renamed)
    -> LTyFamInstDecl (GhcPass 'Renamed)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc TyFamInstDecl (GhcPass 'Renamed)
    decl)
           ; ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [FamInst
    fam_inst], []) }

    tcLocalInstDecl (L SrcSpan
    loc (DataFamInstD { dfid_inst :: forall pass. InstDecl pass -> DataFamInstDecl pass
    dfid_inst = DataFamInstDecl (GhcPass 'Renamed)
    decl }))
      = do { (FamInst
    fam_inst, Maybe DerivInfo
    m_deriv_info) <- AssocInstInfo
    -> TyVarEnv Name
    -> LDataFamInstDecl (GhcPass 'Renamed)
    -> TcM (FamInst, Maybe DerivInfo)
    tcDataFamInstDecl AssocInstInfo
    NotAssociated TyVarEnv Name
    forall a. VarEnv a
    emptyVarEnv (SrcSpan
    -> DataFamInstDecl (GhcPass 'Renamed)
    -> LDataFamInstDecl (GhcPass 'Renamed)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc DataFamInstDecl (GhcPass 'Renamed)
    decl)
           ; ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [FamInst
    fam_inst], Maybe DerivInfo -> [DerivInfo]
    forall a. Maybe a -> [a]
    maybeToList Maybe DerivInfo
    m_deriv_info) }

    tcLocalInstDecl (L SrcSpan
    loc (ClsInstD { cid_inst :: forall pass. InstDecl pass -> ClsInstDecl pass
    cid_inst = ClsInstDecl (GhcPass 'Renamed)
    decl }))
      = do { ([InstInfo (GhcPass 'Renamed)]
    insts, [FamInst]
    fam_insts, [DerivInfo]
    deriv_infos) <- LClsInstDecl (GhcPass 'Renamed)
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    tcClsInstDecl (SrcSpan
    -> ClsInstDecl (GhcPass 'Renamed)
    -> LClsInstDecl (GhcPass 'Renamed)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc ClsInstDecl (GhcPass 'Renamed)
    decl)
           ; ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([InstInfo (GhcPass 'Renamed)]
    insts, [FamInst]
    fam_insts, [DerivInfo]
    deriv_infos) }

    tcClsInstDecl :: LClsInstDecl GhcRn
                  -> TcM ([InstInfo GhcRn], [FamInst], [DerivInfo])
    -- The returned DerivInfos are for any associated data families
    tcClsInstDecl :: LClsInstDecl (GhcPass 'Renamed)
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    tcClsInstDecl (L SrcSpan
    loc (ClsInstDecl { cid_poly_ty :: forall pass. ClsInstDecl pass -> LHsSigType pass
    cid_poly_ty = LHsSigType (GhcPass 'Renamed)
    hs_ty, cid_binds :: forall pass. ClsInstDecl pass -> LHsBinds pass
    cid_binds = LHsBinds (GhcPass 'Renamed)
    binds
                                      , cid_sigs :: forall pass. ClsInstDecl pass -> [LSig pass]
    cid_sigs = [LSig (GhcPass 'Renamed)]
    uprags, cid_tyfam_insts :: forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
    cid_tyfam_insts = [LTyFamInstDecl (GhcPass 'Renamed)]
    ats
                                      , cid_overlap_mode :: forall pass. ClsInstDecl pass -> Maybe (Located OverlapMode)
    cid_overlap_mode = Maybe (Located OverlapMode)
    overlap_mode
                                      , cid_datafam_insts :: forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
    cid_datafam_insts = [LDataFamInstDecl (GhcPass 'Renamed)]
    adts }))
      = SrcSpan
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc                      (TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
     -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo]))
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    forall a b. (a -> b) -> a -> b
    $
        SDoc
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (LHsSigType (GhcPass 'Renamed) -> SDoc
    instDeclCtxt1 LHsSigType (GhcPass 'Renamed)
    hs_ty)  (TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
     -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo]))
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    forall a b. (a -> b) -> a -> b
    $
        do  { PredType
    dfun_ty <- UserTypeCtxt -> LHsSigType (GhcPass 'Renamed) -> TcM PredType
    tcHsClsInstType (Bool -> UserTypeCtxt
    InstDeclCtxt Bool
    False) LHsSigType (GhcPass 'Renamed)
    hs_ty
            ; let ([Id]
    tyvars, [PredType]
    theta, Class
    clas, [PredType]
    inst_tys) = PredType -> ([Id], [PredType], Class, [PredType])
    tcSplitDFunTy PredType
    dfun_ty
                 -- NB: tcHsClsInstType does checkValidInstance

            ; (TCvSubst
    subst, [Id]
    skol_tvs) <- [Id] -> TcM (TCvSubst, [Id])
    tcInstSkolTyVars [Id]
    tyvars
            ; let tv_skol_prs :: [(Name, Id)]
    tv_skol_prs = [ (Id -> Name
    tyVarName Id
    tv, Id
    skol_tv)
                                | (Id
    tv, Id
    skol_tv) <- [Id]
    tyvars [Id] -> [Id] -> [(Id, Id)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Id]
    skol_tvs ]
                  -- Map from the skolemized Names to the original Names.
                  -- See Note [Associated data family instances and di_scoped_tvs].
                  tv_skol_env :: TyVarEnv Name
    tv_skol_env = [(Id, Name)] -> TyVarEnv Name
    forall a. [(Id, a)] -> VarEnv a
    mkVarEnv ([(Id, Name)] -> TyVarEnv Name) -> [(Id, Name)] -> TyVarEnv Name
    forall a b. (a -> b) -> a -> b
    $ ((Name, Id) -> (Id, Name)) -> [(Name, Id)] -> [(Id, Name)]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, Id) -> (Id, Name)
    forall a b. (a, b) -> (b, a)
    swap [(Name, Id)]
    tv_skol_prs
                  n_inferred :: ConTag
    n_inferred = (VarBndr Id ArgFlag -> Bool) -> [VarBndr Id ArgFlag] -> ConTag
    forall a. (a -> Bool) -> [a] -> ConTag
    countWhile ((ArgFlag -> ArgFlag -> Bool
    forall a. Eq a => a -> a -> Bool
    == ArgFlag
    Inferred) (ArgFlag -> Bool)
    -> (VarBndr Id ArgFlag -> ArgFlag) -> VarBndr Id ArgFlag -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . VarBndr Id ArgFlag -> ArgFlag
    forall tv argf. VarBndr tv argf -> argf
    binderArgFlag) ([VarBndr Id ArgFlag] -> ConTag) -> [VarBndr Id ArgFlag] -> ConTag
    forall a b. (a -> b) -> a -> b
    $
                               ([VarBndr Id ArgFlag], PredType) -> [VarBndr Id ArgFlag]
    forall a b. (a, b) -> a
    fst (([VarBndr Id ArgFlag], PredType) -> [VarBndr Id ArgFlag])
    -> ([VarBndr Id ArgFlag], PredType) -> [VarBndr Id ArgFlag]
    forall a b. (a -> b) -> a -> b
    $ PredType -> ([VarBndr Id ArgFlag], PredType)
    splitForAllVarBndrs PredType
    dfun_ty
                  visible_skol_tvs :: [Id]
    visible_skol_tvs = ConTag -> [Id] -> [Id]
    forall a. ConTag -> [a] -> [a]
    drop ConTag
    n_inferred [Id]
    skol_tvs

            ; String -> SDoc -> TcRn ()
    traceTc String
    "tcLocalInstDecl 1" (PredType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PredType
    dfun_ty SDoc -> SDoc -> SDoc
    $$ ConTag -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (PredType -> ConTag
    invisibleTyBndrCount PredType
    dfun_ty) SDoc -> SDoc -> SDoc
    $$ [Id] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Id]
    skol_tvs)

            -- Next, process any associated types.
            ; ([(FamInst, Maybe DerivInfo)]
    datafam_stuff, [FamInst]
    tyfam_insts)
                 <- [(Name, Id)]
    -> TcM ([(FamInst, Maybe DerivInfo)], [FamInst])
    -> TcM ([(FamInst, Maybe DerivInfo)], [FamInst])
    forall r. [(Name, Id)] -> TcM r -> TcM r
    tcExtendNameTyVarEnv [(Name, Id)]
    tv_skol_prs (TcM ([(FamInst, Maybe DerivInfo)], [FamInst])
     -> TcM ([(FamInst, Maybe DerivInfo)], [FamInst]))
    -> TcM ([(FamInst, Maybe DerivInfo)], [FamInst])
    -> TcM ([(FamInst, Maybe DerivInfo)], [FamInst])
    forall a b. (a -> b) -> a -> b
    $
                    do  { let mini_env :: VarEnv PredType
    mini_env   = [(Id, PredType)] -> VarEnv PredType
    forall a. [(Id, a)] -> VarEnv a
    mkVarEnv (Class -> [Id]
    classTyVars Class
    clas [Id] -> [PredType] -> [(Id, PredType)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` HasCallStack => TCvSubst -> [PredType] -> [PredType]
    TCvSubst -> [PredType] -> [PredType]
    substTys TCvSubst
    subst [PredType]
    inst_tys)
                              mini_subst :: TCvSubst
    mini_subst = InScopeSet -> VarEnv PredType -> TCvSubst
    mkTvSubst (VarSet -> InScopeSet
    mkInScopeSet ([Id] -> VarSet
    mkVarSet [Id]
    skol_tvs)) VarEnv PredType
    mini_env
                              mb_info :: AssocInstInfo
    mb_info    = InClsInst :: Class -> [Id] -> VarEnv PredType -> AssocInstInfo
    InClsInst { ai_class :: Class
    ai_class = Class
    clas
                                                     , ai_tyvars :: [Id]
    ai_tyvars = [Id]
    visible_skol_tvs
                                                     , ai_inst_env :: VarEnv PredType
    ai_inst_env = VarEnv PredType
    mini_env }
                        ; [(FamInst, Maybe DerivInfo)]
    df_stuff  <- (LDataFamInstDecl (GhcPass 'Renamed)
     -> TcM (FamInst, Maybe DerivInfo))
    -> [LDataFamInstDecl (GhcPass 'Renamed)]
    -> TcRn [(FamInst, Maybe DerivInfo)]
    forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
    mapAndRecoverM (AssocInstInfo
    -> TyVarEnv Name
    -> LDataFamInstDecl (GhcPass 'Renamed)
    -> TcM (FamInst, Maybe DerivInfo)
    tcDataFamInstDecl AssocInstInfo
    mb_info TyVarEnv Name
    tv_skol_env) [LDataFamInstDecl (GhcPass 'Renamed)]
    adts
                        ; [FamInst]
    tf_insts1 <- (LTyFamInstDecl (GhcPass 'Renamed) -> TcM FamInst)
    -> [LTyFamInstDecl (GhcPass 'Renamed)] -> TcRn [FamInst]
    forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
    mapAndRecoverM (AssocInstInfo -> LTyFamInstDecl (GhcPass 'Renamed) -> TcM FamInst
    tcTyFamInstDecl AssocInstInfo
    mb_info)   [LTyFamInstDecl (GhcPass 'Renamed)]
    ats

                          -- Check for missing associated types and build them
                          -- from their defaults (if available)
                        ; [[FamInst]]
    tf_insts2 <- (ClassATItem -> TcRn [FamInst])
    -> [ClassATItem] -> IOEnv (Env TcGblEnv TcLclEnv) [[FamInst]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (SrcSpan -> TCvSubst -> NameSet -> ClassATItem -> TcRn [FamInst]
    tcATDefault SrcSpan
    loc TCvSubst
    mini_subst NameSet
    defined_ats)
                                            (Class -> [ClassATItem]
    classATItems Class
    clas)

                        ; ([(FamInst, Maybe DerivInfo)], [FamInst])
    -> TcM ([(FamInst, Maybe DerivInfo)], [FamInst])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(FamInst, Maybe DerivInfo)]
    df_stuff, [FamInst]
    tf_insts1 [FamInst] -> [FamInst] -> [FamInst]
    forall a. [a] -> [a] -> [a]
    ++ [[FamInst]] -> [FamInst]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[FamInst]]
    tf_insts2) }

            -- Finally, construct the Core representation of the instance.
            -- (This no longer includes the associated types.)
            ; Name
    dfun_name <- Class -> [PredType] -> SrcSpan -> TcM Name
    newDFunName Class
    clas [PredType]
    inst_tys (LHsType (GhcPass 'Renamed) -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc (LHsSigType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
    hsSigType LHsSigType (GhcPass 'Renamed)
    hs_ty))
                    -- Dfun location is that of instance *header*

            ; ClsInst
    ispec <- Maybe OverlapMode
    -> Name -> [Id] -> [PredType] -> Class -> [PredType] -> TcM ClsInst
    newClsInst ((Located OverlapMode -> OverlapMode)
    -> Maybe (Located OverlapMode) -> Maybe OverlapMode
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Located OverlapMode -> OverlapMode
    forall l e. GenLocated l e -> e
    unLoc Maybe (Located OverlapMode)
    overlap_mode) Name
    dfun_name
                                  [Id]
    tyvars [PredType]
    theta Class
    clas [PredType]
    inst_tys

            ; let inst_binds :: InstBindings (GhcPass 'Renamed)
    inst_binds = InstBindings :: forall a.
    [Name]
    -> LHsBinds a -> [LSig a] -> [Extension] -> Bool -> InstBindings a
    InstBindings
                                 { ib_binds :: LHsBinds (GhcPass 'Renamed)
    ib_binds = LHsBinds (GhcPass 'Renamed)
    binds
                                 , ib_tyvars :: [Name]
    ib_tyvars = (Id -> Name) -> [Id] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Name
    Var.varName [Id]
    tyvars -- Scope over bindings
                                 , ib_pragmas :: [LSig (GhcPass 'Renamed)]
    ib_pragmas = [LSig (GhcPass 'Renamed)]
    uprags
                                 , ib_extensions :: [Extension]
    ib_extensions = []
                                 , ib_derived :: Bool
    ib_derived = Bool
    False }
                  inst_info :: InstInfo (GhcPass 'Renamed)
    inst_info = InstInfo :: forall a. ClsInst -> InstBindings a -> InstInfo a
    InstInfo { iSpec :: ClsInst
    iSpec  = ClsInst
    ispec, iBinds :: InstBindings (GhcPass 'Renamed)
    iBinds = InstBindings (GhcPass 'Renamed)
    inst_binds }

                  ([FamInst]
    datafam_insts, [Maybe DerivInfo]
    m_deriv_infos) = [(FamInst, Maybe DerivInfo)] -> ([FamInst], [Maybe DerivInfo])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(FamInst, Maybe DerivInfo)]
    datafam_stuff
                  deriv_infos :: [DerivInfo]
    deriv_infos                    = [Maybe DerivInfo] -> [DerivInfo]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe DerivInfo]
    m_deriv_infos
                  all_insts :: [FamInst]
    all_insts                      = [FamInst]
    tyfam_insts [FamInst] -> [FamInst] -> [FamInst]
    forall a. [a] -> [a] -> [a]
    ++ [FamInst]
    datafam_insts

             -- In hs-boot files there should be no bindings
            ; Bool
    is_boot <- TcRn Bool
    tcIsHsBootOrSig
            ; let no_binds :: Bool
    no_binds = LHsBinds (GhcPass 'Renamed) -> Bool
    forall idL idR. LHsBindsLR idL idR -> Bool
    isEmptyLHsBinds LHsBinds (GhcPass 'Renamed)
    binds Bool -> Bool -> Bool
    && [LSig (GhcPass 'Renamed)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LSig (GhcPass 'Renamed)]
    uprags
            ; Bool -> SDoc -> TcRn ()
    failIfTc (Bool
    is_boot Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    no_binds) SDoc
    badBootDeclErr

            ; ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    -> TcRn ([InstInfo (GhcPass 'Renamed)], [FamInst], [DerivInfo])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( [InstInfo (GhcPass 'Renamed)
    inst_info], [FamInst]
    all_insts, [DerivInfo]
    deriv_infos ) }
      where
        defined_ats :: NameSet
    defined_ats = [Name] -> NameSet
    mkNameSet ((LTyFamInstDecl (GhcPass 'Renamed) -> Name)
    -> [LTyFamInstDecl (GhcPass 'Renamed)] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (TyFamInstDecl (GhcPass 'Renamed) -> Name
    forall (p :: Pass). TyFamInstDecl (GhcPass p) -> IdP (GhcPass p)
    tyFamInstDeclName (TyFamInstDecl (GhcPass 'Renamed) -> Name)
    -> (LTyFamInstDecl (GhcPass 'Renamed)
        -> TyFamInstDecl (GhcPass 'Renamed))
    -> LTyFamInstDecl (GhcPass 'Renamed)
    -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LTyFamInstDecl (GhcPass 'Renamed)
    -> TyFamInstDecl (GhcPass 'Renamed)
    forall l e. GenLocated l e -> e
    unLoc) [LTyFamInstDecl (GhcPass 'Renamed)]
    ats)
                      NameSet -> NameSet -> NameSet
    `unionNameSet`
                      [Name] -> NameSet
    mkNameSet ((LDataFamInstDecl (GhcPass 'Renamed) -> Name)
    -> [LDataFamInstDecl (GhcPass 'Renamed)] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (GenLocated SrcSpan Name -> Name
    forall l e. GenLocated l e -> e
    unLoc (GenLocated SrcSpan Name -> Name)
    -> (LDataFamInstDecl (GhcPass 'Renamed) -> GenLocated SrcSpan Name)
    -> LDataFamInstDecl (GhcPass 'Renamed)
    -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
    -> GenLocated SrcSpan Name
    forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
    feqn_tycon
                                            (FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
     -> GenLocated SrcSpan Name)
    -> (LDataFamInstDecl (GhcPass 'Renamed)
        -> FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed)))
    -> LDataFamInstDecl (GhcPass 'Renamed)
    -> GenLocated SrcSpan Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsImplicitBndrs
      (GhcPass 'Renamed)
      (FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed)))
    -> FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
    forall pass thing. HsImplicitBndrs pass thing -> thing
    hsib_body
                                            (HsImplicitBndrs
       (GhcPass 'Renamed)
       (FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed)))
     -> FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed)))
    -> (LDataFamInstDecl (GhcPass 'Renamed)
        -> HsImplicitBndrs
             (GhcPass 'Renamed)
             (FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))))
    -> LDataFamInstDecl (GhcPass 'Renamed)
    -> FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataFamInstDecl (GhcPass 'Renamed)
    -> HsImplicitBndrs
         (GhcPass 'Renamed)
         (FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed)))
    forall pass.
    DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
    dfid_eqn
                                            (DataFamInstDecl (GhcPass 'Renamed)
     -> HsImplicitBndrs
          (GhcPass 'Renamed)
          (FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed))))
    -> (LDataFamInstDecl (GhcPass 'Renamed)
        -> DataFamInstDecl (GhcPass 'Renamed))
    -> LDataFamInstDecl (GhcPass 'Renamed)
    -> HsImplicitBndrs
         (GhcPass 'Renamed)
         (FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LDataFamInstDecl (GhcPass 'Renamed)
    -> DataFamInstDecl (GhcPass 'Renamed)
    forall l e. GenLocated l e -> e
    unLoc) [LDataFamInstDecl (GhcPass 'Renamed)]
    adts)

    {-
    ************************************************************************
    *                                                                      *
                   Type family instances
    *                                                                      *
    ************************************************************************

    Family instances are somewhat of a hybrid.  They are processed together with
    class instance heads, but can contain data constructors and hence they share a
    lot of kinding and type checking code with ordinary algebraic data types (and
    GADTs).
    -}

    tcTyFamInstDecl :: AssocInstInfo
                    -> LTyFamInstDecl GhcRn -> TcM FamInst
      -- "type instance"
      -- See Note [Associated type instances]
    tcTyFamInstDecl :: AssocInstInfo -> LTyFamInstDecl (GhcPass 'Renamed) -> TcM FamInst
    tcTyFamInstDecl AssocInstInfo
    mb_clsinfo (L SrcSpan
    loc decl :: TyFamInstDecl (GhcPass 'Renamed)
    decl@(TyFamInstDecl { tfid_eqn :: forall pass. TyFamInstDecl pass -> TyFamInstEqn pass
    tfid_eqn = TyFamInstEqn (GhcPass 'Renamed)
    eqn }))
      = SrcSpan -> TcM FamInst -> TcM FamInst
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc           (TcM FamInst -> TcM FamInst) -> TcM FamInst -> TcM FamInst
    forall a b. (a -> b) -> a -> b
    $
        TyFamInstDecl (GhcPass 'Renamed) -> TcM FamInst -> TcM FamInst
    forall a. TyFamInstDecl (GhcPass 'Renamed) -> TcM a -> TcM a
    tcAddTyFamInstCtxt TyFamInstDecl (GhcPass 'Renamed)
    decl  (TcM FamInst -> TcM FamInst) -> TcM FamInst -> TcM FamInst
    forall a b. (a -> b) -> a -> b
    $
        do { let fam_lname :: Located (IdP (GhcPass 'Renamed))
    fam_lname = FamEqn (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
    -> Located (IdP (GhcPass 'Renamed))
    forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
    feqn_tycon (TyFamInstEqn (GhcPass 'Renamed)
    -> FamEqn (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
    forall pass thing. HsImplicitBndrs pass thing -> thing
    hsib_body TyFamInstEqn (GhcPass 'Renamed)
    eqn)
           ; TyCon
    fam_tc <- GenLocated SrcSpan Name -> TcM TyCon
    tcLookupLocatedTyCon GenLocated SrcSpan Name
    Located (IdP (GhcPass 'Renamed))
    fam_lname
           ; AssocInstInfo -> TyCon -> TcRn ()
    tcFamInstDeclChecks AssocInstInfo
    mb_clsinfo TyCon
    fam_tc

             -- (0) Check it's an open type family
           ; Bool -> SDoc -> TcRn ()
    checkTc (TyCon -> Bool
    isTypeFamilyTyCon TyCon
    fam_tc)     (TyCon -> SDoc
    wrongKindOfFamily TyCon
    fam_tc)
           ; Bool -> SDoc -> TcRn ()
    checkTc (TyCon -> Bool
    isOpenTypeFamilyTyCon TyCon
    fam_tc) (TyCon -> SDoc
    notOpenFamily TyCon
    fam_tc)

             -- (1) do the work of verifying the synonym group
           ; KnotTied CoAxBranch
    co_ax_branch <- TyCon
    -> AssocInstInfo
    -> LTyFamInstEqn (GhcPass 'Renamed)
    -> TcM (KnotTied CoAxBranch)
    tcTyFamInstEqn TyCon
    fam_tc AssocInstInfo
    mb_clsinfo
                                            (SrcSpan
    -> TyFamInstEqn (GhcPass 'Renamed)
    -> LTyFamInstEqn (GhcPass 'Renamed)
    forall l e. l -> e -> GenLocated l e
    L (GenLocated SrcSpan Name -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc GenLocated SrcSpan Name
    Located (IdP (GhcPass 'Renamed))
    fam_lname) TyFamInstEqn (GhcPass 'Renamed)
    eqn)

             -- (2) check for validity
           ; AssocInstInfo -> TyCon -> KnotTied CoAxBranch -> TcRn ()
    checkConsistentFamInst AssocInstInfo
    mb_clsinfo TyCon
    fam_tc KnotTied CoAxBranch
    co_ax_branch
           ; TyCon -> KnotTied CoAxBranch -> TcRn ()
    checkValidCoAxBranch TyCon
    fam_tc KnotTied CoAxBranch
    co_ax_branch

             -- (3) construct coercion axiom
           ; Name
    rep_tc_name <- GenLocated SrcSpan Name -> [[PredType]] -> TcM Name
    newFamInstAxiomName GenLocated SrcSpan Name
    Located (IdP (GhcPass 'Renamed))
    fam_lname [KnotTied CoAxBranch -> [PredType]
    coAxBranchLHS KnotTied CoAxBranch
    co_ax_branch]
           ; let axiom :: CoAxiom Unbranched
    axiom = Name -> TyCon -> KnotTied CoAxBranch -> CoAxiom Unbranched
    mkUnbranchedCoAxiom Name
    rep_tc_name TyCon
    fam_tc KnotTied CoAxBranch
    co_ax_branch
           ; FamFlavor -> CoAxiom Unbranched -> TcM FamInst
    newFamInst FamFlavor
    SynFamilyInst CoAxiom Unbranched
    axiom }

    ---------------------
    tcFamInstDeclChecks :: AssocInstInfo -> TyCon -> TcM ()
    -- Used for both type and data families
    tcFamInstDeclChecks :: AssocInstInfo -> TyCon -> TcRn ()
    tcFamInstDeclChecks AssocInstInfo
    mb_clsinfo TyCon
    fam_tc
      = do { -- Type family instances require -XTypeFamilies
             -- and can't (currently) be in an hs-boot file
           ; String -> SDoc -> TcRn ()
    traceTc String
    "tcFamInstDecl" (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    fam_tc)
           ; Bool
    type_families <- Extension -> TcRn Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.TypeFamilies
           ; Bool
    is_boot       <- TcRn Bool
    tcIsHsBootOrSig   -- Are we compiling an hs-boot file?
           ; Bool -> SDoc -> TcRn ()
    checkTc Bool
    type_families (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ TyCon -> SDoc
    badFamInstDecl TyCon
    fam_tc
           ; Bool -> SDoc -> TcRn ()
    checkTc (Bool -> Bool
    not Bool
    is_boot) (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ SDoc
    badBootFamInstDeclErr

           -- Check that it is a family TyCon, and that
           -- oplevel type instances are not for associated types.
           ; Bool -> SDoc -> TcRn ()
    checkTc (TyCon -> Bool
    isFamilyTyCon TyCon
    fam_tc) (TyCon -> SDoc
    notFamily TyCon
    fam_tc)

           ; Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (AssocInstInfo -> Bool
    isNotAssociated AssocInstInfo
    mb_clsinfo Bool -> Bool -> Bool
    &&   -- Not in a class decl
                   TyCon -> Bool
    isTyConAssoc TyCon
    fam_tc)            -- but an associated type
                  (SDoc -> TcRn ()
    addErr (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ TyCon -> SDoc
    assocInClassErr TyCon
    fam_tc)
           }

    {- Note [Associated type instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We allow this:
      class C a where
        type T x a
      instance C Int where
        type T (S y) Int = y
        type T Z     Int = Char

    Note that
      a) The variable 'x' is not bound by the class decl
      b) 'x' is instantiated to a non-type-variable in the instance
      c) There are several type instance decls for T in the instance

    All this is fine.  Of course, you can't give any *more* instances
    for (T ty Int) elsewhere, because it's an *associated* type.

    ************************************************************************
    *                                                                      *
                   Data family instances
    *                                                                      *
    ************************************************************************

    For some reason data family instances are a lot more complicated
    than type family instances
    -}

    tcDataFamInstDecl ::
         AssocInstInfo
      -> TyVarEnv Name -- If this is an associated data family instance, maps the
                       -- parent class's skolemized type variables to their
                       -- original Names. If this is a non-associated instance,
                       -- this will be empty.
                       -- See Note [Associated data family instances and di_scoped_tvs].
      -> LDataFamInstDecl GhcRn -> TcM (FamInst, Maybe DerivInfo)
      -- "newtype instance" and "data instance"
    tcDataFamInstDecl :: AssocInstInfo
    -> TyVarEnv Name
    -> LDataFamInstDecl (GhcPass 'Renamed)
    -> TcM (FamInst, Maybe DerivInfo)
    tcDataFamInstDecl AssocInstInfo
    mb_clsinfo TyVarEnv Name
    tv_skol_env
        (L SrcSpan
    loc decl :: DataFamInstDecl (GhcPass 'Renamed)
    decl@(DataFamInstDecl { dfid_eqn :: forall pass.
    DataFamInstDecl pass -> FamInstEqn pass (HsDataDefn pass)
    dfid_eqn = HsIB { hsib_ext :: forall pass thing. HsImplicitBndrs pass thing -> XHsIB pass thing
    hsib_ext = XHsIB
      (GhcPass 'Renamed)
      (FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed)))
    imp_vars
                                                       , hsib_body :: forall pass thing. HsImplicitBndrs pass thing -> thing
    hsib_body =
          FamEqn { feqn_bndrs :: forall pass rhs. FamEqn pass rhs -> Maybe [LHsTyVarBndr () pass]
    feqn_bndrs  = Maybe [LHsTyVarBndr () (GhcPass 'Renamed)]
    mb_bndrs
                 , feqn_pats :: forall pass rhs. FamEqn pass rhs -> HsTyPats pass
    feqn_pats   = HsTyPats (GhcPass 'Renamed)
    hs_pats
                 , feqn_tycon :: forall pass rhs. FamEqn pass rhs -> Located (IdP pass)
    feqn_tycon  = lfam_name :: Located (IdP (GhcPass 'Renamed))
    lfam_name@(L SrcSpan
    _ IdP (GhcPass 'Renamed)
    fam_name)
                 , feqn_fixity :: forall pass rhs. FamEqn pass rhs -> LexicalFixity
    feqn_fixity = LexicalFixity
    fixity
                 , feqn_rhs :: forall pass rhs. FamEqn pass rhs -> rhs
    feqn_rhs    = HsDataDefn { dd_ND :: forall pass. HsDataDefn pass -> NewOrData
    dd_ND      = NewOrData
    new_or_data
                                            , dd_cType :: forall pass. HsDataDefn pass -> Maybe (Located CType)
    dd_cType   = Maybe (Located CType)
    cType
                                            , dd_ctxt :: forall pass. HsDataDefn pass -> LHsContext pass
    dd_ctxt    = LHsContext (GhcPass 'Renamed)
    hs_ctxt
                                            , dd_cons :: forall pass. HsDataDefn pass -> [LConDecl pass]
    dd_cons    = [LConDecl (GhcPass 'Renamed)]
    hs_cons
                                            , dd_kindSig :: forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
    dd_kindSig = Maybe (LHsType (GhcPass 'Renamed))
    m_ksig
                                            , dd_derivs :: forall pass. HsDataDefn pass -> HsDeriving pass
    dd_derivs  = HsDeriving (GhcPass 'Renamed)
    derivs } }}}))
      = SrcSpan
    -> TcM (FamInst, Maybe DerivInfo) -> TcM (FamInst, Maybe DerivInfo)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc             (TcM (FamInst, Maybe DerivInfo) -> TcM (FamInst, Maybe DerivInfo))
    -> TcM (FamInst, Maybe DerivInfo) -> TcM (FamInst, Maybe DerivInfo)
    forall a b. (a -> b) -> a -> b
    $
        DataFamInstDecl (GhcPass 'Renamed)
    -> TcM (FamInst, Maybe DerivInfo) -> TcM (FamInst, Maybe DerivInfo)
    forall a. DataFamInstDecl (GhcPass 'Renamed) -> TcM a -> TcM a
    tcAddDataFamInstCtxt DataFamInstDecl (GhcPass 'Renamed)
    decl  (TcM (FamInst, Maybe DerivInfo) -> TcM (FamInst, Maybe DerivInfo))
    -> TcM (FamInst, Maybe DerivInfo) -> TcM (FamInst, Maybe DerivInfo)
    forall a b. (a -> b) -> a -> b
    $
        do { TyCon
    fam_tc <- GenLocated SrcSpan Name -> TcM TyCon
    tcLookupLocatedTyCon GenLocated SrcSpan Name
    Located (IdP (GhcPass 'Renamed))
    lfam_name

           ; AssocInstInfo -> TyCon -> TcRn ()
    tcFamInstDeclChecks AssocInstInfo
    mb_clsinfo TyCon
    fam_tc

           -- Check that the family declaration is for the right kind
           ; Bool -> SDoc -> TcRn ()
    checkTc (TyCon -> Bool
    isDataFamilyTyCon TyCon
    fam_tc) (TyCon -> SDoc
    wrongKindOfFamily TyCon
    fam_tc)
           ; Bool
    gadt_syntax <- Name
    -> NewOrData
    -> LHsContext (GhcPass 'Renamed)
    -> [LConDecl (GhcPass 'Renamed)]
    -> TcRn Bool
    dataDeclChecks Name
    IdP (GhcPass 'Renamed)
    fam_name NewOrData
    new_or_data LHsContext (GhcPass 'Renamed)
    hs_ctxt [LConDecl (GhcPass 'Renamed)]
    hs_cons
              -- Do /not/ check that the number of patterns = tyConArity fam_tc
              -- See [Arity of data families] in GHC.Core.FamInstEnv
           ; ([Id]
    qtvs, [PredType]
    pats, PredType
    res_kind, [PredType]
    stupid_theta)
                 <- AssocInstInfo
    -> TyCon
    -> [Name]
    -> Maybe [LHsTyVarBndr () (GhcPass 'Renamed)]
    -> LexicalFixity
    -> LHsContext (GhcPass 'Renamed)
    -> HsTyPats (GhcPass 'Renamed)
    -> Maybe (LHsType (GhcPass 'Renamed))
    -> [LConDecl (GhcPass 'Renamed)]
    -> NewOrData
    -> TcM ([Id], [PredType], PredType, [PredType])
    tcDataFamInstHeader AssocInstInfo
    mb_clsinfo TyCon
    fam_tc [Name]
    XHsIB
      (GhcPass 'Renamed)
      (FamEqn (GhcPass 'Renamed) (HsDataDefn (GhcPass 'Renamed)))
    imp_vars Maybe [LHsTyVarBndr () (GhcPass 'Renamed)]
    mb_bndrs
                                        LexicalFixity
    fixity LHsContext (GhcPass 'Renamed)
    hs_ctxt HsTyPats (GhcPass 'Renamed)
    hs_pats Maybe (LHsType (GhcPass 'Renamed))
    m_ksig [LConDecl (GhcPass 'Renamed)]
    hs_cons
                                        NewOrData
    new_or_data

           -- Eta-reduce the axiom if possible
           -- Quite tricky: see Note [Implementing eta reduction for data families]
           ; let ([PredType]
    eta_pats, [TyConBinder]
    eta_tcbs) = TyCon -> [PredType] -> ([PredType], [TyConBinder])
    eta_reduce TyCon
    fam_tc [PredType]
    pats
                 eta_tvs :: [Id]
    eta_tvs       = (TyConBinder -> Id) -> [TyConBinder] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map TyConBinder -> Id
    forall tv argf. VarBndr tv argf -> tv
    binderVar [TyConBinder]
    eta_tcbs
                 post_eta_qtvs :: [Id]
    post_eta_qtvs = (Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (Id -> [Id] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Id]
    eta_tvs) [Id]
    qtvs

                 full_tcbs :: [TyConBinder]
    full_tcbs = [Id] -> VarSet -> [TyConBinder]
    mkTyConBindersPreferAnon [Id]
    post_eta_qtvs
                                (PredType -> VarSet
    tyCoVarsOfType ([Id] -> PredType -> PredType
    mkSpecForAllTys [Id]
    eta_tvs PredType
    res_kind))
                             [TyConBinder] -> [TyConBinder] -> [TyConBinder]
    forall a. [a] -> [a] -> [a]
    ++ [TyConBinder]
    eta_tcbs
                     -- Put the eta-removed tyvars at the end
                     -- Remember, qtvs is in arbitrary order, except kind vars are
                     -- first, so there is no reason to suppose that the eta_tvs
                     -- (obtained from the pats) are at the end (#11148)

           -- Eta-expand the representation tycon until it has result
           -- kind `TYPE r`, for some `r`. If UnliftedNewtypes is not enabled, we
           -- go one step further and ensure that it has kind `TYPE 'LiftedRep`.
           --
           -- See also Note [Arity of data families] in GHC.Core.FamInstEnv
           -- NB: we can do this after eta-reducing the axiom, because if
           --     we did it before the "extra" tvs from etaExpandAlgTyCon
           --     would always be eta-reduced
           --
           ; ([TyConBinder]
    extra_tcbs, PredType
    final_res_kind) <- [TyConBinder] -> PredType -> TcM ([TyConBinder], PredType)
    etaExpandAlgTyCon [TyConBinder]
    full_tcbs PredType
    res_kind

           -- Check the result kind; it may come from a user-written signature.
           -- See Note [Datatype return kinds] in GHC.Tc.TyCl point 4(a)
           ; let extra_pats :: [PredType]
    extra_pats  = (TyConBinder -> PredType) -> [TyConBinder] -> [PredType]
    forall a b. (a -> b) -> [a] -> [b]
    map (Id -> PredType
    mkTyVarTy (Id -> PredType) -> (TyConBinder -> Id) -> TyConBinder -> PredType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TyConBinder -> Id
    forall tv argf. VarBndr tv argf -> tv
    binderVar) [TyConBinder]
    extra_tcbs
                 all_pats :: [PredType]
    all_pats    = [PredType]
    pats [PredType] -> [PredType] -> [PredType]
    forall a. [a] -> [a] -> [a]
    `chkAppend` [PredType]
    extra_pats
                 orig_res_ty :: PredType
    orig_res_ty = TyCon -> [PredType] -> PredType
    mkTyConApp TyCon
    fam_tc [PredType]
    all_pats
                 ty_binders :: [TyConBinder]
    ty_binders  = [TyConBinder]
    full_tcbs [TyConBinder] -> [TyConBinder] -> [TyConBinder]
    forall a. [a] -> [a] -> [a]
    `chkAppend` [TyConBinder]
    extra_tcbs

           ; String -> SDoc -> TcRn ()
    traceTc String
    "tcDataFamInstDecl" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
             [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Fam tycon:" SDoc -> SDoc -> SDoc
    <+> TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    fam_tc
                  , String -> SDoc
    text String
    "Pats:" SDoc -> SDoc -> SDoc
    <+> [PredType] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [PredType]
    pats
                  , String -> SDoc
    text String
    "visiblities:" SDoc -> SDoc -> SDoc
    <+> [TyConBndrVis] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> [PredType] -> [TyConBndrVis]
    tcbVisibilities TyCon
    fam_tc [PredType]
    pats)
                  , String -> SDoc
    text String
    "all_pats:" SDoc -> SDoc -> SDoc
    <+> [PredType] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [PredType]
    all_pats
                  , String -> SDoc
    text String
    "ty_binders" SDoc -> SDoc -> SDoc
    <+> [TyConBinder] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TyConBinder]
    ty_binders
                  , String -> SDoc
    text String
    "fam_tc_binders:" SDoc -> SDoc -> SDoc
    <+> [TyConBinder] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> [TyConBinder]
    tyConBinders TyCon
    fam_tc)
                  , String -> SDoc
    text String
    "res_kind:" SDoc -> SDoc -> SDoc
    <+> PredType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PredType
    res_kind
                  , String -> SDoc
    text String
    "final_res_kind:" SDoc -> SDoc -> SDoc
    <+> PredType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PredType
    final_res_kind
                  , String -> SDoc
    text String
    "eta_pats" SDoc -> SDoc -> SDoc
    <+> [PredType] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [PredType]
    eta_pats
                  , String -> SDoc
    text String
    "eta_tcbs" SDoc -> SDoc -> SDoc
    <+> [TyConBinder] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TyConBinder]
    eta_tcbs ]

           ; (TyCon
    rep_tc, CoAxiom Unbranched
    axiom) <- ((TyCon, CoAxiom Unbranched)
     -> IOEnv (Env TcGblEnv TcLclEnv) (TyCon, CoAxiom Unbranched))
    -> IOEnv (Env TcGblEnv TcLclEnv) (TyCon, CoAxiom Unbranched)
    forall a env. (a -> IOEnv env a) -> IOEnv env a
    fixM (((TyCon, CoAxiom Unbranched)
      -> IOEnv (Env TcGblEnv TcLclEnv) (TyCon, CoAxiom Unbranched))
     -> IOEnv (Env TcGblEnv TcLclEnv) (TyCon, CoAxiom Unbranched))
    -> ((TyCon, CoAxiom Unbranched)
        -> IOEnv (Env TcGblEnv TcLclEnv) (TyCon, CoAxiom Unbranched))
    -> IOEnv (Env TcGblEnv TcLclEnv) (TyCon, CoAxiom Unbranched)
    forall a b. (a -> b) -> a -> b
    $ \ ~(TyCon
    rec_rep_tc, CoAxiom Unbranched
    _) ->
               do { [DataCon]
    data_cons <- [Id] -> TcM [DataCon] -> TcM [DataCon]
    forall r. [Id] -> TcM r -> TcM r
    tcExtendTyVarEnv [Id]
    qtvs (TcM [DataCon] -> TcM [DataCon]) -> TcM [DataCon] -> TcM [DataCon]
    forall a b. (a -> b) -> a -> b
    $
                      -- For H98 decls, the tyvars scope
                      -- over the data constructors
                      TyCon
    -> NewOrData
    -> [TyConBinder]
    -> PredType
    -> PredType
    -> [LConDecl (GhcPass 'Renamed)]
    -> TcM [DataCon]
    tcConDecls TyCon
    rec_rep_tc NewOrData
    new_or_data [TyConBinder]
    ty_binders PredType
    final_res_kind
                                 PredType
    orig_res_ty [LConDecl (GhcPass 'Renamed)]
    hs_cons

                  ; Name
    rep_tc_name <- GenLocated SrcSpan Name -> [PredType] -> TcM Name
    newFamInstTyConName GenLocated SrcSpan Name
    Located (IdP (GhcPass 'Renamed))
    lfam_name [PredType]
    pats
                  ; Name
    axiom_name  <- GenLocated SrcSpan Name -> [[PredType]] -> TcM Name
    newFamInstAxiomName GenLocated SrcSpan Name
    Located (IdP (GhcPass 'Renamed))
    lfam_name [[PredType]
    pats]
                  ; AlgTyConRhs
    tc_rhs <- case NewOrData
    new_or_data of
                         NewOrData
    DataType -> AlgTyConRhs -> IOEnv (Env TcGblEnv TcLclEnv) AlgTyConRhs
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([DataCon] -> AlgTyConRhs
    mkDataTyConRhs [DataCon]
    data_cons)
                         NewOrData
    NewType  -> ASSERT( not (null data_cons) )
                                     Name
    -> TyCon -> DataCon -> IOEnv (Env TcGblEnv TcLclEnv) AlgTyConRhs
    forall m n. Name -> TyCon -> DataCon -> TcRnIf m n AlgTyConRhs
    mkNewTyConRhs Name
    rep_tc_name TyCon
    rec_rep_tc ([DataCon] -> DataCon
    forall a. [a] -> a
    head [DataCon]
    data_cons)

                  ; let ax_rhs :: PredType
    ax_rhs = TyCon -> [PredType] -> PredType
    mkTyConApp TyCon
    rep_tc ([Id] -> [PredType]
    mkTyVarTys [Id]
    post_eta_qtvs)
                        axiom :: CoAxiom Unbranched
    axiom  = Role
    -> Name
    -> [Id]
    -> [Id]
    -> [Id]
    -> TyCon
    -> [PredType]
    -> PredType
    -> CoAxiom Unbranched
    mkSingleCoAxiom Role
    Representational Name
    axiom_name
                                     [Id]
    post_eta_qtvs [Id]
    eta_tvs [] TyCon
    fam_tc [PredType]
    eta_pats PredType
    ax_rhs
                        parent :: AlgTyConFlav
    parent = CoAxiom Unbranched -> TyCon -> [PredType] -> AlgTyConFlav
    DataFamInstTyCon CoAxiom Unbranched
    axiom TyCon
    fam_tc [PredType]
    all_pats

                          -- NB: Use the full ty_binders from the pats. See bullet toward
                          -- the end of Note [Data type families] in GHC.Core.TyCon
                        rep_tc :: TyCon
    rep_tc   = Name
    -> [TyConBinder]
    -> PredType
    -> [Role]
    -> Maybe CType
    -> [PredType]
    -> AlgTyConRhs
    -> AlgTyConFlav
    -> Bool
    -> TyCon
    mkAlgTyCon Name
    rep_tc_name
                                              [TyConBinder]
    ty_binders PredType
    final_res_kind
                                              ((TyConBinder -> Role) -> [TyConBinder] -> [Role]
    forall a b. (a -> b) -> [a] -> [b]
    map (Role -> TyConBinder -> Role
    forall a b. a -> b -> a
    const Role
    Nominal) [TyConBinder]
    ty_binders)
                                              ((Located CType -> CType) -> Maybe (Located CType) -> Maybe CType
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Located CType -> CType
    forall l e. GenLocated l e -> e
    unLoc Maybe (Located CType)
    cType) [PredType]
    stupid_theta
                                              AlgTyConRhs
    tc_rhs AlgTyConFlav
    parent
                                              Bool
    gadt_syntax
                     -- We always assume that indexed types are recursive.  Why?
                     -- (1) Due to their open nature, we can never be sure that a
                     -- further instance might not introduce a new recursive
                     -- dependency.  (2) They are always valid loop breakers as
                     -- they involve a coercion.
                  ; (TyCon, CoAxiom Unbranched)
    -> IOEnv (Env TcGblEnv TcLclEnv) (TyCon, CoAxiom Unbranched)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TyCon
    rep_tc, CoAxiom Unbranched
    axiom) }

           -- Remember to check validity; no recursion to worry about here
           -- Check that left-hand sides are ok (mono-types, no type families,
           -- consistent instantiations, etc)
           ; let ax_branch :: KnotTied CoAxBranch
    ax_branch = CoAxiom Unbranched -> KnotTied CoAxBranch
    coAxiomSingleBranch CoAxiom Unbranched
    axiom
           ; AssocInstInfo -> TyCon -> KnotTied CoAxBranch -> TcRn ()
    checkConsistentFamInst AssocInstInfo
    mb_clsinfo TyCon
    fam_tc KnotTied CoAxBranch
    ax_branch
           ; TyCon -> KnotTied CoAxBranch -> TcRn ()
    checkValidCoAxBranch TyCon
    fam_tc KnotTied CoAxBranch
    ax_branch
           ; TyCon -> TcRn ()
    checkValidTyCon TyCon
    rep_tc

           ; let scoped_tvs :: [(Name, Id)]
    scoped_tvs = (Id -> (Name, Id)) -> [Id] -> [(Name, Id)]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> (Name, Id)
    mk_deriv_info_scoped_tv_pr (TyCon -> [Id]
    tyConTyVars TyCon
    rep_tc)
                 m_deriv_info :: Maybe DerivInfo
    m_deriv_info = case HsDeriving (GhcPass 'Renamed)
    derivs of
                   L SrcSpan
    _ []    -> Maybe DerivInfo
    forall a. Maybe a
    Nothing
                   L SrcSpan
    _ [LHsDerivingClause (GhcPass 'Renamed)]
    preds ->
                     DerivInfo -> Maybe DerivInfo
    forall a. a -> Maybe a
    Just (DerivInfo -> Maybe DerivInfo) -> DerivInfo -> Maybe DerivInfo
    forall a b. (a -> b) -> a -> b
    $ DerivInfo :: TyCon
    -> [(Name, Id)]
    -> [LHsDerivingClause (GhcPass 'Renamed)]
    -> SDoc
    -> DerivInfo
    DerivInfo { di_rep_tc :: TyCon
    di_rep_tc  = TyCon
    rep_tc
                                      , di_scoped_tvs :: [(Name, Id)]
    di_scoped_tvs = [(Name, Id)]
    scoped_tvs
                                      , di_clauses :: [LHsDerivingClause (GhcPass 'Renamed)]
    di_clauses = [LHsDerivingClause (GhcPass 'Renamed)]
    preds
                                      , di_ctxt :: SDoc
    di_ctxt    = DataFamInstDecl (GhcPass 'Renamed) -> SDoc
    tcMkDataFamInstCtxt DataFamInstDecl (GhcPass 'Renamed)
    decl }

           ; FamInst
    fam_inst <- FamFlavor -> CoAxiom Unbranched -> TcM FamInst
    newFamInst (TyCon -> FamFlavor
    DataFamilyInst TyCon
    rep_tc) CoAxiom Unbranched
    axiom
           ; (FamInst, Maybe DerivInfo) -> TcM (FamInst, Maybe DerivInfo)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FamInst
    fam_inst, Maybe DerivInfo
    m_deriv_info) }
      where
        eta_reduce :: TyCon -> [Type] -> ([Type], [TyConBinder])
        -- See Note [Eta reduction for data families] in GHC.Core.Coercion.Axiom
        -- Splits the incoming patterns into two: the [TyVar]
        -- are the patterns that can be eta-reduced away.
        -- e.g.     T [a] Int a d c   ==>  (T [a] Int a, [d,c])
        --
        -- NB: quadratic algorithm, but types are small here
        eta_reduce :: TyCon -> [PredType] -> ([PredType], [TyConBinder])
    eta_reduce TyCon
    fam_tc [PredType]
    pats
            = [(PredType, VarSet, TyConBndrVis)]
    -> [TyConBinder] -> ([PredType], [TyConBinder])
    forall {c}.
    [(PredType, VarSet, c)]
    -> [VarBndr Id c] -> ([PredType], [VarBndr Id c])
    go ([(PredType, VarSet, TyConBndrVis)]
    -> [(PredType, VarSet, TyConBndrVis)]
    forall a. [a] -> [a]
    reverse ([PredType]
    -> [VarSet] -> [TyConBndrVis] -> [(PredType, VarSet, TyConBndrVis)]
    forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
    zip3 [PredType]
    pats [VarSet]
    fvs_s [TyConBndrVis]
    vis_s)) []
            where
              vis_s :: [TyConBndrVis]
              vis_s :: [TyConBndrVis]
    vis_s = TyCon -> [PredType] -> [TyConBndrVis]
    tcbVisibilities TyCon
    fam_tc [PredType]
    pats

              fvs_s :: [TyCoVarSet]  -- 1-1 correspondence with pats
                                     -- Each elt is the free vars of all /earlier/ pats
              (VarSet
    _, [VarSet]
    fvs_s) = (VarSet -> PredType -> (VarSet, VarSet))
    -> VarSet -> [PredType] -> (VarSet, [VarSet])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL VarSet -> PredType -> (VarSet, VarSet)
    add_fvs VarSet
    emptyVarSet [PredType]
    pats
              add_fvs :: VarSet -> PredType -> (VarSet, VarSet)
    add_fvs VarSet
    fvs PredType
    pat = (VarSet
    fvs VarSet -> VarSet -> VarSet
    `unionVarSet` PredType -> VarSet
    tyCoVarsOfType PredType
    pat, VarSet
    fvs)

        go :: [(PredType, VarSet, c)]
    -> [VarBndr Id c] -> ([PredType], [VarBndr Id c])
    go ((PredType
    pat, VarSet
    fvs_to_the_left, c
    tcb_vis):[(PredType, VarSet, c)]
    pats) [VarBndr Id c]
    etad_tvs
          | Just Id
    tv <- PredType -> Maybe Id
    getTyVar_maybe PredType
    pat
          , Bool -> Bool
    not (Id
    tv Id -> VarSet -> Bool
    `elemVarSet` VarSet
    fvs_to_the_left)
          = [(PredType, VarSet, c)]
    -> [VarBndr Id c] -> ([PredType], [VarBndr Id c])
    go [(PredType, VarSet, c)]
    pats (Id -> c -> VarBndr Id c
    forall var argf. var -> argf -> VarBndr var argf
    Bndr Id
    tv c
    tcb_vis VarBndr Id c -> [VarBndr Id c] -> [VarBndr Id c]
    forall a. a -> [a] -> [a]
    : [VarBndr Id c]
    etad_tvs)
        go [(PredType, VarSet, c)]
    pats [VarBndr Id c]
    etad_tvs = ([PredType] -> [PredType]
    forall a. [a] -> [a]
    reverse (((PredType, VarSet, c) -> PredType)
    -> [(PredType, VarSet, c)] -> [PredType]
    forall a b. (a -> b) -> [a] -> [b]
    map (PredType, VarSet, c) -> PredType
    forall a b c. (a, b, c) -> a
    fstOf3 [(PredType, VarSet, c)]
    pats), [VarBndr Id c]
    etad_tvs)

        -- Create a Name-TyVar mapping to bring into scope when typechecking any
        -- deriving clauses this data family instance may have.
        -- See Note [Associated data family instances and di_scoped_tvs].
        mk_deriv_info_scoped_tv_pr :: TyVar -> (Name, TyVar)
        mk_deriv_info_scoped_tv_pr :: Id -> (Name, Id)
    mk_deriv_info_scoped_tv_pr Id
    tv =
          let n :: Name
    n = TyVarEnv Name -> Name -> Id -> Name
    forall a. VarEnv a -> a -> Id -> a
    lookupWithDefaultVarEnv TyVarEnv Name
    tv_skol_env (Id -> Name
    tyVarName Id
    tv) Id
    tv
          in (Name
    n, Id
    tv)

    {-
    Note [Associated data family instances and di_scoped_tvs]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Some care is required to implement `deriving` correctly for associated data
    family instances. Consider this example from #18055:

      class C a where
        data D a

      class X a b

      instance C (Maybe a) where
        data D (Maybe a) deriving (X a)

    When typechecking the `X a` in `deriving (X a)`, we must ensure that the `a`
    from the instance header is brought into scope. This is the role of
    di_scoped_tvs, which maps from the original, renamed `a` to the skolemized,
    typechecked `a`. When typechecking the `deriving` clause, this mapping will be
    consulted when looking up the `a` in `X a`.

    A naïve attempt at creating the di_scoped_tvs is to simply reuse the
    tyConTyVars of the representation TyCon for `data D (Maybe a)`. This is only
    half correct, however. We do want the typechecked `a`'s Name in the /range/
    of the mapping, but we do not want it in the /domain/ of the mapping.
    To ensure that the original `a`'s Name ends up in the domain, we consult a
    TyVarEnv (passed as an argument to tcDataFamInstDecl) that maps from the
    typechecked `a`'s Name to the original `a`'s Name. In the even that
    tcDataFamInstDecl is processing a non-associated data family instance, this
    TyVarEnv will simply be empty, and there is nothing to worry about.
    -}

    -----------------------
    tcDataFamInstHeader
        :: AssocInstInfo -> TyCon -> [Name] -> Maybe [LHsTyVarBndr () GhcRn]
        -> LexicalFixity -> LHsContext GhcRn
        -> HsTyPats GhcRn -> Maybe (LHsKind GhcRn) -> [LConDecl GhcRn]
        -> NewOrData
        -> TcM ([TyVar], [Type], Kind, ThetaType)
    -- The "header" of a data family instance is the part other than
    -- the data constructors themselves
    --    e.g.  data instance D [a] :: * -> * where ...
    -- Here the "header" is the bit before the "where"
    tcDataFamInstHeader :: AssocInstInfo
    -> TyCon
    -> [Name]
    -> Maybe [LHsTyVarBndr () (GhcPass 'Renamed)]
    -> LexicalFixity
    -> LHsContext (GhcPass 'Renamed)
    -> HsTyPats (GhcPass 'Renamed)
    -> Maybe (LHsType (GhcPass 'Renamed))
    -> [LConDecl (GhcPass 'Renamed)]
    -> NewOrData
    -> TcM ([Id], [PredType], PredType, [PredType])
    tcDataFamInstHeader AssocInstInfo
    mb_clsinfo TyCon
    fam_tc [Name]
    imp_vars Maybe [LHsTyVarBndr () (GhcPass 'Renamed)]
    mb_bndrs LexicalFixity
    fixity
                        LHsContext (GhcPass 'Renamed)
    hs_ctxt HsTyPats (GhcPass 'Renamed)
    hs_pats Maybe (LHsType (GhcPass 'Renamed))
    m_ksig [LConDecl (GhcPass 'Renamed)]
    hs_cons NewOrData
    new_or_data
      = do { String -> SDoc -> TcRn ()
    traceTc String
    "tcDataFamInstHeader {" (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    fam_tc SDoc -> SDoc -> SDoc
    <+> HsTyPats (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsTyPats (GhcPass 'Renamed)
    hs_pats)
           ; ([Id]
    imp_tvs, ([Id]
    exp_tvs, ([PredType]
    stupid_theta, PredType
    lhs_ty, PredType
    master_res_kind, PredType
    instance_res_kind)))
                <- TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType)))
    -> TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType)))
    forall a. TcM a -> TcM a
    pushTcLevelM_                                (TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType)))
     -> TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType))))
    -> TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType)))
    -> TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType)))
    forall a b. (a -> b) -> a -> b
    $
                   TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType)))
    -> TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType)))
    forall a. TcM a -> TcM a
    solveEqualities                              (TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType)))
     -> TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType))))
    -> TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType)))
    -> TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType)))
    forall a b. (a -> b) -> a -> b
    $
                   [Name]
    -> TcM ([Id], ([PredType], PredType, PredType, PredType))
    -> TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType)))
    forall a. [Name] -> TcM a -> TcM ([Id], a)
    bindImplicitTKBndrs_Q_Skol [Name]
    imp_vars          (TcM ([Id], ([PredType], PredType, PredType, PredType))
     -> TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType))))
    -> TcM ([Id], ([PredType], PredType, PredType, PredType))
    -> TcM ([Id], ([Id], ([PredType], PredType, PredType, PredType)))
    forall a b. (a -> b) -> a -> b
    $
                   ContextKind
    -> [LHsTyVarBndr () (GhcPass 'Renamed)]
    -> TcM ([PredType], PredType, PredType, PredType)
    -> TcM ([Id], ([PredType], PredType, PredType, PredType))
    forall a.
    ContextKind
    -> [LHsTyVarBndr () (GhcPass 'Renamed)] -> TcM a -> TcM ([Id], a)
    bindExplicitTKBndrs_Q_Skol ContextKind
    AnyKind [LHsTyVarBndr () (GhcPass 'Renamed)]
    exp_bndrs (TcM ([PredType], PredType, PredType, PredType)
     -> TcM ([Id], ([PredType], PredType, PredType, PredType)))
    -> TcM ([PredType], PredType, PredType, PredType)
    -> TcM ([Id], ([PredType], PredType, PredType, PredType))
    forall a b. (a -> b) -> a -> b
    $
                   do { [PredType]
    stupid_theta <- LHsContext (GhcPass 'Renamed) -> TcM [PredType]
    tcHsContext LHsContext (GhcPass 'Renamed)
    hs_ctxt
                      ; (PredType
    lhs_ty, PredType
    lhs_kind) <- TyCon -> HsTyPats (GhcPass 'Renamed) -> TcM (PredType, PredType)
    tcFamTyPats TyCon
    fam_tc HsTyPats (GhcPass 'Renamed)
    hs_pats
                      ; (PredType
    lhs_applied_ty, PredType
    lhs_applied_kind)
                          <- PredType -> PredType -> TcM (PredType, PredType)
    tcInstInvisibleTyBinders PredType
    lhs_ty PredType
    lhs_kind
                          -- See Note [Data family/instance return kinds]
                          -- in GHC.Tc.TyCl point (DF3)

                      -- Ensure that the instance is consistent
                      -- with its parent class
                      ; AssocInstInfo -> PredType -> TcRn ()
    addConsistencyConstraints AssocInstInfo
    mb_clsinfo PredType
    lhs_ty

                      -- Add constraints from the result signature
                      ; PredType
    res_kind <- Maybe (LHsType (GhcPass 'Renamed)) -> TcM PredType
    tc_kind_sig Maybe (LHsType (GhcPass 'Renamed))
    m_ksig

                      -- Add constraints from the data constructors
                      ; NewOrData -> PredType -> [LConDecl (GhcPass 'Renamed)] -> TcRn ()
    kcConDecls NewOrData
    new_or_data PredType
    res_kind [LConDecl (GhcPass 'Renamed)]
    hs_cons

                      -- Check that the result kind of the TyCon applied to its args
                      -- is compatible with the explicit signature (or Type, if there
                      -- is none)
                      ; let hs_lhs :: LHsType (GhcPass 'Renamed)
    hs_lhs = LexicalFixity
    -> IdP (GhcPass 'Renamed)
    -> HsTyPats (GhcPass 'Renamed)
    -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass).
    LexicalFixity
    -> IdP (GhcPass p)
    -> [LHsTypeArg (GhcPass p)]
    -> LHsType (GhcPass p)
    nlHsTyConApp LexicalFixity
    fixity (TyCon -> Name
    forall a. NamedThing a => a -> Name
    getName TyCon
    fam_tc) HsTyPats (GhcPass 'Renamed)
    hs_pats
                      ; CoercionN
    _ <- Maybe (HsType (GhcPass 'Renamed))
    -> PredType -> PredType -> TcM CoercionN
    unifyKind (HsType (GhcPass 'Renamed) -> Maybe (HsType (GhcPass 'Renamed))
    forall a. a -> Maybe a
    Just (LHsType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed)
    forall l e. GenLocated l e -> e
    unLoc LHsType (GhcPass 'Renamed)
    hs_lhs)) PredType
    lhs_applied_kind PredType
    res_kind

                      ; String -> SDoc -> TcRn ()
    traceTc String
    "tcDataFamInstHeader" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
                        [SDoc] -> SDoc
    vcat [ TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    fam_tc, Maybe (LHsType (GhcPass 'Renamed)) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe (LHsType (GhcPass 'Renamed))
    m_ksig, PredType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PredType
    lhs_applied_kind, PredType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PredType
    res_kind ]
                      ; ([PredType], PredType, PredType, PredType)
    -> TcM ([PredType], PredType, PredType, PredType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( [PredType]
    stupid_theta
                               , PredType
    lhs_applied_ty
                               , PredType
    lhs_applied_kind
                               , PredType
    res_kind ) }

           -- See GHC.Tc.TyCl Note [Generalising in tcFamTyPatsGuts]
           -- This code (and the stuff immediately above) is very similar
           -- to that in tcTyFamInstEqnGuts.  Maybe we should abstract the
           -- common code; but for the moment I concluded that it's
           -- clearer to duplicate it.  Still, if you fix a bug here,
           -- check there too!
           ; let scoped_tvs :: [Id]
    scoped_tvs = [Id]
    imp_tvs [Id] -> [Id] -> [Id]
    forall a. [a] -> [a] -> [a]
    ++ [Id]
    exp_tvs
           ; CandidatesQTvs
    dvs  <- [PredType] -> TcM CandidatesQTvs
    candidateQTyVarsOfTypes (PredType
    lhs_ty PredType -> [PredType] -> [PredType]
    forall a. a -> [a] -> [a]
    : [Id] -> [PredType]
    mkTyVarTys [Id]
    scoped_tvs)
           ; [Id]
    qtvs <- CandidatesQTvs -> TcM [Id]
    quantifyTyVars CandidatesQTvs
    dvs

           -- Zonk the patterns etc into the Type world
           ; (ZonkEnv
    ze, [Id]
    qtvs)   <- [Id] -> TcM (ZonkEnv, [Id])
    zonkTyBndrs [Id]
    qtvs
           ; PredType
    lhs_ty       <- ZonkEnv -> PredType -> TcM PredType
    zonkTcTypeToTypeX ZonkEnv
    ze PredType
    lhs_ty
           ; [PredType]
    stupid_theta <- ZonkEnv -> [PredType] -> TcM [PredType]
    zonkTcTypesToTypesX ZonkEnv
    ze [PredType]
    stupid_theta
           ; PredType
    master_res_kind   <- ZonkEnv -> PredType -> TcM PredType
    zonkTcTypeToTypeX ZonkEnv
    ze PredType
    master_res_kind
           ; PredType
    instance_res_kind <- ZonkEnv -> PredType -> TcM PredType
    zonkTcTypeToTypeX ZonkEnv
    ze PredType
    instance_res_kind

           -- We check that res_kind is OK with checkDataKindSig in
           -- tcDataFamInstDecl, after eta-expansion.  We need to check that
           -- it's ok because res_kind can come from a user-written kind signature.
           -- See Note [Datatype return kinds], point (4a)

           ; DataSort -> PredType -> TcRn ()
    checkDataKindSig (NewOrData -> DataSort
    DataInstanceSort NewOrData
    new_or_data) PredType
    master_res_kind
           ; DataSort -> PredType -> TcRn ()
    checkDataKindSig (NewOrData -> DataSort
    DataInstanceSort NewOrData
    new_or_data) PredType
    instance_res_kind

           -- Check that type patterns match the class instance head
           -- The call to splitTyConApp_maybe here is just an inlining of
           -- the body of unravelFamInstPats.
           ; [PredType]
    pats <- case HasDebugCallStack => PredType -> Maybe (TyCon, [PredType])
    PredType -> Maybe (TyCon, [PredType])
    splitTyConApp_maybe PredType
    lhs_ty of
               Just (TyCon
    _, [PredType]
    pats) -> [PredType] -> TcM [PredType]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [PredType]
    pats
               Maybe (TyCon, [PredType])
    Nothing -> String -> SDoc -> TcM [PredType]
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcDataFamInstHeader" (PredType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PredType
    lhs_ty)

           ; ([Id], [PredType], PredType, [PredType])
    -> TcM ([Id], [PredType], PredType, [PredType])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id]
    qtvs, [PredType]
    pats, PredType
    master_res_kind, [PredType]
    stupid_theta) }
      where
        fam_name :: Name
    fam_name  = TyCon -> Name
    tyConName TyCon
    fam_tc
        data_ctxt :: UserTypeCtxt
    data_ctxt = Name -> UserTypeCtxt
    DataKindCtxt Name
    fam_name
        exp_bndrs :: [LHsTyVarBndr () (GhcPass 'Renamed)]
    exp_bndrs = Maybe [LHsTyVarBndr () (GhcPass 'Renamed)]
    mb_bndrs Maybe [LHsTyVarBndr () (GhcPass 'Renamed)]
    -> [LHsTyVarBndr () (GhcPass 'Renamed)]
    -> [LHsTyVarBndr () (GhcPass 'Renamed)]
    forall a. Maybe a -> a -> a
    `orElse` []

        -- See Note [Implementation of UnliftedNewtypes] in GHC.Tc.TyCl, wrinkle (2).
        tc_kind_sig :: Maybe (LHsType (GhcPass 'Renamed)) -> TcM PredType
    tc_kind_sig Maybe (LHsType (GhcPass 'Renamed))
    Nothing
          = do { Bool
    unlifted_newtypes <- Extension -> TcRn Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.UnliftedNewtypes
               ; if Bool
    unlifted_newtypes Bool -> Bool -> Bool
    && NewOrData
    new_or_data NewOrData -> NewOrData -> Bool
    forall a. Eq a => a -> a -> Bool
    == NewOrData
    NewType
                   then TcM PredType
    newOpenTypeKind
                   else PredType -> TcM PredType
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure PredType
    liftedTypeKind
               }

        -- See Note [Result kind signature for a data family instance]
        tc_kind_sig (Just LHsType (GhcPass 'Renamed)
    hs_kind)
          = do { PredType
    sig_kind <- UserTypeCtxt -> LHsType (GhcPass 'Renamed) -> TcM PredType
    tcLHsKindSig UserTypeCtxt
    data_ctxt LHsType (GhcPass 'Renamed)
    hs_kind
               ; let ([Id]
    tvs, PredType
    inner_kind) = PredType -> ([Id], PredType)
    tcSplitForAllTys PredType
    sig_kind
               ; TcLevel
    lvl <- TcM TcLevel
    getTcLevel
               ; (TCvSubst
    subst, [Id]
    _tvs') <- TcLevel -> Bool -> TCvSubst -> [Id] -> TcM (TCvSubst, [Id])
    tcInstSkolTyVarsAt TcLevel
    lvl Bool
    False TCvSubst
    emptyTCvSubst [Id]
    tvs
                 -- Perhaps surprisingly, we don't need the skolemised tvs themselves
               ; PredType -> TcM PredType
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HasCallStack => TCvSubst -> PredType -> PredType
    TCvSubst -> PredType -> PredType
    substTy TCvSubst
    subst PredType
    inner_kind) }

    {- Note [Result kind signature for a data family instance]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The expected type might have a forall at the type. Normally, we
    can't skolemise in kinds because we don't have type-level lambda.
    But here, we're at the top-level of an instance declaration, so
    we actually have a place to put the regeneralised variables.
    Thus: skolemise away. cf. GHC.Tc.Utils.Unify.tcSkolemise
    Examples in indexed-types/should_compile/T12369

    Note [Implementing eta reduction for data families]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
       data D :: * -> * -> * -> * -> *

       data instance D [(a,b)] p q :: * -> * where
          D1 :: blah1
          D2 :: blah2

    Then we'll generate a representation data type
      data Drep a b p q z where
          D1 :: blah1
          D2 :: blah2

    and an axiom to connect them
      axiom AxDrep forall a b p q z. D [(a,b]] p q z = Drep a b p q z

    except that we'll eta-reduce the axiom to
      axiom AxDrep forall a b. D [(a,b]] = Drep a b

    This is described at some length in Note [Eta reduction for data families]
    in GHC.Core.Coercion.Axiom. There are several fiddly subtleties lurking here,
    however, so this Note aims to describe these subtleties:

    * The representation tycon Drep is parameterised over the free
      variables of the pattern, in no particular order. So there is no
      guarantee that 'p' and 'q' will come last in Drep's parameters, and
      in the right order.  So, if the /patterns/ of the family instance
      are eta-reducible, we re-order Drep's parameters to put the
      eta-reduced type variables last.

    * Although we eta-reduce the axiom, we eta-/expand/ the representation
      tycon Drep.  The kind of D says it takes four arguments, but the
      data instance header only supplies three.  But the AlgTyCon for Drep
      itself must have enough TyConBinders so that its result kind is Type.
      So, with etaExpandAlgTyCon we make up some extra TyConBinders.
      See point (3) in Note [Datatype return kinds] in GHC.Tc.TyCl.

    * The result kind in the instance might be a polykind, like this:
         data family DP a :: forall k. k -> *
         data instance DP [b] :: forall k1 k2. (k1,k2) -> *

      So in type-checking the LHS (DP Int) we need to check that it is
      more polymorphic than the signature.  To do that we must skolemise
      the signature and instantiate the call of DP.  So we end up with
         data instance DP [b] @(k1,k2) (z :: (k1,k2)) where

      Note that we must parameterise the representation tycon DPrep over
      'k1' and 'k2', as well as 'b'.

      The skolemise bit is done in tc_kind_sig, while the instantiate bit
      is done by tcFamTyPats.

    * Very fiddly point.  When we eta-reduce to
         axiom AxDrep forall a b. D [(a,b]] = Drep a b

      we want the kind of (D [(a,b)]) to be the same as the kind of
      (Drep a b).  This ensures that applying the axiom doesn't change the
      kind.  Why is that hard?  Because the kind of (Drep a b) depends on
      the TyConBndrVis on Drep's arguments. In particular do we have
        (forall (k::*). blah) or (* -> blah)?

      We must match whatever D does!  In #15817 we had
          data family X a :: forall k. * -> *   -- Note: a forall that is not used
          data instance X Int b = MkX

      So the data instance is really
          data istance X Int @k b = MkX

      The axiom will look like
          axiom    X Int = Xrep

      and it's important that XRep :: forall k * -> *, following X.

      To achieve this we get the TyConBndrVis flags from tcbVisibilities,
      and use those flags for any eta-reduced arguments.  Sigh.

    * The final turn of the knife is that tcbVisibilities is itself
      tricky to sort out.  Consider
          data family D k :: k
      Then consider D (forall k2. k2 -> k2) Type Type
      The visibility flags on an application of D may affected by the arguments
      themselves.  Heavy sigh.  But not truly hard; that's what tcbVisibilities
      does.

    -}

    {- *********************************************************************
    *                                                                      *
          Class instance declarations, pass 2
    *                                                                      *
    ********************************************************************* -}

    tcInstDecls2 :: [LTyClDecl GhcRn] -> [InstInfo GhcRn]
                 -> TcM (LHsBinds GhcTc)
    -- (a) From each class declaration,
    --      generate any default-method bindings
    -- (b) From each instance decl
    --      generate the dfun binding

    tcInstDecls2 :: [LTyClDecl (GhcPass 'Renamed)]
    -> [InstInfo (GhcPass 'Renamed)] -> TcM (LHsBinds GhcTc)
    tcInstDecls2 [LTyClDecl (GhcPass 'Renamed)]
    tycl_decls [InstInfo (GhcPass 'Renamed)]
    inst_decls
      = do  { -- (a) Default methods from class decls
              let class_decls :: [LTyClDecl (GhcPass 'Renamed)]
    class_decls = (LTyClDecl (GhcPass 'Renamed) -> Bool)
    -> [LTyClDecl (GhcPass 'Renamed)] -> [LTyClDecl (GhcPass 'Renamed)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (TyClDecl (GhcPass 'Renamed) -> Bool
    forall pass. TyClDecl pass -> Bool
    isClassDecl (TyClDecl (GhcPass 'Renamed) -> Bool)
    -> (LTyClDecl (GhcPass 'Renamed) -> TyClDecl (GhcPass 'Renamed))
    -> LTyClDecl (GhcPass 'Renamed)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LTyClDecl (GhcPass 'Renamed) -> TyClDecl (GhcPass 'Renamed)
    forall l e. GenLocated l e -> e
    unLoc) [LTyClDecl (GhcPass 'Renamed)]
    tycl_decls
            ; [LHsBinds GhcTc]
    dm_binds_s <- (LTyClDecl (GhcPass 'Renamed) -> TcM (LHsBinds GhcTc))
    -> [LTyClDecl (GhcPass 'Renamed)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [LHsBinds GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM LTyClDecl (GhcPass 'Renamed) -> TcM (LHsBinds GhcTc)
    tcClassDecl2 [LTyClDecl (GhcPass 'Renamed)]
    class_decls
            ; let dm_binds :: LHsBinds GhcTc
    dm_binds = [LHsBinds GhcTc] -> LHsBinds GhcTc
    forall a. [Bag a] -> Bag a
    unionManyBags [LHsBinds GhcTc]
    dm_binds_s

              -- (b) instance declarations
            ; let dm_ids :: [IdP GhcTc]
    dm_ids = LHsBinds GhcTc -> [IdP GhcTc]
    forall p idR. CollectPass p => LHsBindsLR p idR -> [IdP p]
    collectHsBindsBinders LHsBinds GhcTc
    dm_binds
                  -- Add the default method Ids (again)
                  -- (they were arready added in GHC.Tc.TyCl.Utils.tcAddImplicits)
                  -- See Note [Default methods in the type environment]
            ; [LHsBinds GhcTc]
    inst_binds_s <- [Id]
    -> IOEnv (Env TcGblEnv TcLclEnv) [LHsBinds GhcTc]
    -> IOEnv (Env TcGblEnv TcLclEnv) [LHsBinds GhcTc]
    forall r. [Id] -> TcM r -> TcM r
    tcExtendGlobalValEnv [Id]
    [IdP GhcTc]
    dm_ids (IOEnv (Env TcGblEnv TcLclEnv) [LHsBinds GhcTc]
     -> IOEnv (Env TcGblEnv TcLclEnv) [LHsBinds GhcTc])
    -> IOEnv (Env TcGblEnv TcLclEnv) [LHsBinds GhcTc]
    -> IOEnv (Env TcGblEnv TcLclEnv) [LHsBinds GhcTc]
    forall a b. (a -> b) -> a -> b
    $
                              (InstInfo (GhcPass 'Renamed) -> TcM (LHsBinds GhcTc))
    -> [InstInfo (GhcPass 'Renamed)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [LHsBinds GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM InstInfo (GhcPass 'Renamed) -> TcM (LHsBinds GhcTc)
    tcInstDecl2 [InstInfo (GhcPass 'Renamed)]
    inst_decls

              -- Done
            ; LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds GhcTc
    dm_binds LHsBinds GhcTc -> LHsBinds GhcTc -> LHsBinds GhcTc
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` [LHsBinds GhcTc] -> LHsBinds GhcTc
    forall a. [Bag a] -> Bag a
    unionManyBags [LHsBinds GhcTc]
    inst_binds_s) }

    {- Note [Default methods in the type environment]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The default method Ids are already in the type environment (see Note
    [Default method Ids and Template Haskell] in TcTyDcls), BUT they
    don't have their InlinePragmas yet.  Usually that would not matter,
    because the simplifier propagates information from binding site to
    use.  But, unusually, when compiling instance decls we *copy* the
    INLINE pragma from the default method to the method for that
    particular operation (see Note [INLINE and default methods] below).

    So right here in tcInstDecls2 we must re-extend the type envt with
    the default method Ids replete with their INLINE pragmas.  Urk.
    -}

    tcInstDecl2 :: InstInfo GhcRn -> TcM (LHsBinds GhcTc)
                -- Returns a binding for the dfun
    tcInstDecl2 :: InstInfo (GhcPass 'Renamed) -> TcM (LHsBinds GhcTc)
    tcInstDecl2 (InstInfo { iSpec :: forall a. InstInfo a -> ClsInst
    iSpec = ClsInst
    ispec, iBinds :: forall a. InstInfo a -> InstBindings a
    iBinds = InstBindings (GhcPass 'Renamed)
    ibinds })
      = TcM (LHsBinds GhcTc)
    -> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
    forall r. TcRn r -> TcRn r -> TcRn r
    recoverM (LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return LHsBinds GhcTc
    forall idL idR. LHsBindsLR idL idR
    emptyLHsBinds)             (TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc))
    -> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        SrcSpan -> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc                              (TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc))
    -> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        SDoc -> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (PredType -> SDoc
    instDeclCtxt2 (Id -> PredType
    idType Id
    dfun_id)) (TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc))
    -> TcM (LHsBinds GhcTc) -> TcM (LHsBinds GhcTc)
    forall a b. (a -> b) -> a -> b
    $
        do {  -- Instantiate the instance decl with skolem constants
           ; ([Id]
    inst_tyvars, [PredType]
    dfun_theta, PredType
    inst_head) <- Id -> TcM ([Id], [PredType], PredType)
    tcSkolDFunType Id
    dfun_id
           ; [Id]
    dfun_ev_vars <- [PredType] -> TcM [Id]
    newEvVars [PredType]
    dfun_theta
                         -- We instantiate the dfun_id with superSkolems.
                         -- See Note [Subtle interaction of recursion and overlap]
                         -- and Note [Binding when looking up instances]

           ; let (Class
    clas, [PredType]
    inst_tys) = PredType -> (Class, [PredType])
    tcSplitDFunHead PredType
    inst_head
                 ([Id]
    class_tyvars, [PredType]
    sc_theta, [Id]
    _, [ClassOpItem]
    op_items) = Class -> ([Id], [PredType], [Id], [ClassOpItem])
    classBigSig Class
    clas
                 sc_theta' :: [PredType]
    sc_theta' = HasCallStack => TCvSubst -> [PredType] -> [PredType]
    TCvSubst -> [PredType] -> [PredType]
    substTheta ([Id] -> [PredType] -> TCvSubst
    HasDebugCallStack => [Id] -> [PredType] -> TCvSubst
    zipTvSubst [Id]
    class_tyvars [PredType]
    inst_tys) [PredType]
    sc_theta

           ; String -> SDoc -> TcRn ()
    traceTc String
    "tcInstDecl2" ([SDoc] -> SDoc
    vcat [[Id] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Id]
    inst_tyvars, [PredType] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [PredType]
    inst_tys, [PredType] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [PredType]
    dfun_theta, [PredType] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [PredType]
    sc_theta'])

                          -- Deal with 'SPECIALISE instance' pragmas
                          -- See Note [SPECIALISE instance pragmas]
           ; spec_inst_info :: ([Located TcSpecPrag], TcPragEnv)
    spec_inst_info@([Located TcSpecPrag]
    spec_inst_prags,TcPragEnv
    _) <- Id
    -> InstBindings (GhcPass 'Renamed)
    -> TcM ([Located TcSpecPrag], TcPragEnv)
    tcSpecInstPrags Id
    dfun_id InstBindings (GhcPass 'Renamed)
    ibinds

             -- Typecheck superclasses and methods
             -- See Note [Typechecking plan for instance declarations]
           ; EvBindsVar
    dfun_ev_binds_var <- TcM EvBindsVar
    newTcEvBinds
           ; let dfun_ev_binds :: TcEvBinds
    dfun_ev_binds = EvBindsVar -> TcEvBinds
    TcEvBinds EvBindsVar
    dfun_ev_binds_var
           ; (TcLevel
    tclvl, ([Id]
    sc_meth_ids, LHsBinds GhcTc
    sc_meth_binds, Bag Implication
    sc_meth_implics))
                 <- TcM ([Id], LHsBinds GhcTc, Bag Implication)
    -> TcM (TcLevel, ([Id], LHsBinds GhcTc, Bag Implication))
    forall a. TcM a -> TcM (TcLevel, a)
    pushTcLevelM (TcM ([Id], LHsBinds GhcTc, Bag Implication)
     -> TcM (TcLevel, ([Id], LHsBinds GhcTc, Bag Implication)))
    -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
    -> TcM (TcLevel, ([Id], LHsBinds GhcTc, Bag Implication))
    forall a b. (a -> b) -> a -> b
    $
                    do { ([Id]
    sc_ids, LHsBinds GhcTc
    sc_binds, Bag Implication
    sc_implics)
                            <- Id
    -> Class
    -> [Id]
    -> [Id]
    -> [PredType]
    -> TcEvBinds
    -> [PredType]
    -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
    tcSuperClasses Id
    dfun_id Class
    clas [Id]
    inst_tyvars [Id]
    dfun_ev_vars
                                              [PredType]
    inst_tys TcEvBinds
    dfun_ev_binds
                                              [PredType]
    sc_theta'

                          -- Typecheck the methods
                       ; ([Id]
    meth_ids, LHsBinds GhcTc
    meth_binds, Bag Implication
    meth_implics)
                            <- Id
    -> Class
    -> [Id]
    -> [Id]
    -> [PredType]
    -> TcEvBinds
    -> ([Located TcSpecPrag], TcPragEnv)
    -> [ClassOpItem]
    -> InstBindings (GhcPass 'Renamed)
    -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
    tcMethods Id
    dfun_id Class
    clas [Id]
    inst_tyvars [Id]
    dfun_ev_vars
                                         [PredType]
    inst_tys TcEvBinds
    dfun_ev_binds ([Located TcSpecPrag], TcPragEnv)
    spec_inst_info
                                         [ClassOpItem]
    op_items InstBindings (GhcPass 'Renamed)
    ibinds

                       ; ([Id], LHsBinds GhcTc, Bag Implication)
    -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( [Id]
    sc_ids     [Id] -> [Id] -> [Id]
    forall a. [a] -> [a] -> [a]
    ++          [Id]
    meth_ids
                                , LHsBinds GhcTc
    sc_binds   LHsBinds GhcTc -> LHsBinds GhcTc -> LHsBinds GhcTc
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` LHsBinds GhcTc
    meth_binds
                                , Bag Implication
    sc_implics Bag Implication -> Bag Implication -> Bag Implication
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag Implication
    meth_implics ) }

           ; Implication
    imp <- TcM Implication
    newImplication
           ; Implication -> TcRn ()
    emitImplication (Implication -> TcRn ()) -> Implication -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
             Implication
    imp { ic_tclvl :: TcLevel
    ic_tclvl  = TcLevel
    tclvl
                 , ic_skols :: [Id]
    ic_skols  = [Id]
    inst_tyvars
                 , ic_given :: [Id]
    ic_given  = [Id]
    dfun_ev_vars
                 , ic_wanted :: WantedConstraints
    ic_wanted = Bag Implication -> WantedConstraints
    mkImplicWC Bag Implication
    sc_meth_implics
                 , ic_binds :: EvBindsVar
    ic_binds  = EvBindsVar
    dfun_ev_binds_var
                 , ic_info :: SkolemInfo
    ic_info   = SkolemInfo
    InstSkol }

           -- Create the result bindings
           ; Id
    self_dict <- Class -> [PredType] -> TcM Id
    newDict Class
    clas [PredType]
    inst_tys
           ; let class_tc :: TyCon
    class_tc      = Class -> TyCon
    classTyCon Class
    clas
                 [DataCon
    dict_constr] = TyCon -> [DataCon]
    tyConDataCons TyCon
    class_tc
                 dict_bind :: LHsBind GhcTc
    dict_bind     = IdP GhcTc -> LHsExpr GhcTc -> LHsBind GhcTc
    forall (p :: Pass).
    IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)
    mkVarBind Id
    IdP GhcTc
    self_dict (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc HsExpr GhcTc
    con_app_args)

                         -- We don't produce a binding for the dict_constr; instead we
                         -- rely on the simplifier to unfold this saturated application
                         -- We do this rather than generate an HsCon directly, because
                         -- it means that the special cases (e.g. dictionary with only one
                         -- member) are dealt with by the common MkId.mkDataConWrapId
                         -- code rather than needing to be repeated here.
                         --    con_app_tys  = MkD ty1 ty2
                         --    con_app_scs  = MkD ty1 ty2 sc1 sc2
                         --    con_app_args = MkD ty1 ty2 sc1 sc2 op1 op2
                 con_app_tys :: HsExpr GhcTc
    con_app_tys  = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap ([PredType] -> HsWrapper
    mkWpTyApps [PredType]
    inst_tys)
                                      (XConLikeOut GhcTc -> ConLike -> HsExpr GhcTc
    forall p. XConLikeOut p -> ConLike -> HsExpr p
    HsConLikeOut NoExtField
    XConLikeOut GhcTc
    noExtField (DataCon -> ConLike
    RealDataCon DataCon
    dict_constr))
                           -- NB: We *can* have covars in inst_tys, in the case of
                           -- promoted GADT constructors.

                 con_app_args :: HsExpr GhcTc
    con_app_args = (HsExpr GhcTc -> Id -> HsExpr GhcTc)
    -> HsExpr GhcTc -> [Id] -> HsExpr GhcTc
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' HsExpr GhcTc -> Id -> HsExpr GhcTc
    app_to_meth HsExpr GhcTc
    con_app_tys [Id]
    sc_meth_ids

                 app_to_meth :: HsExpr GhcTc -> Id -> HsExpr GhcTc
                 app_to_meth :: HsExpr GhcTc -> Id -> HsExpr GhcTc
    app_to_meth HsExpr GhcTc
    fun Id
    meth_id = XApp GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
    HsApp NoExtField
    XApp GhcTc
    noExtField (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc HsExpr GhcTc
    fun)
                                                (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (HsWrapper -> Id -> HsExpr GhcTc
    wrapId HsWrapper
    arg_wrapper Id
    meth_id))

                 inst_tv_tys :: [PredType]
    inst_tv_tys = [Id] -> [PredType]
    mkTyVarTys [Id]
    inst_tyvars
                 arg_wrapper :: HsWrapper
    arg_wrapper = [Id] -> HsWrapper
    mkWpEvVarApps [Id]
    dfun_ev_vars HsWrapper -> HsWrapper -> HsWrapper
    <.> [PredType] -> HsWrapper
    mkWpTyApps [PredType]
    inst_tv_tys

                 is_newtype :: Bool
    is_newtype = TyCon -> Bool
    isNewTyCon TyCon
    class_tc
                 dfun_id_w_prags :: Id
    dfun_id_w_prags = Id -> [Id] -> Id
    addDFunPrags Id
    dfun_id [Id]
    sc_meth_ids
                 dfun_spec_prags :: TcSpecPrags
    dfun_spec_prags
                    | Bool
    is_newtype = [Located TcSpecPrag] -> TcSpecPrags
    SpecPrags []
                    | Bool
    otherwise  = [Located TcSpecPrag] -> TcSpecPrags
    SpecPrags [Located TcSpecPrag]
    spec_inst_prags
                        -- Newtype dfuns just inline unconditionally,
                        -- so don't attempt to specialise them

                 export :: ABExport GhcTc
    export = ABE :: forall p.
    XABE p -> IdP p -> IdP p -> HsWrapper -> TcSpecPrags -> ABExport p
    ABE { abe_ext :: XABE GhcTc
    abe_ext  = NoExtField
    XABE GhcTc
    noExtField
                              , abe_wrap :: HsWrapper
    abe_wrap = HsWrapper
    idHsWrapper
                              , abe_poly :: IdP GhcTc
    abe_poly = Id
    IdP GhcTc
    dfun_id_w_prags
                              , abe_mono :: IdP GhcTc
    abe_mono = Id
    IdP GhcTc
    self_dict
                              , abe_prags :: TcSpecPrags
    abe_prags = TcSpecPrags
    dfun_spec_prags }
                              -- NB: see Note [SPECIALISE instance pragmas]
                 main_bind :: HsBindLR GhcTc GhcTc
    main_bind = AbsBinds :: forall idL idR.
    XAbsBinds idL idR
    -> [Id]
    -> [Id]
    -> [ABExport idL]
    -> [TcEvBinds]
    -> LHsBinds idL
    -> Bool
    -> HsBindLR idL idR
    AbsBinds { abs_ext :: XAbsBinds GhcTc GhcTc
    abs_ext = NoExtField
    XAbsBinds GhcTc GhcTc
    noExtField
                                      , abs_tvs :: [Id]
    abs_tvs = [Id]
    inst_tyvars
                                      , abs_ev_vars :: [Id]
    abs_ev_vars = [Id]
    dfun_ev_vars
                                      , abs_exports :: [ABExport GhcTc]
    abs_exports = [ABExport GhcTc
    export]
                                      , abs_ev_binds :: [TcEvBinds]
    abs_ev_binds = []
                                      , abs_binds :: LHsBinds GhcTc
    abs_binds = LHsBind GhcTc -> LHsBinds GhcTc
    forall a. a -> Bag a
    unitBag LHsBind GhcTc
    dict_bind
                                      , abs_sig :: Bool
    abs_sig = Bool
    True }

           ; LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBind GhcTc -> LHsBinds GhcTc
    forall a. a -> Bag a
    unitBag (SrcSpan -> HsBindLR GhcTc GhcTc -> LHsBind GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc HsBindLR GhcTc GhcTc
    main_bind) LHsBinds GhcTc -> LHsBinds GhcTc -> LHsBinds GhcTc
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` LHsBinds GhcTc
    sc_meth_binds)
           }
     where
       dfun_id :: Id
    dfun_id = ClsInst -> Id
    instanceDFunId ClsInst
    ispec
       loc :: SrcSpan
    loc     = Id -> SrcSpan
    forall a. NamedThing a => a -> SrcSpan
    getSrcSpan Id
    dfun_id

    addDFunPrags :: DFunId -> [Id] -> DFunId
    -- DFuns need a special Unfolding and InlinePrag
    --    See Note [ClassOp/DFun selection]
    --    and Note [Single-method classes]
    -- It's easiest to create those unfoldings right here, where
    -- have all the pieces in hand, even though we are messing with
    -- Core at this point, which the typechecker doesn't usually do
    -- However we take care to build the unfolding using the TyVars from
    -- the DFunId rather than from the skolem pieces that the typechecker
    -- is messing with.
    addDFunPrags :: Id -> [Id] -> Id
    addDFunPrags Id
    dfun_id [Id]
    sc_meth_ids
     | Bool
    is_newtype
      = Id
    dfun_id Id -> Unfolding -> Id
    `setIdUnfolding`  ConTag -> CoreExpr -> Unfolding
    mkInlineUnfoldingWithArity ConTag
    0 CoreExpr
    con_app
                Id -> InlinePragma -> Id
    `setInlinePragma` InlinePragma
    alwaysInlinePragma { inl_sat :: Maybe ConTag
    inl_sat = ConTag -> Maybe ConTag
    forall a. a -> Maybe a
    Just ConTag
    0 }
     | Bool
    otherwise
     = Id
    dfun_id Id -> Unfolding -> Id
    `setIdUnfolding`  [Id] -> DataCon -> [CoreExpr] -> Unfolding
    mkDFunUnfolding [Id]
    dfun_bndrs DataCon
    dict_con [CoreExpr]
    dict_args
               Id -> InlinePragma -> Id
    `setInlinePragma` InlinePragma
    dfunInlinePragma
     where
       con_app :: CoreExpr
    con_app    = [Id] -> CoreExpr -> CoreExpr
    forall b. [b] -> Expr b -> Expr b
    mkLams [Id]
    dfun_bndrs (CoreExpr -> CoreExpr) -> CoreExpr -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $
                    CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (Id -> CoreExpr
    forall b. Id -> Expr b
    Var (DataCon -> Id
    dataConWrapId DataCon
    dict_con)) [CoreExpr]
    dict_args
                     -- mkApps is OK because of the checkForLevPoly call in checkValidClass
                     -- See Note [Levity polymorphism checking] in GHC.HsToCore.Monad
       dict_args :: [CoreExpr]
    dict_args  = (PredType -> CoreExpr) -> [PredType] -> [CoreExpr]
    forall a b. (a -> b) -> [a] -> [b]
    map PredType -> CoreExpr
    forall b. PredType -> Expr b
    Type [PredType]
    inst_tys [CoreExpr] -> [CoreExpr] -> [CoreExpr]
    forall a. [a] -> [a] -> [a]
    ++
                    [CoreExpr -> [Id] -> CoreExpr
    forall b. Expr b -> [Id] -> Expr b
    mkVarApps (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    id) [Id]
    dfun_bndrs | Id
    id <- [Id]
    sc_meth_ids]

       ([Id]
    dfun_tvs, [PredType]
    dfun_theta, Class
    clas, [PredType]
    inst_tys) = PredType -> ([Id], [PredType], Class, [PredType])
    tcSplitDFunTy (Id -> PredType
    idType Id
    dfun_id)
       ev_ids :: [Id]
    ev_ids      = ConTag -> [PredType] -> [Id]
    mkTemplateLocalsNum ConTag
    1                    [PredType]
    dfun_theta
       dfun_bndrs :: [Id]
    dfun_bndrs  = [Id]
    dfun_tvs [Id] -> [Id] -> [Id]
    forall a. [a] -> [a] -> [a]
    ++ [Id]
    ev_ids
       clas_tc :: TyCon
    clas_tc     = Class -> TyCon
    classTyCon Class
    clas
       [DataCon
    dict_con]  = TyCon -> [DataCon]
    tyConDataCons TyCon
    clas_tc
       is_newtype :: Bool
    is_newtype  = TyCon -> Bool
    isNewTyCon TyCon
    clas_tc

    wrapId :: HsWrapper -> Id -> HsExpr GhcTc
    wrapId :: HsWrapper -> Id -> HsExpr GhcTc
    wrapId HsWrapper
    wrapper Id
    id = HsWrapper -> HsExpr GhcTc -> HsExpr GhcTc
    mkHsWrap HsWrapper
    wrapper (XVar GhcTc -> Located (IdP GhcTc) -> HsExpr GhcTc
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar GhcTc
    noExtField (Id -> Located Id
    forall e. e -> Located e
    noLoc Id
    id))

    {- Note [Typechecking plan for instance declarations]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For instance declarations we generate the following bindings and implication
    constraints.  Example:

       instance Ord a => Ord [a] where compare = <compare-rhs>

    generates this:

       Bindings:
          -- Method bindings
          $ccompare :: forall a. Ord a => a -> a -> Ordering
          $ccompare = /\a \(d:Ord a). let <meth-ev-binds> in ...

          -- Superclass bindings
          $cp1Ord :: forall a. Ord a => Eq [a]
          $cp1Ord = /\a \(d:Ord a). let <sc-ev-binds>
                   in dfEqList (dw :: Eq a)

       Constraints:
          forall a. Ord a =>
                    -- Method constraint
                 (forall. (empty) => <constraints from compare-rhs>)
                    -- Superclass constraint
              /\ (forall. (empty) => dw :: Eq a)

    Notice that

     * Per-meth/sc implication.  There is one inner implication per
       superclass or method, with no skolem variables or givens.  The only
       reason for this one is to gather the evidence bindings privately
       for this superclass or method.  This implication is generated
       by checkInstConstraints.

     * Overall instance implication. There is an overall enclosing
       implication for the whole instance declaration, with the expected
       skolems and givens.  We need this to get the correct "redundant
       constraint" warnings, gathering all the uses from all the methods
       and superclasses.  See GHC.Tc.Solver Note [Tracking redundant
       constraints]

     * The given constraints in the outer implication may generate
       evidence, notably by superclass selection.  Since the method and
       superclass bindings are top-level, we want that evidence copied
       into *every* method or superclass definition.  (Some of it will
       be usused in some, but dead-code elimination will drop it.)

       We achieve this by putting the evidence variable for the overall
       instance implication into the AbsBinds for each method/superclass.
       Hence the 'dfun_ev_binds' passed into tcMethods and tcSuperClasses.
       (And that in turn is why the abs_ev_binds field of AbBinds is a
       [TcEvBinds] rather than simply TcEvBinds.

       This is a bit of a hack, but works very nicely in practice.

     * Note that if a method has a locally-polymorphic binding, there will
       be yet another implication for that, generated by tcPolyCheck
       in tcMethodBody. E.g.
              class C a where
                foo :: forall b. Ord b => blah

    ************************************************************************
    *                                                                      *
          Type-checking superclasses
    *                                                                      *
    ************************************************************************
    -}

    tcSuperClasses :: DFunId -> Class -> [TcTyVar] -> [EvVar] -> [TcType]
                   -> TcEvBinds
                   -> TcThetaType
                   -> TcM ([EvVar], LHsBinds GhcTc, Bag Implication)
    -- Make a new top-level function binding for each superclass,
    -- something like
    --    $Ordp1 :: forall a. Ord a => Eq [a]
    --    $Ordp1 = /\a \(d:Ord a). dfunEqList a (sc_sel d)
    --
    -- See Note [Recursive superclasses] for why this is so hard!
    -- In effect, we build a special-purpose solver for the first step
    -- of solving each superclass constraint
    tcSuperClasses :: Id
    -> Class
    -> [Id]
    -> [Id]
    -> [PredType]
    -> TcEvBinds
    -> [PredType]
    -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
    tcSuperClasses Id
    dfun_id Class
    cls [Id]
    tyvars [Id]
    dfun_evs [PredType]
    inst_tys TcEvBinds
    dfun_ev_binds [PredType]
    sc_theta
      = do { ([Id]
    ids, [LHsBind GhcTc]
    binds, [Implication]
    implics) <- ((PredType, ConTag)
     -> IOEnv (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Implication))
    -> [(PredType, ConTag)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) ([Id], [LHsBind GhcTc], [Implication])
    forall (m :: * -> *) a b c d.
    Monad m =>
    (a -> m (b, c, d)) -> [a] -> m ([b], [c], [d])
    mapAndUnzip3M (PredType, ConTag)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Implication)
    tc_super ([PredType] -> [ConTag] -> [(PredType, ConTag)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [PredType]
    sc_theta [ConTag
    fIRST_TAG..])
           ; ([Id], LHsBinds GhcTc, Bag Implication)
    -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id]
    ids, [LHsBind GhcTc] -> LHsBinds GhcTc
    forall a. [a] -> Bag a
    listToBag [LHsBind GhcTc]
    binds, [Implication] -> Bag Implication
    forall a. [a] -> Bag a
    listToBag [Implication]
    implics) }
      where
        loc :: SrcSpan
    loc = Id -> SrcSpan
    forall a. NamedThing a => a -> SrcSpan
    getSrcSpan Id
    dfun_id
        size :: TypeSize
    size = [PredType] -> TypeSize
    sizeTypes [PredType]
    inst_tys
        tc_super :: (PredType, ConTag)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Implication)
    tc_super (PredType
    sc_pred, ConTag
    n)
          = do { (Implication
    sc_implic, EvBindsVar
    ev_binds_var, EvTerm
    sc_ev_tm)
                    <- TcM EvTerm -> TcM (Implication, EvBindsVar, EvTerm)
    forall result. TcM result -> TcM (Implication, EvBindsVar, result)
    checkInstConstraints (TcM EvTerm -> TcM (Implication, EvBindsVar, EvTerm))
    -> TcM EvTerm -> TcM (Implication, EvBindsVar, EvTerm)
    forall a b. (a -> b) -> a -> b
    $ CtOrigin -> PredType -> TcM EvTerm
    emitWanted (TypeSize -> CtOrigin
    ScOrigin TypeSize
    size) PredType
    sc_pred

               ; Name
    sc_top_name  <- OccName -> TcM Name
    newName (ConTag -> OccName -> OccName
    mkSuperDictAuxOcc ConTag
    n (Class -> OccName
    forall a. NamedThing a => a -> OccName
    getOccName Class
    cls))
               ; Id
    sc_ev_id     <- PredType -> TcM Id
    forall gbl lcl. PredType -> TcRnIf gbl lcl Id
    newEvVar PredType
    sc_pred
               ; EvBindsVar -> EvBind -> TcRn ()
    addTcEvBind EvBindsVar
    ev_binds_var (EvBind -> TcRn ()) -> EvBind -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ Id -> EvTerm -> EvBind
    mkWantedEvBind Id
    sc_ev_id EvTerm
    sc_ev_tm
               ; let sc_top_ty :: PredType
    sc_top_ty = [Id] -> PredType -> PredType
    mkInfForAllTys [Id]
    tyvars (PredType -> PredType) -> PredType -> PredType
    forall a b. (a -> b) -> a -> b
    $
                                 [PredType] -> PredType -> PredType
    mkPhiTy ((Id -> PredType) -> [Id] -> [PredType]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> PredType
    idType [Id]
    dfun_evs) PredType
    sc_pred
                     sc_top_id :: Id
    sc_top_id = HasDebugCallStack => Name -> PredType -> PredType -> Id
    Name -> PredType -> PredType -> Id
    mkLocalId Name
    sc_top_name PredType
    Many PredType
    sc_top_ty
                     export :: ABExport GhcTc
    export = ABE :: forall p.
    XABE p -> IdP p -> IdP p -> HsWrapper -> TcSpecPrags -> ABExport p
    ABE { abe_ext :: XABE GhcTc
    abe_ext  = NoExtField
    XABE GhcTc
    noExtField
                                  , abe_wrap :: HsWrapper
    abe_wrap = HsWrapper
    idHsWrapper
                                  , abe_poly :: IdP GhcTc
    abe_poly = Id
    IdP GhcTc
    sc_top_id
                                  , abe_mono :: IdP GhcTc
    abe_mono = Id
    IdP GhcTc
    sc_ev_id
                                  , abe_prags :: TcSpecPrags
    abe_prags = TcSpecPrags
    noSpecPrags }
                     local_ev_binds :: TcEvBinds
    local_ev_binds = EvBindsVar -> TcEvBinds
    TcEvBinds EvBindsVar
    ev_binds_var
                     bind :: HsBindLR GhcTc GhcTc
    bind = AbsBinds :: forall idL idR.
    XAbsBinds idL idR
    -> [Id]
    -> [Id]
    -> [ABExport idL]
    -> [TcEvBinds]
    -> LHsBinds idL
    -> Bool
    -> HsBindLR idL idR
    AbsBinds { abs_ext :: XAbsBinds GhcTc GhcTc
    abs_ext      = NoExtField
    XAbsBinds GhcTc GhcTc
    noExtField
                                     , abs_tvs :: [Id]
    abs_tvs      = [Id]
    tyvars
                                     , abs_ev_vars :: [Id]
    abs_ev_vars  = [Id]
    dfun_evs
                                     , abs_exports :: [ABExport GhcTc]
    abs_exports  = [ABExport GhcTc
    export]
                                     , abs_ev_binds :: [TcEvBinds]
    abs_ev_binds = [TcEvBinds
    dfun_ev_binds, TcEvBinds
    local_ev_binds]
                                     , abs_binds :: LHsBinds GhcTc
    abs_binds    = LHsBinds GhcTc
    forall a. Bag a
    emptyBag
                                     , abs_sig :: Bool
    abs_sig      = Bool
    False }
               ; (Id, LHsBind GhcTc, Implication)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Implication)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id
    sc_top_id, SrcSpan -> HsBindLR GhcTc GhcTc -> LHsBind GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc HsBindLR GhcTc GhcTc
    bind, Implication
    sc_implic) }

    -------------------
    checkInstConstraints :: TcM result
                         -> TcM (Implication, EvBindsVar, result)
    -- See Note [Typechecking plan for instance declarations]
    checkInstConstraints :: forall result. TcM result -> TcM (Implication, EvBindsVar, result)
    checkInstConstraints TcM result
    thing_inside
      = do { (TcLevel
    tclvl, WantedConstraints
    wanted, result
    result) <- TcM result -> TcM (TcLevel, WantedConstraints, result)
    forall a. TcM a -> TcM (TcLevel, WantedConstraints, a)
    pushLevelAndCaptureConstraints  (TcM result -> TcM (TcLevel, WantedConstraints, result))
    -> TcM result -> TcM (TcLevel, WantedConstraints, result)
    forall a b. (a -> b) -> a -> b
    $
                                        TcM result
    thing_inside

           ; EvBindsVar
    ev_binds_var <- TcM EvBindsVar
    newTcEvBinds
           ; Implication
    implic <- TcM Implication
    newImplication
           ; let implic' :: Implication
    implic' = Implication
    implic { ic_tclvl :: TcLevel
    ic_tclvl  = TcLevel
    tclvl
                                  , ic_wanted :: WantedConstraints
    ic_wanted = WantedConstraints
    wanted
                                  , ic_binds :: EvBindsVar
    ic_binds  = EvBindsVar
    ev_binds_var
                                  , ic_info :: SkolemInfo
    ic_info   = SkolemInfo
    InstSkol }

           ; (Implication, EvBindsVar, result)
    -> TcM (Implication, EvBindsVar, result)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Implication
    implic', EvBindsVar
    ev_binds_var, result
    result) }

    {-
    Note [Recursive superclasses]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    See #3731, #4809, #5751, #5913, #6117, #6161, which all
    describe somewhat more complicated situations, but ones
    encountered in practice.

    See also tests tcrun020, tcrun021, tcrun033, and #11427.

    ----- THE PROBLEM --------
    The problem is that it is all too easy to create a class whose
    superclass is bottom when it should not be.

    Consider the following (extreme) situation:
            class C a => D a where ...
            instance D [a] => D [a] where ...   (dfunD)
            instance C [a] => C [a] where ...   (dfunC)
    Although this looks wrong (assume D [a] to prove D [a]), it is only a
    more extreme case of what happens with recursive dictionaries, and it
    can, just about, make sense because the methods do some work before
    recursing.

    To implement the dfunD we must generate code for the superclass C [a],
    which we had better not get by superclass selection from the supplied
    argument:
           dfunD :: forall a. D [a] -> D [a]
           dfunD = \d::D [a] -> MkD (scsel d) ..

    Otherwise if we later encounter a situation where
    we have a [Wanted] dw::D [a] we might solve it thus:
         dw := dfunD dw
    Which is all fine except that now ** the superclass C is bottom **!

    The instance we want is:
           dfunD :: forall a. D [a] -> D [a]
           dfunD = \d::D [a] -> MkD (dfunC (scsel d)) ...

    ----- THE SOLUTION --------
    The basic solution is simple: be very careful about using superclass
    selection to generate a superclass witness in a dictionary function
    definition.  More precisely:

      Superclass Invariant: in every class dictionary,
                            every superclass dictionary field
                            is non-bottom

    To achieve the Superclass Invariant, in a dfun definition we can
    generate a guaranteed-non-bottom superclass witness from:
      (sc1) one of the dictionary arguments itself (all non-bottom)
      (sc2) an immediate superclass of a smaller dictionary
      (sc3) a call of a dfun (always returns a dictionary constructor)

    The tricky case is (sc2).  We proceed by induction on the size of
    the (type of) the dictionary, defined by GHC.Tc.Validity.sizeTypes.
    Let's suppose we are building a dictionary of size 3, and
    suppose the Superclass Invariant holds of smaller dictionaries.
    Then if we have a smaller dictionary, its immediate superclasses
    will be non-bottom by induction.

    What does "we have a smaller dictionary" mean?  It might be
    one of the arguments of the instance, or one of its superclasses.
    Here is an example, taken from CmmExpr:
           class Ord r => UserOfRegs r a where ...
    (i1)   instance UserOfRegs r a => UserOfRegs r (Maybe a) where
    (i2)   instance (Ord r, UserOfRegs r CmmReg) => UserOfRegs r CmmExpr where

    For (i1) we can get the (Ord r) superclass by selection from (UserOfRegs r a),
    since it is smaller than the thing we are building (UserOfRegs r (Maybe a).

    But for (i2) that isn't the case, so we must add an explicit, and
    perhaps surprising, (Ord r) argument to the instance declaration.

    Here's another example from #6161:

           class       Super a => Duper a  where ...
           class Duper (Fam a) => Foo a    where ...
    (i3)   instance Foo a => Duper (Fam a) where ...
    (i4)   instance              Foo Float where ...

    It would be horribly wrong to define
       dfDuperFam :: Foo a -> Duper (Fam a)  -- from (i3)
       dfDuperFam d = MkDuper (sc_sel1 (sc_sel2 d)) ...

       dfFooFloat :: Foo Float               -- from (i4)
       dfFooFloat = MkFoo (dfDuperFam dfFooFloat) ...

    Now the Super superclass of Duper is definitely bottom!

    This won't happen because when processing (i3) we can use the
    superclasses of (Foo a), which is smaller, namely Duper (Fam a).  But
    that is *not* smaller than the target so we can't take *its*
    superclasses.  As a result the program is rightly rejected, unless you
    add (Super (Fam a)) to the context of (i3).

    Note [Solving superclass constraints]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    How do we ensure that every superclass witness is generated by
    one of (sc1) (sc2) or (sc3) in Note [Recursive superclasses].
    Answer:

      * Superclass "wanted" constraints have CtOrigin of (ScOrigin size)
        where 'size' is the size of the instance declaration. e.g.
              class C a => D a where...
              instance blah => D [a] where ...
        The wanted superclass constraint for C [a] has origin
        ScOrigin size, where size = size( D [a] ).

      * (sc1) When we rewrite such a wanted constraint, it retains its
        origin.  But if we apply an instance declaration, we can set the
        origin to (ScOrigin infinity), thus lifting any restrictions by
        making prohibitedSuperClassSolve return False.

      * (sc2) ScOrigin wanted constraints can't be solved from a
        superclass selection, except at a smaller type.  This test is
        implemented by GHC.Tc.Solver.Interact.prohibitedSuperClassSolve

      * The "given" constraints of an instance decl have CtOrigin
        GivenOrigin InstSkol.

      * When we make a superclass selection from InstSkol we use
        a SkolemInfo of (InstSC size), where 'size' is the size of
        the constraint whose superclass we are taking.  A similarly
        when taking the superclass of an InstSC.  This is implemented
        in GHC.Tc.Solver.Canonical.newSCWorkFromFlavored

    Note [Silent superclass arguments] (historical interest only)
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    NB1: this note describes our *old* solution to the
         recursive-superclass problem. I'm keeping the Note
         for now, just as institutional memory.
         However, the code for silent superclass arguments
         was removed in late Dec 2014

    NB2: the silent-superclass solution introduced new problems
         of its own, in the form of instance overlap.  Tests
         SilentParametersOverlapping, T5051, and T7862 are examples

    NB3: the silent-superclass solution also generated tons of
         extra dictionaries.  For example, in monad-transformer
         code, when constructing a Monad dictionary you had to pass
         an Applicative dictionary; and to construct that you need
         a Functor dictionary. Yet these extra dictionaries were
         often never used.  Test T3064 compiled *far* faster after
         silent superclasses were eliminated.

    Our solution to this problem "silent superclass arguments".  We pass
    to each dfun some ``silent superclass arguments’’, which are the
    immediate superclasses of the dictionary we are trying to
    construct. In our example:
           dfun :: forall a. C [a] -> D [a] -> D [a]
           dfun = \(dc::C [a]) (dd::D [a]) -> DOrd dc ...
    Notice the extra (dc :: C [a]) argument compared to the previous version.

    This gives us:

         -----------------------------------------------------------
         DFun Superclass Invariant
         ~~~~~~~~~~~~~~~~~~~~~~~~
         In the body of a DFun, every superclass argument to the
         returned dictionary is
           either   * one of the arguments of the DFun,
           or       * constant, bound at top level
         -----------------------------------------------------------

    This net effect is that it is safe to treat a dfun application as
    wrapping a dictionary constructor around its arguments (in particular,
    a dfun never picks superclasses from the arguments under the
    dictionary constructor). No superclass is hidden inside a dfun
    application.

    The extra arguments required to satisfy the DFun Superclass Invariant
    always come first, and are called the "silent" arguments.  You can
    find out how many silent arguments there are using Id.dfunNSilent;
    and then you can just drop that number of arguments to see the ones
    that were in the original instance declaration.

    DFun types are built (only) by MkId.mkDictFunId, so that is where we
    decide what silent arguments are to be added.
    -}

    {-
    ************************************************************************
    *                                                                      *
          Type-checking an instance method
    *                                                                      *
    ************************************************************************

    tcMethod
    - Make the method bindings, as a [(NonRec, HsBinds)], one per method
    - Remembering to use fresh Name (the instance method Name) as the binder
    - Bring the instance method Ids into scope, for the benefit of tcInstSig
    - Use sig_fn mapping instance method Name -> instance tyvars
    - Ditto prag_fn
    - Use tcValBinds to do the checking
    -}

    tcMethods :: DFunId -> Class
              -> [TcTyVar] -> [EvVar]
              -> [TcType]
              -> TcEvBinds
              -> ([Located TcSpecPrag], TcPragEnv)
              -> [ClassOpItem]
              -> InstBindings GhcRn
              -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
            -- The returned inst_meth_ids all have types starting
            --      forall tvs. theta => ...
    tcMethods :: Id
    -> Class
    -> [Id]
    -> [Id]
    -> [PredType]
    -> TcEvBinds
    -> ([Located TcSpecPrag], TcPragEnv)
    -> [ClassOpItem]
    -> InstBindings (GhcPass 'Renamed)
    -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
    tcMethods Id
    dfun_id Class
    clas [Id]
    tyvars [Id]
    dfun_ev_vars [PredType]
    inst_tys
                      TcEvBinds
    dfun_ev_binds ([Located TcSpecPrag]
    spec_inst_prags, TcPragEnv
    prag_fn) [ClassOpItem]
    op_items
                      (InstBindings { ib_binds :: forall a. InstBindings a -> LHsBinds a
    ib_binds      = LHsBinds (GhcPass 'Renamed)
    binds
                                    , ib_tyvars :: forall a. InstBindings a -> [Name]
    ib_tyvars     = [Name]
    lexical_tvs
                                    , ib_pragmas :: forall a. InstBindings a -> [LSig a]
    ib_pragmas    = [LSig (GhcPass 'Renamed)]
    sigs
                                    , ib_extensions :: forall a. InstBindings a -> [Extension]
    ib_extensions = [Extension]
    exts
                                    , ib_derived :: forall a. InstBindings a -> Bool
    ib_derived    = Bool
    is_derived })
      = [(Name, Id)]
    -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
    -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
    forall r. [(Name, Id)] -> TcM r -> TcM r
    tcExtendNameTyVarEnv ([Name]
    lexical_tvs [Name] -> [Id] -> [(Name, Id)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [Id]
    tyvars) (TcM ([Id], LHsBinds GhcTc, Bag Implication)
     -> TcM ([Id], LHsBinds GhcTc, Bag Implication))
    -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
    -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
    forall a b. (a -> b) -> a -> b
    $
           -- The lexical_tvs scope over the 'where' part
        do { String -> SDoc -> TcRn ()
    traceTc String
    "tcInstMeth" ([LSig (GhcPass 'Renamed)] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [LSig (GhcPass 'Renamed)]
    sigs SDoc -> SDoc -> SDoc
    $$ LHsBinds (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsBinds (GhcPass 'Renamed)
    binds)
           ; TcRn ()
    checkMinimalDefinition
           ; TcRn ()
    checkMethBindMembership
           ; ([Id]
    ids, [LHsBind GhcTc]
    binds, [Maybe Implication]
    mb_implics) <- [Extension]
    -> TcM ([Id], [LHsBind GhcTc], [Maybe Implication])
    -> TcM ([Id], [LHsBind GhcTc], [Maybe Implication])
    forall a. [Extension] -> TcM a -> TcM a
    set_exts [Extension]
    exts (TcM ([Id], [LHsBind GhcTc], [Maybe Implication])
     -> TcM ([Id], [LHsBind GhcTc], [Maybe Implication]))
    -> TcM ([Id], [LHsBind GhcTc], [Maybe Implication])
    -> TcM ([Id], [LHsBind GhcTc], [Maybe Implication])
    forall a b. (a -> b) -> a -> b
    $
                                         TcM ([Id], [LHsBind GhcTc], [Maybe Implication])
    -> TcM ([Id], [LHsBind GhcTc], [Maybe Implication])
    forall a. TcM a -> TcM a
    unset_warnings_deriving (TcM ([Id], [LHsBind GhcTc], [Maybe Implication])
     -> TcM ([Id], [LHsBind GhcTc], [Maybe Implication]))
    -> TcM ([Id], [LHsBind GhcTc], [Maybe Implication])
    -> TcM ([Id], [LHsBind GhcTc], [Maybe Implication])
    forall a b. (a -> b) -> a -> b
    $
                                         (ClassOpItem
     -> IOEnv
          (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication))
    -> [ClassOpItem]
    -> TcM ([Id], [LHsBind GhcTc], [Maybe Implication])
    forall (m :: * -> *) a b c d.
    Monad m =>
    (a -> m (b, c, d)) -> [a] -> m ([b], [c], [d])
    mapAndUnzip3M ClassOpItem
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    tc_item [ClassOpItem]
    op_items
           ; ([Id], LHsBinds GhcTc, Bag Implication)
    -> TcM ([Id], LHsBinds GhcTc, Bag Implication)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id]
    ids, [LHsBind GhcTc] -> LHsBinds GhcTc
    forall a. [a] -> Bag a
    listToBag [LHsBind GhcTc]
    binds, [Implication] -> Bag Implication
    forall a. [a] -> Bag a
    listToBag ([Maybe Implication] -> [Implication]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe Implication]
    mb_implics)) }
      where
        set_exts :: [LangExt.Extension] -> TcM a -> TcM a
        set_exts :: forall a. [Extension] -> TcM a -> TcM a
    set_exts [Extension]
    es TcM a
    thing = (Extension -> TcM a -> TcM a) -> TcM a -> [Extension] -> TcM a
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr Extension -> TcM a -> TcM a
    forall gbl lcl a. Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setXOptM TcM a
    thing [Extension]
    es

        -- See Note [Avoid -Winaccessible-code when deriving]
        unset_warnings_deriving :: TcM a -> TcM a
        unset_warnings_deriving :: forall a. TcM a -> TcM a
    unset_warnings_deriving
          | Bool
    is_derived = WarningFlag
    -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall gbl lcl a.
    WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetWOptM WarningFlag
    Opt_WarnInaccessibleCode
          | Bool
    otherwise  = TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall a. a -> a
    id

        hs_sig_fn :: HsSigFun
    hs_sig_fn = [LSig (GhcPass 'Renamed)] -> HsSigFun
    mkHsSigFun [LSig (GhcPass 'Renamed)]
    sigs
        inst_loc :: SrcSpan
    inst_loc  = Id -> SrcSpan
    forall a. NamedThing a => a -> SrcSpan
    getSrcSpan Id
    dfun_id

        ----------------------
        tc_item :: ClassOpItem -> TcM (Id, LHsBind GhcTc, Maybe Implication)
        tc_item :: ClassOpItem
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    tc_item (Id
    sel_id, DefMethInfo
    dm_info)
          | Just (GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    user_bind, SrcSpan
    bndr_loc, [LSig (GhcPass 'Renamed)]
    prags) <- Name
    -> LHsBinds (GhcPass 'Renamed)
    -> TcPragEnv
    -> Maybe
         (GenLocated
            SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
          SrcSpan, [LSig (GhcPass 'Renamed)])
    findMethodBind (Id -> Name
    idName Id
    sel_id) LHsBinds (GhcPass 'Renamed)
    binds TcPragEnv
    prag_fn
          = Class
    -> [Id]
    -> [Id]
    -> [PredType]
    -> TcEvBinds
    -> Bool
    -> HsSigFun
    -> [Located TcSpecPrag]
    -> [LSig (GhcPass 'Renamed)]
    -> Id
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> SrcSpan
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    tcMethodBody Class
    clas [Id]
    tyvars [Id]
    dfun_ev_vars [PredType]
    inst_tys
                                  TcEvBinds
    dfun_ev_binds Bool
    is_derived HsSigFun
    hs_sig_fn
                                  [Located TcSpecPrag]
    spec_inst_prags [LSig (GhcPass 'Renamed)]
    prags
                                  Id
    sel_id GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    user_bind SrcSpan
    bndr_loc
          | Bool
    otherwise
          = do { String -> SDoc -> TcRn ()
    traceTc String
    "tc_def" (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    sel_id)
               ; Id
    -> DefMethInfo
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    tc_default Id
    sel_id DefMethInfo
    dm_info }

        ----------------------
        tc_default :: Id -> DefMethInfo
                   -> TcM (TcId, LHsBind GhcTc, Maybe Implication)

        tc_default :: Id
    -> DefMethInfo
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    tc_default Id
    sel_id (Just (Name
    dm_name, DefMethSpec PredType
    _))
          = do { (GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    meth_bind, [LSig (GhcPass 'Renamed)]
    inline_prags) <- Id
    -> Class
    -> Id
    -> Name
    -> TcM
         (GenLocated
            SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
          [LSig (GhcPass 'Renamed)])
    mkDefMethBind Id
    dfun_id Class
    clas Id
    sel_id Name
    dm_name
               ; Class
    -> [Id]
    -> [Id]
    -> [PredType]
    -> TcEvBinds
    -> Bool
    -> HsSigFun
    -> [Located TcSpecPrag]
    -> [LSig (GhcPass 'Renamed)]
    -> Id
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> SrcSpan
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    tcMethodBody Class
    clas [Id]
    tyvars [Id]
    dfun_ev_vars [PredType]
    inst_tys
                              TcEvBinds
    dfun_ev_binds Bool
    is_derived HsSigFun
    hs_sig_fn
                              [Located TcSpecPrag]
    spec_inst_prags [LSig (GhcPass 'Renamed)]
    inline_prags
                              Id
    sel_id GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    meth_bind SrcSpan
    inst_loc }

        tc_default Id
    sel_id DefMethInfo
    Nothing     -- No default method at all
          = do { String -> SDoc -> TcRn ()
    traceTc String
    "tc_def: warn" (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    sel_id)
               ; (Id
    meth_id, Id
    _) <- Class -> [Id] -> [Id] -> [PredType] -> Id -> TcM (Id, Id)
    mkMethIds Class
    clas [Id]
    tyvars [Id]
    dfun_ev_vars
                                           [PredType]
    inst_tys Id
    sel_id
               ; DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
               ; let meth_bind :: LHsBind GhcTc
    meth_bind = IdP GhcTc -> LHsExpr GhcTc -> LHsBind GhcTc
    forall (p :: Pass).
    IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)
    mkVarBind Id
    IdP GhcTc
    meth_id (LHsExpr GhcTc -> LHsBind GhcTc) -> LHsExpr GhcTc -> LHsBind GhcTc
    forall a b. (a -> b) -> a -> b
    $
                                 HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap HsWrapper
    lam_wrapper (DynFlags -> LHsExpr GhcTc
    error_rhs DynFlags
    dflags)
               ; (Id, LHsBind GhcTc, Maybe Implication)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id
    meth_id, LHsBind GhcTc
    meth_bind, Maybe Implication
    forall a. Maybe a
    Nothing) }
          where
            error_rhs :: DynFlags -> LHsExpr GhcTc
    error_rhs DynFlags
    dflags = SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    inst_loc (HsExpr GhcTc -> LHsExpr GhcTc) -> HsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $ XApp GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
    HsApp NoExtField
    XApp GhcTc
    noExtField LHsExpr GhcTc
    error_fun (DynFlags -> LHsExpr GhcTc
    error_msg DynFlags
    dflags)
            error_fun :: LHsExpr GhcTc
    error_fun    = SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    inst_loc (HsExpr GhcTc -> LHsExpr GhcTc) -> HsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                           HsWrapper -> Id -> HsExpr GhcTc
    wrapId ([PredType] -> HsWrapper
    mkWpTyApps
                                    [ HasDebugCallStack => PredType -> PredType
    PredType -> PredType
    getRuntimeRep PredType
    meth_tau, PredType
    meth_tau])
                                  Id
    nO_METHOD_BINDING_ERROR_ID
            error_msg :: DynFlags -> LHsExpr GhcTc
    error_msg DynFlags
    dflags = SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    inst_loc (XLitE GhcTc -> HsLit GhcTc -> HsExpr GhcTc
    forall p. XLitE p -> HsLit p -> HsExpr p
    HsLit NoExtField
    XLitE GhcTc
    noExtField (XHsStringPrim GhcTc -> ByteString -> HsLit GhcTc
    forall x. XHsStringPrim x -> ByteString -> HsLit x
    HsStringPrim SourceText
    XHsStringPrim GhcTc
    NoSourceText
                                                  (String -> ByteString
    unsafeMkByteString (DynFlags -> String
    error_string DynFlags
    dflags))))
            meth_tau :: PredType
    meth_tau     = Id -> [PredType] -> PredType
    classMethodInstTy Id
    sel_id [PredType]
    inst_tys
            error_string :: DynFlags -> String
    error_string DynFlags
    dflags = DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags
                                  ([SDoc] -> SDoc
    hcat [SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    inst_loc, SDoc
    vbar, Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    sel_id ])
            lam_wrapper :: HsWrapper
    lam_wrapper  = [Id] -> HsWrapper
    mkWpTyLams [Id]
    tyvars HsWrapper -> HsWrapper -> HsWrapper
    <.> [Id] -> HsWrapper
    mkWpLams [Id]
    dfun_ev_vars

        ----------------------
        -- Check if one of the minimal complete definitions is satisfied
        checkMinimalDefinition :: TcRn ()
    checkMinimalDefinition
          = Maybe (BooleanFormula Name)
    -> (BooleanFormula Name -> TcRn ()) -> TcRn ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenIsJust ((Name -> Bool)
    -> BooleanFormula Name -> Maybe (BooleanFormula Name)
    forall a.
    Eq a =>
    (a -> Bool) -> BooleanFormula a -> Maybe (BooleanFormula a)
    isUnsatisfied Name -> Bool
    methodExists (Class -> BooleanFormula Name
    classMinimalDef Class
    clas)) ((BooleanFormula Name -> TcRn ()) -> TcRn ())
    -> (BooleanFormula Name -> TcRn ()) -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
            BooleanFormula Name -> TcRn ()
    warnUnsatisfiedMinimalDefinition

        methodExists :: Name -> Bool
    methodExists Name
    meth = Maybe
      (GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
       SrcSpan, [LSig (GhcPass 'Renamed)])
    -> Bool
    forall a. Maybe a -> Bool
    isJust (Name
    -> LHsBinds (GhcPass 'Renamed)
    -> TcPragEnv
    -> Maybe
         (GenLocated
            SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
          SrcSpan, [LSig (GhcPass 'Renamed)])
    findMethodBind Name
    meth LHsBinds (GhcPass 'Renamed)
    binds TcPragEnv
    prag_fn)

        ----------------------
        -- Check if any method bindings do not correspond to the class.
        -- See Note [Mismatched class methods and associated type families].
        checkMethBindMembership :: TcRn ()
    checkMethBindMembership
          = (Name -> TcRn ()) -> [Name] -> TcRn ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (SDoc -> TcRn ()
    addErrTc (SDoc -> TcRn ()) -> (Name -> SDoc) -> Name -> TcRn ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Class -> Name -> SDoc
    forall a. Outputable a => a -> Name -> SDoc
    badMethodErr Class
    clas) [Name]
    mismatched_meths
          where
            bind_nms :: [Name]
    bind_nms         = (GenLocated SrcSpan Name -> Name)
    -> [GenLocated SrcSpan Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpan Name -> Name
    forall l e. GenLocated l e -> e
    unLoc ([GenLocated SrcSpan Name] -> [Name])
    -> [GenLocated SrcSpan Name] -> [Name]
    forall a b. (a -> b) -> a -> b
    $ LHsBinds (GhcPass 'Renamed) -> [Located (IdP (GhcPass 'Renamed))]
    forall idL idR. LHsBindsLR idL idR -> [Located (IdP idL)]
    collectMethodBinders LHsBinds (GhcPass 'Renamed)
    binds
            cls_meth_nms :: [Name]
    cls_meth_nms     = (ClassOpItem -> Name) -> [ClassOpItem] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (Id -> Name
    idName (Id -> Name) -> (ClassOpItem -> Id) -> ClassOpItem -> Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClassOpItem -> Id
    forall a b. (a, b) -> a
    fst) [ClassOpItem]
    op_items
            mismatched_meths :: [Name]
    mismatched_meths = [Name]
    bind_nms [Name] -> [Name] -> [Name]
    forall a. Ord a => [a] -> [a] -> [a]
    `minusList` [Name]
    cls_meth_nms

    {-
    Note [Mismatched class methods and associated type families]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    It's entirely possible for someone to put methods or associated type family
    instances inside of a class in which it doesn't belong. For instance, we'd
    want to fail if someone wrote this:

      instance Eq () where
        type Rep () = Maybe
        compare = undefined

    Since neither the type family `Rep` nor the method `compare` belong to the
    class `Eq`. Normally, this is caught in the renamer when resolving RdrNames,
    since that would discover that the parent class `Eq` is incorrect.

    However, there is a scenario in which the renamer could fail to catch this:
    if the instance was generated through Template Haskell, as in #12387. In that
    case, Template Haskell will provide fully resolved names (e.g.,
    `GHC.Classes.compare`), so the renamer won't notice the sleight-of-hand going
    on. For this reason, we also put an extra validity check for this in the
    typechecker as a last resort.

    Note [Avoid -Winaccessible-code when deriving]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -Winaccessible-code can be particularly noisy when deriving instances for
    GADTs. Consider the following example (adapted from #8128):

      data T a where
        MkT1 :: Int -> T Int
        MkT2 :: T Bool
        MkT3 :: T Bool
      deriving instance Eq (T a)
      deriving instance Ord (T a)

    In the derived Ord instance, GHC will generate the following code:

      instance Ord (T a) where
        compare x y
          = case x of
              MkT2
                -> case y of
                     MkT1 {} -> GT
                     MkT2    -> EQ
                     _       -> LT
              ...

    However, that MkT1 is unreachable, since the type indices for MkT1 and MkT2
    differ, so if -Winaccessible-code is enabled, then deriving this instance will
    result in unwelcome warnings.

    One conceivable approach to fixing this issue would be to change `deriving Ord`
    such that it becomes smarter about not generating unreachable cases. This,
    however, would be a highly nontrivial refactor, as we'd have to propagate
    through typing information everywhere in the algorithm that generates Ord
    instances in order to determine which cases were unreachable. This seems like
    a lot of work for minimal gain, so we have opted not to go for this approach.

    Instead, we take the much simpler approach of always disabling
    -Winaccessible-code for derived code. To accomplish this, we do the following:

    1. In tcMethods (which typechecks method bindings), disable
       -Winaccessible-code.
    2. When creating Implications during typechecking, record this flag
       (in ic_warn_inaccessible) at the time of creation.
    3. After typechecking comes error reporting, where GHC must decide how to
       report inaccessible code to the user, on an Implication-by-Implication
       basis. If an Implication's DynFlags indicate that -Winaccessible-code was
       disabled, then don't bother reporting it. That's it!
    -}

    ------------------------
    tcMethodBody :: Class -> [TcTyVar] -> [EvVar] -> [TcType]
                 -> TcEvBinds -> Bool
                 -> HsSigFun
                 -> [LTcSpecPrag] -> [LSig GhcRn]
                 -> Id -> LHsBind GhcRn -> SrcSpan
                 -> TcM (TcId, LHsBind GhcTc, Maybe Implication)
    tcMethodBody :: Class
    -> [Id]
    -> [Id]
    -> [PredType]
    -> TcEvBinds
    -> Bool
    -> HsSigFun
    -> [Located TcSpecPrag]
    -> [LSig (GhcPass 'Renamed)]
    -> Id
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> SrcSpan
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    tcMethodBody Class
    clas [Id]
    tyvars [Id]
    dfun_ev_vars [PredType]
    inst_tys
                         TcEvBinds
    dfun_ev_binds Bool
    is_derived
                         HsSigFun
    sig_fn [Located TcSpecPrag]
    spec_inst_prags [LSig (GhcPass 'Renamed)]
    prags
                         Id
    sel_id (L SrcSpan
    bind_loc HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    meth_bind) SrcSpan
    bndr_loc
      = IOEnv
      (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    add_meth_ctxt (IOEnv
       (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
     -> IOEnv
          (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication))
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    forall a b. (a -> b) -> a -> b
    $
        do { String -> SDoc -> TcRn ()
    traceTc String
    "tcMethodBody" (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    sel_id SDoc -> SDoc -> SDoc
    <+> PredType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Id -> PredType
    idType Id
    sel_id) SDoc -> SDoc -> SDoc
    $$ SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    bndr_loc)
           ; (Id
    global_meth_id, Id
    local_meth_id) <- SrcSpan -> TcM (Id, Id) -> TcM (Id, Id)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    bndr_loc (TcM (Id, Id) -> TcM (Id, Id)) -> TcM (Id, Id) -> TcM (Id, Id)
    forall a b. (a -> b) -> a -> b
    $
                                                Class -> [Id] -> [Id] -> [PredType] -> Id -> TcM (Id, Id)
    mkMethIds Class
    clas [Id]
    tyvars [Id]
    dfun_ev_vars
                                                          [PredType]
    inst_tys Id
    sel_id

           ; let lm_bind :: HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    lm_bind = HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    meth_bind { fun_id :: Located (IdP (GhcPass 'Renamed))
    fun_id = SrcSpan -> Name -> GenLocated SrcSpan Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    bndr_loc (Id -> Name
    idName Id
    local_meth_id) }
                           -- Substitute the local_meth_name for the binder
                           -- NB: the binding is always a FunBind

                -- taking instance signature into account might change the type of
                -- the local_meth_id
           ; (Implication
    meth_implic, EvBindsVar
    ev_binds_var, LHsBinds GhcTc
    tc_bind)
                 <- TcM (LHsBinds GhcTc)
    -> TcM (Implication, EvBindsVar, LHsBinds GhcTc)
    forall result. TcM result -> TcM (Implication, EvBindsVar, result)
    checkInstConstraints (TcM (LHsBinds GhcTc)
     -> TcM (Implication, EvBindsVar, LHsBinds GhcTc))
    -> TcM (LHsBinds GhcTc)
    -> TcM (Implication, EvBindsVar, LHsBinds GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                    HsSigFun
    -> Id
    -> Id
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM (LHsBinds GhcTc)
    tcMethodBodyHelp HsSigFun
    sig_fn Id
    sel_id Id
    local_meth_id (SrcSpan
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    bind_loc HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    lm_bind)

           ; Id
    global_meth_id <- Id -> [LSig (GhcPass 'Renamed)] -> TcM Id
    addInlinePrags Id
    global_meth_id [LSig (GhcPass 'Renamed)]
    prags
           ; [Located TcSpecPrag]
    spec_prags     <- Id -> [LSig (GhcPass 'Renamed)] -> TcM [Located TcSpecPrag]
    tcSpecPrags Id
    global_meth_id [LSig (GhcPass 'Renamed)]
    prags

            ; let specs :: TcSpecPrags
    specs  = Id -> [Located TcSpecPrag] -> [Located TcSpecPrag] -> TcSpecPrags
    mk_meth_spec_prags Id
    global_meth_id [Located TcSpecPrag]
    spec_inst_prags [Located TcSpecPrag]
    spec_prags
                  export :: ABExport GhcTc
    export = ABE :: forall p.
    XABE p -> IdP p -> IdP p -> HsWrapper -> TcSpecPrags -> ABExport p
    ABE { abe_ext :: XABE GhcTc
    abe_ext   = NoExtField
    XABE GhcTc
    noExtField
                               , abe_poly :: IdP GhcTc
    abe_poly  = Id
    IdP GhcTc
    global_meth_id
                               , abe_mono :: IdP GhcTc
    abe_mono  = Id
    IdP GhcTc
    local_meth_id
                               , abe_wrap :: HsWrapper
    abe_wrap  = HsWrapper
    idHsWrapper
                               , abe_prags :: TcSpecPrags
    abe_prags = TcSpecPrags
    specs }

                  local_ev_binds :: TcEvBinds
    local_ev_binds = EvBindsVar -> TcEvBinds
    TcEvBinds EvBindsVar
    ev_binds_var
                  full_bind :: HsBindLR GhcTc GhcTc
    full_bind = AbsBinds :: forall idL idR.
    XAbsBinds idL idR
    -> [Id]
    -> [Id]
    -> [ABExport idL]
    -> [TcEvBinds]
    -> LHsBinds idL
    -> Bool
    -> HsBindLR idL idR
    AbsBinds { abs_ext :: XAbsBinds GhcTc GhcTc
    abs_ext      = NoExtField
    XAbsBinds GhcTc GhcTc
    noExtField
                                       , abs_tvs :: [Id]
    abs_tvs      = [Id]
    tyvars
                                       , abs_ev_vars :: [Id]
    abs_ev_vars  = [Id]
    dfun_ev_vars
                                       , abs_exports :: [ABExport GhcTc]
    abs_exports  = [ABExport GhcTc
    export]
                                       , abs_ev_binds :: [TcEvBinds]
    abs_ev_binds = [TcEvBinds
    dfun_ev_binds, TcEvBinds
    local_ev_binds]
                                       , abs_binds :: LHsBinds GhcTc
    abs_binds    = LHsBinds GhcTc
    tc_bind
                                       , abs_sig :: Bool
    abs_sig      = Bool
    True }

            ; (Id, LHsBind GhcTc, Maybe Implication)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id
    global_meth_id, SrcSpan -> HsBindLR GhcTc GhcTc -> LHsBind GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    bind_loc HsBindLR GhcTc GhcTc
    full_bind, Implication -> Maybe Implication
    forall a. a -> Maybe a
    Just Implication
    meth_implic) }
      where
            -- For instance decls that come from deriving clauses
            -- we want to print out the full source code if there's an error
            -- because otherwise the user won't see the code at all
        add_meth_ctxt :: IOEnv
      (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    add_meth_ctxt IOEnv
      (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    thing
          | Bool
    is_derived = SDoc
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    forall a. SDoc -> TcM a -> TcM a
    addLandmarkErrCtxt (Id -> Class -> [PredType] -> SDoc
    derivBindCtxt Id
    sel_id Class
    clas [PredType]
    inst_tys) IOEnv
      (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    thing
          | Bool
    otherwise  = IOEnv
      (Env TcGblEnv TcLclEnv) (Id, LHsBind GhcTc, Maybe Implication)
    thing

    tcMethodBodyHelp :: HsSigFun -> Id -> TcId
                     -> LHsBind GhcRn -> TcM (LHsBinds GhcTc)
    tcMethodBodyHelp :: HsSigFun
    -> Id
    -> Id
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM (LHsBinds GhcTc)
    tcMethodBodyHelp HsSigFun
    hs_sig_fn Id
    sel_id Id
    local_meth_id GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    meth_bind
      | Just LHsSigType (GhcPass 'Renamed)
    hs_sig_ty <- HsSigFun
    hs_sig_fn Name
    sel_name
                  -- There is a signature in the instance
                  -- See Note [Instance method signatures]
      = do { (PredType
    sig_ty, HsWrapper
    hs_wrap)
                 <- SrcSpan -> TcRn (PredType, HsWrapper) -> TcRn (PredType, HsWrapper)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (LHsType (GhcPass 'Renamed) -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc (LHsSigType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
    hsSigType LHsSigType (GhcPass 'Renamed)
    hs_sig_ty)) (TcRn (PredType, HsWrapper) -> TcRn (PredType, HsWrapper))
    -> TcRn (PredType, HsWrapper) -> TcRn (PredType, HsWrapper)
    forall a b. (a -> b) -> a -> b
    $
                    do { Bool
    inst_sigs <- Extension -> TcRn Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.InstanceSigs
                       ; Bool -> SDoc -> TcRn ()
    checkTc Bool
    inst_sigs (Name -> LHsSigType (GhcPass 'Renamed) -> SDoc
    misplacedInstSig Name
    sel_name LHsSigType (GhcPass 'Renamed)
    hs_sig_ty)
                       ; PredType
    sig_ty  <- UserTypeCtxt -> LHsSigType (GhcPass 'Renamed) -> TcM PredType
    tcHsSigType (Name -> Bool -> UserTypeCtxt
    FunSigCtxt Name
    sel_name Bool
    False) LHsSigType (GhcPass 'Renamed)
    hs_sig_ty
                       ; let local_meth_ty :: PredType
    local_meth_ty = Id -> PredType
    idType Id
    local_meth_id
                             ctxt :: UserTypeCtxt
    ctxt = Name -> Bool -> UserTypeCtxt
    FunSigCtxt Name
    sel_name Bool
    False
                                    -- False <=> do not report redundant constraints when
                                    --           checking instance-sig <= class-meth-sig
                                    -- The instance-sig is the focus here; the class-meth-sig
                                    -- is fixed (#18036)
                       ; HsWrapper
    hs_wrap <- (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM HsWrapper -> TcM HsWrapper
    forall a. (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    addErrCtxtM (Name -> PredType -> PredType -> TidyEnv -> TcM (TidyEnv, SDoc)
    methSigCtxt Name
    sel_name PredType
    sig_ty PredType
    local_meth_ty) (TcM HsWrapper -> TcM HsWrapper) -> TcM HsWrapper -> TcM HsWrapper
    forall a b. (a -> b) -> a -> b
    $
                                    UserTypeCtxt -> PredType -> PredType -> TcM HsWrapper
    tcSubTypeSigma UserTypeCtxt
    ctxt PredType
    sig_ty PredType
    local_meth_ty
                       ; (PredType, HsWrapper) -> TcRn (PredType, HsWrapper)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PredType
    sig_ty, HsWrapper
    hs_wrap) }

           ; Name
    inner_meth_name <- OccName -> TcM Name
    newName (Name -> OccName
    nameOccName Name
    sel_name)
           ; let ctxt :: UserTypeCtxt
    ctxt = Name -> Bool -> UserTypeCtxt
    FunSigCtxt Name
    sel_name Bool
    True
                        -- True <=> check for redundant constraints in the
                        --          user-specified instance signature
                 inner_meth_id :: Id
    inner_meth_id  = HasDebugCallStack => Name -> PredType -> PredType -> Id
    Name -> PredType -> PredType -> Id
    mkLocalId Name
    inner_meth_name PredType
    Many PredType
    sig_ty
                 inner_meth_sig :: TcIdSigInfo
    inner_meth_sig = CompleteSig :: Id -> UserTypeCtxt -> SrcSpan -> TcIdSigInfo
    CompleteSig { sig_bndr :: Id
    sig_bndr = Id
    inner_meth_id
                                              , sig_ctxt :: UserTypeCtxt
    sig_ctxt = UserTypeCtxt
    ctxt
                                              , sig_loc :: SrcSpan
    sig_loc  = LHsType (GhcPass 'Renamed) -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc (LHsSigType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
    hsSigType LHsSigType (GhcPass 'Renamed)
    hs_sig_ty) }

           ; (LHsBinds GhcTc
    tc_bind, [Id
    inner_id]) <- TcPragEnv
    -> TcIdSigInfo
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM (LHsBinds GhcTc, [Id])
    tcPolyCheck TcPragEnv
    no_prag_fn TcIdSigInfo
    inner_meth_sig GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    meth_bind

           ; let export :: ABExport GhcTc
    export = ABE :: forall p.
    XABE p -> IdP p -> IdP p -> HsWrapper -> TcSpecPrags -> ABExport p
    ABE { abe_ext :: XABE GhcTc
    abe_ext   = NoExtField
    XABE GhcTc
    noExtField
                              , abe_poly :: IdP GhcTc
    abe_poly  = Id
    IdP GhcTc
    local_meth_id
                              , abe_mono :: IdP GhcTc
    abe_mono  = Id
    IdP GhcTc
    inner_id
                              , abe_wrap :: HsWrapper
    abe_wrap  = HsWrapper
    hs_wrap
                              , abe_prags :: TcSpecPrags
    abe_prags = TcSpecPrags
    noSpecPrags }

           ; LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBind GhcTc -> LHsBinds GhcTc
    forall a. a -> Bag a
    unitBag (LHsBind GhcTc -> LHsBinds GhcTc)
    -> LHsBind GhcTc -> LHsBinds GhcTc
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> HsBindLR GhcTc GhcTc -> LHsBind GhcTc
    forall l e. l -> e -> GenLocated l e
    L (GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    meth_bind) (HsBindLR GhcTc GhcTc -> LHsBind GhcTc)
    -> HsBindLR GhcTc GhcTc -> LHsBind GhcTc
    forall a b. (a -> b) -> a -> b
    $
                     AbsBinds :: forall idL idR.
    XAbsBinds idL idR
    -> [Id]
    -> [Id]
    -> [ABExport idL]
    -> [TcEvBinds]
    -> LHsBinds idL
    -> Bool
    -> HsBindLR idL idR
    AbsBinds { abs_ext :: XAbsBinds GhcTc GhcTc
    abs_ext = NoExtField
    XAbsBinds GhcTc GhcTc
    noExtField, abs_tvs :: [Id]
    abs_tvs = [], abs_ev_vars :: [Id]
    abs_ev_vars = []
                              , abs_exports :: [ABExport GhcTc]
    abs_exports = [ABExport GhcTc
    export]
                              , abs_binds :: LHsBinds GhcTc
    abs_binds = LHsBinds GhcTc
    tc_bind, abs_ev_binds :: [TcEvBinds]
    abs_ev_binds = []
                              , abs_sig :: Bool
    abs_sig = Bool
    True }) }

      | Bool
    otherwise  -- No instance signature
      = do { let ctxt :: UserTypeCtxt
    ctxt = Name -> Bool -> UserTypeCtxt
    FunSigCtxt Name
    sel_name Bool
    False
                        -- False <=> don't report redundant constraints
                        -- The signature is not under the users control!
                 tc_sig :: TcIdSigInfo
    tc_sig = UserTypeCtxt -> Id -> TcIdSigInfo
    completeSigFromId UserTypeCtxt
    ctxt Id
    local_meth_id
                  -- Absent a type sig, there are no new scoped type variables here
                  -- Only the ones from the instance decl itself, which are already
                  -- in scope.  Example:
                  --      class C a where { op :: forall b. Eq b => ... }
                  --      instance C [c] where { op = <rhs> }
                  -- In <rhs>, 'c' is scope but 'b' is not!

           ; (LHsBinds GhcTc
    tc_bind, [Id]
    _) <- TcPragEnv
    -> TcIdSigInfo
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM (LHsBinds GhcTc, [Id])
    tcPolyCheck TcPragEnv
    no_prag_fn TcIdSigInfo
    tc_sig GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    meth_bind
           ; LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return LHsBinds GhcTc
    tc_bind }

      where
        sel_name :: Name
    sel_name   = Id -> Name
    idName Id
    sel_id
        no_prag_fn :: TcPragEnv
    no_prag_fn = TcPragEnv
    emptyPragEnv   -- No pragmas for local_meth_id;
                                    -- they are all for meth_id

    ------------------------
    mkMethIds :: Class -> [TcTyVar] -> [EvVar]
              -> [TcType] -> Id -> TcM (TcId, TcId)
                 -- returns (poly_id, local_id), but ignoring any instance signature
                 -- See Note [Instance method signatures]
    mkMethIds :: Class -> [Id] -> [Id] -> [PredType] -> Id -> TcM (Id, Id)
    mkMethIds Class
    clas [Id]
    tyvars [Id]
    dfun_ev_vars [PredType]
    inst_tys Id
    sel_id
      = do  { Name
    poly_meth_name  <- OccName -> TcM Name
    newName (OccName -> OccName
    mkClassOpAuxOcc OccName
    sel_occ)
            ; Name
    local_meth_name <- OccName -> TcM Name
    newName OccName
    sel_occ
                      -- Base the local_meth_name on the selector name, because
                      -- type errors from tcMethodBody come from here
            ; let poly_meth_id :: Id
    poly_meth_id  = HasDebugCallStack => Name -> PredType -> PredType -> Id
    Name -> PredType -> PredType -> Id
    mkLocalId Name
    poly_meth_name  PredType
    Many PredType
    poly_meth_ty
                  local_meth_id :: Id
    local_meth_id = HasDebugCallStack => Name -> PredType -> PredType -> Id
    Name -> PredType -> PredType -> Id
    mkLocalId Name
    local_meth_name PredType
    Many PredType
    local_meth_ty

            ; (Id, Id) -> TcM (Id, Id)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id
    poly_meth_id, Id
    local_meth_id) }
      where
        sel_name :: Name
    sel_name      = Id -> Name
    idName Id
    sel_id
        -- Force so that a thunk doesn't end up in a Name (#19619)
        !sel_occ :: OccName
    sel_occ      = Name -> OccName
    nameOccName Name
    sel_name
        local_meth_ty :: PredType
    local_meth_ty = Class -> Id -> [PredType] -> PredType
    instantiateMethod Class
    clas Id
    sel_id [PredType]
    inst_tys
        poly_meth_ty :: PredType
    poly_meth_ty  = [Id] -> [PredType] -> PredType -> PredType
    mkSpecSigmaTy [Id]
    tyvars [PredType]
    theta PredType
    local_meth_ty
        theta :: [PredType]
    theta         = (Id -> PredType) -> [Id] -> [PredType]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> PredType
    idType [Id]
    dfun_ev_vars

    methSigCtxt :: Name -> TcType -> TcType -> TidyEnv -> TcM (TidyEnv, MsgDoc)
    methSigCtxt :: Name -> PredType -> PredType -> TidyEnv -> TcM (TidyEnv, SDoc)
    methSigCtxt Name
    sel_name PredType
    sig_ty PredType
    meth_ty TidyEnv
    env0
      = do { (TidyEnv
    env1, PredType
    sig_ty)  <- TidyEnv -> PredType -> TcM (TidyEnv, PredType)
    zonkTidyTcType TidyEnv
    env0 PredType
    sig_ty
           ; (TidyEnv
    env2, PredType
    meth_ty) <- TidyEnv -> PredType -> TcM (TidyEnv, PredType)
    zonkTidyTcType TidyEnv
    env1 PredType
    meth_ty
           ; let msg :: SDoc
    msg = SDoc -> ConTag -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "When checking that instance signature for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    sel_name))
                          ConTag
    2 ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "is more general than its signature in the class"
                                  , String -> SDoc
    text String
    "Instance sig:" SDoc -> SDoc -> SDoc
    <+> PredType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PredType
    sig_ty
                                  , String -> SDoc
    text String
    "   Class sig:" SDoc -> SDoc -> SDoc
    <+> PredType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PredType
    meth_ty ])
           ; (TidyEnv, SDoc) -> TcM (TidyEnv, SDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TidyEnv
    env2, SDoc
    msg) }

    misplacedInstSig :: Name -> LHsSigType GhcRn -> SDoc
    misplacedInstSig :: Name -> LHsSigType (GhcPass 'Renamed) -> SDoc
    misplacedInstSig Name
    name LHsSigType (GhcPass 'Renamed)
    hs_ty
      = [SDoc] -> SDoc
    vcat [ SDoc -> ConTag -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Illegal type signature in instance declaration:")
                  ConTag
    2 (SDoc -> ConTag -> SDoc -> SDoc
    hang (Name -> SDoc
    forall a. NamedThing a => a -> SDoc
    pprPrefixName Name
    name)
                        ConTag
    2 (SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> LHsSigType (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsSigType (GhcPass 'Renamed)
    hs_ty))
             , String -> SDoc
    text String
    "(Use InstanceSigs to allow this)" ]

    {- Note [Instance method signatures]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    With -XInstanceSigs we allow the user to supply a signature for the
    method in an instance declaration.  Here is an artificial example:

           data T a = MkT a
           instance Ord a => Ord (T a) where
             (>) :: forall b. b -> b -> Bool
             (>) = error "You can't compare Ts"

    The instance signature can be *more* polymorphic than the instantiated
    class method (in this case: Age -> Age -> Bool), but it cannot be less
    polymorphic.  Moreover, if a signature is given, the implementation
    code should match the signature, and type variables bound in the
    singature should scope over the method body.

    We achieve this by building a TcSigInfo for the method, whether or not
    there is an instance method signature, and using that to typecheck
    the declaration (in tcMethodBody).  That means, conveniently,
    that the type variables bound in the signature will scope over the body.

    What about the check that the instance method signature is more
    polymorphic than the instantiated class method type?  We just do a
    tcSubType call in tcMethodBodyHelp, and generate a nested AbsBind, like
    this (for the example above

     AbsBind { abs_tvs = [a], abs_ev_vars = [d:Ord a]
             , abs_exports
                 = ABExport { (>) :: forall a. Ord a => T a -> T a -> Bool
                            , gr_lcl :: T a -> T a -> Bool }
             , abs_binds
                 = AbsBind { abs_tvs = [], abs_ev_vars = []
                           , abs_exports = ABExport { gr_lcl :: T a -> T a -> Bool
                                                    , gr_inner :: forall b. b -> b -> Bool }
                           , abs_binds = AbsBind { abs_tvs = [b], abs_ev_vars = []
                                                 , ..etc.. }
                   } }

    Wow!  Three nested AbsBinds!
     * The outer one abstracts over the tyvars and dicts for the instance
     * The middle one is only present if there is an instance signature,
       and does the impedance matching for that signature
     * The inner one is for the method binding itself against either the
       signature from the class, or the instance signature.
    -}

    ----------------------
    mk_meth_spec_prags :: Id -> [LTcSpecPrag] -> [LTcSpecPrag] -> TcSpecPrags
            -- Adapt the 'SPECIALISE instance' pragmas to work for this method Id
            -- There are two sources:
            --   * spec_prags_for_me: {-# SPECIALISE op :: <blah> #-}
            --   * spec_prags_from_inst: derived from {-# SPECIALISE instance :: <blah> #-}
            --     These ones have the dfun inside, but [perhaps surprisingly]
            --     the correct wrapper.
            -- See Note [Handling SPECIALISE pragmas] in GHC.Tc.Gen.Bind
    mk_meth_spec_prags :: Id -> [Located TcSpecPrag] -> [Located TcSpecPrag] -> TcSpecPrags
    mk_meth_spec_prags Id
    meth_id [Located TcSpecPrag]
    spec_inst_prags [Located TcSpecPrag]
    spec_prags_for_me
      = [Located TcSpecPrag] -> TcSpecPrags
    SpecPrags ([Located TcSpecPrag]
    spec_prags_for_me [Located TcSpecPrag]
    -> [Located TcSpecPrag] -> [Located TcSpecPrag]
    forall a. [a] -> [a] -> [a]
    ++ [Located TcSpecPrag]
    spec_prags_from_inst)
      where
        spec_prags_from_inst :: [Located TcSpecPrag]
    spec_prags_from_inst
           | InlinePragma -> Bool
    isInlinePragma (Id -> InlinePragma
    idInlinePragma Id
    meth_id)
           = []  -- Do not inherit SPECIALISE from the instance if the
                 -- method is marked INLINE, because then it'll be inlined
                 -- and the specialisation would do nothing. (Indeed it'll provoke
                 -- a warning from the desugarer
           | Bool
    otherwise
           = [ SrcSpan -> TcSpecPrag -> Located TcSpecPrag
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    inst_loc (Id -> HsWrapper -> InlinePragma -> TcSpecPrag
    SpecPrag Id
    meth_id HsWrapper
    wrap InlinePragma
    inl)
             | L SrcSpan
    inst_loc (SpecPrag Id
    _       HsWrapper
    wrap InlinePragma
    inl) <- [Located TcSpecPrag]
    spec_inst_prags]

    mkDefMethBind :: DFunId -> Class -> Id -> Name
                  -> TcM (LHsBind GhcRn, [LSig GhcRn])
    -- The is a default method (vanailla or generic) defined in the class
    -- So make a binding   op = $dmop @t1 @t2
    -- where $dmop is the name of the default method in the class,
    -- and t1,t2 are the instance types.
    -- See Note [Default methods in instances] for why we use
    -- visible type application here
    mkDefMethBind :: Id
    -> Class
    -> Id
    -> Name
    -> TcM
         (GenLocated
            SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
          [LSig (GhcPass 'Renamed)])
    mkDefMethBind Id
    dfun_id Class
    clas Id
    sel_id Name
    dm_name
      = do  { DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            ; Id
    dm_id <- Name -> TcM Id
    tcLookupId Name
    dm_name
            ; let inline_prag :: InlinePragma
    inline_prag = Id -> InlinePragma
    idInlinePragma Id
    dm_id
                  inline_prags :: [LSig (GhcPass 'Renamed)]
    inline_prags | InlinePragma -> Bool
    isAnyInlinePragma InlinePragma
    inline_prag
                               = [Sig (GhcPass 'Renamed) -> LSig (GhcPass 'Renamed)
    forall e. e -> Located e
    noLoc (XInlineSig (GhcPass 'Renamed)
    -> Located (IdP (GhcPass 'Renamed))
    -> InlinePragma
    -> Sig (GhcPass 'Renamed)
    forall pass.
    XInlineSig pass -> Located (IdP pass) -> InlinePragma -> Sig pass
    InlineSig NoExtField
    XInlineSig (GhcPass 'Renamed)
    noExtField GenLocated SrcSpan Name
    Located (IdP (GhcPass 'Renamed))
    fn InlinePragma
    inline_prag)]
                               | Bool
    otherwise
                               = []
                     -- Copy the inline pragma (if any) from the default method
                     -- to this version. Note [INLINE and default methods]

                  fn :: GenLocated SrcSpan Name
    fn   = Name -> GenLocated SrcSpan Name
    forall e. e -> Located e
    noLoc (Id -> Name
    idName Id
    sel_id)
                  visible_inst_tys :: [PredType]
    visible_inst_tys = [ PredType
    ty | (TyConBinder
    tcb, PredType
    ty) <- TyCon -> [TyConBinder]
    tyConBinders (Class -> TyCon
    classTyCon Class
    clas) [TyConBinder] -> [PredType] -> [(TyConBinder, PredType)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [PredType]
    inst_tys
                                          , TyConBinder -> ArgFlag
    tyConBinderArgFlag TyConBinder
    tcb ArgFlag -> ArgFlag -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ArgFlag
    Inferred ]
                  rhs :: LHsExpr (GhcPass 'Renamed)
    rhs  = (LHsExpr (GhcPass 'Renamed)
     -> PredType -> LHsExpr (GhcPass 'Renamed))
    -> LHsExpr (GhcPass 'Renamed)
    -> [PredType]
    -> LHsExpr (GhcPass 'Renamed)
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' LHsExpr (GhcPass 'Renamed)
    -> PredType -> LHsExpr (GhcPass 'Renamed)
    mk_vta (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Name
    IdP (GhcPass 'Renamed)
    dm_name) [PredType]
    visible_inst_tys
                  bind :: GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    bind = HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall e. e -> Located e
    noLoc (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
     -> GenLocated
          SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ Origin
    -> GenLocated SrcSpan Name
    -> [LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    mkTopFunBind Origin
    Generated GenLocated SrcSpan Name
    fn ([LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
     -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> [LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    forall a b. (a -> b) -> a -> b
    $
                                 [HsMatchContext (NoGhcTc (GhcPass 'Renamed))
    -> [LPat (GhcPass 'Renamed)]
    -> LHsExpr (GhcPass 'Renamed)
    -> LMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    forall (p :: Pass) (body :: * -> *).
    HsMatchContext (NoGhcTc (GhcPass p))
    -> [LPat (GhcPass p)]
    -> Located (body (GhcPass p))
    -> LMatch (GhcPass p) (Located (body (GhcPass p)))
    mkSimpleMatch (Located (IdP (GhcPass 'Renamed))
    -> HsMatchContext (GhcPass 'Renamed)
    forall p. LIdP p -> HsMatchContext p
    mkPrefixFunRhs GenLocated SrcSpan Name
    Located (IdP (GhcPass 'Renamed))
    fn) [] LHsExpr (GhcPass 'Renamed)
    rhs]

            ; IO () -> TcRn ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (DynFlags -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn DynFlags
    dflags DumpFlag
    Opt_D_dump_deriv String
    "Filling in method body"
                       DumpFormat
    FormatHaskell
                       ([SDoc] -> SDoc
    vcat [Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Class
    clas SDoc -> SDoc -> SDoc
    <+> [PredType] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [PredType]
    inst_tys,
                              ConTag -> SDoc -> SDoc
    nest ConTag
    2 (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    sel_id SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> LHsExpr (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsExpr (GhcPass 'Renamed)
    rhs)]))

           ; (GenLocated
       SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
     [LSig (GhcPass 'Renamed)])
    -> TcM
         (GenLocated
            SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
          [LSig (GhcPass 'Renamed)])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    bind, [LSig (GhcPass 'Renamed)]
    inline_prags) }
      where
        ([Id]
    _, [PredType]
    _, Class
    _, [PredType]
    inst_tys) = PredType -> ([Id], [PredType], Class, [PredType])
    tcSplitDFunTy (Id -> PredType
    idType Id
    dfun_id)

        mk_vta :: LHsExpr GhcRn -> Type -> LHsExpr GhcRn
        mk_vta :: LHsExpr (GhcPass 'Renamed)
    -> PredType -> LHsExpr (GhcPass 'Renamed)
    mk_vta LHsExpr (GhcPass 'Renamed)
    fun PredType
    ty = HsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
    forall e. e -> Located e
    noLoc (XAppTypeE (GhcPass 'Renamed)
    -> LHsExpr (GhcPass 'Renamed)
    -> LHsWcType (NoGhcTc (GhcPass 'Renamed))
    -> HsExpr (GhcPass 'Renamed)
    forall p.
    XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
    HsAppType NoExtField
    XAppTypeE (GhcPass 'Renamed)
    noExtField LHsExpr (GhcPass 'Renamed)
    fun (LHsType (GhcPass 'Renamed)
    -> HsWildCardBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
    forall thing. thing -> HsWildCardBndrs (GhcPass 'Renamed) thing
    mkEmptyWildCardBndrs (LHsType (GhcPass 'Renamed)
     -> HsWildCardBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed)))
    -> LHsType (GhcPass 'Renamed)
    -> HsWildCardBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass). LHsType (GhcPass p) -> LHsType (GhcPass p)
    nlHsParTy
                                                    (LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed))
    -> LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall a b. (a -> b) -> a -> b
    $ HsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall e. e -> Located e
    noLoc (HsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed))
    -> HsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall a b. (a -> b) -> a -> b
    $ XXType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed)
    forall pass. XXType pass -> HsType pass
    XHsType (XXType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed))
    -> XXType (GhcPass 'Renamed) -> HsType (GhcPass 'Renamed)
    forall a b. (a -> b) -> a -> b
    $ PredType -> NewHsTypeX
    NHsCoreTy PredType
    ty))
           -- NB: use visible type application
           -- See Note [Default methods in instances]

    ----------------------
    derivBindCtxt :: Id -> Class -> [Type ] -> SDoc
    derivBindCtxt :: Id -> Class -> [PredType] -> SDoc
    derivBindCtxt Id
    sel_id Class
    clas [PredType]
    tys
       = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "When typechecking the code for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Id
    sel_id)
              , ConTag -> SDoc -> SDoc
    nest ConTag
    2 (String -> SDoc
    text String
    "in a derived instance for"
                        SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Class -> [PredType] -> SDoc
    pprClassPred Class
    clas [PredType]
    tys) SDoc -> SDoc -> SDoc
    <> SDoc
    colon)
              , ConTag -> SDoc -> SDoc
    nest ConTag
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "To see the code I am typechecking, use -ddump-deriv" ]

    warnUnsatisfiedMinimalDefinition :: ClassMinimalDef -> TcM ()
    warnUnsatisfiedMinimalDefinition :: BooleanFormula Name -> TcRn ()
    warnUnsatisfiedMinimalDefinition BooleanFormula Name
    mindef
      = do { Bool
    warn <- WarningFlag -> TcRn Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnMissingMethods
           ; WarnReason -> Bool -> SDoc -> TcRn ()
    warnTc (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnMissingMethods) Bool
    warn SDoc
    message
           }
      where
        message :: SDoc
    message = [SDoc] -> SDoc
    vcat [String -> SDoc
    text String
    "No explicit implementation for"
                       ,ConTag -> SDoc -> SDoc
    nest ConTag
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ BooleanFormula Name -> SDoc
    forall a. Outputable a => BooleanFormula a -> SDoc
    pprBooleanFormulaNice BooleanFormula Name
    mindef
                       ]

    {-
    Note [Export helper functions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We arrange to export the "helper functions" of an instance declaration,
    so that they are not subject to preInlineUnconditionally, even if their
    RHS is trivial.  Reason: they are mentioned in the DFunUnfolding of
    the dict fun as Ids, not as CoreExprs, so we can't substitute a
    non-variable for them.

    We could change this by making DFunUnfoldings have CoreExprs, but it
    seems a bit simpler this way.

    Note [Default methods in instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider this

       class Baz v x where
          foo :: x -> x
          foo y = <blah>

       instance Baz Int Int

    From the class decl we get

       $dmfoo :: forall v x. Baz v x => x -> x
       $dmfoo y = <blah>

    Notice that the type is ambiguous.  So we use Visible Type Application
    to disambiguate:

       $dBazIntInt = MkBaz fooIntInt
       fooIntInt = $dmfoo @Int @Int

    Lacking VTA we'd get ambiguity errors involving the default method.  This applies
    equally to vanilla default methods (#1061) and generic default methods
    (#12220).

    Historical note: before we had VTA we had to generate
    post-type-checked code, which took a lot more code, and didn't work for
    generic default methods.

    Note [INLINE and default methods]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Default methods need special case.  They are supposed to behave rather like
    macros.  For example

      class Foo a where
        op1, op2 :: Bool -> a -> a

        {-# INLINE op1 #-}
        op1 b x = op2 (not b) x

      instance Foo Int where
        -- op1 via default method
        op2 b x = <blah>

    The instance declaration should behave

       just as if 'op1' had been defined with the
       code, and INLINE pragma, from its original
       definition.

    That is, just as if you'd written

      instance Foo Int where
        op2 b x = <blah>

        {-# INLINE op1 #-}
        op1 b x = op2 (not b) x

    So for the above example we generate:

      {-# INLINE $dmop1 #-}
      -- $dmop1 has an InlineCompulsory unfolding
      $dmop1 d b x = op2 d (not b) x

      $fFooInt = MkD $cop1 $cop2

      {-# INLINE $cop1 #-}
      $cop1 = $dmop1 $fFooInt

      $cop2 = <blah>

    Note carefully:

    * We *copy* any INLINE pragma from the default method $dmop1 to the
      instance $cop1.  Otherwise we'll just inline the former in the
      latter and stop, which isn't what the user expected

    * Regardless of its pragma, we give the default method an
      unfolding with an InlineCompulsory source. That means
      that it'll be inlined at every use site, notably in
      each instance declaration, such as $cop1.  This inlining
      must happen even though
        a) $dmop1 is not saturated in $cop1
        b) $cop1 itself has an INLINE pragma

      It's vital that $dmop1 *is* inlined in this way, to allow the mutual
      recursion between $fooInt and $cop1 to be broken

    * To communicate the need for an InlineCompulsory to the desugarer
      (which makes the Unfoldings), we use the IsDefaultMethod constructor
      in TcSpecPrags.

    ************************************************************************
    *                                                                      *
            Specialise instance pragmas
    *                                                                      *
    ************************************************************************

    Note [SPECIALISE instance pragmas]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider

       instance (Ix a, Ix b) => Ix (a,b) where
         {-# SPECIALISE instance Ix (Int,Int) #-}
         range (x,y) = ...

    We make a specialised version of the dictionary function, AND
    specialised versions of each *method*.  Thus we should generate
    something like this:

      $dfIxPair :: (Ix a, Ix b) => Ix (a,b)
      {-# DFUN [$crangePair, ...] #-}
      {-# SPECIALISE $dfIxPair :: Ix (Int,Int) #-}
      $dfIxPair da db = Ix ($crangePair da db) (...other methods...)

      $crange :: (Ix a, Ix b) -> ((a,b),(a,b)) -> [(a,b)]
      {-# SPECIALISE $crange :: ((Int,Int),(Int,Int)) -> [(Int,Int)] #-}
      $crange da db = <blah>

    The SPECIALISE pragmas are acted upon by the desugarer, which generate

      dii :: Ix Int
      dii = ...

      $s$dfIxPair :: Ix ((Int,Int),(Int,Int))
      {-# DFUN [$crangePair di di, ...] #-}
      $s$dfIxPair = Ix ($crangePair di di) (...)

      {-# RULE forall (d1,d2:Ix Int). $dfIxPair Int Int d1 d2 = $s$dfIxPair #-}

      $s$crangePair :: ((Int,Int),(Int,Int)) -> [(Int,Int)]
      $c$crangePair = ...specialised RHS of $crangePair...

      {-# RULE forall (d1,d2:Ix Int). $crangePair Int Int d1 d2 = $s$crangePair #-}

    Note that

      * The specialised dictionary $s$dfIxPair is very much needed, in case we
        call a function that takes a dictionary, but in a context where the
        specialised dictionary can be used.  See #7797.

      * The ClassOp rule for 'range' works equally well on $s$dfIxPair, because
        it still has a DFunUnfolding.  See Note [ClassOp/DFun selection]

      * A call (range ($dfIxPair Int Int d1 d2)) might simplify two ways:
           --> {ClassOp rule for range}     $crangePair Int Int d1 d2
           --> {SPEC rule for $crangePair}  $s$crangePair
        or thus:
           --> {SPEC rule for $dfIxPair}    range $s$dfIxPair
           --> {ClassOpRule for range}      $s$crangePair
        It doesn't matter which way.

      * We want to specialise the RHS of both $dfIxPair and $crangePair,
        but the SAME HsWrapper will do for both!  We can call tcSpecPrag
        just once, and pass the result (in spec_inst_info) to tcMethods.
    -}

    tcSpecInstPrags :: DFunId -> InstBindings GhcRn
                    -> TcM ([Located TcSpecPrag], TcPragEnv)
    tcSpecInstPrags :: Id
    -> InstBindings (GhcPass 'Renamed)
    -> TcM ([Located TcSpecPrag], TcPragEnv)
    tcSpecInstPrags Id
    dfun_id (InstBindings { ib_binds :: forall a. InstBindings a -> LHsBinds a
    ib_binds = LHsBinds (GhcPass 'Renamed)
    binds, ib_pragmas :: forall a. InstBindings a -> [LSig a]
    ib_pragmas = [LSig (GhcPass 'Renamed)]
    uprags })
      = do { [Located TcSpecPrag]
    spec_inst_prags <- (LSig (GhcPass 'Renamed)
     -> IOEnv (Env TcGblEnv TcLclEnv) (Located TcSpecPrag))
    -> [LSig (GhcPass 'Renamed)] -> TcM [Located TcSpecPrag]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((Sig (GhcPass 'Renamed) -> TcM TcSpecPrag)
    -> LSig (GhcPass 'Renamed)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Located TcSpecPrag)
    forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
    wrapLocM (Id -> Sig (GhcPass 'Renamed) -> TcM TcSpecPrag
    tcSpecInst Id
    dfun_id)) ([LSig (GhcPass 'Renamed)] -> TcM [Located TcSpecPrag])
    -> [LSig (GhcPass 'Renamed)] -> TcM [Located TcSpecPrag]
    forall a b. (a -> b) -> a -> b
    $
                                (LSig (GhcPass 'Renamed) -> Bool)
    -> [LSig (GhcPass 'Renamed)] -> [LSig (GhcPass 'Renamed)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter LSig (GhcPass 'Renamed) -> Bool
    forall name. LSig name -> Bool
    isSpecInstLSig [LSig (GhcPass 'Renamed)]
    uprags
                 -- The filter removes the pragmas for methods
           ; ([Located TcSpecPrag], TcPragEnv)
    -> TcM ([Located TcSpecPrag], TcPragEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Located TcSpecPrag]
    spec_inst_prags, [LSig (GhcPass 'Renamed)]
    -> LHsBinds (GhcPass 'Renamed) -> TcPragEnv
    mkPragEnv [LSig (GhcPass 'Renamed)]
    uprags LHsBinds (GhcPass 'Renamed)
    binds) }

    ------------------------------
    tcSpecInst :: Id -> Sig GhcRn -> TcM TcSpecPrag
    tcSpecInst :: Id -> Sig (GhcPass 'Renamed) -> TcM TcSpecPrag
    tcSpecInst Id
    dfun_id prag :: Sig (GhcPass 'Renamed)
    prag@(SpecInstSig XSpecInstSig (GhcPass 'Renamed)
    _ SourceText
    _ LHsSigType (GhcPass 'Renamed)
    hs_ty)
      = SDoc -> TcM TcSpecPrag -> TcM TcSpecPrag
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (Sig (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    spec_ctxt Sig (GhcPass 'Renamed)
    prag) (TcM TcSpecPrag -> TcM TcSpecPrag)
    -> TcM TcSpecPrag -> TcM TcSpecPrag
    forall a b. (a -> b) -> a -> b
    $
        do  { PredType
    spec_dfun_ty <- UserTypeCtxt -> LHsSigType (GhcPass 'Renamed) -> TcM PredType
    tcHsClsInstType UserTypeCtxt
    SpecInstCtxt LHsSigType (GhcPass 'Renamed)
    hs_ty
            ; HsWrapper
    co_fn <- UserTypeCtxt -> PredType -> PredType -> TcM HsWrapper
    tcSpecWrapper UserTypeCtxt
    SpecInstCtxt (Id -> PredType
    idType Id
    dfun_id) PredType
    spec_dfun_ty
            ; TcSpecPrag -> TcM TcSpecPrag
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> HsWrapper -> InlinePragma -> TcSpecPrag
    SpecPrag Id
    dfun_id HsWrapper
    co_fn InlinePragma
    defaultInlinePragma) }
      where
        spec_ctxt :: a -> SDoc
    spec_ctxt a
    prag = SDoc -> ConTag -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "In the pragma:") ConTag
    2 (a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    prag)

    tcSpecInst Id
    _  Sig (GhcPass 'Renamed)
    _ = String -> TcM TcSpecPrag
    forall a. String -> a
    panic String
    "tcSpecInst"

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Error messages}
    *                                                                      *
    ************************************************************************
    -}

    instDeclCtxt1 :: LHsSigType GhcRn -> SDoc
    instDeclCtxt1 :: LHsSigType (GhcPass 'Renamed) -> SDoc
    instDeclCtxt1 LHsSigType (GhcPass 'Renamed)
    hs_inst_ty
      = SDoc -> SDoc
    inst_decl_ctxt (LHsType (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (LHsSigType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass). LHsSigType (GhcPass p) -> LHsType (GhcPass p)
    getLHsInstDeclHead LHsSigType (GhcPass 'Renamed)
    hs_inst_ty))

    instDeclCtxt2 :: Type -> SDoc
    instDeclCtxt2 :: PredType -> SDoc
    instDeclCtxt2 PredType
    dfun_ty
      = SDoc -> SDoc
    inst_decl_ctxt (PredType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Class -> [PredType] -> PredType
    mkClassPred Class
    cls [PredType]
    tys))
      where
        ([Id]
    _,[PredType]
    _,Class
    cls,[PredType]
    tys) = PredType -> ([Id], [PredType], Class, [PredType])
    tcSplitDFunTy PredType
    dfun_ty

    inst_decl_ctxt :: SDoc -> SDoc
    inst_decl_ctxt :: SDoc -> SDoc
    inst_decl_ctxt SDoc
    doc = SDoc -> ConTag -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "In the instance declaration for")
                            ConTag
    2 (SDoc -> SDoc
    quotes SDoc
    doc)

    badBootFamInstDeclErr :: SDoc
    badBootFamInstDeclErr :: SDoc
    badBootFamInstDeclErr
      = String -> SDoc
    text String
    "Illegal family instance in hs-boot file"

    notFamily :: TyCon -> SDoc
    notFamily :: TyCon -> SDoc
    notFamily TyCon
    tycon
      = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Illegal family instance for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tycon)
             , ConTag -> SDoc -> SDoc
    nest ConTag
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> SDoc
    parens (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tycon SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not an indexed type family")]

    assocInClassErr :: TyCon -> SDoc
    assocInClassErr :: TyCon -> SDoc
    assocInClassErr TyCon
    name
     = String -> SDoc
    text String
    "Associated type" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    name) SDoc -> SDoc -> SDoc
    <+>
       String -> SDoc
    text String
    "must be inside a class instance"

    badFamInstDecl :: TyCon -> SDoc
    badFamInstDecl :: TyCon -> SDoc
    badFamInstDecl TyCon
    tc_name
      = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Illegal family instance for" SDoc -> SDoc -> SDoc
    <+>
               SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc_name)
             , ConTag -> SDoc -> SDoc
    nest ConTag
    2 (SDoc -> SDoc
    parens (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "Use TypeFamilies to allow indexed type families") ]

    notOpenFamily :: TyCon -> SDoc
    notOpenFamily :: TyCon -> SDoc
    notOpenFamily TyCon
    tc
      = String -> SDoc
    text String
    "Illegal instance for closed family" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc)