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

    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE NondecreasingIndentation #-}
    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE ViewPatterns #-}
    {-# LANGUAGE MultiWayIf #-}

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

    -- | Typechecking a whole module
    --
    -- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/type-checker
    module GHC.Tc.Module (
            tcRnStmt, tcRnExpr, TcRnExprMode(..), tcRnType,
            tcRnImportDecls,
            tcRnLookupRdrName,
            getModuleInterface,
            tcRnDeclsi,
            isGHCiMonad,
            runTcInteractive,    -- Used by GHC API clients (#8878)
            tcRnLookupName,
            tcRnGetInfo,
            tcRnModule, tcRnModuleTcRnM,
            tcTopSrcDecls,
            rnTopSrcDecls,
            checkBootDecl, checkHiBootIface',
            findExtraSigImports,
            implicitRequirements,
            checkUnit,
            mergeSignatures,
            tcRnMergeSignatures,
            instantiateSignature,
            tcRnInstantiateSignature,
            loadUnqualIfaces,
            -- More private...
            badReexportedBootThing,
            checkBootDeclM,
            missingBootThing,
            getRenamedStuff, RenamedStuff
        ) where

    import GHC.Prelude

    import {-# SOURCE #-} GHC.Tc.Gen.Splice ( finishTH, runRemoteModFinalizers )
    import GHC.Rename.Splice ( rnTopSpliceDecls, traceSplice, SpliceInfo(..) )
    import GHC.Iface.Env     ( externaliseName )
    import GHC.Tc.Gen.HsType
    import GHC.Tc.Validity( checkValidType )
    import GHC.Tc.Gen.Match
    import GHC.Tc.Utils.Unify( checkConstraints, tcSubTypeSigma )
    import GHC.Rename.HsType
    import GHC.Rename.Expr
    import GHC.Rename.Utils  ( HsDocContext(..) )
    import GHC.Rename.Fixity ( lookupFixityRn )
    import GHC.Builtin.Types ( unitTy, mkListTy )
    import GHC.Driver.Plugins
    import GHC.Driver.Session
    import GHC.Hs
    import GHC.Iface.Syntax   ( ShowSub(..), showToHeader )
    import GHC.Iface.Type     ( ShowForAllFlag(..) )
    import GHC.Core.PatSyn    ( pprPatSynType )
    import GHC.Core.Predicate ( classMethodTy )
    import GHC.Builtin.Names
    import GHC.Builtin.Utils
    import GHC.Types.Name.Reader
    import GHC.Tc.Utils.Zonk
    import GHC.Tc.Gen.Expr
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Gen.Export
    import GHC.Tc.Types.Evidence
    import GHC.Tc.Types.Constraint
    import GHC.Tc.Types.Origin
    import qualified GHC.Data.BooleanFormula as BF
    import GHC.Core.Ppr.TyThing ( pprTyThingInContext )
    import GHC.Core.FVs         ( orphNamesOfFamInst )
    import GHC.Tc.Instance.Family
    import GHC.Core.InstEnv
    import GHC.Core.FamInstEnv
       ( FamInst, pprFamInst, famInstsRepTyCons
       , famInstEnvElts, extendFamInstEnvList, normaliseType )
    import GHC.Tc.Gen.Annotation
    import GHC.Tc.Gen.Bind
    import GHC.Iface.Make   ( coAxiomToIfaceDecl )
    import GHC.Parser.Header       ( mkPrelImports )
    import GHC.Tc.Gen.Default
    import GHC.Tc.Utils.Env
    import GHC.Tc.Gen.Rule
    import GHC.Tc.Gen.Foreign
    import GHC.Tc.TyCl.Instance
    import GHC.IfaceToCore
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Solver
    import GHC.Tc.TyCl
    import GHC.Tc.Instance.Typeable ( mkTypeableBinds )
    import GHC.Tc.Utils.Backpack
    import GHC.Iface.Load
    import GHC.Rename.Names
    import GHC.Rename.Env
    import GHC.Rename.Module
    import GHC.Utils.Error
    import GHC.Types.Id as Id
    import GHC.Types.Id.Info( IdDetails(..) )
    import GHC.Types.Var.Env
    import GHC.Unit.Module
    import GHC.Types.Unique.FM
    import GHC.Types.Name
    import GHC.Types.Name.Env
    import GHC.Types.Name.Set
    import GHC.Types.Avail
    import GHC.Core.TyCon
    import GHC.Types.SrcLoc
    import GHC.Driver.Types
    import GHC.Data.List.SetOps
    import GHC.Utils.Outputable as Outputable
    import GHC.Core.ConLike
    import GHC.Core.DataCon
    import GHC.Core.Type
    import GHC.Core.Class
    import GHC.Types.Basic hiding( SuccessFlag(..) )
    import GHC.Core.Coercion.Axiom
    import GHC.Types.Annotations
    import Data.List ( sortBy, sort )
    import Data.Ord
    import GHC.Data.FastString
    import GHC.Data.Maybe
    import GHC.Utils.Misc
    import GHC.Data.Bag
    import GHC.Tc.Utils.Instantiate (tcGetInsts)
    import qualified GHC.LanguageExtensions as LangExt
    import Data.Data ( Data )
    import GHC.Hs.Dump
    import qualified Data.Set as S

    import Control.DeepSeq
    import Control.Monad

    import GHC.Tc.Errors.Hole.FitTypes ( HoleFitPluginR (..) )

    #include "HsVersions.h"

    {-
    ************************************************************************
    *                                                                      *
            Typecheck and rename a module
    *                                                                      *
    ************************************************************************
    -}

    -- | Top level entry point for typechecker and renamer
    tcRnModule :: HscEnv
               -> ModSummary
               -> Bool              -- True <=> save renamed syntax
               -> HsParsedModule
               -> IO (Messages, Maybe TcGblEnv)

    tcRnModule :: HscEnv
    -> ModSummary
    -> Bool
    -> HsParsedModule
    -> IO (Messages, Maybe TcGblEnv)
    tcRnModule HscEnv
    hsc_env ModSummary
    mod_sum Bool
    save_rn_syntax
       parsedModule :: HsParsedModule
    parsedModule@HsParsedModule {hpm_module :: HsParsedModule -> Located HsModule
    hpm_module= L SrcSpan
    loc HsModule
    this_module}
     | RealSrcSpan RealSrcSpan
    real_loc Maybe BufSpan
    _ <- SrcSpan
    loc
     = DynFlags
    -> SDoc
    -> ((Messages, Maybe TcGblEnv) -> ())
    -> IO (Messages, Maybe TcGblEnv)
    -> IO (Messages, Maybe TcGblEnv)
    forall (m :: * -> *) a.
    MonadIO m =>
    DynFlags -> SDoc -> (a -> ()) -> m a -> m a
    withTiming DynFlags
    dflags
                  (String -> SDoc
    text String
    "Renamer/typechecker"SDoc -> SDoc -> SDoc
    <+>SDoc -> SDoc
    brackets (Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    this_mod))
                  (() -> (Messages, Maybe TcGblEnv) -> ()
    forall a b. a -> b -> a
    const ()) (IO (Messages, Maybe TcGblEnv) -> IO (Messages, Maybe TcGblEnv))
    -> IO (Messages, Maybe TcGblEnv) -> IO (Messages, Maybe TcGblEnv)
    forall a b. (a -> b) -> a -> b
    $
       HscEnv
    -> HscSource
    -> Bool
    -> Module
    -> RealSrcSpan
    -> TcM TcGblEnv
    -> IO (Messages, Maybe TcGblEnv)
    forall r.
    HscEnv
    -> HscSource
    -> Bool
    -> Module
    -> RealSrcSpan
    -> TcM r
    -> IO (Messages, Maybe r)
    initTc HscEnv
    hsc_env HscSource
    hsc_src Bool
    save_rn_syntax Module
    this_mod RealSrcSpan
    real_loc (TcM TcGblEnv -> IO (Messages, Maybe TcGblEnv))
    -> TcM TcGblEnv -> IO (Messages, Maybe TcGblEnv)
    forall a b. (a -> b) -> a -> b
    $
              HscEnv -> TcM TcGblEnv -> TcM TcGblEnv
    forall a. HscEnv -> TcM a -> TcM a
    withTcPlugins HscEnv
    hsc_env (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> TcM TcGblEnv -> TcM TcGblEnv
    forall a. HscEnv -> TcM a -> TcM a
    withHoleFitPlugins HscEnv
    hsc_env (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $

              HscEnv
    -> ModSummary
    -> HsParsedModule
    -> (Module, SrcSpan)
    -> TcM TcGblEnv
    tcRnModuleTcRnM HscEnv
    hsc_env ModSummary
    mod_sum HsParsedModule
    parsedModule (Module, SrcSpan)
    pair

      | Bool
    otherwise
      = (Messages, Maybe TcGblEnv) -> IO (Messages, Maybe TcGblEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Bag WarnMsg
    forall a. Bag a
    emptyBag, WarnMsg -> Bag WarnMsg
    forall a. a -> Bag a
    unitBag WarnMsg
    err_msg), Maybe TcGblEnv
    forall a. Maybe a
    Nothing)

      where
        hsc_src :: HscSource
    hsc_src = ModSummary -> HscSource
    ms_hsc_src ModSummary
    mod_sum
        dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        err_msg :: WarnMsg
    err_msg = DynFlags -> SrcSpan -> SDoc -> WarnMsg
    mkPlainErrMsg (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) SrcSpan
    loc (SDoc -> WarnMsg) -> SDoc -> WarnMsg
    forall a b. (a -> b) -> a -> b
    $
                  String -> SDoc
    text String
    "Module does not have a RealSrcSpan:" SDoc -> SDoc -> SDoc
    <+> Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    this_mod

        this_pkg :: GenUnit UnitId
    this_pkg = DynFlags -> GenUnit UnitId
    homeUnit (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)

        pair :: (Module, SrcSpan)
        pair :: (Module, SrcSpan)
    pair@(Module
    this_mod,SrcSpan
    _)
          | Just (L SrcSpan
    mod_loc ModuleName
    mod) <- HsModule -> Maybe (Located ModuleName)
    hsmodName HsModule
    this_module
          = (GenUnit UnitId -> ModuleName -> Module
    forall u. u -> ModuleName -> GenModule u
    mkModule GenUnit UnitId
    this_pkg ModuleName
    mod, SrcSpan
    mod_loc)

          | Bool
    otherwise   -- 'module M where' is omitted
          = (Module
    mAIN, SrcLoc -> SrcSpan
    srcLocSpan (SrcSpan -> SrcLoc
    srcSpanStart SrcSpan
    loc))

    tcRnModuleTcRnM :: HscEnv
                    -> ModSummary
                    -> HsParsedModule
                    -> (Module, SrcSpan)
                    -> TcRn TcGblEnv
    -- Factored out separately from tcRnModule so that a Core plugin can
    -- call the type checker directly
    tcRnModuleTcRnM :: HscEnv
    -> ModSummary
    -> HsParsedModule
    -> (Module, SrcSpan)
    -> TcM TcGblEnv
    tcRnModuleTcRnM HscEnv
    hsc_env ModSummary
    mod_sum
                    (HsParsedModule {
                       hpm_module :: HsParsedModule -> Located HsModule
    hpm_module =
                          (L SrcSpan
    loc (HsModule LayoutInfo
    _ Maybe (Located ModuleName)
    maybe_mod Maybe (Located [LIE GhcPs])
    export_ies
                                           [LImportDecl GhcPs]
    import_decls [LHsDecl GhcPs]
    local_decls Maybe (Located WarningTxt)
    mod_deprec
                                           Maybe LHsDocString
    maybe_doc_hdr)),
                       hpm_src_files :: HsParsedModule -> [String]
    hpm_src_files = [String]
    src_files
                    })
                    (Module
    this_mod, SrcSpan
    prel_imp_loc)
     = SrcSpan -> TcM TcGblEnv -> TcM TcGblEnv
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $
       do { let { explicit_mod_hdr :: Bool
    explicit_mod_hdr = Maybe (Located ModuleName) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (Located ModuleName)
    maybe_mod
                ; hsc_src :: HscSource
    hsc_src          = ModSummary -> HscSource
    ms_hsc_src ModSummary
    mod_sum }
          ; -- Load the hi-boot interface for this module, if any
            -- We do this now so that the boot_names can be passed
            -- to tcTyAndClassDecls, because the boot_names are
            -- automatically considered to be loop breakers
            TcGblEnv
    tcg_env <- TcM TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
          ; SelfBootInfo
    boot_info <- HscSource -> Module -> TcRn SelfBootInfo
    tcHiBootIface HscSource
    hsc_src Module
    this_mod
          ; TcGblEnv -> TcM TcGblEnv -> TcM TcGblEnv
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv (TcGblEnv
    tcg_env { tcg_self_boot :: SelfBootInfo
    tcg_self_boot = SelfBootInfo
    boot_info })
            (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ do
            { -- Deal with imports; first add implicit prelude
              Bool
    implicit_prelude <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.ImplicitPrelude
            ; let { prel_imports :: [LImportDecl GhcPs]
    prel_imports = ModuleName
    -> SrcSpan -> Bool -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
    mkPrelImports (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    this_mod) SrcSpan
    prel_imp_loc
                                   Bool
    implicit_prelude [LImportDecl GhcPs]
    import_decls }

            ; WarningFlag
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall gbl lcl.
    WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenWOptM WarningFlag
    Opt_WarnImplicitPrelude (TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $
                 Bool -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([LImportDecl GhcPs] -> Bool
    forall a. [a] -> Bool
    notNull [LImportDecl GhcPs]
    prel_imports) (TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $
                    WarnReason -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addWarn (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnImplicitPrelude) (SDoc
    implicitPreludeWarn)

            ; -- TODO This is a little skeevy; maybe handle a bit more directly
              let { simplifyImport :: GenLocated l (ImportDecl pass)
    -> (Maybe FastString, Located ModuleName)
    simplifyImport (L l
    _ ImportDecl pass
    idecl) =
                      ( (StringLiteral -> FastString)
    -> Maybe StringLiteral -> Maybe FastString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap StringLiteral -> FastString
    sl_fs (ImportDecl pass -> Maybe StringLiteral
    forall pass. ImportDecl pass -> Maybe StringLiteral
    ideclPkgQual ImportDecl pass
    idecl) , ImportDecl pass -> Located ModuleName
    forall pass. ImportDecl pass -> Located ModuleName
    ideclName ImportDecl pass
    idecl)
                  }
            ; [(Maybe FastString, Located ModuleName)]
    raw_sig_imports <- IO [(Maybe FastString, Located ModuleName)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) [(Maybe FastString, Located ModuleName)]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO
                                 (IO [(Maybe FastString, Located ModuleName)]
     -> IOEnv
          (Env TcGblEnv TcLclEnv) [(Maybe FastString, Located ModuleName)])
    -> IO [(Maybe FastString, Located ModuleName)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) [(Maybe FastString, Located ModuleName)]
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> HscSource
    -> ModuleName
    -> IO [(Maybe FastString, Located ModuleName)]
    findExtraSigImports HscEnv
    hsc_env HscSource
    hsc_src
                                     (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    this_mod)
            ; [(Maybe FastString, Located ModuleName)]
    raw_req_imports <- IO [(Maybe FastString, Located ModuleName)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) [(Maybe FastString, Located ModuleName)]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO
                                 (IO [(Maybe FastString, Located ModuleName)]
     -> IOEnv
          (Env TcGblEnv TcLclEnv) [(Maybe FastString, Located ModuleName)])
    -> IO [(Maybe FastString, Located ModuleName)]
    -> IOEnv
         (Env TcGblEnv TcLclEnv) [(Maybe FastString, Located ModuleName)]
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> [(Maybe FastString, Located ModuleName)]
    -> IO [(Maybe FastString, Located ModuleName)]
    implicitRequirements HscEnv
    hsc_env
                                    ((LImportDecl GhcPs -> (Maybe FastString, Located ModuleName))
    -> [LImportDecl GhcPs] -> [(Maybe FastString, Located ModuleName)]
    forall a b. (a -> b) -> [a] -> [b]
    map LImportDecl GhcPs -> (Maybe FastString, Located ModuleName)
    forall {l} {pass}.
    GenLocated l (ImportDecl pass)
    -> (Maybe FastString, Located ModuleName)
    simplifyImport ([LImportDecl GhcPs]
    prel_imports
                                                         [LImportDecl GhcPs] -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
    forall a. [a] -> [a] -> [a]
    ++ [LImportDecl GhcPs]
    import_decls))
            ; let { mkImport :: (Maybe a, GenLocated l ModuleName)
    -> Located (ImportDecl (GhcPass p))
    mkImport (Maybe a
    Nothing, L l
    _ ModuleName
    mod_name) = ImportDecl (GhcPass p) -> Located (ImportDecl (GhcPass p))
    forall e. e -> Located e
    noLoc
                    (ImportDecl (GhcPass p) -> Located (ImportDecl (GhcPass p)))
    -> ImportDecl (GhcPass p) -> Located (ImportDecl (GhcPass p))
    forall a b. (a -> b) -> a -> b
    $ (ModuleName -> ImportDecl (GhcPass p)
    forall (p :: Pass). ModuleName -> ImportDecl (GhcPass p)
    simpleImportDecl ModuleName
    mod_name)
                      { ideclHiding :: Maybe (Bool, Located [LIE (GhcPass p)])
    ideclHiding = (Bool, Located [LIE (GhcPass p)])
    -> Maybe (Bool, Located [LIE (GhcPass p)])
    forall a. a -> Maybe a
    Just (Bool
    False, [LIE (GhcPass p)] -> Located [LIE (GhcPass p)]
    forall e. e -> Located e
    noLoc [])}
                  ; mkImport (Maybe a, GenLocated l ModuleName)
    _ = String -> Located (ImportDecl (GhcPass p))
    forall a. String -> a
    panic String
    "mkImport" }
            ; let { all_imports :: [LImportDecl GhcPs]
    all_imports = [LImportDecl GhcPs]
    prel_imports [LImportDecl GhcPs] -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
    forall a. [a] -> [a] -> [a]
    ++ [LImportDecl GhcPs]
    import_decls
                           [LImportDecl GhcPs] -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
    forall a. [a] -> [a] -> [a]
    ++ ((Maybe FastString, Located ModuleName) -> LImportDecl GhcPs)
    -> [(Maybe FastString, Located ModuleName)] -> [LImportDecl GhcPs]
    forall a b. (a -> b) -> [a] -> [b]
    map (Maybe FastString, Located ModuleName) -> LImportDecl GhcPs
    forall {a} {l} {p :: Pass}.
    (Maybe a, GenLocated l ModuleName)
    -> Located (ImportDecl (GhcPass p))
    mkImport ([(Maybe FastString, Located ModuleName)]
    raw_sig_imports [(Maybe FastString, Located ModuleName)]
    -> [(Maybe FastString, Located ModuleName)]
    -> [(Maybe FastString, Located ModuleName)]
    forall a. [a] -> [a] -> [a]
    ++ [(Maybe FastString, Located ModuleName)]
    raw_req_imports) }
            ; -- OK now finally rename the imports
              TcGblEnv
    tcg_env <- {-# SCC "tcRnImports" #-}
                         HscEnv -> [LImportDecl GhcPs] -> TcM TcGblEnv
    tcRnImports HscEnv
    hsc_env [LImportDecl GhcPs]
    all_imports

            ; -- If the whole module is warned about or deprecated
              -- (via mod_deprec) record that in tcg_warns. If we do thereby add
              -- a WarnAll, it will override any subsequent deprecations added to tcg_warns
              let { tcg_env1 :: TcGblEnv
    tcg_env1 = case Maybe (Located WarningTxt)
    mod_deprec of
                                 Just (L SrcSpan
    _ WarningTxt
    txt) ->
                                   TcGblEnv
    tcg_env {tcg_warns :: Warnings
    tcg_warns = WarningTxt -> Warnings
    WarnAll WarningTxt
    txt}
                                 Maybe (Located WarningTxt)
    Nothing            -> TcGblEnv
    tcg_env
                  }
            ; TcGblEnv -> TcM TcGblEnv -> TcM TcGblEnv
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env1
              (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ do { -- Rename and type check the declarations
                     String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceRn String
    "rn1a" SDoc
    empty
                   ; TcGblEnv
    tcg_env <- if HscSource -> Bool
    isHsBootOrSig HscSource
    hsc_src
                                then do {
                                  ; TcGblEnv
    tcg_env <- HscSource -> [LHsDecl GhcPs] -> TcM TcGblEnv
    tcRnHsBootDecls HscSource
    hsc_src [LHsDecl GhcPs]
    local_decls
                                  ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceRn String
    "rn4a: before exports" SDoc
    empty
                                  ; TcGblEnv
    tcg_env <- TcGblEnv -> TcM TcGblEnv -> TcM TcGblEnv
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $
                                               Bool -> Maybe (Located [LIE GhcPs]) -> TcM TcGblEnv
    rnExports Bool
    explicit_mod_hdr Maybe (Located [LIE GhcPs])
    export_ies
                                  ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceRn String
    "rn4b: after exports" SDoc
    empty
                                  ; TcGblEnv -> TcM TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tcg_env
                                  }
                                else {-# SCC "tcRnSrcDecls" #-}
                                     Bool
    -> Maybe (Located [LIE GhcPs]) -> [LHsDecl GhcPs] -> TcM TcGblEnv
    tcRnSrcDecls Bool
    explicit_mod_hdr Maybe (Located [LIE GhcPs])
    export_ies [LHsDecl GhcPs]
    local_decls

                   ; TcRnIf TcGblEnv TcLclEnv Bool
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM (GeneralFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    Opt_DoCoreLinting) (TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $
                     do { let (Bag SDoc
    warns, Bag SDoc
    errs) = DynFlags -> TcGblEnv -> (Bag SDoc, Bag SDoc)
    lintGblEnv (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) TcGblEnv
    tcg_env
                        ; (SDoc -> TcRnIf TcGblEnv TcLclEnv ())
    -> Bag SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> Bag a -> m ()
    mapBagM_ (WarnReason -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addWarn WarnReason
    NoReason) Bag SDoc
    warns
                        ; (SDoc -> TcRnIf TcGblEnv TcLclEnv ())
    -> Bag SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> Bag a -> m ()
    mapBagM_ SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addErr Bag SDoc
    errs
                        ; TcRnIf TcGblEnv TcLclEnv ()
    failIfErrsM }  -- if we have a lint error, we're only
                                         -- going to get in deeper trouble by proceeding

                   ; TcGblEnv -> TcM TcGblEnv -> TcM TcGblEnv
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env
                     (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ do { -- Compare hi-boot iface (if any) with the real thing
                            -- Must be done after processing the exports
                            TcGblEnv
    tcg_env <- TcGblEnv -> SelfBootInfo -> TcM TcGblEnv
    checkHiBootIface TcGblEnv
    tcg_env SelfBootInfo
    boot_info
                          ; -- The new type env is already available to stuff
                            -- slurped from interface files, via
                            -- GHC.Tc.Utils.Env.setGlobalTypeEnv. It's important that this
                            -- includes the stuff in checkHiBootIface,
                            -- because the latter might add new bindings for
                            -- boot_dfuns, which may be mentioned in imported
                            -- unfoldings.

                            -- Don't need to rename the Haddock documentation,
                            -- it's not parsed by GHC anymore.
                            TcGblEnv
    tcg_env <- TcGblEnv -> TcM TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    tcg_env
                                               { tcg_doc_hdr :: Maybe LHsDocString
    tcg_doc_hdr = Maybe LHsDocString
    maybe_doc_hdr })
                          ; -- Report unused names
                            -- Do this /after/ typeinference, so that when reporting
                            -- a function with no type signature we can give the
                            -- inferred type
                            TcGblEnv -> HscSource -> TcRnIf TcGblEnv TcLclEnv ()
    reportUnusedNames TcGblEnv
    tcg_env HscSource
    hsc_src
                          ; -- add extra source files to tcg_dependent_files
                            [String] -> TcRnIf TcGblEnv TcLclEnv ()
    addDependentFiles [String]
    src_files
                            -- Ensure plugins run with the same tcg_env that we pass in
                          ; TcGblEnv -> TcM TcGblEnv -> TcM TcGblEnv
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env
                            (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ do { TcGblEnv
    tcg_env <- ModSummary -> HscEnv -> TcGblEnv -> TcM TcGblEnv
    runTypecheckerPlugin ModSummary
    mod_sum HscEnv
    hsc_env TcGblEnv
    tcg_env
                                 ; -- Dump output and return
                                   TcGblEnv -> TcRnIf TcGblEnv TcLclEnv ()
    tcDump TcGblEnv
    tcg_env
                                 ; TcGblEnv -> TcM TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tcg_env
                                 }
                          }
                   }
            }
          }

    implicitPreludeWarn :: SDoc
    implicitPreludeWarn :: SDoc
    implicitPreludeWarn
      = String -> SDoc
    text String
    "Module `Prelude' implicitly imported"

    {-
    ************************************************************************
    *                                                                      *
                    Import declarations
    *                                                                      *
    ************************************************************************
    -}

    tcRnImports :: HscEnv -> [LImportDecl GhcPs] -> TcM TcGblEnv
    tcRnImports :: HscEnv -> [LImportDecl GhcPs] -> TcM TcGblEnv
    tcRnImports HscEnv
    hsc_env [LImportDecl GhcPs]
    import_decls
      = do  { ([LImportDecl (GhcPass 'Renamed)]
    rn_imports, GlobalRdrEnv
    rdr_env, ImportAvails
    imports, Bool
    hpc_info) <- [LImportDecl GhcPs]
    -> RnM
         ([LImportDecl (GhcPass 'Renamed)], GlobalRdrEnv, ImportAvails,
          Bool)
    rnImports [LImportDecl GhcPs]
    import_decls ;

            ; Module
    this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
    forall (m :: * -> *). HasModule m => m Module
    getModule
            ; let { dep_mods :: ModuleNameEnv ModuleNameWithIsBoot
                  ; dep_mods :: ModuleNameEnv ModuleNameWithIsBoot
    dep_mods = ImportAvails -> ModuleNameEnv ModuleNameWithIsBoot
    imp_dep_mods ImportAvails
    imports

                    -- We want instance declarations from all home-package
                    -- modules below this one, including boot modules, except
                    -- ourselves.  The 'except ourselves' is so that we don't
                    -- get the instances from this module's hs-boot file.  This
                    -- filtering also ensures that we don't see instances from
                    -- modules batch (@--make@) compiled before this one, but
                    -- which are not below this one.
                  ; want_instances :: ModuleName -> Bool
                  ; want_instances :: ModuleName -> Bool
    want_instances ModuleName
    mod = ModuleName
    mod ModuleName -> ModuleNameEnv ModuleNameWithIsBoot -> Bool
    forall key elt. Uniquable key => key -> UniqFM key elt -> Bool
    `elemUFM` ModuleNameEnv ModuleNameWithIsBoot
    dep_mods
                                       Bool -> Bool -> Bool
    && ModuleName
    mod ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    this_mod
                  ; ([ClsInst]
    home_insts, [FamInst]
    home_fam_insts) = HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
    hptInstances HscEnv
    hsc_env
                                                                ModuleName -> Bool
    want_instances
                  } ;

                    -- Record boot-file info in the EPS, so that it's
                    -- visible to loadHiBootInterface in tcRnSrcDecls,
                    -- and any other incrementally-performed imports
            ; (ExternalPackageState -> ExternalPackageState)
    -> TcRnIf TcGblEnv TcLclEnv ()
    forall gbl lcl.
    (ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
    updateEps_ (\ExternalPackageState
    eps -> ExternalPackageState
    eps { eps_is_boot :: ModuleNameEnv ModuleNameWithIsBoot
    eps_is_boot = ModuleNameEnv ModuleNameWithIsBoot
    dep_mods }) ;

                    -- Update the gbl env
            ; (TcGblEnv -> TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall gbl lcl a.
    (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updGblEnv ( \ TcGblEnv
    gbl ->
                TcGblEnv
    gbl {
                  tcg_rdr_env :: GlobalRdrEnv
    tcg_rdr_env      = TcGblEnv -> GlobalRdrEnv
    tcg_rdr_env TcGblEnv
    gbl GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
    `plusGlobalRdrEnv` GlobalRdrEnv
    rdr_env,
                  tcg_imports :: ImportAvails
    tcg_imports      = TcGblEnv -> ImportAvails
    tcg_imports TcGblEnv
    gbl ImportAvails -> ImportAvails -> ImportAvails
    `plusImportAvails` ImportAvails
    imports,
                  tcg_rn_imports :: [LImportDecl (GhcPass 'Renamed)]
    tcg_rn_imports   = [LImportDecl (GhcPass 'Renamed)]
    rn_imports,
                  tcg_inst_env :: InstEnv
    tcg_inst_env     = InstEnv -> [ClsInst] -> InstEnv
    extendInstEnvList (TcGblEnv -> InstEnv
    tcg_inst_env TcGblEnv
    gbl) [ClsInst]
    home_insts,
                  tcg_fam_inst_env :: FamInstEnv
    tcg_fam_inst_env = FamInstEnv -> [FamInst] -> FamInstEnv
    extendFamInstEnvList (TcGblEnv -> FamInstEnv
    tcg_fam_inst_env TcGblEnv
    gbl)
                                                          [FamInst]
    home_fam_insts,
                  tcg_hpc :: Bool
    tcg_hpc          = Bool
    hpc_info
                }) (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ do {

            ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceRn String
    "rn1" (ModuleNameEnv ModuleNameWithIsBoot -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (ImportAvails -> ModuleNameEnv ModuleNameWithIsBoot
    imp_dep_mods ImportAvails
    imports))
                    -- Fail if there are any errors so far
                    -- The error printing (if needed) takes advantage
                    -- of the tcg_env we have now set
    --      ; traceIf (text "rdr_env: " <+> ppr rdr_env)
            ; TcRnIf TcGblEnv TcLclEnv ()
    failIfErrsM

                    -- Load any orphan-module (including orphan family
                    -- instance-module) interfaces, so that their rules and
                    -- instance decls will be found.  But filter out a
                    -- self hs-boot: these instances will be checked when
                    -- we define them locally.
                    -- (We don't need to load non-orphan family instance
                    -- modules until we either try to use the instances they
                    -- define, or define our own family instances, at which
                    -- point we need to check them for consistency.)
            ; SDoc -> [Module] -> TcRnIf TcGblEnv TcLclEnv ()
    loadModuleInterfaces (String -> SDoc
    text String
    "Loading orphan modules")
                                   ((Module -> Bool) -> [Module] -> [Module]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Module -> Module -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Module
    this_mod) (ImportAvails -> [Module]
    imp_orphs ImportAvails
    imports))

                    -- Check type-family consistency between imports.
                    -- See Note [The type family instance consistency story]
            ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceRn String
    "rn1: checking family instance consistency {" SDoc
    empty
            ; let { dir_imp_mods :: [Module]
    dir_imp_mods = ModuleEnv [ImportedBy] -> [Module]
    forall a. ModuleEnv a -> [Module]
    moduleEnvKeys
                                 (ModuleEnv [ImportedBy] -> [Module])
    -> (ImportAvails -> ModuleEnv [ImportedBy])
    -> ImportAvails
    -> [Module]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ImportAvails -> ModuleEnv [ImportedBy]
    imp_mods
                                 (ImportAvails -> [Module]) -> ImportAvails -> [Module]
    forall a b. (a -> b) -> a -> b
    $ ImportAvails
    imports }
            ; [Module] -> TcRnIf TcGblEnv TcLclEnv ()
    checkFamInstConsistency [Module]
    dir_imp_mods
            ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceRn String
    "rn1: } checking family instance consistency" SDoc
    empty

            ; TcM TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv } }

    {-
    ************************************************************************
    *                                                                      *
            Type-checking the top level of a module
    *                                                                      *
    ************************************************************************
    -}

    tcRnSrcDecls :: Bool  -- False => no 'module M(..) where' header at all
                 -> Maybe (Located [LIE GhcPs])
                 -> [LHsDecl GhcPs]               -- Declarations
                 -> TcM TcGblEnv
    tcRnSrcDecls :: Bool
    -> Maybe (Located [LIE GhcPs]) -> [LHsDecl GhcPs] -> TcM TcGblEnv
    tcRnSrcDecls Bool
    explicit_mod_hdr Maybe (Located [LIE GhcPs])
    export_ies [LHsDecl GhcPs]
    decls
     = do { -- Do all the declarations
          ; (TcGblEnv
    tcg_env, TcLclEnv
    tcl_env, WantedConstraints
    lie) <- [LHsDecl GhcPs] -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    tc_rn_src_decls [LHsDecl GhcPs]
    decls

          ------ Simplify constraints ---------
          --
          -- We do this after checkMainType, so that we use the type
          -- info that checkMainType adds
          --
          -- We do it with both global and local env in scope:
          --  * the global env exposes the instances to simplifyTop,
          --    and affects how names are rendered in error messages
          --  * the local env exposes the local Ids to simplifyTop,
          --    so that we get better error messages (monomorphism restriction)
          ; Bag EvBind
    new_ev_binds <- {-# SCC "simplifyTop" #-}
                            (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    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 (Bag EvBind)
     -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind))
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    forall a b. (a -> b) -> a -> b
    $
                            do { WantedConstraints
    lie_main <- TcGblEnv -> TcRn WantedConstraints
    checkMainType TcGblEnv
    tcg_env
                               ; WantedConstraints -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    simplifyTop (WantedConstraints
    lie WantedConstraints -> WantedConstraints -> WantedConstraints
    `andWC` WantedConstraints
    lie_main) }

            -- Emit Typeable bindings
          ; TcGblEnv
    tcg_env <- TcGblEnv -> TcM TcGblEnv -> TcM TcGblEnv
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $
                       TcM TcGblEnv
    mkTypeableBinds

          ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc9" SDoc
    empty

            -- Zonk the final code.  This must be done last.
            -- Even simplifyTop may do some unification.
            -- This pass also warns about missing type signatures
          ; (TypeEnv
    id_env, Bag EvBind
    ev_binds', LHsBinds GhcTc
    binds', [LForeignDecl GhcTc]
    fords', [LTcSpecPrag]
    imp_specs', [LRuleDecl GhcTc]
    rules')
                <- Bag EvBind
    -> TcGblEnv
    -> TcM
         (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
          [LTcSpecPrag], [LRuleDecl GhcTc])
    zonkTcGblEnv Bag EvBind
    new_ev_binds TcGblEnv
    tcg_env

          --------- Run finalizers --------------
          -- Finalizers must run after constraints are simplified, lest types
          --    might not be complete when using reify (see #12777).
          -- and also after we zonk the first time because we run typed splices
          --    in the zonker which gives rise to the finalisers.
          ; let -- init_tcg_env:
                --   * Remove accumulated bindings, rules and so on from
                --     TcGblEnv.  They are now in ev_binds', binds', etc.
                --   * Add the zonked Ids from the value bindings to tcg_type_env
                --     Up to now these Ids are only in tcl_env's type-envt
                init_tcg_env :: TcGblEnv
    init_tcg_env = TcGblEnv
    tcg_env { tcg_binds :: LHsBinds GhcTc
    tcg_binds     = LHsBinds GhcTc
    forall a. Bag a
    emptyBag
                                       , tcg_ev_binds :: Bag EvBind
    tcg_ev_binds  = Bag EvBind
    forall a. Bag a
    emptyBag
                                       , tcg_imp_specs :: [LTcSpecPrag]
    tcg_imp_specs = []
                                       , tcg_rules :: [LRuleDecl GhcTc]
    tcg_rules     = []
                                       , tcg_fords :: [LForeignDecl GhcTc]
    tcg_fords     = []
                                       , tcg_type_env :: TypeEnv
    tcg_type_env  = TcGblEnv -> TypeEnv
    tcg_type_env TcGblEnv
    tcg_env
                                                         TypeEnv -> TypeEnv -> TypeEnv
    `plusTypeEnv` TypeEnv
    id_env }
          ; (TcGblEnv
    tcg_env, TcLclEnv
    tcl_env) <- TcGblEnv
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    init_tcg_env
                                  TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    run_th_modfinalizers
          ; TcRnIf TcGblEnv TcLclEnv ()
    finishTH
          ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc11" SDoc
    empty

          --------- Deal with the exports ----------
          -- Can't be done earlier, because the export list must "see"
          -- the declarations created by the finalizers
          ; TcGblEnv
    tcg_env <- (TcGblEnv, TcLclEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall gbl' lcl' a gbl lcl.
    (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
    setEnvs (TcGblEnv
    tcg_env, TcLclEnv
    tcl_env) (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $
                       Bool -> Maybe (Located [LIE GhcPs]) -> TcM TcGblEnv
    rnExports Bool
    explicit_mod_hdr Maybe (Located [LIE GhcPs])
    export_ies

          --------- Emit the ':Main.main = runMainIO main' declaration ----------
          -- Do this /after/ rnExports, so that it can consult
          -- the tcg_exports created by rnExports
          ; (TcGblEnv
    tcg_env, Bag EvBind
    main_ev_binds)
               <- (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, Bag EvBind)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, Bag EvBind)
    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 (TcGblEnv, Bag EvBind)
     -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, Bag EvBind))
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, Bag EvBind)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, Bag EvBind)
    forall a b. (a -> b) -> a -> b
    $
                  do { (TcGblEnv
    tcg_env, WantedConstraints
    lie) <- TcM TcGblEnv -> TcM (TcGblEnv, WantedConstraints)
    forall a. TcM a -> TcM (a, WantedConstraints)
    captureTopConstraints (TcM TcGblEnv -> TcM (TcGblEnv, WantedConstraints))
    -> TcM TcGblEnv -> TcM (TcGblEnv, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                                         Bool -> Maybe (Located [LIE GhcPs]) -> TcM TcGblEnv
    checkMain Bool
    explicit_mod_hdr Maybe (Located [LIE GhcPs])
    export_ies
                     ; Bag EvBind
    ev_binds <- WantedConstraints -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    simplifyTop WantedConstraints
    lie
                     ; (TcGblEnv, Bag EvBind)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, Bag EvBind)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    tcg_env, Bag EvBind
    ev_binds) }

          ---------- Final zonking ---------------
          -- Zonk the new bindings arising from running the finalisers,
          -- and main. This won't give rise to any more finalisers as you
          -- can't nest finalisers inside finalisers.
          ; (TypeEnv
    id_env_mf, Bag EvBind
    ev_binds_mf, LHsBinds GhcTc
    binds_mf, [LForeignDecl GhcTc]
    fords_mf, [LTcSpecPrag]
    imp_specs_mf, [LRuleDecl GhcTc]
    rules_mf)
                <- Bag EvBind
    -> TcGblEnv
    -> TcM
         (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
          [LTcSpecPrag], [LRuleDecl GhcTc])
    zonkTcGblEnv Bag EvBind
    main_ev_binds TcGblEnv
    tcg_env

          ; let { !final_type_env :: TypeEnv
    final_type_env = TcGblEnv -> TypeEnv
    tcg_type_env TcGblEnv
    tcg_env
                                    TypeEnv -> TypeEnv -> TypeEnv
    `plusTypeEnv` TypeEnv
    id_env_mf
                  -- Add the zonked Ids from the value bindings (they were in tcl_env)
                  -- Force !final_type_env, lest we retain an old reference
                  -- to the previous tcg_env

                ; tcg_env' :: TcGblEnv
    tcg_env' = TcGblEnv
    tcg_env
                              { tcg_binds :: LHsBinds GhcTc
    tcg_binds     = LHsBinds GhcTc
    binds'    LHsBinds GhcTc -> LHsBinds GhcTc -> LHsBinds GhcTc
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` LHsBinds GhcTc
    binds_mf
                              , tcg_ev_binds :: Bag EvBind
    tcg_ev_binds  = Bag EvBind
    ev_binds' Bag EvBind -> Bag EvBind -> Bag EvBind
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag EvBind
    ev_binds_mf
                              , tcg_imp_specs :: [LTcSpecPrag]
    tcg_imp_specs = [LTcSpecPrag]
    imp_specs' [LTcSpecPrag] -> [LTcSpecPrag] -> [LTcSpecPrag]
    forall a. [a] -> [a] -> [a]
    ++ [LTcSpecPrag]
    imp_specs_mf
                              , tcg_rules :: [LRuleDecl GhcTc]
    tcg_rules     = [LRuleDecl GhcTc]
    rules'     [LRuleDecl GhcTc] -> [LRuleDecl GhcTc] -> [LRuleDecl GhcTc]
    forall a. [a] -> [a] -> [a]
    ++ [LRuleDecl GhcTc]
    rules_mf
                              , tcg_fords :: [LForeignDecl GhcTc]
    tcg_fords     = [LForeignDecl GhcTc]
    fords'     [LForeignDecl GhcTc]
    -> [LForeignDecl GhcTc] -> [LForeignDecl GhcTc]
    forall a. [a] -> [a] -> [a]
    ++ [LForeignDecl GhcTc]
    fords_mf } } ;

          ; TcGblEnv -> TypeEnv -> TcM TcGblEnv
    setGlobalTypeEnv TcGblEnv
    tcg_env' TypeEnv
    final_type_env
       }

    zonkTcGblEnv :: Bag EvBind -> TcGblEnv
                 -> TcM (TypeEnv, Bag EvBind, LHsBinds GhcTc,
                           [LForeignDecl GhcTc], [LTcSpecPrag], [LRuleDecl GhcTc])
    zonkTcGblEnv :: Bag EvBind
    -> TcGblEnv
    -> TcM
         (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
          [LTcSpecPrag], [LRuleDecl GhcTc])
    zonkTcGblEnv Bag EvBind
    ev_binds tcg_env :: TcGblEnv
    tcg_env@(TcGblEnv { tcg_binds :: TcGblEnv -> LHsBinds GhcTc
    tcg_binds     = LHsBinds GhcTc
    binds
                                            , tcg_ev_binds :: TcGblEnv -> Bag EvBind
    tcg_ev_binds  = Bag EvBind
    cur_ev_binds
                                            , tcg_imp_specs :: TcGblEnv -> [LTcSpecPrag]
    tcg_imp_specs = [LTcSpecPrag]
    imp_specs
                                            , tcg_rules :: TcGblEnv -> [LRuleDecl GhcTc]
    tcg_rules     = [LRuleDecl GhcTc]
    rules
                                            , tcg_fords :: TcGblEnv -> [LForeignDecl GhcTc]
    tcg_fords     = [LForeignDecl GhcTc]
    fords })
      = {-# SCC "zonkTopDecls" #-}
        TcGblEnv
    -> TcM
         (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
          [LTcSpecPrag], [LRuleDecl GhcTc])
    -> TcM
         (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
          [LTcSpecPrag], [LRuleDecl GhcTc])
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env (TcM
       (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
        [LTcSpecPrag], [LRuleDecl GhcTc])
     -> TcM
          (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
           [LTcSpecPrag], [LRuleDecl GhcTc]))
    -> TcM
         (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
          [LTcSpecPrag], [LRuleDecl GhcTc])
    -> TcM
         (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
          [LTcSpecPrag], [LRuleDecl GhcTc])
    forall a b. (a -> b) -> a -> b
    $ -- This sets the GlobalRdrEnv which is used when rendering
                            --   error messages during zonking (notably levity errors)
        do { TcRnIf TcGblEnv TcLclEnv ()
    failIfErrsM    -- Don't zonk if there have been errors
                            -- It's a waste of time; and we may get debug warnings
                            -- about strangely-typed TyCons!
           ; let all_ev_binds :: Bag EvBind
    all_ev_binds = Bag EvBind
    cur_ev_binds Bag EvBind -> Bag EvBind -> Bag EvBind
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag EvBind
    ev_binds
           ; Bag EvBind
    -> LHsBinds GhcTc
    -> [LRuleDecl GhcTc]
    -> [LTcSpecPrag]
    -> [LForeignDecl GhcTc]
    -> TcM
         (TypeEnv, Bag EvBind, LHsBinds GhcTc, [LForeignDecl GhcTc],
          [LTcSpecPrag], [LRuleDecl GhcTc])
    zonkTopDecls Bag EvBind
    all_ev_binds LHsBinds GhcTc
    binds [LRuleDecl GhcTc]
    rules [LTcSpecPrag]
    imp_specs [LForeignDecl GhcTc]
    fords }

    -- | Runs TH finalizers and renames and typechecks the top-level declarations
    -- that they could introduce.
    run_th_modfinalizers :: TcM (TcGblEnv, TcLclEnv)
    run_th_modfinalizers :: TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    run_th_modfinalizers = do
      TcRef [(TcLclEnv, ThModFinalizers)]
    th_modfinalizers_var <- (TcGblEnv -> TcRef [(TcLclEnv, ThModFinalizers)])
    -> TcM TcGblEnv
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (TcRef [(TcLclEnv, ThModFinalizers)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TcGblEnv -> TcRef [(TcLclEnv, ThModFinalizers)]
    tcg_th_modfinalizers TcM TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
      [(TcLclEnv, ThModFinalizers)]
    th_modfinalizers <- TcRef [(TcLclEnv, ThModFinalizers)]
    -> TcRnIf TcGblEnv TcLclEnv [(TcLclEnv, ThModFinalizers)]
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef TcRef [(TcLclEnv, ThModFinalizers)]
    th_modfinalizers_var
      if [(TcLclEnv, ThModFinalizers)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(TcLclEnv, ThModFinalizers)]
    th_modfinalizers
      then TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
    getEnvs
      else do
        TcRef [(TcLclEnv, ThModFinalizers)]
    -> [(TcLclEnv, ThModFinalizers)] -> TcRnIf TcGblEnv TcLclEnv ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef TcRef [(TcLclEnv, ThModFinalizers)]
    th_modfinalizers_var []
        let run_finalizer :: (TcLclEnv, ThModFinalizers) -> TcRnIf TcGblEnv lcl ()
    run_finalizer (TcLclEnv
    lcl_env, ThModFinalizers
    f) =
                TcLclEnv -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv lcl ()
    forall lcl' gbl a lcl.
    lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
    setLclEnv TcLclEnv
    lcl_env (ThModFinalizers -> TcRnIf TcGblEnv TcLclEnv ()
    runRemoteModFinalizers ThModFinalizers
    f)

        (()
    _, WantedConstraints
    lie_th) <- TcRnIf TcGblEnv TcLclEnv () -> TcM ((), WantedConstraints)
    forall a. TcM a -> TcM (a, WantedConstraints)
    captureTopConstraints (TcRnIf TcGblEnv TcLclEnv () -> TcM ((), WantedConstraints))
    -> TcRnIf TcGblEnv TcLclEnv () -> TcM ((), WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                       ((TcLclEnv, ThModFinalizers) -> TcRnIf TcGblEnv TcLclEnv ())
    -> [(TcLclEnv, ThModFinalizers)] -> TcRnIf TcGblEnv TcLclEnv ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (TcLclEnv, ThModFinalizers) -> TcRnIf TcGblEnv TcLclEnv ()
    forall {lcl}. (TcLclEnv, ThModFinalizers) -> TcRnIf TcGblEnv lcl ()
    run_finalizer [(TcLclEnv, ThModFinalizers)]
    th_modfinalizers

          -- Finalizers can add top-level declarations with addTopDecls, so
          -- we have to run tc_rn_src_decls to get them
        (TcGblEnv
    tcg_env, TcLclEnv
    tcl_env, WantedConstraints
    lie_top_decls) <- [LHsDecl GhcPs] -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    tc_rn_src_decls []

        (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    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 (TcGblEnv, TcLclEnv)
     -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv))
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall a b. (a -> b) -> a -> b
    $ do
          -- Subsequent rounds of finalizers run after any new constraints are
          -- simplified, or some types might not be complete when using reify
          -- (see #12777).
          Bag EvBind
    new_ev_binds <- {-# SCC "simplifyTop2" #-}
                          WantedConstraints -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    simplifyTop (WantedConstraints
    lie_th WantedConstraints -> WantedConstraints -> WantedConstraints
    `andWC` WantedConstraints
    lie_top_decls)
          Bag EvBind
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall a. Bag EvBind -> TcM a -> TcM a
    addTopEvBinds Bag EvBind
    new_ev_binds TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    run_th_modfinalizers
            -- addTopDecls can add declarations which add new finalizers.

    tc_rn_src_decls :: [LHsDecl GhcPs]
                    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    -- Loops around dealing with each top level inter-splice group
    -- in turn, until it's dealt with the entire module
    -- Never emits constraints; calls captureTopConstraints internally
    tc_rn_src_decls :: [LHsDecl GhcPs] -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    tc_rn_src_decls [LHsDecl GhcPs]
    ds
     = {-# SCC "tc_rn_src_decls" #-}
       do { (HsGroup GhcPs
    first_group, Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs])
    group_tail) <- [LHsDecl GhcPs]
    -> RnM (HsGroup GhcPs, Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs]))
    findSplice [LHsDecl GhcPs]
    ds
                    -- If ds is [] we get ([], Nothing)

            -- Deal with decls up to, but not including, the first splice
          ; (TcGblEnv
    tcg_env, HsGroup (GhcPass 'Renamed)
    rn_decls) <- HsGroup GhcPs -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    rnTopSrcDecls HsGroup GhcPs
    first_group
                    -- rnTopSrcDecls fails if there are any errors

            -- Get TH-generated top-level declarations and make sure they don't
            -- contain any splices since we don't handle that at the moment
            --
            -- The plumbing here is a bit odd: see #10853
          ; TcRef [LHsDecl GhcPs]
    th_topdecls_var <- (TcGblEnv -> TcRef [LHsDecl GhcPs])
    -> TcM TcGblEnv
    -> IOEnv (Env TcGblEnv TcLclEnv) (TcRef [LHsDecl GhcPs])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TcGblEnv -> TcRef [LHsDecl GhcPs]
    tcg_th_topdecls TcM TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
          ; [LHsDecl GhcPs]
    th_ds <- TcRef [LHsDecl GhcPs] -> TcRnIf TcGblEnv TcLclEnv [LHsDecl GhcPs]
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef TcRef [LHsDecl GhcPs]
    th_topdecls_var
          ; TcRef [LHsDecl GhcPs]
    -> [LHsDecl GhcPs] -> TcRnIf TcGblEnv TcLclEnv ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef TcRef [LHsDecl GhcPs]
    th_topdecls_var []

          ; (TcGblEnv
    tcg_env, HsGroup (GhcPass 'Renamed)
    rn_decls) <-
                if [LHsDecl GhcPs] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LHsDecl GhcPs]
    th_ds
                then (TcGblEnv, HsGroup (GhcPass 'Renamed))
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    tcg_env, HsGroup (GhcPass 'Renamed)
    rn_decls)
                else do { (HsGroup GhcPs
    th_group, Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs])
    th_group_tail) <- [LHsDecl GhcPs]
    -> RnM (HsGroup GhcPs, Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs]))
    findSplice [LHsDecl GhcPs]
    th_ds
                        ; case Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs])
    th_group_tail of
                            { Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs])
    Nothing -> () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                            ; Just (SpliceDecl XSpliceDecl GhcPs
    _ (L SrcSpan
    loc HsSplice GhcPs
    _) SpliceExplicitFlag
    _, [LHsDecl GhcPs]
    _) ->
                                SrcSpan
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc
                                (TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $ SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addErr (String -> SDoc
    text
                                    (String
    "Declaration splices are not "
                                      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "permitted inside top-level "
                                      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "declarations added with addTopDecls"))
                            }
                          -- Rename TH-generated top-level declarations
                        ; (TcGblEnv
    tcg_env, HsGroup (GhcPass 'Renamed)
    th_rn_decls) <- TcGblEnv
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env
                            (TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
     -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed)))
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ HsGroup GhcPs -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    rnTopSrcDecls HsGroup GhcPs
    th_group

                          -- Dump generated top-level declarations
                        ; let msg :: String
    msg = String
    "top-level declarations added with addTopDecls"
                        ; SpliceInfo -> TcRnIf TcGblEnv TcLclEnv ()
    traceSplice
                            (SpliceInfo -> TcRnIf TcGblEnv TcLclEnv ())
    -> SpliceInfo -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $ SpliceInfo :: String
    -> Maybe (Located (HsExpr (GhcPass 'Renamed)))
    -> Bool
    -> SDoc
    -> SpliceInfo
    SpliceInfo { spliceDescription :: String
    spliceDescription = String
    msg
                                         , spliceIsDecl :: Bool
    spliceIsDecl    = Bool
    True
                                         , spliceSource :: Maybe (Located (HsExpr (GhcPass 'Renamed)))
    spliceSource    = Maybe (Located (HsExpr (GhcPass 'Renamed)))
    forall a. Maybe a
    Nothing
                                         , spliceGenerated :: SDoc
    spliceGenerated = HsGroup (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsGroup (GhcPass 'Renamed)
    th_rn_decls }
                        ; (TcGblEnv, HsGroup (GhcPass 'Renamed))
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    tcg_env, HsGroup (GhcPass 'Renamed)
    -> HsGroup (GhcPass 'Renamed) -> HsGroup (GhcPass 'Renamed)
    forall (p :: Pass).
    HsGroup (GhcPass p) -> HsGroup (GhcPass p) -> HsGroup (GhcPass p)
    appendGroups HsGroup (GhcPass 'Renamed)
    rn_decls HsGroup (GhcPass 'Renamed)
    th_rn_decls)
                        }

          -- Type check all declarations
          -- NB: set the env **before** captureTopConstraints so that error messages
          -- get reported w.r.t. the right GlobalRdrEnv. It is for this reason that
          -- the captureTopConstraints must go here, not in tcRnSrcDecls.
          ; ((TcGblEnv
    tcg_env, TcLclEnv
    tcl_env), WantedConstraints
    lie1) <- TcGblEnv
    -> TcRnIf
         TcGblEnv TcLclEnv ((TcGblEnv, TcLclEnv), WantedConstraints)
    -> TcRnIf
         TcGblEnv TcLclEnv ((TcGblEnv, TcLclEnv), WantedConstraints)
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env (TcRnIf TcGblEnv TcLclEnv ((TcGblEnv, TcLclEnv), WantedConstraints)
     -> TcRnIf
          TcGblEnv TcLclEnv ((TcGblEnv, TcLclEnv), WantedConstraints))
    -> TcRnIf
         TcGblEnv TcLclEnv ((TcGblEnv, TcLclEnv), WantedConstraints)
    -> TcRnIf
         TcGblEnv TcLclEnv ((TcGblEnv, TcLclEnv), WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                                          TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf
         TcGblEnv TcLclEnv ((TcGblEnv, TcLclEnv), WantedConstraints)
    forall a. TcM a -> TcM (a, WantedConstraints)
    captureTopConstraints (TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
     -> TcRnIf
          TcGblEnv TcLclEnv ((TcGblEnv, TcLclEnv), WantedConstraints))
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf
         TcGblEnv TcLclEnv ((TcGblEnv, TcLclEnv), WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                                          HsGroup (GhcPass 'Renamed)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    tcTopSrcDecls HsGroup (GhcPass 'Renamed)
    rn_decls

            -- If there is no splice, we're nearly done
          ; (TcGblEnv, TcLclEnv)
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    forall gbl' lcl' a gbl lcl.
    (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
    setEnvs (TcGblEnv
    tcg_env, TcLclEnv
    tcl_env) (TcM (TcGblEnv, TcLclEnv, WantedConstraints)
     -> TcM (TcGblEnv, TcLclEnv, WantedConstraints))
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
            case Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs])
    group_tail of
              { Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs])
    Nothing -> (TcGblEnv, TcLclEnv, WantedConstraints)
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    tcg_env, TcLclEnv
    tcl_env, WantedConstraints
    lie1)

                -- If there's a splice, we must carry on
              ; Just (SpliceDecl XSpliceDecl GhcPs
    _ (L SrcSpan
    _ HsSplice GhcPs
    splice) SpliceExplicitFlag
    _, [LHsDecl GhcPs]
    rest_ds) ->
                do {
                     -- We need to simplify any constraints from the previous declaration
                     -- group, or else we might reify metavariables, as in #16980.
                   ; Bag EvBind
    ev_binds1 <- WantedConstraints -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    simplifyTop WantedConstraints
    lie1

                     -- Rename the splice expression, and get its supporting decls
                   ; ([LHsDecl GhcPs]
    spliced_decls, FreeVars
    splice_fvs) <- HsSplice GhcPs -> RnM ([LHsDecl GhcPs], FreeVars)
    rnTopSpliceDecls HsSplice GhcPs
    splice

                     -- Glue them on the front of the remaining decls and loop
                   ; TcGblEnv
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv (TcGblEnv
    tcg_env TcGblEnv -> DefUses -> TcGblEnv
    `addTcgDUs` FreeVars -> DefUses
    usesOnly FreeVars
    splice_fvs) (TcM (TcGblEnv, TcLclEnv, WantedConstraints)
     -> TcM (TcGblEnv, TcLclEnv, WantedConstraints))
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                     Bag EvBind
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    forall a. Bag EvBind -> TcM a -> TcM a
    addTopEvBinds Bag EvBind
    ev_binds1                             (TcM (TcGblEnv, TcLclEnv, WantedConstraints)
     -> TcM (TcGblEnv, TcLclEnv, WantedConstraints))
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                     [LHsDecl GhcPs] -> TcM (TcGblEnv, TcLclEnv, WantedConstraints)
    tc_rn_src_decls ([LHsDecl GhcPs]
    spliced_decls [LHsDecl GhcPs] -> [LHsDecl GhcPs] -> [LHsDecl GhcPs]
    forall a. [a] -> [a] -> [a]
    ++ [LHsDecl GhcPs]
    rest_ds)
                   }
              }
          }

    {-
    ************************************************************************
    *                                                                      *
            Compiling hs-boot source files, and
            comparing the hi-boot interface with the real thing
    *                                                                      *
    ************************************************************************
    -}

    tcRnHsBootDecls :: HscSource -> [LHsDecl GhcPs] -> TcM TcGblEnv
    tcRnHsBootDecls :: HscSource -> [LHsDecl GhcPs] -> TcM TcGblEnv
    tcRnHsBootDecls HscSource
    hsc_src [LHsDecl GhcPs]
    decls
       = do { (HsGroup GhcPs
    first_group, Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs])
    group_tail) <- [LHsDecl GhcPs]
    -> RnM (HsGroup GhcPs, Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs]))
    findSplice [LHsDecl GhcPs]
    decls

                    -- Rename the declarations
            ; (TcGblEnv
    tcg_env, HsGroup { hs_tyclds :: forall p. HsGroup p -> [TyClGroup p]
    hs_tyclds = [TyClGroup (GhcPass 'Renamed)]
    tycl_decls
                                , hs_derivds :: forall p. HsGroup p -> [LDerivDecl p]
    hs_derivds = [LDerivDecl (GhcPass 'Renamed)]
    deriv_decls
                                , hs_fords :: forall p. HsGroup p -> [LForeignDecl p]
    hs_fords  = [LForeignDecl (GhcPass 'Renamed)]
    for_decls
                                , hs_defds :: forall p. HsGroup p -> [LDefaultDecl p]
    hs_defds  = [LDefaultDecl (GhcPass 'Renamed)]
    def_decls
                                , hs_ruleds :: forall p. HsGroup p -> [LRuleDecls p]
    hs_ruleds = [LRuleDecls (GhcPass 'Renamed)]
    rule_decls
                                , hs_annds :: forall p. HsGroup p -> [LAnnDecl p]
    hs_annds  = [LAnnDecl (GhcPass 'Renamed)]
    _
                                , hs_valds :: forall p. HsGroup p -> HsValBinds p
    hs_valds  = XValBindsLR (NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    val_binds [LSig (GhcPass 'Renamed)]
    val_sigs) })
                  <- HsGroup GhcPs -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    rnTopSrcDecls HsGroup GhcPs
    first_group

            -- The empty list is for extra dependencies coming from .hs-boot files
            -- See Note [Extra dependencies from .hs-boot files] in GHC.Rename.Module

            ; (TcGblEnv
    gbl_env, WantedConstraints
    lie) <- TcGblEnv
    -> TcM (TcGblEnv, WantedConstraints)
    -> TcM (TcGblEnv, WantedConstraints)
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env (TcM (TcGblEnv, WantedConstraints)
     -> TcM (TcGblEnv, WantedConstraints))
    -> TcM (TcGblEnv, WantedConstraints)
    -> TcM (TcGblEnv, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $ TcM TcGblEnv -> TcM (TcGblEnv, WantedConstraints)
    forall a. TcM a -> TcM (a, WantedConstraints)
    captureTopConstraints (TcM TcGblEnv -> TcM (TcGblEnv, WantedConstraints))
    -> TcM TcGblEnv -> TcM (TcGblEnv, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $ do {
                  -- NB: setGblEnv **before** captureTopConstraints so that
                  -- if the latter reports errors, it knows what's in scope

                    -- Check for illegal declarations
            ; case Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs])
    group_tail of
                 Just (SpliceDecl XSpliceDecl GhcPs
    _ GenLocated SrcSpan (HsSplice GhcPs)
    d SpliceExplicitFlag
    _, [LHsDecl GhcPs]
    _) -> HscSource
    -> String
    -> GenLocated SrcSpan (HsSplice GhcPs)
    -> TcRnIf TcGblEnv TcLclEnv ()
    forall decl.
    HscSource -> String -> Located decl -> TcRnIf TcGblEnv TcLclEnv ()
    badBootDecl HscSource
    hsc_src String
    "splice" GenLocated SrcSpan (HsSplice GhcPs)
    d
                 Maybe (SpliceDecl GhcPs, [LHsDecl GhcPs])
    Nothing                    -> () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            ; (LForeignDecl (GhcPass 'Renamed) -> TcRnIf TcGblEnv TcLclEnv ())
    -> [LForeignDecl (GhcPass 'Renamed)] -> TcRnIf TcGblEnv TcLclEnv ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (HscSource
    -> String
    -> LForeignDecl (GhcPass 'Renamed)
    -> TcRnIf TcGblEnv TcLclEnv ()
    forall decl.
    HscSource -> String -> Located decl -> TcRnIf TcGblEnv TcLclEnv ()
    badBootDecl HscSource
    hsc_src String
    "foreign") [LForeignDecl (GhcPass 'Renamed)]
    for_decls
            ; (LDefaultDecl (GhcPass 'Renamed) -> TcRnIf TcGblEnv TcLclEnv ())
    -> [LDefaultDecl (GhcPass 'Renamed)] -> TcRnIf TcGblEnv TcLclEnv ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (HscSource
    -> String
    -> LDefaultDecl (GhcPass 'Renamed)
    -> TcRnIf TcGblEnv TcLclEnv ()
    forall decl.
    HscSource -> String -> Located decl -> TcRnIf TcGblEnv TcLclEnv ()
    badBootDecl HscSource
    hsc_src String
    "default") [LDefaultDecl (GhcPass 'Renamed)]
    def_decls
            ; (LRuleDecls (GhcPass 'Renamed) -> TcRnIf TcGblEnv TcLclEnv ())
    -> [LRuleDecls (GhcPass 'Renamed)] -> TcRnIf TcGblEnv TcLclEnv ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (HscSource
    -> String
    -> LRuleDecls (GhcPass 'Renamed)
    -> TcRnIf TcGblEnv TcLclEnv ()
    forall decl.
    HscSource -> String -> Located decl -> TcRnIf TcGblEnv TcLclEnv ()
    badBootDecl HscSource
    hsc_src String
    "rule")    [LRuleDecls (GhcPass 'Renamed)]
    rule_decls

                    -- Typecheck type/class/instance decls
            ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc2 (boot)" SDoc
    empty
            ; (TcGblEnv
    tcg_env, [InstInfo (GhcPass 'Renamed)]
    inst_infos, HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    _deriv_binds)
                 <- [TyClGroup (GhcPass 'Renamed)]
    -> [LDerivDecl (GhcPass 'Renamed)]
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    tcTyClsInstDecls [TyClGroup (GhcPass 'Renamed)]
    tycl_decls [LDerivDecl (GhcPass 'Renamed)]
    deriv_decls [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    val_binds
            ; TcGblEnv -> TcM TcGblEnv -> TcM TcGblEnv
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env     (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ do {

            -- Emit Typeable bindings
            ; TcGblEnv
    tcg_env <- TcM TcGblEnv
    mkTypeableBinds
            ; TcGblEnv -> TcM TcGblEnv -> TcM TcGblEnv
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ do {

                    -- Typecheck value declarations
            ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc5" SDoc
    empty
            ; [Id]
    val_ids <- [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [LSig (GhcPass 'Renamed)] -> TcM [Id]
    tcHsBootSigs [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    val_binds [LSig (GhcPass 'Renamed)]
    val_sigs

                    -- Wrap up
                    -- No simplification or zonking to do
            ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc7a" SDoc
    empty
            ; TcGblEnv
    gbl_env <- TcM TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv

                    -- Make the final type-env
                    -- Include the dfun_ids so that their type sigs
                    -- are written into the interface file.
            ; let { type_env0 :: TypeEnv
    type_env0 = TcGblEnv -> TypeEnv
    tcg_type_env TcGblEnv
    gbl_env
                  ; type_env1 :: TypeEnv
    type_env1 = TypeEnv -> [Id] -> TypeEnv
    extendTypeEnvWithIds TypeEnv
    type_env0 [Id]
    val_ids
                  ; type_env2 :: TypeEnv
    type_env2 = TypeEnv -> [Id] -> TypeEnv
    extendTypeEnvWithIds TypeEnv
    type_env1 [Id]
    dfun_ids
                  ; dfun_ids :: [Id]
    dfun_ids = (InstInfo (GhcPass 'Renamed) -> Id)
    -> [InstInfo (GhcPass 'Renamed)] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map InstInfo (GhcPass 'Renamed) -> Id
    forall a. InstInfo a -> Id
    iDFunId [InstInfo (GhcPass 'Renamed)]
    inst_infos
                  }

            ; TcGblEnv -> TypeEnv -> TcM TcGblEnv
    setGlobalTypeEnv TcGblEnv
    gbl_env TypeEnv
    type_env2
       }}}
       ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "boot" (WantedConstraints -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WantedConstraints
    lie); TcGblEnv -> TcM TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    gbl_env }

    badBootDecl :: HscSource -> String -> Located decl -> TcM ()
    badBootDecl :: forall decl.
    HscSource -> String -> Located decl -> TcRnIf TcGblEnv TcLclEnv ()
    badBootDecl HscSource
    hsc_src String
    what (L SrcSpan
    loc decl
    _)
      = SrcSpan -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addErrAt SrcSpan
    loc (Char -> SDoc
    char Char
    'A' SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    what
          SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "declaration is not (currently) allowed in a"
          SDoc -> SDoc -> SDoc
    <+> (case HscSource
    hsc_src of
                HscSource
    HsBootFile -> String -> SDoc
    text String
    "hs-boot"
                HscSource
    HsigFile -> String -> SDoc
    text String
    "hsig"
                HscSource
    _ -> String -> SDoc
    forall a. String -> a
    panic String
    "badBootDecl: should be an hsig or hs-boot file")
          SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "file")

    {-
    Once we've typechecked the body of the module, we want to compare what
    we've found (gathered in a TypeEnv) with the hi-boot details (if any).
    -}

    checkHiBootIface :: TcGblEnv -> SelfBootInfo -> TcM TcGblEnv
    -- Compare the hi-boot file for this module (if there is one)
    -- with the type environment we've just come up with
    -- In the common case where there is no hi-boot file, the list
    -- of boot_names is empty.

    checkHiBootIface :: TcGblEnv -> SelfBootInfo -> TcM TcGblEnv
    checkHiBootIface TcGblEnv
    tcg_env SelfBootInfo
    boot_info
      | SelfBootInfo
    NoSelfBoot <- SelfBootInfo
    boot_info  -- Common case
      = TcGblEnv -> TcM TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tcg_env

      | HscSource
    HsBootFile <- TcGblEnv -> HscSource
    tcg_src TcGblEnv
    tcg_env   -- Current module is already a hs-boot file!
      = TcGblEnv -> TcM TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tcg_env

      | SelfBoot { sb_mds :: SelfBootInfo -> ModDetails
    sb_mds = ModDetails
    boot_details } <- SelfBootInfo
    boot_info
      , TcGblEnv { tcg_binds :: TcGblEnv -> LHsBinds GhcTc
    tcg_binds    = LHsBinds GhcTc
    binds
                 , tcg_insts :: TcGblEnv -> [ClsInst]
    tcg_insts    = [ClsInst]
    local_insts
                 , tcg_type_env :: TcGblEnv -> TypeEnv
    tcg_type_env = TypeEnv
    local_type_env
                 , tcg_exports :: TcGblEnv -> [AvailInfo]
    tcg_exports  = [AvailInfo]
    local_exports } <- TcGblEnv
    tcg_env
      = do  { -- This code is tricky, see Note [DFun knot-tying]
            ; [(Id, Id)]
    dfun_prs <- [ClsInst] -> TypeEnv -> [AvailInfo] -> ModDetails -> TcM [(Id, Id)]
    checkHiBootIface' [ClsInst]
    local_insts TypeEnv
    local_type_env
                                            [AvailInfo]
    local_exports ModDetails
    boot_details

            -- Now add the boot-dfun bindings  $fxblah = $fblah
            -- to (a) the type envt, and (b) the top-level bindings
            ; let boot_dfuns :: [Id]
    boot_dfuns = ((Id, Id) -> Id) -> [(Id, Id)] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map (Id, Id) -> Id
    forall a b. (a, b) -> a
    fst [(Id, Id)]
    dfun_prs
                  type_env' :: TypeEnv
    type_env'  = TypeEnv -> [Id] -> TypeEnv
    extendTypeEnvWithIds TypeEnv
    local_type_env [Id]
    boot_dfuns
                  dfun_binds :: LHsBinds GhcTc
    dfun_binds = [GenLocated SrcSpan (HsBindLR GhcTc GhcTc)] -> LHsBinds GhcTc
    forall a. [a] -> Bag a
    listToBag [ IdP GhcTc
    -> LHsExpr GhcTc -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    forall (p :: Pass).
    IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)
    mkVarBind Id
    IdP GhcTc
    boot_dfun (IdP GhcTc -> LHsExpr GhcTc
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Id
    IdP GhcTc
    dfun)
                                         | (Id
    boot_dfun, Id
    dfun) <- [(Id, Id)]
    dfun_prs ]
                  tcg_env_w_binds :: TcGblEnv
    tcg_env_w_binds
                    = TcGblEnv
    tcg_env { tcg_binds :: LHsBinds GhcTc
    tcg_binds = LHsBinds GhcTc
    binds LHsBinds GhcTc -> LHsBinds GhcTc -> LHsBinds GhcTc
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` LHsBinds GhcTc
    dfun_binds }

            ; TypeEnv
    type_env' TypeEnv -> TcM TcGblEnv -> TcM TcGblEnv
    `seq`
                 -- Why the seq?  Without, we will put a TypeEnv thunk in
                 -- tcg_type_env_var.  That thunk will eventually get
                 -- forced if we are typechecking interfaces, but that
                 -- is no good if we are trying to typecheck the very
                 -- DFun we were going to put in.
                 -- TODO: Maybe setGlobalTypeEnv should be strict.
              TcGblEnv -> TypeEnv -> TcM TcGblEnv
    setGlobalTypeEnv TcGblEnv
    tcg_env_w_binds TypeEnv
    type_env' }

    #if __GLASGOW_HASKELL__ <= 810
      | otherwise = panic "checkHiBootIface: unreachable code"
    #endif

    {- Note [DFun impedance matching]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We return a list of "impedance-matching" bindings for the dfuns
    defined in the hs-boot file, such as
              $fxEqT = $fEqT
    We need these because the module and hi-boot file might differ in
    the name it chose for the dfun: the name of a dfun is not
    uniquely determined by its type; there might be multiple dfuns
    which, individually, would map to the same name (in which case
    we have to disambiguate them.)  There's no way for the hi file
    to know exactly what disambiguation to use... without looking
    at the hi-boot file itself.

    In fact, the names will always differ because we always pick names
    prefixed with "$fx" for boot dfuns, and "$f" for real dfuns
    (so that this impedance matching is always possible).

    Note [DFun knot-tying]
    ~~~~~~~~~~~~~~~~~~~~~~
    The 'SelfBootInfo' that is fed into 'checkHiBootIface' comes from
    typechecking the hi-boot file that we are presently implementing.
    Suppose we are typechecking the module A: when we typecheck the
    hi-boot file, whenever we see an identifier A.T, we knot-tie this
    identifier to the *local* type environment (via if_rec_types.)  The
    contract then is that we don't *look* at 'SelfBootInfo' until we've
    finished typechecking the module and updated the type environment with
    the new tycons and ids.

    This most works well, but there is one problem: DFuns!  We do not want
    to look at the mb_insts of the ModDetails in SelfBootInfo, because a
    dfun in one of those ClsInsts is gotten (in GHC.IfaceToCore.tcIfaceInst) by a
    (lazily evaluated) lookup in the if_rec_types.  We could extend the
    type env, do a setGloblaTypeEnv etc; but that all seems very indirect.
    It is much more directly simply to extract the DFunIds from the
    md_types of the SelfBootInfo.

    See #4003, #16038 for why we need to take care here.
    -}

    checkHiBootIface' :: [ClsInst] -> TypeEnv -> [AvailInfo]
                      -> ModDetails -> TcM [(Id, Id)]
    -- Variant which doesn't require a full TcGblEnv; you could get the
    -- local components from another ModDetails.
    checkHiBootIface' :: [ClsInst] -> TypeEnv -> [AvailInfo] -> ModDetails -> TcM [(Id, Id)]
    checkHiBootIface'
            [ClsInst]
    local_insts TypeEnv
    local_type_env [AvailInfo]
    local_exports
            (ModDetails { md_types :: ModDetails -> TypeEnv
    md_types = TypeEnv
    boot_type_env
                        , md_fam_insts :: ModDetails -> [FamInst]
    md_fam_insts = [FamInst]
    boot_fam_insts
                        , md_exports :: ModDetails -> [AvailInfo]
    md_exports = [AvailInfo]
    boot_exports })
      = do  { String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "checkHiBootIface" (SDoc -> TcRnIf TcGblEnv TcLclEnv ())
    -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat
                 [ TypeEnv -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TypeEnv
    boot_type_env, [AvailInfo] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [AvailInfo]
    boot_exports]

                    -- Check the exports of the boot module, one by one
            ; (AvailInfo -> TcRnIf TcGblEnv TcLclEnv ())
    -> [AvailInfo] -> TcRnIf TcGblEnv TcLclEnv ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ AvailInfo -> TcRnIf TcGblEnv TcLclEnv ()
    check_export [AvailInfo]
    boot_exports

                    -- Check for no family instances
            ; Bool -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([FamInst] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FamInst]
    boot_fam_insts) (TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $
                String -> TcRnIf TcGblEnv TcLclEnv ()
    forall a. String -> a
    panic (String
    "GHC.Tc.Module.checkHiBootIface: Cannot handle family " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                       String
    "instances in boot files yet...")
                -- FIXME: Why?  The actual comparison is not hard, but what would
                --        be the equivalent to the dfun bindings returned for class
                --        instances?  We can't easily equate tycons...

                    -- Check instance declarations
                    -- and generate an impedance-matching binding
            ; [Maybe (Id, Id)]
    mb_dfun_prs <- (Id -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Id, Id)))
    -> [Id] -> IOEnv (Env TcGblEnv TcLclEnv) [Maybe (Id, Id)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Id -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Id, Id))
    check_cls_inst [Id]
    boot_dfuns

            ; TcRnIf TcGblEnv TcLclEnv ()
    failIfErrsM

            ; [(Id, Id)] -> TcM [(Id, Id)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Maybe (Id, Id)] -> [(Id, Id)]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe (Id, Id)]
    mb_dfun_prs) }

      where
        boot_dfun_names :: [Name]
    boot_dfun_names = (Id -> Name) -> [Id] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Name
    idName [Id]
    boot_dfuns
        boot_dfuns :: [Id]
    boot_dfuns      = (Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Id -> Bool
    isDFunId ([Id] -> [Id]) -> [Id] -> [Id]
    forall a b. (a -> b) -> a -> b
    $ TypeEnv -> [Id]
    typeEnvIds TypeEnv
    boot_type_env
           -- NB: boot_dfuns is /not/ defined thus: map instanceDFunId md_insts
           --     We don't want to look at md_insts!
           --     Why not?  See Note [DFun knot-tying]

        check_export :: AvailInfo -> TcRnIf TcGblEnv TcLclEnv ()
    check_export AvailInfo
    boot_avail     -- boot_avail is exported by the boot iface
          | Name
    name Name -> [Name] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [Name]
    boot_dfun_names = () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          | Name -> Bool
    isWiredInName Name
    name          = () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () -- No checking for wired-in names.  In particular,
                                                    -- 'error' is handled by a rather gross hack
                                                    -- (see comments in GHC.Err.hs-boot)

            -- Check that the actual module exports the same thing
          | Bool -> Bool
    not ([Name] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Name]
    missing_names)
          = SrcSpan -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addErrAt (Name -> SrcSpan
    nameSrcSpan ([Name] -> Name
    forall a. [a] -> a
    head [Name]
    missing_names))
                     (Bool -> Name -> String -> SDoc
    missingBootThing Bool
    True ([Name] -> Name
    forall a. [a] -> a
    head [Name]
    missing_names) String
    "exported by")

            -- If the boot module does not *define* the thing, we are done
            -- (it simply re-exports it, and names match, so nothing further to do)
          | Maybe TyThing -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe TyThing
    mb_boot_thing = () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

            -- Check that the actual module also defines the thing, and
            -- then compare the definitions
          | Just TyThing
    real_thing <- TypeEnv -> Name -> Maybe TyThing
    lookupTypeEnv TypeEnv
    local_type_env Name
    name,
            Just TyThing
    boot_thing <- Maybe TyThing
    mb_boot_thing
          = Bool -> TyThing -> TyThing -> TcRnIf TcGblEnv TcLclEnv ()
    checkBootDeclM Bool
    True TyThing
    boot_thing TyThing
    real_thing

          | Bool
    otherwise
          = SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addErrTc (Bool -> Name -> String -> SDoc
    missingBootThing Bool
    True Name
    name String
    "defined in")
          where
            name :: Name
    name          = AvailInfo -> Name
    availName AvailInfo
    boot_avail
            mb_boot_thing :: Maybe TyThing
    mb_boot_thing = TypeEnv -> Name -> Maybe TyThing
    lookupTypeEnv TypeEnv
    boot_type_env Name
    name
            missing_names :: [Name]
    missing_names = case NameEnv AvailInfo -> Name -> Maybe AvailInfo
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv NameEnv AvailInfo
    local_export_env Name
    name of
                              Maybe AvailInfo
    Nothing    -> [Name
    name]
                              Just AvailInfo
    avail -> AvailInfo -> [Name]
    availNames AvailInfo
    boot_avail [Name] -> [Name] -> [Name]
    forall a. Ord a => [a] -> [a] -> [a]
    `minusList` AvailInfo -> [Name]
    availNames AvailInfo
    avail

        local_export_env :: NameEnv AvailInfo
        local_export_env :: NameEnv AvailInfo
    local_export_env = [AvailInfo] -> NameEnv AvailInfo
    availsToNameEnv [AvailInfo]
    local_exports

        check_cls_inst :: DFunId -> TcM (Maybe (Id, Id))
            -- Returns a pair of the boot dfun in terms of the equivalent
            -- real dfun. Delicate (like checkBootDecl) because it depends
            -- on the types lining up precisely even to the ordering of
            -- the type variables in the foralls.
        check_cls_inst :: Id -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Id, Id))
    check_cls_inst Id
    boot_dfun
          | (Id
    real_dfun : [Id]
    _) <- Id -> [Id]
    find_real_dfun Id
    boot_dfun
          , let local_boot_dfun :: Id
    local_boot_dfun = Name -> Type -> Id
    Id.mkExportedVanillaId
                                      (Id -> Name
    idName Id
    boot_dfun) (Id -> Type
    idType Id
    real_dfun)
          = Maybe (Id, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Id, Id))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Id, Id) -> Maybe (Id, Id)
    forall a. a -> Maybe a
    Just (Id
    local_boot_dfun, Id
    real_dfun))
              -- Two tricky points here:
              --
              --  * The local_boot_fun should have a Name from the /boot-file/,
              --    but type from the dfun defined in /this module/.
              --    That ensures that the TyCon etc inside the type are
              --    the ones defined in this module, not the ones gotten
              --    from the hi-boot file, which may have a lot less info
              --    (#8743, comment:10).
              --
              --  * The DFunIds from boot_details are /GlobalIds/, because
              --    they come from typechecking M.hi-boot.
              --    But all bindings in this module should be for /LocalIds/,
              --    otherwise dependency analysis fails (#16038). This
              --    is another reason for using mkExportedVanillaId, rather
              --    that modifying boot_dfun, to make local_boot_fun.

          | Bool
    otherwise
          = SrcSpan
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Id, Id))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Id, Id))
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (Name -> SrcSpan
    nameSrcSpan (Id -> Name
    forall a. NamedThing a => a -> Name
    getName Id
    boot_dfun)) (IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Id, Id))
     -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Id, Id)))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Id, Id))
    -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Id, Id))
    forall a b. (a -> b) -> a -> b
    $
            do { String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "check_cls_inst" (SDoc -> TcRnIf TcGblEnv TcLclEnv ())
    -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat
                    [ String -> SDoc
    text String
    "local_insts"  SDoc -> SDoc -> SDoc
    <+>
                         [SDoc] -> SDoc
    vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Type -> SDoc) -> (ClsInst -> Type) -> ClsInst -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    idType (Id -> Type) -> (ClsInst -> Id) -> ClsInst -> Type
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClsInst -> Id
    instanceDFunId) [ClsInst]
    local_insts)
                    , String -> SDoc
    text String
    "boot_dfun_ty" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Id -> Type
    idType Id
    boot_dfun) ]

               ; SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addErrTc (Id -> SDoc
    instMisMatch Id
    boot_dfun)
               ; Maybe (Id, Id) -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe (Id, Id))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Id, Id)
    forall a. Maybe a
    Nothing }

        find_real_dfun :: DFunId -> [DFunId]
        find_real_dfun :: Id -> [Id]
    find_real_dfun Id
    boot_dfun
           = [Id
    dfun | ClsInst
    inst <- [ClsInst]
    local_insts
                   , let dfun :: Id
    dfun = ClsInst -> Id
    instanceDFunId ClsInst
    inst
                   , Id -> Type
    idType Id
    dfun Type -> Type -> Bool
    `eqType` Type
    boot_dfun_ty ]
           where
              boot_dfun_ty :: Type
    boot_dfun_ty   = Id -> Type
    idType Id
    boot_dfun

    -- In general, to perform these checks we have to
    -- compare the TyThing from the .hi-boot file to the TyThing
    -- in the current source file.  We must be careful to allow alpha-renaming
    -- where appropriate, and also the boot declaration is allowed to omit
    -- constructors and class methods.
    --
    -- See rnfail055 for a good test of this stuff.

    -- | Compares two things for equivalence between boot-file and normal code,
    -- reporting an error if they don't match up.
    checkBootDeclM :: Bool  -- ^ True <=> an hs-boot file (could also be a sig)
                   -> TyThing -> TyThing -> TcM ()
    checkBootDeclM :: Bool -> TyThing -> TyThing -> TcRnIf TcGblEnv TcLclEnv ()
    checkBootDeclM Bool
    is_boot TyThing
    boot_thing TyThing
    real_thing
      = Maybe SDoc
    -> (SDoc -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenIsJust (Bool -> TyThing -> TyThing -> Maybe SDoc
    checkBootDecl Bool
    is_boot TyThing
    boot_thing TyThing
    real_thing) ((SDoc -> TcRnIf TcGblEnv TcLclEnv ())
     -> TcRnIf TcGblEnv TcLclEnv ())
    -> (SDoc -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $ \ SDoc
    err ->
           SrcSpan -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addErrAt SrcSpan
    span
                    (Bool -> SDoc -> TyThing -> TyThing -> SDoc
    bootMisMatch Bool
    is_boot SDoc
    err TyThing
    real_thing TyThing
    boot_thing)
      where
        -- Here we use the span of the boot thing or, if it doesn't have a sensible
        -- span, that of the real thing,
        span :: SrcSpan
    span
          | let span :: SrcSpan
    span = Name -> SrcSpan
    nameSrcSpan (TyThing -> Name
    forall a. NamedThing a => a -> Name
    getName TyThing
    boot_thing)
          , SrcSpan -> Bool
    isGoodSrcSpan SrcSpan
    span
          = SrcSpan
    span
          | Bool
    otherwise
          = Name -> SrcSpan
    nameSrcSpan (TyThing -> Name
    forall a. NamedThing a => a -> Name
    getName TyThing
    real_thing)

    -- | Compares the two things for equivalence between boot-file and normal
    -- code. Returns @Nothing@ on success or @Just "some helpful info for user"@
    -- failure. If the difference will be apparent to the user, @Just empty@ is
    -- perfectly suitable.
    checkBootDecl :: Bool -> TyThing -> TyThing -> Maybe SDoc

    checkBootDecl :: Bool -> TyThing -> TyThing -> Maybe SDoc
    checkBootDecl Bool
    _ (AnId Id
    id1) (AnId Id
    id2)
      = ASSERT(id1 == id2)
        Bool -> SDoc -> Maybe SDoc
    check (Id -> Type
    idType Id
    id1 Type -> Type -> Bool
    `eqType` Id -> Type
    idType Id
    id2)
              (String -> SDoc
    text String
    "The two types are different")

    checkBootDecl Bool
    is_boot (ATyCon TyCon
    tc1) (ATyCon TyCon
    tc2)
      = Bool -> TyCon -> TyCon -> Maybe SDoc
    checkBootTyCon Bool
    is_boot TyCon
    tc1 TyCon
    tc2

    checkBootDecl Bool
    _ (AConLike (RealDataCon DataCon
    dc1)) (AConLike (RealDataCon DataCon
    _))
      = String -> SDoc -> Maybe SDoc
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "checkBootDecl" (DataCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DataCon
    dc1)

    checkBootDecl Bool
    _ TyThing
    _ TyThing
    _ = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just SDoc
    empty -- probably shouldn't happen

    -- | Combines two potential error messages
    andThenCheck :: Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    Maybe SDoc
    Nothing andThenCheck :: Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck` Maybe SDoc
    msg     = Maybe SDoc
    msg
    Maybe SDoc
    msg     `andThenCheck` Maybe SDoc
    Nothing = Maybe SDoc
    msg
    Just SDoc
    d1 `andThenCheck` Just SDoc
    d2 = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc
    d1 SDoc -> SDoc -> SDoc
    $$ SDoc
    d2)
    infixr 0 `andThenCheck`

    -- | If the test in the first parameter is True, succeed with @Nothing@;
    -- otherwise, return the provided check
    checkUnless :: Bool -> Maybe SDoc -> Maybe SDoc
    checkUnless :: Bool -> Maybe SDoc -> Maybe SDoc
    checkUnless Bool
    True  Maybe SDoc
    _ = Maybe SDoc
    forall a. Maybe a
    Nothing
    checkUnless Bool
    False Maybe SDoc
    k = Maybe SDoc
    k

    -- | Run the check provided for every pair of elements in the lists.
    -- The provided SDoc should name the element type, in the plural.
    checkListBy :: (a -> a -> Maybe SDoc) -> [a] -> [a] -> SDoc
                -> Maybe SDoc
    checkListBy :: forall a.
    (a -> a -> Maybe SDoc) -> [a] -> [a] -> SDoc -> Maybe SDoc
    checkListBy a -> a -> Maybe SDoc
    check_fun [a]
    as [a]
    bs SDoc
    whats = [SDoc] -> [a] -> [a] -> Maybe SDoc
    go [] [a]
    as [a]
    bs
      where
        herald :: SDoc
    herald = String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> SDoc
    whats SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "do not match"

        go :: [SDoc] -> [a] -> [a] -> Maybe SDoc
    go []   [] [] = Maybe SDoc
    forall a. Maybe a
    Nothing
        go [SDoc]
    docs [] [] = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Arity -> SDoc -> SDoc
    hang (SDoc
    herald SDoc -> SDoc -> SDoc
    <> SDoc
    colon) Arity
    2 ([SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> [SDoc]
    forall a. [a] -> [a]
    reverse [SDoc]
    docs))
        go [SDoc]
    docs (a
    x:[a]
    xs) (a
    y:[a]
    ys) = case a -> a -> Maybe SDoc
    check_fun a
    x a
    y of
          Just SDoc
    doc -> [SDoc] -> [a] -> [a] -> Maybe SDoc
    go (SDoc
    docSDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    :[SDoc]
    docs) [a]
    xs [a]
    ys
          Maybe SDoc
    Nothing  -> [SDoc] -> [a] -> [a] -> Maybe SDoc
    go [SDoc]
    docs       [a]
    xs [a]
    ys
        go [SDoc]
    _    [a]
    _  [a]
    _ = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Arity -> SDoc -> SDoc
    hang (SDoc
    herald SDoc -> SDoc -> SDoc
    <> SDoc
    colon)
                                Arity
    2 (String -> SDoc
    text String
    "There are different numbers of" SDoc -> SDoc -> SDoc
    <+> SDoc
    whats))

    -- | If the test in the first parameter is True, succeed with @Nothing@;
    -- otherwise, fail with the given SDoc.
    check :: Bool -> SDoc -> Maybe SDoc
    check :: Bool -> SDoc -> Maybe SDoc
    check Bool
    True  SDoc
    _   = Maybe SDoc
    forall a. Maybe a
    Nothing
    check Bool
    False SDoc
    doc = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just SDoc
    doc

    -- | A more perspicuous name for @Nothing@, for @checkBootDecl@ and friends.
    checkSuccess :: Maybe SDoc
    checkSuccess :: Maybe SDoc
    checkSuccess = Maybe SDoc
    forall a. Maybe a
    Nothing

    ----------------
    checkBootTyCon :: Bool -> TyCon -> TyCon -> Maybe SDoc
    checkBootTyCon :: Bool -> TyCon -> TyCon -> Maybe SDoc
    checkBootTyCon Bool
    is_boot TyCon
    tc1 TyCon
    tc2
      | Bool -> Bool
    not (Type -> Type -> Bool
    eqType (TyCon -> Type
    tyConKind TyCon
    tc1) (TyCon -> Type
    tyConKind TyCon
    tc2))
      = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "The types have different kinds"    -- First off, check the kind

      | Just Class
    c1 <- TyCon -> Maybe Class
    tyConClass_maybe TyCon
    tc1
      , Just Class
    c2 <- TyCon -> Maybe Class
    tyConClass_maybe TyCon
    tc2
      , let ([Id]
    clas_tvs1, [FunDep Id]
    clas_fds1, [Type]
    sc_theta1, [Id]
    _, [ClassATItem]
    ats1, [ClassOpItem]
    op_stuff1)
              = Class
    -> ([Id], [FunDep Id], [Type], [Id], [ClassATItem], [ClassOpItem])
    classExtraBigSig Class
    c1
            ([Id]
    clas_tvs2, [FunDep Id]
    clas_fds2, [Type]
    sc_theta2, [Id]
    _, [ClassATItem]
    ats2, [ClassOpItem]
    op_stuff2)
              = Class
    -> ([Id], [FunDep Id], [Type], [Id], [ClassATItem], [ClassOpItem])
    classExtraBigSig Class
    c2
      , Just RnEnv2
    env <- RnEnv2 -> [Id] -> [Id] -> Maybe RnEnv2
    eqVarBndrs RnEnv2
    emptyRnEnv2 [Id]
    clas_tvs1 [Id]
    clas_tvs2
      = let
           eqSig :: ClassOpItem -> ClassOpItem -> Maybe SDoc
    eqSig (Id
    id1, Maybe (Name, DefMethSpec Type)
    def_meth1) (Id
    id2, Maybe (Name, DefMethSpec Type)
    def_meth2)
             = Bool -> SDoc -> Maybe SDoc
    check (Name
    name1 Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    name2)
                     (String -> SDoc
    text String
    "The names" SDoc -> SDoc -> SDoc
    <+> SDoc
    pname1 SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "and" SDoc -> SDoc -> SDoc
    <+> SDoc
    pname2 SDoc -> SDoc -> SDoc
    <+>
                      String -> SDoc
    text String
    "are different") Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
               Bool -> SDoc -> Maybe SDoc
    check (RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    op_ty1 Type
    op_ty2)
                     (String -> SDoc
    text String
    "The types of" SDoc -> SDoc -> SDoc
    <+> SDoc
    pname1 SDoc -> SDoc -> SDoc
    <+>
                      String -> SDoc
    text String
    "are different") Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
               if Bool
    is_boot
                   then Bool -> SDoc -> Maybe SDoc
    check (((Name, DefMethSpec Type) -> (Name, DefMethSpec Type) -> Bool)
    -> Maybe (Name, DefMethSpec Type)
    -> Maybe (Name, DefMethSpec Type)
    -> Bool
    forall a. (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
    eqMaybeBy (Name, DefMethSpec Type) -> (Name, DefMethSpec Type) -> Bool
    eqDM Maybe (Name, DefMethSpec Type)
    def_meth1 Maybe (Name, DefMethSpec Type)
    def_meth2)
                              (String -> SDoc
    text String
    "The default methods associated with" SDoc -> SDoc -> SDoc
    <+> SDoc
    pname1 SDoc -> SDoc -> SDoc
    <+>
                               String -> SDoc
    text String
    "are different")
                   else Bool -> SDoc -> Maybe SDoc
    check (Type
    -> Maybe (Name, DefMethSpec Type)
    -> Maybe (Name, DefMethSpec Type)
    -> Bool
    subDM Type
    op_ty1 Maybe (Name, DefMethSpec Type)
    def_meth1 Maybe (Name, DefMethSpec Type)
    def_meth2)
                              (String -> SDoc
    text String
    "The default methods associated with" SDoc -> SDoc -> SDoc
    <+> SDoc
    pname1 SDoc -> SDoc -> SDoc
    <+>
                               String -> SDoc
    text String
    "are not compatible")
             where
              name1 :: Name
    name1 = Id -> Name
    idName Id
    id1
              name2 :: Name
    name2 = Id -> Name
    idName Id
    id2
              pname1 :: SDoc
    pname1 = SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name1)
              pname2 :: SDoc
    pname2 = SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name2)
              op_ty1 :: Type
    op_ty1 = Id -> Type
    classMethodTy Id
    id1
              op_ty2 :: Type
    op_ty2 = Id -> Type
    classMethodTy Id
    id2

           eqAT :: ClassATItem -> ClassATItem -> Maybe SDoc
    eqAT (ATI TyCon
    tc1 Maybe (Type, ATValidityInfo)
    def_ats1) (ATI TyCon
    tc2 Maybe (Type, ATValidityInfo)
    def_ats2)
             = Bool -> TyCon -> TyCon -> Maybe SDoc
    checkBootTyCon Bool
    is_boot TyCon
    tc1 TyCon
    tc2 Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
               Bool -> SDoc -> Maybe SDoc
    check (Maybe (Type, ATValidityInfo)
    -> Maybe (Type, ATValidityInfo) -> Bool
    eqATDef Maybe (Type, ATValidityInfo)
    def_ats1 Maybe (Type, ATValidityInfo)
    def_ats2)
                     (String -> SDoc
    text String
    "The associated type defaults differ")

           eqDM :: (Name, DefMethSpec Type) -> (Name, DefMethSpec Type) -> Bool
    eqDM (Name
    _, DefMethSpec Type
    VanillaDM)    (Name
    _, DefMethSpec Type
    VanillaDM)    = Bool
    True
           eqDM (Name
    _, GenericDM Type
    t1) (Name
    _, GenericDM Type
    t2) = RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    t1 Type
    t2
           eqDM (Name, DefMethSpec Type)
    _ (Name, DefMethSpec Type)
    _ = Bool
    False

           -- NB: first argument is from hsig, second is from real impl.
           -- Order of pattern matching matters.
           subDM :: Type
    -> Maybe (Name, DefMethSpec Type)
    -> Maybe (Name, DefMethSpec Type)
    -> Bool
    subDM Type
    _ Maybe (Name, DefMethSpec Type)
    Nothing Maybe (Name, DefMethSpec Type)
    _ = Bool
    True
           subDM Type
    _ Maybe (Name, DefMethSpec Type)
    _ Maybe (Name, DefMethSpec Type)
    Nothing = Bool
    False
           -- If the hsig wrote:
           --
           --   f :: a -> a
           --   default f :: a -> a
           --
           -- this should be validly implementable using an old-fashioned
           -- vanilla default method.
           subDM Type
    t1 (Just (Name
    _, GenericDM Type
    t2)) (Just (Name
    _, DefMethSpec Type
    VanillaDM))
            = RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    t1 Type
    t2
           -- This case can occur when merging signatures
           subDM Type
    t1 (Just (Name
    _, DefMethSpec Type
    VanillaDM)) (Just (Name
    _, GenericDM Type
    t2))
            = RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    t1 Type
    t2
           subDM Type
    _ (Just (Name
    _, DefMethSpec Type
    VanillaDM)) (Just (Name
    _, DefMethSpec Type
    VanillaDM)) = Bool
    True
           subDM Type
    _ (Just (Name
    _, GenericDM Type
    t1)) (Just (Name
    _, GenericDM Type
    t2))
            = RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    t1 Type
    t2

           -- Ignore the location of the defaults
           eqATDef :: Maybe (Type, ATValidityInfo)
    -> Maybe (Type, ATValidityInfo) -> Bool
    eqATDef Maybe (Type, ATValidityInfo)
    Nothing             Maybe (Type, ATValidityInfo)
    Nothing             = Bool
    True
           eqATDef (Just (Type
    ty1, ATValidityInfo
    _loc1)) (Just (Type
    ty2, ATValidityInfo
    _loc2)) = RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    ty1 Type
    ty2
           eqATDef Maybe (Type, ATValidityInfo)
    _ Maybe (Type, ATValidityInfo)
    _ = Bool
    False

           eqFD :: FunDep Id -> FunDep Id -> Bool
    eqFD ([Id]
    as1,[Id]
    bs1) ([Id]
    as2,[Id]
    bs2) =
             (Type -> Type -> Bool) -> [Type] -> [Type] -> Bool
    forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
    eqListBy (RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env) ([Id] -> [Type]
    mkTyVarTys [Id]
    as1) ([Id] -> [Type]
    mkTyVarTys [Id]
    as2) Bool -> Bool -> Bool
    &&
             (Type -> Type -> Bool) -> [Type] -> [Type] -> Bool
    forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
    eqListBy (RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env) ([Id] -> [Type]
    mkTyVarTys [Id]
    bs1) ([Id] -> [Type]
    mkTyVarTys [Id]
    bs2)
        in
        [Role] -> [Role] -> Maybe SDoc
    checkRoles [Role]
    roles1 [Role]
    roles2 Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
              -- Checks kind of class
        Bool -> SDoc -> Maybe SDoc
    check ((FunDep Id -> FunDep Id -> Bool)
    -> [FunDep Id] -> [FunDep Id] -> Bool
    forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
    eqListBy FunDep Id -> FunDep Id -> Bool
    eqFD [FunDep Id]
    clas_fds1 [FunDep Id]
    clas_fds2)
              (String -> SDoc
    text String
    "The functional dependencies do not match") Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
        Bool -> Maybe SDoc -> Maybe SDoc
    checkUnless (TyCon -> Bool
    isAbstractTyCon TyCon
    tc1) (Maybe SDoc -> Maybe SDoc) -> Maybe SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $
        Bool -> SDoc -> Maybe SDoc
    check ((Type -> Type -> Bool) -> [Type] -> [Type] -> Bool
    forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
    eqListBy (RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env) [Type]
    sc_theta1 [Type]
    sc_theta2)
              (String -> SDoc
    text String
    "The class constraints do not match") Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
        (ClassOpItem -> ClassOpItem -> Maybe SDoc)
    -> [ClassOpItem] -> [ClassOpItem] -> SDoc -> Maybe SDoc
    forall a.
    (a -> a -> Maybe SDoc) -> [a] -> [a] -> SDoc -> Maybe SDoc
    checkListBy ClassOpItem -> ClassOpItem -> Maybe SDoc
    eqSig [ClassOpItem]
    op_stuff1 [ClassOpItem]
    op_stuff2 (String -> SDoc
    text String
    "methods") Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
        (ClassATItem -> ClassATItem -> Maybe SDoc)
    -> [ClassATItem] -> [ClassATItem] -> SDoc -> Maybe SDoc
    forall a.
    (a -> a -> Maybe SDoc) -> [a] -> [a] -> SDoc -> Maybe SDoc
    checkListBy ClassATItem -> ClassATItem -> Maybe SDoc
    eqAT [ClassATItem]
    ats1 [ClassATItem]
    ats2 (String -> SDoc
    text String
    "associated types") Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
        Bool -> SDoc -> Maybe SDoc
    check (Class -> ClassMinimalDef
    classMinimalDef Class
    c1 ClassMinimalDef -> ClassMinimalDef -> Bool
    forall a.
    Uniquable a =>
    BooleanFormula a -> BooleanFormula a -> Bool
    `BF.implies` Class -> ClassMinimalDef
    classMinimalDef Class
    c2)
            (String -> SDoc
    text String
    "The MINIMAL pragmas are not compatible")

      | Just Type
    syn_rhs1 <- TyCon -> DFunInstType
    synTyConRhs_maybe TyCon
    tc1
      , Just Type
    syn_rhs2 <- TyCon -> DFunInstType
    synTyConRhs_maybe TyCon
    tc2
      , Just RnEnv2
    env <- RnEnv2 -> [Id] -> [Id] -> Maybe RnEnv2
    eqVarBndrs RnEnv2
    emptyRnEnv2 (TyCon -> [Id]
    tyConTyVars TyCon
    tc1) (TyCon -> [Id]
    tyConTyVars TyCon
    tc2)
      = ASSERT(tc1 == tc2)
        [Role] -> [Role] -> Maybe SDoc
    checkRoles [Role]
    roles1 [Role]
    roles2 Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
        Bool -> SDoc -> Maybe SDoc
    check (RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    syn_rhs1 Type
    syn_rhs2) SDoc
    empty   -- nothing interesting to say
      -- This allows abstract 'data T a' to be implemented using 'type T = ...'
      -- and abstract 'class K a' to be implement using 'type K = ...'
      -- See Note [Synonyms implement abstract data]
      | Bool -> Bool
    not Bool
    is_boot -- don't support for hs-boot yet
      , TyCon -> Bool
    isAbstractTyCon TyCon
    tc1
      , Just ([Id]
    tvs, Type
    ty) <- TyCon -> Maybe ([Id], Type)
    synTyConDefn_maybe TyCon
    tc2
      , Just (TyCon
    tc2', [Type]
    args) <- HasCallStack => Type -> Maybe (TyCon, [Type])
    Type -> Maybe (TyCon, [Type])
    tcSplitTyConApp_maybe Type
    ty
      = [Id] -> Type -> TyCon -> [Type] -> Maybe SDoc
    checkSynAbsData [Id]
    tvs Type
    ty TyCon
    tc2' [Type]
    args
        -- TODO: When it's a synonym implementing a class, we really
        -- should check if the fundeps are satisfied, but
        -- there is not an obvious way to do this for a constraint synonym.
        -- So for now, let it all through (it won't cause segfaults, anyway).
        -- Tracked at #12704.

      -- This allows abstract 'data T :: Nat' to be implemented using
      -- 'type T = 42' Since the kinds already match (we have checked this
      -- upfront) all we need to check is that the implementation 'type T
      -- = ...' defined an actual literal.  See #15138 for the case this
      -- handles.
      | Bool -> Bool
    not Bool
    is_boot
      , TyCon -> Bool
    isAbstractTyCon TyCon
    tc1
      , Just ([Id]
    _,Type
    ty2) <- TyCon -> Maybe ([Id], Type)
    synTyConDefn_maybe TyCon
    tc2
      , Maybe TyLit -> Bool
    forall a. Maybe a -> Bool
    isJust (Type -> Maybe TyLit
    isLitTy Type
    ty2)
      = Maybe SDoc
    forall a. Maybe a
    Nothing

      | Just FamTyConFlav
    fam_flav1 <- TyCon -> Maybe FamTyConFlav
    famTyConFlav_maybe TyCon
    tc1
      , Just FamTyConFlav
    fam_flav2 <- TyCon -> Maybe FamTyConFlav
    famTyConFlav_maybe TyCon
    tc2
      = ASSERT(tc1 == tc2)
        let eqFamFlav :: FamTyConFlav -> FamTyConFlav -> Bool
    eqFamFlav FamTyConFlav
    OpenSynFamilyTyCon   FamTyConFlav
    OpenSynFamilyTyCon = Bool
    True
            eqFamFlav (DataFamilyTyCon {}) (DataFamilyTyCon {}) = Bool
    True
            -- This case only happens for hsig merging:
            eqFamFlav FamTyConFlav
    AbstractClosedSynFamilyTyCon FamTyConFlav
    AbstractClosedSynFamilyTyCon = Bool
    True
            eqFamFlav FamTyConFlav
    AbstractClosedSynFamilyTyCon (ClosedSynFamilyTyCon {}) = Bool
    True
            eqFamFlav (ClosedSynFamilyTyCon {}) FamTyConFlav
    AbstractClosedSynFamilyTyCon = Bool
    True
            eqFamFlav (ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
    ax1) (ClosedSynFamilyTyCon Maybe (CoAxiom Branched)
    ax2)
                = Maybe (CoAxiom Branched) -> Maybe (CoAxiom Branched) -> Bool
    forall {br :: BranchFlag} {br :: BranchFlag}.
    Maybe (CoAxiom br) -> Maybe (CoAxiom br) -> Bool
    eqClosedFamilyAx Maybe (CoAxiom Branched)
    ax1 Maybe (CoAxiom Branched)
    ax2
            eqFamFlav (BuiltInSynFamTyCon {}) (BuiltInSynFamTyCon {}) = TyCon
    tc1 TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    tc2
            eqFamFlav FamTyConFlav
    _ FamTyConFlav
    _ = Bool
    False
            injInfo1 :: Injectivity
    injInfo1 = TyCon -> Injectivity
    tyConInjectivityInfo TyCon
    tc1
            injInfo2 :: Injectivity
    injInfo2 = TyCon -> Injectivity
    tyConInjectivityInfo TyCon
    tc2
        in
        -- check equality of roles, family flavours and injectivity annotations
        -- (NB: Type family roles are always nominal. But the check is
        -- harmless enough.)
        [Role] -> [Role] -> Maybe SDoc
    checkRoles [Role]
    roles1 [Role]
    roles2 Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
        Bool -> SDoc -> Maybe SDoc
    check (FamTyConFlav -> FamTyConFlav -> Bool
    eqFamFlav FamTyConFlav
    fam_flav1 FamTyConFlav
    fam_flav2)
            (SDoc -> SDoc
    whenPprDebug (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                String -> SDoc
    text String
    "Family flavours" SDoc -> SDoc -> SDoc
    <+> FamTyConFlav -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr FamTyConFlav
    fam_flav1 SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "and" SDoc -> SDoc -> SDoc
    <+> FamTyConFlav -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr FamTyConFlav
    fam_flav2 SDoc -> SDoc -> SDoc
    <+>
                String -> SDoc
    text String
    "do not match") Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
        Bool -> SDoc -> Maybe SDoc
    check (Injectivity
    injInfo1 Injectivity -> Injectivity -> Bool
    forall a. Eq a => a -> a -> Bool
    == Injectivity
    injInfo2) (String -> SDoc
    text String
    "Injectivities do not match")

      | TyCon -> Bool
    isAlgTyCon TyCon
    tc1 Bool -> Bool -> Bool
    && TyCon -> Bool
    isAlgTyCon TyCon
    tc2
      , Just RnEnv2
    env <- RnEnv2 -> [Id] -> [Id] -> Maybe RnEnv2
    eqVarBndrs RnEnv2
    emptyRnEnv2 (TyCon -> [Id]
    tyConTyVars TyCon
    tc1) (TyCon -> [Id]
    tyConTyVars TyCon
    tc2)
      = ASSERT(tc1 == tc2)
        [Role] -> [Role] -> Maybe SDoc
    checkRoles [Role]
    roles1 [Role]
    roles2 Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
        Bool -> SDoc -> Maybe SDoc
    check ((Type -> Type -> Bool) -> [Type] -> [Type] -> Bool
    forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
    eqListBy (RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env)
                         (TyCon -> [Type]
    tyConStupidTheta TyCon
    tc1) (TyCon -> [Type]
    tyConStupidTheta TyCon
    tc2))
              (String -> SDoc
    text String
    "The datatype contexts do not match") Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
        TyCon -> AlgTyConRhs -> AlgTyConRhs -> Maybe SDoc
    forall {p}. p -> AlgTyConRhs -> AlgTyConRhs -> Maybe SDoc
    eqAlgRhs TyCon
    tc1 (TyCon -> AlgTyConRhs
    algTyConRhs TyCon
    tc1) (TyCon -> AlgTyConRhs
    algTyConRhs TyCon
    tc2)

      | Bool
    otherwise = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just SDoc
    empty   -- two very different types -- should be obvious
      where
        roles1 :: [Role]
    roles1 = TyCon -> [Role]
    tyConRoles TyCon
    tc1 -- the abstract one
        roles2 :: [Role]
    roles2 = TyCon -> [Role]
    tyConRoles TyCon
    tc2
        roles_msg :: SDoc
    roles_msg = String -> SDoc
    text String
    "The roles do not match." SDoc -> SDoc -> SDoc
    $$
                    (String -> SDoc
    text String
    "Roles on abstract types default to" SDoc -> SDoc -> SDoc
    <+>
                     SDoc -> SDoc
    quotes (String -> SDoc
    text String
    "representational") SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "in boot files.")

        roles_subtype_msg :: SDoc
    roles_subtype_msg = String -> SDoc
    text String
    "The roles are not compatible:" SDoc -> SDoc -> SDoc
    $$
                            String -> SDoc
    text String
    "Main module:" SDoc -> SDoc -> SDoc
    <+> [Role] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Role]
    roles2 SDoc -> SDoc -> SDoc
    $$
                            String -> SDoc
    text String
    "Hsig file:" SDoc -> SDoc -> SDoc
    <+> [Role] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Role]
    roles1

        checkRoles :: [Role] -> [Role] -> Maybe SDoc
    checkRoles [Role]
    r1 [Role]
    r2
          | Bool
    is_boot Bool -> Bool -> Bool
    || TyCon -> Role -> Bool
    isInjectiveTyCon TyCon
    tc1 Role
    Representational -- See Note [Role subtyping]
          = Bool -> SDoc -> Maybe SDoc
    check ([Role]
    r1 [Role] -> [Role] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Role]
    r2) SDoc
    roles_msg
          | Bool
    otherwise = Bool -> SDoc -> Maybe SDoc
    check ([Role]
    r2 [Role] -> [Role] -> Bool
    forall {a}. Ord a => [a] -> [a] -> Bool
    `rolesSubtypeOf` [Role]
    r1) SDoc
    roles_subtype_msg

        -- Note [Role subtyping]
        -- ~~~~~~~~~~~~~~~~~~~~~
        -- In the current formulation of roles, role subtyping is only OK if the
        -- "abstract" TyCon was not representationally injective.  Among the most
        -- notable examples of non representationally injective TyCons are abstract
        -- data, which can be implemented via newtypes (which are not
        -- representationally injective).  The key example is
        -- in this example from #13140:
        --
        --      -- In an hsig file
        --      data T a -- abstract!
        --      type role T nominal
        --
        --      -- Elsewhere
        --      foo :: Coercible (T a) (T b) => a -> b
        --      foo x = x
        --
        -- We must NOT allow foo to typecheck, because if we instantiate
        -- T with a concrete data type with a phantom role would cause
        -- Coercible (T a) (T b) to be provable.  Fortunately, if T is not
        -- representationally injective, we cannot make the inference that a ~N b if
        -- T a ~R T b.
        --
        -- Unconditional role subtyping would be possible if we setup
        -- an extra set of roles saying when we can project out coercions
        -- (we call these proj-roles); then it would NOT be valid to instantiate T
        -- with a data type at phantom since the proj-role subtyping check
        -- would fail.  See #13140 for more details.
        --
        -- One consequence of this is we get no role subtyping for non-abstract
        -- data types in signatures. Suppose you have:
        --
        --      signature A where
        --          type role T nominal
        --          data T a = MkT
        --
        -- If you write this, we'll treat T as injective, and make inferences
        -- like T a ~R T b ==> a ~N b (mkNthCo).  But if we can
        -- subsequently replace T with one at phantom role, we would then be able to
        -- infer things like T Int ~R T Bool which is bad news.
        --
        -- We could allow role subtyping here if we didn't treat *any* data types
        -- defined in signatures as injective.  But this would be a bit surprising,
        -- replacing a data type in a module with one in a signature could cause
        -- your code to stop typechecking (whereas if you made the type abstract,
        -- it is more understandable that the type checker knows less).
        --
        -- It would have been best if this was purely a question of defaults
        -- (i.e., a user could explicitly ask for one behavior or another) but
        -- the current role system isn't expressive enough to do this.
        -- Having explicit proj-roles would solve this problem.

        rolesSubtypeOf :: [a] -> [a] -> Bool
    rolesSubtypeOf [] [] = Bool
    True
        -- NB: this relation is the OPPOSITE of the subroling relation
        rolesSubtypeOf (a
    x:[a]
    xs) (a
    y:[a]
    ys) = a
    x a -> a -> Bool
    forall a. Ord a => a -> a -> Bool
    >= a
    y Bool -> Bool -> Bool
    && [a] -> [a] -> Bool
    rolesSubtypeOf [a]
    xs [a]
    ys
        rolesSubtypeOf [a]
    _ [a]
    _ = Bool
    False

        -- Note [Synonyms implement abstract data]
        -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        -- An abstract data type or class can be implemented using a type synonym,
        -- but ONLY if the type synonym is nullary and has no type family
        -- applications.  This arises from two properties of skolem abstract data:
        --
        --    For any T (with some number of paramaters),
        --
        --    1. T is a valid type (it is "curryable"), and
        --
        --    2. T is valid in an instance head (no type families).
        --
        -- See also 'HowAbstract' and Note [Skolem abstract data].

        -- | Given @type T tvs = ty@, where @ty@ decomposes into @tc2' args@,
        -- check that this synonym is an acceptable implementation of @tc1@.
        -- See Note [Synonyms implement abstract data]
        checkSynAbsData :: [TyVar] -> Type -> TyCon -> [Type] -> Maybe SDoc
        checkSynAbsData :: [Id] -> Type -> TyCon -> [Type] -> Maybe SDoc
    checkSynAbsData [Id]
    tvs Type
    ty TyCon
    tc2' [Type]
    args =
            Bool -> SDoc -> Maybe SDoc
    check ([(TyCon, [Type])] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Type -> [(TyCon, [Type])]
    tcTyFamInsts Type
    ty))
                  (String -> SDoc
    text String
    "Illegal type family application in implementation of abstract data.")
                    Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
            Bool -> SDoc -> Maybe SDoc
    check ([Id] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Id]
    tvs)
                  (String -> SDoc
    text String
    "Illegal parameterized type synonym in implementation of abstract data." SDoc -> SDoc -> SDoc
    $$
                   String -> SDoc
    text String
    "(Try eta reducing your type synonym so that it is nullary.)")
                    Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
            -- Don't report roles errors unless the type synonym is nullary
            Bool -> Maybe SDoc -> Maybe SDoc
    checkUnless (Bool -> Bool
    not ([Id] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Id]
    tvs)) (Maybe SDoc -> Maybe SDoc) -> Maybe SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $
                ASSERT( null roles2 )
                -- If we have something like:
                --
                --  signature H where
                --      data T a
                --  module H where
                --      data K a b = ...
                --      type T = K Int
                --
                -- we need to drop the first role of K when comparing!
                [Role] -> [Role] -> Maybe SDoc
    checkRoles [Role]
    roles1 (Arity -> [Role] -> [Role]
    forall a. Arity -> [a] -> [a]
    drop ([Type] -> Arity
    forall (t :: * -> *) a. Foldable t => t a -> Arity
    length [Type]
    args) (TyCon -> [Role]
    tyConRoles TyCon
    tc2'))
    {-
            -- Hypothetically, if we were allow to non-nullary type synonyms, here
            -- is how you would check the roles
            if length tvs == length roles1
                then checkRoles roles1 roles2
                else case tcSplitTyConApp_maybe ty of
                        Just (tc2', args) ->
                            checkRoles roles1 (drop (length args) (tyConRoles tc2') ++ roles2)
                        Nothing -> Just roles_msg
    -}

        eqAlgRhs :: p -> AlgTyConRhs -> AlgTyConRhs -> Maybe SDoc
    eqAlgRhs p
    _ AlgTyConRhs
    AbstractTyCon AlgTyConRhs
    _rhs2
          = Maybe SDoc
    checkSuccess -- rhs2 is guaranteed to be injective, since it's an AlgTyCon
        eqAlgRhs p
    _  tc1 :: AlgTyConRhs
    tc1@DataTyCon{} tc2 :: AlgTyConRhs
    tc2@DataTyCon{} =
            (DataCon -> DataCon -> Maybe SDoc)
    -> [DataCon] -> [DataCon] -> SDoc -> Maybe SDoc
    forall a.
    (a -> a -> Maybe SDoc) -> [a] -> [a] -> SDoc -> Maybe SDoc
    checkListBy DataCon -> DataCon -> Maybe SDoc
    eqCon (AlgTyConRhs -> [DataCon]
    data_cons AlgTyConRhs
    tc1) (AlgTyConRhs -> [DataCon]
    data_cons AlgTyConRhs
    tc2) (String -> SDoc
    text String
    "constructors")
        eqAlgRhs p
    _  tc1 :: AlgTyConRhs
    tc1@NewTyCon{} tc2 :: AlgTyConRhs
    tc2@NewTyCon{} =
            DataCon -> DataCon -> Maybe SDoc
    eqCon (AlgTyConRhs -> DataCon
    data_con AlgTyConRhs
    tc1) (AlgTyConRhs -> DataCon
    data_con AlgTyConRhs
    tc2)
        eqAlgRhs p
    _ AlgTyConRhs
    _ AlgTyConRhs
    _ = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (String -> SDoc
    text String
    "Cannot match a" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (String -> SDoc
    text String
    "data") SDoc -> SDoc -> SDoc
    <+>
                               String -> SDoc
    text String
    "definition with a" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (String -> SDoc
    text String
    "newtype") SDoc -> SDoc -> SDoc
    <+>
                               String -> SDoc
    text String
    "definition")

        eqCon :: DataCon -> DataCon -> Maybe SDoc
    eqCon DataCon
    c1 DataCon
    c2
          =  Bool -> SDoc -> Maybe SDoc
    check (Name
    name1 Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    name2)
                   (String -> SDoc
    text String
    "The names" SDoc -> SDoc -> SDoc
    <+> SDoc
    pname1 SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "and" SDoc -> SDoc -> SDoc
    <+> SDoc
    pname2 SDoc -> SDoc -> SDoc
    <+>
                    String -> SDoc
    text String
    "differ") Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
             Bool -> SDoc -> Maybe SDoc
    check (DataCon -> Bool
    dataConIsInfix DataCon
    c1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == DataCon -> Bool
    dataConIsInfix DataCon
    c2)
                   (String -> SDoc
    text String
    "The fixities of" SDoc -> SDoc -> SDoc
    <+> SDoc
    pname1 SDoc -> SDoc -> SDoc
    <+>
                    String -> SDoc
    text String
    "differ") Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
             Bool -> SDoc -> Maybe SDoc
    check ((HsImplBang -> HsImplBang -> Bool)
    -> [HsImplBang] -> [HsImplBang] -> Bool
    forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
    eqListBy HsImplBang -> HsImplBang -> Bool
    eqHsBang (DataCon -> [HsImplBang]
    dataConImplBangs DataCon
    c1) (DataCon -> [HsImplBang]
    dataConImplBangs DataCon
    c2))
                   (String -> SDoc
    text String
    "The strictness annotations for" SDoc -> SDoc -> SDoc
    <+> SDoc
    pname1 SDoc -> SDoc -> SDoc
    <+>
                    String -> SDoc
    text String
    "differ") Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
             Bool -> SDoc -> Maybe SDoc
    check ((FieldLbl Name -> Name) -> [FieldLbl Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLbl Name -> Name
    forall a. FieldLbl a -> a
    flSelector (DataCon -> [FieldLbl Name]
    dataConFieldLabels DataCon
    c1) [Name] -> [Name] -> Bool
    forall a. Eq a => a -> a -> Bool
    == (FieldLbl Name -> Name) -> [FieldLbl Name] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map FieldLbl Name -> Name
    forall a. FieldLbl a -> a
    flSelector (DataCon -> [FieldLbl Name]
    dataConFieldLabels DataCon
    c2))
                   (String -> SDoc
    text String
    "The record label lists for" SDoc -> SDoc -> SDoc
    <+> SDoc
    pname1 SDoc -> SDoc -> SDoc
    <+>
                    String -> SDoc
    text String
    "differ") Maybe SDoc -> Maybe SDoc -> Maybe SDoc
    `andThenCheck`
             Bool -> SDoc -> Maybe SDoc
    check (Type -> Type -> Bool
    eqType (DataCon -> Type
    dataConWrapperType DataCon
    c1) (DataCon -> Type
    dataConWrapperType DataCon
    c2))
                   (String -> SDoc
    text String
    "The types for" SDoc -> SDoc -> SDoc
    <+> SDoc
    pname1 SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "differ")
          where
            name1 :: Name
    name1 = DataCon -> Name
    dataConName DataCon
    c1
            name2 :: Name
    name2 = DataCon -> Name
    dataConName DataCon
    c2
            pname1 :: SDoc
    pname1 = SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name1)
            pname2 :: SDoc
    pname2 = SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name2)

        eqClosedFamilyAx :: Maybe (CoAxiom br) -> Maybe (CoAxiom br) -> Bool
    eqClosedFamilyAx Maybe (CoAxiom br)
    Nothing Maybe (CoAxiom br)
    Nothing  = Bool
    True
        eqClosedFamilyAx Maybe (CoAxiom br)
    Nothing (Just CoAxiom br
    _) = Bool
    False
        eqClosedFamilyAx (Just CoAxiom br
    _) Maybe (CoAxiom br)
    Nothing = Bool
    False
        eqClosedFamilyAx (Just (CoAxiom { co_ax_branches :: forall (br :: BranchFlag). CoAxiom br -> Branches br
    co_ax_branches = Branches br
    branches1 }))
                         (Just (CoAxiom { co_ax_branches :: forall (br :: BranchFlag). CoAxiom br -> Branches br
    co_ax_branches = Branches br
    branches2 }))
          =  Branches br -> Arity
    forall (br :: BranchFlag). Branches br -> Arity
    numBranches Branches br
    branches1 Arity -> Arity -> Bool
    forall a. Eq a => a -> a -> Bool
    == Branches br -> Arity
    forall (br :: BranchFlag). Branches br -> Arity
    numBranches Branches br
    branches2
          Bool -> Bool -> Bool
    && ([Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and ([Bool] -> Bool) -> [Bool] -> Bool
    forall a b. (a -> b) -> a -> b
    $ (CoAxBranch -> CoAxBranch -> Bool)
    -> [CoAxBranch] -> [CoAxBranch] -> [Bool]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith CoAxBranch -> CoAxBranch -> Bool
    eqClosedFamilyBranch [CoAxBranch]
    branch_list1 [CoAxBranch]
    branch_list2)
          where
            branch_list1 :: [CoAxBranch]
    branch_list1 = Branches br -> [CoAxBranch]
    forall (br :: BranchFlag). Branches br -> [CoAxBranch]
    fromBranches Branches br
    branches1
            branch_list2 :: [CoAxBranch]
    branch_list2 = Branches br -> [CoAxBranch]
    forall (br :: BranchFlag). Branches br -> [CoAxBranch]
    fromBranches Branches br
    branches2

        eqClosedFamilyBranch :: CoAxBranch -> CoAxBranch -> Bool
    eqClosedFamilyBranch (CoAxBranch { cab_tvs :: CoAxBranch -> [Id]
    cab_tvs = [Id]
    tvs1, cab_cvs :: CoAxBranch -> [Id]
    cab_cvs = [Id]
    cvs1
                                         , cab_lhs :: CoAxBranch -> [Type]
    cab_lhs = [Type]
    lhs1, cab_rhs :: CoAxBranch -> Type
    cab_rhs = Type
    rhs1 })
                             (CoAxBranch { cab_tvs :: CoAxBranch -> [Id]
    cab_tvs = [Id]
    tvs2, cab_cvs :: CoAxBranch -> [Id]
    cab_cvs = [Id]
    cvs2
                                         , cab_lhs :: CoAxBranch -> [Type]
    cab_lhs = [Type]
    lhs2, cab_rhs :: CoAxBranch -> Type
    cab_rhs = Type
    rhs2 })
          | Just RnEnv2
    env1 <- RnEnv2 -> [Id] -> [Id] -> Maybe RnEnv2
    eqVarBndrs RnEnv2
    emptyRnEnv2 [Id]
    tvs1 [Id]
    tvs2
          , Just RnEnv2
    env  <- RnEnv2 -> [Id] -> [Id] -> Maybe RnEnv2
    eqVarBndrs RnEnv2
    env1        [Id]
    cvs1 [Id]
    cvs2
          = (Type -> Type -> Bool) -> [Type] -> [Type] -> Bool
    forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
    eqListBy (RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env) [Type]
    lhs1 [Type]
    lhs2 Bool -> Bool -> Bool
    &&
            RnEnv2 -> Type -> Type -> Bool
    eqTypeX RnEnv2
    env Type
    rhs1 Type
    rhs2

          | Bool
    otherwise = Bool
    False

    emptyRnEnv2 :: RnEnv2
    emptyRnEnv2 :: RnEnv2
    emptyRnEnv2 = InScopeSet -> RnEnv2
    mkRnEnv2 InScopeSet
    emptyInScopeSet

    ----------------
    missingBootThing :: Bool -> Name -> String -> SDoc
    missingBootThing :: Bool -> Name -> String -> SDoc
    missingBootThing Bool
    is_boot Name
    name String
    what
      = SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is exported by the"
        SDoc -> SDoc -> SDoc
    <+> (if Bool
    is_boot then String -> SDoc
    text String
    "hs-boot" else String -> SDoc
    text String
    "hsig")
        SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "file, but not"
        SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "the module"

    badReexportedBootThing :: Bool -> Name -> Name -> SDoc
    badReexportedBootThing :: Bool -> Name -> Name -> SDoc
    badReexportedBootThing Bool
    is_boot Name
    name Name
    name'
      = PrintUnqualified -> Depth -> SDoc -> SDoc
    withUserStyle PrintUnqualified
    alwaysQualify Depth
    AllTheWay (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat
            [ String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> (if Bool
    is_boot then String -> SDoc
    text String
    "hs-boot" else String -> SDoc
    text String
    "hsig")
               SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "file (re)exports" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name)
            , String -> SDoc
    text String
    "but the implementing module exports a different identifier" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name')
            ]

    bootMisMatch :: Bool -> SDoc -> TyThing -> TyThing -> SDoc
    bootMisMatch :: Bool -> SDoc -> TyThing -> TyThing -> SDoc
    bootMisMatch Bool
    is_boot SDoc
    extra_info TyThing
    real_thing TyThing
    boot_thing
      = Bool -> SDoc -> TyThing -> SDoc -> SDoc -> SDoc
    pprBootMisMatch Bool
    is_boot SDoc
    extra_info TyThing
    real_thing SDoc
    real_doc SDoc
    boot_doc
      where
        to_doc :: TyThing -> SDoc
    to_doc
          = ShowSub -> TyThing -> SDoc
    pprTyThingInContext (ShowSub -> TyThing -> SDoc) -> ShowSub -> TyThing -> SDoc
    forall a b. (a -> b) -> a -> b
    $ ShowSub
    showToHeader { ss_forall :: ShowForAllFlag
    ss_forall =
                                                  if Bool
    is_boot
                                                    then ShowForAllFlag
    ShowForAllMust
                                                    else ShowForAllFlag
    ShowForAllWhen }

        real_doc :: SDoc
    real_doc = TyThing -> SDoc
    to_doc TyThing
    real_thing
        boot_doc :: SDoc
    boot_doc = TyThing -> SDoc
    to_doc TyThing
    boot_thing

        pprBootMisMatch :: Bool -> SDoc -> TyThing -> SDoc -> SDoc -> SDoc
        pprBootMisMatch :: Bool -> SDoc -> TyThing -> SDoc -> SDoc -> SDoc
    pprBootMisMatch Bool
    is_boot SDoc
    extra_info TyThing
    real_thing SDoc
    real_doc SDoc
    boot_doc
          = [SDoc] -> SDoc
    vcat
              [ TyThing -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyThing
    real_thing SDoc -> SDoc -> SDoc
    <+>
                String -> SDoc
    text String
    "has conflicting definitions in the module",
                String -> SDoc
    text String
    "and its" SDoc -> SDoc -> SDoc
    <+>
                  (if Bool
    is_boot
                    then String -> SDoc
    text String
    "hs-boot file"
                    else String -> SDoc
    text String
    "hsig file"),
                String -> SDoc
    text String
    "Main module:" SDoc -> SDoc -> SDoc
    <+> SDoc
    real_doc,
                  (if Bool
    is_boot
                    then String -> SDoc
    text String
    "Boot file:  "
                    else String -> SDoc
    text String
    "Hsig file: ")
                    SDoc -> SDoc -> SDoc
    <+> SDoc
    boot_doc,
                SDoc
    extra_info
              ]

    instMisMatch :: DFunId -> SDoc
    instMisMatch :: Id -> SDoc
    instMisMatch Id
    dfun
      = SDoc -> Arity -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "instance" SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Id -> Type
    idType Id
    dfun))
           Arity
    2 (String -> SDoc
    text String
    "is defined in the hs-boot file, but not in the module itself")

    {-
    ************************************************************************
    *                                                                      *
            Type-checking the top level of a module (continued)
    *                                                                      *
    ************************************************************************
    -}

    rnTopSrcDecls :: HsGroup GhcPs -> TcM (TcGblEnv, HsGroup GhcRn)
    -- Fails if there are any errors
    rnTopSrcDecls :: HsGroup GhcPs -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    rnTopSrcDecls HsGroup GhcPs
    group
     = do { -- Rename the source decls
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceRn String
    "rn12" SDoc
    empty ;
            (TcGblEnv
    tcg_env, HsGroup (GhcPass 'Renamed)
    rn_decls) <- TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    forall r. TcM r -> TcM r
    checkNoErrs (TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
     -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed)))
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ HsGroup GhcPs -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    rnSrcDecls HsGroup GhcPs
    group ;
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceRn String
    "rn13" SDoc
    empty ;
            (TcGblEnv
    tcg_env, HsGroup (GhcPass 'Renamed)
    rn_decls) <- TcGblEnv
    -> HsGroup (GhcPass 'Renamed)
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    runRenamerPlugin TcGblEnv
    tcg_env HsGroup (GhcPass 'Renamed)
    rn_decls ;
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceRn String
    "rn13-plugin" SDoc
    empty ;

            -- save the renamed syntax, if we want it
            let { tcg_env' :: TcGblEnv
    tcg_env'
                    | Just HsGroup (GhcPass 'Renamed)
    grp <- TcGblEnv -> Maybe (HsGroup (GhcPass 'Renamed))
    tcg_rn_decls TcGblEnv
    tcg_env
                      = TcGblEnv
    tcg_env{ tcg_rn_decls :: Maybe (HsGroup (GhcPass 'Renamed))
    tcg_rn_decls = HsGroup (GhcPass 'Renamed) -> Maybe (HsGroup (GhcPass 'Renamed))
    forall a. a -> Maybe a
    Just (HsGroup (GhcPass 'Renamed)
    -> HsGroup (GhcPass 'Renamed) -> HsGroup (GhcPass 'Renamed)
    forall (p :: Pass).
    HsGroup (GhcPass p) -> HsGroup (GhcPass p) -> HsGroup (GhcPass p)
    appendGroups HsGroup (GhcPass 'Renamed)
    grp HsGroup (GhcPass 'Renamed)
    rn_decls) }
                    | Bool
    otherwise
                       = TcGblEnv
    tcg_env };

                    -- Dump trace of renaming part
            HsGroup (GhcPass 'Renamed) -> TcRnIf TcGblEnv TcLclEnv ()
    forall a.
    (Outputable a, Data a) =>
    a -> TcRnIf TcGblEnv TcLclEnv ()
    rnDump HsGroup (GhcPass 'Renamed)
    rn_decls ;
            (TcGblEnv, HsGroup (GhcPass 'Renamed))
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    tcg_env', HsGroup (GhcPass 'Renamed)
    rn_decls)
       }

    tcTopSrcDecls :: HsGroup GhcRn -> TcM (TcGblEnv, TcLclEnv)
    tcTopSrcDecls :: HsGroup (GhcPass 'Renamed)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    tcTopSrcDecls (HsGroup { hs_tyclds :: forall p. HsGroup p -> [TyClGroup p]
    hs_tyclds = [TyClGroup (GhcPass 'Renamed)]
    tycl_decls,
                             hs_derivds :: forall p. HsGroup p -> [LDerivDecl p]
    hs_derivds = [LDerivDecl (GhcPass 'Renamed)]
    deriv_decls,
                             hs_fords :: forall p. HsGroup p -> [LForeignDecl p]
    hs_fords  = [LForeignDecl (GhcPass 'Renamed)]
    foreign_decls,
                             hs_defds :: forall p. HsGroup p -> [LDefaultDecl p]
    hs_defds  = [LDefaultDecl (GhcPass 'Renamed)]
    default_decls,
                             hs_annds :: forall p. HsGroup p -> [LAnnDecl p]
    hs_annds  = [LAnnDecl (GhcPass 'Renamed)]
    annotation_decls,
                             hs_ruleds :: forall p. HsGroup p -> [LRuleDecls p]
    hs_ruleds = [LRuleDecls (GhcPass 'Renamed)]
    rule_decls,
                             hs_valds :: forall p. HsGroup p -> HsValBinds p
    hs_valds  = hs_val_binds :: HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    hs_val_binds@(XValBindsLR
                                                  (NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    val_binds [LSig (GhcPass 'Renamed)]
    val_sigs)) })
     = do {         -- Type-check the type and class decls, and all imported decls
                    -- The latter come in via tycl_decls
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc2 (src)" SDoc
    empty ;

                    -- Source-language instances, including derivings,
                    -- and import the supporting declarations
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc3" SDoc
    empty ;
            (TcGblEnv
    tcg_env, [InstInfo (GhcPass 'Renamed)]
    inst_infos, XValBindsLR (NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    deriv_binds [LSig (GhcPass 'Renamed)]
    deriv_sigs))
                <- [TyClGroup (GhcPass 'Renamed)]
    -> [LDerivDecl (GhcPass 'Renamed)]
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    tcTyClsInstDecls [TyClGroup (GhcPass 'Renamed)]
    tycl_decls [LDerivDecl (GhcPass 'Renamed)]
    deriv_decls [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    val_binds ;

            TcGblEnv
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env       (TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
     -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv))
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall a b. (a -> b) -> a -> b
    $ do {

                    -- Generate Applicative/Monad proposal (AMP) warnings
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc3b" SDoc
    empty ;

                    -- Generate Semigroup/Monoid warnings
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc3c" SDoc
    empty ;
            TcRnIf TcGblEnv TcLclEnv ()
    tcSemigroupWarnings ;

                    -- Foreign import declarations next.
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc4" SDoc
    empty ;
            ([Id]
    fi_ids, [LForeignDecl GhcTc]
    fi_decls, Bag GlobalRdrElt
    fi_gres) <- [LForeignDecl (GhcPass 'Renamed)]
    -> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt)
    tcForeignImports [LForeignDecl (GhcPass 'Renamed)]
    foreign_decls ;
            [Id]
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall a. [Id] -> TcM a -> TcM a
    tcExtendGlobalValEnv [Id]
    fi_ids     (TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
     -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv))
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall a b. (a -> b) -> a -> b
    $ do {

                    -- Default declarations
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc4a" SDoc
    empty ;
            Maybe [Type]
    default_tys <- [LDefaultDecl (GhcPass 'Renamed)] -> TcM (Maybe [Type])
    tcDefaults [LDefaultDecl (GhcPass 'Renamed)]
    default_decls ;
            (TcGblEnv -> TcGblEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall gbl lcl a.
    (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updGblEnv (\TcGblEnv
    gbl -> TcGblEnv
    gbl { tcg_default :: Maybe [Type]
    tcg_default = Maybe [Type]
    default_tys }) (TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
     -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv))
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall a b. (a -> b) -> a -> b
    $ do {

                    -- Value declarations next.
                    -- It is important that we check the top-level value bindings
                    -- before the GHC-generated derived bindings, since the latter
                    -- may be defined in terms of the former. (For instance,
                    -- the bindings produced in a Data instance.)
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc5" SDoc
    empty ;
            (TcGblEnv, TcLclEnv)
    tc_envs <- [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [LSig (GhcPass 'Renamed)]
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    tcTopBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    val_binds [LSig (GhcPass 'Renamed)]
    val_sigs;
            (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall gbl' lcl' a gbl lcl.
    (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
    setEnvs (TcGblEnv, TcLclEnv)
    tc_envs (TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
     -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv))
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall a b. (a -> b) -> a -> b
    $ do {

                    -- Now GHC-generated derived bindings, generics, and selectors
                    -- Do not generate warnings from compiler-generated code;
                    -- hence the use of discardWarnings
            tc_envs :: (TcGblEnv, TcLclEnv)
    tc_envs@(TcGblEnv
    tcg_env, TcLclEnv
    tcl_env)
                <- TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall r. TcM r -> TcM r
    discardWarnings ([(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [LSig (GhcPass 'Renamed)]
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    tcTopBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    deriv_binds [LSig (GhcPass 'Renamed)]
    deriv_sigs) ;
            (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall gbl' lcl' a gbl lcl.
    (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
    setEnvs (TcGblEnv, TcLclEnv)
    tc_envs (TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
     -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv))
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall a b. (a -> b) -> a -> b
    $ do {  -- Environment doesn't change now

                    -- Second pass over class and instance declarations,
                    -- now using the kind-checked decls
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc6" SDoc
    empty ;
            LHsBinds GhcTc
    inst_binds <- [LTyClDecl (GhcPass 'Renamed)]
    -> [InstInfo (GhcPass 'Renamed)] -> TcM (LHsBinds GhcTc)
    tcInstDecls2 ([TyClGroup (GhcPass 'Renamed)] -> [LTyClDecl (GhcPass 'Renamed)]
    forall pass. [TyClGroup pass] -> [LTyClDecl pass]
    tyClGroupTyClDecls [TyClGroup (GhcPass 'Renamed)]
    tycl_decls) [InstInfo (GhcPass 'Renamed)]
    inst_infos ;

                    -- Foreign exports
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc7" SDoc
    empty ;
            (LHsBinds GhcTc
    foe_binds, [LForeignDecl GhcTc]
    foe_decls, Bag GlobalRdrElt
    foe_gres) <- [LForeignDecl (GhcPass 'Renamed)]
    -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)
    tcForeignExports [LForeignDecl (GhcPass 'Renamed)]
    foreign_decls ;

                    -- Annotations
            [Annotation]
    annotations <- [LAnnDecl (GhcPass 'Renamed)] -> TcM [Annotation]
    tcAnnotations [LAnnDecl (GhcPass 'Renamed)]
    annotation_decls ;

                    -- Rules
            [LRuleDecls GhcTc]
    rules <- [LRuleDecls (GhcPass 'Renamed)] -> TcM [LRuleDecls GhcTc]
    tcRules [LRuleDecls (GhcPass 'Renamed)]
    rule_decls ;

                    -- Wrap up
            String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "Tc7a" SDoc
    empty ;
            let { all_binds :: LHsBinds GhcTc
    all_binds = LHsBinds GhcTc
    inst_binds     LHsBinds GhcTc -> LHsBinds GhcTc -> LHsBinds GhcTc
    forall a. Bag a -> Bag a -> Bag a
    `unionBags`
                              LHsBinds GhcTc
    foe_binds

                ; fo_gres :: Bag GlobalRdrElt
    fo_gres = Bag GlobalRdrElt
    fi_gres Bag GlobalRdrElt -> Bag GlobalRdrElt -> Bag GlobalRdrElt
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag GlobalRdrElt
    foe_gres
                ; fo_fvs :: FreeVars
    fo_fvs = (GlobalRdrElt -> FreeVars -> FreeVars)
    -> FreeVars -> Bag GlobalRdrElt -> FreeVars
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\GlobalRdrElt
    gre FreeVars
    fvs -> FreeVars
    fvs FreeVars -> Name -> FreeVars
    `addOneFV` GlobalRdrElt -> Name
    gre_name GlobalRdrElt
    gre)
                                    FreeVars
    emptyFVs Bag GlobalRdrElt
    fo_gres

                ; sig_names :: FreeVars
    sig_names = [Name] -> FreeVars
    mkNameSet (HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> [IdP (GhcPass 'Renamed)]
    forall (idL :: Pass) (idR :: Pass).
    CollectPass (GhcPass idL) =>
    HsValBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
    collectHsValBinders HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    hs_val_binds)
                              FreeVars -> FreeVars -> FreeVars
    `minusNameSet` [LSig (GhcPass 'Renamed)] -> FreeVars
    getTypeSigNames [LSig (GhcPass 'Renamed)]
    val_sigs

                    -- Extend the GblEnv with the (as yet un-zonked)
                    -- bindings, rules, foreign decls
                ; tcg_env' :: TcGblEnv
    tcg_env' = TcGblEnv
    tcg_env { tcg_binds :: LHsBinds GhcTc
    tcg_binds   = TcGblEnv -> LHsBinds GhcTc
    tcg_binds TcGblEnv
    tcg_env LHsBinds GhcTc -> LHsBinds GhcTc -> LHsBinds GhcTc
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` LHsBinds GhcTc
    all_binds
                                     , tcg_sigs :: FreeVars
    tcg_sigs    = TcGblEnv -> FreeVars
    tcg_sigs TcGblEnv
    tcg_env FreeVars -> FreeVars -> FreeVars
    `unionNameSet` FreeVars
    sig_names
                                     , tcg_rules :: [LRuleDecl GhcTc]
    tcg_rules   = TcGblEnv -> [LRuleDecl GhcTc]
    tcg_rules TcGblEnv
    tcg_env
                                                          [LRuleDecl GhcTc] -> [LRuleDecl GhcTc] -> [LRuleDecl GhcTc]
    forall a. [a] -> [a] -> [a]
    ++ [LRuleDecls GhcTc] -> [LRuleDecl GhcTc]
    forall pass. [LRuleDecls pass] -> [LRuleDecl pass]
    flattenRuleDecls [LRuleDecls GhcTc]
    rules
                                     , tcg_anns :: [Annotation]
    tcg_anns    = TcGblEnv -> [Annotation]
    tcg_anns TcGblEnv
    tcg_env [Annotation] -> [Annotation] -> [Annotation]
    forall a. [a] -> [a] -> [a]
    ++ [Annotation]
    annotations
                                     , tcg_ann_env :: AnnEnv
    tcg_ann_env = AnnEnv -> [Annotation] -> AnnEnv
    extendAnnEnvList (TcGblEnv -> AnnEnv
    tcg_ann_env TcGblEnv
    tcg_env) [Annotation]
    annotations
                                     , tcg_fords :: [LForeignDecl GhcTc]
    tcg_fords   = TcGblEnv -> [LForeignDecl GhcTc]
    tcg_fords TcGblEnv
    tcg_env [LForeignDecl GhcTc]
    -> [LForeignDecl GhcTc] -> [LForeignDecl GhcTc]
    forall a. [a] -> [a] -> [a]
    ++ [LForeignDecl GhcTc]
    foe_decls [LForeignDecl GhcTc]
    -> [LForeignDecl GhcTc] -> [LForeignDecl GhcTc]
    forall a. [a] -> [a] -> [a]
    ++ [LForeignDecl GhcTc]
    fi_decls
                                     , tcg_dus :: DefUses
    tcg_dus     = TcGblEnv -> DefUses
    tcg_dus TcGblEnv
    tcg_env DefUses -> DefUses -> DefUses
    `plusDU` FreeVars -> DefUses
    usesOnly FreeVars
    fo_fvs } } ;
                                     -- tcg_dus: see Note [Newtype constructor usage in foreign declarations]

            -- See Note [Newtype constructor usage in foreign declarations]
            [GlobalRdrElt] -> TcRnIf TcGblEnv TcLclEnv ()
    addUsedGREs (Bag GlobalRdrElt -> [GlobalRdrElt]
    forall a. Bag a -> [a]
    bagToList Bag GlobalRdrElt
    fo_gres) ;

            (TcGblEnv, TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    tcg_env', TcLclEnv
    tcl_env)
        }}}}}}

    tcTopSrcDecls HsGroup (GhcPass 'Renamed)
    _ = String -> TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall a. String -> a
    panic String
    "tcTopSrcDecls: ValBindsIn"

    tcSemigroupWarnings :: TcM ()
    tcSemigroupWarnings :: TcRnIf TcGblEnv TcLclEnv ()
    tcSemigroupWarnings = do
        String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcSemigroupWarnings" SDoc
    empty
        let warnFlag :: WarningFlag
    warnFlag = WarningFlag
    Opt_WarnSemigroup
        WarningFlag -> Name -> TcRnIf TcGblEnv TcLclEnv ()
    tcPreludeClashWarn WarningFlag
    warnFlag Name
    sappendName
        WarningFlag -> Name -> Name -> TcRnIf TcGblEnv TcLclEnv ()
    tcMissingParentClassWarn WarningFlag
    warnFlag Name
    monoidClassName Name
    semigroupClassName

    -- | Warn on local definitions of names that would clash with future Prelude
    -- elements.
    --
    --   A name clashes if the following criteria are met:
    --       1. It would is imported (unqualified) from Prelude
    --       2. It is locally defined in the current module
    --       3. It has the same literal name as the reference function
    --       4. It is not identical to the reference function
    tcPreludeClashWarn :: WarningFlag
                       -> Name
                       -> TcM ()
    tcPreludeClashWarn :: WarningFlag -> Name -> TcRnIf TcGblEnv TcLclEnv ()
    tcPreludeClashWarn WarningFlag
    warnFlag Name
    name = do
        { Bool
    warn <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    warnFlag
        ; Bool -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    warn (TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $ do
        { String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcPreludeClashWarn/wouldBeImported" SDoc
    empty
        -- Is the name imported (unqualified) from Prelude? (Point 4 above)
        ; [ImportDecl (GhcPass 'Renamed)]
    rnImports <- (TcGblEnv -> [ImportDecl (GhcPass 'Renamed)])
    -> TcM TcGblEnv
    -> IOEnv (Env TcGblEnv TcLclEnv) [ImportDecl (GhcPass 'Renamed)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((LImportDecl (GhcPass 'Renamed) -> ImportDecl (GhcPass 'Renamed))
    -> [LImportDecl (GhcPass 'Renamed)]
    -> [ImportDecl (GhcPass 'Renamed)]
    forall a b. (a -> b) -> [a] -> [b]
    map LImportDecl (GhcPass 'Renamed) -> ImportDecl (GhcPass 'Renamed)
    forall l e. GenLocated l e -> e
    unLoc ([LImportDecl (GhcPass 'Renamed)]
     -> [ImportDecl (GhcPass 'Renamed)])
    -> (TcGblEnv -> [LImportDecl (GhcPass 'Renamed)])
    -> TcGblEnv
    -> [ImportDecl (GhcPass 'Renamed)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcGblEnv -> [LImportDecl (GhcPass 'Renamed)]
    tcg_rn_imports) TcM TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
        -- (Note that this automatically handles -XNoImplicitPrelude, as Prelude
        -- will not appear in rnImports automatically if it is set.)

        -- Continue only the name is imported from Prelude
        ; Bool -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Name -> [ImportDecl (GhcPass 'Renamed)] -> Bool
    importedViaPrelude Name
    name [ImportDecl (GhcPass 'Renamed)]
    rnImports) (TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $ do
          -- Handle 2.-4.
        { [GlobalRdrElt]
    rdrElts <- (TcGblEnv -> [GlobalRdrElt])
    -> TcM TcGblEnv -> IOEnv (Env TcGblEnv TcLclEnv) [GlobalRdrElt]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([[GlobalRdrElt]] -> [GlobalRdrElt]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[GlobalRdrElt]] -> [GlobalRdrElt])
    -> (TcGblEnv -> [[GlobalRdrElt]]) -> TcGblEnv -> [GlobalRdrElt]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GlobalRdrEnv -> [[GlobalRdrElt]]
    forall a. OccEnv a -> [a]
    occEnvElts (GlobalRdrEnv -> [[GlobalRdrElt]])
    -> (TcGblEnv -> GlobalRdrEnv) -> TcGblEnv -> [[GlobalRdrElt]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcGblEnv -> GlobalRdrEnv
    tcg_rdr_env) TcM TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv

        ; let clashes :: GlobalRdrElt -> Bool
              clashes :: GlobalRdrElt -> Bool
    clashes GlobalRdrElt
    x = Bool
    isLocalDef Bool -> Bool -> Bool
    && Bool
    nameClashes Bool -> Bool -> Bool
    && Bool
    isNotInProperModule
                where
                  isLocalDef :: Bool
    isLocalDef = GlobalRdrElt -> Bool
    gre_lcl GlobalRdrElt
    x Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    True
                  -- Names are identical ...
                  nameClashes :: Bool
    nameClashes = Name -> OccName
    nameOccName (GlobalRdrElt -> Name
    gre_name GlobalRdrElt
    x) OccName -> OccName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> OccName
    nameOccName Name
    name
                  -- ... but not the actual definitions, because we don't want to
                  -- warn about a bad definition of e.g. <> in Data.Semigroup, which
                  -- is the (only) proper place where this should be defined
                  isNotInProperModule :: Bool
    isNotInProperModule = GlobalRdrElt -> Name
    gre_name GlobalRdrElt
    x Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name
    name

              -- List of all offending definitions
              clashingElts :: [GlobalRdrElt]
              clashingElts :: [GlobalRdrElt]
    clashingElts = (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
    forall a. (a -> Bool) -> [a] -> [a]
    filter GlobalRdrElt -> Bool
    clashes [GlobalRdrElt]
    rdrElts

        ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcPreludeClashWarn/prelude_functions"
                    (SDoc -> Arity -> SDoc -> SDoc
    hang (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    name) Arity
    4 ([SDoc] -> SDoc
    sep [[GlobalRdrElt] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [GlobalRdrElt]
    clashingElts]))

        ; let warn_msg :: GlobalRdrElt -> TcRnIf TcGblEnv TcLclEnv ()
    warn_msg GlobalRdrElt
    x = WarnReason -> SrcSpan -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addWarnAt (WarningFlag -> WarnReason
    Reason WarningFlag
    warnFlag) (Name -> SrcSpan
    nameSrcSpan (GlobalRdrElt -> Name
    gre_name GlobalRdrElt
    x)) ([SDoc] -> SDoc
    hsep
                  [ String -> SDoc
    text String
    "Local definition of"
                  , (SDoc -> SDoc
    quotes (SDoc -> SDoc) -> (GlobalRdrElt -> SDoc) -> GlobalRdrElt -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (OccName -> SDoc)
    -> (GlobalRdrElt -> OccName) -> GlobalRdrElt -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> OccName
    nameOccName (Name -> OccName)
    -> (GlobalRdrElt -> Name) -> GlobalRdrElt -> OccName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GlobalRdrElt -> Name
    gre_name) GlobalRdrElt
    x
                  , String -> SDoc
    text String
    "clashes with a future Prelude name." ]
                  SDoc -> SDoc -> SDoc
    $$
                  String -> SDoc
    text String
    "This will become an error in a future release." )
        ; (GlobalRdrElt -> TcRnIf TcGblEnv TcLclEnv ())
    -> [GlobalRdrElt] -> TcRnIf TcGblEnv TcLclEnv ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ GlobalRdrElt -> TcRnIf TcGblEnv TcLclEnv ()
    warn_msg [GlobalRdrElt]
    clashingElts
        }}}

      where

        -- Is the given name imported via Prelude?
        --
        -- Possible scenarios:
        --   a) Prelude is imported implicitly, issue warnings.
        --   b) Prelude is imported explicitly, but without mentioning the name in
        --      question. Issue no warnings.
        --   c) Prelude is imported hiding the name in question. Issue no warnings.
        --   d) Qualified import of Prelude, no warnings.
        importedViaPrelude :: Name
                           -> [ImportDecl GhcRn]
                           -> Bool
        importedViaPrelude :: Name -> [ImportDecl (GhcPass 'Renamed)] -> Bool
    importedViaPrelude Name
    name = (ImportDecl (GhcPass 'Renamed) -> Bool)
    -> [ImportDecl (GhcPass 'Renamed)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ImportDecl (GhcPass 'Renamed) -> Bool
    importViaPrelude
          where
            isPrelude :: ImportDecl GhcRn -> Bool
            isPrelude :: ImportDecl (GhcPass 'Renamed) -> Bool
    isPrelude ImportDecl (GhcPass 'Renamed)
    imp = Located ModuleName -> ModuleName
    forall l e. GenLocated l e -> e
    unLoc (ImportDecl (GhcPass 'Renamed) -> Located ModuleName
    forall pass. ImportDecl pass -> Located ModuleName
    ideclName ImportDecl (GhcPass 'Renamed)
    imp) ModuleName -> ModuleName -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModuleName
    pRELUDE_NAME

            -- Implicit (Prelude) import?
            isImplicit :: ImportDecl GhcRn -> Bool
            isImplicit :: ImportDecl (GhcPass 'Renamed) -> Bool
    isImplicit = ImportDecl (GhcPass 'Renamed) -> Bool
    forall pass. ImportDecl pass -> Bool
    ideclImplicit

            -- Unqualified import?
            isUnqualified :: ImportDecl GhcRn -> Bool
            isUnqualified :: ImportDecl (GhcPass 'Renamed) -> Bool
    isUnqualified = Bool -> Bool
    not (Bool -> Bool)
    -> (ImportDecl (GhcPass 'Renamed) -> Bool)
    -> ImportDecl (GhcPass 'Renamed)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ImportDeclQualifiedStyle -> Bool
    isImportDeclQualified (ImportDeclQualifiedStyle -> Bool)
    -> (ImportDecl (GhcPass 'Renamed) -> ImportDeclQualifiedStyle)
    -> ImportDecl (GhcPass 'Renamed)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ImportDecl (GhcPass 'Renamed) -> ImportDeclQualifiedStyle
    forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
    ideclQualified

            -- List of explicitly imported (or hidden) Names from a single import.
            --   Nothing -> No explicit imports
            --   Just (False, <names>) -> Explicit import list of <names>
            --   Just (True , <names>) -> Explicit hiding of <names>
            importListOf :: ImportDecl GhcRn -> Maybe (Bool, [Name])
            importListOf :: ImportDecl (GhcPass 'Renamed) -> Maybe (Bool, [Name])
    importListOf = ((Bool,
      GenLocated SrcSpan [GenLocated SrcSpan (IE (GhcPass 'Renamed))])
     -> (Bool, [Name]))
    -> Maybe
         (Bool,
          GenLocated SrcSpan [GenLocated SrcSpan (IE (GhcPass 'Renamed))])
    -> Maybe (Bool, [Name])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Bool,
     GenLocated SrcSpan [GenLocated SrcSpan (IE (GhcPass 'Renamed))])
    -> (Bool, [Name])
    forall {a} {l} {l} {p :: Pass}.
    (a, GenLocated l [GenLocated l (IE (GhcPass p))])
    -> (a, [IdGhcP p])
    toImportList (Maybe
       (Bool,
        GenLocated SrcSpan [GenLocated SrcSpan (IE (GhcPass 'Renamed))])
     -> Maybe (Bool, [Name]))
    -> (ImportDecl (GhcPass 'Renamed)
        -> Maybe
             (Bool,
              GenLocated SrcSpan [GenLocated SrcSpan (IE (GhcPass 'Renamed))]))
    -> ImportDecl (GhcPass 'Renamed)
    -> Maybe (Bool, [Name])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ImportDecl (GhcPass 'Renamed)
    -> Maybe
         (Bool,
          GenLocated SrcSpan [GenLocated SrcSpan (IE (GhcPass 'Renamed))])
    forall pass. ImportDecl pass -> Maybe (Bool, Located [LIE pass])
    ideclHiding
              where
                toImportList :: (a, GenLocated l [GenLocated l (IE (GhcPass p))])
    -> (a, [IdGhcP p])
    toImportList (a
    h, GenLocated l [GenLocated l (IE (GhcPass p))]
    loc) = (a
    h, (GenLocated l (IE (GhcPass p)) -> IdGhcP p)
    -> [GenLocated l (IE (GhcPass p))] -> [IdGhcP p]
    forall a b. (a -> b) -> [a] -> [b]
    map (IE (GhcPass p) -> IdGhcP p
    forall (p :: Pass). IE (GhcPass p) -> IdP (GhcPass p)
    ieName (IE (GhcPass p) -> IdGhcP p)
    -> (GenLocated l (IE (GhcPass p)) -> IE (GhcPass p))
    -> GenLocated l (IE (GhcPass p))
    -> IdGhcP p
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . GenLocated l (IE (GhcPass p)) -> IE (GhcPass p)
    forall l e. GenLocated l e -> e
    unLoc) (GenLocated l [GenLocated l (IE (GhcPass p))]
    -> [GenLocated l (IE (GhcPass p))]
    forall l e. GenLocated l e -> e
    unLoc GenLocated l [GenLocated l (IE (GhcPass p))]
    loc))

            isExplicit :: ImportDecl GhcRn -> Bool
            isExplicit :: ImportDecl (GhcPass 'Renamed) -> Bool
    isExplicit ImportDecl (GhcPass 'Renamed)
    x = case ImportDecl (GhcPass 'Renamed) -> Maybe (Bool, [Name])
    importListOf ImportDecl (GhcPass 'Renamed)
    x of
                Maybe (Bool, [Name])
    Nothing -> Bool
    False
                Just (Bool
    False, [Name]
    explicit)
                    -> Name -> OccName
    nameOccName Name
    name OccName -> [OccName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem`    (Name -> OccName) -> [Name] -> [OccName]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> OccName
    nameOccName [Name]
    explicit
                Just (Bool
    True, [Name]
    hidden)
                    -> Name -> OccName
    nameOccName Name
    name OccName -> [OccName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` (Name -> OccName) -> [Name] -> [OccName]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> OccName
    nameOccName [Name]
    hidden

            -- Check whether the given name would be imported (unqualified) from
            -- an import declaration.
            importViaPrelude :: ImportDecl GhcRn -> Bool
            importViaPrelude :: ImportDecl (GhcPass 'Renamed) -> Bool
    importViaPrelude ImportDecl (GhcPass 'Renamed)
    x = ImportDecl (GhcPass 'Renamed) -> Bool
    isPrelude ImportDecl (GhcPass 'Renamed)
    x
                              Bool -> Bool -> Bool
    && ImportDecl (GhcPass 'Renamed) -> Bool
    isUnqualified ImportDecl (GhcPass 'Renamed)
    x
                              Bool -> Bool -> Bool
    && (ImportDecl (GhcPass 'Renamed) -> Bool
    isImplicit ImportDecl (GhcPass 'Renamed)
    x Bool -> Bool -> Bool
    || ImportDecl (GhcPass 'Renamed) -> Bool
    isExplicit ImportDecl (GhcPass 'Renamed)
    x)

    -- Notation: is* is for classes the type is an instance of, should* for those
    --           that it should also be an instance of based on the corresponding
    --           is*.
    tcMissingParentClassWarn :: WarningFlag
                             -> Name -- ^ Instances of this ...
                             -> Name -- ^ should also be instances of this
                             -> TcM ()
    tcMissingParentClassWarn :: WarningFlag -> Name -> Name -> TcRnIf TcGblEnv TcLclEnv ()
    tcMissingParentClassWarn WarningFlag
    warnFlag Name
    isName Name
    shouldName
      = do { Bool
    warn <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    warnFlag
           ; Bool -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    warn (TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $ do
           { String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcMissingParentClassWarn" SDoc
    empty
           ; Maybe Class
    isClass'     <- Name -> TcM (Maybe Class)
    tcLookupClass_maybe Name
    isName
           ; Maybe Class
    shouldClass' <- Name -> TcM (Maybe Class)
    tcLookupClass_maybe Name
    shouldName
           ; case (Maybe Class
    isClass', Maybe Class
    shouldClass') of
                  (Just Class
    isClass, Just Class
    shouldClass) -> do
                      { [ClsInst]
    localInstances <- TcM [ClsInst]
    tcGetInsts
                      ; let isInstance :: ClsInst -> Bool
    isInstance ClsInst
    m = ClsInst -> Class
    is_cls ClsInst
    m Class -> Class -> Bool
    forall a. Eq a => a -> a -> Bool
    == Class
    isClass
                            isInsts :: [ClsInst]
    isInsts = (ClsInst -> Bool) -> [ClsInst] -> [ClsInst]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ClsInst -> Bool
    isInstance [ClsInst]
    localInstances
                      ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcMissingParentClassWarn/isInsts" ([ClsInst] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ClsInst]
    isInsts)
                      ; [ClsInst]
    -> (ClsInst -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [ClsInst]
    isInsts (Class -> Class -> ClsInst -> TcRnIf TcGblEnv TcLclEnv ()
    checkShouldInst Class
    isClass Class
    shouldClass)
                      }
                  (Maybe Class
    is',Maybe Class
    should') ->
                      String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcMissingParentClassWarn/notIsShould"
                              (SDoc -> Arity -> SDoc -> SDoc
    hang (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    isName SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "/" SDoc -> SDoc -> SDoc
    <> Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    shouldName) Arity
    2 (
                                ([SDoc] -> SDoc
    hsep [ SDoc -> SDoc
    quotes (String -> SDoc
    text String
    "Is"), String -> SDoc
    text String
    "lookup for"
                                      , Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    isName
                                      , String -> SDoc
    text String
    "resulted in", Maybe Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe Class
    is' ])
                                SDoc -> SDoc -> SDoc
    $$
                                ([SDoc] -> SDoc
    hsep [ SDoc -> SDoc
    quotes (String -> SDoc
    text String
    "Should"), String -> SDoc
    text String
    "lookup for"
                                      , Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    shouldName
                                      , String -> SDoc
    text String
    "resulted in", Maybe Class -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Maybe Class
    should' ])))
           }}
      where
        -- Check whether the desired superclass exists in a given environment.
        checkShouldInst :: Class   -- ^ Class of existing instance
                        -> Class   -- ^ Class there should be an instance of
                        -> ClsInst -- ^ Existing instance
                        -> TcM ()
        checkShouldInst :: Class -> Class -> ClsInst -> TcRnIf TcGblEnv TcLclEnv ()
    checkShouldInst Class
    isClass Class
    shouldClass ClsInst
    isInst
          = do { InstEnvs
    instEnv <- TcM InstEnvs
    tcGetInstEnvs
               ; let ([InstMatch]
    instanceMatches, [ClsInst]
    shouldInsts, [InstMatch]
    _)
                        = Bool
    -> InstEnvs
    -> Class
    -> [Type]
    -> ([InstMatch], [ClsInst], [InstMatch])
    lookupInstEnv Bool
    False InstEnvs
    instEnv Class
    shouldClass (ClsInst -> [Type]
    is_tys ClsInst
    isInst)

               ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcMissingParentClassWarn/checkShouldInst"
                         (SDoc -> Arity -> SDoc -> SDoc
    hang (ClsInst -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ClsInst
    isInst) Arity
    4
                             ([SDoc] -> SDoc
    sep [[InstMatch] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [InstMatch]
    instanceMatches, [ClsInst] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ClsInst]
    shouldInsts]))

               -- "<location>: Warning: <type> is an instance of <is> but not
               -- <should>" e.g. "Foo is an instance of Monad but not Applicative"
               ; let instLoc :: SrcSpan
    instLoc = SrcLoc -> SrcSpan
    srcLocSpan (SrcLoc -> SrcSpan) -> (Name -> SrcLoc) -> Name -> SrcSpan
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> SrcLoc
    nameSrcLoc (Name -> SrcSpan) -> Name -> SrcSpan
    forall a b. (a -> b) -> a -> b
    $ ClsInst -> Name
    forall a. NamedThing a => a -> Name
    getName ClsInst
    isInst
                     warnMsg :: [Maybe Name] -> TcRnIf TcGblEnv TcLclEnv ()
    warnMsg (Just Name
    name:[Maybe Name]
    _) =
                          WarnReason -> SrcSpan -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addWarnAt (WarningFlag -> WarnReason
    Reason WarningFlag
    warnFlag) SrcSpan
    instLoc (SDoc -> TcRnIf TcGblEnv TcLclEnv ())
    -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $
                               [SDoc] -> SDoc
    hsep [ (SDoc -> SDoc
    quotes (SDoc -> SDoc) -> (Name -> SDoc) -> Name -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (OccName -> SDoc) -> (Name -> OccName) -> Name -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> OccName
    nameOccName) Name
    name
                                    , String -> SDoc
    text String
    "is an instance of"
                                    , (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (OccName -> SDoc) -> (Class -> OccName) -> Class -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> OccName
    nameOccName (Name -> OccName) -> (Class -> Name) -> Class -> OccName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Class -> Name
    className) Class
    isClass
                                    , String -> SDoc
    text String
    "but not"
                                    , (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (OccName -> SDoc) -> (Class -> OccName) -> Class -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> OccName
    nameOccName (Name -> OccName) -> (Class -> Name) -> Class -> OccName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Class -> Name
    className) Class
    shouldClass ]
                                    SDoc -> SDoc -> SDoc
    <> String -> SDoc
    text String
    "."
                               SDoc -> SDoc -> SDoc
    $$
                               [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "This will become an error in"
                                    , String -> SDoc
    text String
    "a future release." ]
                     warnMsg [Maybe Name]
    _ = () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
               ; Bool -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([ClsInst] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    shouldInsts Bool -> Bool -> Bool
    && [InstMatch] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [InstMatch]
    instanceMatches) (TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $
                      [Maybe Name] -> TcRnIf TcGblEnv TcLclEnv ()
    warnMsg (ClsInst -> [Maybe Name]
    is_tcs ClsInst
    isInst)
               }

        tcLookupClass_maybe :: Name -> TcM (Maybe Class)
        tcLookupClass_maybe :: Name -> TcM (Maybe Class)
    tcLookupClass_maybe Name
    name = Name -> TcM (MaybeErr SDoc TyThing)
    tcLookupImported_maybe Name
    name TcM (MaybeErr SDoc TyThing)
    -> (MaybeErr SDoc TyThing -> TcM (Maybe Class))
    -> TcM (Maybe Class)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Succeeded (ATyCon TyCon
    tc) | cls :: Maybe Class
    cls@(Just Class
    _) <- TyCon -> Maybe Class
    tyConClass_maybe TyCon
    tc -> Maybe Class -> TcM (Maybe Class)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Class
    cls
            MaybeErr SDoc TyThing
    _else -> Maybe Class -> TcM (Maybe Class)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Class
    forall a. Maybe a
    Nothing

    ---------------------------
    tcTyClsInstDecls :: [TyClGroup GhcRn]
                     -> [LDerivDecl GhcRn]
                     -> [(RecFlag, LHsBinds GhcRn)]
                     -> TcM (TcGblEnv,            -- The full inst env
                             [InstInfo GhcRn],    -- Source-code instance decls to
                                                  -- process; contains all dfuns for
                                                  -- this module
                              HsValBinds GhcRn)   -- Supporting bindings for derived
                                                  -- instances

    tcTyClsInstDecls :: [TyClGroup (GhcPass 'Renamed)]
    -> [LDerivDecl (GhcPass 'Renamed)]
    -> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    tcTyClsInstDecls [TyClGroup (GhcPass 'Renamed)]
    tycl_decls [LDerivDecl (GhcPass 'Renamed)]
    deriv_decls [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds
     = [LInstDecl (GhcPass 'Renamed)]
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall a. [LInstDecl (GhcPass 'Renamed)] -> TcM a -> TcM a
    tcAddDataFamConPlaceholders ([TyClGroup (GhcPass 'Renamed)]
    tycl_decls [TyClGroup (GhcPass 'Renamed)]
    -> (TyClGroup (GhcPass 'Renamed) -> [LInstDecl (GhcPass 'Renamed)])
    -> [LInstDecl (GhcPass 'Renamed)]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= TyClGroup (GhcPass 'Renamed) -> [LInstDecl (GhcPass 'Renamed)]
    forall pass. TyClGroup pass -> [LInstDecl pass]
    group_instds) (TcM
       (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
        HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
     -> TcM
          (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
           HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $
       [PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)]
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall a.
    [PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)]
    -> TcM a -> TcM a
    tcAddPatSynPlaceholders ([(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)]
    forall id. [(RecFlag, LHsBinds id)] -> [PatSynBind id id]
    getPatSynBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
    binds) (TcM
       (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
        HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
     -> TcM
          (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
           HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $
       do { (TcGblEnv
    tcg_env, [InstInfo (GhcPass 'Renamed)]
    inst_info, [DerivInfo]
    deriv_info)
              <- [TyClGroup (GhcPass 'Renamed)]
    -> TcM (TcGblEnv, [InstInfo (GhcPass 'Renamed)], [DerivInfo])
    tcTyAndClassDecls [TyClGroup (GhcPass 'Renamed)]
    tycl_decls ;
          ; TcGblEnv
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env (TcM
       (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
        HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
     -> TcM
          (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
           HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ do {
              -- With the @TyClDecl@s and @InstDecl@s checked we're ready to
              -- process the deriving clauses, including data family deriving
              -- clauses discovered in @tcTyAndClassDecls@.
              --
              -- Careful to quit now in case there were instance errors, so that
              -- the deriving errors don't pile up as well.
              ; TcRnIf TcGblEnv TcLclEnv ()
    failIfErrsM
              ; (TcGblEnv
    tcg_env', [InstInfo (GhcPass 'Renamed)]
    inst_info', HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    val_binds)
                  <- [DerivInfo]
    -> [LDerivDecl (GhcPass 'Renamed)]
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    tcInstDeclsDeriv [DerivInfo]
    deriv_info [LDerivDecl (GhcPass 'Renamed)]
    deriv_decls
              ; TcGblEnv
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    tcg_env' (TcM
       (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
        HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
     -> TcM
          (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
           HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ do {
                    TcRnIf TcGblEnv TcLclEnv ()
    failIfErrsM
                  ; (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
     HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> TcM
         (TcGblEnv, [InstInfo (GhcPass 'Renamed)],
          HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TcGblEnv
    tcg_env', [InstInfo (GhcPass 'Renamed)]
    inst_info' [InstInfo (GhcPass 'Renamed)]
    -> [InstInfo (GhcPass 'Renamed)] -> [InstInfo (GhcPass 'Renamed)]
    forall a. [a] -> [a] -> [a]
    ++ [InstInfo (GhcPass 'Renamed)]
    inst_info, HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    val_binds)
          }}}

    {- *********************************************************************
    *                                                                      *
            Checking for 'main'
    *                                                                      *
    ************************************************************************
    -}

    checkMainType :: TcGblEnv -> TcRn WantedConstraints
    -- If this is the Main module, and it defines a function main,
    --   check that its type is of form IO tau.
    -- If not, do nothing
    -- See Note [Dealing with main]
    checkMainType :: TcGblEnv -> TcRn WantedConstraints
    checkMainType TcGblEnv
    tcg_env
      = do { DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; if TcGblEnv -> Module
    tcg_mod TcGblEnv
    tcg_env Module -> Module -> Bool
    forall a. Eq a => a -> a -> Bool
    /= DynFlags -> Module
    mainModIs DynFlags
    dflags
             then WantedConstraints -> TcRn WantedConstraints
    forall (m :: * -> *) a. Monad m => a -> m a
    return WantedConstraints
    emptyWC else

        do { GlobalRdrEnv
    rdr_env <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
           ; let main_occ :: OccName
    main_occ  = DynFlags -> OccName
    getMainOcc DynFlags
    dflags
                 main_gres :: [GlobalRdrElt]
    main_gres = GlobalRdrEnv -> OccName -> [GlobalRdrElt]
    lookupGlobalRdrEnv GlobalRdrEnv
    rdr_env OccName
    main_occ
           ; case (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
    forall a. (a -> Bool) -> [a] -> [a]
    filter GlobalRdrElt -> Bool
    isLocalGRE [GlobalRdrElt]
    main_gres of {
                []         -> WantedConstraints -> TcRn WantedConstraints
    forall (m :: * -> *) a. Monad m => a -> m a
    return WantedConstraints
    emptyWC ;
                (GlobalRdrElt
    _:GlobalRdrElt
    _:[GlobalRdrElt]
    _)    -> WantedConstraints -> TcRn WantedConstraints
    forall (m :: * -> *) a. Monad m => a -> m a
    return WantedConstraints
    emptyWC ;
                [GlobalRdrElt
    main_gre] ->

        do { let main_name :: Name
    main_name = GlobalRdrElt -> Name
    gre_name GlobalRdrElt
    main_gre
                 ctxt :: UserTypeCtxt
    ctxt      = Name -> Bool -> UserTypeCtxt
    FunSigCtxt Name
    main_name Bool
    False
           ; Id
    main_id   <- Name -> TcM Id
    tcLookupId Name
    main_name
           ; (Type
    io_ty,Type
    _) <- TcM (Type, Type)
    getIOType
           ; ((TcEvBinds, HsWrapper)
    _, WantedConstraints
    lie)  <- TcM (TcEvBinds, HsWrapper)
    -> TcM ((TcEvBinds, HsWrapper), WantedConstraints)
    forall a. TcM a -> TcM (a, WantedConstraints)
    captureTopConstraints       (TcM (TcEvBinds, HsWrapper)
     -> TcM ((TcEvBinds, HsWrapper), WantedConstraints))
    -> TcM (TcEvBinds, HsWrapper)
    -> TcM ((TcEvBinds, HsWrapper), WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                          Name -> Type -> TcM HsWrapper -> TcM (TcEvBinds, HsWrapper)
    forall a. Name -> Type -> TcM a -> TcM (TcEvBinds, a)
    setMainCtxt Name
    main_name Type
    io_ty (TcM HsWrapper -> TcM (TcEvBinds, HsWrapper))
    -> TcM HsWrapper -> TcM (TcEvBinds, HsWrapper)
    forall a b. (a -> b) -> a -> b
    $
                          UserTypeCtxt -> Type -> Type -> TcM HsWrapper
    tcSubTypeSigma UserTypeCtxt
    ctxt (Id -> Type
    idType Id
    main_id) Type
    io_ty
           ; WantedConstraints -> TcRn WantedConstraints
    forall (m :: * -> *) a. Monad m => a -> m a
    return WantedConstraints
    lie } } } }

    checkMain :: Bool  -- False => no 'module M(..) where' header at all
              -> Maybe (Located [LIE GhcPs])  -- Export specs of Main module
              -> TcM TcGblEnv
    -- If we are in module Main, check that 'main' is exported,
    -- and generate the runMainIO binding that calls it
    -- See Note [Dealing with main]
    checkMain :: Bool -> Maybe (Located [LIE GhcPs]) -> TcM TcGblEnv
    checkMain Bool
    explicit_mod_hdr Maybe (Located [LIE GhcPs])
    export_ies
     = do { DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
          ; TcGblEnv
    tcg_env <- TcM TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv

          ; let main_mod :: Module
    main_mod    = DynFlags -> Module
    mainModIs DynFlags
    dflags
                main_occ :: OccName
    main_occ    = DynFlags -> OccName
    getMainOcc DynFlags
    dflags

                exported_mains :: [Name]
                -- Exported things that are called 'main'
                exported_mains :: [Name]
    exported_mains  = [ Name
    name | AvailInfo
    avail <- TcGblEnv -> [AvailInfo]
    tcg_exports TcGblEnv
    tcg_env
                                         , Name
    name  <- AvailInfo -> [Name]
    availNames AvailInfo
    avail
                                         , Name -> OccName
    nameOccName Name
    name OccName -> OccName -> Bool
    forall a. Eq a => a -> a -> Bool
    == OccName
    main_occ ]

          ; if | TcGblEnv -> Module
    tcg_mod TcGblEnv
    tcg_env Module -> Module -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Module
    main_mod
               -> -- Not the main module
                  TcGblEnv -> TcM TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tcg_env

               | [Name
    main_name] <- [Name]
    exported_mains
               -> -- The module indeed exports a function called 'main'
                  TcGblEnv -> Name -> TcM TcGblEnv
    generateMainBinding TcGblEnv
    tcg_env Name
    main_name

               | Bool
    otherwise
               -> ASSERT( null exported_mains )
                  -- A fully-checked export list can't contain more
                  -- than one function with the same OccName
                  do { DynFlags -> Module -> OccName -> TcRnIf TcGblEnv TcLclEnv ()
    complain_no_main DynFlags
    dflags Module
    main_mod OccName
    main_occ
                     ; TcGblEnv -> TcM TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tcg_env } }
      where
        complain_no_main :: DynFlags -> Module -> OccName -> TcRnIf TcGblEnv TcLclEnv ()
    complain_no_main DynFlags
    dflags Module
    main_mod OccName
    main_occ
          = Bool -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Bool
    interactive Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    explicit_mod_hdr) (TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $
            SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addErrTc (Module -> OccName -> SDoc
    noMainMsg Module
    main_mod OccName
    main_occ)          -- #12906
          where
            interactive :: Bool
    interactive = DynFlags -> GhcLink
    ghcLink DynFlags
    dflags GhcLink -> GhcLink -> Bool
    forall a. Eq a => a -> a -> Bool
    == GhcLink
    LinkInMemory
            -- Without an explicit module header...
            -- in interactive mode, don't worry about the absence of 'main'.
            -- in other modes, add error message and go on with typechecking.

        noMainMsg :: Module -> OccName -> SDoc
    noMainMsg Module
    main_mod OccName
    main_occ
          = String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> OccName -> SDoc
    ppMainFn OccName
    main_occ
            SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is not" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    defOrExp SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "module"
            SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    main_mod)

        defOrExp :: String
    defOrExp | Bool
    explicit_export_list = String
    "exported by"
                 | Bool
    otherwise            = String
    "defined in"
        explicit_export_list :: Bool
    explicit_export_list = Bool
    explicit_mod_hdr Bool -> Bool -> Bool
    && Maybe (Located [LIE GhcPs]) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (Located [LIE GhcPs])
    export_ies

    -- | Get the unqualified name of the function to use as the \"main\" for the main module.
    -- Either returns the default name or the one configured on the command line with -main-is
    getMainOcc :: DynFlags -> OccName
    getMainOcc :: DynFlags -> OccName
    getMainOcc DynFlags
    dflags = case DynFlags -> Maybe String
    mainFunIs DynFlags
    dflags of
                          Just String
    fn -> FastString -> OccName
    mkVarOccFS (String -> FastString
    mkFastString String
    fn)
                          Maybe String
    Nothing -> OccName
    mainOcc

    ppMainFn :: OccName -> SDoc
    ppMainFn :: OccName -> SDoc
    ppMainFn OccName
    main_occ
      | OccName
    main_occ OccName -> OccName -> Bool
    forall a. Eq a => a -> a -> Bool
    == OccName
    mainOcc
      = String -> SDoc
    text String
    "IO action" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    main_occ)
      | Bool
    otherwise
      = String -> SDoc
    text String
    "main IO action" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    main_occ)

    mainOcc :: OccName
    mainOcc :: OccName
    mainOcc = FastString -> OccName
    mkVarOccFS (String -> FastString
    fsLit String
    "main")

    generateMainBinding :: TcGblEnv -> Name -> TcM TcGblEnv
    -- There is a single exported 'main' function, called 'foo' (say),
    -- which may be locally defined or imported
    -- Define and typecheck the binding
    --     :Main.main :: IO res_ty = runMainIO res_ty foo
    -- This wraps the user's main function in the top-level stuff
    -- defined in runMainIO (eg catching otherwise un-caught exceptions)
    -- See Note [Dealing with main]
    generateMainBinding :: TcGblEnv -> Name -> TcM TcGblEnv
    generateMainBinding TcGblEnv
    tcg_env Name
    main_name = do
        { String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "checkMain found" (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    main_name)
        ; (Type
    io_ty, Type
    res_ty) <- TcM (Type, Type)
    getIOType
        ; let loc :: SrcSpan
    loc = Name -> SrcSpan
    forall a. NamedThing a => a -> SrcSpan
    getSrcSpan Name
    main_name
              main_expr_rn :: Located (HsExpr (GhcPass 'Renamed))
    main_expr_rn = SrcSpan
    -> HsExpr (GhcPass 'Renamed) -> Located (HsExpr (GhcPass 'Renamed))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XVar (GhcPass 'Renamed)
    -> Located (IdP (GhcPass 'Renamed)) -> HsExpr (GhcPass 'Renamed)
    forall p. XVar p -> Located (IdP p) -> HsExpr p
    HsVar NoExtField
    XVar (GhcPass 'Renamed)
    noExtField (SrcSpan -> Name -> GenLocated SrcSpan Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc Name
    main_name))
        ; (TcEvBinds
    ev_binds, LHsExpr GhcTc
    main_expr) <- Name
    -> Type -> TcM (LHsExpr GhcTc) -> TcM (TcEvBinds, LHsExpr GhcTc)
    forall a. Name -> Type -> TcM a -> TcM (TcEvBinds, a)
    setMainCtxt Name
    main_name Type
    io_ty (TcM (LHsExpr GhcTc) -> TcM (TcEvBinds, LHsExpr GhcTc))
    -> TcM (LHsExpr GhcTc) -> TcM (TcEvBinds, LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                                   Located (HsExpr (GhcPass 'Renamed)) -> Type -> TcM (LHsExpr GhcTc)
    tcCheckMonoExpr Located (HsExpr (GhcPass 'Renamed))
    main_expr_rn Type
    io_ty

                -- See Note [Root-main Id]
                -- Construct the binding
                --      :Main.main :: IO res_ty = runMainIO res_ty main
        ; Id
    run_main_id <- Name -> TcM Id
    tcLookupId Name
    runMainIOName
        ; let { root_main_name :: Name
    root_main_name =  Unique -> Module -> OccName -> SrcSpan -> Name
    mkExternalName Unique
    rootMainKey Module
    rOOT_MAIN
                                   (FastString -> OccName
    mkVarOccFS (String -> FastString
    fsLit String
    "main"))
                                   (Name -> SrcSpan
    forall a. NamedThing a => a -> SrcSpan
    getSrcSpan Name
    main_name)
              ; root_main_id :: Id
    root_main_id = Name -> Type -> Id
    Id.mkExportedVanillaId Name
    root_main_name Type
    io_ty
              ; co :: HsWrapper
    co  = [Type] -> HsWrapper
    mkWpTyApps [Type
    res_ty]
              -- The ev_binds of the `main` function may contain deferred
              -- type errors when type of `main` is not `IO a`. The `ev_binds`
              -- must be put inside `runMainIO` to ensure the deferred type
              -- error can be emitted correctly. See #13838.
              ; rhs :: LHsExpr GhcTc
    rhs = LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsApp (HsWrapper -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkLHsWrap HsWrapper
    co (IdP GhcTc -> LHsExpr GhcTc
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Id
    IdP GhcTc
    run_main_id)) (LHsExpr GhcTc -> LHsExpr GhcTc) -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                        TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkHsDictLet TcEvBinds
    ev_binds LHsExpr GhcTc
    main_expr
              ; main_bind :: GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    main_bind = IdP GhcTc
    -> LHsExpr GhcTc -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    forall (p :: Pass).
    IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p)
    mkVarBind Id
    IdP GhcTc
    root_main_id LHsExpr GhcTc
    rhs }

        ; TcGblEnv -> TcM TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    tcg_env { tcg_main :: Maybe Name
    tcg_main  = Name -> Maybe Name
    forall a. a -> Maybe a
    Just Name
    main_name
                          , tcg_binds :: LHsBinds GhcTc
    tcg_binds = TcGblEnv -> LHsBinds GhcTc
    tcg_binds TcGblEnv
    tcg_env
                                        LHsBinds GhcTc
    -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc) -> LHsBinds GhcTc
    forall a. Bag a -> a -> Bag a
    `snocBag` GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    main_bind
                          , tcg_dus :: DefUses
    tcg_dus   = TcGblEnv -> DefUses
    tcg_dus TcGblEnv
    tcg_env
                                        DefUses -> DefUses -> DefUses
    `plusDU` FreeVars -> DefUses
    usesOnly (Name -> FreeVars
    unitFV Name
    main_name) })
                        -- Record the use of 'main', so that we don't
                        -- complain about it being defined but not used
        }

    getIOType :: TcM (TcType, TcType)
    -- Return (IO alpha, alpha) for fresh alpha
    getIOType :: TcM (Type, Type)
    getIOType = do { TyCon
    ioTyCon <- Name -> TcM TyCon
    tcLookupTyCon Name
    ioTyConName
                   ; Type
    res_ty <- Type -> TcM Type
    newFlexiTyVarTy Type
    liftedTypeKind
                   ; (Type, Type) -> TcM (Type, Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TyCon -> [Type] -> Type
    mkTyConApp TyCon
    ioTyCon [Type
    res_ty], Type
    res_ty) }

    setMainCtxt :: Name -> TcType -> TcM a -> TcM (TcEvBinds, a)
    setMainCtxt :: forall a. Name -> Type -> TcM a -> TcM (TcEvBinds, a)
    setMainCtxt Name
    main_name Type
    io_ty TcM a
    thing_inside
      = SrcSpan -> TcRn (TcEvBinds, a) -> TcRn (TcEvBinds, a)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (Name -> SrcSpan
    forall a. NamedThing a => a -> SrcSpan
    getSrcSpan Name
    main_name) (TcRn (TcEvBinds, a) -> TcRn (TcEvBinds, a))
    -> TcRn (TcEvBinds, a) -> TcRn (TcEvBinds, a)
    forall a b. (a -> b) -> a -> b
    $
        SDoc -> TcRn (TcEvBinds, a) -> TcRn (TcEvBinds, a)
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt SDoc
    main_ctxt              (TcRn (TcEvBinds, a) -> TcRn (TcEvBinds, a))
    -> TcRn (TcEvBinds, a) -> TcRn (TcEvBinds, a)
    forall a b. (a -> b) -> a -> b
    $
        SkolemInfo -> [Id] -> [Id] -> TcM a -> TcRn (TcEvBinds, a)
    forall result.
    SkolemInfo -> [Id] -> [Id] -> TcM result -> TcM (TcEvBinds, result)
    checkConstraints SkolemInfo
    skol_info [] []  (TcM a -> TcRn (TcEvBinds, a)) -> TcM a -> TcRn (TcEvBinds, a)
    forall a b. (a -> b) -> a -> b
    $  -- Builds an implication if necessary
        TcM a
    thing_inside                         -- e.g. with -fdefer-type-errors
      where
        skol_info :: SkolemInfo
    skol_info = UserTypeCtxt -> Type -> [(Name, Id)] -> SkolemInfo
    SigSkol (Name -> Bool -> UserTypeCtxt
    FunSigCtxt Name
    main_name Bool
    False) Type
    io_ty []
        main_ctxt :: SDoc
    main_ctxt = String -> SDoc
    text String
    "When checking the type of the"
                    SDoc -> SDoc -> SDoc
    <+> OccName -> SDoc
    ppMainFn (Name -> OccName
    nameOccName Name
    main_name)

    {- Note [Dealing with main]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Dealing with the 'main' declaration is surprisingly tricky. Here are
    the moving parts:

    * The flag -main-is=M.foo allows you to set the main module to 'M',
      and the main function to 'foo'.  We access them through
          mainModIs  :: DynFlags -> Module   -- returns M
          getMainOcc :: DynFlags -> OccName  -- returns foo
      Of course usually M = Main, and foo = main.

    * checkMainType: when typechecking module M, we add an extra check that
        foo :: IO tau, for some type tau.
      This avoids getting ambiguous-type errors from the monomorphism restriction
      applying to things like
          main = return ()
      Note that checkMainType does not consult the export list because
      we have not yet done rnExports (and can't do it until later).

    * rnExports: checks the export list.  Very annoyingly, we can only do
      this after running any finalisers, which may add new declarations.
      That's why checkMainType and checkMain have to be separate.

    * checkMain: does two things:
      - check that the export list does indeed export something called 'foo'
      - generateMainBinding: generate the root-main binding
           :Main.main = runMainIO M.foo
      See Note [Root-main id]

    An annoying consequence of having both checkMainType and checkMain is
    that, when (but only when) -fdefer-type-errors is on, we may report an
    ill-typed 'main' twice (as warnings): once in checkMainType and once
    in checkMain. See test typecheck/should_fail/T13292.

    We have the following tests to check this processing:
    ----------------+----------------------------------------------------------------------------------+
                    |                                  Module Header:                                  |
                    +-------------+-------------+-------------+-------------+-------------+------------+
                    | module      | module Main | <No Header> | module Main |module       |module Main |
                    |  Main(main) |             |             |   (module X)|   Main ()   |  (Sub.main)|
    ----------------+==================================================================================+
    `main` function | ERROR:      | Main.main   | ERROR:      | Main.main   | ERROR:      | Sub.main   |
    in Main module  |  Ambiguous  |             |  Ambiguous  |             |  `main` not |            |
    and in imported |             |             |             |             |  exported   |            |
    module Sub.     | T19397E1    | T16453M0    | T19397E2    | T16453M3    |             | T16453M1   |
                    |             |             |             | X = Main    | Remark 2)   |            |
    ----------------+-------------+-------------+-------------+-------------+-------------+------------+
    `main`function  | Sub.main    | ERROR:      | Sub.main    | Sub.main    | ERROR:      | Sub.main   |
    only in imported|             | No `main` in|             |             |  `main` not |            |
    submodule Sub.  |             |   `Main`    |             |             |  exported   |            |
                    | T19397M0    | T16453E1    | T19397M1    | T16453M4    |             | T16453M5   |
                    |             |             |             | X = Sub     | Remark 2)   |            |
    ----------------+-------------+-------------+-------------+-------------+-------------+------------+
    `foo` function  | Sub.foo     | ERROR:      | Sub.foo     | Sub.foo     | ERROR:      | Sub.foo    |
    in submodule    |             | No `foo` in |             |             |  `foo` not  |            |
    Sub.            |             |   `Main`    |             |             |  exported   |            |
    GHC option:     |             |             |             |             |             |            |
      -main-is foo  | T19397M2    | T19397E3    | T19397M3    | T19397M4    | T19397E4    | T16453M6   |
                    | Remark 1)   |             |             | X = Sub     |             | Remark 3)  |
    ----------------+-------------+-------------+-------------+-------------+-------------+------------+

    Remarks:
    * The first line shows the exported `main` function or the error.
    * The second line shows the coresponding test case.
    * The module `Sub` contains the following functions:
         main :: IO ()
         foo :: IO ()
    * Remark 1) Here the header is `Main (foo)`.
    * Remark 2) Here we have no extra test case. It would exercise the same code path as `T19397E4`.
    * Remark 3) Here the header is `Main (Sub.foo)`.

    Note [Root-main Id]
    ~~~~~~~~~~~~~~~~~~~
    The function that the RTS invokes is always :Main.main, which we call
    root_main_id.  (Because GHC allows the user to have a module not
    called Main as the main module, we can't rely on the main function
    being called "Main.main".  That's why root_main_id has a fixed module
    ":Main".)

    This is unusual: it's a LocalId whose Name has a Module from another
    module. Tiresomely, we must filter it out again in GHC.Iface.Make, less we
    get two defns for 'main' in the interface file!

    *********************************************************
    *                                                       *
                    GHCi stuff
    *                                                       *
    *********************************************************
    -}

    runTcInteractive :: HscEnv -> TcRn a -> IO (Messages, Maybe a)
    -- Initialise the tcg_inst_env with instances from all home modules.
    -- This mimics the more selective call to hptInstances in tcRnImports
    runTcInteractive :: forall a. HscEnv -> TcRn a -> IO (Messages, Maybe a)
    runTcInteractive HscEnv
    hsc_env TcRn a
    thing_inside
      = HscEnv -> TcRn a -> IO (Messages, Maybe a)
    forall a. HscEnv -> TcRn a -> IO (Messages, Maybe a)
    initTcInteractive HscEnv
    hsc_env (TcRn a -> IO (Messages, Maybe a))
    -> TcRn a -> IO (Messages, Maybe a)
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> TcRn a -> TcRn a
    forall a. HscEnv -> TcM a -> TcM a
    withTcPlugins HscEnv
    hsc_env (TcRn a -> TcRn a) -> TcRn a -> TcRn a
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> TcRn a -> TcRn a
    forall a. HscEnv -> TcM a -> TcM a
    withHoleFitPlugins HscEnv
    hsc_env (TcRn a -> TcRn a) -> TcRn a -> TcRn a
    forall a b. (a -> b) -> a -> b
    $
        do { String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "setInteractiveContext" (SDoc -> TcRnIf TcGblEnv TcLclEnv ())
    -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $
                [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "ic_tythings:" SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    vcat ((TyThing -> SDoc) -> [TyThing] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map TyThing -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (InteractiveContext -> [TyThing]
    ic_tythings InteractiveContext
    icxt))
                     , String -> SDoc
    text String
    "ic_insts:" SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (BindingSite -> Id -> SDoc
    forall a. OutputableBndr a => BindingSite -> a -> SDoc
    pprBndr BindingSite
    LetBind (Id -> SDoc) -> (ClsInst -> Id) -> ClsInst -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ClsInst -> Id
    instanceDFunId) [ClsInst]
    ic_insts)
                     , String -> SDoc
    text String
    "ic_rn_gbl_env (LocalDef)" SDoc -> SDoc -> SDoc
    <+>
                          [SDoc] -> SDoc
    vcat (([GlobalRdrElt] -> SDoc) -> [[GlobalRdrElt]] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map [GlobalRdrElt] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ [GlobalRdrElt]
    local_gres | [GlobalRdrElt]
    gres <- GlobalRdrEnv -> [[GlobalRdrElt]]
    forall a. OccEnv a -> [a]
    occEnvElts (InteractiveContext -> GlobalRdrEnv
    ic_rn_gbl_env InteractiveContext
    icxt)
                                                     , let local_gres :: [GlobalRdrElt]
    local_gres = (GlobalRdrElt -> Bool) -> [GlobalRdrElt] -> [GlobalRdrElt]
    forall a. (a -> Bool) -> [a] -> [a]
    filter GlobalRdrElt -> Bool
    isLocalGRE [GlobalRdrElt]
    gres
                                                     , Bool -> Bool
    not ([GlobalRdrElt] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GlobalRdrElt]
    local_gres) ]) ]

           ; let getOrphans :: ModuleName
    -> Maybe FastString -> IOEnv (Env TcGblEnv TcLclEnv) [Module]
    getOrphans ModuleName
    m Maybe FastString
    mb_pkg = (ModIface_ 'ModIfaceFinal -> [Module])
    -> IOEnv (Env TcGblEnv TcLclEnv) (ModIface_ 'ModIfaceFinal)
    -> IOEnv (Env TcGblEnv TcLclEnv) [Module]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\ModIface_ 'ModIfaceFinal
    iface -> ModIface_ 'ModIfaceFinal -> Module
    forall (phase :: ModIfacePhase). ModIface_ phase -> Module
    mi_module ModIface_ 'ModIfaceFinal
    iface
                                              Module -> [Module] -> [Module]
    forall a. a -> [a] -> [a]
    : Dependencies -> [Module]
    dep_orphs (ModIface_ 'ModIfaceFinal -> Dependencies
    forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
    mi_deps ModIface_ 'ModIfaceFinal
    iface))
                                     (SDoc
    -> ModuleName
    -> IsBootInterface
    -> Maybe FastString
    -> IOEnv (Env TcGblEnv TcLclEnv) (ModIface_ 'ModIfaceFinal)
    loadSrcInterface (String -> SDoc
    text String
    "runTcInteractive") ModuleName
    m
                                                       IsBootInterface
    NotBoot Maybe FastString
    mb_pkg)

           ; ![Module]
    orphs <- ([[Module]] -> [Module])
    -> IOEnv (Env TcGblEnv TcLclEnv) [[Module]]
    -> IOEnv (Env TcGblEnv TcLclEnv) [Module]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([Module] -> [Module]
    forall a. NFData a => a -> a
    force ([Module] -> [Module])
    -> ([[Module]] -> [Module]) -> [[Module]] -> [Module]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Module]] -> [Module]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat) (IOEnv (Env TcGblEnv TcLclEnv) [[Module]]
     -> IOEnv (Env TcGblEnv TcLclEnv) [Module])
    -> ((InteractiveImport -> IOEnv (Env TcGblEnv TcLclEnv) [Module])
        -> IOEnv (Env TcGblEnv TcLclEnv) [[Module]])
    -> (InteractiveImport -> IOEnv (Env TcGblEnv TcLclEnv) [Module])
    -> IOEnv (Env TcGblEnv TcLclEnv) [Module]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [InteractiveImport]
    -> (InteractiveImport -> IOEnv (Env TcGblEnv TcLclEnv) [Module])
    -> IOEnv (Env TcGblEnv TcLclEnv) [[Module]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM (InteractiveContext -> [InteractiveImport]
    ic_imports InteractiveContext
    icxt) ((InteractiveImport -> IOEnv (Env TcGblEnv TcLclEnv) [Module])
     -> IOEnv (Env TcGblEnv TcLclEnv) [Module])
    -> (InteractiveImport -> IOEnv (Env TcGblEnv TcLclEnv) [Module])
    -> IOEnv (Env TcGblEnv TcLclEnv) [Module]
    forall a b. (a -> b) -> a -> b
    $ \InteractiveImport
    i ->
                case InteractiveImport
    i of                   -- force above: see #15111
                    IIModule ModuleName
    n -> ModuleName
    -> Maybe FastString -> IOEnv (Env TcGblEnv TcLclEnv) [Module]
    getOrphans ModuleName
    n Maybe FastString
    forall a. Maybe a
    Nothing
                    IIDecl ImportDecl GhcPs
    i ->
                      let mb_pkg :: Maybe FastString
    mb_pkg = StringLiteral -> FastString
    sl_fs (StringLiteral -> FastString)
    -> Maybe StringLiteral -> Maybe FastString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ImportDecl GhcPs -> Maybe StringLiteral
    forall pass. ImportDecl pass -> Maybe StringLiteral
    ideclPkgQual ImportDecl GhcPs
    i in
                      ModuleName
    -> Maybe FastString -> IOEnv (Env TcGblEnv TcLclEnv) [Module]
    getOrphans (Located ModuleName -> ModuleName
    forall l e. GenLocated l e -> e
    unLoc (ImportDecl GhcPs -> Located ModuleName
    forall pass. ImportDecl pass -> Located ModuleName
    ideclName ImportDecl GhcPs
    i)) Maybe FastString
    mb_pkg

           ; let imports :: ImportAvails
    imports = ImportAvails
    emptyImportAvails {
                                imp_orphs :: [Module]
    imp_orphs = [Module]
    orphs
                            }

           ; (TcGblEnv
    gbl_env, TcLclEnv
    lcl_env) <- TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
    getEnvs
           ; let gbl_env' :: TcGblEnv
    gbl_env' = TcGblEnv
    gbl_env {
                               tcg_rdr_env :: GlobalRdrEnv
    tcg_rdr_env      = InteractiveContext -> GlobalRdrEnv
    ic_rn_gbl_env InteractiveContext
    icxt
                             , tcg_type_env :: TypeEnv
    tcg_type_env     = TypeEnv
    type_env
                             , tcg_inst_env :: InstEnv
    tcg_inst_env     = InstEnv -> [ClsInst] -> InstEnv
    extendInstEnvList
                                                   (InstEnv -> [ClsInst] -> InstEnv
    extendInstEnvList (TcGblEnv -> InstEnv
    tcg_inst_env TcGblEnv
    gbl_env) [ClsInst]
    ic_insts)
                                                   [ClsInst]
    home_insts
                             , tcg_fam_inst_env :: FamInstEnv
    tcg_fam_inst_env = FamInstEnv -> [FamInst] -> FamInstEnv
    extendFamInstEnvList
                                                   (FamInstEnv -> [FamInst] -> FamInstEnv
    extendFamInstEnvList (TcGblEnv -> FamInstEnv
    tcg_fam_inst_env TcGblEnv
    gbl_env)
                                                                         [FamInst]
    ic_finsts)
                                                   [FamInst]
    home_fam_insts
                             , tcg_field_env :: RecFieldEnv
    tcg_field_env    = [(Name, [FieldLbl Name])] -> RecFieldEnv
    forall a. [(Name, a)] -> NameEnv a
    mkNameEnv [(Name, [FieldLbl Name])]
    con_fields
                                  -- setting tcg_field_env is necessary
                                  -- to make RecordWildCards work (test: ghci049)
                             , tcg_fix_env :: FixityEnv
    tcg_fix_env      = InteractiveContext -> FixityEnv
    ic_fix_env InteractiveContext
    icxt
                             , tcg_default :: Maybe [Type]
    tcg_default      = InteractiveContext -> Maybe [Type]
    ic_default InteractiveContext
    icxt
                                  -- must calculate imp_orphs of the ImportAvails
                                  -- so that instance visibility is done correctly
                             , tcg_imports :: ImportAvails
    tcg_imports      = ImportAvails
    imports
                             }

                 lcl_env' :: TcLclEnv
    lcl_env' = TcLclEnv -> [(Name, TcTyThing)] -> TcLclEnv
    tcExtendLocalTypeEnv TcLclEnv
    lcl_env [(Name, TcTyThing)]
    lcl_ids

           ; (TcGblEnv, TcLclEnv) -> TcRn a -> TcRn a
    forall gbl' lcl' a gbl lcl.
    (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
    setEnvs (TcGblEnv
    gbl_env', TcLclEnv
    lcl_env') TcRn a
    thing_inside }
      where
        ([ClsInst]
    home_insts, [FamInst]
    home_fam_insts) = HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
    hptInstances HscEnv
    hsc_env (\ModuleName
    _ -> Bool
    True)

        icxt :: InteractiveContext
    icxt                     = HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env
        ([ClsInst]
    ic_insts, [FamInst]
    ic_finsts)    = InteractiveContext -> ([ClsInst], [FamInst])
    ic_instances InteractiveContext
    icxt
        ([(Name, TcTyThing)]
    lcl_ids, [TyThing]
    top_ty_things) = (TyThing -> Either (Name, TcTyThing) TyThing)
    -> [TyThing] -> ([(Name, TcTyThing)], [TyThing])
    forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
    partitionWith TyThing -> Either (Name, TcTyThing) TyThing
    is_closed (InteractiveContext -> [TyThing]
    ic_tythings InteractiveContext
    icxt)

        is_closed :: TyThing -> Either (Name, TcTyThing) TyThing
        -- Put Ids with free type variables (always RuntimeUnks)
        -- in the *local* type environment
        -- See Note [Initialising the type environment for GHCi]
        is_closed :: TyThing -> Either (Name, TcTyThing) TyThing
    is_closed TyThing
    thing
          | AnId Id
    id <- TyThing
    thing
          , Bool -> Bool
    not (Id -> Bool
    isTypeClosedLetBndr Id
    id)
          = (Name, TcTyThing) -> Either (Name, TcTyThing) TyThing
    forall a b. a -> Either a b
    Left (Id -> Name
    idName Id
    id, ATcId :: Id -> IdBindingInfo -> TcTyThing
    ATcId { tct_id :: Id
    tct_id = Id
    id
                                   , tct_info :: IdBindingInfo
    tct_info = IdBindingInfo
    NotLetBound })
          | Bool
    otherwise
          = TyThing -> Either (Name, TcTyThing) TyThing
    forall a b. b -> Either a b
    Right TyThing
    thing

        type_env1 :: TypeEnv
    type_env1 = [TyThing] -> TypeEnv
    mkTypeEnvWithImplicits [TyThing]
    top_ty_things
        type_env :: TypeEnv
    type_env  = TypeEnv -> [Id] -> TypeEnv
    extendTypeEnvWithIds TypeEnv
    type_env1 ((ClsInst -> Id) -> [ClsInst] -> [Id]
    forall a b. (a -> b) -> [a] -> [b]
    map ClsInst -> Id
    instanceDFunId [ClsInst]
    ic_insts)
                    -- Putting the dfuns in the type_env
                    -- is just to keep Core Lint happy

        con_fields :: [(Name, [FieldLbl Name])]
    con_fields = [ (DataCon -> Name
    dataConName DataCon
    c, DataCon -> [FieldLbl Name]
    dataConFieldLabels DataCon
    c)
                     | ATyCon TyCon
    t <- [TyThing]
    top_ty_things
                     , DataCon
    c <- TyCon -> [DataCon]
    tyConDataCons TyCon
    t ]

    {- Note [Initialising the type environment for GHCi]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Most of the Ids in ic_things, defined by the user in 'let' stmts,
    have closed types. E.g.
       ghci> let foo x y = x && not y

    However the GHCi debugger creates top-level bindings for Ids whose
    types have free RuntimeUnk skolem variables, standing for unknown
    types.  If we don't register these free TyVars as global TyVars then
    the typechecker will try to quantify over them and fall over in
    skolemiseQuantifiedTyVar. so we must add any free TyVars to the
    typechecker's global TyVar set.  That is done by using
    tcExtendLocalTypeEnv.

    We do this by splitting out the Ids with open types, using 'is_closed'
    to do the partition.  The top-level things go in the global TypeEnv;
    the open, NotTopLevel, Ids, with free RuntimeUnk tyvars, go in the
    local TypeEnv.

    Note that we don't extend the local RdrEnv (tcl_rdr); all the in-scope
    things are already in the interactive context's GlobalRdrEnv.
    Extending the local RdrEnv isn't terrible, but it means there is an
    entry for the same Name in both global and local RdrEnvs, and that
    lead to duplicate "perhaps you meant..." suggestions (e.g. T5564).

    We don't bother with the tcl_th_bndrs environment either.
    -}

    -- | The returned [Id] is the list of new Ids bound by this statement. It can
    -- be used to extend the InteractiveContext via extendInteractiveContext.
    --
    -- The returned TypecheckedHsExpr is of type IO [ () ], a list of the bound
    -- values, coerced to ().
    tcRnStmt :: HscEnv -> GhciLStmt GhcPs
             -> IO (Messages, Maybe ([Id], LHsExpr GhcTc, FixityEnv))
    tcRnStmt :: HscEnv
    -> GhciLStmt GhcPs
    -> IO (Messages, Maybe ([Id], LHsExpr GhcTc, FixityEnv))
    tcRnStmt HscEnv
    hsc_env GhciLStmt GhcPs
    rdr_stmt
      = HscEnv
    -> TcRn ([Id], LHsExpr GhcTc, FixityEnv)
    -> IO (Messages, Maybe ([Id], LHsExpr GhcTc, FixityEnv))
    forall a. HscEnv -> TcRn a -> IO (Messages, Maybe a)
    runTcInteractive HscEnv
    hsc_env (TcRn ([Id], LHsExpr GhcTc, FixityEnv)
     -> IO (Messages, Maybe ([Id], LHsExpr GhcTc, FixityEnv)))
    -> TcRn ([Id], LHsExpr GhcTc, FixityEnv)
    -> IO (Messages, Maybe ([Id], LHsExpr GhcTc, FixityEnv))
    forall a b. (a -> b) -> a -> b
    $ do {

        -- The real work is done here
        (([Id]
    bound_ids, LHsExpr GhcTc
    tc_expr), FixityEnv
    fix_env) <- GhciLStmt GhcPs -> TcM (PlanResult, FixityEnv)
    tcUserStmt GhciLStmt GhcPs
    rdr_stmt ;
        LHsExpr GhcTc
    zonked_expr <- LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
    zonkTopLExpr LHsExpr GhcTc
    tc_expr ;
        [Id]
    zonked_ids  <- [Id] -> TcM [Id]
    zonkTopBndrs [Id]
    bound_ids ;

        TcRnIf TcGblEnv TcLclEnv ()
    failIfErrsM ;  -- we can't do the next step if there are levity polymorphism errors
                       -- test case: ghci/scripts/T13202{,a}

            -- None of the Ids should be of unboxed type, because we
            -- cast them all to HValues in the end!
        (Id -> TcRnIf TcGblEnv TcLclEnv ())
    -> [Id] -> TcRnIf TcGblEnv TcLclEnv ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ Id -> TcRnIf TcGblEnv TcLclEnv ()
    bad_unboxed ((Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (HasDebugCallStack => Type -> Bool
    Type -> Bool
    isUnliftedType (Type -> Bool) -> (Id -> Type) -> Id -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    idType) [Id]
    zonked_ids) ;

        String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcs 1" SDoc
    empty ;
        Module
    this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
    forall (m :: * -> *). HasModule m => m Module
    getModule ;
        [Id]
    global_ids <- (Id -> TcM Id) -> [Id] -> TcM [Id]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Module -> Id -> TcM Id
    externaliseAndTidyId Module
    this_mod) [Id]
    zonked_ids ;
            -- Note [Interactively-bound Ids in GHCi] in GHC.Driver.Types

    {- ---------------------------------------------
       At one stage I removed any shadowed bindings from the type_env;
       they are inaccessible but might, I suppose, cause a space leak if we leave them there.
       However, with Template Haskell they aren't necessarily inaccessible.  Consider this
       GHCi session
             Prelude> let f n = n * 2 :: Int
             Prelude> fName <- runQ [| f |]
             Prelude> $(return $ AppE fName (LitE (IntegerL 7)))
             14
             Prelude> let f n = n * 3 :: Int
             Prelude> $(return $ AppE fName (LitE (IntegerL 7)))
       In the last line we use 'fName', which resolves to the *first* 'f'
       in scope. If we delete it from the type env, GHCi crashes because
       it doesn't expect that.

       Hence this code is commented out

    -------------------------------------------------- -}

        DumpFlag -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceOptTcRn DumpFlag
    Opt_D_dump_tc
            ([SDoc] -> SDoc
    vcat [String -> SDoc
    text String
    "Bound Ids" SDoc -> SDoc -> SDoc
    <+> (Id -> SDoc) -> [Id] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas Id -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Id]
    global_ids,
                   String -> SDoc
    text String
    "Typechecked expr" SDoc -> SDoc -> SDoc
    <+> LHsExpr GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsExpr GhcTc
    zonked_expr]) ;

        ([Id], LHsExpr GhcTc, FixityEnv)
    -> TcRn ([Id], LHsExpr GhcTc, FixityEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id]
    global_ids, LHsExpr GhcTc
    zonked_expr, FixityEnv
    fix_env)
        }
      where
        bad_unboxed :: Id -> TcRnIf TcGblEnv TcLclEnv ()
    bad_unboxed Id
    id = SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addErr ([SDoc] -> SDoc
    sep [String -> SDoc
    text String
    "GHCi can't bind a variable of unlifted type:",
                                      Arity -> SDoc -> SDoc
    nest Arity
    2 (Id -> SDoc
    forall a. OutputableBndr a => a -> SDoc
    pprPrefixOcc Id
    id SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Id -> Type
    idType Id
    id))])

    {-
    --------------------------------------------------------------------------
                    Typechecking Stmts in GHCi

    Here is the grand plan, implemented in tcUserStmt

            What you type                   The IO [HValue] that hscStmt returns
            -------------                   ------------------------------------
            let pat = expr          ==>     let pat = expr in return [coerce HVal x, coerce HVal y, ...]
                                            bindings: [x,y,...]

            pat <- expr             ==>     expr >>= \ pat -> return [coerce HVal x, coerce HVal y, ...]
                                            bindings: [x,y,...]

            expr (of IO type)       ==>     expr >>= \ it -> return [coerce HVal it]
              [NB: result not printed]      bindings: [it]

            expr (of non-IO type,   ==>     let it = expr in print it >> return [coerce HVal it]
              result showable)              bindings: [it]

            expr (of non-IO type,
              result not showable)  ==>     error
    -}

    -- | A plan is an attempt to lift some code into the IO monad.
    type PlanResult = ([Id], LHsExpr GhcTc)
    type Plan = TcM PlanResult

    -- | Try the plans in order. If one fails (by raising an exn), try the next.
    -- If one succeeds, take it.
    runPlans :: [Plan] -> TcM PlanResult
    runPlans :: [Plan] -> Plan
    runPlans []     = String -> Plan
    forall a. String -> a
    panic String
    "runPlans"
    runPlans [Plan
    p]    = Plan
    p
    runPlans (Plan
    p:[Plan]
    ps) = Plan -> Plan -> Plan
    forall r. TcM r -> TcM r -> TcM r
    tryTcDiscardingErrs ([Plan] -> Plan
    runPlans [Plan]
    ps) Plan
    p

    -- | Typecheck (and 'lift') a stmt entered by the user in GHCi into the
    -- GHCi 'environment'.
    --
    -- By 'lift' and 'environment we mean that the code is changed to
    -- execute properly in an IO monad. See Note [Interactively-bound Ids
    -- in GHCi] in GHC.Driver.Types for more details. We do this lifting by trying
    -- different ways ('plans') of lifting the code into the IO monad and
    -- type checking each plan until one succeeds.
    tcUserStmt :: GhciLStmt GhcPs -> TcM (PlanResult, FixityEnv)

    -- An expression typed at the prompt is treated very specially
    tcUserStmt :: GhciLStmt GhcPs -> TcM (PlanResult, FixityEnv)
    tcUserStmt (L SrcSpan
    loc (BodyStmt XBodyStmt GhcPs GhcPs (LHsExpr GhcPs)
    _ LHsExpr GhcPs
    expr SyntaxExpr GhcPs
    _ SyntaxExpr GhcPs
    _))
      = do  { (Located (HsExpr (GhcPass 'Renamed))
    rn_expr, FreeVars
    fvs) <- TcM (Located (HsExpr (GhcPass 'Renamed)), FreeVars)
    -> TcM (Located (HsExpr (GhcPass 'Renamed)), FreeVars)
    forall r. TcM r -> TcM r
    checkNoErrs (LHsExpr GhcPs
    -> TcM (Located (HsExpr (GhcPass 'Renamed)), FreeVars)
    rnLExpr LHsExpr GhcPs
    expr)
                   -- Don't try to typecheck if the renamer fails!
            ; Located (HsExpr (GhcPass 'Renamed))
    ghciStep <- TcM (Located (HsExpr (GhcPass 'Renamed)))
    getGhciStepIO
            ; Unique
    uniq <- TcRnIf TcGblEnv TcLclEnv Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
            ; Name
    interPrintName <- TcRn Name
    getInteractivePrintName
            ; let fresh_it :: Name
    fresh_it  = Unique -> SrcSpan -> Name
    itName Unique
    uniq SrcSpan
    loc
                  matches :: [LMatch (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    matches   = [HsMatchContext (NoGhcTc (GhcPass 'Renamed))
    -> [LPat (GhcPass 'Renamed)]
    -> Located (HsExpr (GhcPass 'Renamed))
    -> Located (HsLocalBinds (GhcPass 'Renamed))
    -> LMatch (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall (p :: Pass).
    IsPass p =>
    HsMatchContext (NoGhcTc (GhcPass p))
    -> [LPat (GhcPass p)]
    -> LHsExpr (GhcPass p)
    -> Located (HsLocalBinds (GhcPass p))
    -> LMatch (GhcPass p) (LHsExpr (GhcPass p))
    mkMatch (Located (IdP (GhcPass 'Renamed))
    -> HsMatchContext (GhcPass 'Renamed)
    forall p. LIdP p -> HsMatchContext p
    mkPrefixFunRhs (SrcSpan -> Name -> GenLocated SrcSpan Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc Name
    fresh_it)) [] Located (HsExpr (GhcPass 'Renamed))
    rn_expr
                                       (HsLocalBinds (GhcPass 'Renamed)
    -> Located (HsLocalBinds (GhcPass 'Renamed))
    forall e. e -> Located e
    noLoc HsLocalBinds (GhcPass 'Renamed)
    forall (a :: Pass) (b :: Pass).
    HsLocalBindsLR (GhcPass a) (GhcPass b)
    emptyLocalBinds)]
                  -- [it = expr]
                  the_bind :: GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    the_bind  = SrcSpan
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
     -> GenLocated
          SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> GenLocated
         SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ (Origin
    -> GenLocated SrcSpan Name
    -> [LMatch
          (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    mkTopFunBind Origin
    FromSource
                                         (SrcSpan -> Name -> GenLocated SrcSpan Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc Name
    fresh_it) [LMatch (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    matches)
                                             { fun_ext :: XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
    fun_ext = FreeVars
    XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
    fvs }
                  -- Care here!  In GHCi the expression might have
                  -- free variables, and they in turn may have free type variables
                  -- (if we are at a breakpoint, say).  We must put those free vars

                  -- [let it = expr]
                  let_stmt :: LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    let_stmt  = SrcSpan
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (StmtLR
       (GhcPass 'Renamed)
       (GhcPass 'Renamed)
       (Located (HsExpr (GhcPass 'Renamed)))
     -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed))))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall a b. (a -> b) -> a -> b
    $ XLetStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    -> Located (HsLocalBinds (GhcPass 'Renamed))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    forall idL idR body.
    XLetStmt idL idR body
    -> LHsLocalBindsLR idL idR -> StmtLR idL idR body
    LetStmt NoExtField
    XLetStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    noExtField (Located (HsLocalBinds (GhcPass 'Renamed))
     -> StmtLR
          (GhcPass 'Renamed)
          (GhcPass 'Renamed)
          (Located (HsExpr (GhcPass 'Renamed))))
    -> Located (HsLocalBinds (GhcPass 'Renamed))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    forall a b. (a -> b) -> a -> b
    $ HsLocalBinds (GhcPass 'Renamed)
    -> Located (HsLocalBinds (GhcPass 'Renamed))
    forall e. e -> Located e
    noLoc (HsLocalBinds (GhcPass 'Renamed)
     -> Located (HsLocalBinds (GhcPass 'Renamed)))
    -> HsLocalBinds (GhcPass 'Renamed)
    -> Located (HsLocalBinds (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> HsLocalBinds (GhcPass 'Renamed)
    forall idL idR.
    XHsValBinds idL idR
    -> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
    HsValBinds NoExtField
    XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
    noExtField
                               (HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
     -> HsLocalBinds (GhcPass 'Renamed))
    -> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> HsLocalBinds (GhcPass 'Renamed)
    forall a b. (a -> b) -> a -> b
    $ XXValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
    XValBindsLR
                                   ([(RecFlag, LHsBinds (GhcPass 'Renamed))]
    -> [LSig (GhcPass 'Renamed)] -> NHsValBindsLR (GhcPass 'Renamed)
    forall idL.
    [(RecFlag, LHsBinds idL)]
    -> [LSig (GhcPass 'Renamed)] -> NHsValBindsLR idL
    NValBinds [(RecFlag
    NonRecursive,GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    -> LHsBinds (GhcPass 'Renamed)
    forall a. a -> Bag a
    unitBag GenLocated SrcSpan (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
    the_bind)] [])

                  -- [it <- e]
                  bind_stmt :: LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    bind_stmt = SrcSpan
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (StmtLR
       (GhcPass 'Renamed)
       (GhcPass 'Renamed)
       (Located (HsExpr (GhcPass 'Renamed)))
     -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed))))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall a b. (a -> b) -> a -> b
    $ XBindStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    -> LPat (GhcPass 'Renamed)
    -> Located (HsExpr (GhcPass 'Renamed))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    forall idL idR body.
    XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
    BindStmt
                                           (XBindStmtRn :: SyntaxExpr (GhcPass 'Renamed)
    -> FailOperator (GhcPass 'Renamed) -> XBindStmtRn
    XBindStmtRn
                                              { xbsrn_bindOp :: SyntaxExpr (GhcPass 'Renamed)
    xbsrn_bindOp = Name -> SyntaxExprRn
    mkRnSyntaxExpr Name
    bindIOName
                                              , xbsrn_failOp :: FailOperator (GhcPass 'Renamed)
    xbsrn_failOp = FailOperator (GhcPass 'Renamed)
    forall a. Maybe a
    Nothing
                                              })
                                           (SrcSpan
    -> Pat (GhcPass 'Renamed)
    -> GenLocated SrcSpan (Pat (GhcPass 'Renamed))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (XVarPat (GhcPass 'Renamed)
    -> Located (IdP (GhcPass 'Renamed)) -> Pat (GhcPass 'Renamed)
    forall p. XVarPat p -> Located (IdP p) -> Pat p
    VarPat NoExtField
    XVarPat (GhcPass 'Renamed)
    noExtField (SrcSpan -> Name -> GenLocated SrcSpan Name
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc Name
    fresh_it)))
                                           (Located (HsExpr (GhcPass 'Renamed))
    -> Located (HsExpr (GhcPass 'Renamed))
    -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsApp Located (HsExpr (GhcPass 'Renamed))
    ghciStep Located (HsExpr (GhcPass 'Renamed))
    rn_expr)

                  -- [; print it]
                  print_it :: LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    print_it  = SrcSpan
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (StmtLR
       (GhcPass 'Renamed)
       (GhcPass 'Renamed)
       (Located (HsExpr (GhcPass 'Renamed)))
     -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed))))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall a b. (a -> b) -> a -> b
    $ XBodyStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    -> Located (HsExpr (GhcPass 'Renamed))
    -> SyntaxExpr (GhcPass 'Renamed)
    -> SyntaxExpr (GhcPass 'Renamed)
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt NoExtField
    XBodyStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    noExtField
                                               (Located (HsExpr (GhcPass 'Renamed))
    -> Located (HsExpr (GhcPass 'Renamed))
    -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsApp (IdP (GhcPass 'Renamed) -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Name
    IdP (GhcPass 'Renamed)
    interPrintName)
                                               (IdP (GhcPass 'Renamed) -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Name
    IdP (GhcPass 'Renamed)
    fresh_it))
                                               (Name -> SyntaxExprRn
    mkRnSyntaxExpr Name
    thenIOName)
                                                      SyntaxExpr (GhcPass 'Renamed)
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr

                  -- NewA
                  no_it_a :: LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    no_it_a = SrcSpan
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (StmtLR
       (GhcPass 'Renamed)
       (GhcPass 'Renamed)
       (Located (HsExpr (GhcPass 'Renamed)))
     -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed))))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall a b. (a -> b) -> a -> b
    $ XBodyStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    -> Located (HsExpr (GhcPass 'Renamed))
    -> SyntaxExpr (GhcPass 'Renamed)
    -> SyntaxExpr (GhcPass 'Renamed)
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt NoExtField
    XBodyStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    noExtField (IdP (GhcPass 'Renamed)
    -> [Located (HsExpr (GhcPass 'Renamed))]
    -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass).
    IsPass id =>
    IdP (GhcPass id) -> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
    nlHsApps Name
    IdP (GhcPass 'Renamed)
    bindIOName
                                           [Located (HsExpr (GhcPass 'Renamed))
    rn_expr , IdP (GhcPass 'Renamed) -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Name
    IdP (GhcPass 'Renamed)
    interPrintName])
                                           (Name -> SyntaxExprRn
    mkRnSyntaxExpr Name
    thenIOName)
                                           SyntaxExpr (GhcPass 'Renamed)
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr

                  no_it_b :: LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    no_it_b = SrcSpan
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (StmtLR
       (GhcPass 'Renamed)
       (GhcPass 'Renamed)
       (Located (HsExpr (GhcPass 'Renamed)))
     -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed))))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall a b. (a -> b) -> a -> b
    $ XBodyStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    -> Located (HsExpr (GhcPass 'Renamed))
    -> SyntaxExpr (GhcPass 'Renamed)
    -> SyntaxExpr (GhcPass 'Renamed)
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt NoExtField
    XBodyStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    noExtField (Located (HsExpr (GhcPass 'Renamed))
    rn_expr)
                                           (Name -> SyntaxExprRn
    mkRnSyntaxExpr Name
    thenIOName)
                                           SyntaxExpr (GhcPass 'Renamed)
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr

                  no_it_c :: LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    no_it_c = SrcSpan
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (StmtLR
       (GhcPass 'Renamed)
       (GhcPass 'Renamed)
       (Located (HsExpr (GhcPass 'Renamed)))
     -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed))))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall a b. (a -> b) -> a -> b
    $ XBodyStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    -> Located (HsExpr (GhcPass 'Renamed))
    -> SyntaxExpr (GhcPass 'Renamed)
    -> SyntaxExpr (GhcPass 'Renamed)
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt NoExtField
    XBodyStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    noExtField
                                          (Located (HsExpr (GhcPass 'Renamed))
    -> Located (HsExpr (GhcPass 'Renamed))
    -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsApp (IdP (GhcPass 'Renamed) -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Name
    IdP (GhcPass 'Renamed)
    interPrintName) Located (HsExpr (GhcPass 'Renamed))
    rn_expr)
                                          (Name -> SyntaxExprRn
    mkRnSyntaxExpr Name
    thenIOName)
                                          SyntaxExpr (GhcPass 'Renamed)
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr

                  -- See Note [GHCi Plans]

                  it_plans :: [Plan]
    it_plans = [
                        -- Plan A
                        do { stuff :: PlanResult
    stuff@([Id
    it_id], LHsExpr GhcTc
    _) <- [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> Plan
    tcGhciStmts [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    bind_stmt, LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    print_it]
                           ; Type
    it_ty <- Type -> TcM Type
    zonkTcType (Id -> Type
    idType Id
    it_id)
                           ; Bool -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Type -> Bool
    isUnitTy (Type -> Bool) -> Type -> Bool
    forall a b. (a -> b) -> a -> b
    $ Type
    it_ty) TcRnIf TcGblEnv TcLclEnv ()
    forall env a. IOEnv env a
    failM
                           ; PlanResult -> Plan
    forall (m :: * -> *) a. Monad m => a -> m a
    return PlanResult
    stuff },

                            -- Plan B; a naked bind statement
                        [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> Plan
    tcGhciStmts [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    bind_stmt],

                            -- Plan C; check that the let-binding is typeable all by itself.
                            -- If not, fail; if so, try to print it.
                            -- The two-step process avoids getting two errors: one from
                            -- the expression itself, and one from the 'print it' part
                            -- This two-step story is very clunky, alas
                        do { PlanResult
    _ <- Plan -> Plan
    forall r. TcM r -> TcM r
    checkNoErrs ([LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> Plan
    tcGhciStmts [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    let_stmt])
                                    --- checkNoErrs defeats the error recovery of let-bindings
                           ; [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> Plan
    tcGhciStmts [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    let_stmt, LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    print_it] } ]

                  -- Plans where we don't bind "it"
                  no_it_plans :: [Plan]
    no_it_plans = [
                        [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> Plan
    tcGhciStmts [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    no_it_a] ,
                        [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> Plan
    tcGhciStmts [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    no_it_b] ,
                        [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> Plan
    tcGhciStmts [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    no_it_c] ]

            ; Bool
    generate_it <- GeneralFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    Opt_NoIt

            -- We disable `-fdefer-type-errors` in GHCi for naked expressions.
            -- See Note [Deferred type errors in GHCi]

            -- NB: The flag `-fdefer-type-errors` implies `-fdefer-type-holes`
            -- and `-fdefer-out-of-scope-variables`. However the flag
            -- `-fno-defer-type-errors` doesn't imply `-fdefer-type-holes` and
            -- `-fno-defer-out-of-scope-variables`. Thus the later two flags
            -- also need to be unset here.
            ; PlanResult
    plan <- GeneralFlag -> Plan -> Plan
    forall gbl lcl a.
    GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetGOptM GeneralFlag
    Opt_DeferTypeErrors (Plan -> Plan) -> Plan -> Plan
    forall a b. (a -> b) -> a -> b
    $
                      GeneralFlag -> Plan -> Plan
    forall gbl lcl a.
    GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetGOptM GeneralFlag
    Opt_DeferTypedHoles (Plan -> Plan) -> Plan -> Plan
    forall a b. (a -> b) -> a -> b
    $
                      GeneralFlag -> Plan -> Plan
    forall gbl lcl a.
    GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetGOptM GeneralFlag
    Opt_DeferOutOfScopeVariables (Plan -> Plan) -> Plan -> Plan
    forall a b. (a -> b) -> a -> b
    $
                        [Plan] -> Plan
    runPlans ([Plan] -> Plan) -> [Plan] -> Plan
    forall a b. (a -> b) -> a -> b
    $ if Bool
    generate_it
                                     then [Plan]
    no_it_plans
                                     else [Plan]
    it_plans

            ; FixityEnv
    fix_env <- TcRn FixityEnv
    getFixityEnv
            ; (PlanResult, FixityEnv) -> TcM (PlanResult, FixityEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PlanResult
    plan, FixityEnv
    fix_env) }

    {- Note [Deferred type errors in GHCi]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In GHCi, we ensure that type errors don't get deferred when type checking the
    naked expressions. Deferring type errors here is unhelpful because the
    expression gets evaluated right away anyway. It also would potentially emit
    two redundant type-error warnings, one from each plan.

    #14963 reveals another bug that when deferred type errors is enabled
    in GHCi, any reference of imported/loaded variables (directly or indirectly)
    in interactively issued naked expressions will cause ghc panic. See more
    detailed discussion in #14963.

    The interactively issued declarations, statements, as well as the modules
    loaded into GHCi, are not affected. That means, for declaration, you could
    have

        Prelude> :set -fdefer-type-errors
        Prelude> x :: IO (); x = putStrLn True
        <interactive>:14:26: warning: [-Wdeferred-type-errors]
            ? Couldn't match type ‘Bool’ with ‘[Char]’
              Expected type: String
                Actual type: Bool
            ? In the first argument of ‘putStrLn’, namely ‘True’
              In the expression: putStrLn True
              In an equation for ‘x’: x = putStrLn True

    But for naked expressions, you will have

        Prelude> :set -fdefer-type-errors
        Prelude> putStrLn True
        <interactive>:2:10: error:
            ? Couldn't match type ‘Bool’ with ‘[Char]’
              Expected type: String
                Actual type: Bool
            ? In the first argument of ‘putStrLn’, namely ‘True’
              In the expression: putStrLn True
              In an equation for ‘it’: it = putStrLn True

        Prelude> let x = putStrLn True
        <interactive>:2:18: warning: [-Wdeferred-type-errors]
            ? Couldn't match type ‘Bool’ with ‘[Char]’
              Expected type: String
                Actual type: Bool
            ? In the first argument of ‘putStrLn’, namely ‘True’
              In the expression: putStrLn True
              In an equation for ‘x’: x = putStrLn True
    -}

    tcUserStmt rdr_stmt :: GhciLStmt GhcPs
    rdr_stmt@(L SrcSpan
    loc StmtLR GhcPs GhcPs (LHsExpr GhcPs)
    _)
      = do { (([LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    rn_stmt], FixityEnv
    fix_env), FreeVars
    fvs) <- TcM
      (([LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))],
        FixityEnv),
       FreeVars)
    -> TcM
         (([LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))],
           FixityEnv),
          FreeVars)
    forall r. TcM r -> TcM r
    checkNoErrs (TcM
       (([LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))],
         FixityEnv),
        FreeVars)
     -> TcM
          (([LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))],
            FixityEnv),
           FreeVars))
    -> TcM
         (([LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))],
           FixityEnv),
          FreeVars)
    -> TcM
         (([LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))],
           FixityEnv),
          FreeVars)
    forall a b. (a -> b) -> a -> b
    $
               HsStmtContext (GhcPass 'Renamed)
    -> (LHsExpr GhcPs
        -> TcM (Located (HsExpr (GhcPass 'Renamed)), FreeVars))
    -> [GhciLStmt GhcPs]
    -> ([Name] -> RnM (FixityEnv, FreeVars))
    -> TcM
         (([LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))],
           FixityEnv),
          FreeVars)
    forall (body :: * -> *) thing.
    Outputable (body GhcPs) =>
    HsStmtContext (GhcPass 'Renamed)
    -> (Located (body GhcPs)
        -> RnM (Located (body (GhcPass 'Renamed)), FreeVars))
    -> [LStmt GhcPs (Located (body GhcPs))]
    -> ([Name] -> RnM (thing, FreeVars))
    -> RnM
         (([LStmt (GhcPass 'Renamed) (Located (body (GhcPass 'Renamed)))],
           thing),
          FreeVars)
    rnStmts HsStmtContext (GhcPass 'Renamed)
    forall p. HsStmtContext p
    GhciStmtCtxt LHsExpr GhcPs
    -> TcM (Located (HsExpr (GhcPass 'Renamed)), FreeVars)
    rnLExpr [GhciLStmt GhcPs
    rdr_stmt] (([Name] -> RnM (FixityEnv, FreeVars))
     -> TcM
          (([LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))],
            FixityEnv),
           FreeVars))
    -> ([Name] -> RnM (FixityEnv, FreeVars))
    -> TcM
         (([LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))],
           FixityEnv),
          FreeVars)
    forall a b. (a -> b) -> a -> b
    $ \[Name]
    _ -> do
                 FixityEnv
    fix_env <- TcRn FixityEnv
    getFixityEnv
                 (FixityEnv, FreeVars) -> RnM (FixityEnv, FreeVars)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FixityEnv
    fix_env, FreeVars
    emptyFVs)
                -- Don't try to typecheck if the renamer fails!
           ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceRn String
    "tcRnStmt" ([SDoc] -> SDoc
    vcat [GhciLStmt GhcPs -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr GhciLStmt GhcPs
    rdr_stmt, LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    rn_stmt, FreeVars -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr FreeVars
    fvs])
           ; LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    -> TcRnIf TcGblEnv TcLclEnv ()
    forall a.
    (Outputable a, Data a) =>
    a -> TcRnIf TcGblEnv TcLclEnv ()
    rnDump LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    rn_stmt ;

           ; Located (HsExpr (GhcPass 'Renamed))
    ghciStep <- TcM (Located (HsExpr (GhcPass 'Renamed)))
    getGhciStepIO
           ; let gi_stmt :: LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    gi_stmt
                   | (L SrcSpan
    loc (BindStmt XBindStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    x LPat (GhcPass 'Renamed)
    pat Located (HsExpr (GhcPass 'Renamed))
    expr)) <- LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    rn_stmt
                         = SrcSpan
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (StmtLR
       (GhcPass 'Renamed)
       (GhcPass 'Renamed)
       (Located (HsExpr (GhcPass 'Renamed)))
     -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed))))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall a b. (a -> b) -> a -> b
    $ XBindStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    -> LPat (GhcPass 'Renamed)
    -> Located (HsExpr (GhcPass 'Renamed))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    forall idL idR body.
    XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
    BindStmt XBindStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    x LPat (GhcPass 'Renamed)
    pat (Located (HsExpr (GhcPass 'Renamed))
    -> Located (HsExpr (GhcPass 'Renamed))
    -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsApp Located (HsExpr (GhcPass 'Renamed))
    ghciStep Located (HsExpr (GhcPass 'Renamed))
    expr)
                   | Bool
    otherwise = LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    rn_stmt

           ; Bool
    opt_pr_flag <- GeneralFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    Opt_PrintBindResult
           ; let print_result_plan :: [Plan]
    print_result_plan
                   | Bool
    opt_pr_flag                         -- The flag says "print result"
                   , [IdP (GhcPass 'Renamed)
    v] <- LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    -> [IdP (GhcPass 'Renamed)]
    forall (idL :: Pass) (idR :: Pass) body.
    CollectPass (GhcPass idL) =>
    LStmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
    collectLStmtBinders LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    gi_stmt  -- One binder
                               =  [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    -> Name -> Plan
    mk_print_result_plan LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    gi_stmt Name
    IdP (GhcPass 'Renamed)
    v]
                   | Bool
    otherwise = []

            -- The plans are:
            --      [stmt; print v]         if one binder and not v::()
            --      [stmt]                  otherwise
           ; PlanResult
    plan <- [Plan] -> Plan
    runPlans ([Plan]
    print_result_plan [Plan] -> [Plan] -> [Plan]
    forall a. [a] -> [a] -> [a]
    ++ [[LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> Plan
    tcGhciStmts [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    gi_stmt]])
           ; (PlanResult, FixityEnv) -> TcM (PlanResult, FixityEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PlanResult
    plan, FixityEnv
    fix_env) }
      where
        mk_print_result_plan :: LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    -> Name -> Plan
    mk_print_result_plan LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    stmt Name
    v
          = do { stuff :: PlanResult
    stuff@([Id
    v_id], LHsExpr GhcTc
    _) <- [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> Plan
    tcGhciStmts [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    stmt, LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    print_v]
               ; Type
    v_ty <- Type -> TcM Type
    zonkTcType (Id -> Type
    idType Id
    v_id)
               ; Bool -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Type -> Bool
    isUnitTy Type
    v_ty Bool -> Bool -> Bool
    || Bool -> Bool
    not (Type -> Bool
    isTauTy Type
    v_ty)) TcRnIf TcGblEnv TcLclEnv ()
    forall env a. IOEnv env a
    failM
               ; PlanResult -> Plan
    forall (m :: * -> *) a. Monad m => a -> m a
    return PlanResult
    stuff }
          where
            print_v :: LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    print_v  = SrcSpan
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (StmtLR
       (GhcPass 'Renamed)
       (GhcPass 'Renamed)
       (Located (HsExpr (GhcPass 'Renamed)))
     -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed))))
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    -> LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))
    forall a b. (a -> b) -> a -> b
    $ XBodyStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    -> Located (HsExpr (GhcPass 'Renamed))
    -> SyntaxExpr (GhcPass 'Renamed)
    -> SyntaxExpr (GhcPass 'Renamed)
    -> StmtLR
         (GhcPass 'Renamed)
         (GhcPass 'Renamed)
         (Located (HsExpr (GhcPass 'Renamed)))
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt NoExtField
    XBodyStmt
      (GhcPass 'Renamed)
      (GhcPass 'Renamed)
      (Located (HsExpr (GhcPass 'Renamed)))
    noExtField (Located (HsExpr (GhcPass 'Renamed))
    -> Located (HsExpr (GhcPass 'Renamed))
    -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsApp (IdP (GhcPass 'Renamed) -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Name
    IdP (GhcPass 'Renamed)
    printName)
                                        (IdP (GhcPass 'Renamed) -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Name
    IdP (GhcPass 'Renamed)
    v))
                                        (Name -> SyntaxExprRn
    mkRnSyntaxExpr Name
    thenIOName) SyntaxExpr (GhcPass 'Renamed)
    forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
    noSyntaxExpr

    {-
    Note [GHCi Plans]
    ~~~~~~~~~~~~~~~~~
    When a user types an expression in the repl we try to print it in three different
    ways. Also, depending on whether -fno-it is set, we bind a variable called `it`
    which can be used to refer to the result of the expression subsequently in the repl.

    The normal plans are :
      A. [it <- e; print e]     but not if it::()
      B. [it <- e]
      C. [let it = e; print it]

    When -fno-it is set, the plans are:
      A. [e >>= print]
      B. [e]
      C. [let it = e in print it]

    The reason for -fno-it is explained in #14336. `it` can lead to the repl
    leaking memory as it is repeatedly queried.
    -}

    -- | Typecheck the statements given and then return the results of the
    -- statement in the form 'IO [()]'.
    tcGhciStmts :: [GhciLStmt GhcRn] -> TcM PlanResult
    tcGhciStmts :: [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> Plan
    tcGhciStmts [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    stmts
     = do { TyCon
    ioTyCon <- Name -> TcM TyCon
    tcLookupTyCon Name
    ioTyConName
          ; Id
    ret_id  <- Name -> TcM Id
    tcLookupId Name
    returnIOName             -- return @ IO
          ; let ret_ty :: Type
    ret_ty      = Type -> Type
    mkListTy Type
    unitTy
                io_ret_ty :: Type
    io_ret_ty   = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    ioTyCon [Type
    ret_ty]
                tc_io_stmts :: (ExpType -> TcM [Id]) -> TcM ([LStmt GhcTc (LHsExpr GhcTc)], [Id])
    tc_io_stmts = HsStmtContext (GhcPass 'Renamed)
    -> TcStmtChecker HsExpr ExpType
    -> [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> ExpType
    -> (ExpType -> TcM [Id])
    -> TcM ([LStmt GhcTc (LHsExpr GhcTc)], [Id])
    forall (body :: * -> *) rho_type thing.
    Outputable (body (GhcPass 'Renamed)) =>
    HsStmtContext (GhcPass 'Renamed)
    -> TcStmtChecker body rho_type
    -> [LStmt (GhcPass 'Renamed) (Located (body (GhcPass 'Renamed)))]
    -> rho_type
    -> (rho_type -> TcM thing)
    -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
    tcStmtsAndThen HsStmtContext (GhcPass 'Renamed)
    forall p. HsStmtContext p
    GhciStmtCtxt TcStmtChecker HsExpr ExpType
    tcDoStmt [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    stmts
                                             (Type -> ExpType
    mkCheckExpType Type
    io_ret_ty)
                names :: [IdP (GhcPass 'Renamed)]
    names = [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    -> [IdP (GhcPass 'Renamed)]
    forall (idL :: Pass) (idR :: Pass) body.
    CollectPass (GhcPass idL) =>
    [LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
    collectLStmtsBinders [LStmt (GhcPass 'Renamed) (Located (HsExpr (GhcPass 'Renamed)))]
    stmts

            -- OK, we're ready to typecheck the stmts
          ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "GHC.Tc.Module.tcGhciStmts: tc stmts" SDoc
    empty
          ; (([LStmt GhcTc (LHsExpr GhcTc)]
    tc_stmts, [Id]
    ids), WantedConstraints
    lie) <- TcM ([LStmt GhcTc (LHsExpr GhcTc)], [Id])
    -> TcM (([LStmt GhcTc (LHsExpr GhcTc)], [Id]), WantedConstraints)
    forall a. TcM a -> TcM (a, WantedConstraints)
    captureTopConstraints (TcM ([LStmt GhcTc (LHsExpr GhcTc)], [Id])
     -> TcM (([LStmt GhcTc (LHsExpr GhcTc)], [Id]), WantedConstraints))
    -> TcM ([LStmt GhcTc (LHsExpr GhcTc)], [Id])
    -> TcM (([LStmt GhcTc (LHsExpr GhcTc)], [Id]), WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                                      (ExpType -> TcM [Id]) -> TcM ([LStmt GhcTc (LHsExpr GhcTc)], [Id])
    tc_io_stmts ((ExpType -> TcM [Id])
     -> TcM ([LStmt GhcTc (LHsExpr GhcTc)], [Id]))
    -> (ExpType -> TcM [Id])
    -> TcM ([LStmt GhcTc (LHsExpr GhcTc)], [Id])
    forall a b. (a -> b) -> a -> b
    $ \ ExpType
    _ ->
                                      (Name -> TcM Id) -> [Name] -> TcM [Id]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Name -> TcM Id
    tcLookupId [Name]
    [IdP (GhcPass 'Renamed)]
    names
                            -- Look up the names right in the middle,
                            -- where they will all be in scope

            -- Simplify the context
          ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "GHC.Tc.Module.tcGhciStmts: simplify ctxt" SDoc
    empty
          ; Bag EvBind
    const_binds <- TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    forall r. TcM r -> TcM r
    checkNoErrs (WantedConstraints -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    simplifyInteractive WantedConstraints
    lie)
                    -- checkNoErrs ensures that the plan fails if context redn fails

          ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "GHC.Tc.Module.tcGhciStmts: done" SDoc
    empty

          -- rec_expr is the expression
          --      returnIO @ [()] [unsafeCoerce# () x, ..,  unsafeCorece# () z]
          --
          -- Despite the inconvenience of building the type applications etc,
          -- this *has* to be done in type-annotated post-typecheck form
          -- because we are going to return a list of *polymorphic* values
          -- coerced to type (). If we built a *source* stmt
          --      return [coerce x, ..., coerce z]
          -- then the type checker would instantiate x..z, and we wouldn't
          -- get their *polymorphic* values.  (And we'd get ambiguity errs
          -- if they were overloaded, since they aren't applied to anything.)

          ; AnId Id
    unsafe_coerce_id <- Name -> TcM TyThing
    tcLookupGlobal Name
    unsafeCoercePrimName
               -- We use unsafeCoerce# here because of (U11) in
               -- Note [Implementing unsafeCoerce] in base:Unsafe.Coerce

          ; let ret_expr :: LHsExpr GhcTc
    ret_expr = LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsApp (Id -> [Type] -> LHsExpr GhcTc
    nlHsTyApp Id
    ret_id [Type
    ret_ty]) (LHsExpr GhcTc -> LHsExpr GhcTc) -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                           HsExpr GhcTc -> LHsExpr GhcTc
    forall e. e -> Located e
    noLoc (HsExpr GhcTc -> LHsExpr GhcTc) -> HsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $ XExplicitList GhcTc
    -> Maybe (SyntaxExpr GhcTc) -> [LHsExpr GhcTc] -> HsExpr GhcTc
    forall p.
    XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
    ExplicitList Type
    XExplicitList GhcTc
    unitTy Maybe (SyntaxExpr GhcTc)
    forall a. Maybe a
    Nothing ([LHsExpr GhcTc] -> HsExpr GhcTc)
    -> [LHsExpr GhcTc] -> HsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                           (Id -> LHsExpr GhcTc) -> [Id] -> [LHsExpr GhcTc]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> LHsExpr GhcTc
    mk_item [Id]
    ids

                mk_item :: Id -> LHsExpr GhcTc
    mk_item Id
    id = Id
    unsafe_coerce_id Id -> [Type] -> LHsExpr GhcTc
    `nlHsTyApp` [ HasDebugCallStack => Type -> Type
    Type -> Type
    getRuntimeRep (Id -> Type
    idType Id
    id)
                                                          , HasDebugCallStack => Type -> Type
    Type -> Type
    getRuntimeRep Type
    unitTy
                                                          , Id -> Type
    idType Id
    id, Type
    unitTy]
                                              LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall (id :: Pass).
    IsPass id =>
    LHsExpr (GhcPass id)
    -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
    `nlHsApp` IdP GhcTc -> LHsExpr GhcTc
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Id
    IdP GhcTc
    id
                stmts :: [LStmt GhcTc (LHsExpr GhcTc)]
    stmts = [LStmt GhcTc (LHsExpr GhcTc)]
    tc_stmts [LStmt GhcTc (LHsExpr GhcTc)]
    -> [LStmt GhcTc (LHsExpr GhcTc)] -> [LStmt GhcTc (LHsExpr GhcTc)]
    forall a. [a] -> [a] -> [a]
    ++ [StmtLR GhcTc GhcTc (LHsExpr GhcTc) -> LStmt GhcTc (LHsExpr GhcTc)
    forall e. e -> Located e
    noLoc (LHsExpr GhcTc -> StmtLR GhcTc GhcTc (LHsExpr GhcTc)
    forall (idR :: Pass) (bodyR :: * -> *) (idL :: Pass).
    IsPass idR =>
    Located (bodyR (GhcPass idR))
    -> StmtLR
         (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
    mkLastStmt LHsExpr GhcTc
    ret_expr)]

          ; PlanResult -> Plan
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Id]
    ids, TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc
    mkHsDictLet (Bag EvBind -> TcEvBinds
    EvBinds Bag EvBind
    const_binds) (LHsExpr GhcTc -> LHsExpr GhcTc) -> LHsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $
                         HsExpr GhcTc -> LHsExpr GhcTc
    forall e. e -> Located e
    noLoc (XDo GhcTc
    -> HsStmtContext (GhcPass 'Renamed)
    -> Located [LStmt GhcTc (LHsExpr GhcTc)]
    -> HsExpr GhcTc
    forall p.
    XDo p
    -> HsStmtContext (GhcPass 'Renamed)
    -> Located [ExprLStmt p]
    -> HsExpr p
    HsDo Type
    XDo GhcTc
    io_ret_ty HsStmtContext (GhcPass 'Renamed)
    forall p. HsStmtContext p
    GhciStmtCtxt ([LStmt GhcTc (LHsExpr GhcTc)]
    -> Located [LStmt GhcTc (LHsExpr GhcTc)]
    forall e. e -> Located e
    noLoc [LStmt GhcTc (LHsExpr GhcTc)]
    stmts)))
        }

    -- | Generate a typed ghciStepIO expression (ghciStep :: Ty a -> IO a)
    getGhciStepIO :: TcM (LHsExpr GhcRn)
    getGhciStepIO :: TcM (Located (HsExpr (GhcPass 'Renamed)))
    getGhciStepIO = do
        Name
    ghciTy <- TcRn Name
    getGHCiMonad
        Name
    a_tv <- OccName -> TcRn Name
    newName (FastString -> OccName
    mkTyVarOccFS (String -> FastString
    fsLit String
    "a"))
        let ghciM :: LHsType (GhcPass 'Renamed)
    ghciM   = LHsType (GhcPass 'Renamed)
    -> LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass).
    LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
    nlHsAppTy (IdP (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
    nlHsTyVar Name
    IdP (GhcPass 'Renamed)
    ghciTy) (IdP (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
    nlHsTyVar Name
    IdP (GhcPass 'Renamed)
    a_tv)
            ioM :: LHsType (GhcPass 'Renamed)
    ioM     = LHsType (GhcPass 'Renamed)
    -> LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass).
    LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
    nlHsAppTy (IdP (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
    nlHsTyVar Name
    IdP (GhcPass 'Renamed)
    ioTyConName) (IdP (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass). IdP (GhcPass p) -> LHsType (GhcPass p)
    nlHsTyVar Name
    IdP (GhcPass 'Renamed)
    a_tv)

            step_ty :: LHsType (GhcPass 'Renamed)
    step_ty = HsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall e. e -> Located e
    noLoc (HsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed))
    -> HsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall a b. (a -> b) -> a -> b
    $ HsForAllTy :: forall pass.
    XForAllTy pass
    -> HsForAllTelescope pass -> LHsType pass -> HsType pass
    HsForAllTy
                         { hst_tele :: HsForAllTelescope (GhcPass 'Renamed)
    hst_tele = [LHsTyVarBndr Specificity (GhcPass 'Renamed)]
    -> HsForAllTelescope (GhcPass 'Renamed)
    forall (p :: Pass).
    [LHsTyVarBndr Specificity (GhcPass p)]
    -> HsForAllTelescope (GhcPass p)
    mkHsForAllInvisTele
                                      [HsTyVarBndr Specificity (GhcPass 'Renamed)
    -> LHsTyVarBndr Specificity (GhcPass 'Renamed)
    forall e. e -> Located e
    noLoc (HsTyVarBndr Specificity (GhcPass 'Renamed)
     -> LHsTyVarBndr Specificity (GhcPass 'Renamed))
    -> HsTyVarBndr Specificity (GhcPass 'Renamed)
    -> LHsTyVarBndr Specificity (GhcPass 'Renamed)
    forall a b. (a -> b) -> a -> b
    $ XUserTyVar (GhcPass 'Renamed)
    -> Specificity
    -> Located (IdP (GhcPass 'Renamed))
    -> HsTyVarBndr Specificity (GhcPass 'Renamed)
    forall flag pass.
    XUserTyVar pass
    -> flag -> Located (IdP pass) -> HsTyVarBndr flag pass
    UserTyVar NoExtField
    XUserTyVar (GhcPass 'Renamed)
    noExtField Specificity
    SpecifiedSpec (Name -> GenLocated SrcSpan Name
    forall e. e -> Located e
    noLoc Name
    a_tv)]
                         , hst_xforall :: XForAllTy (GhcPass 'Renamed)
    hst_xforall = NoExtField
    XForAllTy (GhcPass 'Renamed)
    noExtField
                         , hst_body :: LHsType (GhcPass 'Renamed)
    hst_body  = LHsType (GhcPass 'Renamed)
    -> LHsType (GhcPass 'Renamed) -> LHsType (GhcPass 'Renamed)
    forall (p :: Pass).
    LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
    nlHsFunTy LHsType (GhcPass 'Renamed)
    ghciM LHsType (GhcPass 'Renamed)
    ioM }

            stepTy :: LHsSigWcType GhcRn
            stepTy :: LHsSigWcType (GhcPass 'Renamed)
    stepTy = HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
    -> LHsSigWcType (GhcPass 'Renamed)
    forall thing. thing -> HsWildCardBndrs (GhcPass 'Renamed) thing
    mkEmptyWildCardBndrs (LHsType (GhcPass 'Renamed)
    -> HsImplicitBndrs (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
    forall thing. thing -> HsImplicitBndrs (GhcPass 'Renamed) thing
    mkEmptyImplicitBndrs LHsType (GhcPass 'Renamed)
    step_ty)

        Located (HsExpr (GhcPass 'Renamed))
    -> TcM (Located (HsExpr (GhcPass 'Renamed)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr (GhcPass 'Renamed) -> Located (HsExpr (GhcPass 'Renamed))
    forall e. e -> Located e
    noLoc (HsExpr (GhcPass 'Renamed) -> Located (HsExpr (GhcPass 'Renamed)))
    -> HsExpr (GhcPass 'Renamed) -> Located (HsExpr (GhcPass 'Renamed))
    forall a b. (a -> b) -> a -> b
    $ XExprWithTySig (GhcPass 'Renamed)
    -> Located (HsExpr (GhcPass 'Renamed))
    -> LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
    -> HsExpr (GhcPass 'Renamed)
    forall p.
    XExprWithTySig p
    -> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
    ExprWithTySig NoExtField
    XExprWithTySig (GhcPass 'Renamed)
    noExtField (IdP (GhcPass 'Renamed) -> Located (HsExpr (GhcPass 'Renamed))
    forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
    nlHsVar Name
    IdP (GhcPass 'Renamed)
    ghciStepIoMName) LHsSigWcType (GhcPass 'Renamed)
    LHsSigWcType (NoGhcTc (GhcPass 'Renamed))
    stepTy)

    isGHCiMonad :: HscEnv -> String -> IO (Messages, Maybe Name)
    isGHCiMonad :: HscEnv -> String -> IO (Messages, Maybe Name)
    isGHCiMonad HscEnv
    hsc_env String
    ty
      = HscEnv -> TcRn Name -> IO (Messages, Maybe Name)
    forall a. HscEnv -> TcRn a -> IO (Messages, Maybe a)
    runTcInteractive HscEnv
    hsc_env (TcRn Name -> IO (Messages, Maybe Name))
    -> TcRn Name -> IO (Messages, Maybe Name)
    forall a b. (a -> b) -> a -> b
    $ do
            GlobalRdrEnv
    rdrEnv <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
            let occIO :: Maybe [GlobalRdrElt]
    occIO = GlobalRdrEnv -> OccName -> Maybe [GlobalRdrElt]
    forall a. OccEnv a -> OccName -> Maybe a
    lookupOccEnv GlobalRdrEnv
    rdrEnv (NameSpace -> String -> OccName
    mkOccName NameSpace
    tcName String
    ty)
            case Maybe [GlobalRdrElt]
    occIO of
                Just [GlobalRdrElt
    n] -> do
                    let name :: Name
    name = GlobalRdrElt -> Name
    gre_name GlobalRdrElt
    n
                    Class
    ghciClass <- Name -> TcM Class
    tcLookupClass Name
    ghciIoClassName
                    TyCon
    userTyCon <- Name -> TcM TyCon
    tcLookupTyCon Name
    name
                    let userTy :: Type
    userTy = TyCon -> [Type] -> Type
    mkTyConApp TyCon
    userTyCon []
                    ClsInst
    _ <- Class -> [Type] -> TcM ClsInst
    tcLookupInstance Class
    ghciClass [Type
    userTy]
                    Name -> TcRn Name
    forall (m :: * -> *) a. Monad m => a -> m a
    return Name
    name

                Just [GlobalRdrElt]
    _  -> SDoc -> TcRn Name
    forall a. SDoc -> TcM a
    failWithTc (SDoc -> TcRn Name) -> SDoc -> TcRn Name
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "Ambiguous type!"
                Maybe [GlobalRdrElt]
    Nothing -> SDoc -> TcRn Name
    forall a. SDoc -> TcM a
    failWithTc (SDoc -> TcRn Name) -> SDoc -> TcRn Name
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text (String
    "Can't find type:" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ty)

    -- | How should we infer a type? See Note [TcRnExprMode]
    data TcRnExprMode = TM_Inst    -- ^ Instantiate the type fully (:type)
                      | TM_NoInst  -- ^ Do not instantiate the type (:type +v)
                      | TM_Default -- ^ Default the type eagerly (:type +d)

    -- | tcRnExpr just finds the type of an expression
    --   for :type
    tcRnExpr :: HscEnv
             -> TcRnExprMode
             -> LHsExpr GhcPs
             -> IO (Messages, Maybe Type)
    tcRnExpr :: HscEnv
    -> TcRnExprMode -> LHsExpr GhcPs -> IO (Messages, DFunInstType)
    tcRnExpr HscEnv
    hsc_env TcRnExprMode
    mode LHsExpr GhcPs
    rdr_expr
      = HscEnv -> TcM Type -> IO (Messages, DFunInstType)
    forall a. HscEnv -> TcRn a -> IO (Messages, Maybe a)
    runTcInteractive HscEnv
    hsc_env (TcM Type -> IO (Messages, DFunInstType))
    -> TcM Type -> IO (Messages, DFunInstType)
    forall a b. (a -> b) -> a -> b
    $
        do {

        (Located (HsExpr (GhcPass 'Renamed))
    rn_expr, FreeVars
    _fvs) <- LHsExpr GhcPs
    -> TcM (Located (HsExpr (GhcPass 'Renamed)), FreeVars)
    rnLExpr LHsExpr GhcPs
    rdr_expr ;
        TcRnIf TcGblEnv TcLclEnv ()
    failIfErrsM ;

            -- Now typecheck the expression, and generalise its type
            -- it might have a rank-2 type (e.g. :t runST)
        Unique
    uniq <- TcRnIf TcGblEnv TcLclEnv Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique ;
        let { fresh_it :: Name
    fresh_it  = Unique -> SrcSpan -> Name
    itName Unique
    uniq (LHsExpr GhcPs -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc LHsExpr GhcPs
    rdr_expr) } ;
        ((TcLevel
    tclvl, (LHsExpr GhcTc
    _tc_expr, Type
    res_ty)), WantedConstraints
    lie)
              <- TcM (TcLevel, (LHsExpr GhcTc, Type))
    -> TcM ((TcLevel, (LHsExpr GhcTc, Type)), WantedConstraints)
    forall a. TcM a -> TcM (a, WantedConstraints)
    captureTopConstraints (TcM (TcLevel, (LHsExpr GhcTc, Type))
     -> TcM ((TcLevel, (LHsExpr GhcTc, Type)), WantedConstraints))
    -> TcM (TcLevel, (LHsExpr GhcTc, Type))
    -> TcM ((TcLevel, (LHsExpr GhcTc, Type)), WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                 TcM (LHsExpr GhcTc, Type) -> TcM (TcLevel, (LHsExpr GhcTc, Type))
    forall a. TcM a -> TcM (TcLevel, a)
    pushTcLevelM          (TcM (LHsExpr GhcTc, Type) -> TcM (TcLevel, (LHsExpr GhcTc, Type)))
    -> TcM (LHsExpr GhcTc, Type)
    -> TcM (TcLevel, (LHsExpr GhcTc, Type))
    forall a b. (a -> b) -> a -> b
    $
                 Located (HsExpr (GhcPass 'Renamed)) -> TcM (LHsExpr GhcTc, Type)
    tc_infer Located (HsExpr (GhcPass 'Renamed))
    rn_expr ;

        -- Generalise
        ([Id]
    qtvs, [Id]
    dicts, TcEvBinds
    _, WantedConstraints
    residual, Bool
    _)
             <- TcLevel
    -> InferMode
    -> [TcIdSigInst]
    -> [(Name, Type)]
    -> WantedConstraints
    -> TcM ([Id], [Id], TcEvBinds, WantedConstraints, Bool)
    simplifyInfer TcLevel
    tclvl InferMode
    infer_mode
                              []    {- No sig vars -}
                              [(Name
    fresh_it, Type
    res_ty)]
                              WantedConstraints
    lie ;

        -- Ignore the dictionary bindings
        Bag EvBind
    _ <- TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    perhaps_disable_default_warnings (TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
     -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind))
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    forall a b. (a -> b) -> a -> b
    $
             WantedConstraints -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    simplifyInteractive WantedConstraints
    residual ;

        let { all_expr_ty :: Type
    all_expr_ty = [Id] -> Type -> Type
    mkInfForAllTys [Id]
    qtvs (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $
                            [Type] -> Type -> Type
    mkPhiTy ((Id -> Type) -> [Id] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> Type
    idType [Id]
    dicts) Type
    res_ty } ;
        Type
    ty <- Type -> TcM Type
    zonkTcType Type
    all_expr_ty ;

        -- We normalise type families, so that the type of an expression is the
        -- same as of a bound expression (GHC.Tc.Gen.Bind.mkInferredPolyId). See Trac
        -- #10321 for further discussion.
        FamInstEnvs
    fam_envs <- TcM FamInstEnvs
    tcGetFamInstEnvs ;
        -- normaliseType returns a coercion which we discard, so the Role is
        -- irrelevant
        Type -> TcM Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Coercion, Type) -> Type
    forall a b. (a, b) -> b
    snd (FamInstEnvs -> Role -> Type -> (Coercion, Type)
    normaliseType FamInstEnvs
    fam_envs Role
    Nominal Type
    ty))
        }
      where
        tc_infer :: Located (HsExpr (GhcPass 'Renamed)) -> TcM (LHsExpr GhcTc, Type)
    tc_infer Located (HsExpr (GhcPass 'Renamed))
    expr | Bool
    inst      = Located (HsExpr (GhcPass 'Renamed)) -> TcM (LHsExpr GhcTc, Type)
    tcInferRho Located (HsExpr (GhcPass 'Renamed))
    expr
                      | Bool
    otherwise = Located (HsExpr (GhcPass 'Renamed)) -> TcM (LHsExpr GhcTc, Type)
    tcInferSigma Located (HsExpr (GhcPass 'Renamed))
    expr
                      -- tcInferSigma: see Note [Implementing :type]

        -- See Note [TcRnExprMode]
        (Bool
    inst, InferMode
    infer_mode, TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    perhaps_disable_default_warnings) = case TcRnExprMode
    mode of
          TcRnExprMode
    TM_Inst    -> (Bool
    True,  InferMode
    NoRestrictions, TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    forall a. a -> a
    id)
          TcRnExprMode
    TM_NoInst  -> (Bool
    False, InferMode
    NoRestrictions, TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    forall a. a -> a
    id)
          TcRnExprMode
    TM_Default -> (Bool
    True,  InferMode
    EagerDefaulting, WarningFlag
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    -> TcRnIf TcGblEnv TcLclEnv (Bag EvBind)
    forall gbl lcl a.
    WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetWOptM WarningFlag
    Opt_WarnTypeDefaults)

    {- Note [Implementing :type]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider   :type const

    We want    forall a b. a -> b -> a
    and not    forall {a}{b}. a -> b -> a

    The latter is what we'd get if we eagerly instantiated and then
    re-generalised with Inferred binders.  It makes a difference, because
    it tells us we where we can use Visible Type Application (VTA).

    And also for   :type const @Int
    we want        forall b. Int -> b -> Int
    and not        forall {b}. Int -> b -> Int

    Solution: use tcInferSigma, which in turn uses tcInferApp, which
    has a special case for application chains.
    -}

    --------------------------
    tcRnImportDecls :: HscEnv
                    -> [LImportDecl GhcPs]
                    -> IO (Messages, Maybe GlobalRdrEnv)
    -- Find the new chunk of GlobalRdrEnv created by this list of import
    -- decls.  In contract tcRnImports *extends* the TcGblEnv.
    tcRnImportDecls :: HscEnv -> [LImportDecl GhcPs] -> IO (Messages, Maybe GlobalRdrEnv)
    tcRnImportDecls HscEnv
    hsc_env [LImportDecl GhcPs]
    import_decls
     =  HscEnv -> TcRn GlobalRdrEnv -> IO (Messages, Maybe GlobalRdrEnv)
    forall a. HscEnv -> TcRn a -> IO (Messages, Maybe a)
    runTcInteractive HscEnv
    hsc_env (TcRn GlobalRdrEnv -> IO (Messages, Maybe GlobalRdrEnv))
    -> TcRn GlobalRdrEnv -> IO (Messages, Maybe GlobalRdrEnv)
    forall a b. (a -> b) -> a -> b
    $
        do { TcGblEnv
    gbl_env <- (TcGblEnv -> TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall gbl lcl a.
    (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updGblEnv TcGblEnv -> TcGblEnv
    zap_rdr_env (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
    forall a b. (a -> b) -> a -> b
    $
                        HscEnv -> [LImportDecl GhcPs] -> TcM TcGblEnv
    tcRnImports HscEnv
    hsc_env [LImportDecl GhcPs]
    import_decls
           ; GlobalRdrEnv -> TcRn GlobalRdrEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv -> GlobalRdrEnv
    tcg_rdr_env TcGblEnv
    gbl_env) }
      where
        zap_rdr_env :: TcGblEnv -> TcGblEnv
    zap_rdr_env TcGblEnv
    gbl_env = TcGblEnv
    gbl_env { tcg_rdr_env :: GlobalRdrEnv
    tcg_rdr_env = GlobalRdrEnv
    emptyGlobalRdrEnv }

    -- tcRnType just finds the kind of a type
    tcRnType :: HscEnv
             -> ZonkFlexi
             -> Bool        -- Normalise the returned type
             -> LHsType GhcPs
             -> IO (Messages, Maybe (Type, Kind))
    tcRnType :: HscEnv
    -> ZonkFlexi
    -> Bool
    -> LHsType GhcPs
    -> IO (Messages, Maybe (Type, Type))
    tcRnType HscEnv
    hsc_env ZonkFlexi
    flexi Bool
    normalise LHsType GhcPs
    rdr_type
      = HscEnv -> TcM (Type, Type) -> IO (Messages, Maybe (Type, Type))
    forall a. HscEnv -> TcRn a -> IO (Messages, Maybe a)
    runTcInteractive HscEnv
    hsc_env (TcM (Type, Type) -> IO (Messages, Maybe (Type, Type)))
    -> TcM (Type, Type) -> IO (Messages, Maybe (Type, Type))
    forall a b. (a -> b) -> a -> b
    $
        Extension -> TcM (Type, Type) -> TcM (Type, Type)
    forall gbl lcl a. Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setXOptM Extension
    LangExt.PolyKinds (TcM (Type, Type) -> TcM (Type, Type))
    -> TcM (Type, Type) -> TcM (Type, Type)
    forall a b. (a -> b) -> a -> b
    $   -- See Note [Kind-generalise in tcRnType]
        do { (HsWC { hswc_ext :: forall pass thing. HsWildCardBndrs pass thing -> XHsWC pass thing
    hswc_ext = XHsWC (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
    wcs, hswc_body :: forall pass thing. HsWildCardBndrs pass thing -> thing
    hswc_body = LHsType (GhcPass 'Renamed)
    rn_type }, FreeVars
    _fvs)
                   <- HsDocContext
    -> LHsWcType GhcPs -> RnM (LHsWcType (GhcPass 'Renamed), FreeVars)
    rnHsWcType HsDocContext
    GHCiCtx (LHsType GhcPs -> LHsWcType GhcPs
    forall thing. thing -> HsWildCardBndrs GhcPs thing
    mkHsWildCardBndrs LHsType GhcPs
    rdr_type)
                      -- The type can have wild cards, but no implicit
                      -- generalisation; e.g.   :kind (T _)
           ; TcRnIf TcGblEnv TcLclEnv ()
    failIfErrsM

            -- We follow Note [Recipe for checking a signature] in GHC.Tc.Gen.HsType here

            -- Now kind-check the type
            -- It can have any rank or kind
            -- First bring into scope any wildcards
           ; String -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    traceTc String
    "tcRnType" ([SDoc] -> SDoc
    vcat [[Name] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Name]
    XHsWC (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
    wcs, LHsType (GhcPass 'Renamed) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LHsType (GhcPass 'Renamed)
    rn_type])
           ; (Type
    ty, Type
    kind) <- TcM (Type, Type) -> TcM (Type, Type)
    forall r. TcM r -> TcM r
    pushTcLevelM_         (TcM (Type, Type) -> TcM (Type, Type))
    -> TcM (Type, Type) -> TcM (Type, Type)
    forall a b. (a -> b) -> a -> b
    $
                            -- must push level to satisfy level precondition of
                            -- kindGeneralize, below
                           TcM (Type, Type) -> TcM (Type, Type)
    forall r. TcM r -> TcM r
    solveEqualities       (TcM (Type, Type) -> TcM (Type, Type))
    -> TcM (Type, Type) -> TcM (Type, Type)
    forall a b. (a -> b) -> a -> b
    $
                           [Name] -> ([(Name, Id)] -> TcM (Type, Type)) -> TcM (Type, Type)
    forall a. [Name] -> ([(Name, Id)] -> TcM a) -> TcM a
    tcNamedWildCardBinders [Name]
    XHsWC (GhcPass 'Renamed) (LHsType (GhcPass 'Renamed))
    wcs (([(Name, Id)] -> TcM (Type, Type)) -> TcM (Type, Type))
    -> ([(Name, Id)] -> TcM (Type, Type)) -> TcM (Type, Type)
    forall a b. (a -> b) -> a -> b
    $ \ [(Name, Id)]
    wcs' ->
                           do { ((Name, Id) -> TcRnIf TcGblEnv TcLclEnv ())
    -> [(Name, Id)] -> TcRnIf TcGblEnv TcLclEnv ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Name, Id) -> TcRnIf TcGblEnv TcLclEnv ()
    emitNamedTypeHole [(Name, Id)]
    wcs'
                              ; LHsType (GhcPass 'Renamed) -> TcM (Type, Type)
    tcInferLHsTypeUnsaturated LHsType (GhcPass 'Renamed)
    rn_type }

           -- Do kind generalisation; see Note [Kind-generalise in tcRnType]
           ; [Id]
    kvs <- Type -> TcM [Id]
    kindGeneralizeAll Type
    kind
           ; ZonkEnv
    e <- ZonkFlexi -> TcM ZonkEnv
    mkEmptyZonkEnv ZonkFlexi
    flexi

           ; Type
    ty  <- ZonkEnv -> Type -> TcM Type
    zonkTcTypeToTypeX ZonkEnv
    e Type
    ty

           -- Do validity checking on type
           ; UserTypeCtxt -> Type -> TcRnIf TcGblEnv TcLclEnv ()
    checkValidType (Bool -> UserTypeCtxt
    GhciCtxt Bool
    True) Type
    ty

           ; Type
    ty' <- if Bool
    normalise
                    then do { FamInstEnvs
    fam_envs <- TcM FamInstEnvs
    tcGetFamInstEnvs
                            ; let (Coercion
    _, Type
    ty')
                                    = FamInstEnvs -> Role -> Type -> (Coercion, Type)
    normaliseType FamInstEnvs
    fam_envs Role
    Nominal Type
    ty
                            ; Type -> TcM Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    ty' }
                    else Type -> TcM Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    ty ;

           ; (Type, Type) -> TcM (Type, Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type
    ty', [Id] -> Type -> Type
    mkInfForAllTys [Id]
    kvs (HasDebugCallStack => Type -> Type
    Type -> Type
    tcTypeKind Type
    ty')) }

    {- Note [TcRnExprMode]
    ~~~~~~~~~~~~~~~~~~~~~~
    How should we infer a type when a user asks for the type of an expression e
    at the GHCi prompt? We offer 3 different possibilities, described below. Each
    considers this example, with -fprint-explicit-foralls enabled:

      foo :: forall a f b. (Show a, Num b, Foldable f) => a -> f b -> String
      :type{,-spec,-def} foo @Int

    :type / TM_Inst

      In this mode, we report the type that would be inferred if a variable
      were assigned to expression e, without applying the monomorphism restriction.
      This means we instantiate the type and then regeneralize, as discussed
      in #11376.

      > :type foo @Int
      forall {b} {f :: * -> *}. (Foldable f, Num b) => Int -> f b -> String

      Note that the variables and constraints are reordered here, because this
      is possible during regeneralization. Also note that the variables are
      reported as Inferred instead of Specified.

    :type +v / TM_NoInst

      This mode is for the benefit of users using TypeApplications. It does no
      instantiation whatsoever, sometimes meaning that class constraints are not
      solved.

      > :type +v foo @Int
      forall f b. (Show Int, Num b, Foldable f) => Int -> f b -> String

      Note that Show Int is still reported, because the solver never got a chance
      to see it.

    :type +d / TM_Default

      This mode is for the benefit of users who wish to see instantiations of
      generalized types, and in particular to instantiate Foldable and Traversable.
      In this mode, any type variable that can be defaulted is defaulted. Because
      GHCi uses -XExtendedDefaultRules, this means that Foldable and Traversable are
      defaulted.

      > :type +d foo @Int
      Int -> [Integer] -> String

      Note that this mode can sometimes lead to a type error, if a type variable is
      used with a defaultable class but cannot actually be defaulted:

      bar :: (Num a, Monoid a) => a -> a
      > :type +d bar
      ** error **

      The error arises because GHC tries to default a but cannot find a concrete
      type in the defaulting list that is both Num and Monoid. (If this list is
      modified to include an element that is both Num and Monoid, the defaulting
      would succeed, of course.)

    Note [Kind-generalise in tcRnType]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We switch on PolyKinds when kind-checking a user type, so that we will
    kind-generalise the type, even when PolyKinds is not otherwise on.
    This gives the right default behaviour at the GHCi prompt, where if
    you say ":k T", and T has a polymorphic kind, you'd like to see that
    polymorphism. Of course.  If T isn't kind-polymorphic you won't get
    anything unexpected, but the apparent *loss* of polymorphism, for
    types that you know are polymorphic, is quite surprising.  See Trac
    #7688 for a discussion.

    Note that the goal is to generalise the *kind of the type*, not
    the type itself! Example:
      ghci> data SameKind :: k -> k -> Type
      ghci> :k SameKind _

    We want to get `k -> Type`, not `Any -> Type`, which is what we would
    get without kind-generalisation. Note that `:k SameKind` is OK, as
    GHC will not instantiate SameKind here, and so we see its full kind
    of `forall k. k -> k -> Type`.

    ************************************************************************
    *                                                                      *
                     tcRnDeclsi
    *                                                                      *
    ************************************************************************

    tcRnDeclsi exists to allow class, data, and other declarations in GHCi.
    -}

    tcRnDeclsi :: HscEnv
               -> [LHsDecl GhcPs]
               -> IO (Messages, Maybe TcGblEnv)
    tcRnDeclsi :: HscEnv -> [LHsDecl GhcPs] -> IO (Messages, Maybe TcGblEnv)
    tcRnDeclsi HscEnv
    hsc_env [LHsDecl GhcPs]
    local_decls
      = HscEnv -> TcM TcGblEnv -> IO (Messages, Maybe TcGblEnv)
    forall a. HscEnv -> TcRn a -> IO (Messages, Maybe a)
    runTcInteractive HscEnv
    hsc_env (TcM TcGblEnv -> IO (Messages, Maybe TcGblEnv))
    -> TcM TcGblEnv -> IO (Messages, Maybe TcGblEnv)
    forall a b. (a -> b) -> a -> b
    $
        Bool
    -> Maybe (Located [LIE GhcPs]) -> [LHsDecl GhcPs] -> TcM TcGblEnv
    tcRnSrcDecls Bool
    False Maybe (Located [LIE GhcPs])
    forall a. Maybe a
    Nothing [LHsDecl GhcPs]
    local_decls

    externaliseAndTidyId :: Module -> Id -> TcM Id
    externaliseAndTidyId :: Module -> Id -> TcM Id
    externaliseAndTidyId Module
    this_mod Id
    id
      = do { Name
    name' <- Module -> Name -> TcRn Name
    forall m n. Module -> Name -> TcRnIf m n Name
    externaliseName Module
    this_mod (Id -> Name
    idName Id
    id)
           ; Id -> TcM Id
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> TcM Id) -> Id -> TcM Id
    forall a b. (a -> b) -> a -> b
    $ Id -> Id
    globaliseId Id
    id
                         Id -> Name -> Id
    `setIdName` Name
    name'
                         Id -> Type -> Id
    `setIdType` Type -> Type
    tidyTopType (Id -> Type
    idType Id
    id) }

    {-
    ************************************************************************
    *                                                                      *
            More GHCi stuff, to do with browsing and getting info
    *                                                                      *
    ************************************************************************
    -}

    -- | ASSUMES that the module is either in the 'HomePackageTable' or is
    -- a package module with an interface on disk.  If neither of these is
    -- true, then the result will be an error indicating the interface
    -- could not be found.
    getModuleInterface :: HscEnv -> Module -> IO (Messages, Maybe ModIface)
    getModuleInterface :: HscEnv -> Module -> IO (Messages, Maybe (ModIface_ 'ModIfaceFinal))
    getModuleInterface HscEnv
    hsc_env Module
    mod
      = HscEnv
    -> IOEnv (Env TcGblEnv TcLclEnv) (ModIface_ 'ModIfaceFinal)
    -> IO (Messages, Maybe (ModIface_ 'ModIfaceFinal))
    forall a. HscEnv -> TcRn a -> IO (Messages, Maybe a)
    runTcInteractive HscEnv
    hsc_env (IOEnv (Env TcGblEnv TcLclEnv) (ModIface_ 'ModIfaceFinal)
     -> IO (Messages, Maybe (ModIface_ 'ModIfaceFinal)))
    -> IOEnv (Env TcGblEnv TcLclEnv) (ModIface_ 'ModIfaceFinal)
    -> IO (Messages, Maybe (ModIface_ 'ModIfaceFinal))
    forall a b. (a -> b) -> a -> b
    $
        SDoc
    -> Module
    -> IOEnv (Env TcGblEnv TcLclEnv) (ModIface_ 'ModIfaceFinal)
    loadModuleInterface (String -> SDoc
    text String
    "getModuleInterface") Module
    mod

    tcRnLookupRdrName :: HscEnv -> Located RdrName
                      -> IO (Messages, Maybe [Name])
    -- ^ Find all the Names that this RdrName could mean, in GHCi
    tcRnLookupRdrName :: HscEnv -> Located RdrName -> IO (Messages, Maybe [Name])
    tcRnLookupRdrName HscEnv
    hsc_env (L SrcSpan
    loc RdrName
    rdr_name)
      = HscEnv -> TcRn [Name] -> IO (Messages, Maybe [Name])
    forall a. HscEnv -> TcRn a -> IO (Messages, Maybe a)
    runTcInteractive HscEnv
    hsc_env (TcRn [Name] -> IO (Messages, Maybe [Name]))
    -> TcRn [Name] -> IO (Messages, Maybe [Name])
    forall a b. (a -> b) -> a -> b
    $
        SrcSpan -> TcRn [Name] -> TcRn [Name]
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc           (TcRn [Name] -> TcRn [Name]) -> TcRn [Name] -> TcRn [Name]
    forall a b. (a -> b) -> a -> b
    $
        do {   -- If the identifier is a constructor (begins with an
               -- upper-case letter), then we need to consider both
               -- constructor and type class identifiers.
             let rdr_names :: [RdrName]
    rdr_names = RdrName -> [RdrName]
    dataTcOccs RdrName
    rdr_name
           ; [[Name]]
    names_s <- (RdrName -> TcRn [Name])
    -> [RdrName] -> IOEnv (Env TcGblEnv TcLclEnv) [[Name]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM RdrName -> TcRn [Name]
    lookupInfoOccRn [RdrName]
    rdr_names
           ; let names :: [Name]
    names = [[Name]] -> [Name]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Name]]
    names_s
           ; Bool -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Name] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Name]
    names) (SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    addErrTc (String -> SDoc
    text String
    "Not in scope:" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (RdrName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RdrName
    rdr_name)))
           ; [Name] -> TcRn [Name]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Name]
    names }

    tcRnLookupName :: HscEnv -> Name -> IO (Messages, Maybe TyThing)
    tcRnLookupName :: HscEnv -> Name -> IO (Messages, Maybe TyThing)
    tcRnLookupName HscEnv
    hsc_env Name
    name
      = HscEnv -> TcM TyThing -> IO (Messages, Maybe TyThing)
    forall a. HscEnv -> TcRn a -> IO (Messages, Maybe a)
    runTcInteractive HscEnv
    hsc_env (TcM TyThing -> IO (Messages, Maybe TyThing))
    -> TcM TyThing -> IO (Messages, Maybe TyThing)
    forall a b. (a -> b) -> a -> b
    $
        Name -> TcM TyThing
    tcRnLookupName' Name
    name

    -- To look up a name we have to look in the local environment (tcl_lcl)
    -- as well as the global environment, which is what tcLookup does.
    -- But we also want a TyThing, so we have to convert:

    tcRnLookupName' :: Name -> TcRn TyThing
    tcRnLookupName' :: Name -> TcM TyThing
    tcRnLookupName' Name
    name = do
       TcTyThing
    tcthing <- Name -> TcM TcTyThing
    tcLookup Name
    name
       case TcTyThing
    tcthing of
         AGlobal TyThing
    thing    -> TyThing -> TcM TyThing
    forall (m :: * -> *) a. Monad m => a -> m a
    return TyThing
    thing
         ATcId{tct_id :: TcTyThing -> Id
    tct_id=Id
    id} -> TyThing -> TcM TyThing
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> TyThing
    AnId Id
    id)
         TcTyThing
    _ -> String -> TcM TyThing
    forall a. String -> a
    panic String
    "tcRnLookupName'"

    tcRnGetInfo :: HscEnv
                -> Name
                -> IO ( Messages
                      , Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))

    -- Used to implement :info in GHCi
    --
    -- Look up a RdrName and return all the TyThings it might be
    -- A capitalised RdrName is given to us in the DataName namespace,
    -- but we want to treat it as *both* a data constructor
    --  *and* as a type or class constructor;
    -- hence the call to dataTcOccs, and we return up to two results
    tcRnGetInfo :: HscEnv
    -> Name
    -> IO
         (Messages, Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    tcRnGetInfo HscEnv
    hsc_env Name
    name
      = HscEnv
    -> TcRn (TyThing, Fixity, [ClsInst], [FamInst], SDoc)
    -> IO
         (Messages, Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    forall a. HscEnv -> TcRn a -> IO (Messages, Maybe a)
    runTcInteractive HscEnv
    hsc_env (TcRn (TyThing, Fixity, [ClsInst], [FamInst], SDoc)
     -> IO
          (Messages, Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)))
    -> TcRn (TyThing, Fixity, [ClsInst], [FamInst], SDoc)
    -> IO
         (Messages, Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    forall a b. (a -> b) -> a -> b
    $
        do { HscEnv -> InteractiveContext -> TcRnIf TcGblEnv TcLclEnv ()
    loadUnqualIfaces HscEnv
    hsc_env (HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env)
               -- Load the interface for all unqualified types and classes
               -- That way we will find all the instance declarations
               -- (Packages have not orphan modules, and we assume that
               --  in the home package all relevant modules are loaded.)

           ; TyThing
    thing  <- Name -> TcM TyThing
    tcRnLookupName' Name
    name
           ; Fixity
    fixity <- Name -> RnM Fixity
    lookupFixityRn Name
    name
           ; ([ClsInst]
    cls_insts, [FamInst]
    fam_insts) <- TyThing -> TcM ([ClsInst], [FamInst])
    lookupInsts TyThing
    thing
           ; let info :: SDoc
    info = Name -> SDoc
    lookupKnownNameInfo Name
    name
           ; (TyThing, Fixity, [ClsInst], [FamInst], SDoc)
    -> TcRn (TyThing, Fixity, [ClsInst], [FamInst], SDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TyThing
    thing, Fixity
    fixity, [ClsInst]
    cls_insts, [FamInst]
    fam_insts, SDoc
    info) }

    -- Lookup all class and family instances for a type constructor.
    --
    -- This function filters all instances in the type environment, so there
    -- is a lot of duplicated work if it is called many times in the same
    -- type environment. If this becomes a problem, the NameEnv computed
    -- in GHC.getNameToInstancesIndex could be cached in TcM and both functions
    -- could be changed to consult that index.
    lookupInsts :: TyThing -> TcM ([ClsInst],[FamInst])
    lookupInsts :: TyThing -> TcM ([ClsInst], [FamInst])
    lookupInsts (ATyCon TyCon
    tc)
      = do  { InstEnvs { ie_global :: InstEnvs -> InstEnv
    ie_global = InstEnv
    pkg_ie, ie_local :: InstEnvs -> InstEnv
    ie_local = InstEnv
    home_ie, ie_visible :: InstEnvs -> VisibleOrphanModules
    ie_visible = VisibleOrphanModules
    vis_mods } <- TcM InstEnvs
    tcGetInstEnvs
            ; (FamInstEnv
    pkg_fie, FamInstEnv
    home_fie) <- TcM FamInstEnvs
    tcGetFamInstEnvs
                    -- Load all instances for all classes that are
                    -- in the type environment (which are all the ones
                    -- we've seen in any interface file so far)

              -- Return only the instances relevant to the given thing, i.e.
              -- the instances whose head contains the thing's name.
            ; let cls_insts :: [ClsInst]
    cls_insts =
                     [ ClsInst
    ispec        -- Search all
                     | ClsInst
    ispec <- InstEnv -> [ClsInst]
    instEnvElts InstEnv
    home_ie [ClsInst] -> [ClsInst] -> [ClsInst]
    forall a. [a] -> [a] -> [a]
    ++ InstEnv -> [ClsInst]
    instEnvElts InstEnv
    pkg_ie
                     , VisibleOrphanModules -> ClsInst -> Bool
    instIsVisible VisibleOrphanModules
    vis_mods ClsInst
    ispec
                     , Name
    tc_name Name -> FreeVars -> Bool
    `elemNameSet` ClsInst -> FreeVars
    orphNamesOfClsInst ClsInst
    ispec ]
            ; let fam_insts :: [FamInst]
    fam_insts =
                     [ FamInst
    fispec
                     | FamInst
    fispec <- FamInstEnv -> [FamInst]
    famInstEnvElts FamInstEnv
    home_fie [FamInst] -> [FamInst] -> [FamInst]
    forall a. [a] -> [a] -> [a]
    ++ FamInstEnv -> [FamInst]
    famInstEnvElts FamInstEnv
    pkg_fie
                     , Name
    tc_name Name -> FreeVars -> Bool
    `elemNameSet` FamInst -> FreeVars
    orphNamesOfFamInst FamInst
    fispec ]
            ; ([ClsInst], [FamInst]) -> TcM ([ClsInst], [FamInst])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([ClsInst]
    cls_insts, [FamInst]
    fam_insts) }
      where
        tc_name :: Name
    tc_name     = TyCon -> Name
    tyConName TyCon
    tc

    lookupInsts TyThing
    _ = ([ClsInst], [FamInst]) -> TcM ([ClsInst], [FamInst])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([],[])

    loadUnqualIfaces :: HscEnv -> InteractiveContext -> TcM ()
    -- Load the interface for everything that is in scope unqualified
    -- This is so that we can accurately report the instances for
    -- something
    loadUnqualIfaces :: HscEnv -> InteractiveContext -> TcRnIf TcGblEnv TcLclEnv ()
    loadUnqualIfaces HscEnv
    hsc_env InteractiveContext
    ictxt
      = IfG () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a. IfG a -> TcRn a
    initIfaceTcRn (IfG () -> TcRnIf TcGblEnv TcLclEnv ())
    -> IfG () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $ do
        (Module -> IOEnv (Env IfGblEnv ()) (ModIface_ 'ModIfaceFinal))
    -> [Module] -> IfG ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (SDoc
    -> Module -> IOEnv (Env IfGblEnv ()) (ModIface_ 'ModIfaceFinal)
    forall lcl. SDoc -> Module -> IfM lcl (ModIface_ 'ModIfaceFinal)
    loadSysInterface SDoc
    doc) (VisibleOrphanModules -> [Module]
    moduleSetElts ([Module] -> VisibleOrphanModules
    mkModuleSet [Module]
    unqual_mods))
      where
        this_pkg :: GenUnit UnitId
    this_pkg = DynFlags -> GenUnit UnitId
    homeUnit (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)

        unqual_mods :: [Module]
    unqual_mods = [ HasDebugCallStack => Name -> Module
    Name -> Module
    nameModule Name
    name
                      | GlobalRdrElt
    gre <- GlobalRdrEnv -> [GlobalRdrElt]
    globalRdrEnvElts (InteractiveContext -> GlobalRdrEnv
    ic_rn_gbl_env InteractiveContext
    ictxt)
                      , let name :: Name
    name = GlobalRdrElt -> Name
    gre_name GlobalRdrElt
    gre
                      , GenUnit UnitId -> Name -> Bool
    nameIsFromExternalPackage GenUnit UnitId
    this_pkg Name
    name
                      , OccName -> Bool
    isTcOcc (Name -> OccName
    nameOccName Name
    name)   -- Types and classes only
                      , GlobalRdrElt -> Bool
    unQualOK GlobalRdrElt
    gre ]               -- In scope unqualified
        doc :: SDoc
    doc = String -> SDoc
    text String
    "Need interface for module whose export(s) are in scope unqualified"

    {-
    ************************************************************************
    *                                                                      *
                    Debugging output
          This is what happens when you do -ddump-types
    *                                                                      *
    ************************************************************************
    -}

    -- | Dump, with a banner, if -ddump-rn
    rnDump :: (Outputable a, Data a) => a -> TcRn ()
    rnDump :: forall a.
    (Outputable a, Data a) =>
    a -> TcRnIf TcGblEnv TcLclEnv ()
    rnDump a
    rn = DumpFlag
    -> String -> DumpFormat -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    dumpOptTcRn DumpFlag
    Opt_D_dump_rn String
    "Renamer" DumpFormat
    FormatHaskell (a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    rn)

    tcDump :: TcGblEnv -> TcRn ()
    tcDump :: TcGblEnv -> TcRnIf TcGblEnv TcLclEnv ()
    tcDump TcGblEnv
    env
     = do { DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags ;

            -- Dump short output if -ddump-types or -ddump-tc
            Bool -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DumpFlag -> DynFlags -> Bool
    dopt DumpFlag
    Opt_D_dump_types DynFlags
    dflags Bool -> Bool -> Bool
    || DumpFlag -> DynFlags -> Bool
    dopt DumpFlag
    Opt_D_dump_tc DynFlags
    dflags)
              (Bool
    -> DumpOptions
    -> String
    -> DumpFormat
    -> SDoc
    -> TcRnIf TcGblEnv TcLclEnv ()
    dumpTcRn Bool
    True (DumpFlag -> DumpOptions
    dumpOptionsFromFlag DumpFlag
    Opt_D_dump_types)
                String
    "" DumpFormat
    FormatText SDoc
    short_dump) ;

            -- Dump bindings if -ddump-tc
            DumpFlag
    -> String -> DumpFormat -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    dumpOptTcRn DumpFlag
    Opt_D_dump_tc String
    "Typechecker" DumpFormat
    FormatHaskell SDoc
    full_dump;

            -- Dump bindings as an hsSyn AST if -ddump-tc-ast
            DumpFlag
    -> String -> DumpFormat -> SDoc -> TcRnIf TcGblEnv TcLclEnv ()
    dumpOptTcRn DumpFlag
    Opt_D_dump_tc_ast String
    "Typechecker AST" DumpFormat
    FormatHaskell SDoc
    ast_dump
       }
      where
        short_dump :: SDoc
    short_dump = TcGblEnv -> SDoc
    pprTcGblEnv TcGblEnv
    env
        full_dump :: SDoc
    full_dump  = LHsBinds GhcTc -> SDoc
    forall (idL :: Pass) (idR :: Pass).
    (OutputableBndrId idL, OutputableBndrId idR) =>
    LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
    pprLHsBinds (TcGblEnv -> LHsBinds GhcTc
    tcg_binds TcGblEnv
    env)
            -- NB: foreign x-d's have undefined's in their types;
            --     hence can't show the tc_fords
        ast_dump :: SDoc
    ast_dump = BlankSrcSpan -> LHsBinds GhcTc -> SDoc
    forall a. Data a => BlankSrcSpan -> a -> SDoc
    showAstData BlankSrcSpan
    NoBlankSrcSpan (TcGblEnv -> LHsBinds GhcTc
    tcg_binds TcGblEnv
    env)

    -- It's unpleasant having both pprModGuts and pprModDetails here
    pprTcGblEnv :: TcGblEnv -> SDoc
    pprTcGblEnv :: TcGblEnv -> SDoc
    pprTcGblEnv (TcGblEnv { tcg_type_env :: TcGblEnv -> TypeEnv
    tcg_type_env  = TypeEnv
    type_env,
                            tcg_insts :: TcGblEnv -> [ClsInst]
    tcg_insts     = [ClsInst]
    insts,
                            tcg_fam_insts :: TcGblEnv -> [FamInst]
    tcg_fam_insts = [FamInst]
    fam_insts,
                            tcg_rules :: TcGblEnv -> [LRuleDecl GhcTc]
    tcg_rules     = [LRuleDecl GhcTc]
    rules,
                            tcg_imports :: TcGblEnv -> ImportAvails
    tcg_imports   = ImportAvails
    imports })
      = (Bool -> SDoc) -> SDoc
    getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \Bool
    debug ->
        [SDoc] -> SDoc
    vcat [ Bool -> TypeEnv -> SDoc
    ppr_types Bool
    debug TypeEnv
    type_env
             , Bool -> [FamInst] -> TypeEnv -> SDoc
    ppr_tycons Bool
    debug [FamInst]
    fam_insts TypeEnv
    type_env
             , Bool -> TypeEnv -> SDoc
    ppr_datacons Bool
    debug TypeEnv
    type_env
             , TypeEnv -> SDoc
    ppr_patsyns TypeEnv
    type_env
             , [ClsInst] -> SDoc
    ppr_insts [ClsInst]
    insts
             , [FamInst] -> SDoc
    ppr_fam_insts [FamInst]
    fam_insts
             , [LRuleDecl GhcTc] -> SDoc
    ppr_rules [LRuleDecl GhcTc]
    rules
             , String -> SDoc
    text String
    "Dependent modules:" SDoc -> SDoc -> SDoc
    <+>
                    ModuleNameEnv ModuleNameWithIsBoot
    -> ([ModuleNameWithIsBoot] -> SDoc) -> SDoc
    forall key a. UniqFM key a -> ([a] -> SDoc) -> SDoc
    pprUFM (ImportAvails -> ModuleNameEnv ModuleNameWithIsBoot
    imp_dep_mods ImportAvails
    imports) ([ModuleNameWithIsBoot] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([ModuleNameWithIsBoot] -> SDoc)
    -> ([ModuleNameWithIsBoot] -> [ModuleNameWithIsBoot])
    -> [ModuleNameWithIsBoot]
    -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [ModuleNameWithIsBoot] -> [ModuleNameWithIsBoot]
    forall a. Ord a => [a] -> [a]
    sort)
             , String -> SDoc
    text String
    "Dependent packages:" SDoc -> SDoc -> SDoc
    <+>
                    [UnitId] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Set UnitId -> [UnitId]
    forall a. Set a -> [a]
    S.toList (Set UnitId -> [UnitId]) -> Set UnitId -> [UnitId]
    forall a b. (a -> b) -> a -> b
    $ ImportAvails -> Set UnitId
    imp_dep_pkgs ImportAvails
    imports)]
                    -- The use of sort is just to reduce unnecessary
                    -- wobbling in testsuite output

    ppr_rules :: [LRuleDecl GhcTc] -> SDoc
    ppr_rules :: [LRuleDecl GhcTc] -> SDoc
    ppr_rules [LRuleDecl GhcTc]
    rules
      = Bool -> SDoc -> SDoc
    ppUnless ([LRuleDecl GhcTc] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [LRuleDecl GhcTc]
    rules) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
        SDoc -> Arity -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "RULES")
           Arity
    2 ([SDoc] -> SDoc
    vcat ((LRuleDecl GhcTc -> SDoc) -> [LRuleDecl GhcTc] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map LRuleDecl GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [LRuleDecl GhcTc]
    rules))

    ppr_types :: Bool -> TypeEnv -> SDoc
    ppr_types :: Bool -> TypeEnv -> SDoc
    ppr_types Bool
    debug TypeEnv
    type_env
      = String -> (Id -> SDoc) -> [Id] -> SDoc
    forall a. String -> (a -> SDoc) -> [a] -> SDoc
    ppr_things String
    "TYPE SIGNATURES" Id -> SDoc
    ppr_sig
                 ((Id -> Id -> Ordering) -> [Id] -> [Id]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ((Id -> OccName) -> Id -> Id -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing Id -> OccName
    forall a. NamedThing a => a -> OccName
    getOccName) [Id]
    ids)
      where
        ids :: [Id]
    ids = [Id
    id | Id
    id <- TypeEnv -> [Id]
    typeEnvIds TypeEnv
    type_env, Id -> Bool
    want_sig Id
    id]
        want_sig :: Id -> Bool
    want_sig Id
    id
          | Bool
    debug     = Bool
    True
          | Bool
    otherwise = Id -> Bool
    forall x. NamedThing x => x -> Bool
    hasTopUserName Id
    id
                        Bool -> Bool -> Bool
    && case Id -> IdDetails
    idDetails Id
    id of
                             IdDetails
    VanillaId    -> Bool
    True
                             RecSelId {}  -> Bool
    True
                             ClassOpId {} -> Bool
    True
                             FCallId {}   -> Bool
    True
                             IdDetails
    _            -> Bool
    False
                 -- Data cons (workers and wrappers), pattern synonyms,
                 -- etc are suppressed (unless -dppr-debug),
                 -- because they appear elsewhere

        ppr_sig :: Id -> SDoc
    ppr_sig Id
    id = SDoc -> Arity -> SDoc -> SDoc
    hang (Id -> SDoc
    forall a. OutputableBndr a => a -> SDoc
    pprPrefixOcc Id
    id SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon) Arity
    2 (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Type -> Type
    tidyTopType (Id -> Type
    idType Id
    id)))

    ppr_tycons :: Bool -> [FamInst] -> TypeEnv -> SDoc
    ppr_tycons :: Bool -> [FamInst] -> TypeEnv -> SDoc
    ppr_tycons Bool
    debug [FamInst]
    fam_insts TypeEnv
    type_env
      = [SDoc] -> SDoc
    vcat [ String -> (TyCon -> SDoc) -> [TyCon] -> SDoc
    forall a. String -> (a -> SDoc) -> [a] -> SDoc
    ppr_things String
    "TYPE CONSTRUCTORS" TyCon -> SDoc
    ppr_tc [TyCon]
    tycons
             , String -> (CoAxiom Branched -> SDoc) -> [CoAxiom Branched] -> SDoc
    forall a. String -> (a -> SDoc) -> [a] -> SDoc
    ppr_things String
    "COERCION AXIOMS" CoAxiom Branched -> SDoc
    forall {br :: BranchFlag}. CoAxiom br -> SDoc
    ppr_ax
                          (TypeEnv -> [CoAxiom Branched]
    typeEnvCoAxioms TypeEnv
    type_env) ]
      where
        fi_tycons :: [TyCon]
    fi_tycons = [FamInst] -> [TyCon]
    famInstsRepTyCons [FamInst]
    fam_insts

        tycons :: [TyCon]
    tycons = (TyCon -> TyCon -> Ordering) -> [TyCon] -> [TyCon]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ((TyCon -> OccName) -> TyCon -> TyCon -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing TyCon -> OccName
    forall a. NamedThing a => a -> OccName
    getOccName) ([TyCon] -> [TyCon]) -> [TyCon] -> [TyCon]
    forall a b. (a -> b) -> a -> b
    $
                 [TyCon
    tycon | TyCon
    tycon <- TypeEnv -> [TyCon]
    typeEnvTyCons TypeEnv
    type_env
                        , TyCon -> Bool
    want_tycon TyCon
    tycon]
                 -- Sort by OccName to reduce unnecessary changes
        want_tycon :: TyCon -> Bool
    want_tycon TyCon
    tycon | Bool
    debug      = Bool
    True
                         | Bool
    otherwise  = Name -> Bool
    isExternalName (TyCon -> Name
    tyConName TyCon
    tycon) Bool -> Bool -> Bool
    &&
                                        Bool -> Bool
    not (TyCon
    tycon TyCon -> [TyCon] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [TyCon]
    fi_tycons)
        ppr_tc :: TyCon -> SDoc
    ppr_tc TyCon
    tc
           = [SDoc] -> SDoc
    vcat [ SDoc -> Arity -> SDoc -> SDoc
    hang (TyConFlavour -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> TyConFlavour
    tyConFlavour TyCon
    tc) SDoc -> SDoc -> SDoc
    <+> Name -> SDoc
    forall a. OutputableBndr a => a -> SDoc
    pprPrefixOcc (TyCon -> Name
    tyConName TyCon
    tc)
                          SDoc -> SDoc -> SDoc
    <> SDoc -> SDoc
    braces (Arity -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TyCon -> Arity
    tyConArity TyCon
    tc)) SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon)
                       Arity
    2 (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Type -> Type
    tidyTopType (TyCon -> Type
    tyConKind TyCon
    tc)))
                  , Arity -> SDoc -> SDoc
    nest Arity
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                    Bool -> SDoc -> SDoc
    ppWhen Bool
    show_roles (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                    String -> SDoc
    text String
    "roles" SDoc -> SDoc -> SDoc
    <+> ([SDoc] -> SDoc
    sep ((Role -> SDoc) -> [Role] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Role -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Role]
    roles)) ]
           where
             show_roles :: Bool
    show_roles = Bool
    debug Bool -> Bool -> Bool
    || Bool -> Bool
    not ((Role -> Bool) -> [Role] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Role -> Role -> Bool
    forall a. Eq a => a -> a -> Bool
    == Role
    boring_role) [Role]
    roles)
             roles :: [Role]
    roles = TyCon -> [Role]
    tyConRoles TyCon
    tc
             boring_role :: Role
    boring_role | TyCon -> Bool
    isClassTyCon TyCon
    tc = Role
    Nominal
                         | Bool
    otherwise       = Role
    Representational
                -- Matches the choice in GHC.Iface.Syntax, calls to pprRoles

        ppr_ax :: CoAxiom br -> SDoc
    ppr_ax CoAxiom br
    ax = IfaceDecl -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (CoAxiom br -> IfaceDecl
    forall (br :: BranchFlag). CoAxiom br -> IfaceDecl
    coAxiomToIfaceDecl CoAxiom br
    ax)
          -- We go via IfaceDecl rather than using pprCoAxiom
          -- This way we get the full axiom (both LHS and RHS) with
          -- wildcard binders tidied to _1, _2, etc.

    ppr_datacons :: Bool -> TypeEnv -> SDoc
    ppr_datacons :: Bool -> TypeEnv -> SDoc
    ppr_datacons Bool
    debug TypeEnv
    type_env
      = String -> (DataCon -> SDoc) -> [DataCon] -> SDoc
    forall a. String -> (a -> SDoc) -> [a] -> SDoc
    ppr_things String
    "DATA CONSTRUCTORS" DataCon -> SDoc
    ppr_dc [DataCon]
    wanted_dcs
          -- The filter gets rid of class data constructors
      where
        ppr_dc :: DataCon -> SDoc
    ppr_dc DataCon
    dc = (DynFlags -> SDoc) -> SDoc
    sdocWithDynFlags (\DynFlags
    dflags ->
                    DataCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DataCon
    dc SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (DynFlags -> DataCon -> Type
    dataConDisplayType DynFlags
    dflags DataCon
    dc))
        all_dcs :: [DataCon]
    all_dcs    = TypeEnv -> [DataCon]
    typeEnvDataCons TypeEnv
    type_env
        wanted_dcs :: [DataCon]
    wanted_dcs | Bool
    debug     = [DataCon]
    all_dcs
                   | Bool
    otherwise = (DataCon -> Bool) -> [DataCon] -> [DataCon]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut DataCon -> Bool
    is_cls_dc [DataCon]
    all_dcs
        is_cls_dc :: DataCon -> Bool
    is_cls_dc DataCon
    dc = TyCon -> Bool
    isClassTyCon (DataCon -> TyCon
    dataConTyCon DataCon
    dc)

    ppr_patsyns :: TypeEnv -> SDoc
    ppr_patsyns :: TypeEnv -> SDoc
    ppr_patsyns TypeEnv
    type_env
      = String -> (PatSyn -> SDoc) -> [PatSyn] -> SDoc
    forall a. String -> (a -> SDoc) -> [a] -> SDoc
    ppr_things String
    "PATTERN SYNONYMS" PatSyn -> SDoc
    ppr_ps
                   (TypeEnv -> [PatSyn]
    typeEnvPatSyns TypeEnv
    type_env)
      where
        ppr_ps :: PatSyn -> SDoc
    ppr_ps PatSyn
    ps = PatSyn -> SDoc
    forall a. OutputableBndr a => a -> SDoc
    pprPrefixOcc PatSyn
    ps SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> PatSyn -> SDoc
    pprPatSynType PatSyn
    ps

    ppr_insts :: [ClsInst] -> SDoc
    ppr_insts :: [ClsInst] -> SDoc
    ppr_insts [ClsInst]
    ispecs
      = String -> (ClsInst -> SDoc) -> [ClsInst] -> SDoc
    forall a. String -> (a -> SDoc) -> [a] -> SDoc
    ppr_things String
    "CLASS INSTANCES" ClsInst -> SDoc
    pprInstance [ClsInst]
    ispecs

    ppr_fam_insts :: [FamInst] -> SDoc
    ppr_fam_insts :: [FamInst] -> SDoc
    ppr_fam_insts [FamInst]
    fam_insts
      = String -> (FamInst -> SDoc) -> [FamInst] -> SDoc
    forall a. String -> (a -> SDoc) -> [a] -> SDoc
    ppr_things String
    "FAMILY INSTANCES" FamInst -> SDoc
    pprFamInst [FamInst]
    fam_insts

    ppr_things :: String -> (a -> SDoc) -> [a] -> SDoc
    ppr_things :: forall a. String -> (a -> SDoc) -> [a] -> SDoc
    ppr_things String
    herald a -> SDoc
    ppr_one [a]
    things
      | [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [a]
    things = SDoc
    empty
      | Bool
    otherwise   = String -> SDoc
    text String
    herald SDoc -> SDoc -> SDoc
    $$ Arity -> SDoc -> SDoc
    nest Arity
    2 ([SDoc] -> SDoc
    vcat ((a -> SDoc) -> [a] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> SDoc
    ppr_one [a]
    things))

    hasTopUserName :: NamedThing x => x -> Bool
    -- A top-level thing whose name is not "derived"
    -- Thus excluding things like $tcX, from Typeable boilerplate
    -- and C:Coll from class-dictionary data constructors
    hasTopUserName :: forall x. NamedThing x => x -> Bool
    hasTopUserName x
    x
      = Name -> Bool
    isExternalName Name
    name Bool -> Bool -> Bool
    && Bool -> Bool
    not (OccName -> Bool
    isDerivedOccName (Name -> OccName
    nameOccName Name
    name))
      where
        name :: Name
    name = x -> Name
    forall a. NamedThing a => a -> Name
    getName x
    x

    {-
    ********************************************************************************

    Type Checker Plugins

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

    withTcPlugins :: HscEnv -> TcM a -> TcM a
    withTcPlugins :: forall a. HscEnv -> TcM a -> TcM a
    withTcPlugins HscEnv
    hsc_env TcM a
    m =
      do let plugins :: [TcPlugin]
    plugins = DynFlags -> [TcPlugin]
    getTcPlugins (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)
         case [TcPlugin]
    plugins of
           [] -> TcM a
    m  -- Common fast case
           [TcPlugin]
    _  -> do EvBindsVar
    ev_binds_var <- TcM EvBindsVar
    newTcEvBinds
                    ([TcPluginSolver]
    solvers,[TcPluginM ()]
    stops) <- [(TcPluginSolver, TcPluginM ())]
    -> ([TcPluginSolver], [TcPluginM ()])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(TcPluginSolver, TcPluginM ())]
     -> ([TcPluginSolver], [TcPluginM ()]))
    -> IOEnv (Env TcGblEnv TcLclEnv) [(TcPluginSolver, TcPluginM ())]
    -> IOEnv (Env TcGblEnv TcLclEnv) ([TcPluginSolver], [TcPluginM ()])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (TcPlugin
     -> IOEnv (Env TcGblEnv TcLclEnv) (TcPluginSolver, TcPluginM ()))
    -> [TcPlugin]
    -> IOEnv (Env TcGblEnv TcLclEnv) [(TcPluginSolver, TcPluginM ())]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (EvBindsVar
    -> TcPlugin
    -> IOEnv (Env TcGblEnv TcLclEnv) (TcPluginSolver, TcPluginM ())
    startPlugin EvBindsVar
    ev_binds_var) [TcPlugin]
    plugins
                    -- This ensures that tcPluginStop is called even if a type
                    -- error occurs during compilation (Fix of #10078)
                    Either IOEnvFailure a
    eitherRes <- TcM a -> IOEnv (Env TcGblEnv TcLclEnv) (Either IOEnvFailure a)
    forall env r. IOEnv env r -> IOEnv env (Either IOEnvFailure r)
    tryM (TcM a -> IOEnv (Env TcGblEnv TcLclEnv) (Either IOEnvFailure a))
    -> TcM a -> IOEnv (Env TcGblEnv TcLclEnv) (Either IOEnvFailure a)
    forall a b. (a -> b) -> a -> b
    $ do
                      (TcGblEnv -> TcGblEnv) -> TcM a -> TcM a
    forall gbl lcl a.
    (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updGblEnv (\TcGblEnv
    e -> TcGblEnv
    e { tcg_tc_plugins :: [TcPluginSolver]
    tcg_tc_plugins = [TcPluginSolver]
    solvers }) TcM a
    m
                    (TcPluginM () -> TcRnIf TcGblEnv TcLclEnv ())
    -> [TcPluginM ()] -> TcRnIf TcGblEnv TcLclEnv ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((TcPluginM () -> EvBindsVar -> TcRnIf TcGblEnv TcLclEnv ())
    -> EvBindsVar -> TcPluginM () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip TcPluginM () -> EvBindsVar -> TcRnIf TcGblEnv TcLclEnv ()
    forall a. TcPluginM a -> EvBindsVar -> TcM a
    runTcPluginM EvBindsVar
    ev_binds_var) [TcPluginM ()]
    stops
                    case Either IOEnvFailure a
    eitherRes of
                      Left IOEnvFailure
    _ -> TcM a
    forall env a. IOEnv env a
    failM
                      Right a
    res -> a -> TcM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    res
      where
      startPlugin :: EvBindsVar
    -> TcPlugin
    -> IOEnv (Env TcGblEnv TcLclEnv) (TcPluginSolver, TcPluginM ())
    startPlugin EvBindsVar
    ev_binds_var (TcPlugin TcPluginM s
    start s -> TcPluginSolver
    solve s -> TcPluginM ()
    stop) =
        do s
    s <- TcPluginM s -> EvBindsVar -> TcM s
    forall a. TcPluginM a -> EvBindsVar -> TcM a
    runTcPluginM TcPluginM s
    start EvBindsVar
    ev_binds_var
           (TcPluginSolver, TcPluginM ())
    -> IOEnv (Env TcGblEnv TcLclEnv) (TcPluginSolver, TcPluginM ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return (s -> TcPluginSolver
    solve s
    s, s -> TcPluginM ()
    stop s
    s)

    getTcPlugins :: DynFlags -> [GHC.Tc.Utils.Monad.TcPlugin]
    getTcPlugins :: DynFlags -> [TcPlugin]
    getTcPlugins DynFlags
    dflags = [Maybe TcPlugin] -> [TcPlugin]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe TcPlugin] -> [TcPlugin]) -> [Maybe TcPlugin] -> [TcPlugin]
    forall a b. (a -> b) -> a -> b
    $ DynFlags
    -> (Plugin -> [String] -> Maybe TcPlugin) -> [Maybe TcPlugin]
    forall a. DynFlags -> (Plugin -> [String] -> a) -> [a]
    mapPlugins DynFlags
    dflags (\Plugin
    p [String]
    args -> Plugin -> [String] -> Maybe TcPlugin
    tcPlugin Plugin
    p [String]
    args)

    withHoleFitPlugins :: HscEnv -> TcM a -> TcM a
    withHoleFitPlugins :: forall a. HscEnv -> TcM a -> TcM a
    withHoleFitPlugins HscEnv
    hsc_env TcM a
    m =
      case (DynFlags -> [HoleFitPluginR]
    getHfPlugins (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)) of
        [] -> TcM a
    m  -- Common fast case
        [HoleFitPluginR]
    plugins -> do ([HoleFitPlugin]
    plugins,[TcRnIf TcGblEnv TcLclEnv ()]
    stops) <- [(HoleFitPlugin, TcRnIf TcGblEnv TcLclEnv ())]
    -> ([HoleFitPlugin], [TcRnIf TcGblEnv TcLclEnv ()])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(HoleFitPlugin, TcRnIf TcGblEnv TcLclEnv ())]
     -> ([HoleFitPlugin], [TcRnIf TcGblEnv TcLclEnv ()]))
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [(HoleFitPlugin, TcRnIf TcGblEnv TcLclEnv ())]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         ([HoleFitPlugin], [TcRnIf TcGblEnv TcLclEnv ()])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (HoleFitPluginR
     -> IOEnv
          (Env TcGblEnv TcLclEnv)
          (HoleFitPlugin, TcRnIf TcGblEnv TcLclEnv ()))
    -> [HoleFitPluginR]
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         [(HoleFitPlugin, TcRnIf TcGblEnv TcLclEnv ())]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM HoleFitPluginR
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (HoleFitPlugin, TcRnIf TcGblEnv TcLclEnv ())
    startPlugin [HoleFitPluginR]
    plugins
                      -- This ensures that hfPluginStop is called even if a type
                      -- error occurs during compilation.
                      Either IOEnvFailure a
    eitherRes <- TcM a -> IOEnv (Env TcGblEnv TcLclEnv) (Either IOEnvFailure a)
    forall env r. IOEnv env r -> IOEnv env (Either IOEnvFailure r)
    tryM (TcM a -> IOEnv (Env TcGblEnv TcLclEnv) (Either IOEnvFailure a))
    -> TcM a -> IOEnv (Env TcGblEnv TcLclEnv) (Either IOEnvFailure a)
    forall a b. (a -> b) -> a -> b
    $ do
                        (TcGblEnv -> TcGblEnv) -> TcM a -> TcM a
    forall gbl lcl a.
    (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updGblEnv (\TcGblEnv
    e -> TcGblEnv
    e { tcg_hf_plugins :: [HoleFitPlugin]
    tcg_hf_plugins = [HoleFitPlugin]
    plugins }) TcM a
    m
                      [TcRnIf TcGblEnv TcLclEnv ()] -> TcRnIf TcGblEnv TcLclEnv ()
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, Monad m) =>
    t (m a) -> m ()
    sequence_ [TcRnIf TcGblEnv TcLclEnv ()]
    stops
                      case Either IOEnvFailure a
    eitherRes of
                        Left IOEnvFailure
    _ -> TcM a
    forall env a. IOEnv env a
    failM
                        Right a
    res -> a -> TcM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    res
      where
        startPlugin :: HoleFitPluginR
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (HoleFitPlugin, TcRnIf TcGblEnv TcLclEnv ())
    startPlugin (HoleFitPluginR TcM (TcRef s)
    init TcRef s -> HoleFitPlugin
    plugin TcRef s -> TcRnIf TcGblEnv TcLclEnv ()
    stop) =
          do TcRef s
    ref <- TcM (TcRef s)
    init
             (HoleFitPlugin, TcRnIf TcGblEnv TcLclEnv ())
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (HoleFitPlugin, TcRnIf TcGblEnv TcLclEnv ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcRef s -> HoleFitPlugin
    plugin TcRef s
    ref, TcRef s -> TcRnIf TcGblEnv TcLclEnv ()
    stop TcRef s
    ref)

    getHfPlugins :: DynFlags -> [HoleFitPluginR]
    getHfPlugins :: DynFlags -> [HoleFitPluginR]
    getHfPlugins DynFlags
    dflags =
      [Maybe HoleFitPluginR] -> [HoleFitPluginR]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe HoleFitPluginR] -> [HoleFitPluginR])
    -> [Maybe HoleFitPluginR] -> [HoleFitPluginR]
    forall a b. (a -> b) -> a -> b
    $ DynFlags
    -> (Plugin -> [String] -> Maybe HoleFitPluginR)
    -> [Maybe HoleFitPluginR]
    forall a. DynFlags -> (Plugin -> [String] -> a) -> [a]
    mapPlugins DynFlags
    dflags (\Plugin
    p [String]
    args -> Plugin -> [String] -> Maybe HoleFitPluginR
    holeFitPlugin Plugin
    p [String]
    args)

    runRenamerPlugin :: TcGblEnv
                     -> HsGroup GhcRn
                     -> TcM (TcGblEnv, HsGroup GhcRn)
    runRenamerPlugin :: TcGblEnv
    -> HsGroup (GhcPass 'Renamed)
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    runRenamerPlugin TcGblEnv
    gbl_env HsGroup (GhcPass 'Renamed)
    hs_group = do
        DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        DynFlags
    -> PluginOperation
         (IOEnv (Env TcGblEnv TcLclEnv))
         (TcGblEnv, HsGroup (GhcPass 'Renamed))
    -> (TcGblEnv, HsGroup (GhcPass 'Renamed))
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    forall (m :: * -> *) a.
    Monad m =>
    DynFlags -> PluginOperation m a -> a -> m a
    withPlugins DynFlags
    dflags
          (\Plugin
    p [String]
    opts (TcGblEnv
    e, HsGroup (GhcPass 'Renamed)
    g) -> ( DynFlags -> TcRnIf TcGblEnv TcLclEnv ()
    mark_plugin_unsafe DynFlags
    dflags TcRnIf TcGblEnv TcLclEnv ()
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Plugin
    -> [String]
    -> TcGblEnv
    -> HsGroup (GhcPass 'Renamed)
    -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
    renamedResultAction Plugin
    p [String]
    opts TcGblEnv
    e HsGroup (GhcPass 'Renamed)
    g))
          (TcGblEnv
    gbl_env, HsGroup (GhcPass 'Renamed)
    hs_group)

    -- XXX: should this really be a Maybe X?  Check under which circumstances this
    -- can become a Nothing and decide whether this should instead throw an
    -- exception/signal an error.
    type RenamedStuff =
            (Maybe (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [(LIE GhcRn, Avails)],
                    Maybe LHsDocString))

    -- | Extract the renamed information from TcGblEnv.
    getRenamedStuff :: TcGblEnv -> RenamedStuff
    getRenamedStuff :: TcGblEnv -> RenamedStuff
    getRenamedStuff TcGblEnv
    tc_result
      = (HsGroup (GhcPass 'Renamed)
     -> (HsGroup (GhcPass 'Renamed), [LImportDecl (GhcPass 'Renamed)],
         Maybe [(GenLocated SrcSpan (IE (GhcPass 'Renamed)), [AvailInfo])],
         Maybe LHsDocString))
    -> Maybe (HsGroup (GhcPass 'Renamed)) -> RenamedStuff
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\HsGroup (GhcPass 'Renamed)
    decls -> ( HsGroup (GhcPass 'Renamed)
    decls, TcGblEnv -> [LImportDecl (GhcPass 'Renamed)]
    tcg_rn_imports TcGblEnv
    tc_result
                        , TcGblEnv
    -> Maybe
         [(GenLocated SrcSpan (IE (GhcPass 'Renamed)), [AvailInfo])]
    tcg_rn_exports TcGblEnv
    tc_result, TcGblEnv -> Maybe LHsDocString
    tcg_doc_hdr TcGblEnv
    tc_result ) )
             (TcGblEnv -> Maybe (HsGroup (GhcPass 'Renamed))
    tcg_rn_decls TcGblEnv
    tc_result)

    runTypecheckerPlugin :: ModSummary -> HscEnv -> TcGblEnv -> TcM TcGblEnv
    runTypecheckerPlugin :: ModSummary -> HscEnv -> TcGblEnv -> TcM TcGblEnv
    runTypecheckerPlugin ModSummary
    sum HscEnv
    hsc_env TcGblEnv
    gbl_env = do
        let dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        DynFlags
    -> PluginOperation (IOEnv (Env TcGblEnv TcLclEnv)) TcGblEnv
    -> TcGblEnv
    -> TcM TcGblEnv
    forall (m :: * -> *) a.
    Monad m =>
    DynFlags -> PluginOperation m a -> a -> m a
    withPlugins DynFlags
    dflags
          (\Plugin
    p [String]
    opts TcGblEnv
    env -> DynFlags -> TcRnIf TcGblEnv TcLclEnv ()
    mark_plugin_unsafe DynFlags
    dflags
                            TcRnIf TcGblEnv TcLclEnv () -> TcM TcGblEnv -> TcM TcGblEnv
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Plugin -> [String] -> ModSummary -> TcGblEnv -> TcM TcGblEnv
    typeCheckResultAction Plugin
    p [String]
    opts ModSummary
    sum TcGblEnv
    env)
          TcGblEnv
    gbl_env

    mark_plugin_unsafe :: DynFlags -> TcM ()
    mark_plugin_unsafe :: DynFlags -> TcRnIf TcGblEnv TcLclEnv ()
    mark_plugin_unsafe DynFlags
    dflags = Bool -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_PluginTrustworthy DynFlags
    dflags) (TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ())
    -> TcRnIf TcGblEnv TcLclEnv () -> TcRnIf TcGblEnv TcLclEnv ()
    forall a b. (a -> b) -> a -> b
    $
      Bag WarnMsg -> TcRnIf TcGblEnv TcLclEnv ()
    recordUnsafeInfer Bag WarnMsg
    pluginUnsafe
      where
        unsafeText :: String
    unsafeText = String
    "Use of plugins makes the module unsafe"
        pluginUnsafe :: Bag WarnMsg
    pluginUnsafe = WarnMsg -> Bag WarnMsg
    forall a. a -> Bag a
    unitBag ( DynFlags -> SrcSpan -> SDoc -> WarnMsg
    mkPlainWarnMsg DynFlags
    dflags SrcSpan
    noSrcSpan
                                       (String -> SDoc
    Outputable.text String
    unsafeText) )