    {-# LANGUAGE CPP                      #-}
    {-# LANGUAGE BangPatterns             #-}
    {-# LANGUAGE NondecreasingIndentation #-}
    {-# LANGUAGE LambdaCase               #-}
    {-# LANGUAGE ViewPatterns             #-}
    {-# OPTIONS_GHC -fprof-auto-top #-}

    -------------------------------------------------------------------------------
    --
    -- | Main API for compiling plain Haskell source code.
    --
    -- This module implements compilation of a Haskell source. It is
    -- /not/ concerned with preprocessing of source files; this is handled
    -- in "GHC.Driver.Pipeline"
    --
    -- There are various entry points depending on what mode we're in:
    -- "batch" mode (@--make@), "one-shot" mode (@-c@, @-S@ etc.), and
    -- "interactive" mode (GHCi). There are also entry points for
    -- individual passes: parsing, typechecking/renaming, desugaring, and
    -- simplification.
    --
    -- All the functions here take an 'HscEnv' as a parameter, but none of
    -- them return a new one: 'HscEnv' is treated as an immutable value
    -- from here on in (although it has mutable components, for the
    -- caches).
    --
    -- We use the Hsc monad to deal with warning messages consistently:
    -- specifically, while executing within an Hsc monad, warnings are
    -- collected. When a Hsc monad returns to an IO monad, the
    -- warnings are printed, or compilation aborts if the @-Werror@
    -- flag is enabled.
    --
    -- (c) The GRASP/AQUA Project, Glasgow University, 1993-2000
    --
    -------------------------------------------------------------------------------

    module GHC.Driver.Main
        (
        -- * Making an HscEnv
          newHscEnv

        -- * Compiling complete source files
        , Messager, batchMsg
        , HscStatus (..)
        , hscIncrementalCompile
        , hscMaybeWriteIface
        , hscCompileCmmFile

        , hscGenHardCode
        , hscInteractive

        -- * Running passes separately
        , hscParse
        , hscTypecheckRename
        , hscDesugar
        , makeSimpleDetails
        , hscSimplify -- ToDo, shouldn't really export this

        -- * Safe Haskell
        , hscCheckSafe
        , hscGetSafe

        -- * Support for interactive evaluation
        , hscParseIdentifier
        , hscTcRcLookupName
        , hscTcRnGetInfo
        , hscIsGHCiMonad
        , hscGetModuleInterface
        , hscRnImportDecls
        , hscTcRnLookupRdrName
        , hscStmt, hscParseStmtWithLocation, hscStmtWithLocation, hscParsedStmt
        , hscDecls, hscParseDeclsWithLocation, hscDeclsWithLocation, hscParsedDecls
        , hscTcExpr, TcRnExprMode(..), hscImport, hscKcType
        , hscParseExpr
        , hscParseType
        , hscCompileCoreExpr
        -- * Low-level exports for hooks
        , hscCompileCoreExpr'
          -- We want to make sure that we export enough to be able to redefine
          -- hsc_typecheck in client code
        , hscParse', hscSimplify', hscDesugar', tcRnModule', doCodeGen
        , getHscEnv
        , hscSimpleIface'
        , oneShotMsg
        , dumpIfaceStats
        , ioMsgMaybe
        , showModuleIndex
        , hscAddSptEntries
        ) where

    import GHC.Prelude

    import GHC.Driver.Plugins
    import GHC.Driver.Session
    import GHC.Driver.Backend
    import GHC.Driver.Env
    import GHC.Driver.Errors
    import GHC.Driver.CodeOutput
    import GHC.Driver.Config
    import GHC.Driver.Hooks

    import GHC.Runtime.Context
    import GHC.Runtime.Interpreter ( addSptEntry, hscInterp )
    import GHC.Runtime.Loader      ( initializePlugins )
    import GHCi.RemoteTypes        ( ForeignHValue )
    import GHC.ByteCode.Types

    import GHC.Linker.Loader
    import GHC.Linker.Types

    import GHC.Hs
    import GHC.Hs.Dump
    import GHC.Hs.Stats         ( ppSourceStats )

    import GHC.HsToCore

    import GHC.StgToByteCode    ( byteCodeGen )

    import GHC.IfaceToCore  ( typecheckIface )

    import GHC.Iface.Load   ( ifaceStats, initExternalPackageState, writeIface )
    import GHC.Iface.Make
    import GHC.Iface.Recomp
    import GHC.Iface.Tidy
    import GHC.Iface.Ext.Ast    ( mkHieFile )
    import GHC.Iface.Ext.Types  ( getAsts, hie_asts, hie_module )
    import GHC.Iface.Ext.Binary ( readHieFile, writeHieFile , hie_file_result, NameCacheUpdater(..))
    import GHC.Iface.Ext.Debug  ( diffFile, validateScopes )
    import GHC.Iface.Env        ( updNameCache )

    import GHC.Core
    import GHC.Core.Tidy           ( tidyExpr )
    import GHC.Core.Type           ( Type, Kind )
    import GHC.Core.Lint           ( lintInteractiveExpr )
    import GHC.Core.Multiplicity
    import GHC.Core.Utils          ( exprType )
    import GHC.Core.ConLike
    import GHC.Core.Opt.Pipeline
    import GHC.Core.TyCon
    import GHC.Core.InstEnv
    import GHC.Core.FamInstEnv

    import GHC.CoreToStg.Prep
    import GHC.CoreToStg    ( coreToStg )

    import GHC.Parser.Errors
    import GHC.Parser.Errors.Ppr
    import GHC.Parser
    import GHC.Parser.Lexer as Lexer

    import GHC.Tc.Module
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Utils.Zonk    ( ZonkFlexi (DefaultFlexi) )

    import GHC.Stg.Syntax
    import GHC.Stg.FVs      ( annTopBindingsFreeVars )
    import GHC.Stg.Pipeline ( stg2stg )

    import GHC.Builtin.Utils
    import GHC.Builtin.Names
    import GHC.Builtin.Uniques ( mkPseudoUniqueE )

    import qualified GHC.StgToCmm as StgToCmm ( codeGen )
    import GHC.StgToCmm.Types (CgInfos (..), ModuleLFInfos)

    import GHC.Cmm
    import GHC.Cmm.Parser       ( parseCmmFile )
    import GHC.Cmm.Info.Build
    import GHC.Cmm.Pipeline
    import GHC.Cmm.Info

    import GHC.Unit
    import GHC.Unit.External
    import GHC.Unit.State
    import GHC.Unit.Module.ModDetails
    import GHC.Unit.Module.ModGuts
    import GHC.Unit.Module.ModIface
    import GHC.Unit.Module.ModSummary
    import GHC.Unit.Module.Graph
    import GHC.Unit.Module.Imported
    import GHC.Unit.Module.Deps
    import GHC.Unit.Module.Status
    import GHC.Unit.Home.ModInfo

    import GHC.Types.Id
    import GHC.Types.SourceError
    import GHC.Types.SafeHaskell
    import GHC.Types.ForeignStubs
    import GHC.Types.Var.Env       ( emptyTidyEnv )
    import GHC.Types.Error
    import GHC.Types.Fixity.Env
    import GHC.Types.CostCentre
    import GHC.Types.IPE
    import GHC.Types.Unique.Supply
    import GHC.Types.SourceFile
    import GHC.Types.SrcLoc
    import GHC.Types.Name
    import GHC.Types.Name.Env
    import GHC.Types.Name.Cache ( initNameCache )
    import GHC.Types.Name.Reader
    import GHC.Types.Name.Ppr
    import GHC.Types.TyThing
    import GHC.Types.HpcInfo

    import GHC.Utils.Fingerprint ( Fingerprint )
    import GHC.Utils.Panic
    import GHC.Utils.Error
    import GHC.Utils.Outputable
    import GHC.Utils.Exception
    import GHC.Utils.Misc
    import GHC.Utils.Logger
    import GHC.Utils.TmpFs

    import GHC.Data.FastString
    import GHC.Data.Bag
    import GHC.Data.StringBuffer
    import qualified GHC.Data.Stream as Stream
    import GHC.Data.Stream (Stream)

    import Data.Data hiding (Fixity, TyCon)
    import Data.List        ( nub, isPrefixOf, partition )
    import Control.Monad
    import Data.IORef
    import System.FilePath as FilePath
    import System.Directory
    import System.IO (fixIO)
    import qualified Data.Set as S
    import Data.Set (Set)
    import Data.Functor
    import Control.DeepSeq (force)
    import Data.Bifunctor (first, bimap)
    import GHC.Data.Maybe

    #include "HsVersions.h"

    {- **********************************************************************
    %*                                                                      *
                    Initialisation
    %*                                                                      *
    %********************************************************************* -}

    newHscEnv :: DynFlags -> IO HscEnv
    newHscEnv :: DynFlags -> IO HscEnv
    newHscEnv DynFlags
    dflags = do
        -- we don't store the unit databases and the unit state to still
        -- allow `setSessionDynFlags` to be used to set unit db flags.
        IORef ExternalPackageState
    eps_var <- ExternalPackageState -> IO (IORef ExternalPackageState)
    forall a. a -> IO (IORef a)
    newIORef ExternalPackageState
    initExternalPackageState
        UniqSupply
    us      <- Char -> IO UniqSupply
    mkSplitUniqSupply Char
    'r'
        IORef NameCache
    nc_var  <- NameCache -> IO (IORef NameCache)
    forall a. a -> IO (IORef a)
    newIORef (UniqSupply -> [Name] -> NameCache
    initNameCache UniqSupply
    us [Name]
    knownKeyNames)
        IORef (InstalledModuleEnv InstalledFindResult)
    fc_var  <- InstalledModuleEnv InstalledFindResult
    -> IO (IORef (InstalledModuleEnv InstalledFindResult))
    forall a. a -> IO (IORef a)
    newIORef InstalledModuleEnv InstalledFindResult
    forall a. InstalledModuleEnv a
    emptyInstalledModuleEnv
        Logger
    logger  <- IO Logger
    initLogger
        TmpFs
    tmpfs   <- IO TmpFs
    initTmpFs
        -- FIXME: it's sad that we have so many "unitialized" fields filled with
        -- empty stuff or lazy panics. We should have two kinds of HscEnv
        -- (initialized or not) instead and less fields that are mutable over time.
        HscEnv -> IO HscEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return HscEnv {  hsc_dflags :: DynFlags
    hsc_dflags         = DynFlags
    dflags
                      ,  hsc_logger :: Logger
    hsc_logger         = Logger
    logger
                      ,  hsc_targets :: [Target]
    hsc_targets        = []
                      ,  hsc_mod_graph :: ModuleGraph
    hsc_mod_graph      = ModuleGraph
    emptyMG
                      ,  hsc_IC :: InteractiveContext
    hsc_IC             = DynFlags -> InteractiveContext
    emptyInteractiveContext DynFlags
    dflags
                      ,  hsc_HPT :: HomePackageTable
    hsc_HPT            = HomePackageTable
    emptyHomePackageTable
                      ,  hsc_EPS :: IORef ExternalPackageState
    hsc_EPS            = IORef ExternalPackageState
    eps_var
                      ,  hsc_NC :: IORef NameCache
    hsc_NC             = IORef NameCache
    nc_var
                      ,  hsc_FC :: IORef (InstalledModuleEnv InstalledFindResult)
    hsc_FC             = IORef (InstalledModuleEnv InstalledFindResult)
    fc_var
                      ,  hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
    hsc_type_env_var   = Maybe (Module, IORef TypeEnv)
    forall a. Maybe a
    Nothing
                      ,  hsc_interp :: Maybe Interp
    hsc_interp         = Maybe Interp
    forall a. Maybe a
    Nothing
                      ,  hsc_unit_env :: UnitEnv
    hsc_unit_env       = [Char] -> UnitEnv
    forall a. [Char] -> a
    panic [Char]
    "hsc_unit_env not initialized"
                      ,  hsc_plugins :: [LoadedPlugin]
    hsc_plugins        = []
                      ,  hsc_static_plugins :: [StaticPlugin]
    hsc_static_plugins = []
                      ,  hsc_unit_dbs :: Maybe [UnitDatabase UnitId]
    hsc_unit_dbs       = Maybe [UnitDatabase UnitId]
    forall a. Maybe a
    Nothing
                      ,  hsc_hooks :: Hooks
    hsc_hooks          = Hooks
    emptyHooks
                      ,  hsc_tmpfs :: TmpFs
    hsc_tmpfs          = TmpFs
    tmpfs
                      }

    -- -----------------------------------------------------------------------------

    getWarnings :: Hsc WarningMessages
    getWarnings :: Hsc WarningMessages
    getWarnings = (HscEnv
     -> WarningMessages -> IO (WarningMessages, WarningMessages))
    -> Hsc WarningMessages
    forall a.
    (HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
    Hsc ((HscEnv
      -> WarningMessages -> IO (WarningMessages, WarningMessages))
     -> Hsc WarningMessages)
    -> (HscEnv
        -> WarningMessages -> IO (WarningMessages, WarningMessages))
    -> Hsc WarningMessages
    forall a b. (a -> b) -> a -> b
    $ \HscEnv
    _ WarningMessages
    w -> (WarningMessages, WarningMessages)
    -> IO (WarningMessages, WarningMessages)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WarningMessages
    w, WarningMessages
    w)

    clearWarnings :: Hsc ()
    clearWarnings :: Hsc ()
    clearWarnings = (HscEnv -> WarningMessages -> IO ((), WarningMessages)) -> Hsc ()
    forall a.
    (HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
    Hsc ((HscEnv -> WarningMessages -> IO ((), WarningMessages)) -> Hsc ())
    -> (HscEnv -> WarningMessages -> IO ((), WarningMessages))
    -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ \HscEnv
    _ WarningMessages
    _ -> ((), WarningMessages) -> IO ((), WarningMessages)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((), WarningMessages
    forall a. Bag a
    emptyBag)

    logWarnings :: WarningMessages -> Hsc ()
    logWarnings :: WarningMessages -> Hsc ()
    logWarnings WarningMessages
    w = (HscEnv -> WarningMessages -> IO ((), WarningMessages)) -> Hsc ()
    forall a.
    (HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
    Hsc ((HscEnv -> WarningMessages -> IO ((), WarningMessages)) -> Hsc ())
    -> (HscEnv -> WarningMessages -> IO ((), WarningMessages))
    -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ \HscEnv
    _ WarningMessages
    w0 -> ((), WarningMessages) -> IO ((), WarningMessages)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((), WarningMessages
    w0 WarningMessages -> WarningMessages -> WarningMessages
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` WarningMessages
    w)

    getHscEnv :: Hsc HscEnv
    getHscEnv :: Hsc HscEnv
    getHscEnv = (HscEnv -> WarningMessages -> IO (HscEnv, WarningMessages))
    -> Hsc HscEnv
    forall a.
    (HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
    Hsc ((HscEnv -> WarningMessages -> IO (HscEnv, WarningMessages))
     -> Hsc HscEnv)
    -> (HscEnv -> WarningMessages -> IO (HscEnv, WarningMessages))
    -> Hsc HscEnv
    forall a b. (a -> b) -> a -> b
    $ \HscEnv
    e WarningMessages
    w -> (HscEnv, WarningMessages) -> IO (HscEnv, WarningMessages)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HscEnv
    e, WarningMessages
    w)

    handleWarnings :: Hsc ()
    handleWarnings :: Hsc ()
    handleWarnings = do
        DynFlags
    dflags <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        Logger
    logger <- Hsc Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        WarningMessages
    w <- Hsc WarningMessages
    getWarnings
        IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> DynFlags -> WarningMessages -> IO ()
    printOrThrowWarnings Logger
    logger DynFlags
    dflags WarningMessages
    w
        Hsc ()
    clearWarnings

    -- | log warning in the monad, and if there are errors then
    -- throw a SourceError exception.
    logWarningsReportErrors :: (Bag PsWarning, Bag PsError) -> Hsc ()
    logWarningsReportErrors :: (Bag PsWarning, Bag PsError) -> Hsc ()
    logWarningsReportErrors (Bag PsWarning
    warnings,Bag PsError
    errors) = do
        let warns :: WarningMessages
    warns = (PsWarning -> MsgEnvelope DecoratedSDoc)
    -> Bag PsWarning -> WarningMessages
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PsWarning -> MsgEnvelope DecoratedSDoc
    pprWarning Bag PsWarning
    warnings
            errs :: WarningMessages
    errs  = (PsError -> MsgEnvelope DecoratedSDoc)
    -> Bag PsError -> WarningMessages
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PsError -> MsgEnvelope DecoratedSDoc
    pprError   Bag PsError
    errors
        WarningMessages -> Hsc ()
    logWarnings WarningMessages
    warns
        Bool -> Hsc () -> Hsc ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ WarningMessages -> Bool
    forall a. Bag a -> Bool
    isEmptyBag WarningMessages
    errs) (Hsc () -> Hsc ()) -> Hsc () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ WarningMessages -> Hsc ()
    forall (io :: * -> *) a. MonadIO io => WarningMessages -> io a
    throwErrors WarningMessages
    errs

    -- | Log warnings and throw errors, assuming the messages
    -- contain at least one error (e.g. coming from PFailed)
    handleWarningsThrowErrors :: (Bag PsWarning, Bag PsError) -> Hsc a
    handleWarningsThrowErrors :: forall a. (Bag PsWarning, Bag PsError) -> Hsc a
    handleWarningsThrowErrors (Bag PsWarning
    warnings, Bag PsError
    errors) = do
        let warns :: WarningMessages
    warns = (PsWarning -> MsgEnvelope DecoratedSDoc)
    -> Bag PsWarning -> WarningMessages
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PsWarning -> MsgEnvelope DecoratedSDoc
    pprWarning Bag PsWarning
    warnings
            errs :: WarningMessages
    errs  = (PsError -> MsgEnvelope DecoratedSDoc)
    -> Bag PsError -> WarningMessages
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PsError -> MsgEnvelope DecoratedSDoc
    pprError   Bag PsError
    errors
        WarningMessages -> Hsc ()
    logWarnings WarningMessages
    warns
        DynFlags
    dflags <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        Logger
    logger <- Hsc Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        (WarningMessages
    wWarns, WarningMessages
    wErrs) <- DynFlags -> WarningMessages -> (WarningMessages, WarningMessages)
    warningsToMessages DynFlags
    dflags (WarningMessages -> (WarningMessages, WarningMessages))
    -> Hsc WarningMessages -> Hsc (WarningMessages, WarningMessages)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Hsc WarningMessages
    getWarnings
        IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> DynFlags -> WarningMessages -> IO ()
    forall a.
    RenderableDiagnostic a =>
    Logger -> DynFlags -> Bag (MsgEnvelope a) -> IO ()
    printBagOfErrors Logger
    logger DynFlags
    dflags WarningMessages
    wWarns
        WarningMessages -> Hsc a
    forall (io :: * -> *) a. MonadIO io => WarningMessages -> io a
    throwErrors (WarningMessages -> WarningMessages -> WarningMessages
    forall a. Bag a -> Bag a -> Bag a
    unionBags WarningMessages
    errs WarningMessages
    wErrs)

    -- | Deal with errors and warnings returned by a compilation step
    --
    -- In order to reduce dependencies to other parts of the compiler, functions
    -- outside the "main" parts of GHC return warnings and errors as a parameter
    -- and signal success via by wrapping the result in a 'Maybe' type. This
    -- function logs the returned warnings and propagates errors as exceptions
    -- (of type 'SourceError').
    --
    -- This function assumes the following invariants:
    --
    --  1. If the second result indicates success (is of the form 'Just x'),
    --     there must be no error messages in the first result.
    --
    --  2. If there are no error messages, but the second result indicates failure
    --     there should be warnings in the first result. That is, if the action
    --     failed, it must have been due to the warnings (i.e., @-Werror@).
    ioMsgMaybe :: IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe :: forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe IO (Messages DecoratedSDoc, Maybe a)
    ioA = do
        (Messages DecoratedSDoc
    msgs, Maybe a
    mb_r) <- IO (Messages DecoratedSDoc, Maybe a)
    -> Hsc (Messages DecoratedSDoc, Maybe a)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO (Messages DecoratedSDoc, Maybe a)
    ioA
        let (WarningMessages
    warns, WarningMessages
    errs) = Messages DecoratedSDoc -> (WarningMessages, WarningMessages)
    forall e. Messages e -> (Bag (MsgEnvelope e), Bag (MsgEnvelope e))
    partitionMessages Messages DecoratedSDoc
    msgs
        WarningMessages -> Hsc ()
    logWarnings WarningMessages
    warns
        case Maybe a
    mb_r of
            Maybe a
    Nothing -> WarningMessages -> Hsc a
    forall (io :: * -> *) a. MonadIO io => WarningMessages -> io a
    throwErrors WarningMessages
    errs
            Just a
    r  -> ASSERT( isEmptyBag errs ) return r

    -- | like ioMsgMaybe, except that we ignore error messages and return
    -- 'Nothing' instead.
    ioMsgMaybe' :: IO (Messages DecoratedSDoc, Maybe a) -> Hsc (Maybe a)
    ioMsgMaybe' :: forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc (Maybe a)
    ioMsgMaybe' IO (Messages DecoratedSDoc, Maybe a)
    ioA = do
        (Messages DecoratedSDoc
    msgs, Maybe a
    mb_r) <- IO (Messages DecoratedSDoc, Maybe a)
    -> Hsc (Messages DecoratedSDoc, Maybe a)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Messages DecoratedSDoc, Maybe a)
     -> Hsc (Messages DecoratedSDoc, Maybe a))
    -> IO (Messages DecoratedSDoc, Maybe a)
    -> Hsc (Messages DecoratedSDoc, Maybe a)
    forall a b. (a -> b) -> a -> b
    $ IO (Messages DecoratedSDoc, Maybe a)
    ioA
        WarningMessages -> Hsc ()
    logWarnings (Messages DecoratedSDoc -> WarningMessages
    forall e. Messages e -> Bag (MsgEnvelope e)
    getWarningMessages Messages DecoratedSDoc
    msgs)
        Maybe a -> Hsc (Maybe a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    mb_r

    -- -----------------------------------------------------------------------------
    -- | Lookup things in the compiler's environment

    hscTcRnLookupRdrName :: HscEnv -> LocatedN RdrName -> IO [Name]
    hscTcRnLookupRdrName :: HscEnv -> LocatedN RdrName -> IO [Name]
    hscTcRnLookupRdrName HscEnv
    hsc_env0 LocatedN RdrName
    rdr_name
      = HscEnv -> Hsc [Name] -> IO [Name]
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env0 (Hsc [Name] -> IO [Name]) -> Hsc [Name] -> IO [Name]
    forall a b. (a -> b) -> a -> b
    $
        do { HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
           ; IO (Messages DecoratedSDoc, Maybe [Name]) -> Hsc [Name]
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages DecoratedSDoc, Maybe [Name]) -> Hsc [Name])
    -> IO (Messages DecoratedSDoc, Maybe [Name]) -> Hsc [Name]
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> LocatedN RdrName -> IO (Messages DecoratedSDoc, Maybe [Name])
    tcRnLookupRdrName HscEnv
    hsc_env LocatedN RdrName
    rdr_name }

    hscTcRcLookupName :: HscEnv -> Name -> IO (Maybe TyThing)
    hscTcRcLookupName :: HscEnv -> Name -> IO (Maybe TyThing)
    hscTcRcLookupName HscEnv
    hsc_env0 Name
    name = HscEnv -> Hsc (Maybe TyThing) -> IO (Maybe TyThing)
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env0 (Hsc (Maybe TyThing) -> IO (Maybe TyThing))
    -> Hsc (Maybe TyThing) -> IO (Maybe TyThing)
    forall a b. (a -> b) -> a -> b
    $ do
      HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
      IO (Messages DecoratedSDoc, Maybe TyThing) -> Hsc (Maybe TyThing)
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc (Maybe a)
    ioMsgMaybe' (IO (Messages DecoratedSDoc, Maybe TyThing) -> Hsc (Maybe TyThing))
    -> IO (Messages DecoratedSDoc, Maybe TyThing)
    -> Hsc (Maybe TyThing)
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> Name -> IO (Messages DecoratedSDoc, Maybe TyThing)
    tcRnLookupName HscEnv
    hsc_env Name
    name
          -- ignore errors: the only error we're likely to get is
          -- "name not found", and the Maybe in the return type
          -- is used to indicate that.

    hscTcRnGetInfo :: HscEnv -> Name
                   -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    hscTcRnGetInfo :: HscEnv
    -> Name -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    hscTcRnGetInfo HscEnv
    hsc_env0 Name
    name
      = HscEnv
    -> Hsc (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env0 (Hsc (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
     -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)))
    -> Hsc (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    forall a b. (a -> b) -> a -> b
    $
        do { HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
           ; IO
      (Messages DecoratedSDoc,
       Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    -> Hsc (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc (Maybe a)
    ioMsgMaybe' (IO
       (Messages DecoratedSDoc,
        Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
     -> Hsc (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc)))
    -> IO
         (Messages DecoratedSDoc,
          Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    -> Hsc (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> Name
    -> IO
         (Messages DecoratedSDoc,
          Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
    tcRnGetInfo HscEnv
    hsc_env Name
    name }

    hscIsGHCiMonad :: HscEnv -> String -> IO Name
    hscIsGHCiMonad :: HscEnv -> [Char] -> IO Name
    hscIsGHCiMonad HscEnv
    hsc_env [Char]
    name
      = HscEnv -> Hsc Name -> IO Name
    forall a. HscEnv -> Hsc a -> IO a
    runHsc HscEnv
    hsc_env (Hsc Name -> IO Name) -> Hsc Name -> IO Name
    forall a b. (a -> b) -> a -> b
    $ IO (Messages DecoratedSDoc, Maybe Name) -> Hsc Name
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages DecoratedSDoc, Maybe Name) -> Hsc Name)
    -> IO (Messages DecoratedSDoc, Maybe Name) -> Hsc Name
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> [Char] -> IO (Messages DecoratedSDoc, Maybe Name)
    isGHCiMonad HscEnv
    hsc_env [Char]
    name

    hscGetModuleInterface :: HscEnv -> Module -> IO ModIface
    hscGetModuleInterface :: HscEnv -> Module -> IO ModIface
    hscGetModuleInterface HscEnv
    hsc_env0 Module
    mod = HscEnv -> Hsc ModIface -> IO ModIface
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env0 (Hsc ModIface -> IO ModIface) -> Hsc ModIface -> IO ModIface
    forall a b. (a -> b) -> a -> b
    $ do
      HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
      IO (Messages DecoratedSDoc, Maybe ModIface) -> Hsc ModIface
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages DecoratedSDoc, Maybe ModIface) -> Hsc ModIface)
    -> IO (Messages DecoratedSDoc, Maybe ModIface) -> Hsc ModIface
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> Module -> IO (Messages DecoratedSDoc, Maybe ModIface)
    getModuleInterface HscEnv
    hsc_env Module
    mod

    -- -----------------------------------------------------------------------------
    -- | Rename some import declarations
    hscRnImportDecls :: HscEnv -> [LImportDecl GhcPs] -> IO GlobalRdrEnv
    hscRnImportDecls :: HscEnv -> [LImportDecl GhcPs] -> IO GlobalRdrEnv
    hscRnImportDecls HscEnv
    hsc_env0 [LImportDecl GhcPs]
    import_decls = HscEnv -> Hsc GlobalRdrEnv -> IO GlobalRdrEnv
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env0 (Hsc GlobalRdrEnv -> IO GlobalRdrEnv)
    -> Hsc GlobalRdrEnv -> IO GlobalRdrEnv
    forall a b. (a -> b) -> a -> b
    $ do
      HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
      IO (Messages DecoratedSDoc, Maybe GlobalRdrEnv) -> Hsc GlobalRdrEnv
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages DecoratedSDoc, Maybe GlobalRdrEnv)
     -> Hsc GlobalRdrEnv)
    -> IO (Messages DecoratedSDoc, Maybe GlobalRdrEnv)
    -> Hsc GlobalRdrEnv
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> [LImportDecl GhcPs]
    -> IO (Messages DecoratedSDoc, Maybe GlobalRdrEnv)
    tcRnImportDecls HscEnv
    hsc_env [LImportDecl GhcPs]
    import_decls

    -- -----------------------------------------------------------------------------
    -- | parse a file, returning the abstract syntax

    hscParse :: HscEnv -> ModSummary -> IO HsParsedModule
    hscParse :: HscEnv -> ModSummary -> IO HsParsedModule
    hscParse HscEnv
    hsc_env ModSummary
    mod_summary = HscEnv -> Hsc HsParsedModule -> IO HsParsedModule
    forall a. HscEnv -> Hsc a -> IO a
    runHsc HscEnv
    hsc_env (Hsc HsParsedModule -> IO HsParsedModule)
    -> Hsc HsParsedModule -> IO HsParsedModule
    forall a b. (a -> b) -> a -> b
    $ ModSummary -> Hsc HsParsedModule
    hscParse' ModSummary
    mod_summary

    -- internal version, that doesn't fail due to -Werror
    hscParse' :: ModSummary -> Hsc HsParsedModule
    hscParse' :: ModSummary -> Hsc HsParsedModule
    hscParse' ModSummary
    mod_summary
     | Just HsParsedModule
    r <- ModSummary -> Maybe HsParsedModule
    ms_parsed_mod ModSummary
    mod_summary = HsParsedModule -> Hsc HsParsedModule
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsParsedModule
    r
     | Bool
    otherwise = do
        DynFlags
    dflags <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        Logger
    logger <- Hsc Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        {-# SCC "Parser" #-} Logger
    -> DynFlags
    -> SDoc
    -> (HsParsedModule -> ())
    -> Hsc HsParsedModule
    -> Hsc HsParsedModule
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> DynFlags -> SDoc -> (a -> ()) -> m a -> m a
    withTiming Logger
    logger DynFlags
    dflags
                    ([Char] -> SDoc
    text [Char]
    "Parser"SDoc -> SDoc -> SDoc
    <+>SDoc -> SDoc
    brackets (Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Module -> SDoc) -> Module -> SDoc
    forall a b. (a -> b) -> a -> b
    $ ModSummary -> Module
    ms_mod ModSummary
    mod_summary))
                    (() -> HsParsedModule -> ()
    forall a b. a -> b -> a
    const ()) (Hsc HsParsedModule -> Hsc HsParsedModule)
    -> Hsc HsParsedModule -> Hsc HsParsedModule
    forall a b. (a -> b) -> a -> b
    $ do
        let src_filename :: [Char]
    src_filename  = ModSummary -> [Char]
    ms_hspp_file ModSummary
    mod_summary
            maybe_src_buf :: Maybe StringBuffer
    maybe_src_buf = ModSummary -> Maybe StringBuffer
    ms_hspp_buf  ModSummary
    mod_summary

        --------------------------  Parser  ----------------
        -- sometimes we already have the buffer in memory, perhaps
        -- because we needed to parse the imports out of it, or get the
        -- module name.
        StringBuffer
    buf <- case Maybe StringBuffer
    maybe_src_buf of
                   Just StringBuffer
    b  -> StringBuffer -> Hsc StringBuffer
    forall (m :: * -> *) a. Monad m => a -> m a
    return StringBuffer
    b
                   Maybe StringBuffer
    Nothing -> IO StringBuffer -> Hsc StringBuffer
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO StringBuffer -> Hsc StringBuffer)
    -> IO StringBuffer -> Hsc StringBuffer
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO StringBuffer
    hGetStringBuffer [Char]
    src_filename

        let loc :: RealSrcLoc
    loc = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc ([Char] -> FastString
    mkFastString [Char]
    src_filename) Int
    1 Int
    1
        let parseMod :: P (Located HsModule)
    parseMod | HscSource
    HsigFile HscSource -> HscSource -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModSummary -> HscSource
    ms_hsc_src ModSummary
    mod_summary
                     = P (Located HsModule)
    parseSignature
                     | Bool
    otherwise = P (Located HsModule)
    parseModule

        case P (Located HsModule) -> PState -> ParseResult (Located HsModule)
    forall a. P a -> PState -> ParseResult a
    unP P (Located HsModule)
    parseMod (ParserOpts -> StringBuffer -> RealSrcLoc -> PState
    initParserState (DynFlags -> ParserOpts
    initParserOpts DynFlags
    dflags) StringBuffer
    buf RealSrcLoc
    loc) of
            PFailed PState
    pst ->
                (Bag PsWarning, Bag PsError) -> Hsc HsParsedModule
    forall a. (Bag PsWarning, Bag PsError) -> Hsc a
    handleWarningsThrowErrors (PState -> (Bag PsWarning, Bag PsError)
    getMessages PState
    pst)
            POk PState
    pst Located HsModule
    rdr_module -> do
                let (WarningMessages
    warns, WarningMessages
    errs) = (Bag PsWarning -> WarningMessages)
    -> (Bag PsError -> WarningMessages)
    -> (Bag PsWarning, Bag PsError)
    -> (WarningMessages, WarningMessages)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap ((PsWarning -> MsgEnvelope DecoratedSDoc)
    -> Bag PsWarning -> WarningMessages
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PsWarning -> MsgEnvelope DecoratedSDoc
    pprWarning) ((PsError -> MsgEnvelope DecoratedSDoc)
    -> Bag PsError -> WarningMessages
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PsError -> MsgEnvelope DecoratedSDoc
    pprError) (PState -> (Bag PsWarning, Bag PsError)
    getMessages PState
    pst)
                WarningMessages -> Hsc ()
    logWarnings WarningMessages
    warns
                IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_parsed [Char]
    "Parser"
                            DumpFormat
    FormatHaskell (Located HsModule -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Located HsModule
    rdr_module)
                IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_parsed_ast [Char]
    "Parser AST"
                            DumpFormat
    FormatHaskell (BlankSrcSpan -> BlankEpAnnotations -> Located HsModule -> SDoc
    forall a. Data a => BlankSrcSpan -> BlankEpAnnotations -> a -> SDoc
    showAstData BlankSrcSpan
    NoBlankSrcSpan
                                                       BlankEpAnnotations
    NoBlankEpAnnotations
                                                       Located HsModule
    rdr_module)
                IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_source_stats [Char]
    "Source Statistics"
                            DumpFormat
    FormatText (Bool -> Located HsModule -> SDoc
    ppSourceStats Bool
    False Located HsModule
    rdr_module)
                Bool -> Hsc () -> Hsc ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ WarningMessages -> Bool
    forall a. Bag a -> Bool
    isEmptyBag WarningMessages
    errs) (Hsc () -> Hsc ()) -> Hsc () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ WarningMessages -> Hsc ()
    forall (io :: * -> *) a. MonadIO io => WarningMessages -> io a
    throwErrors WarningMessages
    errs

                -- To get the list of extra source files, we take the list
                -- that the parser gave us,
                --   - eliminate files beginning with '<'.  gcc likes to use
                --     pseudo-filenames like "<built-in>" and "<command-line>"
                --   - normalise them (eliminate differences between ./f and f)
                --   - filter out the preprocessed source file
                --   - filter out anything beginning with tmpdir
                --   - remove duplicates
                --   - filter out the .hs/.lhs source filename if we have one
                --
                let n_hspp :: [Char]
    n_hspp  = [Char] -> [Char]
    FilePath.normalise [Char]
    src_filename
                    srcs0 :: [[Char]]
    srcs0 = [[Char]] -> [[Char]]
    forall a. Eq a => [a] -> [a]
    nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> Bool) -> [[Char]] -> [[Char]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (DynFlags -> [Char]
    tmpDir DynFlags
    dflags [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`))
                                ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> Bool) -> [[Char]] -> [[Char]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    n_hspp))
                                ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map [Char] -> [Char]
    FilePath.normalise
                                ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> Bool) -> [[Char]] -> [[Char]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf [Char]
    "<")
                                ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ (FastString -> [Char]) -> [FastString] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map FastString -> [Char]
    unpackFS
                                ([FastString] -> [[Char]]) -> [FastString] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ PState -> [FastString]
    srcfiles PState
    pst
                    srcs1 :: [[Char]]
    srcs1 = case ModLocation -> Maybe [Char]
    ml_hs_file (ModSummary -> ModLocation
    ms_location ModSummary
    mod_summary) of
                              Just [Char]
    f  -> ([Char] -> Bool) -> [[Char]] -> [[Char]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ([Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Char] -> [Char]
    FilePath.normalise [Char]
    f) [[Char]]
    srcs0
                              Maybe [Char]
    Nothing -> [[Char]]
    srcs0

                -- sometimes we see source files from earlier
                -- preprocessing stages that cannot be found, so just
                -- filter them out:
                [[Char]]
    srcs2 <- IO [[Char]] -> Hsc [[Char]]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [[Char]] -> Hsc [[Char]]) -> IO [[Char]] -> Hsc [[Char]]
    forall a b. (a -> b) -> a -> b
    $ ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM [Char] -> IO Bool
    doesFileExist [[Char]]
    srcs1

                let res :: HsParsedModule
    res = HsParsedModule {
                          hpm_module :: Located HsModule
    hpm_module    = Located HsModule
    rdr_module,
                          hpm_src_files :: [[Char]]
    hpm_src_files = [[Char]]
    srcs2
                       }

                -- apply parse transformation of plugins
                let applyPluginAction :: Plugin -> [[Char]] -> HsParsedModule -> Hsc HsParsedModule
    applyPluginAction Plugin
    p [[Char]]
    opts
                      = Plugin
    -> [[Char]] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule
    parsedResultAction Plugin
    p [[Char]]
    opts ModSummary
    mod_summary
                HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
                HscEnv
    -> (Plugin -> [[Char]] -> HsParsedModule -> Hsc HsParsedModule)
    -> HsParsedModule
    -> Hsc HsParsedModule
    forall (m :: * -> *) a.
    Monad m =>
    HscEnv -> PluginOperation m a -> a -> m a
    withPlugins HscEnv
    hsc_env Plugin -> [[Char]] -> HsParsedModule -> Hsc HsParsedModule
    applyPluginAction HsParsedModule
    res

    -- -----------------------------------------------------------------------------
    -- | If the renamed source has been kept, extract it. Dump it if requested.
    extract_renamed_stuff :: ModSummary -> TcGblEnv -> Hsc RenamedStuff
    extract_renamed_stuff :: ModSummary -> TcGblEnv -> Hsc RenamedStuff
    extract_renamed_stuff ModSummary
    mod_summary TcGblEnv
    tc_result = do
        let rn_info :: RenamedStuff
    rn_info = TcGblEnv -> RenamedStuff
    getRenamedStuff TcGblEnv
    tc_result

        DynFlags
    dflags <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        Logger
    logger <- Hsc Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_rn_ast [Char]
    "Renamer"
                    DumpFormat
    FormatHaskell (BlankSrcSpan
    -> BlankEpAnnotations
    -> Maybe
         (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
          Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
          Maybe LHsDocString)
    -> SDoc
    forall a. Data a => BlankSrcSpan -> BlankEpAnnotations -> a -> SDoc
    showAstData BlankSrcSpan
    NoBlankSrcSpan BlankEpAnnotations
    NoBlankEpAnnotations Maybe
      (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
       Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
       Maybe LHsDocString)
    RenamedStuff
    rn_info)

        -- Create HIE files
        Bool -> Hsc () -> Hsc ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_WriteHie DynFlags
    dflags) (Hsc () -> Hsc ()) -> Hsc () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ do
            -- I assume this fromJust is safe because `-fwrite-hie-file`
            -- enables the option which keeps the renamed source.
            HieFile
    hieFile <- ModSummary -> TcGblEnv -> RenamedSource -> Hsc HieFile
    mkHieFile ModSummary
    mod_summary TcGblEnv
    tc_result (Maybe
      (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
       Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
       Maybe LHsDocString)
    -> (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
        Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
        Maybe LHsDocString)
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe
      (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
       Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
       Maybe LHsDocString)
    RenamedStuff
    rn_info)
            let out_file :: [Char]
    out_file = ModLocation -> [Char]
    ml_hie_file (ModLocation -> [Char]) -> ModLocation -> [Char]
    forall a b. (a -> b) -> a -> b
    $ ModSummary -> ModLocation
    ms_location ModSummary
    mod_summary
            IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> HieFile -> IO ()
    writeHieFile [Char]
    out_file HieFile
    hieFile
            IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_hie [Char]
    "HIE AST" DumpFormat
    FormatHaskell (HieASTs Int -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (HieASTs Int -> SDoc) -> HieASTs Int -> SDoc
    forall a b. (a -> b) -> a -> b
    $ HieFile -> HieASTs Int
    hie_asts HieFile
    hieFile)

            -- Validate HIE files
            Bool -> Hsc () -> Hsc ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_ValidateHie DynFlags
    dflags) (Hsc () -> Hsc ()) -> Hsc () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ do
                HscEnv
    hs_env <- (HscEnv -> WarningMessages -> IO (HscEnv, WarningMessages))
    -> Hsc HscEnv
    forall a.
    (HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
    Hsc ((HscEnv -> WarningMessages -> IO (HscEnv, WarningMessages))
     -> Hsc HscEnv)
    -> (HscEnv -> WarningMessages -> IO (HscEnv, WarningMessages))
    -> Hsc HscEnv
    forall a b. (a -> b) -> a -> b
    $ \HscEnv
    e WarningMessages
    w -> (HscEnv, WarningMessages) -> IO (HscEnv, WarningMessages)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HscEnv
    e, WarningMessages
    w)
                IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ do
                  -- Validate Scopes
                  case Module -> Map HiePath (HieAST Int) -> [SDoc]
    forall a. Module -> Map HiePath (HieAST a) -> [SDoc]
    validateScopes (HieFile -> Module
    hie_module HieFile
    hieFile) (Map HiePath (HieAST Int) -> [SDoc])
    -> Map HiePath (HieAST Int) -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ HieASTs Int -> Map HiePath (HieAST Int)
    forall a. HieASTs a -> Map HiePath (HieAST a)
    getAsts (HieASTs Int -> Map HiePath (HieAST Int))
    -> HieASTs Int -> Map HiePath (HieAST Int)
    forall a b. (a -> b) -> a -> b
    $ HieFile -> HieASTs Int
    hie_asts HieFile
    hieFile of
                      [] -> Logger -> DynFlags -> SDoc -> IO ()
    putMsg Logger
    logger DynFlags
    dflags (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> SDoc
    text [Char]
    "Got valid scopes"
                      [SDoc]
    xs -> do
                        Logger -> DynFlags -> SDoc -> IO ()
    putMsg Logger
    logger DynFlags
    dflags (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> SDoc
    text [Char]
    "Got invalid scopes"
                        (SDoc -> IO ()) -> [SDoc] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Logger -> DynFlags -> SDoc -> IO ()
    putMsg Logger
    logger DynFlags
    dflags) [SDoc]
    xs
                  -- Roundtrip testing
                  HieFileResult
    file' <- NameCacheUpdater -> [Char] -> IO HieFileResult
    readHieFile ((forall c. (NameCache -> (NameCache, c)) -> IO c)
    -> NameCacheUpdater
    NCU ((forall c. (NameCache -> (NameCache, c)) -> IO c)
     -> NameCacheUpdater)
    -> (forall c. (NameCache -> (NameCache, c)) -> IO c)
    -> NameCacheUpdater
    forall a b. (a -> b) -> a -> b
    $ IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
    forall c. IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
    updNameCache (IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c)
    -> IORef NameCache -> (NameCache -> (NameCache, c)) -> IO c
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> IORef NameCache
    hsc_NC HscEnv
    hs_env) [Char]
    out_file
                  case Diff HieFile
    diffFile HieFile
    hieFile (HieFileResult -> HieFile
    hie_file_result HieFileResult
    file') of
                    [] ->
                      Logger -> DynFlags -> SDoc -> IO ()
    putMsg Logger
    logger DynFlags
    dflags (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> SDoc
    text [Char]
    "Got no roundtrip errors"
                    [SDoc]
    xs -> do
                      Logger -> DynFlags -> SDoc -> IO ()
    putMsg Logger
    logger DynFlags
    dflags (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> SDoc
    text [Char]
    "Got roundtrip errors"
                      (SDoc -> IO ()) -> [SDoc] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Logger -> DynFlags -> SDoc -> IO ()
    putMsg Logger
    logger (DynFlags -> DumpFlag -> DynFlags
    dopt_set DynFlags
    dflags DumpFlag
    Opt_D_ppr_debug)) [SDoc]
    xs
        Maybe
      (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
       Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
       Maybe LHsDocString)
    -> Hsc
         (Maybe
            (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
             Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
             Maybe LHsDocString))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe
      (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
       Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
       Maybe LHsDocString)
    RenamedStuff
    rn_info

    -- -----------------------------------------------------------------------------
    -- | Rename and typecheck a module, additionally returning the renamed syntax
    hscTypecheckRename :: HscEnv -> ModSummary -> HsParsedModule
                       -> IO (TcGblEnv, RenamedStuff)
    hscTypecheckRename :: HscEnv
    -> ModSummary -> HsParsedModule -> IO (TcGblEnv, RenamedStuff)
    hscTypecheckRename HscEnv
    hsc_env ModSummary
    mod_summary HsParsedModule
    rdr_module = HscEnv
    -> Hsc (TcGblEnv, RenamedStuff) -> IO (TcGblEnv, RenamedStuff)
    forall a. HscEnv -> Hsc a -> IO a
    runHsc HscEnv
    hsc_env (Hsc (TcGblEnv, RenamedStuff) -> IO (TcGblEnv, RenamedStuff))
    -> Hsc (TcGblEnv, RenamedStuff) -> IO (TcGblEnv, RenamedStuff)
    forall a b. (a -> b) -> a -> b
    $
        Bool
    -> ModSummary
    -> Maybe HsParsedModule
    -> Hsc (TcGblEnv, RenamedStuff)
    hsc_typecheck Bool
    True ModSummary
    mod_summary (HsParsedModule -> Maybe HsParsedModule
    forall a. a -> Maybe a
    Just HsParsedModule
    rdr_module)

    -- | A bunch of logic piled around @tcRnModule'@, concerning a) backpack
    -- b) concerning dumping rename info and hie files. It would be nice to further
    -- separate this stuff out, probably in conjunction better separating renaming
    -- and type checking (#17781).
    hsc_typecheck :: Bool -- ^ Keep renamed source?
                  -> ModSummary -> Maybe HsParsedModule
                  -> Hsc (TcGblEnv, RenamedStuff)
    hsc_typecheck :: Bool
    -> ModSummary
    -> Maybe HsParsedModule
    -> Hsc (TcGblEnv, RenamedStuff)
    hsc_typecheck Bool
    keep_rn ModSummary
    mod_summary Maybe HsParsedModule
    mb_rdr_module = do
        HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
        let hsc_src :: HscSource
    hsc_src = ModSummary -> HscSource
    ms_hsc_src ModSummary
    mod_summary
            dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
            home_unit :: HomeUnit
    home_unit = HscEnv -> HomeUnit
    hsc_home_unit HscEnv
    hsc_env
            outer_mod :: Module
    outer_mod = ModSummary -> Module
    ms_mod ModSummary
    mod_summary
            mod_name :: ModuleName
    mod_name = Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    outer_mod
            outer_mod' :: Module
    outer_mod' = HomeUnit -> ModuleName -> Module
    mkHomeModule HomeUnit
    home_unit ModuleName
    mod_name
            inner_mod :: Module
    inner_mod = HomeUnit -> ModuleName -> Module
    homeModuleNameInstantiation HomeUnit
    home_unit ModuleName
    mod_name
            src_filename :: [Char]
    src_filename  = ModSummary -> [Char]
    ms_hspp_file ModSummary
    mod_summary
            real_loc :: RealSrcSpan
    real_loc = RealSrcLoc -> RealSrcSpan
    realSrcLocSpan (RealSrcLoc -> RealSrcSpan) -> RealSrcLoc -> RealSrcSpan
    forall a b. (a -> b) -> a -> b
    $ FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc ([Char] -> FastString
    mkFastString [Char]
    src_filename) Int
    1 Int
    1
            keep_rn' :: Bool
    keep_rn' = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_WriteHie DynFlags
    dflags Bool -> Bool -> Bool
    || Bool
    keep_rn
        MASSERT( isHomeModule home_unit outer_mod )
        TcGblEnv
    tc_result <- if HscSource
    hsc_src HscSource -> HscSource -> Bool
    forall a. Eq a => a -> a -> Bool
    == HscSource
    HsigFile Bool -> Bool -> Bool
    && Bool -> Bool
    not (Module -> Bool
    forall u. GenModule (GenUnit u) -> Bool
    isHoleModule Module
    inner_mod)
            then IO (Messages DecoratedSDoc, Maybe TcGblEnv) -> Hsc TcGblEnv
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages DecoratedSDoc, Maybe TcGblEnv) -> Hsc TcGblEnv)
    -> IO (Messages DecoratedSDoc, Maybe TcGblEnv) -> Hsc TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> Module
    -> RealSrcSpan
    -> IO (Messages DecoratedSDoc, Maybe TcGblEnv)
    tcRnInstantiateSignature HscEnv
    hsc_env Module
    outer_mod' RealSrcSpan
    real_loc
            else
             do HsParsedModule
    hpm <- case Maybe HsParsedModule
    mb_rdr_module of
                        Just HsParsedModule
    hpm -> HsParsedModule -> Hsc HsParsedModule
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsParsedModule
    hpm
                        Maybe HsParsedModule
    Nothing -> ModSummary -> Hsc HsParsedModule
    hscParse' ModSummary
    mod_summary
                TcGblEnv
    tc_result0 <- ModSummary -> Bool -> HsParsedModule -> Hsc TcGblEnv
    tcRnModule' ModSummary
    mod_summary Bool
    keep_rn' HsParsedModule
    hpm
                if HscSource
    hsc_src HscSource -> HscSource -> Bool
    forall a. Eq a => a -> a -> Bool
    == HscSource
    HsigFile
                    then do (ModIface
    iface, Maybe Fingerprint
    _, ModDetails
    _) <- IO (ModIface, Maybe Fingerprint, ModDetails)
    -> Hsc (ModIface, Maybe Fingerprint, ModDetails)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ModIface, Maybe Fingerprint, ModDetails)
     -> Hsc (ModIface, Maybe Fingerprint, ModDetails))
    -> IO (ModIface, Maybe Fingerprint, ModDetails)
    -> Hsc (ModIface, Maybe Fingerprint, ModDetails)
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> TcGblEnv
    -> Maybe Fingerprint
    -> IO (ModIface, Maybe Fingerprint, ModDetails)
    hscSimpleIface HscEnv
    hsc_env TcGblEnv
    tc_result0 Maybe Fingerprint
    forall a. Maybe a
    Nothing
                            IO (Messages DecoratedSDoc, Maybe TcGblEnv) -> Hsc TcGblEnv
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages DecoratedSDoc, Maybe TcGblEnv) -> Hsc TcGblEnv)
    -> IO (Messages DecoratedSDoc, Maybe TcGblEnv) -> Hsc TcGblEnv
    forall a b. (a -> b) -> a -> b
    $
                                HscEnv
    -> HsParsedModule
    -> TcGblEnv
    -> ModIface
    -> IO (Messages DecoratedSDoc, Maybe TcGblEnv)
    tcRnMergeSignatures HscEnv
    hsc_env HsParsedModule
    hpm TcGblEnv
    tc_result0 ModIface
    iface
                    else TcGblEnv -> Hsc TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tc_result0
        -- TODO are we extracting anything when we merely instantiate a signature?
        -- If not, try to move this into the "else" case above.
        Maybe
      (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
       Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
       Maybe LHsDocString)
    rn_info <- ModSummary -> TcGblEnv -> Hsc RenamedStuff
    extract_renamed_stuff ModSummary
    mod_summary TcGblEnv
    tc_result
        (TcGblEnv,
     Maybe
       (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
        Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
        Maybe LHsDocString))
    -> Hsc
         (TcGblEnv,
          Maybe
            (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
             Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
             Maybe LHsDocString))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv
    tc_result, Maybe
      (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
       Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
       Maybe LHsDocString)
    rn_info)

    -- wrapper around tcRnModule to handle safe haskell extras
    tcRnModule' :: ModSummary -> Bool -> HsParsedModule
                -> Hsc TcGblEnv
    tcRnModule' :: ModSummary -> Bool -> HsParsedModule -> Hsc TcGblEnv
    tcRnModule' ModSummary
    sum Bool
    save_rn_syntax HsParsedModule
    mod = do
        HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
        DynFlags
    dflags   <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags

        -- -Wmissing-safe-haskell-mode
        Bool -> Hsc () -> Hsc ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (DynFlags -> Bool
    safeHaskellModeEnabled DynFlags
    dflags)
              Bool -> Bool -> Bool
    && WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnMissingSafeHaskellMode DynFlags
    dflags) (Hsc () -> Hsc ()) -> Hsc () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $
            WarningMessages -> Hsc ()
    logWarnings (WarningMessages -> Hsc ()) -> WarningMessages -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a. a -> Bag a
    unitBag (MsgEnvelope DecoratedSDoc -> WarningMessages)
    -> MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a b. (a -> b) -> a -> b
    $
            WarnReason
    -> MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc
    forall e. WarnReason -> MsgEnvelope e -> MsgEnvelope e
    makeIntoWarning (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnMissingSafeHaskellMode) (MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc)
    -> MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
            SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainWarnMsg (Located HsModule -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc (HsParsedModule -> Located HsModule
    hpm_module HsParsedModule
    mod)) (SDoc -> MsgEnvelope DecoratedSDoc)
    -> SDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
            SDoc
    warnMissingSafeHaskellMode

        TcGblEnv
    tcg_res <- {-# SCC "Typecheck-Rename" #-}
                   IO (Messages DecoratedSDoc, Maybe TcGblEnv) -> Hsc TcGblEnv
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages DecoratedSDoc, Maybe TcGblEnv) -> Hsc TcGblEnv)
    -> IO (Messages DecoratedSDoc, Maybe TcGblEnv) -> Hsc TcGblEnv
    forall a b. (a -> b) -> a -> b
    $
                       HscEnv
    -> ModSummary
    -> Bool
    -> HsParsedModule
    -> IO (Messages DecoratedSDoc, Maybe TcGblEnv)
    tcRnModule HscEnv
    hsc_env ModSummary
    sum
                         Bool
    save_rn_syntax HsParsedModule
    mod

        -- See Note [Safe Haskell Overlapping Instances Implementation]
        -- although this is used for more than just that failure case.
        (Bool
    tcSafeOK, WarningMessages
    whyUnsafe) <- IO (Bool, WarningMessages) -> Hsc (Bool, WarningMessages)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Bool, WarningMessages) -> Hsc (Bool, WarningMessages))
    -> IO (Bool, WarningMessages) -> Hsc (Bool, WarningMessages)
    forall a b. (a -> b) -> a -> b
    $ IORef (Bool, WarningMessages) -> IO (Bool, WarningMessages)
    forall a. IORef a -> IO a
    readIORef (TcGblEnv -> IORef (Bool, WarningMessages)
    tcg_safeInfer TcGblEnv
    tcg_res)
        let allSafeOK :: Bool
    allSafeOK = DynFlags -> Bool
    safeInferred DynFlags
    dflags Bool -> Bool -> Bool
    && Bool
    tcSafeOK

        -- end of the safe haskell line, how to respond to user?
        if Bool -> Bool
    not (DynFlags -> Bool
    safeHaskellOn DynFlags
    dflags)
             Bool -> Bool -> Bool
    || (DynFlags -> Bool
    safeInferOn DynFlags
    dflags Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    allSafeOK)
          -- if safe Haskell off or safe infer failed, mark unsafe
          then TcGblEnv -> WarningMessages -> Hsc TcGblEnv
    markUnsafeInfer TcGblEnv
    tcg_res WarningMessages
    whyUnsafe

          -- module (could be) safe, throw warning if needed
          else do
              TcGblEnv
    tcg_res' <- TcGblEnv -> Hsc TcGblEnv
    hscCheckSafeImports TcGblEnv
    tcg_res
              Bool
    safe <- IO Bool -> Hsc Bool
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> Hsc Bool) -> IO Bool -> Hsc Bool
    forall a b. (a -> b) -> a -> b
    $ (Bool, WarningMessages) -> Bool
    forall a b. (a, b) -> a
    fst ((Bool, WarningMessages) -> Bool)
    -> IO (Bool, WarningMessages) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef (Bool, WarningMessages) -> IO (Bool, WarningMessages)
    forall a. IORef a -> IO a
    readIORef (TcGblEnv -> IORef (Bool, WarningMessages)
    tcg_safeInfer TcGblEnv
    tcg_res')
              Bool -> Hsc () -> Hsc ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    safe (Hsc () -> Hsc ()) -> Hsc () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $
                case WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnSafe DynFlags
    dflags of
                  Bool
    True
                    | DynFlags -> SafeHaskellMode
    safeHaskell DynFlags
    dflags SafeHaskellMode -> SafeHaskellMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == SafeHaskellMode
    Sf_Safe -> () -> Hsc ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    | Bool
    otherwise -> (WarningMessages -> Hsc ()
    logWarnings (WarningMessages -> Hsc ()) -> WarningMessages -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a. a -> Bag a
    unitBag (MsgEnvelope DecoratedSDoc -> WarningMessages)
    -> MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a b. (a -> b) -> a -> b
    $
                           WarnReason
    -> MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc
    forall e. WarnReason -> MsgEnvelope e -> MsgEnvelope e
    makeIntoWarning (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnSafe) (MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc)
    -> MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                           SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainWarnMsg (DynFlags -> SrcSpan
    warnSafeOnLoc DynFlags
    dflags) (SDoc -> MsgEnvelope DecoratedSDoc)
    -> SDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                           TcGblEnv -> SDoc
    errSafe TcGblEnv
    tcg_res')
                  Bool
    False | DynFlags -> SafeHaskellMode
    safeHaskell DynFlags
    dflags SafeHaskellMode -> SafeHaskellMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == SafeHaskellMode
    Sf_Trustworthy Bool -> Bool -> Bool
    &&
                          WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnTrustworthySafe DynFlags
    dflags ->
                          (WarningMessages -> Hsc ()
    logWarnings (WarningMessages -> Hsc ()) -> WarningMessages -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a. a -> Bag a
    unitBag (MsgEnvelope DecoratedSDoc -> WarningMessages)
    -> MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a b. (a -> b) -> a -> b
    $
                           WarnReason
    -> MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc
    forall e. WarnReason -> MsgEnvelope e -> MsgEnvelope e
    makeIntoWarning (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnTrustworthySafe) (MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc)
    -> MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                           SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainWarnMsg (DynFlags -> SrcSpan
    trustworthyOnLoc DynFlags
    dflags) (SDoc -> MsgEnvelope DecoratedSDoc)
    -> SDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                           TcGblEnv -> SDoc
    errTwthySafe TcGblEnv
    tcg_res')
                  Bool
    False -> () -> Hsc ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              TcGblEnv -> Hsc TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tcg_res'
      where
        pprMod :: TcGblEnv -> SDoc
    pprMod TcGblEnv
    t  = ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (ModuleName -> SDoc) -> ModuleName -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName (Module -> ModuleName) -> Module -> ModuleName
    forall a b. (a -> b) -> a -> b
    $ TcGblEnv -> Module
    tcg_mod TcGblEnv
    t
        errSafe :: TcGblEnv -> SDoc
    errSafe TcGblEnv
    t = SDoc -> SDoc
    quotes (TcGblEnv -> SDoc
    pprMod TcGblEnv
    t) SDoc -> SDoc -> SDoc
    <+> [Char] -> SDoc
    text [Char]
    "has been inferred as safe!"
        errTwthySafe :: TcGblEnv -> SDoc
    errTwthySafe TcGblEnv
    t = SDoc -> SDoc
    quotes (TcGblEnv -> SDoc
    pprMod TcGblEnv
    t)
          SDoc -> SDoc -> SDoc
    <+> [Char] -> SDoc
    text [Char]
    "is marked as Trustworthy but has been inferred as safe!"
        warnMissingSafeHaskellMode :: SDoc
    warnMissingSafeHaskellMode = ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName (ModSummary -> Module
    ms_mod ModSummary
    sum))
          SDoc -> SDoc -> SDoc
    <+> [Char] -> SDoc
    text [Char]
    "is missing Safe Haskell mode"

    -- | Convert a typechecked module to Core
    hscDesugar :: HscEnv -> ModSummary -> TcGblEnv -> IO ModGuts
    hscDesugar :: HscEnv -> ModSummary -> TcGblEnv -> IO ModGuts
    hscDesugar HscEnv
    hsc_env ModSummary
    mod_summary TcGblEnv
    tc_result =
        HscEnv -> Hsc ModGuts -> IO ModGuts
    forall a. HscEnv -> Hsc a -> IO a
    runHsc HscEnv
    hsc_env (Hsc ModGuts -> IO ModGuts) -> Hsc ModGuts -> IO ModGuts
    forall a b. (a -> b) -> a -> b
    $ ModLocation -> TcGblEnv -> Hsc ModGuts
    hscDesugar' (ModSummary -> ModLocation
    ms_location ModSummary
    mod_summary) TcGblEnv
    tc_result

    hscDesugar' :: ModLocation -> TcGblEnv -> Hsc ModGuts
    hscDesugar' :: ModLocation -> TcGblEnv -> Hsc ModGuts
    hscDesugar' ModLocation
    mod_location TcGblEnv
    tc_result = do
        HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
        ModGuts
    r <- IO (Messages DecoratedSDoc, Maybe ModGuts) -> Hsc ModGuts
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages DecoratedSDoc, Maybe ModGuts) -> Hsc ModGuts)
    -> IO (Messages DecoratedSDoc, Maybe ModGuts) -> Hsc ModGuts
    forall a b. (a -> b) -> a -> b
    $
          {-# SCC "deSugar" #-}
          HscEnv
    -> ModLocation
    -> TcGblEnv
    -> IO (Messages DecoratedSDoc, Maybe ModGuts)
    deSugar HscEnv
    hsc_env ModLocation
    mod_location TcGblEnv
    tc_result

        -- always check -Werror after desugaring, this is the last opportunity for
        -- warnings to arise before the backend.
        Hsc ()
    handleWarnings
        ModGuts -> Hsc ModGuts
    forall (m :: * -> *) a. Monad m => a -> m a
    return ModGuts
    r

    -- | Make a 'ModDetails' from the results of typechecking. Used when
    -- typechecking only, as opposed to full compilation.
    makeSimpleDetails :: HscEnv -> TcGblEnv -> IO ModDetails
    makeSimpleDetails :: HscEnv -> TcGblEnv -> IO ModDetails
    makeSimpleDetails HscEnv
    hsc_env TcGblEnv
    tc_result = HscEnv -> TcGblEnv -> IO ModDetails
    mkBootModDetailsTc HscEnv
    hsc_env TcGblEnv
    tc_result

    {- **********************************************************************
    %*                                                                      *
                    The main compiler pipeline
    %*                                                                      *
    %********************************************************************* -}

    {-
                       --------------------------------
                            The compilation proper
                       --------------------------------

    It's the task of the compilation proper to compile Haskell, hs-boot and core
    files to either byte-code, hard-code (C, asm, LLVM, etc.) or to nothing at all
    (the module is still parsed and type-checked. This feature is mostly used by
    IDE's and the likes). Compilation can happen in either 'one-shot', 'batch',
    'nothing', or 'interactive' mode. 'One-shot' mode targets hard-code, 'batch'
    mode targets hard-code, 'nothing' mode targets nothing and 'interactive' mode
    targets byte-code.

    The modes are kept separate because of their different types and meanings:

     * In 'one-shot' mode, we're only compiling a single file and can therefore
     discard the new ModIface and ModDetails. This is also the reason it only
     targets hard-code; compiling to byte-code or nothing doesn't make sense when
     we discard the result.

     * 'Batch' mode is like 'one-shot' except that we keep the resulting ModIface
     and ModDetails. 'Batch' mode doesn't target byte-code since that require us to
     return the newly compiled byte-code.

     * 'Nothing' mode has exactly the same type as 'batch' mode but they're still
     kept separate. This is because compiling to nothing is fairly special: We
     don't output any interface files, we don't run the simplifier and we don't
     generate any code.

     * 'Interactive' mode is similar to 'batch' mode except that we return the
     compiled byte-code together with the ModIface and ModDetails.

    Trying to compile a hs-boot file to byte-code will result in a run-time error.
    This is the only thing that isn't caught by the type-system.
    -}

    type Messager = HscEnv -> (Int,Int) -> RecompileRequired -> ModuleGraphNode -> IO ()

    -- | This function runs GHC's frontend with recompilation
    -- avoidance. Specifically, it checks if recompilation is needed,
    -- and if it is, it parses and typechecks the input module.
    -- It does not write out the results of typechecking (See
    -- compileOne and hscIncrementalCompile).
    hscIncrementalFrontend :: Bool -- always do basic recompilation check?
                           -> Maybe TcGblEnv
                           -> Maybe Messager
                           -> ModSummary
                           -> SourceModified
                           -> Maybe ModIface  -- Old interface, if available
                           -> (Int,Int)       -- (i,n) = module i of n (for msgs)
                           -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))

    hscIncrementalFrontend :: Bool
    -> Maybe TcGblEnv
    -> Maybe Messager
    -> ModSummary
    -> SourceModified
    -> Maybe ModIface
    -> (Int, Int)
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    hscIncrementalFrontend
      Bool
    always_do_basic_recompilation_check Maybe TcGblEnv
    m_tc_result
      Maybe Messager
    mHscMessage ModSummary
    mod_summary SourceModified
    source_modified Maybe ModIface
    mb_old_iface (Int, Int)
    mod_index
        = do
        HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv

        let msg :: RecompileRequired -> IO ()
    msg RecompileRequired
    what = case Maybe Messager
    mHscMessage of
              -- We use extendModSummaryNoDeps because extra backpack deps are only needed for batch mode
              Just Messager
    hscMessage -> Messager
    hscMessage HscEnv
    hsc_env (Int, Int)
    mod_index RecompileRequired
    what (ExtendedModSummary -> ModuleGraphNode
    ModuleNode (ModSummary -> ExtendedModSummary
    extendModSummaryNoDeps ModSummary
    mod_summary))
              Maybe Messager
    Nothing -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

            skip :: ModIface
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    skip ModIface
    iface = do
                IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ RecompileRequired -> IO ()
    msg RecompileRequired
    UpToDate
                Either ModIface (FrontendResult, Maybe Fingerprint)
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either ModIface (FrontendResult, Maybe Fingerprint)
     -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint)))
    -> Either ModIface (FrontendResult, Maybe Fingerprint)
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    forall a b. (a -> b) -> a -> b
    $ ModIface -> Either ModIface (FrontendResult, Maybe Fingerprint)
    forall a b. a -> Either a b
    Left ModIface
    iface

            compile :: Maybe Fingerprint
    -> RecompileRequired
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    compile Maybe Fingerprint
    mb_old_hash RecompileRequired
    reason = do
                IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ RecompileRequired -> IO ()
    msg RecompileRequired
    reason
                FrontendResult
    tc_result <- case Hooks -> Maybe (ModSummary -> Hsc FrontendResult)
    hscFrontendHook (HscEnv -> Hooks
    hsc_hooks HscEnv
    hsc_env) of
                  Maybe (ModSummary -> Hsc FrontendResult)
    Nothing -> TcGblEnv -> FrontendResult
    FrontendTypecheck (TcGblEnv -> FrontendResult)
    -> ((TcGblEnv,
         Maybe
           (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
            Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
            Maybe LHsDocString))
        -> TcGblEnv)
    -> (TcGblEnv,
        Maybe
          (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
           Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
           Maybe LHsDocString))
    -> FrontendResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TcGblEnv,
     Maybe
       (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
        Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
        Maybe LHsDocString))
    -> TcGblEnv
    forall a b. (a, b) -> a
    fst ((TcGblEnv,
      Maybe
        (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
         Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
         Maybe LHsDocString))
     -> FrontendResult)
    -> Hsc
         (TcGblEnv,
          Maybe
            (HsGroup GhcRn, [GenLocated SrcSpanAnnA (ImportDecl GhcRn)],
             Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), Avails)],
             Maybe LHsDocString))
    -> Hsc FrontendResult
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool
    -> ModSummary
    -> Maybe HsParsedModule
    -> Hsc (TcGblEnv, RenamedStuff)
    hsc_typecheck Bool
    False ModSummary
    mod_summary Maybe HsParsedModule
    forall a. Maybe a
    Nothing
                  Just ModSummary -> Hsc FrontendResult
    h  -> ModSummary -> Hsc FrontendResult
    h ModSummary
    mod_summary
                Either ModIface (FrontendResult, Maybe Fingerprint)
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either ModIface (FrontendResult, Maybe Fingerprint)
     -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint)))
    -> Either ModIface (FrontendResult, Maybe Fingerprint)
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    forall a b. (a -> b) -> a -> b
    $ (FrontendResult, Maybe Fingerprint)
    -> Either ModIface (FrontendResult, Maybe Fingerprint)
    forall a b. b -> Either a b
    Right (FrontendResult
    tc_result, Maybe Fingerprint
    mb_old_hash)

            stable :: Bool
    stable = case SourceModified
    source_modified of
                         SourceModified
    SourceUnmodifiedAndStable -> Bool
    True
                         SourceModified
    _                         -> Bool
    False

        case Maybe TcGblEnv
    m_tc_result of
             Just TcGblEnv
    tc_result
              | Bool -> Bool
    not Bool
    always_do_basic_recompilation_check ->
                 Either ModIface (FrontendResult, Maybe Fingerprint)
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either ModIface (FrontendResult, Maybe Fingerprint)
     -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint)))
    -> Either ModIface (FrontendResult, Maybe Fingerprint)
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    forall a b. (a -> b) -> a -> b
    $ (FrontendResult, Maybe Fingerprint)
    -> Either ModIface (FrontendResult, Maybe Fingerprint)
    forall a b. b -> Either a b
    Right (TcGblEnv -> FrontendResult
    FrontendTypecheck TcGblEnv
    tc_result, Maybe Fingerprint
    forall a. Maybe a
    Nothing)
             Maybe TcGblEnv
    _ -> do
                (RecompileRequired
    recomp_reqd, Maybe ModIface
    mb_checked_iface)
                    <- {-# SCC "checkOldIface" #-}
                       IO (RecompileRequired, Maybe ModIface)
    -> Hsc (RecompileRequired, Maybe ModIface)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (RecompileRequired, Maybe ModIface)
     -> Hsc (RecompileRequired, Maybe ModIface))
    -> IO (RecompileRequired, Maybe ModIface)
    -> Hsc (RecompileRequired, Maybe ModIface)
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> ModSummary
    -> SourceModified
    -> Maybe ModIface
    -> IO (RecompileRequired, Maybe ModIface)
    checkOldIface HscEnv
    hsc_env ModSummary
    mod_summary
                                    SourceModified
    source_modified Maybe ModIface
    mb_old_iface
                -- save the interface that comes back from checkOldIface.
                -- In one-shot mode we don't have the old iface until this
                -- point, when checkOldIface reads it from the disk.
                let mb_old_hash :: Maybe Fingerprint
    mb_old_hash = (ModIface -> Fingerprint) -> Maybe ModIface -> Maybe Fingerprint
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ModIfaceBackend -> Fingerprint
    mi_iface_hash (ModIfaceBackend -> Fingerprint)
    -> (ModIface -> ModIfaceBackend) -> ModIface -> Fingerprint
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModIface -> ModIfaceBackend
    forall (phase :: ModIfacePhase).
    ModIface_ phase -> IfaceBackendExts phase
    mi_final_exts) Maybe ModIface
    mb_checked_iface

                case Maybe ModIface
    mb_checked_iface of
                    Just ModIface
    iface | Bool -> Bool
    not (RecompileRequired -> Bool
    recompileRequired RecompileRequired
    recomp_reqd) ->
                        -- If the module used TH splices when it was last
                        -- compiled, then the recompilation check is not
                        -- accurate enough (#481) and we must ignore
                        -- it.  However, if the module is stable (none of
                        -- the modules it depends on, directly or
                        -- indirectly, changed), then we *can* skip
                        -- recompilation. This is why the SourceModified
                        -- type contains SourceUnmodifiedAndStable, and
                        -- it's pretty important: otherwise ghc --make
                        -- would always recompile TH modules, even if
                        -- nothing at all has changed. Stability is just
                        -- the same check that make is doing for us in
                        -- one-shot mode.
                        case Maybe TcGblEnv
    m_tc_result of
                        Maybe TcGblEnv
    Nothing
                         | ModIface -> Bool
    forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
    mi_used_th ModIface
    iface Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    stable ->
                            Maybe Fingerprint
    -> RecompileRequired
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    compile Maybe Fingerprint
    mb_old_hash ([Char] -> RecompileRequired
    RecompBecause [Char]
    "TH")
                        Maybe TcGblEnv
    _ ->
                            ModIface
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    skip ModIface
    iface
                    Maybe ModIface
    _ ->
                        case Maybe TcGblEnv
    m_tc_result of
                        Maybe TcGblEnv
    Nothing -> Maybe Fingerprint
    -> RecompileRequired
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    compile Maybe Fingerprint
    mb_old_hash RecompileRequired
    recomp_reqd
                        Just TcGblEnv
    tc_result ->
                            Either ModIface (FrontendResult, Maybe Fingerprint)
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either ModIface (FrontendResult, Maybe Fingerprint)
     -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint)))
    -> Either ModIface (FrontendResult, Maybe Fingerprint)
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    forall a b. (a -> b) -> a -> b
    $ (FrontendResult, Maybe Fingerprint)
    -> Either ModIface (FrontendResult, Maybe Fingerprint)
    forall a b. b -> Either a b
    Right (TcGblEnv -> FrontendResult
    FrontendTypecheck TcGblEnv
    tc_result, Maybe Fingerprint
    mb_old_hash)

    --------------------------------------------------------------
    -- Compilers
    --------------------------------------------------------------

    -- | Used by both OneShot and batch mode. Runs the pipeline HsSyn and Core parts
    -- of the pipeline.
    -- We return a interface if we already had an old one around and recompilation
    -- was not needed. Otherwise it will be created during later passes when we
    -- run the compilation pipeline.
    hscIncrementalCompile :: Bool
                          -> Maybe TcGblEnv
                          -> Maybe Messager
                          -> HscEnv
                          -> ModSummary
                          -> SourceModified
                          -> Maybe ModIface
                          -> (Int,Int)
                          -> IO (HscStatus, HscEnv)
    hscIncrementalCompile :: Bool
    -> Maybe TcGblEnv
    -> Maybe Messager
    -> HscEnv
    -> ModSummary
    -> SourceModified
    -> Maybe ModIface
    -> (Int, Int)
    -> IO (HscStatus, HscEnv)
    hscIncrementalCompile Bool
    always_do_basic_recompilation_check Maybe TcGblEnv
    m_tc_result
        Maybe Messager
    mHscMessage HscEnv
    hsc_env' ModSummary
    mod_summary SourceModified
    source_modified Maybe ModIface
    mb_old_iface (Int, Int)
    mod_index
      = do
        HscEnv
    hsc_env'' <- HscEnv -> IO HscEnv
    initializePlugins HscEnv
    hsc_env'

        -- One-shot mode needs a knot-tying mutable variable for interface
        -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var.
        -- See also Note [hsc_type_env_var hack]
        IORef TypeEnv
    type_env_var <- TypeEnv -> IO (IORef TypeEnv)
    forall a. a -> IO (IORef a)
    newIORef TypeEnv
    forall a. NameEnv a
    emptyNameEnv
        let mod :: Module
    mod = ModSummary -> Module
    ms_mod ModSummary
    mod_summary
            hsc_env :: HscEnv
    hsc_env | GhcMode -> Bool
    isOneShot (DynFlags -> GhcMode
    ghcMode (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env''))
                    = HscEnv
    hsc_env'' { hsc_type_env_var :: Maybe (Module, IORef TypeEnv)
    hsc_type_env_var = (Module, IORef TypeEnv) -> Maybe (Module, IORef TypeEnv)
    forall a. a -> Maybe a
    Just (Module
    mod, IORef TypeEnv
    type_env_var) }
                    | Bool
    otherwise
                    = HscEnv
    hsc_env''

        -- NB: enter Hsc monad here so that we don't bail out early with
        -- -Werror on typechecker warnings; we also want to run the desugarer
        -- to get those warnings too. (But we'll always exit at that point
        -- because the desugarer runs ioMsgMaybe.)
        HscEnv -> Hsc (HscStatus, HscEnv) -> IO (HscStatus, HscEnv)
    forall a. HscEnv -> Hsc a -> IO a
    runHsc HscEnv
    hsc_env (Hsc (HscStatus, HscEnv) -> IO (HscStatus, HscEnv))
    -> Hsc (HscStatus, HscEnv) -> IO (HscStatus, HscEnv)
    forall a b. (a -> b) -> a -> b
    $ do
        Either ModIface (FrontendResult, Maybe Fingerprint)
    e <- Bool
    -> Maybe TcGblEnv
    -> Maybe Messager
    -> ModSummary
    -> SourceModified
    -> Maybe ModIface
    -> (Int, Int)
    -> Hsc (Either ModIface (FrontendResult, Maybe Fingerprint))
    hscIncrementalFrontend Bool
    always_do_basic_recompilation_check Maybe TcGblEnv
    m_tc_result Maybe Messager
    mHscMessage
                ModSummary
    mod_summary SourceModified
    source_modified Maybe ModIface
    mb_old_iface (Int, Int)
    mod_index
        case Either ModIface (FrontendResult, Maybe Fingerprint)
    e of
            -- We didn't need to do any typechecking; the old interface
            -- file on disk was good enough.
            Left ModIface
    iface -> do
                -- Knot tying!  See Note [Knot-tying typecheckIface]
                ModDetails
    details <- IO ModDetails -> Hsc ModDetails
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ModDetails -> Hsc ModDetails)
    -> ((ModDetails -> IO ModDetails) -> IO ModDetails)
    -> (ModDetails -> IO ModDetails)
    -> Hsc ModDetails
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ModDetails -> IO ModDetails) -> IO ModDetails
    forall a. (a -> IO a) -> IO a
    fixIO ((ModDetails -> IO ModDetails) -> Hsc ModDetails)
    -> (ModDetails -> IO ModDetails) -> Hsc ModDetails
    forall a b. (a -> b) -> a -> b
    $ \ModDetails
    details' -> do
                    let hsc_env' :: HscEnv
    hsc_env' =
                            HscEnv
    hsc_env {
                                hsc_HPT :: HomePackageTable
    hsc_HPT = HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable
    addToHpt (HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    hsc_env)
                                            (ModSummary -> ModuleName
    ms_mod_name ModSummary
    mod_summary) (ModIface -> ModDetails -> Maybe Linkable -> HomeModInfo
    HomeModInfo ModIface
    iface ModDetails
    details' Maybe Linkable
    forall a. Maybe a
    Nothing)
                            }
                    -- NB: This result is actually not that useful
                    -- in one-shot mode, since we're not going to do
                    -- any further typechecking.  It's much more useful
                    -- in make mode, since this HMI will go into the HPT.
                    HscEnv -> ModIface -> IO ModDetails
    genModDetails HscEnv
    hsc_env' ModIface
    iface
                (HscStatus, HscEnv) -> Hsc (HscStatus, HscEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModIface -> ModDetails -> HscStatus
    HscUpToDate ModIface
    iface ModDetails
    details, HscEnv
    hsc_env')
            -- We finished type checking.  (mb_old_hash is the hash of
            -- the interface that existed on disk; it's possible we had
            -- to retypecheck but the resulting interface is exactly
            -- the same.)
            Right (FrontendTypecheck TcGblEnv
    tc_result, Maybe Fingerprint
    mb_old_hash) -> do
                HscStatus
    status <- ModSummary -> TcGblEnv -> Maybe Fingerprint -> Hsc HscStatus
    finish ModSummary
    mod_summary TcGblEnv
    tc_result Maybe Fingerprint
    mb_old_hash
                (HscStatus, HscEnv) -> Hsc (HscStatus, HscEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HscStatus
    status, HscEnv
    hsc_env)

    -- Runs the post-typechecking frontend (desugar and simplify). We want to
    -- generate most of the interface as late as possible. This gets us up-to-date
    -- and good unfoldings and other info in the interface file.
    --
    -- We might create a interface right away, in which case we also return the
    -- updated HomeModInfo. But we might also need to run the backend first. In the
    -- later case Status will be HscRecomp and we return a function from ModIface ->
    -- HomeModInfo.
    --
    -- HscRecomp in turn will carry the information required to compute a interface
    -- when passed the result of the code generator. So all this can and is done at
    -- the call site of the backend code gen if it is run.
    finish :: ModSummary
           -> TcGblEnv
           -> Maybe Fingerprint
           -> Hsc HscStatus
    finish :: ModSummary -> TcGblEnv -> Maybe Fingerprint -> Hsc HscStatus
    finish ModSummary
    summary TcGblEnv
    tc_result Maybe Fingerprint
    mb_old_hash = do
      HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
      DynFlags
    dflags <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      Logger
    logger <- Hsc Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
      let bcknd :: Backend
    bcknd  = DynFlags -> Backend
    backend DynFlags
    dflags
          hsc_src :: HscSource
    hsc_src = ModSummary -> HscSource
    ms_hsc_src ModSummary
    summary

      -- Desugar, if appropriate
      --
      -- We usually desugar even when we are not generating code, otherwise we
      -- would miss errors thrown by the desugaring (see #10600). The only
      -- exceptions are when the Module is Ghc.Prim or when it is not a
      -- HsSrcFile Module.
      Maybe ModGuts
    mb_desugar <-
          if ModSummary -> Module
    ms_mod ModSummary
    summary Module -> Module -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Module
    gHC_PRIM Bool -> Bool -> Bool
    && HscSource
    hsc_src HscSource -> HscSource -> Bool
    forall a. Eq a => a -> a -> Bool
    == HscSource
    HsSrcFile
          then ModGuts -> Maybe ModGuts
    forall a. a -> Maybe a
    Just (ModGuts -> Maybe ModGuts) -> Hsc ModGuts -> Hsc (Maybe ModGuts)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ModLocation -> TcGblEnv -> Hsc ModGuts
    hscDesugar' (ModSummary -> ModLocation
    ms_location ModSummary
    summary) TcGblEnv
    tc_result
          else Maybe ModGuts -> Hsc (Maybe ModGuts)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe ModGuts
    forall a. Maybe a
    Nothing

      -- Simplify, if appropriate, and (whether we simplified or not) generate an
      -- interface file.
      case Maybe ModGuts
    mb_desugar of
          -- Just cause we desugared doesn't mean we are generating code, see above.
          Just ModGuts
    desugared_guts | Backend
    bcknd Backend -> Backend -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Backend
    NoBackend -> do
              [[Char]]
    plugins <- IO [[Char]] -> Hsc [[Char]]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [[Char]] -> Hsc [[Char]]) -> IO [[Char]] -> Hsc [[Char]]
    forall a b. (a -> b) -> a -> b
    $ IORef [[Char]] -> IO [[Char]]
    forall a. IORef a -> IO a
    readIORef (TcGblEnv -> IORef [[Char]]
    tcg_th_coreplugins TcGblEnv
    tc_result)
              ModGuts
    simplified_guts <- [[Char]] -> ModGuts -> Hsc ModGuts
    hscSimplify' [[Char]]
    plugins ModGuts
    desugared_guts

              (CgGuts
    cg_guts, ModDetails
    details) <- {-# SCC "CoreTidy" #-}
                  IO (CgGuts, ModDetails) -> Hsc (CgGuts, ModDetails)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (CgGuts, ModDetails) -> Hsc (CgGuts, ModDetails))
    -> IO (CgGuts, ModDetails) -> Hsc (CgGuts, ModDetails)
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> ModGuts -> IO (CgGuts, ModDetails)
    tidyProgram HscEnv
    hsc_env ModGuts
    simplified_guts

              let !partial_iface :: PartialModIface
    partial_iface =
                    {-# SCC "GHC.Driver.Main.mkPartialIface" #-}
                    -- This `force` saves 2M residency in test T10370
                    -- See Note [Avoiding space leaks in toIface*] for details.
                    PartialModIface -> PartialModIface
    forall a. NFData a => a -> a
    force (HscEnv -> ModDetails -> ModGuts -> PartialModIface
    mkPartialIface HscEnv
    hsc_env ModDetails
    details ModGuts
    simplified_guts)

              HscStatus -> Hsc HscStatus
    forall (m :: * -> *) a. Monad m => a -> m a
    return HscRecomp { hscs_guts :: CgGuts
    hscs_guts = CgGuts
    cg_guts,
                                 hscs_mod_location :: ModLocation
    hscs_mod_location = ModSummary -> ModLocation
    ms_location ModSummary
    summary,
                                 hscs_mod_details :: ModDetails
    hscs_mod_details = ModDetails
    details,
                                 hscs_partial_iface :: PartialModIface
    hscs_partial_iface = PartialModIface
    partial_iface,
                                 hscs_old_iface_hash :: Maybe Fingerprint
    hscs_old_iface_hash = Maybe Fingerprint
    mb_old_hash
                               }

          -- We are not generating code, so we can skip simplification
          -- and generate a simple interface.
          Maybe ModGuts
    _ -> do
            (ModIface
    iface, Maybe Fingerprint
    mb_old_iface_hash, ModDetails
    details) <- IO (ModIface, Maybe Fingerprint, ModDetails)
    -> Hsc (ModIface, Maybe Fingerprint, ModDetails)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ModIface, Maybe Fingerprint, ModDetails)
     -> Hsc (ModIface, Maybe Fingerprint, ModDetails))
    -> IO (ModIface, Maybe Fingerprint, ModDetails)
    -> Hsc (ModIface, Maybe Fingerprint, ModDetails)
    forall a b. (a -> b) -> a -> b
    $
              HscEnv
    -> TcGblEnv
    -> Maybe Fingerprint
    -> IO (ModIface, Maybe Fingerprint, ModDetails)
    hscSimpleIface HscEnv
    hsc_env TcGblEnv
    tc_result Maybe Fingerprint
    mb_old_hash

            IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> DynFlags
    -> Bool
    -> ModIface
    -> Maybe Fingerprint
    -> ModLocation
    -> IO ()
    hscMaybeWriteIface Logger
    logger DynFlags
    dflags Bool
    True ModIface
    iface Maybe Fingerprint
    mb_old_iface_hash (ModSummary -> ModLocation
    ms_location ModSummary
    summary)

            HscStatus -> Hsc HscStatus
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HscStatus -> Hsc HscStatus) -> HscStatus -> Hsc HscStatus
    forall a b. (a -> b) -> a -> b
    $ case Backend
    bcknd of
              Backend
    NoBackend -> ModIface -> ModDetails -> HscStatus
    HscNotGeneratingCode ModIface
    iface ModDetails
    details
              Backend
    _         -> case HscSource
    hsc_src of
                            HscSource
    HsBootFile -> ModIface -> ModDetails -> HscStatus
    HscUpdateBoot ModIface
    iface ModDetails
    details
                            HscSource
    HsigFile   -> ModIface -> ModDetails -> HscStatus
    HscUpdateSig ModIface
    iface ModDetails
    details
                            HscSource
    _          -> [Char] -> HscStatus
    forall a. [Char] -> a
    panic [Char]
    "finish"

    {-
    Note [Writing interface files]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    We write one interface file per module and per compilation, except with
    -dynamic-too where we write two interface files (non-dynamic and dynamic).

    We can write two kinds of interfaces (see Note [Interface file stages] in
    "GHC.Driver.Types"):

       * simple interface: interface generated after the core pipeline

       * full interface: simple interface completed with information from the
         backend

    Depending on the situation, we write one or the other (using
    `hscMaybeWriteIface`). We must be careful with `-dynamic-too` because only the
    backend is run twice, so if we write a simple interface we need to write both
    the non-dynamic and the dynamic interfaces at the same time (with the same
    contents).

    Cases for which we generate simple interfaces:

       * GHC.Driver.Main.finish: when a compilation does NOT require (re)compilation
       of the hard code

       * GHC.Driver.Pipeline.compileOne': when we run in One Shot mode and target
       bytecode (if interface writing is forced).

       * GHC.Driver.Backpack uses simple interfaces for indefinite units
       (units with module holes). It writes them indirectly by forcing the
       -fwrite-interface flag while setting backend to NoBackend.

    Cases for which we generate full interfaces:

       * GHC.Driver.Pipeline.runPhase: when we must be compiling to regular hard
       code and/or require recompilation.

    By default interface file names are derived from module file names by adding
    suffixes. The interface file name can be overloaded with "-ohi", except when
    `-dynamic-too` is used.

    -}

    -- | Write interface files
    hscMaybeWriteIface :: Logger -> DynFlags -> Bool -> ModIface -> Maybe Fingerprint -> ModLocation -> IO ()
    hscMaybeWriteIface :: Logger
    -> DynFlags
    -> Bool
    -> ModIface
    -> Maybe Fingerprint
    -> ModLocation
    -> IO ()
    hscMaybeWriteIface Logger
    logger DynFlags
    dflags Bool
    is_simple ModIface
    iface Maybe Fingerprint
    old_iface ModLocation
    mod_location = do
        let force_write_interface :: Bool
    force_write_interface = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_WriteInterface DynFlags
    dflags
            write_interface :: Bool
    write_interface = case DynFlags -> Backend
    backend DynFlags
    dflags of
                                Backend
    NoBackend    -> Bool
    False
                                Backend
    Interpreter  -> Bool
    False
                                Backend
    _            -> Bool
    True

          -- mod_location only contains the base name, so we rebuild the
          -- correct file extension from the dynflags.
            baseName :: [Char]
    baseName = ModLocation -> [Char]
    ml_hi_file ModLocation
    mod_location
            buildIfName :: [Char] -> Bool -> [Char]
    buildIfName [Char]
    suffix Bool
    is_dynamic
              | Just [Char]
    name <- (if Bool
    is_dynamic then DynFlags -> Maybe [Char]
    dynOutputHi else DynFlags -> Maybe [Char]
    outputHi) DynFlags
    dflags
              = [Char]
    name
              | Bool
    otherwise
              = let with_hi :: [Char]
    with_hi = [Char] -> [Char] -> [Char]
    replaceExtension [Char]
    baseName [Char]
    suffix
                in  IsBootInterface -> [Char] -> [Char]
    addBootSuffix_maybe (ModIface -> IsBootInterface
    mi_boot ModIface
    iface) [Char]
    with_hi

            write_iface :: DynFlags -> ModIface -> IO ()
    write_iface DynFlags
    dflags' ModIface
    iface =
              let !iface_name :: [Char]
    iface_name = [Char] -> Bool -> [Char]
    buildIfName (DynFlags -> [Char]
    hiSuf DynFlags
    dflags') (DynFlags -> Bool
    dynamicNow DynFlags
    dflags')
              in
              {-# SCC "writeIface" #-}
              Logger -> DynFlags -> SDoc -> (() -> ()) -> IO () -> IO ()
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> DynFlags -> SDoc -> (a -> ()) -> m a -> m a
    withTiming Logger
    logger DynFlags
    dflags'
                  ([Char] -> SDoc
    text [Char]
    "WriteIface"SDoc -> SDoc -> SDoc
    <+>SDoc -> SDoc
    brackets ([Char] -> SDoc
    text [Char]
    iface_name))
                  (() -> () -> ()
    forall a b. a -> b -> a
    const ())
                  (Logger -> DynFlags -> [Char] -> ModIface -> IO ()
    writeIface Logger
    logger DynFlags
    dflags' [Char]
    iface_name ModIface
    iface)

        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    write_interface Bool -> Bool -> Bool
    || Bool
    force_write_interface) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do

          -- FIXME: with -dynamic-too, "no_change" is only meaningful for the
          -- non-dynamic interface, not for the dynamic one. We should have another
          -- flag for the dynamic interface. In the meantime:
          --
          --    * when we write a single full interface, we check if we are
          --    currently writing the dynamic interface due to -dynamic-too, in
          --    which case we ignore "no_change".
          --
          --    * when we write two simple interfaces at once because of
          --    dynamic-too, we use "no_change" both for the non-dynamic and the
          --    dynamic interfaces. Hopefully both the dynamic and the non-dynamic
          --    interfaces stay in sync...
          --
          let no_change :: Bool
    no_change = Maybe Fingerprint
    old_iface Maybe Fingerprint -> Maybe Fingerprint -> Bool
    forall a. Eq a => a -> a -> Bool
    == Fingerprint -> Maybe Fingerprint
    forall a. a -> Maybe a
    Just (ModIfaceBackend -> Fingerprint
    mi_iface_hash (ModIface -> IfaceBackendExts 'ModIfaceFinal
    forall (phase :: ModIfacePhase).
    ModIface_ phase -> IfaceBackendExts phase
    mi_final_exts ModIface
    iface))

          DynamicTooState
    dt <- DynFlags -> IO DynamicTooState
    forall (m :: * -> *). MonadIO m => DynFlags -> m DynamicTooState
    dynamicTooState DynFlags
    dflags

          Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DumpFlag -> DynFlags -> Bool
    dopt DumpFlag
    Opt_D_dump_if_trace DynFlags
    dflags) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> DynFlags -> SDoc -> IO ()
    putMsg Logger
    logger DynFlags
    dflags (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            SDoc -> Int -> SDoc -> SDoc
    hang ([Char] -> SDoc
    text [Char]
    "Writing interface(s):") Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat
             [ [Char] -> SDoc
    text [Char]
    "Kind:" SDoc -> SDoc -> SDoc
    <+> if Bool
    is_simple then [Char] -> SDoc
    text [Char]
    "simple" else [Char] -> SDoc
    text [Char]
    "full"
             , [Char] -> SDoc
    text [Char]
    "Hash change:" SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Bool -> Bool
    not Bool
    no_change)
             , [Char] -> SDoc
    text [Char]
    "DynamicToo state:" SDoc -> SDoc -> SDoc
    <+> [Char] -> SDoc
    text (DynamicTooState -> [Char]
    forall a. Show a => a -> [Char]
    show DynamicTooState
    dt)
             ]

          if Bool
    is_simple
             then Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    no_change (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do -- FIXME: see no_change' comment above
                DynFlags -> ModIface -> IO ()
    write_iface DynFlags
    dflags ModIface
    iface
                case DynamicTooState
    dt of
                   DynamicTooState
    DT_Dont   -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                   DynamicTooState
    DT_Failed -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                   DynamicTooState
    DT_Dyn    -> [Char] -> IO ()
    forall a. [Char] -> a
    panic [Char]
    "Unexpected DT_Dyn state when writing simple interface"
                   DynamicTooState
    DT_OK     -> DynFlags -> ModIface -> IO ()
    write_iface (DynFlags -> DynFlags
    setDynamicNow DynFlags
    dflags) ModIface
    iface
             else case DynamicTooState
    dt of
                   DynamicTooState
    DT_Dont | Bool -> Bool
    not Bool
    no_change             -> DynFlags -> ModIface -> IO ()
    write_iface DynFlags
    dflags ModIface
    iface
                   DynamicTooState
    DT_OK   | Bool -> Bool
    not Bool
    no_change             -> DynFlags -> ModIface -> IO ()
    write_iface DynFlags
    dflags ModIface
    iface
                   -- FIXME: see no_change' comment above
                   DynamicTooState
    DT_Dyn                              -> DynFlags -> ModIface -> IO ()
    write_iface DynFlags
    dflags ModIface
    iface
                   DynamicTooState
    DT_Failed | Bool -> Bool
    not (DynFlags -> Bool
    dynamicNow DynFlags
    dflags) -> DynFlags -> ModIface -> IO ()
    write_iface DynFlags
    dflags ModIface
    iface
                   DynamicTooState
    _                                   -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    --------------------------------------------------------------
    -- NoRecomp handlers
    --------------------------------------------------------------

    -- NB: this must be knot-tied appropriately, see hscIncrementalCompile
    genModDetails :: HscEnv -> ModIface -> IO ModDetails
    genModDetails :: HscEnv -> ModIface -> IO ModDetails
    genModDetails HscEnv
    hsc_env ModIface
    old_iface
      = do
        ModDetails
    new_details <- {-# SCC "tcRnIface" #-}
                       HscEnv -> IfG ModDetails -> IO ModDetails
    forall a. HscEnv -> IfG a -> IO a
    initIfaceLoad HscEnv
    hsc_env (ModIface -> IfG ModDetails
    typecheckIface ModIface
    old_iface)
        HscEnv -> IO ()
    dumpIfaceStats HscEnv
    hsc_env
        ModDetails -> IO ModDetails
    forall (m :: * -> *) a. Monad m => a -> m a
    return ModDetails
    new_details

    --------------------------------------------------------------
    -- Progress displayers.
    --------------------------------------------------------------

    oneShotMsg :: HscEnv -> RecompileRequired -> IO ()
    oneShotMsg :: HscEnv -> RecompileRequired -> IO ()
    oneShotMsg HscEnv
    hsc_env RecompileRequired
    recomp =
        case RecompileRequired
    recomp of
            RecompileRequired
    UpToDate ->
                Logger -> DynFlags -> SDoc -> IO ()
    compilationProgressMsg Logger
    logger DynFlags
    dflags (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                       [Char] -> SDoc
    text [Char]
    "compilation IS NOT required"
            RecompileRequired
    _ ->
                () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        where
            dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
            logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env

    batchMsg :: Messager
    batchMsg :: Messager
    batchMsg HscEnv
    hsc_env (Int, Int)
    mod_index RecompileRequired
    recomp ModuleGraphNode
    node = case ModuleGraphNode
    node of
        InstantiationNode InstantiatedUnit
    _ ->
            case RecompileRequired
    recomp of
                RecompileRequired
    MustCompile -> SDoc -> SDoc -> IO ()
    showMsg ([Char] -> SDoc
    text [Char]
    "Instantiating ") SDoc
    empty
                RecompileRequired
    UpToDate
                    | DynFlags -> Int
    verbosity DynFlags
    dflags Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2 -> SDoc -> SDoc -> IO ()
    showMsg ([Char] -> SDoc
    text [Char]
    "Skipping  ") SDoc
    empty
                    | Bool
    otherwise -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                RecompBecause [Char]
    reason -> SDoc -> SDoc -> IO ()
    showMsg ([Char] -> SDoc
    text [Char]
    "Instantiating ") ([Char] -> SDoc
    text [Char]
    " [" SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    reason SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    "]")
        ModuleNode ExtendedModSummary
    _ ->
            case RecompileRequired
    recomp of
                RecompileRequired
    MustCompile -> SDoc -> SDoc -> IO ()
    showMsg ([Char] -> SDoc
    text [Char]
    "Compiling ") SDoc
    empty
                RecompileRequired
    UpToDate
                    | DynFlags -> Int
    verbosity DynFlags
    dflags Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2 -> SDoc -> SDoc -> IO ()
    showMsg ([Char] -> SDoc
    text [Char]
    "Skipping  ") SDoc
    empty
                    | Bool
    otherwise -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                RecompBecause [Char]
    reason -> SDoc -> SDoc -> IO ()
    showMsg ([Char] -> SDoc
    text [Char]
    "Compiling ") ([Char] -> SDoc
    text [Char]
    " [" SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    reason SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    "]")
        where
            dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
            logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
            showMsg :: SDoc -> SDoc -> IO ()
    showMsg SDoc
    msg SDoc
    reason =
                Logger -> DynFlags -> SDoc -> IO ()
    compilationProgressMsg Logger
    logger DynFlags
    dflags (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                ((Int, Int) -> SDoc
    showModuleIndex (Int, Int)
    mod_index SDoc -> SDoc -> SDoc
    <>
                SDoc
    msg SDoc -> SDoc -> SDoc
    <> DynFlags -> Bool -> ModuleGraphNode -> SDoc
    showModMsg DynFlags
    dflags (RecompileRequired -> Bool
    recompileRequired RecompileRequired
    recomp) ModuleGraphNode
    node)
                    SDoc -> SDoc -> SDoc
    <> SDoc
    reason

    --------------------------------------------------------------
    -- Safe Haskell
    --------------------------------------------------------------

    -- Note [Safe Haskell Trust Check]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- Safe Haskell checks that an import is trusted according to the following
    -- rules for an import of module M that resides in Package P:
    --
    --   * If M is recorded as Safe and all its trust dependencies are OK
    --     then M is considered safe.
    --   * If M is recorded as Trustworthy and P is considered trusted and
    --     all M's trust dependencies are OK then M is considered safe.
    --
    -- By trust dependencies we mean that the check is transitive. So if
    -- a module M that is Safe relies on a module N that is trustworthy,
    -- importing module M will first check (according to the second case)
    -- that N is trusted before checking M is trusted.
    --
    -- This is a minimal description, so please refer to the user guide
    -- for more details. The user guide is also considered the authoritative
    -- source in this matter, not the comments or code.

    -- Note [Safe Haskell Inference]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- Safe Haskell does Safe inference on modules that don't have any specific
    -- safe haskell mode flag. The basic approach to this is:
    --   * When deciding if we need to do a Safe language check, treat
    --     an unmarked module as having -XSafe mode specified.
    --   * For checks, don't throw errors but return them to the caller.
    --   * Caller checks if there are errors:
    --     * For modules explicitly marked -XSafe, we throw the errors.
    --     * For unmarked modules (inference mode), we drop the errors
    --       and mark the module as being Unsafe.
    --
    -- It used to be that we only did safe inference on modules that had no Safe
    -- Haskell flags, but now we perform safe inference on all modules as we want
    -- to allow users to set the `-Wsafe`, `-Wunsafe` and
    -- `-Wtrustworthy-safe` flags on Trustworthy and Unsafe modules so that a
    -- user can ensure their assumptions are correct and see reasons for why a
    -- module is safe or unsafe.
    --
    -- This is tricky as we must be careful when we should throw an error compared
    -- to just warnings. For checking safe imports we manage it as two steps. First
    -- we check any imports that are required to be safe, then we check all other
    -- imports to see if we can infer them to be safe.

    -- | Check that the safe imports of the module being compiled are valid.
    -- If not we either issue a compilation error if the module is explicitly
    -- using Safe Haskell, or mark the module as unsafe if we're in safe
    -- inference mode.
    hscCheckSafeImports :: TcGblEnv -> Hsc TcGblEnv
    hscCheckSafeImports :: TcGblEnv -> Hsc TcGblEnv
    hscCheckSafeImports TcGblEnv
    tcg_env = do
        DynFlags
    dflags   <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        TcGblEnv
    tcg_env' <- TcGblEnv -> Hsc TcGblEnv
    checkSafeImports TcGblEnv
    tcg_env
        DynFlags -> TcGblEnv -> Hsc TcGblEnv
    checkRULES DynFlags
    dflags TcGblEnv
    tcg_env'

      where
        checkRULES :: DynFlags -> TcGblEnv -> Hsc TcGblEnv
    checkRULES DynFlags
    dflags TcGblEnv
    tcg_env' =
          case DynFlags -> Bool
    safeLanguageOn DynFlags
    dflags of
              Bool
    True -> do
                  -- XSafe: we nuke user written RULES
                  WarningMessages -> Hsc ()
    logWarnings (WarningMessages -> Hsc ()) -> WarningMessages -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ [GenLocated SrcSpanAnnA (RuleDecl GhcTc)] -> WarningMessages
    warns (TcGblEnv -> [LRuleDecl GhcTc]
    tcg_rules TcGblEnv
    tcg_env')
                  TcGblEnv -> Hsc TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tcg_env' { tcg_rules :: [LRuleDecl GhcTc]
    tcg_rules = [] }
              Bool
    False
                    -- SafeInferred: user defined RULES, so not safe
                  | DynFlags -> Bool
    safeInferOn DynFlags
    dflags Bool -> Bool -> Bool
    && Bool -> Bool
    not ([LRuleDecl GhcTc] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([LRuleDecl GhcTc] -> Bool) -> [LRuleDecl GhcTc] -> Bool
    forall a b. (a -> b) -> a -> b
    $ TcGblEnv -> [LRuleDecl GhcTc]
    tcg_rules TcGblEnv
    tcg_env')
                  -> TcGblEnv -> WarningMessages -> Hsc TcGblEnv
    markUnsafeInfer TcGblEnv
    tcg_env' (WarningMessages -> Hsc TcGblEnv)
    -> WarningMessages -> Hsc TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ [GenLocated SrcSpanAnnA (RuleDecl GhcTc)] -> WarningMessages
    warns (TcGblEnv -> [LRuleDecl GhcTc]
    tcg_rules TcGblEnv
    tcg_env')

                    -- Trustworthy OR SafeInferred: with no RULES
                  | Bool
    otherwise
                  -> TcGblEnv -> Hsc TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tcg_env'

        warns :: [GenLocated SrcSpanAnnA (RuleDecl GhcTc)] -> WarningMessages
    warns [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
    rules = [MsgEnvelope DecoratedSDoc] -> WarningMessages
    forall a. [a] -> Bag a
    listToBag ([MsgEnvelope DecoratedSDoc] -> WarningMessages)
    -> [MsgEnvelope DecoratedSDoc] -> WarningMessages
    forall a b. (a -> b) -> a -> b
    $ (GenLocated SrcSpanAnnA (RuleDecl GhcTc)
     -> MsgEnvelope DecoratedSDoc)
    -> [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
    -> [MsgEnvelope DecoratedSDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnA (RuleDecl GhcTc)
    -> MsgEnvelope DecoratedSDoc
    LRuleDecl GhcTc -> MsgEnvelope DecoratedSDoc
    warnRules [GenLocated SrcSpanAnnA (RuleDecl GhcTc)]
    rules

        warnRules :: LRuleDecl GhcTc -> MsgEnvelope DecoratedSDoc
        warnRules :: LRuleDecl GhcTc -> MsgEnvelope DecoratedSDoc
    warnRules (L SrcSpanAnnA
    loc (HsRule { rd_name :: forall pass. RuleDecl pass -> XRec pass (SourceText, FastString)
    rd_name = XRec GhcTc (SourceText, FastString)
    n })) =
            SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainWarnMsg (SrcSpanAnnA -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    loc) (SDoc -> MsgEnvelope DecoratedSDoc)
    -> SDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                [Char] -> SDoc
    text [Char]
    "Rule \"" SDoc -> SDoc -> SDoc
    <> FastString -> SDoc
    ftext ((SourceText, FastString) -> FastString
    forall a b. (a, b) -> b
    snd ((SourceText, FastString) -> FastString)
    -> (SourceText, FastString) -> FastString
    forall a b. (a -> b) -> a -> b
    $ GenLocated SrcSpan (SourceText, FastString)
    -> (SourceText, FastString)
    forall l e. GenLocated l e -> e
    unLoc GenLocated SrcSpan (SourceText, FastString)
    XRec GhcTc (SourceText, FastString)
    n) SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    "\" ignored" SDoc -> SDoc -> SDoc
    $+$
                [Char] -> SDoc
    text [Char]
    "User defined rules are disabled under Safe Haskell"

    -- | Validate that safe imported modules are actually safe.  For modules in the
    -- HomePackage (the package the module we are compiling in resides) this just
    -- involves checking its trust type is 'Safe' or 'Trustworthy'. For modules
    -- that reside in another package we also must check that the external package
    -- is trusted. See the Note [Safe Haskell Trust Check] above for more
    -- information.
    --
    -- The code for this is quite tricky as the whole algorithm is done in a few
    -- distinct phases in different parts of the code base. See
    -- 'GHC.Rename.Names.rnImportDecl' for where package trust dependencies for a
    -- module are collected and unioned.  Specifically see the Note [Tracking Trust
    -- Transitively] in "GHC.Rename.Names" and the Note [Trust Own Package] in
    -- "GHC.Rename.Names".
    checkSafeImports :: TcGblEnv -> Hsc TcGblEnv
    checkSafeImports :: TcGblEnv -> Hsc TcGblEnv
    checkSafeImports TcGblEnv
    tcg_env
        = do
            DynFlags
    dflags <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            [(Module, SrcSpan, Bool)]
    imps <- ((Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, Bool))
    -> [(Module, [ImportedModsVal])] -> Hsc [(Module, SrcSpan, Bool)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, Bool)
    condense [(Module, [ImportedModsVal])]
    imports'
            let ([(Module, SrcSpan, Bool)]
    safeImps, [(Module, SrcSpan, Bool)]
    regImps) = ((Module, SrcSpan, Bool) -> Bool)
    -> [(Module, SrcSpan, Bool)]
    -> ([(Module, SrcSpan, Bool)], [(Module, SrcSpan, Bool)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (\(Module
    _,SrcSpan
    _,Bool
    s) -> Bool
    s) [(Module, SrcSpan, Bool)]
    imps

            -- We want to use the warning state specifically for detecting if safe
            -- inference has failed, so store and clear any existing warnings.
            WarningMessages
    oldErrs <- Hsc WarningMessages
    getWarnings
            Hsc ()
    clearWarnings

            -- Check safe imports are correct
            Set UnitId
    safePkgs <- [UnitId] -> Set UnitId
    forall a. Ord a => [a] -> Set a
    S.fromList ([UnitId] -> Set UnitId) -> Hsc [UnitId] -> Hsc (Set UnitId)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Module, SrcSpan, Bool) -> Hsc (Maybe UnitId))
    -> [(Module, SrcSpan, Bool)] -> Hsc [UnitId]
    forall (m :: * -> *) a b.
    Applicative m =>
    (a -> m (Maybe b)) -> [a] -> m [b]
    mapMaybeM (Module, SrcSpan, Bool) -> Hsc (Maybe UnitId)
    forall a. (Module, SrcSpan, a) -> Hsc (Maybe UnitId)
    checkSafe [(Module, SrcSpan, Bool)]
    safeImps
            WarningMessages
    safeErrs <- Hsc WarningMessages
    getWarnings
            Hsc ()
    clearWarnings

            -- Check non-safe imports are correct if inferring safety
            -- See the Note [Safe Haskell Inference]
            (WarningMessages
    infErrs, Set UnitId
    infPkgs) <- case (DynFlags -> Bool
    safeInferOn DynFlags
    dflags) of
              Bool
    False -> (WarningMessages, Set UnitId) -> Hsc (WarningMessages, Set UnitId)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WarningMessages
    forall a. Bag a
    emptyBag, Set UnitId
    forall a. Set a
    S.empty)
              Bool
    True -> do Set UnitId
    infPkgs <- [UnitId] -> Set UnitId
    forall a. Ord a => [a] -> Set a
    S.fromList ([UnitId] -> Set UnitId) -> Hsc [UnitId] -> Hsc (Set UnitId)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ((Module, SrcSpan, Bool) -> Hsc (Maybe UnitId))
    -> [(Module, SrcSpan, Bool)] -> Hsc [UnitId]
    forall (m :: * -> *) a b.
    Applicative m =>
    (a -> m (Maybe b)) -> [a] -> m [b]
    mapMaybeM (Module, SrcSpan, Bool) -> Hsc (Maybe UnitId)
    forall a. (Module, SrcSpan, a) -> Hsc (Maybe UnitId)
    checkSafe [(Module, SrcSpan, Bool)]
    regImps
                         WarningMessages
    infErrs <- Hsc WarningMessages
    getWarnings
                         Hsc ()
    clearWarnings
                         (WarningMessages, Set UnitId) -> Hsc (WarningMessages, Set UnitId)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WarningMessages
    infErrs, Set UnitId
    infPkgs)

            -- restore old errors
            WarningMessages -> Hsc ()
    logWarnings WarningMessages
    oldErrs

            case (WarningMessages -> Bool
    forall a. Bag a -> Bool
    isEmptyBag WarningMessages
    safeErrs) of
              -- Failed safe check
              Bool
    False -> IO TcGblEnv -> Hsc TcGblEnv
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO TcGblEnv -> Hsc TcGblEnv)
    -> (WarningMessages -> IO TcGblEnv)
    -> WarningMessages
    -> Hsc TcGblEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SourceError -> IO TcGblEnv
    forall e a. Exception e => e -> IO a
    throwIO (SourceError -> IO TcGblEnv)
    -> (WarningMessages -> SourceError)
    -> WarningMessages
    -> IO TcGblEnv
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WarningMessages -> SourceError
    mkSrcErr (WarningMessages -> Hsc TcGblEnv)
    -> WarningMessages -> Hsc TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ WarningMessages
    safeErrs

              -- Passed safe check
              Bool
    True -> do
                let infPassed :: Bool
    infPassed = WarningMessages -> Bool
    forall a. Bag a -> Bool
    isEmptyBag WarningMessages
    infErrs
                TcGblEnv
    tcg_env' <- case (Bool -> Bool
    not Bool
    infPassed) of
                  Bool
    True  -> TcGblEnv -> WarningMessages -> Hsc TcGblEnv
    markUnsafeInfer TcGblEnv
    tcg_env WarningMessages
    infErrs
                  Bool
    False -> TcGblEnv -> Hsc TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tcg_env
                Bool -> Hsc () -> Hsc ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DynFlags -> Bool
    packageTrustOn DynFlags
    dflags) (Hsc () -> Hsc ()) -> Hsc () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ Set UnitId -> Hsc ()
    checkPkgTrust Set UnitId
    pkgReqs
                let newTrust :: ImportAvails
    newTrust = DynFlags -> Set UnitId -> Set UnitId -> Bool -> ImportAvails
    pkgTrustReqs DynFlags
    dflags Set UnitId
    safePkgs Set UnitId
    infPkgs Bool
    infPassed
                TcGblEnv -> Hsc TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tcg_env' { tcg_imports :: ImportAvails
    tcg_imports = ImportAvails
    impInfo ImportAvails -> ImportAvails -> ImportAvails
    `plusImportAvails` ImportAvails
    newTrust }

      where
        impInfo :: ImportAvails
    impInfo  = TcGblEnv -> ImportAvails
    tcg_imports TcGblEnv
    tcg_env     -- ImportAvails
        imports :: ImportedMods
    imports  = ImportAvails -> ImportedMods
    imp_mods ImportAvails
    impInfo        -- ImportedMods
        imports1 :: [(Module, [ImportedBy])]
    imports1 = ImportedMods -> [(Module, [ImportedBy])]
    forall a. ModuleEnv a -> [(Module, a)]
    moduleEnvToList ImportedMods
    imports -- (Module, [ImportedBy])
        imports' :: [(Module, [ImportedModsVal])]
    imports' = ((Module, [ImportedBy]) -> (Module, [ImportedModsVal]))
    -> [(Module, [ImportedBy])] -> [(Module, [ImportedModsVal])]
    forall a b. (a -> b) -> [a] -> [b]
    map (([ImportedBy] -> [ImportedModsVal])
    -> (Module, [ImportedBy]) -> (Module, [ImportedModsVal])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [ImportedBy] -> [ImportedModsVal]
    importedByUser) [(Module, [ImportedBy])]
    imports1 -- (Module, [ImportedModsVal])
        pkgReqs :: Set UnitId
    pkgReqs  = ImportAvails -> Set UnitId
    imp_trust_pkgs ImportAvails
    impInfo  -- [Unit]

        condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, IsSafeImport)
        condense :: (Module, [ImportedModsVal]) -> Hsc (Module, SrcSpan, Bool)
    condense (Module
    _, [])   = [Char] -> Hsc (Module, SrcSpan, Bool)
    forall a. [Char] -> a
    panic [Char]
    "GHC.Driver.Main.condense: Pattern match failure!"
        condense (Module
    m, ImportedModsVal
    x:[ImportedModsVal]
    xs) = do ImportedModsVal
    imv <- (ImportedModsVal -> ImportedModsVal -> Hsc ImportedModsVal)
    -> ImportedModsVal -> [ImportedModsVal] -> Hsc ImportedModsVal
    forall (t :: * -> *) (m :: * -> *) b a.
    (Foldable t, Monad m) =>
    (b -> a -> m b) -> b -> t a -> m b
    foldlM ImportedModsVal -> ImportedModsVal -> Hsc ImportedModsVal
    cond' ImportedModsVal
    x [ImportedModsVal]
    xs
                                (Module, SrcSpan, Bool) -> Hsc (Module, SrcSpan, Bool)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Module
    m, ImportedModsVal -> SrcSpan
    imv_span ImportedModsVal
    imv, ImportedModsVal -> Bool
    imv_is_safe ImportedModsVal
    imv)

        -- ImportedModsVal = (ModuleName, Bool, SrcSpan, IsSafeImport)
        cond' :: ImportedModsVal -> ImportedModsVal -> Hsc ImportedModsVal
        cond' :: ImportedModsVal -> ImportedModsVal -> Hsc ImportedModsVal
    cond' ImportedModsVal
    v1 ImportedModsVal
    v2
            | ImportedModsVal -> Bool
    imv_is_safe ImportedModsVal
    v1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ImportedModsVal -> Bool
    imv_is_safe ImportedModsVal
    v2
            = MsgEnvelope DecoratedSDoc -> Hsc ImportedModsVal
    forall (io :: * -> *) a.
    MonadIO io =>
    MsgEnvelope DecoratedSDoc -> io a
    throwOneError (MsgEnvelope DecoratedSDoc -> Hsc ImportedModsVal)
    -> MsgEnvelope DecoratedSDoc -> Hsc ImportedModsVal
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainMsgEnvelope (ImportedModsVal -> SrcSpan
    imv_span ImportedModsVal
    v1)
                  ([Char] -> SDoc
    text [Char]
    "Module" SDoc -> SDoc -> SDoc
    <+> ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (ImportedModsVal -> ModuleName
    imv_name ImportedModsVal
    v1) SDoc -> SDoc -> SDoc
    <+>
                  ([Char] -> SDoc
    text ([Char] -> SDoc) -> [Char] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "is imported both as a safe and unsafe import!"))
            | Bool
    otherwise
            = ImportedModsVal -> Hsc ImportedModsVal
    forall (m :: * -> *) a. Monad m => a -> m a
    return ImportedModsVal
    v1

        -- easier interface to work with
        checkSafe :: (Module, SrcSpan, a) -> Hsc (Maybe UnitId)
        checkSafe :: forall a. (Module, SrcSpan, a) -> Hsc (Maybe UnitId)
    checkSafe (Module
    m, SrcSpan
    l, a
    _) = (Maybe UnitId, Set UnitId) -> Maybe UnitId
    forall a b. (a, b) -> a
    fst ((Maybe UnitId, Set UnitId) -> Maybe UnitId)
    -> Hsc (Maybe UnitId, Set UnitId) -> Hsc (Maybe UnitId)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Module -> SrcSpan -> Hsc (Maybe UnitId, Set UnitId)
    hscCheckSafe' Module
    m SrcSpan
    l

        -- what pkg's to add to our trust requirements
        pkgTrustReqs :: DynFlags -> Set UnitId -> Set UnitId ->
              Bool -> ImportAvails
        pkgTrustReqs :: DynFlags -> Set UnitId -> Set UnitId -> Bool -> ImportAvails
    pkgTrustReqs DynFlags
    dflags Set UnitId
    req Set UnitId
    inf Bool
    infPassed | DynFlags -> Bool
    safeInferOn DynFlags
    dflags
                                      Bool -> Bool -> Bool
    && Bool -> Bool
    not (DynFlags -> Bool
    safeHaskellModeEnabled DynFlags
    dflags) Bool -> Bool -> Bool
    && Bool
    infPassed
                                       = ImportAvails
    emptyImportAvails {
                                           imp_trust_pkgs :: Set UnitId
    imp_trust_pkgs = Set UnitId
    req Set UnitId -> Set UnitId -> Set UnitId
    forall a. Ord a => Set a -> Set a -> Set a
    `S.union` Set UnitId
    inf
                                       }
        pkgTrustReqs DynFlags
    dflags Set UnitId
    _   Set UnitId
    _ Bool
    _ | DynFlags -> SafeHaskellMode
    safeHaskell DynFlags
    dflags SafeHaskellMode -> SafeHaskellMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == SafeHaskellMode
    Sf_Unsafe
                             = ImportAvails
    emptyImportAvails
        pkgTrustReqs DynFlags
    _ Set UnitId
    req Set UnitId
    _ Bool
    _ = ImportAvails
    emptyImportAvails { imp_trust_pkgs :: Set UnitId
    imp_trust_pkgs = Set UnitId
    req }

    -- | Check that a module is safe to import.
    --
    -- We return True to indicate the import is safe and False otherwise
    -- although in the False case an exception may be thrown first.
    hscCheckSafe :: HscEnv -> Module -> SrcSpan -> IO Bool
    hscCheckSafe :: HscEnv -> Module -> SrcSpan -> IO Bool
    hscCheckSafe HscEnv
    hsc_env Module
    m SrcSpan
    l = HscEnv -> Hsc Bool -> IO Bool
    forall a. HscEnv -> Hsc a -> IO a
    runHsc HscEnv
    hsc_env (Hsc Bool -> IO Bool) -> Hsc Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ do
        DynFlags
    dflags <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        Set UnitId
    pkgs <- (Maybe UnitId, Set UnitId) -> Set UnitId
    forall a b. (a, b) -> b
    snd ((Maybe UnitId, Set UnitId) -> Set UnitId)
    -> Hsc (Maybe UnitId, Set UnitId) -> Hsc (Set UnitId)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Module -> SrcSpan -> Hsc (Maybe UnitId, Set UnitId)
    hscCheckSafe' Module
    m SrcSpan
    l
        Bool -> Hsc () -> Hsc ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DynFlags -> Bool
    packageTrustOn DynFlags
    dflags) (Hsc () -> Hsc ()) -> Hsc () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ Set UnitId -> Hsc ()
    checkPkgTrust Set UnitId
    pkgs
        WarningMessages
    errs <- Hsc WarningMessages
    getWarnings
        Bool -> Hsc Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool -> Hsc Bool) -> Bool -> Hsc Bool
    forall a b. (a -> b) -> a -> b
    $ WarningMessages -> Bool
    forall a. Bag a -> Bool
    isEmptyBag WarningMessages
    errs

    -- | Return if a module is trusted and the pkgs it depends on to be trusted.
    hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set UnitId)
    hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set UnitId)
    hscGetSafe HscEnv
    hsc_env Module
    m SrcSpan
    l = HscEnv -> Hsc (Bool, Set UnitId) -> IO (Bool, Set UnitId)
    forall a. HscEnv -> Hsc a -> IO a
    runHsc HscEnv
    hsc_env (Hsc (Bool, Set UnitId) -> IO (Bool, Set UnitId))
    -> Hsc (Bool, Set UnitId) -> IO (Bool, Set UnitId)
    forall a b. (a -> b) -> a -> b
    $ do
        (Maybe UnitId
    self, Set UnitId
    pkgs) <- Module -> SrcSpan -> Hsc (Maybe UnitId, Set UnitId)
    hscCheckSafe' Module
    m SrcSpan
    l
        Bool
    good         <- WarningMessages -> Bool
    forall a. Bag a -> Bool
    isEmptyBag (WarningMessages -> Bool) -> Hsc WarningMessages -> Hsc Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` Hsc WarningMessages
    getWarnings
        Hsc ()
    clearWarnings -- don't want them printed...
        let pkgs' :: Set UnitId
    pkgs' | Just UnitId
    p <- Maybe UnitId
    self = UnitId -> Set UnitId -> Set UnitId
    forall a. Ord a => a -> Set a -> Set a
    S.insert UnitId
    p Set UnitId
    pkgs
                  | Bool
    otherwise      = Set UnitId
    pkgs
        (Bool, Set UnitId) -> Hsc (Bool, Set UnitId)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    good, Set UnitId
    pkgs')

    -- | Is a module trusted? If not, throw or log errors depending on the type.
    -- Return (regardless of trusted or not) if the trust type requires the modules
    -- own package be trusted and a list of other packages required to be trusted
    -- (these later ones haven't been checked) but the own package trust has been.
    hscCheckSafe' :: Module -> SrcSpan
      -> Hsc (Maybe UnitId, Set UnitId)
    hscCheckSafe' :: Module -> SrcSpan -> Hsc (Maybe UnitId, Set UnitId)
    hscCheckSafe' Module
    m SrcSpan
    l = do
        HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
        let home_unit :: HomeUnit
    home_unit = HscEnv -> HomeUnit
    hsc_home_unit HscEnv
    hsc_env
        (Bool
    tw, Set UnitId
    pkgs) <- HomeUnit -> Module -> SrcSpan -> Hsc (Bool, Set UnitId)
    isModSafe HomeUnit
    home_unit Module
    m SrcSpan
    l
        case Bool
    tw of
            Bool
    False                           -> (Maybe UnitId, Set UnitId) -> Hsc (Maybe UnitId, Set UnitId)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe UnitId
    forall a. Maybe a
    Nothing, Set UnitId
    pkgs)
            Bool
    True | HomeUnit -> Module -> Bool
    isHomeModule HomeUnit
    home_unit Module
    m -> (Maybe UnitId, Set UnitId) -> Hsc (Maybe UnitId, Set UnitId)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe UnitId
    forall a. Maybe a
    Nothing, Set UnitId
    pkgs)
                 -- TODO: do we also have to check the trust of the instantiation?
                 -- Not necessary if that is reflected in dependencies
                 | Bool
    otherwise   -> (Maybe UnitId, Set UnitId) -> Hsc (Maybe UnitId, Set UnitId)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UnitId -> Maybe UnitId
    forall a. a -> Maybe a
    Just (UnitId -> Maybe UnitId) -> UnitId -> Maybe UnitId
    forall a b. (a -> b) -> a -> b
    $ Unit -> UnitId
    toUnitId (Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    m), Set UnitId
    pkgs)
      where
        isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, Set UnitId)
        isModSafe :: HomeUnit -> Module -> SrcSpan -> Hsc (Bool, Set UnitId)
    isModSafe HomeUnit
    home_unit Module
    m SrcSpan
    l = do
            HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
            DynFlags
    dflags <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            Maybe ModIface
    iface <- Module -> Hsc (Maybe ModIface)
    lookup' Module
    m
            case Maybe ModIface
    iface of
                -- can't load iface to check trust!
                Maybe ModIface
    Nothing -> MsgEnvelope DecoratedSDoc -> Hsc (Bool, Set UnitId)
    forall (io :: * -> *) a.
    MonadIO io =>
    MsgEnvelope DecoratedSDoc -> io a
    throwOneError (MsgEnvelope DecoratedSDoc -> Hsc (Bool, Set UnitId))
    -> MsgEnvelope DecoratedSDoc -> Hsc (Bool, Set UnitId)
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainMsgEnvelope SrcSpan
    l
                             (SDoc -> MsgEnvelope DecoratedSDoc)
    -> SDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [Char] -> SDoc
    text [Char]
    "Can't load the interface file for" SDoc -> SDoc -> SDoc
    <+> Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    m
                               SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    ", to check that it can be safely imported"

                -- got iface, check trust
                Just ModIface
    iface' ->
                    let trust :: SafeHaskellMode
    trust = IfaceTrustInfo -> SafeHaskellMode
    getSafeMode (IfaceTrustInfo -> SafeHaskellMode)
    -> IfaceTrustInfo -> SafeHaskellMode
    forall a b. (a -> b) -> a -> b
    $ ModIface -> IfaceTrustInfo
    forall (phase :: ModIfacePhase). ModIface_ phase -> IfaceTrustInfo
    mi_trust ModIface
    iface'
                        trust_own_pkg :: Bool
    trust_own_pkg = ModIface -> Bool
    forall (phase :: ModIfacePhase). ModIface_ phase -> Bool
    mi_trust_pkg ModIface
    iface'
                        -- check module is trusted
                        safeM :: Bool
    safeM = SafeHaskellMode
    trust SafeHaskellMode -> [SafeHaskellMode] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [SafeHaskellMode
    Sf_Safe, SafeHaskellMode
    Sf_SafeInferred, SafeHaskellMode
    Sf_Trustworthy]
                        -- check package is trusted
                        safeP :: Bool
    safeP = DynFlags
    -> UnitState
    -> HomeUnit
    -> SafeHaskellMode
    -> Bool
    -> Module
    -> Bool
    packageTrusted DynFlags
    dflags (HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env) HomeUnit
    home_unit SafeHaskellMode
    trust Bool
    trust_own_pkg Module
    m
                        -- pkg trust reqs
                        pkgRs :: Set UnitId
    pkgRs = [UnitId] -> Set UnitId
    forall a. Ord a => [a] -> Set a
    S.fromList ([UnitId] -> Set UnitId)
    -> ([(UnitId, Bool)] -> [UnitId]) -> [(UnitId, Bool)] -> Set UnitId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((UnitId, Bool) -> UnitId) -> [(UnitId, Bool)] -> [UnitId]
    forall a b. (a -> b) -> [a] -> [b]
    map (UnitId, Bool) -> UnitId
    forall a b. (a, b) -> a
    fst ([(UnitId, Bool)] -> Set UnitId) -> [(UnitId, Bool)] -> Set UnitId
    forall a b. (a -> b) -> a -> b
    $ ((UnitId, Bool) -> Bool) -> [(UnitId, Bool)] -> [(UnitId, Bool)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (UnitId, Bool) -> Bool
    forall a b. (a, b) -> b
    snd ([(UnitId, Bool)] -> [(UnitId, Bool)])
    -> [(UnitId, Bool)] -> [(UnitId, Bool)]
    forall a b. (a -> b) -> a -> b
    $ Dependencies -> [(UnitId, Bool)]
    dep_pkgs (Dependencies -> [(UnitId, Bool)])
    -> Dependencies -> [(UnitId, Bool)]
    forall a b. (a -> b) -> a -> b
    $ ModIface -> Dependencies
    forall (phase :: ModIfacePhase). ModIface_ phase -> Dependencies
    mi_deps ModIface
    iface'
                        -- warn if Safe module imports Safe-Inferred module.
                        warns :: WarningMessages
    warns = if WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnInferredSafeImports DynFlags
    dflags
                                    Bool -> Bool -> Bool
    && DynFlags -> Bool
    safeLanguageOn DynFlags
    dflags
                                    Bool -> Bool -> Bool
    && SafeHaskellMode
    trust SafeHaskellMode -> SafeHaskellMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == SafeHaskellMode
    Sf_SafeInferred
                                    then WarningMessages
    inferredImportWarn
                                    else WarningMessages
    forall a. Bag a
    emptyBag
                        -- General errors we throw but Safe errors we log
                        errs :: WarningMessages
    errs = case (Bool
    safeM, Bool
    safeP) of
                            (Bool
    True, Bool
    True ) -> WarningMessages
    forall a. Bag a
    emptyBag
                            (Bool
    True, Bool
    False) -> WarningMessages
    pkgTrustErr
                            (Bool
    False, Bool
    _   ) -> WarningMessages
    modTrustErr
                    in do
                        WarningMessages -> Hsc ()
    logWarnings WarningMessages
    warns
                        WarningMessages -> Hsc ()
    logWarnings WarningMessages
    errs
                        (Bool, Set UnitId) -> Hsc (Bool, Set UnitId)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SafeHaskellMode
    trust SafeHaskellMode -> SafeHaskellMode -> Bool
    forall a. Eq a => a -> a -> Bool
    == SafeHaskellMode
    Sf_Trustworthy, Set UnitId
    pkgRs)

                    where
                        state :: UnitState
    state = HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env
                        inferredImportWarn :: WarningMessages
    inferredImportWarn = MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a. a -> Bag a
    unitBag
                            (MsgEnvelope DecoratedSDoc -> WarningMessages)
    -> MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a b. (a -> b) -> a -> b
    $ WarnReason
    -> MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc
    forall e. WarnReason -> MsgEnvelope e -> MsgEnvelope e
    makeIntoWarning (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnInferredSafeImports)
                            (MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc)
    -> MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
    mkWarnMsg SrcSpan
    l (UnitState -> PrintUnqualified
    pkgQual UnitState
    state)
                            (SDoc -> MsgEnvelope DecoratedSDoc)
    -> SDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    sep
                                [ [Char] -> SDoc
    text [Char]
    "Importing Safe-Inferred module "
                                    SDoc -> SDoc -> SDoc
    <> ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    m)
                                    SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    " from explicitly Safe module"
                                ]
                        pkgTrustErr :: WarningMessages
    pkgTrustErr = MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a. a -> Bag a
    unitBag (MsgEnvelope DecoratedSDoc -> WarningMessages)
    -> MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
    mkMsgEnvelope SrcSpan
    l (UnitState -> PrintUnqualified
    pkgQual UnitState
    state) (SDoc -> MsgEnvelope DecoratedSDoc)
    -> SDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                            [SDoc] -> SDoc
    sep [ ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    m)
                                    SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    ": Can't be safely imported!"
                                , [Char] -> SDoc
    text [Char]
    "The package ("
                                    SDoc -> SDoc -> SDoc
    <> (UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    state (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Unit -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    m))
                                    SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    ") the module resides in isn't trusted."
                                ]
                        modTrustErr :: WarningMessages
    modTrustErr = MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a. a -> Bag a
    unitBag (MsgEnvelope DecoratedSDoc -> WarningMessages)
    -> MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
    mkMsgEnvelope SrcSpan
    l (UnitState -> PrintUnqualified
    pkgQual UnitState
    state) (SDoc -> MsgEnvelope DecoratedSDoc)
    -> SDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                            [SDoc] -> SDoc
    sep [ ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    m)
                                    SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    ": Can't be safely imported!"
                                , [Char] -> SDoc
    text [Char]
    "The module itself isn't safe." ]

        -- | Check the package a module resides in is trusted. Safe compiled
        -- modules are trusted without requiring that their package is trusted. For
        -- trustworthy modules, modules in the home package are trusted but
        -- otherwise we check the package trust flag.
        packageTrusted :: DynFlags -> UnitState -> HomeUnit -> SafeHaskellMode -> Bool -> Module -> Bool
        packageTrusted :: DynFlags
    -> UnitState
    -> HomeUnit
    -> SafeHaskellMode
    -> Bool
    -> Module
    -> Bool
    packageTrusted DynFlags
    dflags UnitState
    unit_state HomeUnit
    home_unit SafeHaskellMode
    safe_mode Bool
    trust_own_pkg Module
    mod =
            case SafeHaskellMode
    safe_mode of
                SafeHaskellMode
    Sf_None      -> Bool
    False -- shouldn't hit these cases
                SafeHaskellMode
    Sf_Ignore    -> Bool
    False -- shouldn't hit these cases
                SafeHaskellMode
    Sf_Unsafe    -> Bool
    False -- prefer for completeness.
                SafeHaskellMode
    _ | Bool -> Bool
    not (DynFlags -> Bool
    packageTrustOn DynFlags
    dflags)     -> Bool
    True
                SafeHaskellMode
    Sf_Safe | Bool -> Bool
    not Bool
    trust_own_pkg         -> Bool
    True
                SafeHaskellMode
    Sf_SafeInferred | Bool -> Bool
    not Bool
    trust_own_pkg -> Bool
    True
                SafeHaskellMode
    _ | HomeUnit -> Module -> Bool
    isHomeModule HomeUnit
    home_unit Module
    mod      -> Bool
    True
                SafeHaskellMode
    _ -> GenericUnitInfo
      (Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
    -> Bool
    forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> Bool
    unitIsTrusted (GenericUnitInfo
       (Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
     -> Bool)
    -> GenericUnitInfo
         (Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
    -> Bool
    forall a b. (a -> b) -> a -> b
    $ HasDebugCallStack =>
    UnitState
    -> Unit
    -> GenericUnitInfo
         (Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
    UnitState
    -> Unit
    -> GenericUnitInfo
         (Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
    unsafeLookupUnit UnitState
    unit_state (Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    m)

        lookup' :: Module -> Hsc (Maybe ModIface)
        lookup' :: Module -> Hsc (Maybe ModIface)
    lookup' Module
    m = do
            HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
            ExternalPackageState
    hsc_eps <- IO ExternalPackageState -> Hsc ExternalPackageState
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ExternalPackageState -> Hsc ExternalPackageState)
    -> IO ExternalPackageState -> Hsc ExternalPackageState
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> IO ExternalPackageState
    hscEPS HscEnv
    hsc_env
            let pkgIfaceT :: PackageIfaceTable
    pkgIfaceT = ExternalPackageState -> PackageIfaceTable
    eps_PIT ExternalPackageState
    hsc_eps
                homePkgT :: HomePackageTable
    homePkgT  = HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    hsc_env
                iface :: Maybe ModIface
    iface     = HomePackageTable -> PackageIfaceTable -> Module -> Maybe ModIface
    lookupIfaceByModule HomePackageTable
    homePkgT PackageIfaceTable
    pkgIfaceT Module
    m
            -- the 'lookupIfaceByModule' method will always fail when calling from GHCi
            -- as the compiler hasn't filled in the various module tables
            -- so we need to call 'getModuleInterface' to load from disk
            case Maybe ModIface
    iface of
                Just ModIface
    _  -> Maybe ModIface -> Hsc (Maybe ModIface)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ModIface
    iface
                Maybe ModIface
    Nothing -> (Messages DecoratedSDoc, Maybe ModIface) -> Maybe ModIface
    forall a b. (a, b) -> b
    snd ((Messages DecoratedSDoc, Maybe ModIface) -> Maybe ModIface)
    -> Hsc (Messages DecoratedSDoc, Maybe ModIface)
    -> Hsc (Maybe ModIface)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (IO (Messages DecoratedSDoc, Maybe ModIface)
    -> Hsc (Messages DecoratedSDoc, Maybe ModIface)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Messages DecoratedSDoc, Maybe ModIface)
     -> Hsc (Messages DecoratedSDoc, Maybe ModIface))
    -> IO (Messages DecoratedSDoc, Maybe ModIface)
    -> Hsc (Messages DecoratedSDoc, Maybe ModIface)
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> Module -> IO (Messages DecoratedSDoc, Maybe ModIface)
    getModuleInterface HscEnv
    hsc_env Module
    m)

    -- | Check the list of packages are trusted.
    checkPkgTrust :: Set UnitId -> Hsc ()
    checkPkgTrust :: Set UnitId -> Hsc ()
    checkPkgTrust Set UnitId
    pkgs = do
        HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
        let errors :: [MsgEnvelope DecoratedSDoc]
    errors = (UnitId
     -> [MsgEnvelope DecoratedSDoc] -> [MsgEnvelope DecoratedSDoc])
    -> [MsgEnvelope DecoratedSDoc]
    -> Set UnitId
    -> [MsgEnvelope DecoratedSDoc]
    forall a b. (a -> b -> b) -> b -> Set a -> b
    S.foldr UnitId
    -> [MsgEnvelope DecoratedSDoc] -> [MsgEnvelope DecoratedSDoc]
    go [] Set UnitId
    pkgs
            state :: UnitState
    state  = HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env
            go :: UnitId
    -> [MsgEnvelope DecoratedSDoc] -> [MsgEnvelope DecoratedSDoc]
    go UnitId
    pkg [MsgEnvelope DecoratedSDoc]
    acc
                | GenericUnitInfo
      (Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
    -> Bool
    forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> Bool
    unitIsTrusted (GenericUnitInfo
       (Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
     -> Bool)
    -> GenericUnitInfo
         (Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
    -> Bool
    forall a b. (a -> b) -> a -> b
    $ HasDebugCallStack =>
    UnitState
    -> UnitId
    -> GenericUnitInfo
         (Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
    UnitState
    -> UnitId
    -> GenericUnitInfo
         (Indefinite UnitId) PackageId PackageName UnitId ModuleName Module
    unsafeLookupUnitId UnitState
    state UnitId
    pkg
                = [MsgEnvelope DecoratedSDoc]
    acc
                | Bool
    otherwise
                = (MsgEnvelope DecoratedSDoc
    -> [MsgEnvelope DecoratedSDoc] -> [MsgEnvelope DecoratedSDoc]
    forall a. a -> [a] -> [a]
    :[MsgEnvelope DecoratedSDoc]
    acc) (MsgEnvelope DecoratedSDoc -> [MsgEnvelope DecoratedSDoc])
    -> MsgEnvelope DecoratedSDoc -> [MsgEnvelope DecoratedSDoc]
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
    mkMsgEnvelope SrcSpan
    noSrcSpan (UnitState -> PrintUnqualified
    pkgQual UnitState
    state)
                         (SDoc -> MsgEnvelope DecoratedSDoc)
    -> SDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    state
                         (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [Char] -> SDoc
    text [Char]
    "The package ("
                            SDoc -> SDoc -> SDoc
    <> UnitId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr UnitId
    pkg
                            SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    ") is required to be trusted but it isn't!"
        case [MsgEnvelope DecoratedSDoc]
    errors of
            [] -> () -> Hsc ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            [MsgEnvelope DecoratedSDoc]
    _  -> (IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ())
    -> ([MsgEnvelope DecoratedSDoc] -> IO ())
    -> [MsgEnvelope DecoratedSDoc]
    -> Hsc ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SourceError -> IO ()
    forall e a. Exception e => e -> IO a
    throwIO (SourceError -> IO ())
    -> ([MsgEnvelope DecoratedSDoc] -> SourceError)
    -> [MsgEnvelope DecoratedSDoc]
    -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WarningMessages -> SourceError
    mkSrcErr (WarningMessages -> SourceError)
    -> ([MsgEnvelope DecoratedSDoc] -> WarningMessages)
    -> [MsgEnvelope DecoratedSDoc]
    -> SourceError
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [MsgEnvelope DecoratedSDoc] -> WarningMessages
    forall a. [a] -> Bag a
    listToBag) [MsgEnvelope DecoratedSDoc]
    errors

    -- | Set module to unsafe and (potentially) wipe trust information.
    --
    -- Make sure to call this method to set a module to inferred unsafe, it should
    -- be a central and single failure method. We only wipe the trust information
    -- when we aren't in a specific Safe Haskell mode.
    --
    -- While we only use this for recording that a module was inferred unsafe, we
    -- may call it on modules using Trustworthy or Unsafe flags so as to allow
    -- warning flags for safety to function correctly. See Note [Safe Haskell
    -- Inference].
    markUnsafeInfer :: TcGblEnv -> WarningMessages -> Hsc TcGblEnv
    markUnsafeInfer :: TcGblEnv -> WarningMessages -> Hsc TcGblEnv
    markUnsafeInfer TcGblEnv
    tcg_env WarningMessages
    whyUnsafe = do
        DynFlags
    dflags <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags

        Bool -> Hsc () -> Hsc ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    Opt_WarnUnsafe DynFlags
    dflags)
             (WarningMessages -> Hsc ()
    logWarnings (WarningMessages -> Hsc ()) -> WarningMessages -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a. a -> Bag a
    unitBag (MsgEnvelope DecoratedSDoc -> WarningMessages)
    -> MsgEnvelope DecoratedSDoc -> WarningMessages
    forall a b. (a -> b) -> a -> b
    $ WarnReason
    -> MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc
    forall e. WarnReason -> MsgEnvelope e -> MsgEnvelope e
    makeIntoWarning (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnUnsafe) (MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc)
    -> MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                 SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainWarnMsg (DynFlags -> SrcSpan
    warnUnsafeOnLoc DynFlags
    dflags) (DynFlags -> SDoc
    whyUnsafe' DynFlags
    dflags))

        IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ IORef (Bool, WarningMessages) -> (Bool, WarningMessages) -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef (TcGblEnv -> IORef (Bool, WarningMessages)
    tcg_safeInfer TcGblEnv
    tcg_env) (Bool
    False, WarningMessages
    whyUnsafe)
        -- NOTE: Only wipe trust when not in an explicitly safe haskell mode. Other
        -- times inference may be on but we are in Trustworthy mode -- so we want
        -- to record safe-inference failed but not wipe the trust dependencies.
        case Bool -> Bool
    not (DynFlags -> Bool
    safeHaskellModeEnabled DynFlags
    dflags) of
          Bool
    True  -> TcGblEnv -> Hsc TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv -> Hsc TcGblEnv) -> TcGblEnv -> Hsc TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ TcGblEnv
    tcg_env { tcg_imports :: ImportAvails
    tcg_imports = ImportAvails
    wiped_trust }
          Bool
    False -> TcGblEnv -> Hsc TcGblEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return TcGblEnv
    tcg_env

      where
        wiped_trust :: ImportAvails
    wiped_trust   = (TcGblEnv -> ImportAvails
    tcg_imports TcGblEnv
    tcg_env) { imp_trust_pkgs :: Set UnitId
    imp_trust_pkgs = Set UnitId
    forall a. Set a
    S.empty }
        pprMod :: SDoc
    pprMod        = ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (ModuleName -> SDoc) -> ModuleName -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName (Module -> ModuleName) -> Module -> ModuleName
    forall a b. (a -> b) -> a -> b
    $ TcGblEnv -> Module
    tcg_mod TcGblEnv
    tcg_env
        whyUnsafe' :: DynFlags -> SDoc
    whyUnsafe' DynFlags
    df = [SDoc] -> SDoc
    vcat [ SDoc -> SDoc
    quotes SDoc
    pprMod SDoc -> SDoc -> SDoc
    <+> [Char] -> SDoc
    text [Char]
    "has been inferred as unsafe!"
                             , [Char] -> SDoc
    text [Char]
    "Reason:"
                             , Int -> SDoc -> SDoc
    nest Int
    4 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ ([SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> [SDoc]
    badFlags DynFlags
    df) SDoc -> SDoc -> SDoc
    $+$
                                        ([SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ WarningMessages -> [SDoc]
    pprMsgEnvelopeBagWithLoc WarningMessages
    whyUnsafe) SDoc -> SDoc -> SDoc
    $+$
                                        ([SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [ClsInst] -> [SDoc]
    forall {t :: * -> *}. Foldable t => t ClsInst -> [SDoc]
    badInsts ([ClsInst] -> [SDoc]) -> [ClsInst] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ TcGblEnv -> [ClsInst]
    tcg_insts TcGblEnv
    tcg_env)
                             ]
        badFlags :: DynFlags -> [SDoc]
    badFlags DynFlags
    df   = (([Char], DynFlags -> SrcSpan, DynFlags -> Bool,
      DynFlags -> DynFlags)
     -> [SDoc])
    -> [([Char], DynFlags -> SrcSpan, DynFlags -> Bool,
         DynFlags -> DynFlags)]
    -> [SDoc]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (DynFlags
    -> ([Char], DynFlags -> SrcSpan, DynFlags -> Bool,
        DynFlags -> DynFlags)
    -> [SDoc]
    forall {t} {d}. t -> ([Char], t -> SrcSpan, t -> Bool, d) -> [SDoc]
    badFlag DynFlags
    df) [([Char], DynFlags -> SrcSpan, DynFlags -> Bool,
      DynFlags -> DynFlags)]
    unsafeFlagsForInfer
        badFlag :: t -> ([Char], t -> SrcSpan, t -> Bool, d) -> [SDoc]
    badFlag t
    df ([Char]
    str,t -> SrcSpan
    loc,t -> Bool
    on,d
    _)
            | t -> Bool
    on t
    df     = [Severity -> SrcSpan -> SDoc -> SDoc
    mkLocMessage Severity
    SevOutput (t -> SrcSpan
    loc t
    df) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                                [Char] -> SDoc
    text [Char]
    str SDoc -> SDoc -> SDoc
    <+> [Char] -> SDoc
    text [Char]
    "is not allowed in Safe Haskell"]
            | Bool
    otherwise = []
        badInsts :: t ClsInst -> [SDoc]
    badInsts t ClsInst
    insts = (ClsInst -> [SDoc]) -> t ClsInst -> [SDoc]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ClsInst -> [SDoc]
    badInst t ClsInst
    insts

        checkOverlap :: OverlapMode -> Bool
    checkOverlap (NoOverlap SourceText
    _) = Bool
    False
        checkOverlap OverlapMode
    _             = Bool
    True

        badInst :: ClsInst -> [SDoc]
    badInst ClsInst
    ins | OverlapMode -> Bool
    checkOverlap (OverlapFlag -> OverlapMode
    overlapMode (ClsInst -> OverlapFlag
    is_flag ClsInst
    ins))
                    = [Severity -> SrcSpan -> SDoc -> SDoc
    mkLocMessage Severity
    SevOutput (Name -> SrcSpan
    nameSrcSpan (Name -> SrcSpan) -> Name -> SrcSpan
    forall a b. (a -> b) -> a -> b
    $ Id -> Name
    forall a. NamedThing a => a -> Name
    getName (Id -> Name) -> Id -> Name
    forall a b. (a -> b) -> a -> b
    $ ClsInst -> Id
    is_dfun ClsInst
    ins) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                          OverlapMode -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (OverlapFlag -> OverlapMode
    overlapMode (OverlapFlag -> OverlapMode) -> OverlapFlag -> OverlapMode
    forall a b. (a -> b) -> a -> b
    $ ClsInst -> OverlapFlag
    is_flag ClsInst
    ins) SDoc -> SDoc -> SDoc
    <+>
                          [Char] -> SDoc
    text [Char]
    "overlap mode isn't allowed in Safe Haskell"]
                    | Bool
    otherwise = []

    -- | Figure out the final correct safe haskell mode
    hscGetSafeMode :: TcGblEnv -> Hsc SafeHaskellMode
    hscGetSafeMode :: TcGblEnv -> Hsc SafeHaskellMode
    hscGetSafeMode TcGblEnv
    tcg_env = do
        DynFlags
    dflags  <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        IO SafeHaskellMode -> Hsc SafeHaskellMode
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO SafeHaskellMode -> Hsc SafeHaskellMode)
    -> IO SafeHaskellMode -> Hsc SafeHaskellMode
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> TcGblEnv -> IO SafeHaskellMode
    finalSafeMode DynFlags
    dflags TcGblEnv
    tcg_env

    --------------------------------------------------------------
    -- Simplifiers
    --------------------------------------------------------------

    -- | Run Core2Core simplifier. The list of String is a list of (Core) plugin
    -- module names added via TH (cf 'addCorePlugin').
    hscSimplify :: HscEnv -> [String] -> ModGuts -> IO ModGuts
    hscSimplify :: HscEnv -> [[Char]] -> ModGuts -> IO ModGuts
    hscSimplify HscEnv
    hsc_env [[Char]]
    plugins ModGuts
    modguts =
        HscEnv -> Hsc ModGuts -> IO ModGuts
    forall a. HscEnv -> Hsc a -> IO a
    runHsc HscEnv
    hsc_env (Hsc ModGuts -> IO ModGuts) -> Hsc ModGuts -> IO ModGuts
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> ModGuts -> Hsc ModGuts
    hscSimplify' [[Char]]
    plugins ModGuts
    modguts

    -- | Run Core2Core simplifier. The list of String is a list of (Core) plugin
    -- module names added via TH (cf 'addCorePlugin').
    hscSimplify' :: [String] -> ModGuts -> Hsc ModGuts
    hscSimplify' :: [[Char]] -> ModGuts -> Hsc ModGuts
    hscSimplify' [[Char]]
    plugins ModGuts
    ds_result = do
        HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
        HscEnv
    hsc_env_with_plugins <- if [[Char]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Char]]
    plugins -- fast path
            then HscEnv -> Hsc HscEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return HscEnv
    hsc_env
            else IO HscEnv -> Hsc HscEnv
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO HscEnv -> Hsc HscEnv) -> IO HscEnv -> Hsc HscEnv
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> IO HscEnv
    initializePlugins (HscEnv -> IO HscEnv) -> HscEnv -> IO HscEnv
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    hsc_env
                    { hsc_dflags :: DynFlags
    hsc_dflags = ([Char] -> DynFlags -> DynFlags)
    -> DynFlags -> [[Char]] -> DynFlags
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr [Char] -> DynFlags -> DynFlags
    addPluginModuleName (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) [[Char]]
    plugins
                    }
        {-# SCC "Core2Core" #-}
          IO ModGuts -> Hsc ModGuts
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ModGuts -> Hsc ModGuts) -> IO ModGuts -> Hsc ModGuts
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> ModGuts -> IO ModGuts
    core2core HscEnv
    hsc_env_with_plugins ModGuts
    ds_result

    --------------------------------------------------------------
    -- Interface generators
    --------------------------------------------------------------

    -- | Generate a striped down interface file, e.g. for boot files or when ghci
    -- generates interface files. See Note [simpleTidyPgm - mkBootModDetailsTc]
    hscSimpleIface :: HscEnv
                   -> TcGblEnv
                   -> Maybe Fingerprint
                   -> IO (ModIface, Maybe Fingerprint, ModDetails)
    hscSimpleIface :: HscEnv
    -> TcGblEnv
    -> Maybe Fingerprint
    -> IO (ModIface, Maybe Fingerprint, ModDetails)
    hscSimpleIface HscEnv
    hsc_env TcGblEnv
    tc_result Maybe Fingerprint
    mb_old_iface
        = HscEnv
    -> Hsc (ModIface, Maybe Fingerprint, ModDetails)
    -> IO (ModIface, Maybe Fingerprint, ModDetails)
    forall a. HscEnv -> Hsc a -> IO a
    runHsc HscEnv
    hsc_env (Hsc (ModIface, Maybe Fingerprint, ModDetails)
     -> IO (ModIface, Maybe Fingerprint, ModDetails))
    -> Hsc (ModIface, Maybe Fingerprint, ModDetails)
    -> IO (ModIface, Maybe Fingerprint, ModDetails)
    forall a b. (a -> b) -> a -> b
    $ TcGblEnv
    -> Maybe Fingerprint
    -> Hsc (ModIface, Maybe Fingerprint, ModDetails)
    hscSimpleIface' TcGblEnv
    tc_result Maybe Fingerprint
    mb_old_iface

    hscSimpleIface' :: TcGblEnv
                    -> Maybe Fingerprint
                    -> Hsc (ModIface, Maybe Fingerprint, ModDetails)
    hscSimpleIface' :: TcGblEnv
    -> Maybe Fingerprint
    -> Hsc (ModIface, Maybe Fingerprint, ModDetails)
    hscSimpleIface' TcGblEnv
    tc_result Maybe Fingerprint
    mb_old_iface = do
        HscEnv
    hsc_env   <- Hsc HscEnv
    getHscEnv
        ModDetails
    details   <- IO ModDetails -> Hsc ModDetails
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ModDetails -> Hsc ModDetails)
    -> IO ModDetails -> Hsc ModDetails
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> TcGblEnv -> IO ModDetails
    mkBootModDetailsTc HscEnv
    hsc_env TcGblEnv
    tc_result
        SafeHaskellMode
    safe_mode <- TcGblEnv -> Hsc SafeHaskellMode
    hscGetSafeMode TcGblEnv
    tc_result
        ModIface
    new_iface
            <- {-# SCC "MkFinalIface" #-}
               IO ModIface -> Hsc ModIface
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ModIface -> Hsc ModIface) -> IO ModIface -> Hsc ModIface
    forall a b. (a -> b) -> a -> b
    $
                   HscEnv -> SafeHaskellMode -> ModDetails -> TcGblEnv -> IO ModIface
    mkIfaceTc HscEnv
    hsc_env SafeHaskellMode
    safe_mode ModDetails
    details TcGblEnv
    tc_result
        -- And the answer is ...
        IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> IO ()
    dumpIfaceStats HscEnv
    hsc_env
        (ModIface, Maybe Fingerprint, ModDetails)
    -> Hsc (ModIface, Maybe Fingerprint, ModDetails)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModIface
    new_iface, Maybe Fingerprint
    mb_old_iface, ModDetails
    details)

    --------------------------------------------------------------
    -- BackEnd combinators
    --------------------------------------------------------------

    -- | Compile to hard-code.
    hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath
                   -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], CgInfos)
                   -- ^ @Just f@ <=> _stub.c is f
    hscGenHardCode :: HscEnv
    -> CgGuts
    -> ModLocation
    -> [Char]
    -> IO ([Char], Maybe [Char], [(ForeignSrcLang, [Char])], CgInfos)
    hscGenHardCode HscEnv
    hsc_env CgGuts
    cgguts ModLocation
    location [Char]
    output_filename = do
            let CgGuts{ -- This is the last use of the ModGuts in a compilation.
                        -- From now on, we just use the bits we need.
                        cg_module :: CgGuts -> Module
    cg_module   = Module
    this_mod,
                        cg_binds :: CgGuts -> CoreProgram
    cg_binds    = CoreProgram
    core_binds,
                        cg_tycons :: CgGuts -> [TyCon]
    cg_tycons   = [TyCon]
    tycons,
                        cg_foreign :: CgGuts -> ForeignStubs
    cg_foreign  = ForeignStubs
    foreign_stubs0,
                        cg_foreign_files :: CgGuts -> [(ForeignSrcLang, [Char])]
    cg_foreign_files = [(ForeignSrcLang, [Char])]
    foreign_files,
                        cg_dep_pkgs :: CgGuts -> [UnitId]
    cg_dep_pkgs = [UnitId]
    dependencies,
                        cg_hpc_info :: CgGuts -> HpcInfo
    cg_hpc_info = HpcInfo
    hpc_info } = CgGuts
    cgguts
                dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
                logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
                hooks :: Hooks
    hooks  = HscEnv -> Hooks
    hsc_hooks HscEnv
    hsc_env
                tmpfs :: TmpFs
    tmpfs  = HscEnv -> TmpFs
    hsc_tmpfs HscEnv
    hsc_env
                data_tycons :: [TyCon]
    data_tycons = (TyCon -> Bool) -> [TyCon] -> [TyCon]
    forall a. (a -> Bool) -> [a] -> [a]
    filter TyCon -> Bool
    isDataTyCon [TyCon]
    tycons
                -- cg_tycons includes newtypes, for the benefit of External Core,
                -- but we don't generate any code for newtypes

            -------------------
            -- PREPARE FOR CODE GENERATION
            -- Do saturation and convert to A-normal form
            (CoreProgram
    prepd_binds, Set CostCentre
    local_ccs) <- {-# SCC "CorePrep" #-}
                           HscEnv
    -> Module
    -> ModLocation
    -> CoreProgram
    -> [TyCon]
    -> IO (CoreProgram, Set CostCentre)
    corePrepPgm HscEnv
    hsc_env Module
    this_mod ModLocation
    location
                                       CoreProgram
    core_binds [TyCon]
    data_tycons

            -----------------  Convert to STG ------------------
            ([StgTopBinding]
    stg_binds, InfoTableProvMap
    denv, ([CostCentre]
    caf_ccs, [CostCentreStack]
    caf_cc_stacks))
                <- {-# SCC "CoreToStg" #-}
                   Logger
    -> DynFlags
    -> SDoc
    -> (([StgTopBinding], InfoTableProvMap,
         ([CostCentre], [CostCentreStack]))
        -> ())
    -> IO
         ([StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    -> IO
         ([StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> DynFlags -> SDoc -> (a -> ()) -> m a -> m a
    withTiming Logger
    logger DynFlags
    dflags
                       ([Char] -> SDoc
    text [Char]
    "CoreToStg"SDoc -> SDoc -> SDoc
    <+>SDoc -> SDoc
    brackets (Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    this_mod))
                       (\([StgTopBinding]
    a, InfoTableProvMap
    b, ([CostCentre]
    c,[CostCentreStack]
    d)) -> [StgTopBinding]
    a [StgTopBinding] -> InfoTableProvMap -> InfoTableProvMap
    forall a b. [a] -> b -> b
    `seqList` InfoTableProvMap
    b InfoTableProvMap -> () -> ()
    `seq` [CostCentre]
    c [CostCentre] -> [CostCentreStack] -> [CostCentreStack]
    forall a b. [a] -> b -> b
    `seqList` [CostCentreStack]
    d [CostCentreStack] -> () -> ()
    forall a b. [a] -> b -> b
    `seqList` ())
                       (Logger
    -> DynFlags
    -> InteractiveContext
    -> Module
    -> ModLocation
    -> CoreProgram
    -> IO
         ([StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    myCoreToStg Logger
    logger DynFlags
    dflags (HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env) Module
    this_mod ModLocation
    location CoreProgram
    prepd_binds)

            let cost_centre_info :: ([CostCentre], [CostCentreStack])
    cost_centre_info =
                  (Set CostCentre -> [CostCentre]
    forall a. Set a -> [a]
    S.toList Set CostCentre
    local_ccs [CostCentre] -> [CostCentre] -> [CostCentre]
    forall a. [a] -> [a] -> [a]
    ++ [CostCentre]
    caf_ccs, [CostCentreStack]
    caf_cc_stacks)
                platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
                prof_init :: CStub
    prof_init
                  | DynFlags -> Bool
    sccProfilingEnabled DynFlags
    dflags = Platform -> Module -> ([CostCentre], [CostCentreStack]) -> CStub
    profilingInitCode Platform
    platform Module
    this_mod ([CostCentre], [CostCentreStack])
    cost_centre_info
                  | Bool
    otherwise = CStub
    forall a. Monoid a => a
    mempty

            ------------------  Code generation ------------------
            -- The back-end is streamed: each top-level function goes
            -- from Stg all the way to asm before dealing with the next
            -- top-level function, so showPass isn't very useful here.
            -- Hence we have one showPass for the whole backend, the
            -- next showPass after this will be "Assembler".
            Logger
    -> DynFlags
    -> SDoc
    -> (([Char], Maybe [Char], [(ForeignSrcLang, [Char])], CgInfos)
        -> ())
    -> IO ([Char], Maybe [Char], [(ForeignSrcLang, [Char])], CgInfos)
    -> IO ([Char], Maybe [Char], [(ForeignSrcLang, [Char])], CgInfos)
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> DynFlags -> SDoc -> (a -> ()) -> m a -> m a
    withTiming Logger
    logger DynFlags
    dflags
                       ([Char] -> SDoc
    text [Char]
    "CodeGen"SDoc -> SDoc -> SDoc
    <+>SDoc -> SDoc
    brackets (Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    this_mod))
                       (()
    -> ([Char], Maybe [Char], [(ForeignSrcLang, [Char])], CgInfos)
    -> ()
    forall a b. a -> b -> a
    const ()) (IO ([Char], Maybe [Char], [(ForeignSrcLang, [Char])], CgInfos)
     -> IO ([Char], Maybe [Char], [(ForeignSrcLang, [Char])], CgInfos))
    -> IO ([Char], Maybe [Char], [(ForeignSrcLang, [Char])], CgInfos)
    -> IO ([Char], Maybe [Char], [(ForeignSrcLang, [Char])], CgInfos)
    forall a b. (a -> b) -> a -> b
    $ do
                Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
    cmms <- {-# SCC "StgToCmm" #-}
                                HscEnv
    -> Module
    -> InfoTableProvMap
    -> [TyCon]
    -> ([CostCentre], [CostCentreStack])
    -> [StgTopBinding]
    -> HpcInfo
    -> IO
         (Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos)
    doCodeGen HscEnv
    hsc_env Module
    this_mod InfoTableProvMap
    denv [TyCon]
    data_tycons
                                    ([CostCentre], [CostCentreStack])
    cost_centre_info
                                    [StgTopBinding]
    stg_binds HpcInfo
    hpc_info

                ------------------  Code output -----------------------
                Stream
      IO
      [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
      CgInfos
    rawcmms0 <- {-# SCC "cmmToRawCmm" #-}
                            case Hooks
    -> forall a.
       Maybe
         (DynFlags
          -> Maybe Module
          -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] a
          -> IO
               (Stream
                  IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph] a))
    cmmToRawCmmHook Hooks
    hooks of
                                Maybe
      (DynFlags
       -> Maybe Module
       -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
       -> IO
            (Stream
               IO
               [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
               CgInfos))
    Nothing -> Logger
    -> DynFlags
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
    -> IO
         (Stream
            IO
            [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
            CgInfos)
    forall a.
    Logger
    -> DynFlags
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] a
    -> IO
         (Stream
            IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph] a)
    cmmToRawCmm Logger
    logger DynFlags
    dflags Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
    cmms
                                Just DynFlags
    -> Maybe Module
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
    -> IO
         (Stream
            IO
            [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
            CgInfos)
    h  -> DynFlags
    -> Maybe Module
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
    -> IO
         (Stream
            IO
            [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
            CgInfos)
    h DynFlags
    dflags (Module -> Maybe Module
    forall a. a -> Maybe a
    Just Module
    this_mod) Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
    cmms

                let dump :: [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
    -> IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
    dump [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
    a = do
                      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
    -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
    a) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                        Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_cmm_raw [Char]
    "Raw Cmm" DumpFormat
    FormatCMM (Platform
    -> [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
    -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
    a)
                      [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
    -> IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
    a
                    rawcmms1 :: Stream
      IO
      [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
      CgInfos
    rawcmms1 = ([GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
     -> IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph])
    -> Stream
         IO
         [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
         CgInfos
    -> Stream
         IO
         [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
         CgInfos
    forall (m :: * -> *) a b x.
    Monad m =>
    (a -> m b) -> Stream m a x -> Stream m b x
    Stream.mapM [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
    -> IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
    dump Stream
      IO
      [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
      CgInfos
    rawcmms0

                let foreign_stubs :: CgInfos -> ForeignStubs
    foreign_stubs CgInfos
    st = ForeignStubs
    foreign_stubs0 ForeignStubs -> CStub -> ForeignStubs
    `appendStubC` CStub
    prof_init
                                                      ForeignStubs -> CStub -> ForeignStubs
    `appendStubC` CgInfos -> CStub
    cgIPEStub CgInfos
    st

                ([Char]
    output_filename, (Bool
    _stub_h_exists, Maybe [Char]
    stub_c_exists), [(ForeignSrcLang, [Char])]
    foreign_fps, CgInfos
    cg_infos)
                    <- {-# SCC "codeOutput" #-}
                      Logger
    -> TmpFs
    -> DynFlags
    -> UnitState
    -> Module
    -> [Char]
    -> ModLocation
    -> (CgInfos -> ForeignStubs)
    -> [(ForeignSrcLang, [Char])]
    -> [UnitId]
    -> Stream
         IO
         [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
         CgInfos
    -> IO
         ([Char], (Bool, Maybe [Char]), [(ForeignSrcLang, [Char])], CgInfos)
    forall a.
    Logger
    -> TmpFs
    -> DynFlags
    -> UnitState
    -> Module
    -> [Char]
    -> ModLocation
    -> (a -> ForeignStubs)
    -> [(ForeignSrcLang, [Char])]
    -> [UnitId]
    -> Stream
         IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph] a
    -> IO ([Char], (Bool, Maybe [Char]), [(ForeignSrcLang, [Char])], a)
    codeOutput Logger
    logger TmpFs
    tmpfs DynFlags
    dflags (HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env) Module
    this_mod [Char]
    output_filename ModLocation
    location
                      CgInfos -> ForeignStubs
    foreign_stubs [(ForeignSrcLang, [Char])]
    foreign_files [UnitId]
    dependencies Stream
      IO
      [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
      CgInfos
    rawcmms1
                ([Char], Maybe [Char], [(ForeignSrcLang, [Char])], CgInfos)
    -> IO ([Char], Maybe [Char], [(ForeignSrcLang, [Char])], CgInfos)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char]
    output_filename, Maybe [Char]
    stub_c_exists, [(ForeignSrcLang, [Char])]
    foreign_fps, CgInfos
    cg_infos)

    hscInteractive :: HscEnv
                   -> CgGuts
                   -> ModLocation
                   -> IO (Maybe FilePath, CompiledByteCode, [SptEntry])
    hscInteractive :: HscEnv
    -> CgGuts
    -> ModLocation
    -> IO (Maybe [Char], CompiledByteCode, [SptEntry])
    hscInteractive HscEnv
    hsc_env CgGuts
    cgguts ModLocation
    location = do
        let dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        let logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
        let tmpfs :: TmpFs
    tmpfs  = HscEnv -> TmpFs
    hsc_tmpfs HscEnv
    hsc_env
        let CgGuts{ -- This is the last use of the ModGuts in a compilation.
                    -- From now on, we just use the bits we need.
                   cg_module :: CgGuts -> Module
    cg_module   = Module
    this_mod,
                   cg_binds :: CgGuts -> CoreProgram
    cg_binds    = CoreProgram
    core_binds,
                   cg_tycons :: CgGuts -> [TyCon]
    cg_tycons   = [TyCon]
    tycons,
                   cg_foreign :: CgGuts -> ForeignStubs
    cg_foreign  = ForeignStubs
    foreign_stubs,
                   cg_modBreaks :: CgGuts -> Maybe ModBreaks
    cg_modBreaks = Maybe ModBreaks
    mod_breaks,
                   cg_spt_entries :: CgGuts -> [SptEntry]
    cg_spt_entries = [SptEntry]
    spt_entries } = CgGuts
    cgguts

            data_tycons :: [TyCon]
    data_tycons = (TyCon -> Bool) -> [TyCon] -> [TyCon]
    forall a. (a -> Bool) -> [a] -> [a]
    filter TyCon -> Bool
    isDataTyCon [TyCon]
    tycons
            -- cg_tycons includes newtypes, for the benefit of External Core,
            -- but we don't generate any code for newtypes

        -------------------
        -- PREPARE FOR CODE GENERATION
        -- Do saturation and convert to A-normal form
        (CoreProgram
    prepd_binds, Set CostCentre
    _) <- {-# SCC "CorePrep" #-}
                       HscEnv
    -> Module
    -> ModLocation
    -> CoreProgram
    -> [TyCon]
    -> IO (CoreProgram, Set CostCentre)
    corePrepPgm HscEnv
    hsc_env Module
    this_mod ModLocation
    location CoreProgram
    core_binds [TyCon]
    data_tycons

        ([StgTopBinding]
    stg_binds, InfoTableProvMap
    _infotable_prov, ([CostCentre], [CostCentreStack])
    _caf_ccs__caf_cc_stacks)
          <- {-# SCC "CoreToStg" #-}
              Logger
    -> DynFlags
    -> InteractiveContext
    -> Module
    -> ModLocation
    -> CoreProgram
    -> IO
         ([StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    myCoreToStg Logger
    logger DynFlags
    dflags (HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env) Module
    this_mod ModLocation
    location CoreProgram
    prepd_binds
        -----------------  Generate byte code ------------------
        CompiledByteCode
    comp_bc <- HscEnv
    -> Module
    -> [StgTopBinding]
    -> [TyCon]
    -> Maybe ModBreaks
    -> IO CompiledByteCode
    byteCodeGen HscEnv
    hsc_env Module
    this_mod [StgTopBinding]
    stg_binds [TyCon]
    data_tycons Maybe ModBreaks
    mod_breaks
        ------------------ Create f-x-dynamic C-side stuff -----
        (Bool
    _istub_h_exists, Maybe [Char]
    istub_c_exists)
            <- Logger
    -> TmpFs
    -> DynFlags
    -> UnitState
    -> Module
    -> ModLocation
    -> ForeignStubs
    -> IO (Bool, Maybe [Char])
    outputForeignStubs Logger
    logger TmpFs
    tmpfs DynFlags
    dflags (HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env) Module
    this_mod ModLocation
    location ForeignStubs
    foreign_stubs
        (Maybe [Char], CompiledByteCode, [SptEntry])
    -> IO (Maybe [Char], CompiledByteCode, [SptEntry])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe [Char]
    istub_c_exists, CompiledByteCode
    comp_bc, [SptEntry]
    spt_entries)

    ------------------------------

    hscCompileCmmFile :: HscEnv -> FilePath -> FilePath -> IO (Maybe FilePath)
    hscCompileCmmFile :: HscEnv -> [Char] -> [Char] -> IO (Maybe [Char])
    hscCompileCmmFile HscEnv
    hsc_env [Char]
    filename [Char]
    output_filename = HscEnv -> Hsc (Maybe [Char]) -> IO (Maybe [Char])
    forall a. HscEnv -> Hsc a -> IO a
    runHsc HscEnv
    hsc_env (Hsc (Maybe [Char]) -> IO (Maybe [Char]))
    -> Hsc (Maybe [Char]) -> IO (Maybe [Char])
    forall a b. (a -> b) -> a -> b
    $ do
        let dflags :: DynFlags
    dflags   = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        let logger :: Logger
    logger   = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
        let hooks :: Hooks
    hooks    = HscEnv -> Hooks
    hsc_hooks HscEnv
    hsc_env
        let tmpfs :: TmpFs
    tmpfs    = HscEnv -> TmpFs
    hsc_tmpfs HscEnv
    hsc_env
            home_unit :: HomeUnit
    home_unit = HscEnv -> HomeUnit
    hsc_home_unit HscEnv
    hsc_env
            platform :: Platform
    platform  = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
            -- Make up a module name to give the NCG. We can't pass bottom here
            -- lest we reproduce #11784.
            mod_name :: ModuleName
    mod_name = [Char] -> ModuleName
    mkModuleName ([Char] -> ModuleName) -> [Char] -> ModuleName
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Cmm$" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    FilePath.takeFileName [Char]
    filename
            cmm_mod :: Module
    cmm_mod = HomeUnit -> ModuleName -> Module
    mkHomeModule HomeUnit
    home_unit ModuleName
    mod_name
        ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    cmm, [InfoProvEnt]
    ents) <- IO
      (Messages DecoratedSDoc,
       Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
    -> Hsc ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt])
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe
                   (IO
       (Messages DecoratedSDoc,
        Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
     -> Hsc
          ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
    -> IO
         (Messages DecoratedSDoc,
          Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
    -> Hsc ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt])
    forall a b. (a -> b) -> a -> b
    $ do
                      (Bag PsWarning
    warns,Bag PsError
    errs,Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt])
    cmm) <- Logger
    -> DynFlags
    -> SDoc
    -> ((Bag PsWarning, Bag PsError,
         Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
        -> ())
    -> IO
         (Bag PsWarning, Bag PsError,
          Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
    -> IO
         (Bag PsWarning, Bag PsError,
          Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> DynFlags -> SDoc -> (a -> ()) -> m a -> m a
    withTiming Logger
    logger DynFlags
    dflags ([Char] -> SDoc
    text [Char]
    "ParseCmm"SDoc -> SDoc -> SDoc
    <+>SDoc -> SDoc
    brackets ([Char] -> SDoc
    text [Char]
    filename)) (\(Bag PsWarning, Bag PsError,
     Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
    _ -> ())
                                           (IO
       (Bag PsWarning, Bag PsError,
        Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
     -> IO
          (Bag PsWarning, Bag PsError,
           Maybe
             ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt])))
    -> IO
         (Bag PsWarning, Bag PsError,
          Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
    -> IO
         (Bag PsWarning, Bag PsError,
          Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
    forall a b. (a -> b) -> a -> b
    $ DynFlags
    -> Module
    -> HomeUnit
    -> [Char]
    -> IO
         (Bag PsWarning, Bag PsError,
          Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
    parseCmmFile DynFlags
    dflags Module
    cmm_mod HomeUnit
    home_unit [Char]
    filename
                      (Messages DecoratedSDoc,
     Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
    -> IO
         (Messages DecoratedSDoc,
          Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt]))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WarningMessages -> Messages DecoratedSDoc
    forall e. Bag (MsgEnvelope e) -> Messages e
    mkMessages ((PsWarning -> MsgEnvelope DecoratedSDoc)
    -> Bag PsWarning -> WarningMessages
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PsWarning -> MsgEnvelope DecoratedSDoc
    pprWarning Bag PsWarning
    warns WarningMessages -> WarningMessages -> WarningMessages
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` (PsError -> MsgEnvelope DecoratedSDoc)
    -> Bag PsError -> WarningMessages
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PsError -> MsgEnvelope DecoratedSDoc
    pprError Bag PsError
    errs), Maybe ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph], [InfoProvEnt])
    cmm)
        IO (Maybe [Char]) -> Hsc (Maybe [Char])
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe [Char]) -> Hsc (Maybe [Char]))
    -> IO (Maybe [Char]) -> Hsc (Maybe [Char])
    forall a b. (a -> b) -> a -> b
    $ do
            Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_cmm_verbose_by_proc [Char]
    "Parsed Cmm" DumpFormat
    FormatCMM (Platform -> [GenCmmDecl CmmStatics CmmTopInfo CmmGraph] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    cmm)

            -- Compile decls in Cmm files one decl at a time, to avoid re-ordering
            -- them in SRT analysis.
            --
            -- Re-ordering here causes breakage when booting with C backend because
            -- in C we must declare before use, but SRT algorithm is free to
            -- re-order [A, B] (B refers to A) when A is not CAFFY and return [B, A]
            [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    cmmgroup <-
              (GenCmmDecl CmmStatics CmmTopInfo CmmGraph
     -> IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph])
    -> [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    -> IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
    concatMapM (\GenCmmDecl CmmStatics CmmTopInfo CmmGraph
    cmm -> (ModuleSRTInfo, [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph])
    -> [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    forall a b. (a, b) -> b
    snd ((ModuleSRTInfo, [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph])
     -> [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph])
    -> IO
         (ModuleSRTInfo, [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph])
    -> IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HscEnv
    -> ModuleSRTInfo
    -> [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    -> IO
         (ModuleSRTInfo, [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph])
    cmmPipeline HscEnv
    hsc_env (Module -> ModuleSRTInfo
    emptySRT Module
    cmm_mod) [GenCmmDecl CmmStatics CmmTopInfo CmmGraph
    cmm]) [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    cmm

            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    cmmgroup) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
              Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_cmm [Char]
    "Output Cmm"
                DumpFormat
    FormatCMM (Platform -> [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    cmmgroup)

            Stream
      IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph] ()
    rawCmms <- case Hooks
    -> forall a.
       Maybe
         (DynFlags
          -> Maybe Module
          -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] a
          -> IO
               (Stream
                  IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph] a))
    cmmToRawCmmHook Hooks
    hooks of
              Maybe
      (DynFlags
       -> Maybe Module
       -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] ()
       -> IO
            (Stream
               IO
               [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph]
               ()))
    Nothing -> Logger
    -> DynFlags
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] ()
    -> IO
         (Stream
            IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph] ())
    forall a.
    Logger
    -> DynFlags
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] a
    -> IO
         (Stream
            IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph] a)
    cmmToRawCmm Logger
    logger DynFlags
    dflags         ([GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] ()
    forall (m :: * -> *) a. Monad m => a -> Stream m a ()
    Stream.yield [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    cmmgroup)
              Just DynFlags
    -> Maybe Module
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] ()
    -> IO
         (Stream
            IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph] ())
    h  -> DynFlags
    -> Maybe Module
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] ()
    -> IO
         (Stream
            IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph] ())
    h                  DynFlags
    dflags Maybe Module
    forall a. Maybe a
    Nothing ([GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] ()
    forall (m :: * -> *) a. Monad m => a -> Stream m a ()
    Stream.yield [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    cmmgroup)

            let foreign_stubs :: () -> ForeignStubs
    foreign_stubs ()
    _ =
                  let ip_init :: CStub
    ip_init = DynFlags -> Module -> [InfoProvEnt] -> CStub
    ipInitCode DynFlags
    dflags Module
    cmm_mod [InfoProvEnt]
    ents
                  in ForeignStubs
    NoStubs ForeignStubs -> CStub -> ForeignStubs
    `appendStubC` CStub
    ip_init

            ([Char]
    _output_filename, (Bool
    _stub_h_exists, Maybe [Char]
    stub_c_exists), [(ForeignSrcLang, [Char])]
    _foreign_fps, ()
    _caf_infos)
              <- Logger
    -> TmpFs
    -> DynFlags
    -> UnitState
    -> Module
    -> [Char]
    -> ModLocation
    -> (() -> ForeignStubs)
    -> [(ForeignSrcLang, [Char])]
    -> [UnitId]
    -> Stream
         IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph] ()
    -> IO
         ([Char], (Bool, Maybe [Char]), [(ForeignSrcLang, [Char])], ())
    forall a.
    Logger
    -> TmpFs
    -> DynFlags
    -> UnitState
    -> Module
    -> [Char]
    -> ModLocation
    -> (a -> ForeignStubs)
    -> [(ForeignSrcLang, [Char])]
    -> [UnitId]
    -> Stream
         IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph] a
    -> IO ([Char], (Bool, Maybe [Char]), [(ForeignSrcLang, [Char])], a)
    codeOutput Logger
    logger TmpFs
    tmpfs DynFlags
    dflags (HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env) Module
    cmm_mod [Char]
    output_filename ModLocation
    no_loc () -> ForeignStubs
    foreign_stubs [] []
                 Stream
      IO [GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph] ()
    rawCmms
            Maybe [Char] -> IO (Maybe [Char])
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Char]
    stub_c_exists
      where
        no_loc :: ModLocation
    no_loc = ModLocation{ ml_hs_file :: Maybe [Char]
    ml_hs_file  = [Char] -> Maybe [Char]
    forall a. a -> Maybe a
    Just [Char]
    filename,
                              ml_hi_file :: [Char]
    ml_hi_file  = [Char] -> [Char]
    forall a. [Char] -> a
    panic [Char]
    "hscCompileCmmFile: no hi file",
                              ml_obj_file :: [Char]
    ml_obj_file = [Char] -> [Char]
    forall a. [Char] -> a
    panic [Char]
    "hscCompileCmmFile: no obj file",
                              ml_hie_file :: [Char]
    ml_hie_file = [Char] -> [Char]
    forall a. [Char] -> a
    panic [Char]
    "hscCompileCmmFile: no hie file"}

    -------------------- Stuff for new code gen ---------------------

    {-
    Note [Forcing of stg_binds]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~

    The two last steps in the STG pipeline are:

    * Sorting the bindings in dependency order.
    * Annotating them with free variables.

    We want to make sure we do not keep references to unannotated STG bindings
    alive, nor references to bindings which have already been compiled to Cmm.

    We explicitly force the bindings to avoid this.

    This reduces residency towards the end of the CodeGen phase significantly
    (5-10%).
    -}

    doCodeGen   :: HscEnv -> Module -> InfoTableProvMap -> [TyCon]
                -> CollectedCCs
                -> [StgTopBinding]
                -> HpcInfo
                -> IO (Stream IO CmmGroupSRTs CgInfos)
             -- Note we produce a 'Stream' of CmmGroups, so that the
             -- backend can be run incrementally.  Otherwise it generates all
             -- the C-- up front, which has a significant space cost.
    doCodeGen :: HscEnv
    -> Module
    -> InfoTableProvMap
    -> [TyCon]
    -> ([CostCentre], [CostCentreStack])
    -> [StgTopBinding]
    -> HpcInfo
    -> IO
         (Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos)
    doCodeGen HscEnv
    hsc_env Module
    this_mod InfoTableProvMap
    denv [TyCon]
    data_tycons
                  ([CostCentre], [CostCentreStack])
    cost_centre_info [StgTopBinding]
    stg_binds HpcInfo
    hpc_info = do
        let dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        let logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
        let hooks :: Hooks
    hooks  = HscEnv -> Hooks
    hsc_hooks HscEnv
    hsc_env
        let tmpfs :: TmpFs
    tmpfs  = HscEnv -> TmpFs
    hsc_tmpfs HscEnv
    hsc_env
        let platform :: Platform
    platform = DynFlags -> Platform
    targetPlatform DynFlags
    dflags

        let stg_binds_w_fvs :: [CgStgTopBinding]
    stg_binds_w_fvs = [StgTopBinding] -> [CgStgTopBinding]
    annTopBindingsFreeVars [StgTopBinding]
    stg_binds

        Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_stg_final [Char]
    "Final STG:" DumpFormat
    FormatSTG (StgPprOpts -> [CgStgTopBinding] -> SDoc
    forall (pass :: StgPass).
    OutputablePass pass =>
    StgPprOpts -> [GenStgTopBinding pass] -> SDoc
    pprGenStgTopBindings (DynFlags -> StgPprOpts
    initStgPprOpts DynFlags
    dflags) [CgStgTopBinding]
    stg_binds_w_fvs)

        let stg_to_cmm :: DynFlags
    -> Module
    -> InfoTableProvMap
    -> [TyCon]
    -> ([CostCentre], [CostCentreStack])
    -> [CgStgTopBinding]
    -> HpcInfo
    -> Stream
         IO
         [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
         (CStub, ModuleLFInfos)
    stg_to_cmm = case Hooks
    -> Maybe
         (DynFlags
          -> Module
          -> InfoTableProvMap
          -> [TyCon]
          -> ([CostCentre], [CostCentreStack])
          -> [CgStgTopBinding]
          -> HpcInfo
          -> Stream
               IO
               [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
               (CStub, ModuleLFInfos))
    stgToCmmHook Hooks
    hooks of
                            Maybe
      (DynFlags
       -> Module
       -> InfoTableProvMap
       -> [TyCon]
       -> ([CostCentre], [CostCentreStack])
       -> [CgStgTopBinding]
       -> HpcInfo
       -> Stream
            IO
            [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
            (CStub, ModuleLFInfos))
    Nothing -> Logger
    -> TmpFs
    -> DynFlags
    -> Module
    -> InfoTableProvMap
    -> [TyCon]
    -> ([CostCentre], [CostCentreStack])
    -> [CgStgTopBinding]
    -> HpcInfo
    -> Stream
         IO
         [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
         (CStub, ModuleLFInfos)
    StgToCmm.codeGen Logger
    logger TmpFs
    tmpfs
                            Just DynFlags
    -> Module
    -> InfoTableProvMap
    -> [TyCon]
    -> ([CostCentre], [CostCentreStack])
    -> [CgStgTopBinding]
    -> HpcInfo
    -> Stream
         IO
         [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
         (CStub, ModuleLFInfos)
    h  -> DynFlags
    -> Module
    -> InfoTableProvMap
    -> [TyCon]
    -> ([CostCentre], [CostCentreStack])
    -> [CgStgTopBinding]
    -> HpcInfo
    -> Stream
         IO
         [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
         (CStub, ModuleLFInfos)
    h

        let cmm_stream :: Stream IO CmmGroup (CStub, ModuleLFInfos)
            -- See Note [Forcing of stg_binds]
            cmm_stream :: Stream
      IO
      [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
      (CStub, ModuleLFInfos)
    cmm_stream = [CgStgTopBinding]
    stg_binds_w_fvs [CgStgTopBinding]
    -> Stream
         IO
         [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
         (CStub, ModuleLFInfos)
    -> Stream
         IO
         [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
         (CStub, ModuleLFInfos)
    forall a b. [a] -> b -> b
    `seqList` {-# SCC "StgToCmm" #-}
                DynFlags
    -> Module
    -> InfoTableProvMap
    -> [TyCon]
    -> ([CostCentre], [CostCentreStack])
    -> [CgStgTopBinding]
    -> HpcInfo
    -> Stream
         IO
         [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
         (CStub, ModuleLFInfos)
    stg_to_cmm DynFlags
    dflags Module
    this_mod InfoTableProvMap
    denv [TyCon]
    data_tycons ([CostCentre], [CostCentreStack])
    cost_centre_info [CgStgTopBinding]
    stg_binds_w_fvs HpcInfo
    hpc_info

            -- codegen consumes a stream of CmmGroup, and produces a new
            -- stream of CmmGroup (not necessarily synchronised: one
            -- CmmGroup on input may produce many CmmGroups on output due
            -- to proc-point splitting).

        let dump1 :: [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    -> IO [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    dump1 [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    a = do
              Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    a) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_cmm_from_stg
                  [Char]
    "Cmm produced by codegen" DumpFormat
    FormatCMM (Platform -> [GenCmmDecl CmmStatics CmmTopInfo CmmGraph] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    a)
              [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    -> IO [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    a

            ppr_stream1 :: Stream
      IO
      [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
      (CStub, ModuleLFInfos)
    ppr_stream1 = ([GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
     -> IO [GenCmmDecl CmmStatics CmmTopInfo CmmGraph])
    -> Stream
         IO
         [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
         (CStub, ModuleLFInfos)
    -> Stream
         IO
         [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
         (CStub, ModuleLFInfos)
    forall (m :: * -> *) a b x.
    Monad m =>
    (a -> m b) -> Stream m a x -> Stream m b x
    Stream.mapM [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    -> IO [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    dump1 Stream
      IO
      [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
      (CStub, ModuleLFInfos)
    cmm_stream

            pipeline_stream :: Stream IO CmmGroupSRTs CgInfos
            pipeline_stream :: Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
    pipeline_stream = do
              (NonCaffySet
    non_cafs, (CStub
    used_info, ModuleLFInfos
    lf_infos)) <-
                {-# SCC "cmmPipeline" #-}
                (ModuleSRTInfo
     -> [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
     -> IO
          (ModuleSRTInfo, [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]))
    -> ModuleSRTInfo
    -> Stream
         IO
         [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
         (CStub, ModuleLFInfos)
    -> Stream
         IO
         [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
         (ModuleSRTInfo, (CStub, ModuleLFInfos))
    forall (m :: * -> *) a b c r.
    Monad m =>
    (c -> a -> m (c, b)) -> c -> Stream m a r -> Stream m b (c, r)
    Stream.mapAccumL_ (HscEnv
    -> ModuleSRTInfo
    -> [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
    -> IO
         (ModuleSRTInfo, [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph])
    cmmPipeline HscEnv
    hsc_env) (Module -> ModuleSRTInfo
    emptySRT Module
    this_mod) Stream
      IO
      [GenCmmDecl CmmStatics CmmTopInfo CmmGraph]
      (CStub, ModuleLFInfos)
    ppr_stream1
                  Stream
      IO
      [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
      (ModuleSRTInfo, (CStub, ModuleLFInfos))
    -> ((ModuleSRTInfo, (CStub, ModuleLFInfos))
        -> (NonCaffySet, (CStub, ModuleLFInfos)))
    -> Stream
         IO
         [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
         (NonCaffySet, (CStub, ModuleLFInfos))
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    <&> (ModuleSRTInfo -> NonCaffySet)
    -> (ModuleSRTInfo, (CStub, ModuleLFInfos))
    -> (NonCaffySet, (CStub, ModuleLFInfos))
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first (SRTMap -> NonCaffySet
    srtMapNonCAFs (SRTMap -> NonCaffySet)
    -> (ModuleSRTInfo -> SRTMap) -> ModuleSRTInfo -> NonCaffySet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleSRTInfo -> SRTMap
    moduleSRTMap)

              CgInfos
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
    forall (m :: * -> *) a. Monad m => a -> m a
    return CgInfos{ cgNonCafs :: NonCaffySet
    cgNonCafs = NonCaffySet
    non_cafs, cgLFInfos :: ModuleLFInfos
    cgLFInfos = ModuleLFInfos
    lf_infos, cgIPEStub :: CStub
    cgIPEStub = CStub
    used_info }

            dump2 :: [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    -> IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    dump2 [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    a = do
              Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    a) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_cmm [Char]
    "Output Cmm" DumpFormat
    FormatCMM (Platform -> [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    a)
              [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    -> IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    a

        Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
    -> IO
         (Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
     -> IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph])
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
    -> Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
    forall (m :: * -> *) a b x.
    Monad m =>
    (a -> m b) -> Stream m a x -> Stream m b x
    Stream.mapM [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    -> IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph]
    dump2 Stream IO [GenCmmDecl RawCmmStatics CmmTopInfo CmmGraph] CgInfos
    pipeline_stream)

    myCoreToStgExpr :: Logger -> DynFlags -> InteractiveContext
                    -> Module -> ModLocation -> CoreExpr
                    -> IO ( Id
                          , [StgTopBinding]
                          , InfoTableProvMap
                          , CollectedCCs )
    myCoreToStgExpr :: Logger
    -> DynFlags
    -> InteractiveContext
    -> Module
    -> ModLocation
    -> CoreExpr
    -> IO
         (Id, [StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    myCoreToStgExpr Logger
    logger DynFlags
    dflags InteractiveContext
    ictxt Module
    this_mod ModLocation
    ml CoreExpr
    prepd_expr = do
        {- Create a temporary binding (just because myCoreToStg needs a
           binding for the stg2stg step) -}
        let bco_tmp_id :: Id
    bco_tmp_id = FastString -> Unique -> Mult -> Mult -> Id
    mkSysLocal ([Char] -> FastString
    fsLit [Char]
    "BCO_toplevel")
                                    (Int -> Unique
    mkPseudoUniqueE Int
    0)
                                    Mult
    Many
                                    (CoreExpr -> Mult
    exprType CoreExpr
    prepd_expr)
        ([StgTopBinding]
    stg_binds, InfoTableProvMap
    prov_map, ([CostCentre], [CostCentreStack])
    collected_ccs) <-
           Logger
    -> DynFlags
    -> InteractiveContext
    -> Module
    -> ModLocation
    -> CoreProgram
    -> IO
         ([StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    myCoreToStg Logger
    logger
                       DynFlags
    dflags
                       InteractiveContext
    ictxt
                       Module
    this_mod
                       ModLocation
    ml
                       [Id -> CoreExpr -> Bind Id
    forall b. b -> Expr b -> Bind b
    NonRec Id
    bco_tmp_id CoreExpr
    prepd_expr]
        (Id, [StgTopBinding], InfoTableProvMap,
     ([CostCentre], [CostCentreStack]))
    -> IO
         (Id, [StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id
    bco_tmp_id, [StgTopBinding]
    stg_binds, InfoTableProvMap
    prov_map, ([CostCentre], [CostCentreStack])
    collected_ccs)

    myCoreToStg :: Logger -> DynFlags -> InteractiveContext
                -> Module -> ModLocation -> CoreProgram
                -> IO ( [StgTopBinding] -- output program
                      , InfoTableProvMap
                      , CollectedCCs )  -- CAF cost centre info (declared and used)
    myCoreToStg :: Logger
    -> DynFlags
    -> InteractiveContext
    -> Module
    -> ModLocation
    -> CoreProgram
    -> IO
         ([StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    myCoreToStg Logger
    logger DynFlags
    dflags InteractiveContext
    ictxt Module
    this_mod ModLocation
    ml CoreProgram
    prepd_binds = do
        let ([StgTopBinding]
    stg_binds, InfoTableProvMap
    denv, ([CostCentre], [CostCentreStack])
    cost_centre_info)
             = {-# SCC "Core2Stg" #-}
               DynFlags
    -> Module
    -> ModLocation
    -> CoreProgram
    -> ([StgTopBinding], InfoTableProvMap,
        ([CostCentre], [CostCentreStack]))
    coreToStg DynFlags
    dflags Module
    this_mod ModLocation
    ml CoreProgram
    prepd_binds

        [StgTopBinding]
    stg_binds2
            <- {-# SCC "Stg2Stg" #-}
               Logger
    -> DynFlags
    -> InteractiveContext
    -> Module
    -> [StgTopBinding]
    -> IO [StgTopBinding]
    stg2stg Logger
    logger DynFlags
    dflags InteractiveContext
    ictxt Module
    this_mod [StgTopBinding]
    stg_binds

        ([StgTopBinding], InfoTableProvMap,
     ([CostCentre], [CostCentreStack]))
    -> IO
         ([StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([StgTopBinding]
    stg_binds2, InfoTableProvMap
    denv, ([CostCentre], [CostCentreStack])
    cost_centre_info)

    {- **********************************************************************
    %*                                                                      *
    \subsection{Compiling a do-statement}
    %*                                                                      *
    %********************************************************************* -}

    {-
    When the UnlinkedBCOExpr is linked you get an HValue of type *IO [HValue]* When
    you run it you get a list of HValues that should be the same length as the list
    of names; add them to the ClosureEnv.

    A naked expression returns a singleton Name [it]. The stmt is lifted into the
    IO monad as explained in Note [Interactively-bound Ids in GHCi] in GHC.Runtime.Context
    -}

    -- | Compile a stmt all the way to an HValue, but don't run it
    --
    -- We return Nothing to indicate an empty statement (or comment only), not a
    -- parse error.
    hscStmt :: HscEnv -> String -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
    hscStmt :: HscEnv -> [Char] -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
    hscStmt HscEnv
    hsc_env [Char]
    stmt = HscEnv
    -> [Char]
    -> [Char]
    -> Int
    -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
    hscStmtWithLocation HscEnv
    hsc_env [Char]
    stmt [Char]
    "<interactive>" Int
    1

    -- | Compile a stmt all the way to an HValue, but don't run it
    --
    -- We return Nothing to indicate an empty statement (or comment only), not a
    -- parse error.
    hscStmtWithLocation :: HscEnv
                        -> String -- ^ The statement
                        -> String -- ^ The source
                        -> Int    -- ^ Starting line
                        -> IO ( Maybe ([Id]
                              , ForeignHValue {- IO [HValue] -}
                              , FixityEnv))
    hscStmtWithLocation :: HscEnv
    -> [Char]
    -> [Char]
    -> Int
    -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
    hscStmtWithLocation HscEnv
    hsc_env0 [Char]
    stmt [Char]
    source Int
    linenumber =
      HscEnv
    -> Hsc (Maybe ([Id], ForeignHValue, FixityEnv))
    -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env0 (Hsc (Maybe ([Id], ForeignHValue, FixityEnv))
     -> IO (Maybe ([Id], ForeignHValue, FixityEnv)))
    -> Hsc (Maybe ([Id], ForeignHValue, FixityEnv))
    -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
    forall a b. (a -> b) -> a -> b
    $ do
        Maybe
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    maybe_stmt <- [Char] -> Int -> [Char] -> Hsc (Maybe (GhciLStmt GhcPs))
    hscParseStmtWithLocation [Char]
    source Int
    linenumber [Char]
    stmt
        case Maybe
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    maybe_stmt of
          Maybe
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    Nothing -> Maybe ([Id], ForeignHValue, FixityEnv)
    -> Hsc (Maybe ([Id], ForeignHValue, FixityEnv))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ([Id], ForeignHValue, FixityEnv)
    forall a. Maybe a
    Nothing

          Just GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    parsed_stmt -> do
            HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
            IO (Maybe ([Id], ForeignHValue, FixityEnv))
    -> Hsc (Maybe ([Id], ForeignHValue, FixityEnv))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe ([Id], ForeignHValue, FixityEnv))
     -> Hsc (Maybe ([Id], ForeignHValue, FixityEnv)))
    -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
    -> Hsc (Maybe ([Id], ForeignHValue, FixityEnv))
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> GhciLStmt GhcPs -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
    hscParsedStmt HscEnv
    hsc_env GenLocated
      SrcSpanAnnA
      (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    GhciLStmt GhcPs
    parsed_stmt

    hscParsedStmt :: HscEnv
                  -> GhciLStmt GhcPs  -- ^ The parsed statement
                  -> IO ( Maybe ([Id]
                        , ForeignHValue {- IO [HValue] -}
                        , FixityEnv))
    hscParsedStmt :: HscEnv
    -> GhciLStmt GhcPs -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
    hscParsedStmt HscEnv
    hsc_env GhciLStmt GhcPs
    stmt = HscEnv
    -> Hsc (Maybe ([Id], ForeignHValue, FixityEnv))
    -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env (Hsc (Maybe ([Id], ForeignHValue, FixityEnv))
     -> IO (Maybe ([Id], ForeignHValue, FixityEnv)))
    -> Hsc (Maybe ([Id], ForeignHValue, FixityEnv))
    -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
    forall a b. (a -> b) -> a -> b
    $ do
      -- Rename and typecheck it
      ([Id]
    ids, GenLocated SrcSpanAnnA (HsExpr GhcTc)
    tc_expr, FixityEnv
    fix_env) <- IO (Messages DecoratedSDoc, Maybe ([Id], LHsExpr GhcTc, FixityEnv))
    -> Hsc ([Id], LHsExpr GhcTc, FixityEnv)
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO
       (Messages DecoratedSDoc, Maybe ([Id], LHsExpr GhcTc, FixityEnv))
     -> Hsc ([Id], LHsExpr GhcTc, FixityEnv))
    -> IO
         (Messages DecoratedSDoc, Maybe ([Id], LHsExpr GhcTc, FixityEnv))
    -> Hsc ([Id], LHsExpr GhcTc, FixityEnv)
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> GhciLStmt GhcPs
    -> IO
         (Messages DecoratedSDoc, Maybe ([Id], LHsExpr GhcTc, FixityEnv))
    tcRnStmt HscEnv
    hsc_env GhciLStmt GhcPs
    stmt

      -- Desugar it
      CoreExpr
    ds_expr <- IO (Messages DecoratedSDoc, Maybe CoreExpr) -> Hsc CoreExpr
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages DecoratedSDoc, Maybe CoreExpr) -> Hsc CoreExpr)
    -> IO (Messages DecoratedSDoc, Maybe CoreExpr) -> Hsc CoreExpr
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> LHsExpr GhcTc -> IO (Messages DecoratedSDoc, Maybe CoreExpr)
    deSugarExpr HscEnv
    hsc_env GenLocated SrcSpanAnnA (HsExpr GhcTc)
    LHsExpr GhcTc
    tc_expr
      IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (SDoc -> HscEnv -> CoreExpr -> IO ()
    lintInteractiveExpr ([Char] -> SDoc
    text [Char]
    "desugar expression") HscEnv
    hsc_env CoreExpr
    ds_expr)
      Hsc ()
    handleWarnings

      -- Then code-gen, and link it
      -- It's important NOT to have package 'interactive' as thisUnitId
      -- for linking, else we try to link 'main' and can't find it.
      -- Whereas the linker already knows to ignore 'interactive'
      let src_span :: SrcSpan
    src_span = SrcLoc -> SrcSpan
    srcLocSpan SrcLoc
    interactiveSrcLoc
      ForeignHValue
    hval <- IO ForeignHValue -> Hsc ForeignHValue
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ForeignHValue -> Hsc ForeignHValue)
    -> IO ForeignHValue -> Hsc ForeignHValue
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue
    hscCompileCoreExpr HscEnv
    hsc_env SrcSpan
    src_span CoreExpr
    ds_expr

      Maybe ([Id], ForeignHValue, FixityEnv)
    -> Hsc (Maybe ([Id], ForeignHValue, FixityEnv))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ([Id], ForeignHValue, FixityEnv)
     -> Hsc (Maybe ([Id], ForeignHValue, FixityEnv)))
    -> Maybe ([Id], ForeignHValue, FixityEnv)
    -> Hsc (Maybe ([Id], ForeignHValue, FixityEnv))
    forall a b. (a -> b) -> a -> b
    $ ([Id], ForeignHValue, FixityEnv)
    -> Maybe ([Id], ForeignHValue, FixityEnv)
    forall a. a -> Maybe a
    Just ([Id]
    ids, ForeignHValue
    hval, FixityEnv
    fix_env)

    -- | Compile a decls
    hscDecls :: HscEnv
             -> String -- ^ The statement
             -> IO ([TyThing], InteractiveContext)
    hscDecls :: HscEnv -> [Char] -> IO ([TyThing], InteractiveContext)
    hscDecls HscEnv
    hsc_env [Char]
    str = HscEnv
    -> [Char] -> [Char] -> Int -> IO ([TyThing], InteractiveContext)
    hscDeclsWithLocation HscEnv
    hsc_env [Char]
    str [Char]
    "<interactive>" Int
    1

    hscParseDeclsWithLocation :: HscEnv -> String -> Int -> String -> IO [LHsDecl GhcPs]
    hscParseDeclsWithLocation :: HscEnv -> [Char] -> Int -> [Char] -> IO [LHsDecl GhcPs]
    hscParseDeclsWithLocation HscEnv
    hsc_env [Char]
    source Int
    line_num [Char]
    str = do
        L SrcSpan
    _ (HsModule{ hsmodDecls :: HsModule -> [LHsDecl GhcPs]
    hsmodDecls = [LHsDecl GhcPs]
    decls }) <-
          HscEnv -> Hsc (Located HsModule) -> IO (Located HsModule)
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env (Hsc (Located HsModule) -> IO (Located HsModule))
    -> Hsc (Located HsModule) -> IO (Located HsModule)
    forall a b. (a -> b) -> a -> b
    $
            [Char]
    -> Int -> P (Located HsModule) -> [Char] -> Hsc (Located HsModule)
    forall thing.
    (Outputable thing, Data thing) =>
    [Char] -> Int -> P thing -> [Char] -> Hsc thing
    hscParseThingWithLocation [Char]
    source Int
    line_num P (Located HsModule)
    parseModule [Char]
    str
        [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> IO [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    [LHsDecl GhcPs]
    decls

    -- | Compile a decls
    hscDeclsWithLocation :: HscEnv
                         -> String -- ^ The statement
                         -> String -- ^ The source
                         -> Int    -- ^ Starting line
                         -> IO ([TyThing], InteractiveContext)
    hscDeclsWithLocation :: HscEnv
    -> [Char] -> [Char] -> Int -> IO ([TyThing], InteractiveContext)
    hscDeclsWithLocation HscEnv
    hsc_env [Char]
    str [Char]
    source Int
    linenumber = do
        L SrcSpan
    _ (HsModule{ hsmodDecls :: HsModule -> [LHsDecl GhcPs]
    hsmodDecls = [LHsDecl GhcPs]
    decls }) <-
          HscEnv -> Hsc (Located HsModule) -> IO (Located HsModule)
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env (Hsc (Located HsModule) -> IO (Located HsModule))
    -> Hsc (Located HsModule) -> IO (Located HsModule)
    forall a b. (a -> b) -> a -> b
    $
            [Char]
    -> Int -> P (Located HsModule) -> [Char] -> Hsc (Located HsModule)
    forall thing.
    (Outputable thing, Data thing) =>
    [Char] -> Int -> P thing -> [Char] -> Hsc thing
    hscParseThingWithLocation [Char]
    source Int
    linenumber P (Located HsModule)
    parseModule [Char]
    str
        HscEnv -> [LHsDecl GhcPs] -> IO ([TyThing], InteractiveContext)
    hscParsedDecls HscEnv
    hsc_env [LHsDecl GhcPs]
    decls

    hscParsedDecls :: HscEnv -> [LHsDecl GhcPs] -> IO ([TyThing], InteractiveContext)
    hscParsedDecls :: HscEnv -> [LHsDecl GhcPs] -> IO ([TyThing], InteractiveContext)
    hscParsedDecls HscEnv
    hsc_env [LHsDecl GhcPs]
    decls = HscEnv
    -> Hsc ([TyThing], InteractiveContext)
    -> IO ([TyThing], InteractiveContext)
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env (Hsc ([TyThing], InteractiveContext)
     -> IO ([TyThing], InteractiveContext))
    -> Hsc ([TyThing], InteractiveContext)
    -> IO ([TyThing], InteractiveContext)
    forall a b. (a -> b) -> a -> b
    $ do
        HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
        let interp :: Interp
    interp = HscEnv -> Interp
    hscInterp HscEnv
    hsc_env

        {- Rename and typecheck it -}
        TcGblEnv
    tc_gblenv <- IO (Messages DecoratedSDoc, Maybe TcGblEnv) -> Hsc TcGblEnv
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages DecoratedSDoc, Maybe TcGblEnv) -> Hsc TcGblEnv)
    -> IO (Messages DecoratedSDoc, Maybe TcGblEnv) -> Hsc TcGblEnv
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> [LHsDecl GhcPs] -> IO (Messages DecoratedSDoc, Maybe TcGblEnv)
    tcRnDeclsi HscEnv
    hsc_env [LHsDecl GhcPs]
    decls

        {- Grab the new instances -}
        -- We grab the whole environment because of the overlapping that may have
        -- been done. See the notes at the definition of InteractiveContext
        -- (ic_instances) for more details.
        let defaults :: Maybe [Mult]
    defaults = TcGblEnv -> Maybe [Mult]
    tcg_default TcGblEnv
    tc_gblenv

        {- Desugar it -}
        -- We use a basically null location for iNTERACTIVE
        let iNTERACTIVELoc :: ModLocation
    iNTERACTIVELoc = ModLocation{ ml_hs_file :: Maybe [Char]
    ml_hs_file   = Maybe [Char]
    forall a. Maybe a
    Nothing,
                                          ml_hi_file :: [Char]
    ml_hi_file   = [Char] -> [Char]
    forall a. [Char] -> a
    panic [Char]
    "hsDeclsWithLocation:ml_hi_file",
                                          ml_obj_file :: [Char]
    ml_obj_file  = [Char] -> [Char]
    forall a. [Char] -> a
    panic [Char]
    "hsDeclsWithLocation:ml_obj_file",
                                          ml_hie_file :: [Char]
    ml_hie_file  = [Char] -> [Char]
    forall a. [Char] -> a
    panic [Char]
    "hsDeclsWithLocation:ml_hie_file" }
        ModGuts
    ds_result <- ModLocation -> TcGblEnv -> Hsc ModGuts
    hscDesugar' ModLocation
    iNTERACTIVELoc TcGblEnv
    tc_gblenv

        {- Simplify -}
        ModGuts
    simpl_mg <- IO ModGuts -> Hsc ModGuts
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ModGuts -> Hsc ModGuts) -> IO ModGuts -> Hsc ModGuts
    forall a b. (a -> b) -> a -> b
    $ do
          [[Char]]
    plugins <- IORef [[Char]] -> IO [[Char]]
    forall a. IORef a -> IO a
    readIORef (TcGblEnv -> IORef [[Char]]
    tcg_th_coreplugins TcGblEnv
    tc_gblenv)
          HscEnv -> [[Char]] -> ModGuts -> IO ModGuts
    hscSimplify HscEnv
    hsc_env [[Char]]
    plugins ModGuts
    ds_result

        {- Tidy -}
        (CgGuts
    tidy_cg, ModDetails
    mod_details) <- IO (CgGuts, ModDetails) -> Hsc (CgGuts, ModDetails)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (CgGuts, ModDetails) -> Hsc (CgGuts, ModDetails))
    -> IO (CgGuts, ModDetails) -> Hsc (CgGuts, ModDetails)
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> ModGuts -> IO (CgGuts, ModDetails)
    tidyProgram HscEnv
    hsc_env ModGuts
    simpl_mg

        let !CgGuts{ cg_module :: CgGuts -> Module
    cg_module    = Module
    this_mod,
                     cg_binds :: CgGuts -> CoreProgram
    cg_binds     = CoreProgram
    core_binds,
                     cg_tycons :: CgGuts -> [TyCon]
    cg_tycons    = [TyCon]
    tycons,
                     cg_modBreaks :: CgGuts -> Maybe ModBreaks
    cg_modBreaks = Maybe ModBreaks
    mod_breaks } = CgGuts
    tidy_cg

            !ModDetails { md_insts :: ModDetails -> [ClsInst]
    md_insts     = [ClsInst]
    cls_insts
                        , md_fam_insts :: ModDetails -> [FamInst]
    md_fam_insts = [FamInst]
    fam_insts } = ModDetails
    mod_details
                -- Get the *tidied* cls_insts and fam_insts

            data_tycons :: [TyCon]
    data_tycons = (TyCon -> Bool) -> [TyCon] -> [TyCon]
    forall a. (a -> Bool) -> [a] -> [a]
    filter TyCon -> Bool
    isDataTyCon [TyCon]
    tycons

        {- Prepare For Code Generation -}
        -- Do saturation and convert to A-normal form
        (CoreProgram
    prepd_binds, Set CostCentre
    _) <- {-# SCC "CorePrep" #-}
          IO (CoreProgram, Set CostCentre)
    -> Hsc (CoreProgram, Set CostCentre)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (CoreProgram, Set CostCentre)
     -> Hsc (CoreProgram, Set CostCentre))
    -> IO (CoreProgram, Set CostCentre)
    -> Hsc (CoreProgram, Set CostCentre)
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> Module
    -> ModLocation
    -> CoreProgram
    -> [TyCon]
    -> IO (CoreProgram, Set CostCentre)
    corePrepPgm HscEnv
    hsc_env Module
    this_mod ModLocation
    iNTERACTIVELoc CoreProgram
    core_binds [TyCon]
    data_tycons

        ([StgTopBinding]
    stg_binds, InfoTableProvMap
    _infotable_prov, ([CostCentre], [CostCentreStack])
    _caf_ccs__caf_cc_stacks)
            <- {-# SCC "CoreToStg" #-}
               IO
      ([StgTopBinding], InfoTableProvMap,
       ([CostCentre], [CostCentreStack]))
    -> Hsc
         ([StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO
       ([StgTopBinding], InfoTableProvMap,
        ([CostCentre], [CostCentreStack]))
     -> Hsc
          ([StgTopBinding], InfoTableProvMap,
           ([CostCentre], [CostCentreStack])))
    -> IO
         ([StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    -> Hsc
         ([StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> DynFlags
    -> InteractiveContext
    -> Module
    -> ModLocation
    -> CoreProgram
    -> IO
         ([StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    myCoreToStg (HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env)
                                    (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)
                                    (HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env)
                                    Module
    this_mod
                                    ModLocation
    iNTERACTIVELoc
                                    CoreProgram
    prepd_binds

        {- Generate byte code -}
        CompiledByteCode
    cbc <- IO CompiledByteCode -> Hsc CompiledByteCode
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO CompiledByteCode -> Hsc CompiledByteCode)
    -> IO CompiledByteCode -> Hsc CompiledByteCode
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> Module
    -> [StgTopBinding]
    -> [TyCon]
    -> Maybe ModBreaks
    -> IO CompiledByteCode
    byteCodeGen HscEnv
    hsc_env Module
    this_mod
                                    [StgTopBinding]
    stg_binds [TyCon]
    data_tycons Maybe ModBreaks
    mod_breaks

        let src_span :: SrcSpan
    src_span = SrcLoc -> SrcSpan
    srcLocSpan SrcLoc
    interactiveSrcLoc
        [(Name, ForeignHValue)]
    _ <- IO [(Name, ForeignHValue)] -> Hsc [(Name, ForeignHValue)]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [(Name, ForeignHValue)] -> Hsc [(Name, ForeignHValue)])
    -> IO [(Name, ForeignHValue)] -> Hsc [(Name, ForeignHValue)]
    forall a b. (a -> b) -> a -> b
    $ Interp
    -> HscEnv
    -> SrcSpan
    -> CompiledByteCode
    -> IO [(Name, ForeignHValue)]
    loadDecls Interp
    interp HscEnv
    hsc_env SrcSpan
    src_span CompiledByteCode
    cbc

        {- Load static pointer table entries -}
        IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> [SptEntry] -> IO ()
    hscAddSptEntries HscEnv
    hsc_env (CgGuts -> [SptEntry]
    cg_spt_entries CgGuts
    tidy_cg)

        let tcs :: [TyCon]
    tcs = (TyCon -> Bool) -> [TyCon] -> [TyCon]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut TyCon -> Bool
    isImplicitTyCon (ModGuts -> [TyCon]
    mg_tcs ModGuts
    simpl_mg)
            patsyns :: [PatSyn]
    patsyns = ModGuts -> [PatSyn]
    mg_patsyns ModGuts
    simpl_mg

            ext_ids :: [Id]
    ext_ids = [ Id
    id | Id
    id <- CoreProgram -> [Id]
    forall b. [Bind b] -> [b]
    bindersOfBinds CoreProgram
    core_binds
                           , Name -> Bool
    isExternalName (Id -> Name
    idName Id
    id)
                           , Bool -> Bool
    not (Id -> Bool
    isDFunId Id
    id Bool -> Bool -> Bool
    || Id -> Bool
    isImplicitId Id
    id) ]
                -- We only need to keep around the external bindings
                -- (as decided by GHC.Iface.Tidy), since those are the only ones
                -- that might later be looked up by name.  But we can exclude
                --    - DFunIds, which are in 'cls_insts' (see Note [ic_tythings] in GHC.Runtime.Context
                --    - Implicit Ids, which are implicit in tcs
                -- c.f. GHC.Tc.Module.runTcInteractive, which reconstructs the TypeEnv

            new_tythings :: [TyThing]
    new_tythings = (Id -> TyThing) -> [Id] -> [TyThing]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> TyThing
    AnId [Id]
    ext_ids [TyThing] -> [TyThing] -> [TyThing]
    forall a. [a] -> [a] -> [a]
    ++ (TyCon -> TyThing) -> [TyCon] -> [TyThing]
    forall a b. (a -> b) -> [a] -> [b]
    map TyCon -> TyThing
    ATyCon [TyCon]
    tcs [TyThing] -> [TyThing] -> [TyThing]
    forall a. [a] -> [a] -> [a]
    ++ (PatSyn -> TyThing) -> [PatSyn] -> [TyThing]
    forall a b. (a -> b) -> [a] -> [b]
    map (ConLike -> TyThing
    AConLike (ConLike -> TyThing) -> (PatSyn -> ConLike) -> PatSyn -> TyThing
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . PatSyn -> ConLike
    PatSynCon) [PatSyn]
    patsyns
            ictxt :: InteractiveContext
    ictxt        = HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env
            -- See Note [Fixity declarations in GHCi]
            fix_env :: FixityEnv
    fix_env      = TcGblEnv -> FixityEnv
    tcg_fix_env TcGblEnv
    tc_gblenv
            new_ictxt :: InteractiveContext
    new_ictxt    = InteractiveContext
    -> [TyThing]
    -> [ClsInst]
    -> [FamInst]
    -> Maybe [Mult]
    -> FixityEnv
    -> InteractiveContext
    extendInteractiveContext InteractiveContext
    ictxt [TyThing]
    new_tythings [ClsInst]
    cls_insts
                                                    [FamInst]
    fam_insts Maybe [Mult]
    defaults FixityEnv
    fix_env
        ([TyThing], InteractiveContext)
    -> Hsc ([TyThing], InteractiveContext)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TyThing]
    new_tythings, InteractiveContext
    new_ictxt)

    -- | Load the given static-pointer table entries into the interpreter.
    -- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable".
    hscAddSptEntries :: HscEnv -> [SptEntry] -> IO ()
    hscAddSptEntries :: HscEnv -> [SptEntry] -> IO ()
    hscAddSptEntries HscEnv
    hsc_env [SptEntry]
    entries = do
        let interp :: Interp
    interp = HscEnv -> Interp
    hscInterp HscEnv
    hsc_env
        let add_spt_entry :: SptEntry -> IO ()
            add_spt_entry :: SptEntry -> IO ()
    add_spt_entry (SptEntry Id
    i Fingerprint
    fpr) = do
                ForeignHValue
    val <- Interp -> HscEnv -> Name -> IO ForeignHValue
    loadName Interp
    interp HscEnv
    hsc_env (Id -> Name
    idName Id
    i)
                Interp -> Fingerprint -> ForeignHValue -> IO ()
    addSptEntry Interp
    interp Fingerprint
    fpr ForeignHValue
    val
        (SptEntry -> IO ()) -> [SptEntry] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ SptEntry -> IO ()
    add_spt_entry [SptEntry]
    entries

    {-
      Note [Fixity declarations in GHCi]
      ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

      To support fixity declarations on types defined within GHCi (as requested
      in #10018) we record the fixity environment in InteractiveContext.
      When we want to evaluate something GHC.Tc.Module.runTcInteractive pulls out this
      fixity environment and uses it to initialize the global typechecker environment.
      After the typechecker has finished its business, an updated fixity environment
      (reflecting whatever fixity declarations were present in the statements we
      passed it) will be returned from hscParsedStmt. This is passed to
      updateFixityEnv, which will stuff it back into InteractiveContext, to be
      used in evaluating the next statement.

    -}

    hscImport :: HscEnv -> String -> IO (ImportDecl GhcPs)
    hscImport :: HscEnv -> [Char] -> IO (ImportDecl GhcPs)
    hscImport HscEnv
    hsc_env [Char]
    str = HscEnv -> Hsc (ImportDecl GhcPs) -> IO (ImportDecl GhcPs)
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env (Hsc (ImportDecl GhcPs) -> IO (ImportDecl GhcPs))
    -> Hsc (ImportDecl GhcPs) -> IO (ImportDecl GhcPs)
    forall a b. (a -> b) -> a -> b
    $ do
        (L SrcSpan
    _ (HsModule{hsmodImports :: HsModule -> [LImportDecl GhcPs]
    hsmodImports=[LImportDecl GhcPs]
    is})) <-
           P (Located HsModule) -> [Char] -> Hsc (Located HsModule)
    forall thing.
    (Outputable thing, Data thing) =>
    P thing -> [Char] -> Hsc thing
    hscParseThing P (Located HsModule)
    parseModule [Char]
    str
        case [LImportDecl GhcPs]
    is of
            [L SrcSpanAnnA
    _ ImportDecl GhcPs
    i] -> ImportDecl GhcPs -> Hsc (ImportDecl GhcPs)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ImportDecl GhcPs
    i
            [LImportDecl GhcPs]
    _ -> IO (ImportDecl GhcPs) -> Hsc (ImportDecl GhcPs)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (ImportDecl GhcPs) -> Hsc (ImportDecl GhcPs))
    -> IO (ImportDecl GhcPs) -> Hsc (ImportDecl GhcPs)
    forall a b. (a -> b) -> a -> b
    $ MsgEnvelope DecoratedSDoc -> IO (ImportDecl GhcPs)
    forall (io :: * -> *) a.
    MonadIO io =>
    MsgEnvelope DecoratedSDoc -> io a
    throwOneError (MsgEnvelope DecoratedSDoc -> IO (ImportDecl GhcPs))
    -> MsgEnvelope DecoratedSDoc -> IO (ImportDecl GhcPs)
    forall a b. (a -> b) -> a -> b
    $
                     SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainMsgEnvelope SrcSpan
    noSrcSpan (SDoc -> MsgEnvelope DecoratedSDoc)
    -> SDoc -> MsgEnvelope DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $
                         [Char] -> SDoc
    text [Char]
    "parse error in import declaration"

    -- | Typecheck an expression (but don't run it)
    hscTcExpr :: HscEnv
              -> TcRnExprMode
              -> String -- ^ The expression
              -> IO Type
    hscTcExpr :: HscEnv -> TcRnExprMode -> [Char] -> IO Mult
    hscTcExpr HscEnv
    hsc_env0 TcRnExprMode
    mode [Char]
    expr = HscEnv -> Hsc Mult -> IO Mult
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env0 (Hsc Mult -> IO Mult) -> Hsc Mult -> IO Mult
    forall a b. (a -> b) -> a -> b
    $ do
      HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
      GenLocated SrcSpanAnnA (HsExpr GhcPs)
    parsed_expr <- [Char] -> Hsc (LHsExpr GhcPs)
    hscParseExpr [Char]
    expr
      IO (Messages DecoratedSDoc, Maybe Mult) -> Hsc Mult
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages DecoratedSDoc, Maybe Mult) -> Hsc Mult)
    -> IO (Messages DecoratedSDoc, Maybe Mult) -> Hsc Mult
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> TcRnExprMode
    -> LHsExpr GhcPs
    -> IO (Messages DecoratedSDoc, Maybe Mult)
    tcRnExpr HscEnv
    hsc_env TcRnExprMode
    mode GenLocated SrcSpanAnnA (HsExpr GhcPs)
    LHsExpr GhcPs
    parsed_expr

    -- | Find the kind of a type, after generalisation
    hscKcType
      :: HscEnv
      -> Bool            -- ^ Normalise the type
      -> String          -- ^ The type as a string
      -> IO (Type, Kind) -- ^ Resulting type (possibly normalised) and kind
    hscKcType :: HscEnv -> Bool -> [Char] -> IO (Mult, Mult)
    hscKcType HscEnv
    hsc_env0 Bool
    normalise [Char]
    str = HscEnv -> Hsc (Mult, Mult) -> IO (Mult, Mult)
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env0 (Hsc (Mult, Mult) -> IO (Mult, Mult))
    -> Hsc (Mult, Mult) -> IO (Mult, Mult)
    forall a b. (a -> b) -> a -> b
    $ do
        HscEnv
    hsc_env <- Hsc HscEnv
    getHscEnv
        GenLocated SrcSpanAnnA (HsType GhcPs)
    ty <- [Char] -> Hsc (LHsType GhcPs)
    hscParseType [Char]
    str
        IO (Messages DecoratedSDoc, Maybe (Mult, Mult)) -> Hsc (Mult, Mult)
    forall a. IO (Messages DecoratedSDoc, Maybe a) -> Hsc a
    ioMsgMaybe (IO (Messages DecoratedSDoc, Maybe (Mult, Mult))
     -> Hsc (Mult, Mult))
    -> IO (Messages DecoratedSDoc, Maybe (Mult, Mult))
    -> Hsc (Mult, Mult)
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> ZonkFlexi
    -> Bool
    -> LHsType GhcPs
    -> IO (Messages DecoratedSDoc, Maybe (Mult, Mult))
    tcRnType HscEnv
    hsc_env ZonkFlexi
    DefaultFlexi Bool
    normalise GenLocated SrcSpanAnnA (HsType GhcPs)
    LHsType GhcPs
    ty

    hscParseExpr :: String -> Hsc (LHsExpr GhcPs)
    hscParseExpr :: [Char] -> Hsc (LHsExpr GhcPs)
    hscParseExpr [Char]
    expr = do
      Maybe
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    maybe_stmt <- [Char] -> Hsc (Maybe (GhciLStmt GhcPs))
    hscParseStmt [Char]
    expr
      case Maybe
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    maybe_stmt of
        Just (L SrcSpanAnnA
    _ (BodyStmt XBodyStmt GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    _ GenLocated SrcSpanAnnA (HsExpr GhcPs)
    expr SyntaxExpr GhcPs
    _ SyntaxExpr GhcPs
    _)) -> GenLocated SrcSpanAnnA (HsExpr GhcPs)
    -> Hsc (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    forall (m :: * -> *) a. Monad m => a -> m a
    return GenLocated SrcSpanAnnA (HsExpr GhcPs)
    expr
        Maybe
      (GenLocated
         SrcSpanAnnA
         (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs))))
    _ -> MsgEnvelope DecoratedSDoc
    -> Hsc (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    forall (io :: * -> *) a.
    MonadIO io =>
    MsgEnvelope DecoratedSDoc -> io a
    throwOneError (MsgEnvelope DecoratedSDoc
     -> Hsc (GenLocated SrcSpanAnnA (HsExpr GhcPs)))
    -> MsgEnvelope DecoratedSDoc
    -> Hsc (GenLocated SrcSpanAnnA (HsExpr GhcPs))
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainMsgEnvelope SrcSpan
    noSrcSpan
          ([Char] -> SDoc
    text [Char]
    "not an expression:" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes ([Char] -> SDoc
    text [Char]
    expr))

    hscParseStmt :: String -> Hsc (Maybe (GhciLStmt GhcPs))
    hscParseStmt :: [Char] -> Hsc (Maybe (GhciLStmt GhcPs))
    hscParseStmt = P (Maybe
         (GenLocated
            SrcSpanAnnA
            (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
    -> [Char]
    -> Hsc
         (Maybe
            (GenLocated
               SrcSpanAnnA
               (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
    forall thing.
    (Outputable thing, Data thing) =>
    P thing -> [Char] -> Hsc thing
    hscParseThing P (Maybe
         (GenLocated
            SrcSpanAnnA
            (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
    parseStmt

    hscParseStmtWithLocation :: String -> Int -> String
                             -> Hsc (Maybe (GhciLStmt GhcPs))
    hscParseStmtWithLocation :: [Char] -> Int -> [Char] -> Hsc (Maybe (GhciLStmt GhcPs))
    hscParseStmtWithLocation [Char]
    source Int
    linenumber [Char]
    stmt =
        [Char]
    -> Int
    -> P (Maybe
            (GenLocated
               SrcSpanAnnA
               (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
    -> [Char]
    -> Hsc
         (Maybe
            (GenLocated
               SrcSpanAnnA
               (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
    forall thing.
    (Outputable thing, Data thing) =>
    [Char] -> Int -> P thing -> [Char] -> Hsc thing
    hscParseThingWithLocation [Char]
    source Int
    linenumber P (Maybe
         (GenLocated
            SrcSpanAnnA
            (StmtLR GhcPs GhcPs (GenLocated SrcSpanAnnA (HsExpr GhcPs)))))
    parseStmt [Char]
    stmt

    hscParseType :: String -> Hsc (LHsType GhcPs)
    hscParseType :: [Char] -> Hsc (LHsType GhcPs)
    hscParseType = P (GenLocated SrcSpanAnnA (HsType GhcPs))
    -> [Char] -> Hsc (GenLocated SrcSpanAnnA (HsType GhcPs))
    forall thing.
    (Outputable thing, Data thing) =>
    P thing -> [Char] -> Hsc thing
    hscParseThing P (GenLocated SrcSpanAnnA (HsType GhcPs))
    parseType

    hscParseIdentifier :: HscEnv -> String -> IO (LocatedN RdrName)
    hscParseIdentifier :: HscEnv -> [Char] -> IO (LocatedN RdrName)
    hscParseIdentifier HscEnv
    hsc_env [Char]
    str =
        HscEnv -> Hsc (LocatedN RdrName) -> IO (LocatedN RdrName)
    forall a. HscEnv -> Hsc a -> IO a
    runInteractiveHsc HscEnv
    hsc_env (Hsc (LocatedN RdrName) -> IO (LocatedN RdrName))
    -> Hsc (LocatedN RdrName) -> IO (LocatedN RdrName)
    forall a b. (a -> b) -> a -> b
    $ P (LocatedN RdrName) -> [Char] -> Hsc (LocatedN RdrName)
    forall thing.
    (Outputable thing, Data thing) =>
    P thing -> [Char] -> Hsc thing
    hscParseThing P (LocatedN RdrName)
    parseIdentifier [Char]
    str

    hscParseThing :: (Outputable thing, Data thing)
                  => Lexer.P thing -> String -> Hsc thing
    hscParseThing :: forall thing.
    (Outputable thing, Data thing) =>
    P thing -> [Char] -> Hsc thing
    hscParseThing = [Char] -> Int -> P thing -> [Char] -> Hsc thing
    forall thing.
    (Outputable thing, Data thing) =>
    [Char] -> Int -> P thing -> [Char] -> Hsc thing
    hscParseThingWithLocation [Char]
    "<interactive>" Int
    1

    hscParseThingWithLocation :: (Outputable thing, Data thing) => String -> Int
                              -> Lexer.P thing -> String -> Hsc thing
    hscParseThingWithLocation :: forall thing.
    (Outputable thing, Data thing) =>
    [Char] -> Int -> P thing -> [Char] -> Hsc thing
    hscParseThingWithLocation [Char]
    source Int
    linenumber P thing
    parser [Char]
    str = do
        DynFlags
    dflags <- Hsc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        Logger
    logger <- Hsc Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        Logger
    -> DynFlags -> SDoc -> (thing -> ()) -> Hsc thing -> Hsc thing
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> DynFlags -> SDoc -> (a -> ()) -> m a -> m a
    withTiming Logger
    logger DynFlags
    dflags
                   ([Char] -> SDoc
    text [Char]
    "Parser [source]")
                   (() -> thing -> ()
    forall a b. a -> b -> a
    const ()) (Hsc thing -> Hsc thing) -> Hsc thing -> Hsc thing
    forall a b. (a -> b) -> a -> b
    $ {-# SCC "Parser" #-} do

            let buf :: StringBuffer
    buf = [Char] -> StringBuffer
    stringToStringBuffer [Char]
    str
                loc :: RealSrcLoc
    loc = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc ([Char] -> FastString
    fsLit [Char]
    source) Int
    linenumber Int
    1

            case P thing -> PState -> ParseResult thing
    forall a. P a -> PState -> ParseResult a
    unP P thing
    parser (ParserOpts -> StringBuffer -> RealSrcLoc -> PState
    initParserState (DynFlags -> ParserOpts
    initParserOpts DynFlags
    dflags) StringBuffer
    buf RealSrcLoc
    loc) of
                PFailed PState
    pst ->
                    (Bag PsWarning, Bag PsError) -> Hsc thing
    forall a. (Bag PsWarning, Bag PsError) -> Hsc a
    handleWarningsThrowErrors (PState -> (Bag PsWarning, Bag PsError)
    getMessages PState
    pst)
                POk PState
    pst thing
    thing -> do
                    (Bag PsWarning, Bag PsError) -> Hsc ()
    logWarningsReportErrors (PState -> (Bag PsWarning, Bag PsError)
    getMessages PState
    pst)
                    IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_parsed [Char]
    "Parser"
                                DumpFormat
    FormatHaskell (thing -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr thing
    thing)
                    IO () -> Hsc ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> DynFlags -> DumpFlag -> [Char] -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_parsed_ast [Char]
    "Parser AST"
                                DumpFormat
    FormatHaskell (BlankSrcSpan -> BlankEpAnnotations -> thing -> SDoc
    forall a. Data a => BlankSrcSpan -> BlankEpAnnotations -> a -> SDoc
    showAstData BlankSrcSpan
    NoBlankSrcSpan BlankEpAnnotations
    NoBlankEpAnnotations thing
    thing)
                    thing -> Hsc thing
    forall (m :: * -> *) a. Monad m => a -> m a
    return thing
    thing

    {- **********************************************************************
    %*                                                                      *
            Desugar, simplify, convert to bytecode, and link an expression
    %*                                                                      *
    %********************************************************************* -}

    hscCompileCoreExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue
    hscCompileCoreExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue
    hscCompileCoreExpr HscEnv
    hsc_env SrcSpan
    loc CoreExpr
    expr =
      case Hooks -> Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)
    hscCompileCoreExprHook (HscEnv -> Hooks
    hsc_hooks HscEnv
    hsc_env) of
          Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)
    Nothing -> HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue
    hscCompileCoreExpr' HscEnv
    hsc_env SrcSpan
    loc CoreExpr
    expr
          Just HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue
    h  -> HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue
    h                   HscEnv
    hsc_env SrcSpan
    loc CoreExpr
    expr

    hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue
    hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue
    hscCompileCoreExpr' HscEnv
    hsc_env SrcSpan
    srcspan CoreExpr
    ds_expr
        = do { {- Simplify it -}
               -- Question: should we call SimpleOpt.simpleOptExpr here instead?
               -- It is, well, simpler, and does less inlining etc.
               CoreExpr
    simpl_expr <- HscEnv -> CoreExpr -> IO CoreExpr
    simplifyExpr HscEnv
    hsc_env CoreExpr
    ds_expr

               {- Tidy it (temporary, until coreSat does cloning) -}
             ; let tidy_expr :: CoreExpr
    tidy_expr = TidyEnv -> CoreExpr -> CoreExpr
    tidyExpr TidyEnv
    emptyTidyEnv CoreExpr
    simpl_expr

               {- Prepare for codegen -}
             ; CoreExpr
    prepd_expr <- HscEnv -> CoreExpr -> IO CoreExpr
    corePrepExpr HscEnv
    hsc_env CoreExpr
    tidy_expr

               {- Lint if necessary -}
             ; SDoc -> HscEnv -> CoreExpr -> IO ()
    lintInteractiveExpr ([Char] -> SDoc
    text [Char]
    "hscCompileExpr") HscEnv
    hsc_env CoreExpr
    prepd_expr
             ; let iNTERACTIVELoc :: ModLocation
    iNTERACTIVELoc = ModLocation{ ml_hs_file :: Maybe [Char]
    ml_hs_file   = Maybe [Char]
    forall a. Maybe a
    Nothing,
                                          ml_hi_file :: [Char]
    ml_hi_file   = [Char] -> [Char]
    forall a. [Char] -> a
    panic [Char]
    "hscCompileCoreExpr':ml_hi_file",
                                          ml_obj_file :: [Char]
    ml_obj_file  = [Char] -> [Char]
    forall a. [Char] -> a
    panic [Char]
    "hscCompileCoreExpr':ml_obj_file",
                                          ml_hie_file :: [Char]
    ml_hie_file  = [Char] -> [Char]
    forall a. [Char] -> a
    panic [Char]
    "hscCompileCoreExpr':ml_hie_file" }

             ; let ictxt :: InteractiveContext
    ictxt = HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env
             ; (Id
    binding_id, [StgTopBinding]
    stg_expr, InfoTableProvMap
    _, ([CostCentre], [CostCentreStack])
    _) <-
                 Logger
    -> DynFlags
    -> InteractiveContext
    -> Module
    -> ModLocation
    -> CoreExpr
    -> IO
         (Id, [StgTopBinding], InfoTableProvMap,
          ([CostCentre], [CostCentreStack]))
    myCoreToStgExpr (HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env)
                                 (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)
                                 InteractiveContext
    ictxt
                                 (InteractiveContext -> Module
    icInteractiveModule InteractiveContext
    ictxt)
                                 ModLocation
    iNTERACTIVELoc
                                 CoreExpr
    prepd_expr

               {- Convert to BCOs -}
             ; CompiledByteCode
    bcos <- HscEnv
    -> Module
    -> [StgTopBinding]
    -> [TyCon]
    -> Maybe ModBreaks
    -> IO CompiledByteCode
    byteCodeGen HscEnv
    hsc_env
                         (InteractiveContext -> Module
    icInteractiveModule InteractiveContext
    ictxt)
                         [StgTopBinding]
    stg_expr
                         [] Maybe ModBreaks
    forall a. Maybe a
    Nothing

               {- load it -}
             ; [(Name, ForeignHValue)]
    fv_hvs <- Interp
    -> HscEnv
    -> SrcSpan
    -> CompiledByteCode
    -> IO [(Name, ForeignHValue)]
    loadDecls (HscEnv -> Interp
    hscInterp HscEnv
    hsc_env) HscEnv
    hsc_env SrcSpan
    srcspan CompiledByteCode
    bcos
               {- Get the HValue for the root -}
             ; ForeignHValue -> IO ForeignHValue
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Char] -> Maybe ForeignHValue -> ForeignHValue
    forall a. HasCallStack => [Char] -> Maybe a -> a
    expectJust [Char]
    "hscCompileCoreExpr'"
                  (Maybe ForeignHValue -> ForeignHValue)
    -> Maybe ForeignHValue -> ForeignHValue
    forall a b. (a -> b) -> a -> b
    $ Name -> [(Name, ForeignHValue)] -> Maybe ForeignHValue
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup (Id -> Name
    idName Id
    binding_id) [(Name, ForeignHValue)]
    fv_hvs) }

    {- **********************************************************************
    %*                                                                      *
            Statistics on reading interfaces
    %*                                                                      *
    %********************************************************************* -}

    dumpIfaceStats :: HscEnv -> IO ()
    dumpIfaceStats :: HscEnv -> IO ()
    dumpIfaceStats HscEnv
    hsc_env = do
        ExternalPackageState
    eps <- IORef ExternalPackageState -> IO ExternalPackageState
    forall a. IORef a -> IO a
    readIORef (HscEnv -> IORef ExternalPackageState
    hsc_EPS HscEnv
    hsc_env)
        Logger -> DynFlags -> Bool -> [Char] -> SDoc -> IO ()
    dumpIfSet Logger
    logger DynFlags
    dflags (Bool
    dump_if_trace Bool -> Bool -> Bool
    || Bool
    dump_rn_stats)
                  [Char]
    "Interface statistics"
                  (ExternalPackageState -> SDoc
    ifaceStats ExternalPackageState
    eps)
      where
        dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
        dump_rn_stats :: Bool
    dump_rn_stats = DumpFlag -> DynFlags -> Bool
    dopt DumpFlag
    Opt_D_dump_rn_stats DynFlags
    dflags
        dump_if_trace :: Bool
    dump_if_trace = DumpFlag -> DynFlags -> Bool
    dopt DumpFlag
    Opt_D_dump_if_trace DynFlags
    dflags

    {- **********************************************************************
    %*                                                                      *
            Progress Messages: Module i of n
    %*                                                                      *
    %********************************************************************* -}

    showModuleIndex :: (Int, Int) -> SDoc
    showModuleIndex :: (Int, Int) -> SDoc
    showModuleIndex (Int
    i,Int
    n) = [Char] -> SDoc
    text [Char]
    "[" SDoc -> SDoc -> SDoc
    <> SDoc
    pad SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int Int
    i SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    " of " SDoc -> SDoc -> SDoc
    <> Int -> SDoc
    int Int
    n SDoc -> SDoc -> SDoc
    <> [Char] -> SDoc
    text [Char]
    "] "
      where
        -- compute the length of x > 0 in base 10
        len :: a -> b
    len a
    x = Float -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling (Float -> Float -> Float
    forall a. Floating a => a -> a -> a
    logBase Float
    10 (a -> Float
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    xFloat -> Float -> Float
    forall a. Num a => a -> a -> a
    +Float
    1) :: Float)
        pad :: SDoc
    pad = [Char] -> SDoc
    text (Int -> Char -> [Char]
    forall a. Int -> a -> [a]
    replicate (Int -> Int
    forall {b} {a}. (Integral b, Integral a) => a -> b
    len Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int -> Int
    forall {b} {a}. (Integral b, Integral a) => a -> b
    len Int
    i) Char
    ' ') -- TODO: use GHC.Utils.Ppr.RStr