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

    -}

    {-# LANGUAGE CPP, RankNTypes, ScopedTypeVariables #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE ViewPatterns #-}

    module GHC.Tc.Gen.Bind
       ( tcLocalBinds
       , tcTopBinds
       , tcValBinds
       , tcHsBootSigs
       , tcPolyCheck
       , chooseInferredQuantifiers
       , badBootDeclErr
       )
    where

    import GHC.Prelude

    import {-# SOURCE #-} GHC.Tc.Gen.Match ( tcGRHSsPat, tcMatchesFun )
    import {-# SOURCE #-} GHC.Tc.Gen.Expr  ( tcCheckMonoExpr )
    import {-# SOURCE #-} GHC.Tc.TyCl.PatSyn ( tcPatSynDecl, tcPatSynBuilderBind )

    import GHC.Core (Tickish (..))
    import GHC.Types.CostCentre (mkUserCC, CCFlavour(DeclCC))
    import GHC.Driver.Session
    import GHC.Data.FastString
    import GHC.Hs
    import GHC.Tc.Gen.Sig
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Types.Origin
    import GHC.Tc.Utils.Env
    import GHC.Tc.Utils.Unify
    import GHC.Tc.Solver
    import GHC.Tc.Types.Evidence
    import GHC.Tc.Gen.HsType
    import GHC.Tc.Gen.Pat
    import GHC.Tc.Utils.TcMType
    import GHC.Core.Multiplicity
    import GHC.Core.FamInstEnv( normaliseType )
    import GHC.Tc.Instance.Family( tcGetFamInstEnvs )
    import GHC.Core.TyCon
    import GHC.Tc.Utils.TcType
    import GHC.Core.Type (mkStrLitTy, tidyOpenType, splitTyConApp_maybe, mkCastTy)
    import GHC.Builtin.Types.Prim
    import GHC.Builtin.Types( mkBoxedTupleTy )
    import GHC.Types.Id
    import GHC.Types.Var as Var
    import GHC.Types.Var.Set
    import GHC.Types.Var.Env( TidyEnv )
    import GHC.Unit.Module
    import GHC.Types.Name
    import GHC.Types.Name.Set
    import GHC.Types.Name.Env
    import GHC.Types.SrcLoc
    import GHC.Data.Bag
    import GHC.Utils.Error
    import GHC.Data.Graph.Directed
    import GHC.Data.Maybe
    import GHC.Utils.Misc
    import GHC.Types.Basic
    import GHC.Utils.Outputable as Outputable
    import GHC.Builtin.Names( ipClassName )
    import GHC.Tc.Validity (checkValidType)
    import GHC.Types.Unique.FM
    import GHC.Types.Unique.Set
    import qualified GHC.LanguageExtensions as LangExt
    import GHC.Core.ConLike

    import Control.Monad
    import Data.Foldable (find)

    #include "HsVersions.h"

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Type-checking bindings}
    *                                                                      *
    ************************************************************************

    @tcBindsAndThen@ typechecks a @HsBinds@.  The "and then" part is because
    it needs to know something about the {\em usage} of the things bound,
    so that it can create specialisations of them.  So @tcBindsAndThen@
    takes a function which, given an extended environment, E, typechecks
    the scope of the bindings returning a typechecked thing and (most
    important) an LIE.  It is this LIE which is then used as the basis for
    specialising the things bound.

    @tcBindsAndThen@ also takes a "combiner" which glues together the
    bindings and the "thing" to make a new "thing".

    The real work is done by @tcBindWithSigsAndThen@.

    Recursive and non-recursive binds are handled in essentially the same
    way: because of uniques there are no scoping issues left.  The only
    difference is that non-recursive bindings can bind primitive values.

    Even for non-recursive binding groups we add typings for each binder
    to the LVE for the following reason.  When each individual binding is
    checked the type of its LHS is unified with that of its RHS; and
    type-checking the LHS of course requires that the binder is in scope.

    At the top-level the LIE is sure to contain nothing but constant
    dictionaries, which we resolve at the module level.

    Note [Polymorphic recursion]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The game plan for polymorphic recursion in the code above is

            * Bind any variable for which we have a type signature
              to an Id with a polymorphic type.  Then when type-checking
              the RHSs we'll make a full polymorphic call.

    This fine, but if you aren't a bit careful you end up with a horrendous
    amount of partial application and (worse) a huge space leak. For example:

            f :: Eq a => [a] -> [a]
            f xs = ...f...

    If we don't take care, after typechecking we get

            f = /\a -> \d::Eq a -> let f' = f a d
                                   in
                                   \ys:[a] -> ...f'...

    Notice the stupid construction of (f a d), which is of course
    identical to the function we're executing.  In this case, the
    polymorphic recursion isn't being used (but that's a very common case).
    This can lead to a massive space leak, from the following top-level defn
    (post-typechecking)

            ff :: [Int] -> [Int]
            ff = f Int dEqInt

    Now (f dEqInt) evaluates to a lambda that has f' as a free variable; but
    f' is another thunk which evaluates to the same thing... and you end
    up with a chain of identical values all hung onto by the CAF ff.

            ff = f Int dEqInt

               = let f' = f Int dEqInt in \ys. ...f'...

               = let f' = let f' = f Int dEqInt in \ys. ...f'...
                          in \ys. ...f'...

    Etc.

    NOTE: a bit of arity analysis would push the (f a d) inside the (\ys...),
    which would make the space leak go away in this case

    Solution: when typechecking the RHSs we always have in hand the
    *monomorphic* Ids for each binding.  So we just need to make sure that
    if (Method f a d) shows up in the constraints emerging from (...f...)
    we just use the monomorphic Id.  We achieve this by adding monomorphic Ids
    to the "givens" when simplifying constraints.  That's what the "lies_avail"
    is doing.

    Then we get

            f = /\a -> \d::Eq a -> letrec
                                     fm = \ys:[a] -> ...fm...
                                   in
                                   fm
    -}

    tcTopBinds :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn]
               -> TcM (TcGblEnv, TcLclEnv)
    -- The TcGblEnv contains the new tcg_binds and tcg_spects
    -- The TcLclEnv has an extended type envt for the new bindings
    tcTopBinds :: [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [LSig (GhcPass 'Renamed)] -> TcM (TcGblEnv, TcLclEnv)
    tcTopBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds [LSig (GhcPass 'Renamed)]
    sigs
      = do  { -- Pattern synonym bindings populate the global environment
              ([(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    binds', (TcGblEnv
    tcg_env, TcLclEnv
    tcl_env)) <- TopLevelFlag
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [LSig (GhcPass 'Renamed)]
    -> TcM (TcGblEnv, TcLclEnv)
    -> TcM
         ([(RecFlag, LHsBinds (GhcPass 'Typechecked))],
          (TcGblEnv, TcLclEnv))
    forall thing.
    TopLevelFlag
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [LSig (GhcPass 'Renamed)]
    -> TcM thing
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    tcValBinds TopLevelFlag
    TopLevel [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds [LSig (GhcPass 'Renamed)]
    sigs (TcM (TcGblEnv, TcLclEnv)
     -> TcM
          ([(RecFlag, LHsBinds (GhcPass 'Typechecked))],
           (TcGblEnv, TcLclEnv)))
    -> TcM (TcGblEnv, TcLclEnv)
    -> TcM
         ([(RecFlag, LHsBinds (GhcPass 'Typechecked))],
          (TcGblEnv, TcLclEnv))
    forall a b. (a -> b) -> a -> b
    $
                do { TcGblEnv
    gbl <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
                   ; TcLclEnv
    lcl <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
                   ; (TcGblEnv, TcLclEnv) -> TcM (TcGblEnv, TcLclEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    gbl, TcLclEnv
    lcl) }
            ; [LTcSpecPrag]
    specs <- [LSig (GhcPass 'Renamed)] -> TcM [LTcSpecPrag]
    tcImpPrags [LSig (GhcPass 'Renamed)]
    sigs   -- SPECIALISE prags for imported Ids

            ; [CompleteMatch]
    complete_matches <- (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv [CompleteMatch]
    -> TcRnIf TcGblEnv TcLclEnv [CompleteMatch]
    forall gbl' lcl' a gbl lcl.
    (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
    setEnvs (TcGblEnv
    tcg_env, TcLclEnv
    tcl_env) (TcRnIf TcGblEnv TcLclEnv [CompleteMatch]
     -> TcRnIf TcGblEnv TcLclEnv [CompleteMatch])
    -> TcRnIf TcGblEnv TcLclEnv [CompleteMatch]
    -> TcRnIf TcGblEnv TcLclEnv [CompleteMatch]
    forall a b. (a -> b) -> a -> b
    $ [LSig (GhcPass 'Renamed)]
    -> TcRnIf TcGblEnv TcLclEnv [CompleteMatch]
    tcCompleteSigs [LSig (GhcPass 'Renamed)]
    sigs
            ; String -> SDoc -> TcRn ()
    traceTc String
    "complete_matches" ([(RecFlag, LHsBinds (GhcPass 'Renamed))] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds SDoc -> SDoc -> SDoc
    $$ [LSig (GhcPass 'Renamed)] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [LSig (GhcPass 'Renamed)]
    sigs)
            ; String -> SDoc -> TcRn ()
    traceTc String
    "complete_matches" ([CompleteMatch] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [CompleteMatch]
    complete_matches)

            ; let { tcg_env' :: TcGblEnv
    tcg_env' = TcGblEnv
    tcg_env { tcg_imp_specs :: [LTcSpecPrag]
    tcg_imp_specs
                                          = [LTcSpecPrag]
    specs [LTcSpecPrag] -> [LTcSpecPrag] -> [LTcSpecPrag]
    forall a. [a] -> [a] -> [a]
    ++ TcGblEnv -> [LTcSpecPrag]
    tcg_imp_specs TcGblEnv
    tcg_env
                                       , tcg_complete_matches :: [CompleteMatch]
    tcg_complete_matches
                                          = [CompleteMatch]
    complete_matches
                                              [CompleteMatch] -> [CompleteMatch] -> [CompleteMatch]
    forall a. [a] -> [a] -> [a]
    ++ TcGblEnv -> [CompleteMatch]
    tcg_complete_matches TcGblEnv
    tcg_env }
                               TcGblEnv -> [LHsBinds (GhcPass 'Typechecked)] -> TcGblEnv
    `addTypecheckedBinds` ((RecFlag, LHsBinds (GhcPass 'Typechecked))
     -> LHsBinds (GhcPass 'Typechecked))
    -> [(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    -> [LHsBinds (GhcPass 'Typechecked)]
    forall a b. (a -> b) -> [a] -> [b]
    map (RecFlag, LHsBinds (GhcPass 'Typechecked))
    -> LHsBinds (GhcPass 'Typechecked)
    forall a b. (a, b) -> b
    snd [(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    binds' }

            ; (TcGblEnv, TcLclEnv) -> TcM (TcGblEnv, TcLclEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    tcg_env', TcLclEnv
    tcl_env) }
            -- The top level bindings are flattened into a giant
            -- implicitly-mutually-recursive LHsBinds

    -- Note [Typechecking Complete Matches]
    -- Much like when a user bundled a pattern synonym, the result types of
    -- all the constructors in the match pragma must be consistent.
    --
    -- If we allowed pragmas with inconsistent types then it would be
    -- impossible to ever match every constructor in the list and so
    -- the pragma would be useless.

    -- This is only used in `tcCompleteSig`. We fold over all the conlikes,
    -- this accumulator keeps track of the first `ConLike` with a concrete
    -- return type. After fixing the return type, all other constructors with
    -- a fixed return type must agree with this.
    --
    -- The fields of `Fixed` cache the first conlike and its return type so
    -- that we can compare all the other conlikes to it. The conlike is
    -- stored for error messages.
    --
    -- `Nothing` in the case that the type is fixed by a type signature
    data CompleteSigType = AcceptAny | Fixed (Maybe ConLike) TyCon

    tcCompleteSigs  :: [LSig GhcRn] -> TcM [CompleteMatch]
    tcCompleteSigs :: [LSig (GhcPass 'Renamed)]
    -> TcRnIf TcGblEnv TcLclEnv [CompleteMatch]
    tcCompleteSigs [LSig (GhcPass 'Renamed)]
    sigs =
      let
          doOne :: Sig GhcRn -> TcM (Maybe CompleteMatch)
          doOne :: Sig (GhcPass 'Renamed) -> TcM (Maybe CompleteMatch)
    doOne c :: Sig (GhcPass 'Renamed)
    c@(CompleteMatchSig XCompleteMatchSig (GhcPass 'Renamed)
    _ SourceText
    _ Located [Located (IdP (GhcPass 'Renamed))]
    lns Maybe (Located (IdP (GhcPass 'Renamed)))
    mtc)
            = (CompleteMatch -> Maybe CompleteMatch)
    -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    -> TcM (Maybe CompleteMatch)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap CompleteMatch -> Maybe CompleteMatch
    forall a. a -> Maybe a
    Just (IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
     -> TcM (Maybe CompleteMatch))
    -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    -> TcM (Maybe CompleteMatch)
    forall a b. (a -> b) -> a -> b
    $ do
               SDoc
    -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (String -> SDoc
    text String
    "In" SDoc -> SDoc -> SDoc
    <+> Sig (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Sig (GhcPass 'Renamed)
    c) (IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
     -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch)
    -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    forall a b. (a -> b) -> a -> b
    $
                case Maybe (Located (IdP (GhcPass 'Renamed)))
    mtc of
                  Maybe (Located (IdP (GhcPass 'Renamed)))
    Nothing -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    infer_complete_match
                  Just Located (IdP (GhcPass 'Renamed))
    tc -> Located Name -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    check_complete_match Located Name
    Located (IdP (GhcPass 'Renamed))
    tc
            where

              checkCLTypes :: CompleteSigType
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    checkCLTypes CompleteSigType
    acc = ((CompleteSigType, [ConLike])
     -> Located Name
     -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike]))
    -> (CompleteSigType, [ConLike])
    -> [Located Name]
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldM (CompleteSigType, [ConLike])
    -> Located Name
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    checkCLType (CompleteSigType
    acc, []) (GenLocated SrcSpan [Located Name] -> [Located Name]
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpan [Located Name]
    Located [Located (IdP (GhcPass 'Renamed))]
    lns)

              infer_complete_match :: IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    infer_complete_match = do
                (CompleteSigType
    res, [ConLike]
    cls) <- CompleteSigType
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    checkCLTypes CompleteSigType
    AcceptAny
                case CompleteSigType
    res of
                  CompleteSigType
    AcceptAny -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    forall a. SDoc -> TcM a
    failWithTc SDoc
    ambiguousError
                  Fixed Maybe ConLike
    _ TyCon
    tc  -> CompleteMatch -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CompleteMatch -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch)
    -> CompleteMatch -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    forall a b. (a -> b) -> a -> b
    $ [ConLike] -> TyCon -> CompleteMatch
    mkMatch [ConLike]
    cls TyCon
    tc

              check_complete_match :: Located Name -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    check_complete_match Located Name
    tc_name = do
                TyCon
    ty_con <- Located Name -> TcM TyCon
    tcLookupLocatedTyCon Located Name
    tc_name
                (CompleteSigType
    _, [ConLike]
    cls) <- CompleteSigType
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    checkCLTypes (Maybe ConLike -> TyCon -> CompleteSigType
    Fixed Maybe ConLike
    forall a. Maybe a
    Nothing TyCon
    ty_con)
                CompleteMatch -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CompleteMatch -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch)
    -> CompleteMatch -> IOEnv (Env TcGblEnv TcLclEnv) CompleteMatch
    forall a b. (a -> b) -> a -> b
    $ [ConLike] -> TyCon -> CompleteMatch
    mkMatch [ConLike]
    cls TyCon
    ty_con

              mkMatch :: [ConLike] -> TyCon -> CompleteMatch
              mkMatch :: [ConLike] -> TyCon -> CompleteMatch
    mkMatch [ConLike]
    cls TyCon
    ty_con = CompleteMatch :: [Name] -> Name -> CompleteMatch
    CompleteMatch {
                -- foldM is a left-fold and will have accumulated the ConLikes in
                -- the reverse order. foldrM would accumulate in the correct order,
                -- but would type-check the last ConLike first, which might also be
                -- confusing from the user's perspective. Hence reverse here.
                completeMatchConLikes :: [Name]
    completeMatchConLikes = [Name] -> [Name]
    forall a. [a] -> [a]
    reverse ((ConLike -> Name) -> [ConLike] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map ConLike -> Name
    conLikeName [ConLike]
    cls),
                completeMatchTyCon :: Name
    completeMatchTyCon = TyCon -> Name
    tyConName TyCon
    ty_con
                }
          doOne Sig (GhcPass 'Renamed)
    _ = Maybe CompleteMatch -> TcM (Maybe CompleteMatch)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe CompleteMatch
    forall a. Maybe a
    Nothing

          ambiguousError :: SDoc
          ambiguousError :: SDoc
    ambiguousError =
            String -> SDoc
    text String
    "A type signature must be provided for a set of polymorphic"
              SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "pattern synonyms."

          -- See note [Typechecking Complete Matches]
          checkCLType :: (CompleteSigType, [ConLike]) -> Located Name
                      -> TcM (CompleteSigType, [ConLike])
          checkCLType :: (CompleteSigType, [ConLike])
    -> Located Name
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    checkCLType (CompleteSigType
    cst, [ConLike]
    cs) Located Name
    n = do
            ConLike
    cl <- (Name -> TcM ConLike) -> Located Name -> TcM ConLike
    forall a b. (a -> TcM b) -> Located a -> TcM b
    addLocM Name -> TcM ConLike
    tcLookupConLike Located Name
    n
            let   ([TcId]
    _,[TcId]
    _,[EqSpec]
    _,TcThetaType
    _,TcThetaType
    _,[Scaled Kind]
    _, Kind
    res_ty) = ConLike
    -> ([TcId], [TcId], [EqSpec], TcThetaType, TcThetaType,
        [Scaled Kind], Kind)
    conLikeFullSig ConLike
    cl
                  res_ty_con :: Maybe TyCon
    res_ty_con = (TyCon, TcThetaType) -> TyCon
    forall a b. (a, b) -> a
    fst ((TyCon, TcThetaType) -> TyCon)
    -> Maybe (TyCon, TcThetaType) -> Maybe TyCon
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HasDebugCallStack => Kind -> Maybe (TyCon, TcThetaType)
    Kind -> Maybe (TyCon, TcThetaType)
    splitTyConApp_maybe Kind
    res_ty
            case (CompleteSigType
    cst, Maybe TyCon
    res_ty_con) of
              (CompleteSigType
    AcceptAny, Maybe TyCon
    Nothing) -> (CompleteSigType, [ConLike])
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CompleteSigType
    AcceptAny, ConLike
    clConLike -> [ConLike] -> [ConLike]
    forall a. a -> [a] -> [a]
    :[ConLike]
    cs)
              (CompleteSigType
    AcceptAny, Just TyCon
    tc) -> (CompleteSigType, [ConLike])
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ConLike -> TyCon -> CompleteSigType
    Fixed (ConLike -> Maybe ConLike
    forall a. a -> Maybe a
    Just ConLike
    cl) TyCon
    tc, ConLike
    clConLike -> [ConLike] -> [ConLike]
    forall a. a -> [a] -> [a]
    :[ConLike]
    cs)
              (Fixed Maybe ConLike
    mfcl TyCon
    tc, Maybe TyCon
    Nothing)  -> (CompleteSigType, [ConLike])
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ConLike -> TyCon -> CompleteSigType
    Fixed Maybe ConLike
    mfcl TyCon
    tc, ConLike
    clConLike -> [ConLike] -> [ConLike]
    forall a. a -> [a] -> [a]
    :[ConLike]
    cs)
              (Fixed Maybe ConLike
    mfcl TyCon
    tc, Just TyCon
    tc') ->
                if TyCon
    tc TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    tc'
                  then (CompleteSigType, [ConLike])
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ConLike -> TyCon -> CompleteSigType
    Fixed Maybe ConLike
    mfcl TyCon
    tc, ConLike
    clConLike -> [ConLike] -> [ConLike]
    forall a. a -> [a] -> [a]
    :[ConLike]
    cs)
                  else case Maybe ConLike
    mfcl of
                         Maybe ConLike
    Nothing ->
                          SDoc
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (String -> SDoc
    text String
    "In" SDoc -> SDoc -> SDoc
    <+> ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ConLike
    cl) (IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
     -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike]))
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    forall a b. (a -> b) -> a -> b
    $
                            SDoc -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    forall a. SDoc -> TcM a
    failWithTc SDoc
    typeSigErrMsg
                         Just ConLike
    cl -> SDoc -> IOEnv (Env TcGblEnv TcLclEnv) (CompleteSigType, [ConLike])
    forall a. SDoc -> TcM a
    failWithTc (ConLike -> SDoc
    errMsg ConLike
    cl)
                 where
                  typeSigErrMsg :: SDoc
                  typeSigErrMsg :: SDoc
    typeSigErrMsg =
                    String -> SDoc
    text String
    "Couldn't match expected type"
                          SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc)
                          SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "with"
                          SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc')

                  errMsg :: ConLike -> SDoc
                  errMsg :: ConLike -> SDoc
    errMsg ConLike
    fcl =
                    String -> SDoc
    text String
    "Cannot form a group of complete patterns from patterns"
                      SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ConLike
    fcl) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "and" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (ConLike -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ConLike
    cl)
                      SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "as they match different type constructors"
                      SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    parens (SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc)
                                   SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "resp."
                                   SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc'))
      -- For some reason I haven't investigated further, the signatures come in
      -- backwards wrt. declaration order. So we reverse them here, because it makes
      -- a difference for incomplete match suggestions.
      in  (LSig (GhcPass 'Renamed) -> TcM (Maybe CompleteMatch))
    -> [LSig (GhcPass 'Renamed)]
    -> TcRnIf TcGblEnv TcLclEnv [CompleteMatch]
    forall (m :: * -> *) a b.
    Applicative m =>
    (a -> m (Maybe b)) -> [a] -> m [b]
    mapMaybeM ((Sig (GhcPass 'Renamed) -> TcM (Maybe CompleteMatch))
    -> LSig (GhcPass 'Renamed) -> TcM (Maybe CompleteMatch)
    forall a b. (a -> TcM b) -> Located a -> TcM b
    addLocM Sig (GhcPass 'Renamed) -> TcM (Maybe CompleteMatch)
    doOne) ([LSig (GhcPass 'Renamed)] -> [LSig (GhcPass 'Renamed)]
    forall a. [a] -> [a]
    reverse [LSig (GhcPass 'Renamed)]
    sigs) -- process in declaration order

    tcHsBootSigs :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM [Id]
    -- A hs-boot file has only one BindGroup, and it only has type
    -- signatures in it.  The renamer checked all this
    tcHsBootSigs :: [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [LSig (GhcPass 'Renamed)] -> TcM [TcId]
    tcHsBootSigs [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds [LSig (GhcPass 'Renamed)]
    sigs
      = do  { Bool -> SDoc -> TcRn ()
    checkTc ([(RecFlag, LHsBinds (GhcPass 'Renamed))] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds) SDoc
    badBootDeclErr
            ; (LSig (GhcPass 'Renamed) -> TcM [TcId])
    -> [LSig (GhcPass 'Renamed)] -> TcM [TcId]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    concatMapM ((Sig (GhcPass 'Renamed) -> TcM [TcId])
    -> LSig (GhcPass 'Renamed) -> TcM [TcId]
    forall a b. (a -> TcM b) -> Located a -> TcM b
    addLocM Sig (GhcPass 'Renamed) -> TcM [TcId]
    tc_boot_sig) ((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
    isTypeLSig [LSig (GhcPass 'Renamed)]
    sigs) }
      where
        tc_boot_sig :: Sig (GhcPass 'Renamed) -> TcM [TcId]
    tc_boot_sig (TypeSig XTypeSig (GhcPass 'Renamed)
    _ [Located (IdP (GhcPass 'Renamed))]
    lnames LHsSigWcType (GhcPass 'Renamed)
    hs_ty) = (Located Name -> IOEnv (Env TcGblEnv TcLclEnv) TcId)
    -> [Located Name] -> TcM [TcId]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Located Name -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    f [Located Name]
    [Located (IdP (GhcPass 'Renamed))]
    lnames
          where
            f :: Located Name -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    f (L SrcSpan
    _ Name
    name)
              = do { Kind
    sigma_ty <- UserTypeCtxt -> LHsSigWcType (GhcPass 'Renamed) -> TcM Kind
    tcHsSigWcType (Name -> Bool -> UserTypeCtxt
    FunSigCtxt Name
    name Bool
    False) LHsSigWcType (GhcPass 'Renamed)
    hs_ty
                   ; TcId -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> Kind -> TcId
    mkVanillaGlobal Name
    name Kind
    sigma_ty) }
            -- Notice that we make GlobalIds, not LocalIds
        tc_boot_sig Sig (GhcPass 'Renamed)
    s = String -> SDoc -> TcM [TcId]
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcHsBootSigs/tc_boot_sig" (Sig (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Sig (GhcPass 'Renamed)
    s)

    badBootDeclErr :: MsgDoc
    badBootDeclErr :: SDoc
    badBootDeclErr = String -> SDoc
    text String
    "Illegal declarations in an hs-boot file"

    ------------------------
    tcLocalBinds :: HsLocalBinds GhcRn -> TcM thing
                 -> TcM (HsLocalBinds GhcTc, thing)

    tcLocalBinds :: forall thing.
    HsLocalBinds (GhcPass 'Renamed)
    -> TcM thing -> TcM (HsLocalBinds (GhcPass 'Typechecked), thing)
    tcLocalBinds (EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
    x) TcM thing
    thing_inside
      = do  { thing
    thing <- TcM thing
    thing_inside
            ; (HsLocalBinds (GhcPass 'Typechecked), thing)
    -> TcM (HsLocalBinds (GhcPass 'Typechecked), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XEmptyLocalBinds (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> HsLocalBinds (GhcPass 'Typechecked)
    forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
    EmptyLocalBinds XEmptyLocalBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
    XEmptyLocalBinds (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    x, thing
    thing) }

    tcLocalBinds (HsValBinds XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
    x (XValBindsLR (NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds [LSig (GhcPass 'Renamed)]
    sigs))) TcM thing
    thing_inside
      = do  { ([(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    binds', thing
    thing) <- TopLevelFlag
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [LSig (GhcPass 'Renamed)]
    -> TcM thing
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    forall thing.
    TopLevelFlag
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [LSig (GhcPass 'Renamed)]
    -> TcM thing
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    tcValBinds TopLevelFlag
    NotTopLevel [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds [LSig (GhcPass 'Renamed)]
    sigs TcM thing
    thing_inside
            ; (HsLocalBinds (GhcPass 'Typechecked), thing)
    -> TcM (HsLocalBinds (GhcPass 'Typechecked), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XHsValBinds (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> HsValBindsLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> HsLocalBinds (GhcPass 'Typechecked)
    forall idL idR.
    XHsValBinds idL idR
    -> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
    HsValBinds XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
    XHsValBinds (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    x (XXValBindsLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> HsValBindsLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
    XValBindsLR ([(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    -> [LSig (GhcPass 'Renamed)]
    -> NHsValBindsLR (GhcPass 'Typechecked)
    forall idL.
    [(RecFlag, LHsBinds idL)]
    -> [LSig (GhcPass 'Renamed)] -> NHsValBindsLR idL
    NValBinds [(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    binds' [LSig (GhcPass 'Renamed)]
    sigs)), thing
    thing) }
    tcLocalBinds (HsValBinds XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
    _ (ValBinds {})) TcM thing
    _ = String -> TcM (HsLocalBinds (GhcPass 'Typechecked), thing)
    forall a. String -> a
    panic String
    "tcLocalBinds"

    tcLocalBinds (HsIPBinds XHsIPBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
    x (IPBinds XIPBinds (GhcPass 'Renamed)
    _ [LIPBind (GhcPass 'Renamed)]
    ip_binds)) TcM thing
    thing_inside
      = do  { Class
    ipClass <- Name -> TcM Class
    tcLookupClass Name
    ipClassName
            ; ([TcId]
    given_ips, [Located (IPBind (GhcPass 'Typechecked))]
    ip_binds') <-
                (LIPBind (GhcPass 'Renamed)
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (TcId, Located (IPBind (GhcPass 'Typechecked))))
    -> [LIPBind (GhcPass 'Renamed)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([TcId], [Located (IPBind (GhcPass 'Typechecked))])
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> m (b, c)) -> [a] -> m ([b], [c])
    mapAndUnzipM ((IPBind (GhcPass 'Renamed)
     -> TcM (TcId, IPBind (GhcPass 'Typechecked)))
    -> LIPBind (GhcPass 'Renamed)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (TcId, Located (IPBind (GhcPass 'Typechecked)))
    forall a b c. (a -> TcM (b, c)) -> Located a -> TcM (b, Located c)
    wrapLocSndM (Class
    -> IPBind (GhcPass 'Renamed)
    -> TcM (TcId, IPBind (GhcPass 'Typechecked))
    tc_ip_bind Class
    ipClass)) [LIPBind (GhcPass 'Renamed)]
    ip_binds

            -- If the binding binds ?x = E, we  must now
            -- discharge any ?x constraints in expr_lie
            -- See Note [Implicit parameter untouchables]
            ; (TcEvBinds
    ev_binds, thing
    result) <- SkolemInfo
    -> [TcId] -> [TcId] -> TcM thing -> TcM (TcEvBinds, thing)
    forall result.
    SkolemInfo
    -> [TcId] -> [TcId] -> TcM result -> TcM (TcEvBinds, result)
    checkConstraints ([HsIPName] -> SkolemInfo
    IPSkol [HsIPName]
    ips)
                                      [] [TcId]
    given_ips TcM thing
    thing_inside

            ; (HsLocalBinds (GhcPass 'Typechecked), thing)
    -> TcM (HsLocalBinds (GhcPass 'Typechecked), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XHsIPBinds (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> HsIPBinds (GhcPass 'Typechecked)
    -> HsLocalBinds (GhcPass 'Typechecked)
    forall idL idR.
    XHsIPBinds idL idR -> HsIPBinds idR -> HsLocalBindsLR idL idR
    HsIPBinds XHsIPBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
    XHsIPBinds (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    x (XIPBinds (GhcPass 'Typechecked)
    -> [Located (IPBind (GhcPass 'Typechecked))]
    -> HsIPBinds (GhcPass 'Typechecked)
    forall id. XIPBinds id -> [LIPBind id] -> HsIPBinds id
    IPBinds XIPBinds (GhcPass 'Typechecked)
    TcEvBinds
    ev_binds [Located (IPBind (GhcPass 'Typechecked))]
    ip_binds') , thing
    result) }
      where
        ips :: [HsIPName]
    ips = [HsIPName
    ip | (L SrcSpan
    _ (IPBind XCIPBind (GhcPass 'Renamed)
    _ (Left (L SrcSpan
    _ HsIPName
    ip)) LHsExpr (GhcPass 'Renamed)
    _)) <- [LIPBind (GhcPass 'Renamed)]
    ip_binds]

            -- I wonder if we should do these one at a time
            -- Consider     ?x = 4
            --              ?y = ?x + 1
        tc_ip_bind :: Class
    -> IPBind (GhcPass 'Renamed)
    -> TcM (TcId, IPBind (GhcPass 'Typechecked))
    tc_ip_bind Class
    ipClass (IPBind XCIPBind (GhcPass 'Renamed)
    _ (Left (L SrcSpan
    _ HsIPName
    ip)) LHsExpr (GhcPass 'Renamed)
    expr)
           = do { Kind
    ty <- TcM Kind
    newOpenFlexiTyVarTy
                ; let p :: Kind
    p = FastString -> Kind
    mkStrLitTy (FastString -> Kind) -> FastString -> Kind
    forall a b. (a -> b) -> a -> b
    $ HsIPName -> FastString
    hsIPNameFS HsIPName
    ip
                ; TcId
    ip_id <- Class -> TcThetaType -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    newDict Class
    ipClass [ Kind
    p, Kind
    ty ]
                ; LHsExpr (GhcPass 'Typechecked)
    expr' <- LHsExpr (GhcPass 'Renamed)
    -> Kind -> TcM (LHsExpr (GhcPass 'Typechecked))
    tcCheckMonoExpr LHsExpr (GhcPass 'Renamed)
    expr Kind
    ty
                ; let d :: LHsExpr (GhcPass 'Typechecked)
    d = Class
    -> Kind
    -> Kind
    -> HsExpr (GhcPass 'Typechecked)
    -> HsExpr (GhcPass 'Typechecked)
    toDict Class
    ipClass Kind
    p Kind
    ty (HsExpr (GhcPass 'Typechecked) -> HsExpr (GhcPass 'Typechecked))
    -> LHsExpr (GhcPass 'Typechecked) -> LHsExpr (GhcPass 'Typechecked)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` LHsExpr (GhcPass 'Typechecked)
    expr'
                ; (TcId, IPBind (GhcPass 'Typechecked))
    -> TcM (TcId, IPBind (GhcPass 'Typechecked))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcId
    ip_id, (XCIPBind (GhcPass 'Typechecked)
    -> Either (Located HsIPName) (IdP (GhcPass 'Typechecked))
    -> LHsExpr (GhcPass 'Typechecked)
    -> IPBind (GhcPass 'Typechecked)
    forall id.
    XCIPBind id
    -> Either (Located HsIPName) (IdP id) -> LHsExpr id -> IPBind id
    IPBind NoExtField
    XCIPBind (GhcPass 'Typechecked)
    noExtField (TcId -> Either (Located HsIPName) TcId
    forall a b. b -> Either a b
    Right TcId
    ip_id) LHsExpr (GhcPass 'Typechecked)
    d)) }
        tc_ip_bind Class
    _ (IPBind XCIPBind (GhcPass 'Renamed)
    _ (Right {}) LHsExpr (GhcPass 'Renamed)
    _) = String -> TcM (TcId, IPBind (GhcPass 'Typechecked))
    forall a. String -> a
    panic String
    "tc_ip_bind"

        -- Coerces a `t` into a dictionary for `IP "x" t`.
        -- co : t -> IP "x" t
        toDict :: Class
    -> Kind
    -> Kind
    -> HsExpr (GhcPass 'Typechecked)
    -> HsExpr (GhcPass 'Typechecked)
    toDict Class
    ipClass Kind
    x Kind
    ty = HsWrapper
    -> HsExpr (GhcPass 'Typechecked) -> HsExpr (GhcPass 'Typechecked)
    mkHsWrap (HsWrapper
     -> HsExpr (GhcPass 'Typechecked) -> HsExpr (GhcPass 'Typechecked))
    -> HsWrapper
    -> HsExpr (GhcPass 'Typechecked)
    -> HsExpr (GhcPass 'Typechecked)
    forall a b. (a -> b) -> a -> b
    $ TcCoercionR -> HsWrapper
    mkWpCastR (TcCoercionR -> HsWrapper) -> TcCoercionR -> HsWrapper
    forall a b. (a -> b) -> a -> b
    $
                              Kind -> TcCoercionR
    wrapIP (Kind -> TcCoercionR) -> Kind -> TcCoercionR
    forall a b. (a -> b) -> a -> b
    $ Class -> TcThetaType -> Kind
    mkClassPred Class
    ipClass [Kind
    x,Kind
    ty]

    {- Note [Implicit parameter untouchables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We add the type variables in the types of the implicit parameters
    as untouchables, not so much because we really must not unify them,
    but rather because we otherwise end up with constraints like this
        Num alpha, Implic { wanted = alpha ~ Int }
    The constraint solver solves alpha~Int by unification, but then
    doesn't float that solved constraint out (it's not an unsolved
    wanted).  Result disaster: the (Num alpha) is again solved, this
    time by defaulting.  No no no.

    However [Oct 10] this is all handled automatically by the
    untouchable-range idea.
    -}

    tcValBinds :: TopLevelFlag
               -> [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn]
               -> TcM thing
               -> TcM ([(RecFlag, LHsBinds GhcTc)], thing)

    tcValBinds :: forall thing.
    TopLevelFlag
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [LSig (GhcPass 'Renamed)]
    -> TcM thing
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    tcValBinds TopLevelFlag
    top_lvl [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds [LSig (GhcPass 'Renamed)]
    sigs TcM thing
    thing_inside
      = do  {   -- Typecheck the signatures
                -- It's easier to do so now, once for all the SCCs together
                -- because a single signature  f,g :: <type>
                -- might relate to more than one SCC
              ([TcId]
    poly_ids, TcSigFun
    sig_fn) <- [PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)]
    -> TcM ([TcId], TcSigFun) -> TcM ([TcId], TcSigFun)
    forall a.
    [PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)]
    -> TcM a -> TcM a
    tcAddPatSynPlaceholders [PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)]
    patsyns (TcM ([TcId], TcSigFun) -> TcM ([TcId], TcSigFun))
    -> TcM ([TcId], TcSigFun) -> TcM ([TcId], TcSigFun)
    forall a b. (a -> b) -> a -> b
    $
                                    [LSig (GhcPass 'Renamed)] -> TcM ([TcId], TcSigFun)
    tcTySigs [LSig (GhcPass 'Renamed)]
    sigs

            -- Extend the envt right away with all the Ids
            --   declared with complete type signatures
            -- Do not extend the TcBinderStack; instead
            --   we extend it on a per-rhs basis in tcExtendForRhs
            --   See Note [Relevant bindings and the binder stack]
            --
            -- For the moment, let bindings and top-level bindings introduce
            -- only unrestricted variables.
            ; TopLevelFlag
    -> [TcId]
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    forall a. TopLevelFlag -> [TcId] -> TcM a -> TcM a
    tcExtendSigIds TopLevelFlag
    top_lvl [TcId]
    poly_ids (TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
     -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing))
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    forall a b. (a -> b) -> a -> b
    $
         do { ([(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    binds', ([(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    extra_binds', thing
    thing))
                  <- TopLevelFlag
    -> TcSigFun
    -> TcPragEnv
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    -> TcM
         ([(RecFlag, LHsBinds (GhcPass 'Typechecked))],
          ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing))
    forall thing.
    TopLevelFlag
    -> TcSigFun
    -> TcPragEnv
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> TcM thing
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    tcBindGroups TopLevelFlag
    top_lvl TcSigFun
    sig_fn TcPragEnv
    prag_fn [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds (TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
     -> TcM
          ([(RecFlag, LHsBinds (GhcPass 'Typechecked))],
           ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)))
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    -> TcM
         ([(RecFlag, LHsBinds (GhcPass 'Typechecked))],
          ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing))
    forall a b. (a -> b) -> a -> b
    $
                     do { thing
    thing <- TcM thing
    thing_inside
                           -- See Note [Pattern synonym builders don't yield dependencies]
                           --     in GHC.Rename.Bind
                        ; [LHsBinds (GhcPass 'Typechecked)]
    patsyn_builders <- (PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
     -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBinds (GhcPass 'Typechecked)))
    -> [PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [LHsBinds (GhcPass 'Typechecked)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> IOEnv (Env TcGblEnv TcLclEnv) (LHsBinds (GhcPass 'Typechecked))
    tcPatSynBuilderBind [PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)]
    patsyns
                        ; let extra_binds :: [(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    extra_binds = [ (RecFlag
    NonRecursive, LHsBinds (GhcPass 'Typechecked)
    builder)
                                            | LHsBinds (GhcPass 'Typechecked)
    builder <- [LHsBinds (GhcPass 'Typechecked)]
    patsyn_builders ]
                        ; ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    extra_binds, thing
    thing) }
            ; ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    binds' [(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    -> [(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    -> [(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    forall a. [a] -> [a] -> [a]
    ++ [(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    extra_binds', thing
    thing) }}
      where
        patsyns :: [PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)]
    patsyns = [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)]
    forall id. [(RecFlag, LHsBinds id)] -> [PatSynBind id id]
    getPatSynBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds
        prag_fn :: TcPragEnv
    prag_fn = [LSig (GhcPass 'Renamed)]
    -> LHsBinds (GhcPass 'Renamed) -> TcPragEnv
    mkPragEnv [LSig (GhcPass 'Renamed)]
    sigs (((RecFlag, LHsBinds (GhcPass 'Renamed))
     -> LHsBinds (GhcPass 'Renamed) -> LHsBinds (GhcPass 'Renamed))
    -> LHsBinds (GhcPass 'Renamed)
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> LHsBinds (GhcPass 'Renamed)
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (LHsBinds (GhcPass 'Renamed)
    -> LHsBinds (GhcPass 'Renamed) -> LHsBinds (GhcPass 'Renamed)
    forall a. Bag a -> Bag a -> Bag a
    unionBags (LHsBinds (GhcPass 'Renamed)
     -> LHsBinds (GhcPass 'Renamed) -> LHsBinds (GhcPass 'Renamed))
    -> ((RecFlag, LHsBinds (GhcPass 'Renamed))
        -> LHsBinds (GhcPass 'Renamed))
    -> (RecFlag, LHsBinds (GhcPass 'Renamed))
    -> LHsBinds (GhcPass 'Renamed)
    -> LHsBinds (GhcPass 'Renamed)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (RecFlag, LHsBinds (GhcPass 'Renamed))
    -> LHsBinds (GhcPass 'Renamed)
    forall a b. (a, b) -> b
    snd) LHsBinds (GhcPass 'Renamed)
    forall a. Bag a
    emptyBag [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds)

    ------------------------
    tcBindGroups :: TopLevelFlag -> TcSigFun -> TcPragEnv
                 -> [(RecFlag, LHsBinds GhcRn)] -> TcM thing
                 -> TcM ([(RecFlag, LHsBinds GhcTc)], thing)
    -- Typecheck a whole lot of value bindings,
    -- one strongly-connected component at a time
    -- Here a "strongly connected component" has the straightforward
    -- meaning of a group of bindings that mention each other,
    -- ignoring type signatures (that part comes later)

    tcBindGroups :: forall thing.
    TopLevelFlag
    -> TcSigFun
    -> TcPragEnv
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> TcM thing
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    tcBindGroups TopLevelFlag
    _ TcSigFun
    _ TcPragEnv
    _ [] TcM thing
    thing_inside
      = do  { thing
    thing <- TcM thing
    thing_inside
            ; ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], thing
    thing) }

    tcBindGroups TopLevelFlag
    top_lvl TcSigFun
    sig_fn TcPragEnv
    prag_fn ((RecFlag, LHsBinds (GhcPass 'Renamed))
    group : [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    groups) TcM thing
    thing_inside
      = do  { -- See Note [Closed binder groups]
              TcTypeEnv
    type_env <- TcM TcTypeEnv
    getLclTypeEnv
            ; let closed :: IsGroupClosed
    closed = TcTypeEnv -> LHsBinds (GhcPass 'Renamed) -> IsGroupClosed
    isClosedBndrGroup TcTypeEnv
    type_env ((RecFlag, LHsBinds (GhcPass 'Renamed))
    -> LHsBinds (GhcPass 'Renamed)
    forall a b. (a, b) -> b
    snd (RecFlag, LHsBinds (GhcPass 'Renamed))
    group)
            ; ([(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    group', ([(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    groups', thing
    thing))
                    <- TopLevelFlag
    -> TcSigFun
    -> TcPragEnv
    -> (RecFlag, LHsBinds (GhcPass 'Renamed))
    -> IsGroupClosed
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    -> TcM
         ([(RecFlag, LHsBinds (GhcPass 'Typechecked))],
          ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing))
    forall thing.
    TopLevelFlag
    -> TcSigFun
    -> TcPragEnv
    -> (RecFlag, LHsBinds (GhcPass 'Renamed))
    -> IsGroupClosed
    -> TcM thing
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    tc_group TopLevelFlag
    top_lvl TcSigFun
    sig_fn TcPragEnv
    prag_fn (RecFlag, LHsBinds (GhcPass 'Renamed))
    group IsGroupClosed
    closed (TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
     -> TcM
          ([(RecFlag, LHsBinds (GhcPass 'Typechecked))],
           ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)))
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    -> TcM
         ([(RecFlag, LHsBinds (GhcPass 'Typechecked))],
          ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing))
    forall a b. (a -> b) -> a -> b
    $
                       TopLevelFlag
    -> TcSigFun
    -> TcPragEnv
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> TcM thing
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    forall thing.
    TopLevelFlag
    -> TcSigFun
    -> TcPragEnv
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> TcM thing
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    tcBindGroups TopLevelFlag
    top_lvl TcSigFun
    sig_fn TcPragEnv
    prag_fn [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    groups TcM thing
    thing_inside
            ; ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    group' [(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    -> [(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    -> [(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    forall a. [a] -> [a] -> [a]
    ++ [(RecFlag, LHsBinds (GhcPass 'Typechecked))]
    groups', thing
    thing) }

    -- Note [Closed binder groups]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    --
    --  A mutually recursive group is "closed" if all of the free variables of
    --  the bindings are closed. For example
    --
    -- >  h = \x -> let f = ...g...
    -- >                g = ....f...x...
    -- >             in ...
    --
    -- Here @g@ is not closed because it mentions @x@; and hence neither is @f@
    -- closed.
    --
    -- So we need to compute closed-ness on each strongly connected components,
    -- before we sub-divide it based on what type signatures it has.
    --

    ------------------------
    tc_group :: forall thing.
                TopLevelFlag -> TcSigFun -> TcPragEnv
             -> (RecFlag, LHsBinds GhcRn) -> IsGroupClosed -> TcM thing
             -> TcM ([(RecFlag, LHsBinds GhcTc)], thing)

    -- Typecheck one strongly-connected component of the original program.
    -- We get a list of groups back, because there may
    -- be specialisations etc as well

    tc_group :: forall thing.
    TopLevelFlag
    -> TcSigFun
    -> TcPragEnv
    -> (RecFlag, LHsBinds (GhcPass 'Renamed))
    -> IsGroupClosed
    -> TcM thing
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    tc_group TopLevelFlag
    top_lvl TcSigFun
    sig_fn TcPragEnv
    prag_fn (RecFlag
    NonRecursive, LHsBinds (GhcPass 'Renamed)
    binds) IsGroupClosed
    closed TcM thing
    thing_inside
            -- A single non-recursive binding
            -- We want to keep non-recursive things non-recursive
            -- so that we desugar unlifted bindings correctly
      = do { let bind :: LHsBind (GhcPass 'Renamed)
    bind = case LHsBinds (GhcPass 'Renamed) -> [LHsBind (GhcPass 'Renamed)]
    forall a. Bag a -> [a]
    bagToList LHsBinds (GhcPass 'Renamed)
    binds of
                     [LHsBind (GhcPass 'Renamed)
    bind] -> LHsBind (GhcPass 'Renamed)
    bind
                     []     -> String -> LHsBind (GhcPass 'Renamed)
    forall a. String -> a
    panic String
    "tc_group: empty list of binds"
                     [LHsBind (GhcPass 'Renamed)]
    _      -> String -> LHsBind (GhcPass 'Renamed)
    forall a. String -> a
    panic String
    "tc_group: NonRecursive binds is not a singleton bag"
           ; (LHsBinds (GhcPass 'Typechecked)
    bind', thing
    thing) <- TopLevelFlag
    -> TcSigFun
    -> TcPragEnv
    -> LHsBind (GhcPass 'Renamed)
    -> IsGroupClosed
    -> TcM thing
    -> TcM (LHsBinds (GhcPass 'Typechecked), thing)
    forall thing.
    TopLevelFlag
    -> TcSigFun
    -> TcPragEnv
    -> LHsBind (GhcPass 'Renamed)
    -> IsGroupClosed
    -> TcM thing
    -> TcM (LHsBinds (GhcPass 'Typechecked), thing)
    tc_single TopLevelFlag
    top_lvl TcSigFun
    sig_fn TcPragEnv
    prag_fn LHsBind (GhcPass 'Renamed)
    bind IsGroupClosed
    closed
                                         TcM thing
    thing_inside
           ; ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( [(RecFlag
    NonRecursive, LHsBinds (GhcPass 'Typechecked)
    bind')], thing
    thing) }

    tc_group TopLevelFlag
    top_lvl TcSigFun
    sig_fn TcPragEnv
    prag_fn (RecFlag
    Recursive, LHsBinds (GhcPass 'Renamed)
    binds) IsGroupClosed
    closed TcM thing
    thing_inside
      =     -- To maximise polymorphism, we do a new
            -- strongly-connected-component analysis, this time omitting
            -- any references to variables with type signatures.
            -- (This used to be optional, but isn't now.)
            -- See Note [Polymorphic recursion] in "GHC.Hs.Binds".
        do  { String -> SDoc -> TcRn ()
    traceTc String
    "tc_group rec" (LHsBinds (GhcPass 'Renamed) -> SDoc
    forall (idL :: Pass) (idR :: Pass).
    (OutputableBndrId idL, OutputableBndrId idR) =>
    LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
    pprLHsBinds LHsBinds (GhcPass 'Renamed)
    binds)
            ; Maybe (LHsBind (GhcPass 'Renamed))
    -> (LHsBind (GhcPass 'Renamed) -> TcRn ()) -> TcRn ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenIsJust Maybe (LHsBind (GhcPass 'Renamed))
    mbFirstPatSyn ((LHsBind (GhcPass 'Renamed) -> TcRn ()) -> TcRn ())
    -> (LHsBind (GhcPass 'Renamed) -> TcRn ()) -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ \LHsBind (GhcPass 'Renamed)
    lpat_syn ->
                SrcSpan -> LHsBinds (GhcPass 'Renamed) -> TcRn ()
    forall (p :: Pass) a.
    (OutputableBndrId p, CollectPass (GhcPass p)) =>
    SrcSpan -> LHsBinds (GhcPass p) -> TcM a
    recursivePatSynErr (LHsBind (GhcPass 'Renamed) -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc LHsBind (GhcPass 'Renamed)
    lpat_syn) LHsBinds (GhcPass 'Renamed)
    binds
            ; (LHsBinds (GhcPass 'Typechecked)
    binds1, thing
    thing) <- [SCC (LHsBind (GhcPass 'Renamed))]
    -> TcM (LHsBinds (GhcPass 'Typechecked), thing)
    go [SCC (LHsBind (GhcPass 'Renamed))]
    sccs
            ; ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    -> TcM ([(RecFlag, LHsBinds (GhcPass 'Typechecked))], thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(RecFlag
    Recursive, LHsBinds (GhcPass 'Typechecked)
    binds1)], thing
    thing) }
                    -- Rec them all together
      where
        mbFirstPatSyn :: Maybe (LHsBind (GhcPass 'Renamed))
    mbFirstPatSyn = (LHsBind (GhcPass 'Renamed) -> Bool)
    -> LHsBinds (GhcPass 'Renamed)
    -> Maybe (LHsBind (GhcPass 'Renamed))
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    find (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> Bool
    forall {idL} {idR}. HsBindLR idL idR -> Bool
    isPatSyn (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> Bool)
    -> (LHsBind (GhcPass 'Renamed)
        -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> LHsBind (GhcPass 'Renamed)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsBind (GhcPass 'Renamed)
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    forall l e. GenLocated l e -> e
    unLoc) LHsBinds (GhcPass 'Renamed)
    binds
        isPatSyn :: HsBindLR idL idR -> Bool
    isPatSyn PatSynBind{} = Bool
    True
        isPatSyn HsBindLR idL idR
    _ = Bool
    False

        sccs :: [SCC (LHsBind GhcRn)]
        sccs :: [SCC (LHsBind (GhcPass 'Renamed))]
    sccs = [Node BKey (LHsBind (GhcPass 'Renamed))]
    -> [SCC (LHsBind (GhcPass 'Renamed))]
    forall key payload.
    Uniquable key =>
    [Node key payload] -> [SCC payload]
    stronglyConnCompFromEdgedVerticesUniq (TcSigFun
    -> LHsBinds (GhcPass 'Renamed)
    -> [Node BKey (LHsBind (GhcPass 'Renamed))]
    mkEdges TcSigFun
    sig_fn LHsBinds (GhcPass 'Renamed)
    binds)

        go :: [SCC (LHsBind GhcRn)] -> TcM (LHsBinds GhcTc, thing)
        go :: [SCC (LHsBind (GhcPass 'Renamed))]
    -> TcM (LHsBinds (GhcPass 'Typechecked), thing)
    go (SCC (LHsBind (GhcPass 'Renamed))
    scc:[SCC (LHsBind (GhcPass 'Renamed))]
    sccs) = do  { (LHsBinds (GhcPass 'Typechecked)
    binds1, [TcId]
    ids1) <- SCC (LHsBind (GhcPass 'Renamed))
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tc_scc SCC (LHsBind (GhcPass 'Renamed))
    scc
                             -- recursive bindings must be unrestricted
                             -- (the ids added to the environment here are the name of the recursive definitions).
                            ; (LHsBinds (GhcPass 'Typechecked)
    binds2, thing
    thing) <- TopLevelFlag
    -> TcSigFun
    -> IsGroupClosed
    -> [TcId]
    -> TcM (LHsBinds (GhcPass 'Typechecked), thing)
    -> TcM (LHsBinds (GhcPass 'Typechecked), thing)
    forall a.
    TopLevelFlag
    -> TcSigFun -> IsGroupClosed -> [TcId] -> TcM a -> TcM a
    tcExtendLetEnv TopLevelFlag
    top_lvl TcSigFun
    sig_fn IsGroupClosed
    closed [TcId]
    ids1
                                                                ([SCC (LHsBind (GhcPass 'Renamed))]
    -> TcM (LHsBinds (GhcPass 'Typechecked), thing)
    go [SCC (LHsBind (GhcPass 'Renamed))]
    sccs)
                            ; (LHsBinds (GhcPass 'Typechecked), thing)
    -> TcM (LHsBinds (GhcPass 'Typechecked), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds (GhcPass 'Typechecked)
    binds1 LHsBinds (GhcPass 'Typechecked)
    -> LHsBinds (GhcPass 'Typechecked)
    -> LHsBinds (GhcPass 'Typechecked)
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` LHsBinds (GhcPass 'Typechecked)
    binds2, thing
    thing) }
        go []         = do  { thing
    thing <- TcM thing
    thing_inside; (LHsBinds (GhcPass 'Typechecked), thing)
    -> TcM (LHsBinds (GhcPass 'Typechecked), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds (GhcPass 'Typechecked)
    forall a. Bag a
    emptyBag, thing
    thing) }

        tc_scc :: SCC (LHsBind (GhcPass 'Renamed))
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tc_scc (AcyclicSCC LHsBind (GhcPass 'Renamed)
    bind) = RecFlag
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tc_sub_group RecFlag
    NonRecursive [LHsBind (GhcPass 'Renamed)
    bind]
        tc_scc (CyclicSCC [LHsBind (GhcPass 'Renamed)]
    binds) = RecFlag
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tc_sub_group RecFlag
    Recursive    [LHsBind (GhcPass 'Renamed)]
    binds

        tc_sub_group :: RecFlag
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tc_sub_group RecFlag
    rec_tc [LHsBind (GhcPass 'Renamed)]
    binds =
          TcSigFun
    -> TcPragEnv
    -> RecFlag
    -> RecFlag
    -> IsGroupClosed
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tcPolyBinds TcSigFun
    sig_fn TcPragEnv
    prag_fn RecFlag
    Recursive RecFlag
    rec_tc IsGroupClosed
    closed [LHsBind (GhcPass 'Renamed)]
    binds

    recursivePatSynErr ::
         (OutputableBndrId p, CollectPass (GhcPass p))
      => SrcSpan -- ^ The location of the first pattern synonym binding
                 --   (for error reporting)
      -> LHsBinds (GhcPass p)
      -> TcM a
    recursivePatSynErr :: forall (p :: Pass) a.
    (OutputableBndrId p, CollectPass (GhcPass p)) =>
    SrcSpan -> LHsBinds (GhcPass p) -> TcM a
    recursivePatSynErr SrcSpan
    loc LHsBinds (GhcPass p)
    binds
      = SrcSpan -> SDoc -> TcRn a
    forall a. SrcSpan -> SDoc -> TcRn a
    failAt SrcSpan
    loc (SDoc -> TcRn a) -> SDoc -> TcRn a
    forall a b. (a -> b) -> a -> b
    $
        SDoc -> BKey -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Recursive pattern synonym definition with following bindings:")
           BKey
    2 ([SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ (GenLocated SrcSpan (HsBindLR (GhcPass p) (GhcPass p)) -> SDoc)
    -> [GenLocated SrcSpan (HsBindLR (GhcPass p) (GhcPass p))]
    -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpan (HsBindLR (GhcPass p) (GhcPass p)) -> SDoc
    forall {p} {a} {idR}.
    (CollectPass p, Outputable (IdP p), Outputable a) =>
    GenLocated a (HsBindLR p idR) -> SDoc
    pprLBind ([GenLocated SrcSpan (HsBindLR (GhcPass p) (GhcPass p))] -> [SDoc])
    -> (LHsBinds (GhcPass p)
        -> [GenLocated SrcSpan (HsBindLR (GhcPass p) (GhcPass p))])
    -> LHsBinds (GhcPass p)
    -> [SDoc]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsBinds (GhcPass p)
    -> [GenLocated SrcSpan (HsBindLR (GhcPass p) (GhcPass p))]
    forall a. Bag a -> [a]
    bagToList (LHsBinds (GhcPass p) -> [SDoc]) -> LHsBinds (GhcPass p) -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ LHsBinds (GhcPass p)
    binds)
      where
        pprLoc :: a -> SDoc
    pprLoc a
    loc  = SDoc -> SDoc
    parens (String -> SDoc
    text String
    "defined at" SDoc -> SDoc -> SDoc
    <+> a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    loc)
        pprLBind :: GenLocated a (HsBindLR p idR) -> SDoc
    pprLBind (L a
    loc HsBindLR p idR
    bind) = (IdP p -> SDoc) -> [IdP p] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas IdP p -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (HsBindLR p idR -> [IdP p]
    forall p idR. CollectPass p => HsBindLR p idR -> [IdP p]
    collectHsBindBinders HsBindLR p idR
    bind)
                                    SDoc -> SDoc -> SDoc
    <+> a -> SDoc
    forall a. Outputable a => a -> SDoc
    pprLoc a
    loc

    tc_single :: forall thing.
                TopLevelFlag -> TcSigFun -> TcPragEnv
              -> LHsBind GhcRn -> IsGroupClosed -> TcM thing
              -> TcM (LHsBinds GhcTc, thing)
    tc_single :: forall thing.
    TopLevelFlag
    -> TcSigFun
    -> TcPragEnv
    -> LHsBind (GhcPass 'Renamed)
    -> IsGroupClosed
    -> TcM thing
    -> TcM (LHsBinds (GhcPass 'Typechecked), thing)
    tc_single TopLevelFlag
    _top_lvl TcSigFun
    sig_fn TcPragEnv
    _prag_fn
              (L SrcSpan
    _ (PatSynBind XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
    _ psb :: PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
    psb@PSB{ psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
    psb_id = L SrcSpan
    _ IdP (GhcPass 'Renamed)
    name }))
              IsGroupClosed
    _ TcM thing
    thing_inside
      = do { (LHsBinds (GhcPass 'Typechecked)
    aux_binds, TcGblEnv
    tcg_env) <- PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> Maybe TcSigInfo
    -> TcM (LHsBinds (GhcPass 'Typechecked), TcGblEnv)
    tcPatSynDecl PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
    psb (TcSigFun
    sig_fn Name
    IdP (GhcPass 'Renamed)
    name)
           ; thing
    thing <- TcGblEnv -> TcM thing -> TcM thing
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env TcM thing
    thing_inside
           ; (LHsBinds (GhcPass 'Typechecked), thing)
    -> TcM (LHsBinds (GhcPass 'Typechecked), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds (GhcPass 'Typechecked)
    aux_binds, thing
    thing)
           }

    tc_single TopLevelFlag
    top_lvl TcSigFun
    sig_fn TcPragEnv
    prag_fn LHsBind (GhcPass 'Renamed)
    lbind IsGroupClosed
    closed TcM thing
    thing_inside
      = do { (LHsBinds (GhcPass 'Typechecked)
    binds1, [TcId]
    ids) <- TcSigFun
    -> TcPragEnv
    -> RecFlag
    -> RecFlag
    -> IsGroupClosed
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tcPolyBinds TcSigFun
    sig_fn TcPragEnv
    prag_fn
                                          RecFlag
    NonRecursive RecFlag
    NonRecursive
                                          IsGroupClosed
    closed
                                          [LHsBind (GhcPass 'Renamed)
    lbind]
             -- since we are defining a non-recursive binding, it is not necessary here
             -- to define an unrestricted binding. But we do so until toplevel linear bindings are supported.
           ; thing
    thing <- TopLevelFlag
    -> TcSigFun -> IsGroupClosed -> [TcId] -> TcM thing -> TcM thing
    forall a.
    TopLevelFlag
    -> TcSigFun -> IsGroupClosed -> [TcId] -> TcM a -> TcM a
    tcExtendLetEnv TopLevelFlag
    top_lvl TcSigFun
    sig_fn IsGroupClosed
    closed [TcId]
    ids TcM thing
    thing_inside
           ; (LHsBinds (GhcPass 'Typechecked), thing)
    -> TcM (LHsBinds (GhcPass 'Typechecked), thing)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds (GhcPass 'Typechecked)
    binds1, thing
    thing) }

    ------------------------
    type BKey = Int -- Just number off the bindings

    mkEdges :: TcSigFun -> LHsBinds GhcRn -> [Node BKey (LHsBind GhcRn)]
    -- See Note [Polymorphic recursion] in "GHC.Hs.Binds".
    mkEdges :: TcSigFun
    -> LHsBinds (GhcPass 'Renamed)
    -> [Node BKey (LHsBind (GhcPass 'Renamed))]
    mkEdges TcSigFun
    sig_fn LHsBinds (GhcPass 'Renamed)
    binds
      = [ LHsBind (GhcPass 'Renamed)
    -> BKey -> [BKey] -> Node BKey (LHsBind (GhcPass 'Renamed))
    forall key payload. payload -> key -> [key] -> Node key payload
    DigraphNode LHsBind (GhcPass 'Renamed)
    bind BKey
    key [BKey
    key | Name
    n <- UniqSet Name -> [Name]
    forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
    forall {idL} {idR}.
    (XPatBind idL idR ~ XFunBind idL idR,
     XFunBind idL idR ~ UniqSet Name) =>
    HsBindLR idL idR -> XFunBind idL idR
    bind_fvs (LHsBind (GhcPass 'Renamed)
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    forall l e. GenLocated l e -> e
    unLoc LHsBind (GhcPass 'Renamed)
    bind)),
                             Just BKey
    key <- [NameEnv BKey -> Name -> Maybe BKey
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv NameEnv BKey
    key_map Name
    n], Name -> Bool
    no_sig Name
    n ]
        | (LHsBind (GhcPass 'Renamed)
    bind, BKey
    key) <- [(LHsBind (GhcPass 'Renamed), BKey)]
    keyd_binds
        ]
        -- It's OK to use nonDetEltsUFM here as stronglyConnCompFromEdgedVertices
        -- is still deterministic even if the edges are in nondeterministic order
        -- as explained in Note [Deterministic SCC] in GHC.Data.Graph.Directed.
      where
        bind_fvs :: HsBindLR idL idR -> XFunBind idL idR
    bind_fvs (FunBind { fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
    fun_ext = XFunBind idL idR
    fvs }) = XFunBind idL idR
    fvs
        bind_fvs (PatBind { pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
    pat_ext = XPatBind idL idR
    fvs }) = XFunBind idL idR
    XPatBind idL idR
    fvs
        bind_fvs HsBindLR idL idR
    _                           = UniqSet Name
    XFunBind idL idR
    emptyNameSet

        no_sig :: Name -> Bool
        no_sig :: Name -> Bool
    no_sig Name
    n = Bool -> Bool
    not (TcSigFun -> Name -> Bool
    hasCompleteSig TcSigFun
    sig_fn Name
    n)

        keyd_binds :: [(LHsBind (GhcPass 'Renamed), BKey)]
    keyd_binds = LHsBinds (GhcPass 'Renamed) -> [LHsBind (GhcPass 'Renamed)]
    forall a. Bag a -> [a]
    bagToList LHsBinds (GhcPass 'Renamed)
    binds [LHsBind (GhcPass 'Renamed)]
    -> [BKey] -> [(LHsBind (GhcPass 'Renamed), BKey)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [BKey
    0::BKey ..]

        key_map :: NameEnv BKey     -- Which binding it comes from
        key_map :: NameEnv BKey
    key_map = [(Name, BKey)] -> NameEnv BKey
    forall a. [(Name, a)] -> NameEnv a
    mkNameEnv [(Name
    bndr, BKey
    key) | (L SrcSpan
    _ HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    bind, BKey
    key) <- [(LHsBind (GhcPass 'Renamed), BKey)]
    keyd_binds
                                         , Name
    bndr <- HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> [IdP (GhcPass 'Renamed)]
    forall p idR. CollectPass p => HsBindLR p idR -> [IdP p]
    collectHsBindBinders HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    bind ]

    ------------------------
    tcPolyBinds :: TcSigFun -> TcPragEnv
                -> RecFlag         -- Whether the group is really recursive
                -> RecFlag         -- Whether it's recursive after breaking
                                   -- dependencies based on type signatures
                -> IsGroupClosed   -- Whether the group is closed
                -> [LHsBind GhcRn]  -- None are PatSynBind
                -> TcM (LHsBinds GhcTc, [TcId])

    -- Typechecks a single bunch of values bindings all together,
    -- and generalises them.  The bunch may be only part of a recursive
    -- group, because we use type signatures to maximise polymorphism
    --
    -- Returns a list because the input may be a single non-recursive binding,
    -- in which case the dependency order of the resulting bindings is
    -- important.
    --
    -- Knows nothing about the scope of the bindings
    -- None of the bindings are pattern synonyms

    tcPolyBinds :: TcSigFun
    -> TcPragEnv
    -> RecFlag
    -> RecFlag
    -> IsGroupClosed
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tcPolyBinds TcSigFun
    sig_fn TcPragEnv
    prag_fn RecFlag
    rec_group RecFlag
    rec_tc IsGroupClosed
    closed [LHsBind (GhcPass 'Renamed)]
    bind_list
      = SrcSpan
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc                              (TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
     -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId]))
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    forall a b. (a -> b) -> a -> b
    $
        TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    forall r. TcRn r -> TcRn r -> TcRn r
    recoverM ([Name] -> TcSigFun -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    recoveryCode [Name]
    [IdP (GhcPass 'Renamed)]
    binder_names TcSigFun
    sig_fn) (TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
     -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId]))
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    forall a b. (a -> b) -> a -> b
    $ do
            -- Set up main recover; take advantage of any type sigs

        { String -> SDoc -> TcRn ()
    traceTc String
    "------------------------------------------------" SDoc
    Outputable.empty
        ; String -> SDoc -> TcRn ()
    traceTc String
    "Bindings for {" ([Name] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Name]
    [IdP (GhcPass 'Renamed)]
    binder_names)
        ; DynFlags
    dflags   <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        ; let plan :: GeneralisationPlan
    plan = DynFlags
    -> [LHsBind (GhcPass 'Renamed)]
    -> IsGroupClosed
    -> TcSigFun
    -> GeneralisationPlan
    decideGeneralisationPlan DynFlags
    dflags [LHsBind (GhcPass 'Renamed)]
    bind_list IsGroupClosed
    closed TcSigFun
    sig_fn
        ; String -> SDoc -> TcRn ()
    traceTc String
    "Generalisation plan" (GeneralisationPlan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GeneralisationPlan
    plan)
        ; result :: (LHsBinds (GhcPass 'Typechecked), [TcId])
    result@(LHsBinds (GhcPass 'Typechecked)
    _, [TcId]
    poly_ids) <- case GeneralisationPlan
    plan of
             GeneralisationPlan
    NoGen              -> RecFlag
    -> TcPragEnv
    -> TcSigFun
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tcPolyNoGen RecFlag
    rec_tc TcPragEnv
    prag_fn TcSigFun
    sig_fn [LHsBind (GhcPass 'Renamed)]
    bind_list
             InferGen Bool
    mn        -> RecFlag
    -> TcPragEnv
    -> TcSigFun
    -> Bool
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tcPolyInfer RecFlag
    rec_tc TcPragEnv
    prag_fn TcSigFun
    sig_fn Bool
    mn [LHsBind (GhcPass 'Renamed)]
    bind_list
             CheckGen LHsBind (GhcPass 'Renamed)
    lbind TcIdSigInfo
    sig -> TcPragEnv
    -> TcIdSigInfo
    -> LHsBind (GhcPass 'Renamed)
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tcPolyCheck TcPragEnv
    prag_fn TcIdSigInfo
    sig LHsBind (GhcPass 'Renamed)
    lbind

        ; String -> SDoc -> TcRn ()
    traceTc String
    "} End of bindings for" ([SDoc] -> SDoc
    vcat [ [Name] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Name]
    [IdP (GhcPass 'Renamed)]
    binder_names, RecFlag -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RecFlag
    rec_group
                                                , [SDoc] -> SDoc
    vcat [TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    id SDoc -> SDoc -> SDoc
    <+> Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcId -> Kind
    idType TcId
    id) | TcId
    id <- [TcId]
    poly_ids]
                                              ])

        ; (LHsBinds (GhcPass 'Typechecked), [TcId])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds (GhcPass 'Typechecked), [TcId])
    result }
      where
        binder_names :: [IdP (GhcPass 'Renamed)]
    binder_names = [LHsBind (GhcPass 'Renamed)] -> [IdP (GhcPass 'Renamed)]
    forall p idR. CollectPass p => [LHsBindLR p idR] -> [IdP p]
    collectHsBindListBinders [LHsBind (GhcPass 'Renamed)]
    bind_list
        loc :: SrcSpan
    loc = (SrcSpan -> SrcSpan -> SrcSpan) -> [SrcSpan] -> SrcSpan
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 SrcSpan -> SrcSpan -> SrcSpan
    combineSrcSpans ((LHsBind (GhcPass 'Renamed) -> SrcSpan)
    -> [LHsBind (GhcPass 'Renamed)] -> [SrcSpan]
    forall a b. (a -> b) -> [a] -> [b]
    map LHsBind (GhcPass 'Renamed) -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc [LHsBind (GhcPass 'Renamed)]
    bind_list)
             -- The mbinds have been dependency analysed and
             -- may no longer be adjacent; so find the narrowest
             -- span that includes them all

    --------------
    -- If typechecking the binds fails, then return with each
    -- signature-less binder given type (forall a.a), to minimise
    -- subsequent error messages
    recoveryCode :: [Name] -> TcSigFun -> TcM (LHsBinds GhcTc, [Id])
    recoveryCode :: [Name] -> TcSigFun -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    recoveryCode [Name]
    binder_names TcSigFun
    sig_fn
      = do  { String -> SDoc -> TcRn ()
    traceTc String
    "tcBindsWithSigs: error recovery" ([Name] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Name]
    binder_names)
            ; let poly_ids :: [TcId]
    poly_ids = (Name -> TcId) -> [Name] -> [TcId]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> TcId
    mk_dummy [Name]
    binder_names
            ; (LHsBinds (GhcPass 'Typechecked), [TcId])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds (GhcPass 'Typechecked)
    forall a. Bag a
    emptyBag, [TcId]
    poly_ids) }
      where
        mk_dummy :: Name -> TcId
    mk_dummy Name
    name
          | Just TcSigInfo
    sig <- TcSigFun
    sig_fn Name
    name
          , Just TcId
    poly_id <- TcSigInfo -> Maybe TcId
    completeSigPolyId_maybe TcSigInfo
    sig
          = TcId
    poly_id
          | Bool
    otherwise
          = HasDebugCallStack => Name -> Kind -> Kind -> TcId
    Name -> Kind -> Kind -> TcId
    mkLocalId Name
    name Kind
    Many Kind
    forall_a_a

    forall_a_a :: TcType
    -- At one point I had (forall r (a :: TYPE r). a), but of course
    -- that type is ill-formed: its mentions 'r' which escapes r's scope.
    -- Another alternative would be (forall (a :: TYPE kappa). a), where
    -- kappa is a unification variable. But I don't think we need that
    -- complication here. I'm going to just use (forall (a::*). a).
    -- See #15276
    forall_a_a :: Kind
    forall_a_a = [TcId] -> Kind -> Kind
    mkSpecForAllTys [TcId
    alphaTyVar] Kind
    alphaTy

    {- *********************************************************************
    *                                                                      *
                             tcPolyNoGen
    *                                                                      *
    ********************************************************************* -}

    tcPolyNoGen     -- No generalisation whatsoever
      :: RecFlag       -- Whether it's recursive after breaking
                       -- dependencies based on type signatures
      -> TcPragEnv -> TcSigFun
      -> [LHsBind GhcRn]
      -> TcM (LHsBinds GhcTc, [TcId])

    tcPolyNoGen :: RecFlag
    -> TcPragEnv
    -> TcSigFun
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tcPolyNoGen RecFlag
    rec_tc TcPragEnv
    prag_fn TcSigFun
    tc_sig_fn [LHsBind (GhcPass 'Renamed)]
    bind_list
      = do { (LHsBinds (GhcPass 'Typechecked)
    binds', [MonoBindInfo]
    mono_infos) <- RecFlag
    -> TcSigFun
    -> LetBndrSpec
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    tcMonoBinds RecFlag
    rec_tc TcSigFun
    tc_sig_fn
                                                 (TcPragEnv -> LetBndrSpec
    LetGblBndr TcPragEnv
    prag_fn)
                                                 [LHsBind (GhcPass 'Renamed)]
    bind_list
           ; [TcId]
    mono_ids' <- (MonoBindInfo -> IOEnv (Env TcGblEnv TcLclEnv) TcId)
    -> [MonoBindInfo] -> TcM [TcId]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM MonoBindInfo -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    tc_mono_info [MonoBindInfo]
    mono_infos
           ; (LHsBinds (GhcPass 'Typechecked), [TcId])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds (GhcPass 'Typechecked)
    binds', [TcId]
    mono_ids') }
      where
        tc_mono_info :: MonoBindInfo -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    tc_mono_info (MBI { mbi_poly_name :: MonoBindInfo -> Name
    mbi_poly_name = Name
    name, mbi_mono_id :: MonoBindInfo -> TcId
    mbi_mono_id = TcId
    mono_id })
          = do { [LTcSpecPrag]
    _specs <- TcId -> [LSig (GhcPass 'Renamed)] -> TcM [LTcSpecPrag]
    tcSpecPrags TcId
    mono_id (TcPragEnv -> Name -> [LSig (GhcPass 'Renamed)]
    lookupPragEnv TcPragEnv
    prag_fn Name
    name)
               ; TcId -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcId
    mono_id }
               -- NB: tcPrags generates error messages for
               --     specialisation pragmas for non-overloaded sigs
               -- Indeed that is why we call it here!
               -- So we can safely ignore _specs

    {- *********************************************************************
    *                                                                      *
                             tcPolyCheck
    *                                                                      *
    ********************************************************************* -}

    tcPolyCheck :: TcPragEnv
                -> TcIdSigInfo     -- Must be a complete signature
                -> LHsBind GhcRn   -- Must be a FunBind
                -> TcM (LHsBinds GhcTc, [TcId])
    -- There is just one binding,
    --   it is a FunBind
    --   it has a complete type signature,
    tcPolyCheck :: TcPragEnv
    -> TcIdSigInfo
    -> LHsBind (GhcPass 'Renamed)
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tcPolyCheck TcPragEnv
    prag_fn
                (CompleteSig { sig_bndr :: TcIdSigInfo -> TcId
    sig_bndr  = TcId
    poly_id
                             , sig_ctxt :: TcIdSigInfo -> UserTypeCtxt
    sig_ctxt  = UserTypeCtxt
    ctxt
                             , sig_loc :: TcIdSigInfo -> SrcSpan
    sig_loc   = SrcSpan
    sig_loc })
                (L SrcSpan
    bind_loc (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
    fun_id = L SrcSpan
    nm_loc IdP (GhcPass 'Renamed)
    name
                                     , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
    fun_matches = MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    matches }))
      = do { String -> SDoc -> TcRn ()
    traceTc String
    "tcPolyCheck" (TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    poly_id SDoc -> SDoc -> SDoc
    $$ SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    sig_loc)

           ; Name
    mono_name <- OccName -> SrcSpan -> TcM Name
    newNameAt (Name -> OccName
    nameOccName Name
    IdP (GhcPass 'Renamed)
    name) SrcSpan
    nm_loc
           ; (HsWrapper
    wrap_gen, (HsWrapper
    wrap_res, MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))
    matches'))
                 <- SrcSpan
    -> TcRn
         (HsWrapper,
          (HsWrapper,
           MatchGroup
             (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    -> TcRn
         (HsWrapper,
          (HsWrapper,
           MatchGroup
             (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    sig_loc (TcRn
       (HsWrapper,
        (HsWrapper,
         MatchGroup
           (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
     -> TcRn
          (HsWrapper,
           (HsWrapper,
            MatchGroup
              (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))))
    -> TcRn
         (HsWrapper,
          (HsWrapper,
           MatchGroup
             (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    -> TcRn
         (HsWrapper,
          (HsWrapper,
           MatchGroup
             (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    forall a b. (a -> b) -> a -> b
    $ -- Sets the binding location for the skolems
                    UserTypeCtxt
    -> Kind
    -> (Kind
        -> TcM
             (HsWrapper,
              MatchGroup
                (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    -> TcRn
         (HsWrapper,
          (HsWrapper,
           MatchGroup
             (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    forall result.
    UserTypeCtxt
    -> Kind -> (Kind -> TcM result) -> TcM (HsWrapper, result)
    tcSkolemiseScoped UserTypeCtxt
    ctxt (TcId -> Kind
    idType TcId
    poly_id) ((Kind
      -> TcM
           (HsWrapper,
            MatchGroup
              (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
     -> TcRn
          (HsWrapper,
           (HsWrapper,
            MatchGroup
              (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))))
    -> (Kind
        -> TcM
             (HsWrapper,
              MatchGroup
                (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    -> TcRn
         (HsWrapper,
          (HsWrapper,
           MatchGroup
             (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    forall a b. (a -> b) -> a -> b
    $ \Kind
    rho_ty ->
                    -- Unwraps multiple layers; e.g
                    --    f :: forall a. Eq a => forall b. Ord b => blah
                    -- NB: tcSkolemise makes fresh type variables
                    -- See Note [Instantiate sig with fresh variables]

                    let mono_id :: TcId
    mono_id = HasDebugCallStack => Name -> Kind -> Kind -> TcId
    Name -> Kind -> Kind -> TcId
    mkLocalId Name
    mono_name (TcId -> Kind
    varMult TcId
    poly_id) Kind
    rho_ty in
                    [TcBinder]
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    forall a. [TcBinder] -> TcM a -> TcM a
    tcExtendBinderStack [TcId -> TopLevelFlag -> TcBinder
    TcIdBndr TcId
    mono_id TopLevelFlag
    NotTopLevel] (TcM
       (HsWrapper,
        MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
     -> TcM
          (HsWrapper,
           MatchGroup
             (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    forall a b. (a -> b) -> a -> b
    $
                    -- Why mono_id in the BinderStack?
                    --    See Note [Relevant bindings and the binder stack]

                    SrcSpan
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    bind_loc (TcM
       (HsWrapper,
        MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
     -> TcM
          (HsWrapper,
           MatchGroup
             (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    forall a b. (a -> b) -> a -> b
    $
                    Located Name
    -> MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    -> ExpSigmaType
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    tcMatchesFun (SrcSpan -> Name -> Located Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    nm_loc Name
    mono_name) MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    matches
                                 (Kind -> ExpSigmaType
    mkCheckExpType Kind
    rho_ty)

           -- We make a funny AbsBinds, abstracting over nothing,
           -- just so we haev somewhere to put the SpecPrags.
           -- Otherwise we could just use the FunBind
           -- Hence poly_id2 is just a clone of poly_id;
           -- We re-use mono-name, but we could equally well use a fresh one

           ; let prag_sigs :: [LSig (GhcPass 'Renamed)]
    prag_sigs = TcPragEnv -> Name -> [LSig (GhcPass 'Renamed)]
    lookupPragEnv TcPragEnv
    prag_fn Name
    IdP (GhcPass 'Renamed)
    name
                 poly_id2 :: TcId
    poly_id2  = HasDebugCallStack => Name -> Kind -> Kind -> TcId
    Name -> Kind -> Kind -> TcId
    mkLocalId Name
    mono_name (TcId -> Kind
    idMult TcId
    poly_id) (TcId -> Kind
    idType TcId
    poly_id)
           ; [LTcSpecPrag]
    spec_prags <- TcId -> [LSig (GhcPass 'Renamed)] -> TcM [LTcSpecPrag]
    tcSpecPrags    TcId
    poly_id [LSig (GhcPass 'Renamed)]
    prag_sigs
           ; TcId
    poly_id    <- TcId
    -> [LSig (GhcPass 'Renamed)] -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    addInlinePrags TcId
    poly_id [LSig (GhcPass 'Renamed)]
    prag_sigs

           ; Module
    mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
    forall (m :: * -> *). HasModule m => m Module
    getModule
           ; [Tickish TcId]
    tick <- SrcSpan
    -> TcId
    -> Module
    -> [LSig (GhcPass 'Renamed)]
    -> TcM [Tickish TcId]
    funBindTicks SrcSpan
    nm_loc TcId
    poly_id Module
    mod [LSig (GhcPass 'Renamed)]
    prag_sigs

           ; let bind' :: HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    bind' = FunBind :: forall idL idR.
    XFunBind idL idR
    -> Located (IdP idL)
    -> MatchGroup idR (LHsExpr idR)
    -> [Tickish TcId]
    -> HsBindLR idL idR
    FunBind { fun_id :: Located (IdP (GhcPass 'Typechecked))
    fun_id      = SrcSpan -> TcId -> GenLocated SrcSpan TcId
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    nm_loc TcId
    poly_id2
                                 , fun_matches :: MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))
    fun_matches = MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))
    matches'
                                 , fun_ext :: XFunBind (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    fun_ext     = HsWrapper
    wrap_gen HsWrapper -> HsWrapper -> HsWrapper
    <.> HsWrapper
    wrap_res
                                 , fun_tick :: [Tickish TcId]
    fun_tick    = [Tickish TcId]
    tick }

                 export :: ABExport (GhcPass 'Typechecked)
    export = ABE :: forall p.
    XABE p -> IdP p -> IdP p -> HsWrapper -> TcSpecPrags -> ABExport p
    ABE { abe_ext :: XABE (GhcPass 'Typechecked)
    abe_ext   = NoExtField
    XABE (GhcPass 'Typechecked)
    noExtField
                              , abe_wrap :: HsWrapper
    abe_wrap  = HsWrapper
    idHsWrapper
                              , abe_poly :: IdP (GhcPass 'Typechecked)
    abe_poly  = TcId
    IdP (GhcPass 'Typechecked)
    poly_id
                              , abe_mono :: IdP (GhcPass 'Typechecked)
    abe_mono  = TcId
    IdP (GhcPass 'Typechecked)
    poly_id2
                              , abe_prags :: TcSpecPrags
    abe_prags = [LTcSpecPrag] -> TcSpecPrags
    SpecPrags [LTcSpecPrag]
    spec_prags }

                 abs_bind :: GenLocated
      SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    abs_bind = SrcSpan
    -> HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    bind_loc (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
     -> GenLocated
          SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)))
    -> HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall a b. (a -> b) -> a -> b
    $
                            AbsBinds :: forall idL idR.
    XAbsBinds idL idR
    -> [TcId]
    -> [TcId]
    -> [ABExport idL]
    -> [TcEvBinds]
    -> LHsBinds idL
    -> Bool
    -> HsBindLR idL idR
    AbsBinds { abs_ext :: XAbsBinds (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    abs_ext      = NoExtField
    XAbsBinds (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    noExtField
                                     , abs_tvs :: [TcId]
    abs_tvs      = []
                                     , abs_ev_vars :: [TcId]
    abs_ev_vars  = []
                                     , abs_ev_binds :: [TcEvBinds]
    abs_ev_binds = []
                                     , abs_exports :: [ABExport (GhcPass 'Typechecked)]
    abs_exports  = [ABExport (GhcPass 'Typechecked)
    export]
                                     , abs_binds :: LHsBinds (GhcPass 'Typechecked)
    abs_binds    = GenLocated
      SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    -> LHsBinds (GhcPass 'Typechecked)
    forall a. a -> Bag a
    unitBag (SrcSpan
    -> HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    bind_loc HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    bind')
                                     , abs_sig :: Bool
    abs_sig      = Bool
    True }

           ; (LHsBinds (GhcPass 'Typechecked), [TcId])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated
      SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    -> LHsBinds (GhcPass 'Typechecked)
    forall a. a -> Bag a
    unitBag GenLocated
      SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    abs_bind, [TcId
    poly_id]) }

    tcPolyCheck TcPragEnv
    _prag_fn TcIdSigInfo
    sig LHsBind (GhcPass 'Renamed)
    bind
      = String -> SDoc -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcPolyCheck" (TcIdSigInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcIdSigInfo
    sig SDoc -> SDoc -> SDoc
    $$ LHsBind (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsBind (GhcPass 'Renamed)
    bind)

    funBindTicks :: SrcSpan -> TcId -> Module -> [LSig GhcRn]
                 -> TcM [Tickish TcId]
    funBindTicks :: SrcSpan
    -> TcId
    -> Module
    -> [LSig (GhcPass 'Renamed)]
    -> TcM [Tickish TcId]
    funBindTicks SrcSpan
    loc TcId
    fun_id Module
    mod [LSig (GhcPass 'Renamed)]
    sigs
      | (Maybe (Located StringLiteral)
    mb_cc_str : [Maybe (Located StringLiteral)]
    _) <- [ Maybe (Located StringLiteral)
    cc_name | L SrcSpan
    _ (SCCFunSig XSCCFunSig (GhcPass 'Renamed)
    _ SourceText
    _ Located (IdP (GhcPass 'Renamed))
    _ Maybe (Located StringLiteral)
    cc_name) <- [LSig (GhcPass 'Renamed)]
    sigs ]
          -- this can only be a singleton list, as duplicate pragmas are rejected
          -- by the renamer
      , let cc_str :: FastString
    cc_str
              | Just Located StringLiteral
    cc_str <- Maybe (Located StringLiteral)
    mb_cc_str
              = StringLiteral -> FastString
    sl_fs (StringLiteral -> FastString) -> StringLiteral -> FastString
    forall a b. (a -> b) -> a -> b
    $ Located StringLiteral -> StringLiteral
    forall l e. GenLocated l e -> e
    unLoc Located StringLiteral
    cc_str
              | Bool
    otherwise
              = Name -> FastString
    forall a. NamedThing a => a -> FastString
    getOccFS (TcId -> Name
    Var.varName TcId
    fun_id)
            cc_name :: FastString
    cc_name = ModuleName -> FastString
    moduleNameFS (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    mod) FastString -> FastString -> FastString
    `appendFS` Char -> FastString -> FastString
    consFS Char
    '.' FastString
    cc_str
      = do
          CCFlavour
    flavour <- CostCentreIndex -> CCFlavour
    DeclCC (CostCentreIndex -> CCFlavour)
    -> IOEnv (Env TcGblEnv TcLclEnv) CostCentreIndex
    -> IOEnv (Env TcGblEnv TcLclEnv) CCFlavour
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FastString -> IOEnv (Env TcGblEnv TcLclEnv) CostCentreIndex
    forall gbl lcl.
    ContainsCostCentreState gbl =>
    FastString -> TcRnIf gbl lcl CostCentreIndex
    getCCIndexM FastString
    cc_name
          let cc :: CostCentre
    cc = FastString -> Module -> SrcSpan -> CCFlavour -> CostCentre
    mkUserCC FastString
    cc_name Module
    mod SrcSpan
    loc CCFlavour
    flavour
          [Tickish TcId] -> TcM [Tickish TcId]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [CostCentre -> Bool -> Bool -> Tickish TcId
    forall id. CostCentre -> Bool -> Bool -> Tickish id
    ProfNote CostCentre
    cc Bool
    True Bool
    True]
      | Bool
    otherwise
      = [Tickish TcId] -> TcM [Tickish TcId]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

    {- Note [Instantiate sig with fresh variables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    It's vital to instantiate a type signature with fresh variables.
    For example:
          type T = forall a. [a] -> [a]
          f :: T;
          f = g where { g :: T; g = <rhs> }

     We must not use the same 'a' from the defn of T at both places!!
    (Instantiation is only necessary because of type synonyms.  Otherwise,
    it's all cool; each signature has distinct type variables from the renamer.)
    -}

    {- *********************************************************************
    *                                                                      *
                             tcPolyInfer
    *                                                                      *
    ********************************************************************* -}

    tcPolyInfer
      :: RecFlag       -- Whether it's recursive after breaking
                       -- dependencies based on type signatures
      -> TcPragEnv -> TcSigFun
      -> Bool         -- True <=> apply the monomorphism restriction
      -> [LHsBind GhcRn]
      -> TcM (LHsBinds GhcTc, [TcId])
    tcPolyInfer :: RecFlag
    -> TcPragEnv
    -> TcSigFun
    -> Bool
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    tcPolyInfer RecFlag
    rec_tc TcPragEnv
    prag_fn TcSigFun
    tc_sig_fn Bool
    mono [LHsBind (GhcPass 'Renamed)]
    bind_list
      = do { (TcLevel
    tclvl, WantedConstraints
    wanted, (LHsBinds (GhcPass 'Typechecked)
    binds', [MonoBindInfo]
    mono_infos))
                 <- TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    -> TcM
         (TcLevel, WantedConstraints,
          (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo]))
    forall a. TcM a -> TcM (TcLevel, WantedConstraints, a)
    pushLevelAndCaptureConstraints  (TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
     -> TcM
          (TcLevel, WantedConstraints,
           (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])))
    -> TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    -> TcM
         (TcLevel, WantedConstraints,
          (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo]))
    forall a b. (a -> b) -> a -> b
    $
                    RecFlag
    -> TcSigFun
    -> LetBndrSpec
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    tcMonoBinds RecFlag
    rec_tc TcSigFun
    tc_sig_fn LetBndrSpec
    LetLclBndr [LHsBind (GhcPass 'Renamed)]
    bind_list

           ; let name_taus :: [(Name, Kind)]
    name_taus  = [ (MonoBindInfo -> Name
    mbi_poly_name MonoBindInfo
    info, TcId -> Kind
    idType (MonoBindInfo -> TcId
    mbi_mono_id MonoBindInfo
    info))
                              | MonoBindInfo
    info <- [MonoBindInfo]
    mono_infos ]
                 sigs :: [TcIdSigInst]
    sigs       = [ TcIdSigInst
    sig | MBI { mbi_sig :: MonoBindInfo -> Maybe TcIdSigInst
    mbi_sig = Just TcIdSigInst
    sig } <- [MonoBindInfo]
    mono_infos ]
                 infer_mode :: InferMode
    infer_mode = if Bool
    mono then InferMode
    ApplyMR else InferMode
    NoRestrictions

           ; (TcIdSigInst -> TcRn ()) -> [TcIdSigInst] -> TcRn ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Bool -> TcIdSigInst -> TcRn ()
    checkOverloadedSig Bool
    mono) [TcIdSigInst]
    sigs

           ; String -> SDoc -> TcRn ()
    traceTc String
    "simplifyInfer call" (TcLevel -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcLevel
    tclvl SDoc -> SDoc -> SDoc
    $$ [(Name, Kind)] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [(Name, Kind)]
    name_taus SDoc -> SDoc -> SDoc
    $$ WantedConstraints -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WantedConstraints
    wanted)
           ; ([TcId]
    qtvs, [TcId]
    givens, TcEvBinds
    ev_binds, WantedConstraints
    residual, Bool
    insoluble)
                     <- TcLevel
    -> InferMode
    -> [TcIdSigInst]
    -> [(Name, Kind)]
    -> WantedConstraints
    -> TcM ([TcId], [TcId], TcEvBinds, WantedConstraints, Bool)
    simplifyInfer TcLevel
    tclvl InferMode
    infer_mode [TcIdSigInst]
    sigs [(Name, Kind)]
    name_taus WantedConstraints
    wanted
           ; WantedConstraints -> TcRn ()
    emitConstraints WantedConstraints
    residual

           ; let inferred_theta :: TcThetaType
    inferred_theta = (TcId -> Kind) -> [TcId] -> TcThetaType
    forall a b. (a -> b) -> [a] -> [b]
    map TcId -> Kind
    evVarPred [TcId]
    givens
           ; [ABExport (GhcPass 'Typechecked)]
    exports <- TcM [ABExport (GhcPass 'Typechecked)]
    -> TcM [ABExport (GhcPass 'Typechecked)]
    forall r. TcM r -> TcM r
    checkNoErrs (TcM [ABExport (GhcPass 'Typechecked)]
     -> TcM [ABExport (GhcPass 'Typechecked)])
    -> TcM [ABExport (GhcPass 'Typechecked)]
    -> TcM [ABExport (GhcPass 'Typechecked)]
    forall a b. (a -> b) -> a -> b
    $
                        (MonoBindInfo
     -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport (GhcPass 'Typechecked)))
    -> [MonoBindInfo] -> TcM [ABExport (GhcPass 'Typechecked)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (TcPragEnv
    -> Bool
    -> [TcId]
    -> TcThetaType
    -> MonoBindInfo
    -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport (GhcPass 'Typechecked))
    mkExport TcPragEnv
    prag_fn Bool
    insoluble [TcId]
    qtvs TcThetaType
    inferred_theta) [MonoBindInfo]
    mono_infos

           ; SrcSpan
    loc <- TcRn SrcSpan
    getSrcSpanM
           ; let poly_ids :: [TcId]
    poly_ids = (ABExport (GhcPass 'Typechecked) -> TcId)
    -> [ABExport (GhcPass 'Typechecked)] -> [TcId]
    forall a b. (a -> b) -> [a] -> [b]
    map ABExport (GhcPass 'Typechecked) -> TcId
    forall p. ABExport p -> IdP p
    abe_poly [ABExport (GhcPass 'Typechecked)]
    exports
                 abs_bind :: GenLocated
      SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    abs_bind = SrcSpan
    -> HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
     -> GenLocated
          SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)))
    -> HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall a b. (a -> b) -> a -> b
    $
                            AbsBinds :: forall idL idR.
    XAbsBinds idL idR
    -> [TcId]
    -> [TcId]
    -> [ABExport idL]
    -> [TcEvBinds]
    -> LHsBinds idL
    -> Bool
    -> HsBindLR idL idR
    AbsBinds { abs_ext :: XAbsBinds (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    abs_ext = NoExtField
    XAbsBinds (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    noExtField
                                     , abs_tvs :: [TcId]
    abs_tvs = [TcId]
    qtvs
                                     , abs_ev_vars :: [TcId]
    abs_ev_vars = [TcId]
    givens, abs_ev_binds :: [TcEvBinds]
    abs_ev_binds = [TcEvBinds
    ev_binds]
                                     , abs_exports :: [ABExport (GhcPass 'Typechecked)]
    abs_exports = [ABExport (GhcPass 'Typechecked)]
    exports, abs_binds :: LHsBinds (GhcPass 'Typechecked)
    abs_binds = LHsBinds (GhcPass 'Typechecked)
    binds'
                                     , abs_sig :: Bool
    abs_sig = Bool
    False }

           ; String -> SDoc -> TcRn ()
    traceTc String
    "Binding:" ([(TcId, Kind)] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([TcId]
    poly_ids [TcId] -> TcThetaType -> [(TcId, Kind)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` (TcId -> Kind) -> [TcId] -> TcThetaType
    forall a b. (a -> b) -> [a] -> [b]
    map TcId -> Kind
    idType [TcId]
    poly_ids))
           ; (LHsBinds (GhcPass 'Typechecked), [TcId])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [TcId])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated
      SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    -> LHsBinds (GhcPass 'Typechecked)
    forall a. a -> Bag a
    unitBag GenLocated
      SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    abs_bind, [TcId]
    poly_ids) }
             -- poly_ids are guaranteed zonked by mkExport

    --------------
    mkExport :: TcPragEnv
             -> Bool                        -- True <=> there was an insoluble type error
                                            --          when typechecking the bindings
             -> [TyVar] -> TcThetaType      -- Both already zonked
             -> MonoBindInfo
             -> TcM (ABExport GhcTc)
    -- Only called for generalisation plan InferGen, not by CheckGen or NoGen
    --
    -- mkExport generates exports with
    --      zonked type variables,
    --      zonked poly_ids
    -- The former is just because no further unifications will change
    -- the quantified type variables, so we can fix their final form
    -- right now.
    -- The latter is needed because the poly_ids are used to extend the
    -- type environment; see the invariant on GHC.Tc.Utils.Env.tcExtendIdEnv

    -- Pre-condition: the qtvs and theta are already zonked

    mkExport :: TcPragEnv
    -> Bool
    -> [TcId]
    -> TcThetaType
    -> MonoBindInfo
    -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport (GhcPass 'Typechecked))
    mkExport TcPragEnv
    prag_fn Bool
    insoluble [TcId]
    qtvs TcThetaType
    theta
             mono_info :: MonoBindInfo
    mono_info@(MBI { mbi_poly_name :: MonoBindInfo -> Name
    mbi_poly_name = Name
    poly_name
                            , mbi_sig :: MonoBindInfo -> Maybe TcIdSigInst
    mbi_sig       = Maybe TcIdSigInst
    mb_sig
                            , mbi_mono_id :: MonoBindInfo -> TcId
    mbi_mono_id   = TcId
    mono_id })
      = do  { Kind
    mono_ty <- Kind -> TcM Kind
    zonkTcType (TcId -> Kind
    idType TcId
    mono_id)
            ; TcId
    poly_id <- Bool
    -> [TcId]
    -> TcThetaType
    -> Name
    -> Maybe TcIdSigInst
    -> Kind
    -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    mkInferredPolyId Bool
    insoluble [TcId]
    qtvs TcThetaType
    theta Name
    poly_name Maybe TcIdSigInst
    mb_sig Kind
    mono_ty

            -- NB: poly_id has a zonked type
            ; TcId
    poly_id <- TcId
    -> [LSig (GhcPass 'Renamed)] -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    addInlinePrags TcId
    poly_id [LSig (GhcPass 'Renamed)]
    prag_sigs
            ; [LTcSpecPrag]
    spec_prags <- TcId -> [LSig (GhcPass 'Renamed)] -> TcM [LTcSpecPrag]
    tcSpecPrags TcId
    poly_id [LSig (GhcPass 'Renamed)]
    prag_sigs
                    -- tcPrags requires a zonked poly_id

            -- See Note [Impedance matching]
            -- NB: we have already done checkValidType, including an ambiguity check,
            --     on the type; either when we checked the sig or in mkInferredPolyId
            ; let poly_ty :: Kind
    poly_ty     = TcId -> Kind
    idType TcId
    poly_id
                  sel_poly_ty :: Kind
    sel_poly_ty = [TcId] -> TcThetaType -> Kind -> Kind
    mkInfSigmaTy [TcId]
    qtvs TcThetaType
    theta Kind
    mono_ty
                    -- This type is just going into tcSubType,
                    -- so Inferred vs. Specified doesn't matter

            ; HsWrapper
    wrap <- if Kind
    sel_poly_ty Kind -> Kind -> Bool
    `eqType` Kind
    poly_ty  -- NB: eqType ignores visibility
                      then HsWrapper -> IOEnv (Env TcGblEnv TcLclEnv) HsWrapper
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsWrapper
    idHsWrapper  -- Fast path; also avoids complaint when we infer
                                               -- an ambiguous type and have AllowAmbiguousType
                                               -- e..g infer  x :: forall a. F a -> Int
                      else (TidyEnv -> TcM (TidyEnv, SDoc))
    -> IOEnv (Env TcGblEnv TcLclEnv) HsWrapper
    -> IOEnv (Env TcGblEnv TcLclEnv) HsWrapper
    forall a. (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    addErrCtxtM (MonoBindInfo -> Kind -> Kind -> TidyEnv -> TcM (TidyEnv, SDoc)
    mk_impedance_match_msg MonoBindInfo
    mono_info Kind
    sel_poly_ty Kind
    poly_ty) (IOEnv (Env TcGblEnv TcLclEnv) HsWrapper
     -> IOEnv (Env TcGblEnv TcLclEnv) HsWrapper)
    -> IOEnv (Env TcGblEnv TcLclEnv) HsWrapper
    -> IOEnv (Env TcGblEnv TcLclEnv) HsWrapper
    forall a b. (a -> b) -> a -> b
    $
                           UserTypeCtxt
    -> Kind -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) HsWrapper
    tcSubTypeSigma UserTypeCtxt
    sig_ctxt Kind
    sel_poly_ty Kind
    poly_ty

            ; Bool
    warn_missing_sigs <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnMissingLocalSignatures
            ; Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    warn_missing_sigs (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
                  WarningFlag -> TcId -> Maybe TcIdSigInst -> TcRn ()
    localSigWarn WarningFlag
    Opt_WarnMissingLocalSignatures TcId
    poly_id Maybe TcIdSigInst
    mb_sig

            ; ABExport (GhcPass 'Typechecked)
    -> IOEnv (Env TcGblEnv TcLclEnv) (ABExport (GhcPass 'Typechecked))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ABE :: forall p.
    XABE p -> IdP p -> IdP p -> HsWrapper -> TcSpecPrags -> ABExport p
    ABE { abe_ext :: XABE (GhcPass 'Typechecked)
    abe_ext = NoExtField
    XABE (GhcPass 'Typechecked)
    noExtField
                          , abe_wrap :: HsWrapper
    abe_wrap = HsWrapper
    wrap
                            -- abe_wrap :: idType poly_id ~ (forall qtvs. theta => mono_ty)
                          , abe_poly :: IdP (GhcPass 'Typechecked)
    abe_poly  = TcId
    IdP (GhcPass 'Typechecked)
    poly_id
                          , abe_mono :: IdP (GhcPass 'Typechecked)
    abe_mono  = TcId
    IdP (GhcPass 'Typechecked)
    mono_id
                          , abe_prags :: TcSpecPrags
    abe_prags = [LTcSpecPrag] -> TcSpecPrags
    SpecPrags [LTcSpecPrag]
    spec_prags }) }
      where
        prag_sigs :: [LSig (GhcPass 'Renamed)]
    prag_sigs = TcPragEnv -> Name -> [LSig (GhcPass 'Renamed)]
    lookupPragEnv TcPragEnv
    prag_fn Name
    poly_name
        sig_ctxt :: UserTypeCtxt
    sig_ctxt  = Name -> UserTypeCtxt
    InfSigCtxt Name
    poly_name

    mkInferredPolyId :: Bool  -- True <=> there was an insoluble error when
                              --          checking the binding group for this Id
                     -> [TyVar] -> TcThetaType
                     -> Name -> Maybe TcIdSigInst -> TcType
                     -> TcM TcId
    mkInferredPolyId :: Bool
    -> [TcId]
    -> TcThetaType
    -> Name
    -> Maybe TcIdSigInst
    -> Kind
    -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    mkInferredPolyId Bool
    insoluble [TcId]
    qtvs TcThetaType
    inferred_theta Name
    poly_name Maybe TcIdSigInst
    mb_sig_inst Kind
    mono_ty
      | Just (TISI { sig_inst_sig :: TcIdSigInst -> TcIdSigInfo
    sig_inst_sig = TcIdSigInfo
    sig })  <- Maybe TcIdSigInst
    mb_sig_inst
      , CompleteSig { sig_bndr :: TcIdSigInfo -> TcId
    sig_bndr = TcId
    poly_id } <- TcIdSigInfo
    sig
      = TcId -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcId
    poly_id

      | Bool
    otherwise  -- Either no type sig or partial type sig
      = IOEnv (Env TcGblEnv TcLclEnv) TcId
    -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    forall r. TcM r -> TcM r
    checkNoErrs (IOEnv (Env TcGblEnv TcLclEnv) TcId
     -> IOEnv (Env TcGblEnv TcLclEnv) TcId)
    -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    forall a b. (a -> b) -> a -> b
    $  -- The checkNoErrs ensures that if the type is ambiguous
                       -- we don't carry on to the impedance matching, and generate
                       -- a duplicate ambiguity error.  There is a similar
                       -- checkNoErrs for complete type signatures too.
        do { FamInstEnvs
    fam_envs <- TcM FamInstEnvs
    tcGetFamInstEnvs
           ; let (TcCoercionR
    _co, Kind
    mono_ty') = FamInstEnvs -> Role -> Kind -> (TcCoercionR, Kind)
    normaliseType FamInstEnvs
    fam_envs Role
    Nominal Kind
    mono_ty
                   -- Unification may not have normalised the type,
                   -- (see Note [Lazy flattening] in GHC.Tc.Solver.Flatten) so do it
                   -- here to make it as uncomplicated as possible.
                   -- Example: f :: [F Int] -> Bool
                   -- should be rewritten to f :: [Char] -> Bool, if possible
                   --
                   -- We can discard the coercion _co, because we'll reconstruct
                   -- it in the call to tcSubType below

           ; ([InvisTVBinder]
    binders, TcThetaType
    theta') <- TcThetaType
    -> TcTyVarSet
    -> [TcId]
    -> Maybe TcIdSigInst
    -> TcM ([InvisTVBinder], TcThetaType)
    chooseInferredQuantifiers TcThetaType
    inferred_theta
                                    (Kind -> TcTyVarSet
    tyCoVarsOfType Kind
    mono_ty') [TcId]
    qtvs Maybe TcIdSigInst
    mb_sig_inst

           ; let inferred_poly_ty :: Kind
    inferred_poly_ty = [InvisTVBinder] -> Kind -> Kind
    mkInvisForAllTys [InvisTVBinder]
    binders (TcThetaType -> Kind -> Kind
    mkPhiTy TcThetaType
    theta' Kind
    mono_ty')

           ; String -> SDoc -> TcRn ()
    traceTc String
    "mkInferredPolyId" ([SDoc] -> SDoc
    vcat [Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    poly_name, [TcId] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TcId]
    qtvs, TcThetaType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcThetaType
    theta'
                                              , Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    inferred_poly_ty])
           ; Bool -> TcRn () -> TcRn ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    insoluble (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
             (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcRn () -> TcRn ()
    forall a. (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    addErrCtxtM (Name -> Kind -> TidyEnv -> TcM (TidyEnv, SDoc)
    mk_inf_msg Name
    poly_name Kind
    inferred_poly_ty) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
             UserTypeCtxt -> Kind -> TcRn ()
    checkValidType (Name -> UserTypeCtxt
    InfSigCtxt Name
    poly_name) Kind
    inferred_poly_ty
             -- See Note [Validity of inferred types]
             -- If we found an insoluble error in the function definition, don't
             -- do this check; otherwise (#14000) we may report an ambiguity
             -- error for a rather bogus type.

           ; TcId -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HasDebugCallStack => Name -> Kind -> Kind -> TcId
    Name -> Kind -> Kind -> TcId
    mkLocalId Name
    poly_name Kind
    Many Kind
    inferred_poly_ty) }

    chooseInferredQuantifiers :: TcThetaType   -- inferred
                              -> TcTyVarSet    -- tvs free in tau type
                              -> [TcTyVar]     -- inferred quantified tvs
                              -> Maybe TcIdSigInst
                              -> TcM ([InvisTVBinder], TcThetaType)
    chooseInferredQuantifiers :: TcThetaType
    -> TcTyVarSet
    -> [TcId]
    -> Maybe TcIdSigInst
    -> TcM ([InvisTVBinder], TcThetaType)
    chooseInferredQuantifiers TcThetaType
    inferred_theta TcTyVarSet
    tau_tvs [TcId]
    qtvs Maybe TcIdSigInst
    Nothing
      = -- No type signature (partial or complete) for this binder,
        do { let free_tvs :: TcTyVarSet
    free_tvs = TcTyVarSet -> TcTyVarSet
    closeOverKinds (TcThetaType -> TcTyVarSet -> TcTyVarSet
    growThetaTyVars TcThetaType
    inferred_theta TcTyVarSet
    tau_tvs)
                            -- Include kind variables!  #7916
                 my_theta :: TcThetaType
    my_theta = TcTyVarSet -> TcThetaType -> TcThetaType
    pickCapturedPreds TcTyVarSet
    free_tvs TcThetaType
    inferred_theta
                 binders :: [InvisTVBinder]
    binders  = [ Specificity -> TcId -> InvisTVBinder
    forall vis. vis -> TcId -> VarBndr TcId vis
    mkTyVarBinder Specificity
    InferredSpec TcId
    tv
                            | TcId
    tv <- [TcId]
    qtvs
                            , TcId
    tv TcId -> TcTyVarSet -> Bool
    `elemVarSet` TcTyVarSet
    free_tvs ]
           ; ([InvisTVBinder], TcThetaType)
    -> TcM ([InvisTVBinder], TcThetaType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([InvisTVBinder]
    binders, TcThetaType
    my_theta) }

    chooseInferredQuantifiers TcThetaType
    inferred_theta TcTyVarSet
    tau_tvs [TcId]
    qtvs
                              (Just (TISI { sig_inst_sig :: TcIdSigInst -> TcIdSigInfo
    sig_inst_sig   = TcIdSigInfo
    sig  -- Always PartialSig
                                          , sig_inst_wcx :: TcIdSigInst -> Maybe Kind
    sig_inst_wcx   = Maybe Kind
    wcx
                                          , sig_inst_theta :: TcIdSigInst -> TcThetaType
    sig_inst_theta = TcThetaType
    annotated_theta
                                          , sig_inst_skols :: TcIdSigInst -> [(Name, InvisTVBinder)]
    sig_inst_skols = [(Name, InvisTVBinder)]
    annotated_tvs }))
      = -- Choose quantifiers for a partial type signature
        do { let ([Name]
    psig_qtv_nms, [InvisTVBinder]
    psig_qtv_bndrs) = [(Name, InvisTVBinder)] -> ([Name], [InvisTVBinder])
    forall a b. [(a, b)] -> ([a], [b])
    unzip [(Name, InvisTVBinder)]
    annotated_tvs
           ; [InvisTVBinder]
    psig_qtv_bndrs <- (InvisTVBinder -> IOEnv (Env TcGblEnv TcLclEnv) InvisTVBinder)
    -> [InvisTVBinder] -> IOEnv (Env TcGblEnv TcLclEnv) [InvisTVBinder]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM InvisTVBinder -> IOEnv (Env TcGblEnv TcLclEnv) InvisTVBinder
    forall spec. VarBndr TcId spec -> TcM (VarBndr TcId spec)
    zonkInvisTVBinder [InvisTVBinder]
    psig_qtv_bndrs
           ; let psig_qtvs :: [TcId]
    psig_qtvs    = (InvisTVBinder -> TcId) -> [InvisTVBinder] -> [TcId]
    forall a b. (a -> b) -> [a] -> [b]
    map InvisTVBinder -> TcId
    forall tv argf. VarBndr tv argf -> tv
    binderVar [InvisTVBinder]
    psig_qtv_bndrs
                 psig_qtv_set :: TcTyVarSet
    psig_qtv_set = [TcId] -> TcTyVarSet
    mkVarSet [TcId]
    psig_qtvs
                 psig_qtv_prs :: [(Name, TcId)]
    psig_qtv_prs = [Name]
    psig_qtv_nms [Name] -> [TcId] -> [(Name, TcId)]
    forall a b. [a] -> [b] -> [(a, b)]
    `zip` [TcId]
    psig_qtvs

                -- Check whether the quantified variables of the
                -- partial signature have been unified together
                -- See Note [Quantified variables in partial type signatures]
           ; ((Name, Name) -> TcRn ()) -> [(Name, Name)] -> TcRn ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Name, Name) -> TcRn ()
    report_dup_tyvar_tv_err  ([(Name, TcId)] -> [(Name, Name)]
    findDupTyVarTvs [(Name, TcId)]
    psig_qtv_prs)

                -- Check whether a quantified variable of the partial type
                -- signature is not actually quantified.  How can that happen?
                -- See Note [Quantification and partial signatures] Wrinkle 4
                --     in GHC.Tc.Solver
           ; (Name -> TcRn ()) -> [Name] -> TcRn ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Name -> TcRn ()
    report_mono_sig_tv_err [ Name
    n | (Name
    n,TcId
    tv) <- [(Name, TcId)]
    psig_qtv_prs
                                              , Bool -> Bool
    not (TcId
    tv TcId -> [TcId] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [TcId]
    qtvs) ]

           ; TcThetaType
    annotated_theta      <- TcThetaType -> TcM TcThetaType
    zonkTcTypes TcThetaType
    annotated_theta
           ; (TcTyVarSet
    free_tvs, TcThetaType
    my_theta) <- TcTyVarSet
    -> TcThetaType -> Maybe Kind -> TcM (TcTyVarSet, TcThetaType)
    choose_psig_context TcTyVarSet
    psig_qtv_set TcThetaType
    annotated_theta Maybe Kind
    wcx

           ; let keep_me :: TcTyVarSet
    keep_me    = TcTyVarSet
    free_tvs TcTyVarSet -> TcTyVarSet -> TcTyVarSet
    `unionVarSet` TcTyVarSet
    psig_qtv_set
                 final_qtvs :: [InvisTVBinder]
    final_qtvs = [ Specificity -> TcId -> InvisTVBinder
    forall vis. vis -> TcId -> VarBndr TcId vis
    mkTyVarBinder Specificity
    vis TcId
    tv
                              | TcId
    tv <- [TcId]
    qtvs -- Pulling from qtvs maintains original order
                              , TcId
    tv TcId -> TcTyVarSet -> Bool
    `elemVarSet` TcTyVarSet
    keep_me
                              , let vis :: Specificity
    vis = case TcId -> [InvisTVBinder] -> Maybe Specificity
    forall var flag. Eq var => var -> [VarBndr var flag] -> Maybe flag
    lookupVarBndr TcId
    tv [InvisTVBinder]
    psig_qtv_bndrs of
                                      Just Specificity
    spec -> Specificity
    spec
                                      Maybe Specificity
    Nothing   -> Specificity
    InferredSpec ]

           ; ([InvisTVBinder], TcThetaType)
    -> TcM ([InvisTVBinder], TcThetaType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([InvisTVBinder]
    final_qtvs, TcThetaType
    my_theta) }
      where
        report_dup_tyvar_tv_err :: (Name, Name) -> TcRn ()
    report_dup_tyvar_tv_err (Name
    n1,Name
    n2)
          | PartialSig { psig_name :: TcIdSigInfo -> Name
    psig_name = Name
    fn_name, psig_hs_ty :: TcIdSigInfo -> LHsSigWcType (GhcPass 'Renamed)
    psig_hs_ty = LHsSigWcType (GhcPass 'Renamed)
    hs_ty } <- TcIdSigInfo
    sig
          = SDoc -> TcRn ()
    addErrTc (SDoc -> BKey -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Couldn't match" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n1)
                            SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "with" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n2))
                         BKey
    2 (SDoc -> BKey -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "both bound by the partial type signature:")
                               BKey
    2 (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    fn_name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> LHsSigWcType (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsSigWcType (GhcPass 'Renamed)
    hs_ty)))

          | Bool
    otherwise -- Can't happen; by now we know it's a partial sig
          = String -> SDoc -> TcRn ()
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "report_tyvar_tv_err" (TcIdSigInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcIdSigInfo
    sig)

        report_mono_sig_tv_err :: Name -> TcRn ()
    report_mono_sig_tv_err Name
    n
          | PartialSig { psig_name :: TcIdSigInfo -> Name
    psig_name = Name
    fn_name, psig_hs_ty :: TcIdSigInfo -> LHsSigWcType (GhcPass 'Renamed)
    psig_hs_ty = LHsSigWcType (GhcPass 'Renamed)
    hs_ty } <- TcIdSigInfo
    sig
          = SDoc -> TcRn ()
    addErrTc (SDoc -> BKey -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Can't quantify over" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n))
                         BKey
    2 (SDoc -> BKey -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "bound by the partial type signature:")
                               BKey
    2 (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    fn_name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> LHsSigWcType (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsSigWcType (GhcPass 'Renamed)
    hs_ty)))
          | Bool
    otherwise -- Can't happen; by now we know it's a partial sig
          = String -> SDoc -> TcRn ()
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "report_mono_sig_tv_err" (TcIdSigInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcIdSigInfo
    sig)

        choose_psig_context :: VarSet -> TcThetaType -> Maybe TcType
                            -> TcM (VarSet, TcThetaType)
        choose_psig_context :: TcTyVarSet
    -> TcThetaType -> Maybe Kind -> TcM (TcTyVarSet, TcThetaType)
    choose_psig_context TcTyVarSet
    _ TcThetaType
    annotated_theta Maybe Kind
    Nothing
          = do { let free_tvs :: TcTyVarSet
    free_tvs = TcTyVarSet -> TcTyVarSet
    closeOverKinds (TcThetaType -> TcTyVarSet
    tyCoVarsOfTypes TcThetaType
    annotated_theta
                                                TcTyVarSet -> TcTyVarSet -> TcTyVarSet
    `unionVarSet` TcTyVarSet
    tau_tvs)
               ; (TcTyVarSet, TcThetaType) -> TcM (TcTyVarSet, TcThetaType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcTyVarSet
    free_tvs, TcThetaType
    annotated_theta) }

        choose_psig_context TcTyVarSet
    psig_qtvs TcThetaType
    annotated_theta (Just Kind
    wc_var_ty)
          = do { let free_tvs :: TcTyVarSet
    free_tvs = TcTyVarSet -> TcTyVarSet
    closeOverKinds (TcThetaType -> TcTyVarSet -> TcTyVarSet
    growThetaTyVars TcThetaType
    inferred_theta TcTyVarSet
    seed_tvs)
                                -- growThetaVars just like the no-type-sig case
                                -- Omitting this caused #12844
                     seed_tvs :: TcTyVarSet
    seed_tvs = TcThetaType -> TcTyVarSet
    tyCoVarsOfTypes TcThetaType
    annotated_theta  -- These are put there
                                TcTyVarSet -> TcTyVarSet -> TcTyVarSet
    `unionVarSet` TcTyVarSet
    tau_tvs            --       by the user

               ; let keep_me :: TcTyVarSet
    keep_me  = TcTyVarSet
    psig_qtvs TcTyVarSet -> TcTyVarSet -> TcTyVarSet
    `unionVarSet` TcTyVarSet
    free_tvs
                     my_theta :: TcThetaType
    my_theta = TcTyVarSet -> TcThetaType -> TcThetaType
    pickCapturedPreds TcTyVarSet
    keep_me TcThetaType
    inferred_theta

               -- Fill in the extra-constraints wildcard hole with inferred_theta,
               -- so that the Hole constraint we have already emitted
               -- (in tcHsPartialSigType) can report what filled it in.
               -- NB: my_theta already includes all the annotated constraints
               ; let inferred_diff :: TcThetaType
    inferred_diff = [ Kind
    pred
                                     | Kind
    pred <- TcThetaType
    my_theta
                                     , (Kind -> Bool) -> TcThetaType -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Bool -> Bool
    not (Bool -> Bool) -> (Kind -> Bool) -> Kind -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Kind -> Kind -> Bool
    `eqType` Kind
    pred)) TcThetaType
    annotated_theta ]
               ; Kind
    ctuple <- TcThetaType -> TcM Kind
    forall {m :: * -> *}. Monad m => TcThetaType -> m Kind
    mk_ctuple TcThetaType
    inferred_diff

               ; case Kind -> Maybe (TcId, TcCoercionR)
    tcGetCastedTyVar_maybe Kind
    wc_var_ty of
                   -- We know that wc_co must have type kind(wc_var) ~ Constraint, as it
                   -- comes from the checkExpectedKind in GHC.Tc.Gen.HsType.tcAnonWildCardOcc. So, to
                   -- make the kinds work out, we reverse the cast here.
                   Just (TcId
    wc_var, TcCoercionR
    wc_co) -> TcId -> Kind -> TcRn ()
    writeMetaTyVar TcId
    wc_var (Kind
    ctuple Kind -> TcCoercionR -> Kind
    `mkCastTy` TcCoercionR -> TcCoercionR
    mkTcSymCo TcCoercionR
    wc_co)
                   Maybe (TcId, TcCoercionR)
    Nothing              -> String -> SDoc -> TcRn ()
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "chooseInferredQuantifiers 1" (Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    wc_var_ty)

               ; String -> SDoc -> TcRn ()
    traceTc String
    "completeTheta" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
                    [SDoc] -> SDoc
    vcat [ TcIdSigInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcIdSigInfo
    sig
                         , TcThetaType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcThetaType
    annotated_theta, TcThetaType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcThetaType
    inferred_theta
                         , TcThetaType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcThetaType
    inferred_diff ]
               ; (TcTyVarSet, TcThetaType) -> TcM (TcTyVarSet, TcThetaType)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcTyVarSet
    free_tvs, TcThetaType
    my_theta) }

        mk_ctuple :: TcThetaType -> m Kind
    mk_ctuple TcThetaType
    preds = Kind -> m Kind
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcThetaType -> Kind
    mkBoxedTupleTy TcThetaType
    preds)
           -- Hack alert!  See GHC.Tc.Gen.HsType:
           -- Note [Extra-constraint holes in partial type signatures]

    mk_impedance_match_msg :: MonoBindInfo
                           -> TcType -> TcType
                           -> TidyEnv -> TcM (TidyEnv, SDoc)
    -- This is a rare but rather awkward error messages
    mk_impedance_match_msg :: MonoBindInfo -> Kind -> Kind -> TidyEnv -> TcM (TidyEnv, SDoc)
    mk_impedance_match_msg (MBI { mbi_poly_name :: MonoBindInfo -> Name
    mbi_poly_name = Name
    name, mbi_sig :: MonoBindInfo -> Maybe TcIdSigInst
    mbi_sig = Maybe TcIdSigInst
    mb_sig })
                           Kind
    inf_ty Kind
    sig_ty TidyEnv
    tidy_env
     = do { (TidyEnv
    tidy_env1, Kind
    inf_ty) <- TidyEnv -> Kind -> TcM (TidyEnv, Kind)
    zonkTidyTcType TidyEnv
    tidy_env  Kind
    inf_ty
          ; (TidyEnv
    tidy_env2, Kind
    sig_ty) <- TidyEnv -> Kind -> TcM (TidyEnv, Kind)
    zonkTidyTcType TidyEnv
    tidy_env1 Kind
    sig_ty
          ; let msg :: SDoc
    msg = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "When checking that the inferred type"
                           , BKey -> SDoc -> SDoc
    nest BKey
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    inf_ty
                           , String -> SDoc
    text String
    "is as general as its" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "signature"
                           , BKey -> SDoc -> SDoc
    nest BKey
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    sig_ty ]
          ; (TidyEnv, SDoc) -> TcM (TidyEnv, SDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TidyEnv
    tidy_env2, SDoc
    msg) }
      where
        what :: SDoc
    what = case Maybe TcIdSigInst
    mb_sig of
                 Maybe TcIdSigInst
    Nothing                     -> String -> SDoc
    text String
    "inferred"
                 Just TcIdSigInst
    sig | TcIdSigInst -> Bool
    isPartialSig TcIdSigInst
    sig -> String -> SDoc
    text String
    "(partial)"
                          | Bool
    otherwise        -> SDoc
    empty

    mk_inf_msg :: Name -> TcType -> TidyEnv -> TcM (TidyEnv, SDoc)
    mk_inf_msg :: Name -> Kind -> TidyEnv -> TcM (TidyEnv, SDoc)
    mk_inf_msg Name
    poly_name Kind
    poly_ty TidyEnv
    tidy_env
     = do { (TidyEnv
    tidy_env1, Kind
    poly_ty) <- TidyEnv -> Kind -> TcM (TidyEnv, Kind)
    zonkTidyTcType TidyEnv
    tidy_env Kind
    poly_ty
          ; let msg :: SDoc
    msg = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "When checking the inferred type"
                           , BKey -> SDoc -> SDoc
    nest BKey
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    poly_name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    poly_ty ]
          ; (TidyEnv, SDoc) -> TcM (TidyEnv, SDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TidyEnv
    tidy_env1, SDoc
    msg) }

    -- | Warn the user about polymorphic local binders that lack type signatures.
    localSigWarn :: WarningFlag -> Id -> Maybe TcIdSigInst -> TcM ()
    localSigWarn :: WarningFlag -> TcId -> Maybe TcIdSigInst -> TcRn ()
    localSigWarn WarningFlag
    flag TcId
    id Maybe TcIdSigInst
    mb_sig
      | Just TcIdSigInst
    _ <- Maybe TcIdSigInst
    mb_sig               = () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | Bool -> Bool
    not (Kind -> Bool
    isSigmaTy (TcId -> Kind
    idType TcId
    id))    = () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | Bool
    otherwise                      = WarningFlag -> SDoc -> TcId -> TcRn ()
    warnMissingSignatures WarningFlag
    flag SDoc
    msg TcId
    id
      where
        msg :: SDoc
    msg = String -> SDoc
    text String
    "Polymorphic local binding with no type signature:"

    warnMissingSignatures :: WarningFlag -> SDoc -> Id -> TcM ()
    warnMissingSignatures :: WarningFlag -> SDoc -> TcId -> TcRn ()
    warnMissingSignatures WarningFlag
    flag SDoc
    msg TcId
    id
      = do  { TidyEnv
    env0 <- TcM TidyEnv
    tcInitTidyEnv
            ; let (TidyEnv
    env1, Kind
    tidy_ty) = TidyEnv -> Kind -> (TidyEnv, Kind)
    tidyOpenType TidyEnv
    env0 (TcId -> Kind
    idType TcId
    id)
            ; WarnReason -> (TidyEnv, SDoc) -> TcRn ()
    addWarnTcM (WarningFlag -> WarnReason
    Reason WarningFlag
    flag) (TidyEnv
    env1, Kind -> SDoc
    mk_msg Kind
    tidy_ty) }
      where
        mk_msg :: Kind -> SDoc
    mk_msg Kind
    ty = [SDoc] -> SDoc
    sep [ SDoc
    msg, BKey -> SDoc -> SDoc
    nest BKey
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Name -> SDoc
    forall a. NamedThing a => a -> SDoc
    pprPrefixName (TcId -> Name
    idName TcId
    id) SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    ty ]

    checkOverloadedSig :: Bool -> TcIdSigInst -> TcM ()
    -- Example:
    --   f :: Eq a => a -> a
    --   K f = e
    -- The MR applies, but the signature is overloaded, and it's
    -- best to complain about this directly
    -- c.f #11339
    checkOverloadedSig :: Bool -> TcIdSigInst -> TcRn ()
    checkOverloadedSig Bool
    monomorphism_restriction_applies TcIdSigInst
    sig
      | Bool -> Bool
    not (TcThetaType -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (TcIdSigInst -> TcThetaType
    sig_inst_theta TcIdSigInst
    sig))
      , Bool
    monomorphism_restriction_applies
      , let orig_sig :: TcIdSigInfo
    orig_sig = TcIdSigInst -> TcIdSigInfo
    sig_inst_sig TcIdSigInst
    sig
      = SrcSpan -> TcRn () -> TcRn ()
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (TcIdSigInfo -> SrcSpan
    sig_loc TcIdSigInfo
    orig_sig) (TcRn () -> TcRn ()) -> TcRn () -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
        SDoc -> TcRn ()
    forall a. SDoc -> TcM a
    failWith (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $
        SDoc -> BKey -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Overloaded signature conflicts with monomorphism restriction")
           BKey
    2 (TcIdSigInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcIdSigInfo
    orig_sig)
      | Bool
    otherwise
      = () -> TcRn ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    {- Note [Partial type signatures and generalisation]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If /any/ of the signatures in the group is a partial type signature
       f :: _ -> Int
    then we *always* use the InferGen plan, and hence tcPolyInfer.
    We do this even for a local binding with -XMonoLocalBinds, when
    we normally use NoGen.

    Reasons:
      * The TcSigInfo for 'f' has a unification variable for the '_',
        whose TcLevel is one level deeper than the current level.
        (See pushTcLevelM in tcTySig.)  But NoGen doesn't increase
        the TcLevel like InferGen, so we lose the level invariant.

      * The signature might be   f :: forall a. _ -> a
        so it really is polymorphic.  It's not clear what it would
        mean to use NoGen on this, and indeed the ASSERT in tcLhs,
        in the (Just sig) case, checks that if there is a signature
        then we are using LetLclBndr, and hence a nested AbsBinds with
        increased TcLevel

    It might be possible to fix these difficulties somehow, but there
    doesn't seem much point.  Indeed, adding a partial type signature is a
    way to get per-binding inferred generalisation.

    We apply the MR if /all/ of the partial signatures lack a context.
    In particular (#11016):
       f2 :: (?loc :: Int) => _
       f2 = ?loc
    It's stupid to apply the MR here.  This test includes an extra-constraints
    wildcard; that is, we don't apply the MR if you write
       f3 :: _ => blah

    Note [Quantified variables in partial type signatures]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
      f :: forall a. a -> a -> _
      f x y = g x y
      g :: forall b. b -> b -> _
      g x y = [x, y]

    Here, 'f' and 'g' are mutually recursive, and we end up unifying 'a' and 'b'
    together, which is fine.  So we bind 'a' and 'b' to TyVarTvs, which can then
    unify with each other.

    But now consider:
      f :: forall a b. a -> b -> _
      f x y = [x, y]

    We want to get an error from this, because 'a' and 'b' get unified.
    So we make a test, one per partial signature, to check that the
    explicitly-quantified type variables have not been unified together.
    #14449 showed this up.

    Note [Validity of inferred types]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We need to check inferred type for validity, in case it uses language
    extensions that are not turned on.  The principle is that if the user
    simply adds the inferred type to the program source, it'll compile fine.
    See #8883.

    Examples that might fail:
     - the type might be ambiguous

     - an inferred theta that requires type equalities e.g. (F a ~ G b)
                                    or multi-parameter type classes
     - an inferred type that includes unboxed tuples

    Note [Impedance matching]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
       f 0 x = x
       f n x = g [] (not x)

       g [] y = f 10 y
       g _  y = f 9  y

    After typechecking we'll get
      f_mono_ty :: a -> Bool -> Bool
      g_mono_ty :: [b] -> Bool -> Bool
    with constraints
      (Eq a, Num a)

    Note that f is polymorphic in 'a' and g in 'b'; and these are not linked.
    The types we really want for f and g are
       f :: forall a. (Eq a, Num a) => a -> Bool -> Bool
       g :: forall b. [b] -> Bool -> Bool

    We can get these by "impedance matching":
       tuple :: forall a b. (Eq a, Num a) => (a -> Bool -> Bool, [b] -> Bool -> Bool)
       tuple a b d1 d1 = let ...bind f_mono, g_mono in (f_mono, g_mono)

       f a d1 d2 = case tuple a Any d1 d2 of (f, g) -> f
       g b = case tuple Integer b dEqInteger dNumInteger of (f,g) -> g

    Suppose the shared quantified tyvars are qtvs and constraints theta.
    Then we want to check that
         forall qtvs. theta => f_mono_ty   is more polymorphic than   f's polytype
    and the proof is the impedance matcher.

    Notice that the impedance matcher may do defaulting.  See #7173.

    It also cleverly does an ambiguity check; for example, rejecting
       f :: F a -> F a
    where F is a non-injective type function.
    -}

    {-
    Note [SPECIALISE pragmas]
    ~~~~~~~~~~~~~~~~~~~~~~~~~
    There is no point in a SPECIALISE pragma for a non-overloaded function:
       reverse :: [a] -> [a]
       {-# SPECIALISE reverse :: [Int] -> [Int] #-}

    But SPECIALISE INLINE *can* make sense for GADTS:
       data Arr e where
         ArrInt :: !Int -> ByteArray# -> Arr Int
         ArrPair :: !Int -> Arr e1 -> Arr e2 -> Arr (e1, e2)

       (!:) :: Arr e -> Int -> e
       {-# SPECIALISE INLINE (!:) :: Arr Int -> Int -> Int #-}
       {-# SPECIALISE INLINE (!:) :: Arr (a, b) -> Int -> (a, b) #-}
       (ArrInt _ ba)     !: (I# i) = I# (indexIntArray# ba i)
       (ArrPair _ a1 a2) !: i      = (a1 !: i, a2 !: i)

    When (!:) is specialised it becomes non-recursive, and can usefully
    be inlined.  Scary!  So we only warn for SPECIALISE *without* INLINE
    for a non-overloaded function.

    ************************************************************************
    *                                                                      *
                             tcMonoBinds
    *                                                                      *
    ************************************************************************

    @tcMonoBinds@ deals with a perhaps-recursive group of HsBinds.
    The signatures have been dealt with already.
    -}

    data MonoBindInfo = MBI { MonoBindInfo -> Name
    mbi_poly_name :: Name
                            , MonoBindInfo -> Maybe TcIdSigInst
    mbi_sig       :: Maybe TcIdSigInst
                            , MonoBindInfo -> TcId
    mbi_mono_id   :: TcId }

    tcMonoBinds :: RecFlag  -- Whether the binding is recursive for typechecking purposes
                            -- i.e. the binders are mentioned in their RHSs, and
                            --      we are not rescued by a type signature
                -> TcSigFun -> LetBndrSpec
                -> [LHsBind GhcRn]
                -> TcM (LHsBinds GhcTc, [MonoBindInfo])
    tcMonoBinds :: RecFlag
    -> TcSigFun
    -> LetBndrSpec
    -> [LHsBind (GhcPass 'Renamed)]
    -> TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    tcMonoBinds RecFlag
    is_rec TcSigFun
    sig_fn LetBndrSpec
    no_gen
               [ L SrcSpan
    b_loc (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
    fun_id = L SrcSpan
    nm_loc IdP (GhcPass 'Renamed)
    name
                                  , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
    fun_matches = MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    matches })]
                                 -- Single function binding,
      | RecFlag
    NonRecursive <- RecFlag
    is_rec   -- ...binder isn't mentioned in RHS
      , Maybe TcSigInfo
    Nothing <- TcSigFun
    sig_fn Name
    IdP (GhcPass 'Renamed)
    name   -- ...with no type signature
      =     -- Note [Single function non-recursive binding special-case]
            -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
            -- In this very special case we infer the type of the
            -- right hand side first (it may have a higher-rank type)
            -- and *then* make the monomorphic Id for the LHS
            -- e.g.         f = \(x::forall a. a->a) -> <body>
            --      We want to infer a higher-rank type for f
        SrcSpan
    -> TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    b_loc    (TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
     -> TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo]))
    -> TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    forall a b. (a -> b) -> a -> b
    $
        do  { ((HsWrapper
    co_fn, MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))
    matches'), Kind
    rhs_ty)
                <- (ExpSigmaType
     -> TcM
          (HsWrapper,
           MatchGroup
             (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    -> TcM
         ((HsWrapper,
           MatchGroup
             (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))),
          Kind)
    forall a. (ExpSigmaType -> TcM a) -> TcM (a, Kind)
    tcInfer ((ExpSigmaType
      -> TcM
           (HsWrapper,
            MatchGroup
              (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
     -> TcM
          ((HsWrapper,
            MatchGroup
              (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))),
           Kind))
    -> (ExpSigmaType
        -> TcM
             (HsWrapper,
              MatchGroup
                (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    -> TcM
         ((HsWrapper,
           MatchGroup
             (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))),
          Kind)
    forall a b. (a -> b) -> a -> b
    $ \ ExpSigmaType
    exp_ty ->
                   [TcBinder]
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    forall a. [TcBinder] -> TcM a -> TcM a
    tcExtendBinderStack [Name -> ExpSigmaType -> TopLevelFlag -> TcBinder
    TcIdBndr_ExpType Name
    IdP (GhcPass 'Renamed)
    name ExpSigmaType
    exp_ty TopLevelFlag
    NotTopLevel] (TcM
       (HsWrapper,
        MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
     -> TcM
          (HsWrapper,
           MatchGroup
             (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    forall a b. (a -> b) -> a -> b
    $
                      -- We extend the error context even for a non-recursive
                      -- function so that in type error messages we show the
                      -- type of the thing whose rhs we are type checking
                   Located Name
    -> MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    -> ExpSigmaType
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    tcMatchesFun (SrcSpan -> Name -> Located Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    nm_loc Name
    IdP (GhcPass 'Renamed)
    name) MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    matches ExpSigmaType
    exp_ty

            ; TcId
    mono_id <- LetBndrSpec
    -> Name -> Kind -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    newLetBndr LetBndrSpec
    no_gen Name
    IdP (GhcPass 'Renamed)
    name Kind
    Many Kind
    rhs_ty
            ; (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated
      SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    -> LHsBinds (GhcPass 'Typechecked)
    forall a. a -> Bag a
    unitBag (GenLocated
       SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
     -> LHsBinds (GhcPass 'Typechecked))
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    -> LHsBinds (GhcPass 'Typechecked)
    forall a b. (a -> b) -> a -> b
    $ SrcSpan
    -> HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    b_loc (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
     -> GenLocated
          SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)))
    -> HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall a b. (a -> b) -> a -> b
    $
                         FunBind :: forall idL idR.
    XFunBind idL idR
    -> Located (IdP idL)
    -> MatchGroup idR (LHsExpr idR)
    -> [Tickish TcId]
    -> HsBindLR idL idR
    FunBind { fun_id :: Located (IdP (GhcPass 'Typechecked))
    fun_id = SrcSpan -> TcId -> GenLocated SrcSpan TcId
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    nm_loc TcId
    mono_id,
                                   fun_matches :: MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))
    fun_matches = MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))
    matches',
                                   fun_ext :: XFunBind (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    fun_ext = XFunBind (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    HsWrapper
    co_fn, fun_tick :: [Tickish TcId]
    fun_tick = [] },
                      [MBI :: Name -> Maybe TcIdSigInst -> TcId -> MonoBindInfo
    MBI { mbi_poly_name :: Name
    mbi_poly_name = Name
    IdP (GhcPass 'Renamed)
    name
                           , mbi_sig :: Maybe TcIdSigInst
    mbi_sig       = Maybe TcIdSigInst
    forall a. Maybe a
    Nothing
                           , mbi_mono_id :: TcId
    mbi_mono_id   = TcId
    mono_id }]) }

    tcMonoBinds RecFlag
    _ TcSigFun
    sig_fn LetBndrSpec
    no_gen [LHsBind (GhcPass 'Renamed)]
    binds
      = do  { [Located TcMonoBind]
    tc_binds <- (LHsBind (GhcPass 'Renamed)
     -> IOEnv (Env TcGblEnv TcLclEnv) (Located TcMonoBind))
    -> [LHsBind (GhcPass 'Renamed)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [Located TcMonoBind]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> TcM TcMonoBind)
    -> LHsBind (GhcPass 'Renamed)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Located TcMonoBind)
    forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
    wrapLocM (TcSigFun
    -> LetBndrSpec
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> TcM TcMonoBind
    tcLhs TcSigFun
    sig_fn LetBndrSpec
    no_gen)) [LHsBind (GhcPass 'Renamed)]
    binds

            -- Bring the monomorphic Ids, into scope for the RHSs
            ; let mono_infos :: [MonoBindInfo]
    mono_infos = [Located TcMonoBind] -> [MonoBindInfo]
    getMonoBindInfo [Located TcMonoBind]
    tc_binds
                  rhs_id_env :: [(Name, TcId)]
    rhs_id_env = [ (Name
    name, TcId
    mono_id)
                               | MBI { mbi_poly_name :: MonoBindInfo -> Name
    mbi_poly_name = Name
    name
                                     , mbi_sig :: MonoBindInfo -> Maybe TcIdSigInst
    mbi_sig       = Maybe TcIdSigInst
    mb_sig
                                     , mbi_mono_id :: MonoBindInfo -> TcId
    mbi_mono_id   = TcId
    mono_id } <- [MonoBindInfo]
    mono_infos
                               , case Maybe TcIdSigInst
    mb_sig of
                                   Just TcIdSigInst
    sig -> TcIdSigInst -> Bool
    isPartialSig TcIdSigInst
    sig
                                   Maybe TcIdSigInst
    Nothing  -> Bool
    True ]
                    -- A monomorphic binding for each term variable that lacks
                    -- a complete type sig.  (Ones with a sig are already in scope.)

            ; String -> SDoc -> TcRn ()
    traceTc String
    "tcMonoBinds" (SDoc -> TcRn ()) -> SDoc -> TcRn ()
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat [ Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    n SDoc -> SDoc -> SDoc
    <+> TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    id SDoc -> SDoc -> SDoc
    <+> Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcId -> Kind
    idType TcId
    id)
                                           | (Name
    n,TcId
    id) <- [(Name, TcId)]
    rhs_id_env]
            ; [GenLocated
       SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))]
    binds' <- [(Name, TcId)]
    -> TcM
         [GenLocated
            SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))]
    -> TcM
         [GenLocated
            SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))]
    forall a. [(Name, TcId)] -> TcM a -> TcM a
    tcExtendRecIds [(Name, TcId)]
    rhs_id_env (TcM
       [GenLocated
          SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))]
     -> TcM
          [GenLocated
             SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))])
    -> TcM
         [GenLocated
            SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))]
    -> TcM
         [GenLocated
            SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))]
    forall a b. (a -> b) -> a -> b
    $
                        (Located TcMonoBind
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (GenLocated
             SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))))
    -> [Located TcMonoBind]
    -> TcM
         [GenLocated
            SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((TcMonoBind
     -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)))
    -> Located TcMonoBind
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (GenLocated
            SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)))
    forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
    wrapLocM TcMonoBind
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    tcRhs) [Located TcMonoBind]
    tc_binds

            ; (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    -> TcM (LHsBinds (GhcPass 'Typechecked), [MonoBindInfo])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([GenLocated
       SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))]
    -> LHsBinds (GhcPass 'Typechecked)
    forall a. [a] -> Bag a
    listToBag [GenLocated
       SrcSpan (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))]
    binds', [MonoBindInfo]
    mono_infos) }

    ------------------------
    -- tcLhs typechecks the LHS of the bindings, to construct the environment in which
    -- we typecheck the RHSs.  Basically what we are doing is this: for each binder:
    --      if there's a signature for it, use the instantiated signature type
    --      otherwise invent a type variable
    -- You see that quite directly in the FunBind case.
    --
    -- But there's a complication for pattern bindings:
    --      data T = MkT (forall a. a->a)
    --      MkT f = e
    -- Here we can guess a type variable for the entire LHS (which will be refined to T)
    -- but we want to get (f::forall a. a->a) as the RHS environment.
    -- The simplest way to do this is to typecheck the pattern, and then look up the
    -- bound mono-ids.  Then we want to retain the typechecked pattern to avoid re-doing
    -- it; hence the TcMonoBind data type in which the LHS is done but the RHS isn't

    data TcMonoBind         -- Half completed; LHS done, RHS not done
      = TcFunBind  MonoBindInfo  SrcSpan (MatchGroup GhcRn (LHsExpr GhcRn))
      | TcPatBind [MonoBindInfo] (LPat GhcTc) (GRHSs GhcRn (LHsExpr GhcRn))
                  TcSigmaType

    tcLhs :: TcSigFun -> LetBndrSpec -> HsBind GhcRn -> TcM TcMonoBind
    -- Only called with plan InferGen (LetBndrSpec = LetLclBndr)
    --                    or NoGen    (LetBndrSpec = LetGblBndr)
    -- CheckGen is used only for functions with a complete type signature,
    --          and tcPolyCheck doesn't use tcMonoBinds at all

    tcLhs :: TcSigFun
    -> LetBndrSpec
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> TcM TcMonoBind
    tcLhs TcSigFun
    sig_fn LetBndrSpec
    no_gen (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
    fun_id = L SrcSpan
    nm_loc IdP (GhcPass 'Renamed)
    name
                                 , fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
    fun_matches = MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    matches })
      | Just (TcIdSig TcIdSigInfo
    sig) <- TcSigFun
    sig_fn Name
    IdP (GhcPass 'Renamed)
    name
      = -- There is a type signature.
        -- It must be partial; if complete we'd be in tcPolyCheck!
        --    e.g.   f :: _ -> _
        --           f x = ...g...
        --           Just g = ...f...
        -- Hence always typechecked with InferGen
        do { MonoBindInfo
    mono_info <- LetBndrSpec -> (Name, TcIdSigInfo) -> TcM MonoBindInfo
    tcLhsSigId LetBndrSpec
    no_gen (Name
    IdP (GhcPass 'Renamed)
    name, TcIdSigInfo
    sig)
           ; TcMonoBind -> TcM TcMonoBind
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MonoBindInfo
    -> SrcSpan
    -> MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    -> TcMonoBind
    TcFunBind MonoBindInfo
    mono_info SrcSpan
    nm_loc MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    matches) }

      | Bool
    otherwise  -- No type signature
      = do { Kind
    mono_ty <- TcM Kind
    newOpenFlexiTyVarTy
           ; TcId
    mono_id <- LetBndrSpec
    -> Name -> Kind -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    newLetBndr LetBndrSpec
    no_gen Name
    IdP (GhcPass 'Renamed)
    name Kind
    Many Kind
    mono_ty
              -- This ^ generates a binder with Many multiplicity because all
              -- let/where-binders are unrestricted. When we introduce linear let
              -- binders, we will need to retrieve the multiplicity information.
           ; let mono_info :: MonoBindInfo
    mono_info = MBI :: Name -> Maybe TcIdSigInst -> TcId -> MonoBindInfo
    MBI { mbi_poly_name :: Name
    mbi_poly_name = Name
    IdP (GhcPass 'Renamed)
    name
                                 , mbi_sig :: Maybe TcIdSigInst
    mbi_sig       = Maybe TcIdSigInst
    forall a. Maybe a
    Nothing
                                 , mbi_mono_id :: TcId
    mbi_mono_id   = TcId
    mono_id }
           ; TcMonoBind -> TcM TcMonoBind
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MonoBindInfo
    -> SrcSpan
    -> MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    -> TcMonoBind
    TcFunBind MonoBindInfo
    mono_info SrcSpan
    nm_loc MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    matches) }

    tcLhs TcSigFun
    sig_fn LetBndrSpec
    no_gen (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
    pat_lhs = LPat (GhcPass 'Renamed)
    pat, pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
    pat_rhs = GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    grhss })
      = -- See Note [Typechecking pattern bindings]
        do  { [MonoBindInfo]
    sig_mbis <- ((Name, TcIdSigInfo) -> TcM MonoBindInfo)
    -> [(Name, TcIdSigInfo)]
    -> IOEnv (Env TcGblEnv TcLclEnv) [MonoBindInfo]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (LetBndrSpec -> (Name, TcIdSigInfo) -> TcM MonoBindInfo
    tcLhsSigId LetBndrSpec
    no_gen) [(Name, TcIdSigInfo)]
    sig_names

            ; let inst_sig_fun :: Name -> Maybe TcId
    inst_sig_fun = NameEnv TcId -> Name -> Maybe TcId
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv (NameEnv TcId -> Name -> Maybe TcId)
    -> NameEnv TcId -> Name -> Maybe TcId
    forall a b. (a -> b) -> a -> b
    $ [(Name, TcId)] -> NameEnv TcId
    forall a. [(Name, a)] -> NameEnv a
    mkNameEnv ([(Name, TcId)] -> NameEnv TcId) -> [(Name, TcId)] -> NameEnv TcId
    forall a b. (a -> b) -> a -> b
    $
                                 [ (MonoBindInfo -> Name
    mbi_poly_name MonoBindInfo
    mbi, MonoBindInfo -> TcId
    mbi_mono_id MonoBindInfo
    mbi)
                                 | MonoBindInfo
    mbi <- [MonoBindInfo]
    sig_mbis ]

                -- See Note [Existentials in pattern bindings]
            ; ((Located (Pat (GhcPass 'Typechecked))
    pat', [MonoBindInfo]
    nosig_mbis), Kind
    pat_ty)
                <- SDoc
    -> TcM
         ((Located (Pat (GhcPass 'Typechecked)), [MonoBindInfo]), Kind)
    -> TcM
         ((Located (Pat (GhcPass 'Typechecked)), [MonoBindInfo]), Kind)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (LPat (GhcPass 'Renamed)
    -> GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed)) -> SDoc
    forall (p :: Pass) body.
    (OutputableBndrId p, Outputable body) =>
    LPat (GhcPass p) -> GRHSs (GhcPass 'Renamed) body -> SDoc
    patMonoBindsCtxt LPat (GhcPass 'Renamed)
    pat GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    grhss) (TcM ((Located (Pat (GhcPass 'Typechecked)), [MonoBindInfo]), Kind)
     -> TcM
          ((Located (Pat (GhcPass 'Typechecked)), [MonoBindInfo]), Kind))
    -> TcM
         ((Located (Pat (GhcPass 'Typechecked)), [MonoBindInfo]), Kind)
    -> TcM
         ((Located (Pat (GhcPass 'Typechecked)), [MonoBindInfo]), Kind)
    forall a b. (a -> b) -> a -> b
    $
                   (ExpSigmaType
     -> TcM (Located (Pat (GhcPass 'Typechecked)), [MonoBindInfo]))
    -> TcM
         ((Located (Pat (GhcPass 'Typechecked)), [MonoBindInfo]), Kind)
    forall a. (ExpSigmaType -> TcM a) -> TcM (a, Kind)
    tcInfer ((ExpSigmaType
      -> TcM (Located (Pat (GhcPass 'Typechecked)), [MonoBindInfo]))
     -> TcM
          ((Located (Pat (GhcPass 'Typechecked)), [MonoBindInfo]), Kind))
    -> (ExpSigmaType
        -> TcM (Located (Pat (GhcPass 'Typechecked)), [MonoBindInfo]))
    -> TcM
         ((Located (Pat (GhcPass 'Typechecked)), [MonoBindInfo]), Kind)
    forall a b. (a -> b) -> a -> b
    $ \ ExpSigmaType
    exp_ty ->
                   (Name -> Maybe TcId)
    -> LetBndrSpec
    -> LPat (GhcPass 'Renamed)
    -> Scaled ExpSigmaType
    -> IOEnv (Env TcGblEnv TcLclEnv) [MonoBindInfo]
    -> TcM (LPat (GhcPass 'Typechecked), [MonoBindInfo])
    forall a.
    (Name -> Maybe TcId)
    -> LetBndrSpec
    -> LPat (GhcPass 'Renamed)
    -> Scaled ExpSigmaType
    -> TcM a
    -> TcM (LPat (GhcPass 'Typechecked), a)
    tcLetPat Name -> Maybe TcId
    inst_sig_fun LetBndrSpec
    no_gen LPat (GhcPass 'Renamed)
    pat (ExpSigmaType -> Scaled ExpSigmaType
    forall a. a -> Scaled a
    unrestricted ExpSigmaType
    exp_ty) (IOEnv (Env TcGblEnv TcLclEnv) [MonoBindInfo]
     -> TcM (LPat (GhcPass 'Typechecked), [MonoBindInfo]))
    -> IOEnv (Env TcGblEnv TcLclEnv) [MonoBindInfo]
    -> TcM (LPat (GhcPass 'Typechecked), [MonoBindInfo])
    forall a b. (a -> b) -> a -> b
    $
                     -- The above inferred type get an unrestricted multiplicity. It may be
                     -- worth it to try and find a finer-grained multiplicity here
                     -- if examples warrant it.
                   (Name -> TcM MonoBindInfo)
    -> [Name] -> IOEnv (Env TcGblEnv TcLclEnv) [MonoBindInfo]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Name -> TcM MonoBindInfo
    lookup_info [Name]
    nosig_names

            ; let mbis :: [MonoBindInfo]
    mbis = [MonoBindInfo]
    sig_mbis [MonoBindInfo] -> [MonoBindInfo] -> [MonoBindInfo]
    forall a. [a] -> [a] -> [a]
    ++ [MonoBindInfo]
    nosig_mbis

            ; String -> SDoc -> TcRn ()
    traceTc String
    "tcLhs" ([SDoc] -> SDoc
    vcat [ TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    id SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcId -> Kind
    idType TcId
    id)
                                    | MonoBindInfo
    mbi <- [MonoBindInfo]
    mbis, let id :: TcId
    id = MonoBindInfo -> TcId
    mbi_mono_id MonoBindInfo
    mbi ]
                               SDoc -> SDoc -> SDoc
    $$ LetBndrSpec -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LetBndrSpec
    no_gen)

            ; TcMonoBind -> TcM TcMonoBind
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([MonoBindInfo]
    -> LPat (GhcPass 'Typechecked)
    -> GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    -> Kind
    -> TcMonoBind
    TcPatBind [MonoBindInfo]
    mbis Located (Pat (GhcPass 'Typechecked))
    LPat (GhcPass 'Typechecked)
    pat' GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    grhss Kind
    pat_ty) }
      where
        bndr_names :: [IdP (GhcPass 'Renamed)]
    bndr_names = LPat (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
    forall p. CollectPass p => LPat p -> [IdP p]
    collectPatBinders LPat (GhcPass 'Renamed)
    pat
        ([Name]
    nosig_names, [(Name, TcIdSigInfo)]
    sig_names) = (Name -> Either Name (Name, TcIdSigInfo))
    -> [Name] -> ([Name], [(Name, TcIdSigInfo)])
    forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
    partitionWith Name -> Either Name (Name, TcIdSigInfo)
    find_sig [Name]
    [IdP (GhcPass 'Renamed)]
    bndr_names

        find_sig :: Name -> Either Name (Name, TcIdSigInfo)
        find_sig :: Name -> Either Name (Name, TcIdSigInfo)
    find_sig Name
    name = case TcSigFun
    sig_fn Name
    name of
                          Just (TcIdSig TcIdSigInfo
    sig) -> (Name, TcIdSigInfo) -> Either Name (Name, TcIdSigInfo)
    forall a b. b -> Either a b
    Right (Name
    name, TcIdSigInfo
    sig)
                          Maybe TcSigInfo
    _                  -> Name -> Either Name (Name, TcIdSigInfo)
    forall a b. a -> Either a b
    Left Name
    name

          -- After typechecking the pattern, look up the binder
          -- names that lack a signature, which the pattern has brought
          -- into scope.
        lookup_info :: Name -> TcM MonoBindInfo
        lookup_info :: Name -> TcM MonoBindInfo
    lookup_info Name
    name
          = do { TcId
    mono_id <- Name -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    tcLookupId Name
    name
               ; MonoBindInfo -> TcM MonoBindInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MBI :: Name -> Maybe TcIdSigInst -> TcId -> MonoBindInfo
    MBI { mbi_poly_name :: Name
    mbi_poly_name = Name
    name
                             , mbi_sig :: Maybe TcIdSigInst
    mbi_sig       = Maybe TcIdSigInst
    forall a. Maybe a
    Nothing
                             , mbi_mono_id :: TcId
    mbi_mono_id   = TcId
    mono_id }) }

    tcLhs TcSigFun
    _ LetBndrSpec
    _ HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    other_bind = String -> SDoc -> TcM TcMonoBind
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "tcLhs" (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    other_bind)
            -- AbsBind, VarBind impossible

    -------------------
    tcLhsSigId :: LetBndrSpec -> (Name, TcIdSigInfo) -> TcM MonoBindInfo
    tcLhsSigId :: LetBndrSpec -> (Name, TcIdSigInfo) -> TcM MonoBindInfo
    tcLhsSigId LetBndrSpec
    no_gen (Name
    name, TcIdSigInfo
    sig)
      = do { TcIdSigInst
    inst_sig <- TcIdSigInfo -> TcM TcIdSigInst
    tcInstSig TcIdSigInfo
    sig
           ; TcId
    mono_id <- LetBndrSpec
    -> Name -> TcIdSigInst -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    newSigLetBndr LetBndrSpec
    no_gen Name
    name TcIdSigInst
    inst_sig
           ; MonoBindInfo -> TcM MonoBindInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MBI :: Name -> Maybe TcIdSigInst -> TcId -> MonoBindInfo
    MBI { mbi_poly_name :: Name
    mbi_poly_name = Name
    name
                         , mbi_sig :: Maybe TcIdSigInst
    mbi_sig       = TcIdSigInst -> Maybe TcIdSigInst
    forall a. a -> Maybe a
    Just TcIdSigInst
    inst_sig
                         , mbi_mono_id :: TcId
    mbi_mono_id   = TcId
    mono_id }) }

    ------------
    newSigLetBndr :: LetBndrSpec -> Name -> TcIdSigInst -> TcM TcId
    newSigLetBndr :: LetBndrSpec
    -> Name -> TcIdSigInst -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    newSigLetBndr (LetGblBndr TcPragEnv
    prags) Name
    name (TISI { sig_inst_sig :: TcIdSigInst -> TcIdSigInfo
    sig_inst_sig = TcIdSigInfo
    id_sig })
      | CompleteSig { sig_bndr :: TcIdSigInfo -> TcId
    sig_bndr = TcId
    poly_id } <- TcIdSigInfo
    id_sig
      = TcId
    -> [LSig (GhcPass 'Renamed)] -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    addInlinePrags TcId
    poly_id (TcPragEnv -> Name -> [LSig (GhcPass 'Renamed)]
    lookupPragEnv TcPragEnv
    prags Name
    name)
    newSigLetBndr LetBndrSpec
    no_gen Name
    name (TISI { sig_inst_tau :: TcIdSigInst -> Kind
    sig_inst_tau = Kind
    tau })
      = LetBndrSpec
    -> Name -> Kind -> Kind -> IOEnv (Env TcGblEnv TcLclEnv) TcId
    newLetBndr LetBndrSpec
    no_gen Name
    name Kind
    Many Kind
    tau
        -- Binders with a signature are currently always of multiplicity
        -- Many. Because they come either from toplevel, let, or where
        -- declarations. Which are all unrestricted currently.

    -------------------
    tcRhs :: TcMonoBind -> TcM (HsBind GhcTc)
    tcRhs :: TcMonoBind
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    tcRhs (TcFunBind info :: MonoBindInfo
    info@(MBI { mbi_sig :: MonoBindInfo -> Maybe TcIdSigInst
    mbi_sig = Maybe TcIdSigInst
    mb_sig, mbi_mono_id :: MonoBindInfo -> TcId
    mbi_mono_id = TcId
    mono_id })
                     SrcSpan
    loc MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    matches)
      = [MonoBindInfo]
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall a. [MonoBindInfo] -> TcM a -> TcM a
    tcExtendIdBinderStackForRhs [MonoBindInfo
    info]  (TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
     -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)))
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall a b. (a -> b) -> a -> b
    $
        Maybe TcIdSigInst
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall a. Maybe TcIdSigInst -> TcM a -> TcM a
    tcExtendTyVarEnvForRhs Maybe TcIdSigInst
    mb_sig       (TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
     -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)))
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall a b. (a -> b) -> a -> b
    $
        do  { String -> SDoc -> TcRn ()
    traceTc String
    "tcRhs: fun bind" (TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    mono_id SDoc -> SDoc -> SDoc
    $$ Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcId -> Kind
    idType TcId
    mono_id))
            ; (HsWrapper
    co_fn, MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))
    matches') <- Located Name
    -> MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    -> ExpSigmaType
    -> TcM
         (HsWrapper,
          MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    tcMatchesFun (SrcSpan -> Name -> Located Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (TcId -> Name
    idName TcId
    mono_id))
                                     MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    matches (Kind -> ExpSigmaType
    mkCheckExpType (Kind -> ExpSigmaType) -> Kind -> ExpSigmaType
    forall a b. (a -> b) -> a -> b
    $ TcId -> Kind
    idType TcId
    mono_id)
            ; HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( FunBind :: forall idL idR.
    XFunBind idL idR
    -> Located (IdP idL)
    -> MatchGroup idR (LHsExpr idR)
    -> [Tickish TcId]
    -> HsBindLR idL idR
    FunBind { fun_id :: Located (IdP (GhcPass 'Typechecked))
    fun_id = SrcSpan -> TcId -> GenLocated SrcSpan TcId
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc TcId
    mono_id
                               , fun_matches :: MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))
    fun_matches = MatchGroup (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))
    matches'
                               , fun_ext :: XFunBind (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    fun_ext = XFunBind (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    HsWrapper
    co_fn
                               , fun_tick :: [Tickish TcId]
    fun_tick = [] } ) }

    tcRhs (TcPatBind [MonoBindInfo]
    infos LPat (GhcPass 'Typechecked)
    pat' GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    grhss Kind
    pat_ty)
      = -- When we are doing pattern bindings we *don't* bring any scoped
        -- type variables into scope unlike function bindings
        -- Wny not?  They are not completely rigid.
        -- That's why we have the special case for a single FunBind in tcMonoBinds
        [MonoBindInfo]
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall a. [MonoBindInfo] -> TcM a -> TcM a
    tcExtendIdBinderStackForRhs [MonoBindInfo]
    infos        (TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
     -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)))
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall a b. (a -> b) -> a -> b
    $
        do  { String -> SDoc -> TcRn ()
    traceTc String
    "tcRhs: pat bind" (Located (Pat (GhcPass 'Typechecked)) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Located (Pat (GhcPass 'Typechecked))
    LPat (GhcPass 'Typechecked)
    pat' SDoc -> SDoc -> SDoc
    $$ Kind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Kind
    pat_ty)
            ; GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))
    grhss' <- SDoc
    -> TcM
         (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    -> TcM
         (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (LPat (GhcPass 'Typechecked)
    -> GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed)) -> SDoc
    forall (p :: Pass) body.
    (OutputableBndrId p, Outputable body) =>
    LPat (GhcPass p) -> GRHSs (GhcPass 'Renamed) body -> SDoc
    patMonoBindsCtxt LPat (GhcPass 'Typechecked)
    pat' GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    grhss) (TcM
       (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
     -> TcM
          (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    -> TcM
         (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    -> TcM
         (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    forall a b. (a -> b) -> a -> b
    $
                        Kind
    -> TcM
         (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    -> TcM
         (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    forall a. Kind -> TcM a -> TcM a
    tcScalingUsage Kind
    Many (TcM
       (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
     -> TcM
          (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))))
    -> TcM
         (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    -> TcM
         (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    forall a b. (a -> b) -> a -> b
    $
                        -- Like in tcMatchesFun, this scaling happens because all
                        -- let bindings are unrestricted. A difference, here, is
                        -- that when this is not the case, any more, we will have to
                        -- make sure that the pattern is strict, otherwise this will
                        -- be desugar to incorrect code.
                        GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    -> Kind
    -> TcM
         (GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked)))
    tcGRHSsPat GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    grhss Kind
    pat_ty
            ; HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    -> TcM (HsBindLR (GhcPass 'Typechecked) (GhcPass 'Typechecked))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ( PatBind :: forall idL idR.
    XPatBind idL idR
    -> LPat idL
    -> GRHSs idR (LHsExpr idR)
    -> ([Tickish TcId], [[Tickish TcId]])
    -> HsBindLR idL idR
    PatBind { pat_lhs :: LPat (GhcPass 'Typechecked)
    pat_lhs = LPat (GhcPass 'Typechecked)
    pat', pat_rhs :: GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))
    pat_rhs = GRHSs (GhcPass 'Typechecked) (LHsExpr (GhcPass 'Typechecked))
    grhss'
                               , pat_ext :: XPatBind (GhcPass 'Typechecked) (GhcPass 'Typechecked)
    pat_ext = UniqSet Name -> Kind -> NPatBindTc
    NPatBindTc UniqSet Name
    emptyNameSet Kind
    pat_ty
                               , pat_ticks :: ([Tickish TcId], [[Tickish TcId]])
    pat_ticks = ([],[]) } )}

    tcExtendTyVarEnvForRhs :: Maybe TcIdSigInst -> TcM a -> TcM a
    tcExtendTyVarEnvForRhs :: forall a. Maybe TcIdSigInst -> TcM a -> TcM a
    tcExtendTyVarEnvForRhs Maybe TcIdSigInst
    Nothing TcM a
    thing_inside
      = TcM a
    thing_inside
    tcExtendTyVarEnvForRhs (Just TcIdSigInst
    sig) TcM a
    thing_inside
      = TcIdSigInst -> TcM a -> TcM a
    forall a. TcIdSigInst -> TcM a -> TcM a
    tcExtendTyVarEnvFromSig TcIdSigInst
    sig TcM a
    thing_inside

    tcExtendTyVarEnvFromSig :: TcIdSigInst -> TcM a -> TcM a
    tcExtendTyVarEnvFromSig :: forall a. TcIdSigInst -> TcM a -> TcM a
    tcExtendTyVarEnvFromSig TcIdSigInst
    sig_inst TcM a
    thing_inside
      | TISI { sig_inst_skols :: TcIdSigInst -> [(Name, InvisTVBinder)]
    sig_inst_skols = [(Name, InvisTVBinder)]
    skol_prs, sig_inst_wcs :: TcIdSigInst -> [(Name, TcId)]
    sig_inst_wcs = [(Name, TcId)]
    wcs } <- TcIdSigInst
    sig_inst
      = [(Name, TcId)] -> TcM a -> TcM a
    forall a. [(Name, TcId)] -> TcM a -> TcM a
    tcExtendNameTyVarEnv [(Name, TcId)]
    wcs (TcM a -> TcM a) -> TcM a -> TcM a
    forall a b. (a -> b) -> a -> b
    $
        [(Name, TcId)] -> TcM a -> TcM a
    forall a. [(Name, TcId)] -> TcM a -> TcM a
    tcExtendNameTyVarEnv ((InvisTVBinder -> TcId)
    -> [(Name, InvisTVBinder)] -> [(Name, TcId)]
    forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
    mapSnd InvisTVBinder -> TcId
    forall tv argf. VarBndr tv argf -> tv
    binderVar [(Name, InvisTVBinder)]
    skol_prs) (TcM a -> TcM a) -> TcM a -> TcM a
    forall a b. (a -> b) -> a -> b
    $
        TcM a
    thing_inside

    tcExtendIdBinderStackForRhs :: [MonoBindInfo] -> TcM a -> TcM a
    -- See Note [Relevant bindings and the binder stack]
    tcExtendIdBinderStackForRhs :: forall a. [MonoBindInfo] -> TcM a -> TcM a
    tcExtendIdBinderStackForRhs [MonoBindInfo]
    infos TcM a
    thing_inside
      = [TcBinder] -> TcM a -> TcM a
    forall a. [TcBinder] -> TcM a -> TcM a
    tcExtendBinderStack [ TcId -> TopLevelFlag -> TcBinder
    TcIdBndr TcId
    mono_id TopLevelFlag
    NotTopLevel
                            | MBI { mbi_mono_id :: MonoBindInfo -> TcId
    mbi_mono_id = TcId
    mono_id } <- [MonoBindInfo]
    infos ]
                            TcM a
    thing_inside
        -- NotTopLevel: it's a monomorphic binding

    ---------------------
    getMonoBindInfo :: [Located TcMonoBind] -> [MonoBindInfo]
    getMonoBindInfo :: [Located TcMonoBind] -> [MonoBindInfo]
    getMonoBindInfo [Located TcMonoBind]
    tc_binds
      = (Located TcMonoBind -> [MonoBindInfo] -> [MonoBindInfo])
    -> [MonoBindInfo] -> [Located TcMonoBind] -> [MonoBindInfo]
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (TcMonoBind -> [MonoBindInfo] -> [MonoBindInfo]
    get_info (TcMonoBind -> [MonoBindInfo] -> [MonoBindInfo])
    -> (Located TcMonoBind -> TcMonoBind)
    -> Located TcMonoBind
    -> [MonoBindInfo]
    -> [MonoBindInfo]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Located TcMonoBind -> TcMonoBind
    forall l e. GenLocated l e -> e
    unLoc) [] [Located TcMonoBind]
    tc_binds
      where
        get_info :: TcMonoBind -> [MonoBindInfo] -> [MonoBindInfo]
    get_info (TcFunBind MonoBindInfo
    info SrcSpan
    _ MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    _)    [MonoBindInfo]
    rest = MonoBindInfo
    info MonoBindInfo -> [MonoBindInfo] -> [MonoBindInfo]
    forall a. a -> [a] -> [a]
    : [MonoBindInfo]
    rest
        get_info (TcPatBind [MonoBindInfo]
    infos LPat (GhcPass 'Typechecked)
    _ GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    _ Kind
    _) [MonoBindInfo]
    rest = [MonoBindInfo]
    infos [MonoBindInfo] -> [MonoBindInfo] -> [MonoBindInfo]
    forall a. [a] -> [a] -> [a]
    ++ [MonoBindInfo]
    rest

    {- Note [Relevant bindings and the binder stack]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When typecking a binding we extend the TcBinderStack for the RHS of
    the binding, with the /monomorphic/ Id.  That way, if we have, say
        f = \x -> blah
    and something goes wrong in 'blah', we get a "relevant binding"
    looking like  f :: alpha -> beta
    This applies if 'f' has a type signature too:
       f :: forall a. [a] -> [a]
       f x = True
    We can't unify True with [a], and a relevant binding is f :: [a] -> [a]
    If we had the *polymorphic* version of f in the TcBinderStack, it
    would not be reported as relevant, because its type is closed.
    (See TcErrors.relevantBindings.)

    Note [Typechecking pattern bindings]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Look at:
       - typecheck/should_compile/ExPat
       - #12427, typecheck/should_compile/T12427{a,b}

      data T where
        MkT :: Integral a => a -> Int -> T

    and suppose t :: T.  Which of these pattern bindings are ok?

      E1. let { MkT p _ = t } in <body>

      E2. let { MkT _ q = t } in <body>

      E3. let { MkT (toInteger -> r) _ = t } in <body>

    * (E1) is clearly wrong because the existential 'a' escapes.
      What type could 'p' possibly have?

    * (E2) is fine, despite the existential pattern, because
      q::Int, and nothing escapes.

    * Even (E3) is fine.  The existential pattern binds a dictionary
      for (Integral a) which the view pattern can use to convert the
      a-valued field to an Integer, so r :: Integer.

    An easy way to see all three is to imagine the desugaring.
    For (E2) it would look like
        let q = case t of MkT _ q' -> q'
        in <body>

    We typecheck pattern bindings as follows.  First tcLhs does this:

      1. Take each type signature q :: ty, partial or complete, and
         instantiate it (with tcLhsSigId) to get a MonoBindInfo.  This
         gives us a fresh "mono_id" qm :: instantiate(ty), where qm has
         a fresh name.

         Any fresh unification variables in instantiate(ty) born here, not
         deep under implications as would happen if we allocated them when
         we encountered q during tcPat.

      2. Build a little environment mapping "q" -> "qm" for those Ids
         with signatures (inst_sig_fun)

      3. Invoke tcLetPat to typecheck the pattern.

         - We pass in the current TcLevel.  This is captured by
           GHC.Tc.Gen.Pat.tcLetPat, and put into the pc_lvl field of PatCtxt, in
           PatEnv.

         - When tcPat finds an existential constructor, it binds fresh
           type variables and dictionaries as usual, increments the TcLevel,
           and emits an implication constraint.

         - When we come to a binder (GHC.Tc.Gen.Pat.tcPatBndr), it looks it up
           in the little environment (the pc_sig_fn field of PatCtxt).

             Success => There was a type signature, so just use it,
                        checking compatibility with the expected type.

             Failure => No type signature.
                 Infer case: (happens only outside any constructor pattern)
                             use a unification variable
                             at the outer level pc_lvl

                 Check case: use promoteTcType to promote the type
                             to the outer level pc_lvl.  This is the
                             place where we emit a constraint that'll blow
                             up if existential capture takes place

           Result: the type of the binder is always at pc_lvl. This is
           crucial.

      4. Throughout, when we are making up an Id for the pattern-bound variables
         (newLetBndr), we have two cases:

         - If we are generalising (generalisation plan is InferGen or
           CheckGen), then the let_bndr_spec will be LetLclBndr.  In that case
           we want to bind a cloned, local version of the variable, with the
           type given by the pattern context, *not* by the signature (even if
           there is one; see #7268). The mkExport part of the
           generalisation step will do the checking and impedance matching
           against the signature.

         - If for some reason we are not generalising (plan = NoGen), the
           LetBndrSpec will be LetGblBndr.  In that case we must bind the
           global version of the Id, and do so with precisely the type given
           in the signature.  (Then we unify with the type from the pattern
           context type.)

    And that's it!  The implication constraints check for the skolem
    escape.  It's quite simple and neat, and more expressive than before
    e.g. GHC 8.0 rejects (E2) and (E3).

    Example for (E1), starting at level 1.  We generate
         p :: beta:1, with constraints (forall:3 a. Integral a => a ~ beta)
    The (a~beta) can't float (because of the 'a'), nor be solved (because
    beta is untouchable.)

    Example for (E2), we generate
         q :: beta:1, with constraint (forall:3 a. Integral a => Int ~ beta)
    The beta is untouchable, but floats out of the constraint and can
    be solved absolutely fine.

    ************************************************************************
    *                                                                      *
                    Generalisation
    *                                                                      *
    ********************************************************************* -}

    data GeneralisationPlan
      = NoGen               -- No generalisation, no AbsBinds

      | InferGen            -- Implicit generalisation; there is an AbsBinds
           Bool             --   True <=> apply the MR; generalise only unconstrained type vars

      | CheckGen (LHsBind GhcRn) TcIdSigInfo
                            -- One FunBind with a signature
                            -- Explicit generalisation

    -- A consequence of the no-AbsBinds choice (NoGen) is that there is
    -- no "polymorphic Id" and "monmomorphic Id"; there is just the one

    instance Outputable GeneralisationPlan where
      ppr :: GeneralisationPlan -> SDoc
    ppr GeneralisationPlan
    NoGen          = String -> SDoc
    text String
    "NoGen"
      ppr (InferGen Bool
    b)   = String -> SDoc
    text String
    "InferGen" SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    b
      ppr (CheckGen LHsBind (GhcPass 'Renamed)
    _ TcIdSigInfo
    s) = String -> SDoc
    text String
    "CheckGen" SDoc -> SDoc -> SDoc
    <+> TcIdSigInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcIdSigInfo
    s

    decideGeneralisationPlan
       :: DynFlags -> [LHsBind GhcRn] -> IsGroupClosed -> TcSigFun
       -> GeneralisationPlan
    decideGeneralisationPlan :: DynFlags
    -> [LHsBind (GhcPass 'Renamed)]
    -> IsGroupClosed
    -> TcSigFun
    -> GeneralisationPlan
    decideGeneralisationPlan DynFlags
    dflags [LHsBind (GhcPass 'Renamed)]
    lbinds IsGroupClosed
    closed TcSigFun
    sig_fn
      | Bool
    has_partial_sigs                         = Bool -> GeneralisationPlan
    InferGen ([Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [Bool]
    partial_sig_mrs)
      | Just (LHsBind (GhcPass 'Renamed)
    bind, TcIdSigInfo
    sig) <- Maybe (LHsBind (GhcPass 'Renamed), TcIdSigInfo)
    one_funbind_with_sig = LHsBind (GhcPass 'Renamed) -> TcIdSigInfo -> GeneralisationPlan
    CheckGen LHsBind (GhcPass 'Renamed)
    bind TcIdSigInfo
    sig
      | IsGroupClosed -> Bool
    do_not_generalise IsGroupClosed
    closed                 = GeneralisationPlan
    NoGen
      | Bool
    otherwise                                = Bool -> GeneralisationPlan
    InferGen Bool
    mono_restriction
      where
        binds :: [HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)]
    binds = (LHsBind (GhcPass 'Renamed)
     -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> [LHsBind (GhcPass 'Renamed)]
    -> [HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)]
    forall a b. (a -> b) -> [a] -> [b]
    map LHsBind (GhcPass 'Renamed)
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    forall l e. GenLocated l e -> e
    unLoc [LHsBind (GhcPass 'Renamed)]
    lbinds

        partial_sig_mrs :: [Bool]
        -- One for each partial signature (so empty => no partial sigs)
        -- The Bool is True if the signature has no constraint context
        --      so we should apply the MR
        -- See Note [Partial type signatures and generalisation]
        partial_sig_mrs :: [Bool]
    partial_sig_mrs
          = [ [LHsType (GhcPass 'Renamed)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LHsType (GhcPass 'Renamed)]
    theta
            | TcIdSig (PartialSig { psig_hs_ty :: TcIdSigInfo -> LHsSigWcType (GhcPass 'Renamed)
    psig_hs_ty = LHsSigWcType (GhcPass 'Renamed)
    hs_ty })
                <- TcSigFun -> [Name] -> [TcSigInfo]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe TcSigFun
    sig_fn ([LHsBind (GhcPass 'Renamed)] -> [IdP (GhcPass 'Renamed)]
    forall p idR. CollectPass p => [LHsBindLR p idR] -> [IdP p]
    collectHsBindListBinders [LHsBind (GhcPass 'Renamed)]
    lbinds)
            , let ([LHsTyVarBndr Specificity (GhcPass 'Renamed)]
    _, L SrcSpan
    _ [LHsType (GhcPass 'Renamed)]
    theta, LHsType (GhcPass 'Renamed)
    _) = LHsType (GhcPass 'Renamed)
    -> ([LHsTyVarBndr Specificity (GhcPass 'Renamed)],
        GenLocated SrcSpan [LHsType (GhcPass 'Renamed)],
        LHsType (GhcPass 'Renamed))
    forall pass.
    LHsType pass
    -> ([LHsTyVarBndr Specificity pass], LHsContext pass, LHsType pass)
    splitLHsSigmaTyInvis (LHsSigWcType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall pass. LHsSigWcType pass -> LHsType pass
    hsSigWcType LHsSigWcType (GhcPass 'Renamed)
    hs_ty) ]

        has_partial_sigs :: Bool
    has_partial_sigs   = Bool -> Bool
    not ([Bool] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Bool]
    partial_sig_mrs)

        mono_restriction :: Bool
    mono_restriction  = Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.MonomorphismRestriction DynFlags
    dflags
                         Bool -> Bool -> Bool
    && (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> Bool)
    -> [HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> Bool
    restricted [HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)]
    binds

        do_not_generalise :: IsGroupClosed -> Bool
    do_not_generalise (IsGroupClosed NameEnv (UniqSet Name)
    _ Bool
    True) = Bool
    False
            -- The 'True' means that all of the group's
            -- free vars have ClosedTypeId=True; so we can ignore
            -- -XMonoLocalBinds, and generalise anyway
        do_not_generalise IsGroupClosed
    _ = Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.MonoLocalBinds DynFlags
    dflags

        -- With OutsideIn, all nested bindings are monomorphic
        -- except a single function binding with a signature
        one_funbind_with_sig :: Maybe (LHsBind (GhcPass 'Renamed), TcIdSigInfo)
    one_funbind_with_sig
          | [lbind :: LHsBind (GhcPass 'Renamed)
    lbind@(L SrcSpan
    _ (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
    fun_id = Located (IdP (GhcPass 'Renamed))
    v }))] <- [LHsBind (GhcPass 'Renamed)]
    lbinds
          , Just (TcIdSig TcIdSigInfo
    sig) <- TcSigFun
    sig_fn (Located Name -> Name
    forall l e. GenLocated l e -> e
    unLoc Located Name
    Located (IdP (GhcPass 'Renamed))
    v)
          = (LHsBind (GhcPass 'Renamed), TcIdSigInfo)
    -> Maybe (LHsBind (GhcPass 'Renamed), TcIdSigInfo)
    forall a. a -> Maybe a
    Just (LHsBind (GhcPass 'Renamed)
    lbind, TcIdSigInfo
    sig)
          | Bool
    otherwise
          = Maybe (LHsBind (GhcPass 'Renamed), TcIdSigInfo)
    forall a. Maybe a
    Nothing

        -- The Haskell 98 monomorphism restriction
        restricted :: HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> Bool
    restricted (PatBind {})                              = Bool
    True
        restricted (VarBind { var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
    var_id = IdP (GhcPass 'Renamed)
    v })                  = Name -> Bool
    no_sig Name
    IdP (GhcPass 'Renamed)
    v
        restricted (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
    fun_id = Located (IdP (GhcPass 'Renamed))
    v, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
    fun_matches = MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    m }) = MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed)) -> Bool
    forall {id :: Pass} {body}. MatchGroup (GhcPass id) body -> Bool
    restricted_match MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
    m
                                                               Bool -> Bool -> Bool
    && Name -> Bool
    no_sig (Located Name -> Name
    forall l e. GenLocated l e -> e
    unLoc Located Name
    Located (IdP (GhcPass 'Renamed))
    v)
        restricted HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    b = String -> SDoc -> Bool
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "isRestrictedGroup/unrestricted" (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    b)

        restricted_match :: MatchGroup (GhcPass id) body -> Bool
    restricted_match MatchGroup (GhcPass id) body
    mg = MatchGroup (GhcPass id) body -> BKey
    forall (id :: Pass) body. MatchGroup (GhcPass id) body -> BKey
    matchGroupArity MatchGroup (GhcPass id) body
    mg BKey -> BKey -> Bool
    forall a. Eq a => a -> a -> Bool
    == BKey
    0
            -- No args => like a pattern binding
            -- Some args => a function binding

        no_sig :: Name -> Bool
    no_sig Name
    n = Bool -> Bool
    not (TcSigFun -> Name -> Bool
    hasCompleteSig TcSigFun
    sig_fn Name
    n)

    isClosedBndrGroup :: TcTypeEnv -> Bag (LHsBind GhcRn) -> IsGroupClosed
    isClosedBndrGroup :: TcTypeEnv -> LHsBinds (GhcPass 'Renamed) -> IsGroupClosed
    isClosedBndrGroup TcTypeEnv
    type_env LHsBinds (GhcPass 'Renamed)
    binds
      = NameEnv (UniqSet Name) -> Bool -> IsGroupClosed
    IsGroupClosed NameEnv (UniqSet Name)
    fv_env Bool
    type_closed
      where
        type_closed :: Bool
    type_closed = (UniqSet Name -> Bool) -> NameEnv (UniqSet Name) -> Bool
    forall elt key. (elt -> Bool) -> UniqFM key elt -> Bool
    allUFM ((Name -> Bool) -> UniqSet Name -> Bool
    nameSetAll Name -> Bool
    is_closed_type_id) NameEnv (UniqSet Name)
    fv_env

        fv_env :: NameEnv NameSet
        fv_env :: NameEnv (UniqSet Name)
    fv_env = [(Name, UniqSet Name)] -> NameEnv (UniqSet Name)
    forall a. [(Name, a)] -> NameEnv a
    mkNameEnv ([(Name, UniqSet Name)] -> NameEnv (UniqSet Name))
    -> [(Name, UniqSet Name)] -> NameEnv (UniqSet Name)
    forall a b. (a -> b) -> a -> b
    $ (LHsBind (GhcPass 'Renamed) -> [(Name, UniqSet Name)])
    -> LHsBinds (GhcPass 'Renamed) -> [(Name, UniqSet Name)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> [(Name, UniqSet Name)]
    bindFvs (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
     -> [(Name, UniqSet Name)])
    -> (LHsBind (GhcPass 'Renamed)
        -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> LHsBind (GhcPass 'Renamed)
    -> [(Name, UniqSet Name)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsBind (GhcPass 'Renamed)
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    forall l e. GenLocated l e -> e
    unLoc) LHsBinds (GhcPass 'Renamed)
    binds

        bindFvs :: HsBindLR GhcRn GhcRn -> [(Name, NameSet)]
        bindFvs :: HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> [(Name, UniqSet Name)]
    bindFvs (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
    fun_id = L SrcSpan
    _ IdP (GhcPass 'Renamed)
    f
                         , fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
    fun_ext = XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
    fvs })
           = let open_fvs :: UniqSet Name
    open_fvs = UniqSet Name -> UniqSet Name
    get_open_fvs UniqSet Name
    XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
    fvs
             in [(Name
    IdP (GhcPass 'Renamed)
    f, UniqSet Name
    open_fvs)]
        bindFvs (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
    pat_lhs = LPat (GhcPass 'Renamed)
    pat, pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
    pat_ext = XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
    fvs })
           = let open_fvs :: UniqSet Name
    open_fvs = UniqSet Name -> UniqSet Name
    get_open_fvs UniqSet Name
    XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
    fvs
             in [(Name
    b, UniqSet Name
    open_fvs) | Name
    b <- LPat (GhcPass 'Renamed) -> [IdP (GhcPass 'Renamed)]
    forall p. CollectPass p => LPat p -> [IdP p]
    collectPatBinders LPat (GhcPass 'Renamed)
    pat]
        bindFvs HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    _
           = []

        get_open_fvs :: UniqSet Name -> UniqSet Name
    get_open_fvs UniqSet Name
    fvs = (Name -> Bool) -> UniqSet Name -> UniqSet Name
    filterNameSet (Bool -> Bool
    not (Bool -> Bool) -> (Name -> Bool) -> Name -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Bool
    is_closed) UniqSet Name
    fvs

        is_closed :: Name -> ClosedTypeId
        is_closed :: Name -> Bool
    is_closed Name
    name
          | Just TcTyThing
    thing <- TcTypeEnv -> Name -> Maybe TcTyThing
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv TcTypeEnv
    type_env Name
    name
          = case TcTyThing
    thing of
              AGlobal {}                     -> Bool
    True
              ATcId { tct_info :: TcTyThing -> IdBindingInfo
    tct_info = IdBindingInfo
    ClosedLet } -> Bool
    True
              TcTyThing
    _                              -> Bool
    False

          | Bool
    otherwise
          = Bool
    True  -- The free-var set for a top level binding mentions

        is_closed_type_id :: Name -> Bool
        -- We're already removed Global and ClosedLet Ids
        is_closed_type_id :: Name -> Bool
    is_closed_type_id Name
    name
          | Just TcTyThing
    thing <- TcTypeEnv -> Name -> Maybe TcTyThing
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv TcTypeEnv
    type_env Name
    name
          = case TcTyThing
    thing of
              ATcId { tct_info :: TcTyThing -> IdBindingInfo
    tct_info = NonClosedLet UniqSet Name
    _ Bool
    cl } -> Bool
    cl
              ATcId { tct_info :: TcTyThing -> IdBindingInfo
    tct_info = IdBindingInfo
    NotLetBound }       -> Bool
    False
              ATyVar {}                              -> Bool
    False
                   -- In-scope type variables are not closed!
              TcTyThing
    _ -> String -> SDoc -> Bool
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "is_closed_id" (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name)

          | Bool
    otherwise
          = Bool
    True   -- The free-var set for a top level binding mentions
                   -- imported things too, so that we can report unused imports
                   -- These won't be in the local type env.
                   -- Ditto class method etc from the current module

    {- *********************************************************************
    *                                                                      *
                   Error contexts and messages
    *                                                                      *
    ********************************************************************* -}

    -- This one is called on LHS, when pat and grhss are both Name
    -- and on RHS, when pat is TcId and grhss is still Name
    patMonoBindsCtxt :: (OutputableBndrId p, Outputable body)
                     => LPat (GhcPass p) -> GRHSs GhcRn body -> SDoc
    patMonoBindsCtxt :: forall (p :: Pass) body.
    (OutputableBndrId p, Outputable body) =>
    LPat (GhcPass p) -> GRHSs (GhcPass 'Renamed) body -> SDoc
    patMonoBindsCtxt LPat (GhcPass p)
    pat GRHSs (GhcPass 'Renamed) body
    grhss
      = SDoc -> BKey -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "In a pattern binding:") BKey
    2 (LPat (GhcPass p) -> GRHSs (GhcPass 'Renamed) body -> SDoc
    forall (bndr :: Pass) (p :: Pass) body.
    (OutputableBndrId bndr, OutputableBndrId p, Outputable body) =>
    LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc
    pprPatBind LPat (GhcPass p)
    pat GRHSs (GhcPass 'Renamed) body
    grhss)