    {-# LANGUAGE CPP #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE NondecreasingIndentation #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TypeFamilies #-}

    -- | This is the driver for the 'ghc --backpack' mode, which
    -- is a reimplementation of the "package manager" bits of
    -- Backpack directly in GHC.  The basic method of operation
    -- is to compile packages and then directly insert them into
    -- GHC's in memory database.
    --
    -- The compilation products of this mode aren't really suitable
    -- for Cabal, because GHC makes up component IDs for the things
    -- it builds and doesn't serialize out the database contents.
    -- But it's still handy for constructing tests.

    module GHC.Driver.Backpack (doBackpack) where

    #include "HsVersions.h"

    import GHC.Prelude

    -- In a separate module because it hooks into the parser.
    import GHC.Driver.Backpack.Syntax
    import GHC.Driver.Config
    import GHC.Driver.Monad
    import GHC.Driver.Session
    import GHC.Driver.Ppr
    import GHC.Driver.Main
    import GHC.Driver.Make
    import GHC.Driver.Env
    import GHC.Driver.Errors

    import GHC.Parser
    import GHC.Parser.Header
    import GHC.Parser.Lexer
    import GHC.Parser.Annotation
    import GHC.Parser.Errors.Ppr

    import GHC hiding (Failed, Succeeded)
    import GHC.Tc.Utils.Monad
    import GHC.Iface.Recomp
    import GHC.Builtin.Names

    import GHC.Types.SrcLoc
    import GHC.Types.SourceError
    import GHC.Types.SourceText
    import GHC.Types.SourceFile
    import GHC.Types.Unique.FM
    import GHC.Types.Unique.DFM
    import GHC.Types.Unique.DSet

    import GHC.Utils.Outputable
    import GHC.Utils.Misc
    import GHC.Utils.Panic
    import GHC.Utils.Error
    import GHC.Utils.Logger

    import GHC.Unit
    import GHC.Unit.Env
    import GHC.Unit.External
    import GHC.Unit.State
    import GHC.Unit.Finder
    import GHC.Unit.Module.Graph
    import GHC.Unit.Module.ModSummary
    import GHC.Unit.Home.ModInfo

    import GHC.Linker.Types

    import qualified GHC.LanguageExtensions as LangExt

    import GHC.Data.Maybe
    import GHC.Data.StringBuffer
    import GHC.Data.FastString
    import qualified GHC.Data.EnumSet as EnumSet
    import qualified GHC.Data.ShortText as ST

    import Data.List ( partition )
    import System.Exit
    import Control.Monad
    import System.FilePath
    import Data.Version

    -- for the unification
    import Data.IORef
    import Data.Map (Map)
    import qualified Data.Map as Map
    import qualified Data.Set as Set

    -- | Entry point to compile a Backpack file.
    doBackpack :: [FilePath] -> Ghc ()
    doBackpack :: [FilePath] -> Ghc ()
    doBackpack [FilePath
    src_filename] = do
        Logger
    logger <- forall (m :: * -> *). HasLogger m => m Logger
    getLogger

        -- Apply options from file to dflags
        DynFlags
    dflags0 <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        let dflags1 :: DynFlags
    dflags1 = DynFlags
    dflags0
        [Located FilePath]
    src_opts <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ DynFlags -> FilePath -> IO [Located FilePath]
    getOptionsFromFile DynFlags
    dflags1 FilePath
    src_filename
        (DynFlags
    dflags, [Located FilePath]
    unhandled_flags, [Warn]
    warns) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ forall (m :: * -> *).
    MonadIO m =>
    DynFlags
    -> [Located FilePath] -> m (DynFlags, [Located FilePath], [Warn])
    parseDynamicFilePragma DynFlags
    dflags1 [Located FilePath]
    src_opts
        forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
    modifySession (\HscEnv
    hsc_env -> HscEnv
    hsc_env {hsc_dflags :: DynFlags
    hsc_dflags = DynFlags
    dflags})
        -- Cribbed from: preprocessFile / GHC.Driver.Pipeline
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ forall (m :: * -> *). MonadIO m => [Located FilePath] -> m ()
    checkProcessArgsResult [Located FilePath]
    unhandled_flags
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ Logger -> DynFlags -> [Warn] -> IO ()
    handleFlagWarnings Logger
    logger DynFlags
    dflags [Warn]
    warns
        -- TODO: Preprocessing not implemented

        StringBuffer
    buf <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ FilePath -> IO StringBuffer
    hGetStringBuffer FilePath
    src_filename
        let loc :: RealSrcLoc
    loc = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc (FilePath -> FastString
    mkFastString FilePath
    src_filename) Int
    1 Int
    1 -- TODO: not great
        case forall a. P a -> PState -> ParseResult a
    unP P [LHsUnit PackageName]
    parseBackpack (ParserOpts -> StringBuffer -> RealSrcLoc -> PState
    initParserState (DynFlags -> ParserOpts
    initParserOpts DynFlags
    dflags) StringBuffer
    buf RealSrcLoc
    loc) of
            PFailed PState
    pst -> forall (io :: * -> *) a. MonadIO io => ErrorMessages -> io a
    throwErrors (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PsError -> MsgEnvelope DecoratedSDoc
    pprError (PState -> Bag PsError
    getErrorMessages PState
    pst))
            POk PState
    _ [LHsUnit PackageName]
    pkgname_bkp -> do
                -- OK, so we have an LHsUnit PackageName, but we want an
                -- LHsUnit HsComponentId.  So let's rename it.
                HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
                let bkp :: [LHsUnit HsComponentId]
    bkp = UnitState
    -> PackageNameMap HsComponentId
    -> [LHsUnit PackageName]
    -> [LHsUnit HsComponentId]
    renameHsUnits (HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env) ([LHsUnit PackageName] -> PackageNameMap HsComponentId
    bkpPackageNameMap [LHsUnit PackageName]
    pkgname_bkp) [LHsUnit PackageName]
    pkgname_bkp
                forall a. FilePath -> [LHsUnit HsComponentId] -> BkpM a -> Ghc a
    initBkpM FilePath
    src_filename [LHsUnit HsComponentId]
    bkp forall a b. (a -> b) -> a -> b
    $
                    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] [LHsUnit HsComponentId]
    bkp) forall a b. (a -> b) -> a -> b
    $ \(Int
    i, LHsUnit HsComponentId
    lunit) -> do
                        let comp_name :: HsComponentId
    comp_name = forall l e. GenLocated l e -> e
    unLoc (forall n. HsUnit n -> Located n
    hsunitName (forall l e. GenLocated l e -> e
    unLoc LHsUnit HsComponentId
    lunit))
                        (Int, Int) -> HsComponentId -> IOEnv BkpEnv ()
    msgTopPackage (Int
    i,forall (t :: * -> *) a. Foldable t => t a -> Int
    length [LHsUnit HsComponentId]
    bkp) HsComponentId
    comp_name
                        forall a. BkpM a -> BkpM a
    innerBkpM forall a b. (a -> b) -> a -> b
    $ do
                            let (IndefUnitId
    cid, [(ModuleName, Module)]
    insts) = LHsUnit HsComponentId -> (IndefUnitId, [(ModuleName, Module)])
    computeUnitId LHsUnit HsComponentId
    lunit
                            if forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(ModuleName, Module)]
    insts
                                then if IndefUnitId
    cid forall a. Eq a => a -> a -> Bool
    == forall unit. unit -> Indefinite unit
    Indefinite (FastString -> UnitId
    UnitId (FilePath -> FastString
    fsLit FilePath
    "main"))
                                        then LHsUnit HsComponentId -> IOEnv BkpEnv ()
    compileExe LHsUnit HsComponentId
    lunit
                                        else IndefUnitId -> [(ModuleName, Module)] -> IOEnv BkpEnv ()
    compileUnit IndefUnitId
    cid []
                                else IndefUnitId -> [(ModuleName, Module)] -> IOEnv BkpEnv ()
    typecheckUnit IndefUnitId
    cid [(ModuleName, Module)]
    insts
    doBackpack [FilePath]
    _ =
        forall a. GhcException -> a
    throwGhcException (FilePath -> GhcException
    CmdLineError FilePath
    "--backpack can only process a single file")

    computeUnitId :: LHsUnit HsComponentId -> (IndefUnitId, [(ModuleName, Module)])
    computeUnitId :: LHsUnit HsComponentId -> (IndefUnitId, [(ModuleName, Module)])
    computeUnitId (L SrcSpan
    _ HsUnit HsComponentId
    unit) = (IndefUnitId
    cid, [ (ModuleName
    r, forall u. ModuleName -> GenModule (GenUnit u)
    mkHoleModule ModuleName
    r) | ModuleName
    r <- [ModuleName]
    reqs ])
      where
        cid :: IndefUnitId
    cid = HsComponentId -> IndefUnitId
    hsComponentId (forall l e. GenLocated l e -> e
    unLoc (forall n. HsUnit n -> Located n
    hsunitName HsUnit HsComponentId
    unit))
        reqs :: [ModuleName]
    reqs = forall a. UniqDSet a -> [a]
    uniqDSetToList (forall a. [UniqDSet a] -> UniqDSet a
    unionManyUniqDSets (forall a b. (a -> b) -> [a] -> [b]
    map (HsUnitDecl HsComponentId -> UniqDSet ModuleName
    get_reqs forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall l e. GenLocated l e -> e
    unLoc) (forall n. HsUnit n -> [LHsUnitDecl n]
    hsunitBody HsUnit HsComponentId
    unit)))
        get_reqs :: HsUnitDecl HsComponentId -> UniqDSet ModuleName
    get_reqs (DeclD HscSource
    HsigFile (L SrcSpan
    _ ModuleName
    modname) Maybe (Located HsModule)
    _) = forall a. Uniquable a => a -> UniqDSet a
    unitUniqDSet ModuleName
    modname
        get_reqs (DeclD HscSource
    HsSrcFile GenLocated SrcSpan ModuleName
    _ Maybe (Located HsModule)
    _) = forall a. UniqDSet a
    emptyUniqDSet
        get_reqs (DeclD HscSource
    HsBootFile GenLocated SrcSpan ModuleName
    _ Maybe (Located HsModule)
    _) = forall a. UniqDSet a
    emptyUniqDSet
        get_reqs (IncludeD (IncludeDecl (L SrcSpan
    _ HsUnitId HsComponentId
    hsuid) Maybe [LRenaming]
    _ Bool
    _)) =
            forall u. GenUnit u -> UniqDSet ModuleName
    unitFreeModuleHoles (HsUnitId HsComponentId -> Unit
    convertHsComponentId HsUnitId HsComponentId
    hsuid)

    -- | Tiny enum for all types of Backpack operations we may do.
    data SessionType
        -- | A compilation operation which will result in a
        -- runnable executable being produced.
        = ExeSession
        -- | A type-checking operation which produces only
        -- interface files, no object files.
        | TcSession
        -- | A compilation operation which produces both
        -- interface files and object files.
        | CompSession
        deriving (SessionType -> SessionType -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: SessionType -> SessionType -> Bool
    $c/= :: SessionType -> SessionType -> Bool
    == :: SessionType -> SessionType -> Bool
    $c== :: SessionType -> SessionType -> Bool
    Eq)

    -- | Create a temporary Session to do some sort of type checking or
    -- compilation.
    withBkpSession :: IndefUnitId
                   -> [(ModuleName, Module)]
                   -> [(Unit, ModRenaming)]
                   -> SessionType   -- what kind of session are we doing
                   -> BkpM a        -- actual action to run
                   -> BkpM a
    withBkpSession :: forall a.
    IndefUnitId
    -> [(ModuleName, Module)]
    -> [(Unit, ModRenaming)]
    -> SessionType
    -> BkpM a
    -> BkpM a
    withBkpSession IndefUnitId
    cid [(ModuleName, Module)]
    insts [(Unit, ModRenaming)]
    deps SessionType
    session_type BkpM a
    do_this = do
        DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        let cid_fs :: FastString
    cid_fs = forall u. IsUnitId u => u -> FastString
    unitFS (forall unit. Indefinite unit -> unit
    indefUnit IndefUnitId
    cid)
            is_primary :: Bool
    is_primary = Bool
    False
            uid_str :: FilePath
    uid_str = FastString -> FilePath
    unpackFS (forall u.
    IsUnitId u =>
    Indefinite u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
    mkInstantiatedUnitHash IndefUnitId
    cid [(ModuleName, Module)]
    insts)
            cid_str :: FilePath
    cid_str = FastString -> FilePath
    unpackFS FastString
    cid_fs
            -- There are multiple units in a single Backpack file, so we
            -- need to separate out the results in those cases.  Right now,
            -- we follow this hierarchy:
            --      $outputdir/$compid          --> typecheck results
            --      $outputdir/$compid/$unitid  --> compile results
            key_base :: (DynFlags -> Maybe FilePath) -> FilePath
    key_base DynFlags -> Maybe FilePath
    p | Just FilePath
    f <- DynFlags -> Maybe FilePath
    p DynFlags
    dflags = FilePath
    f
                       | Bool
    otherwise          = FilePath
    "."
            sub_comp :: FilePath -> FilePath
    sub_comp FilePath
    p | Bool
    is_primary = FilePath
    p
                       | Bool
    otherwise = FilePath
    p FilePath -> FilePath -> FilePath
    </> FilePath
    cid_str
            outdir :: (DynFlags -> Maybe FilePath) -> FilePath
    outdir DynFlags -> Maybe FilePath
    p | SessionType
    CompSession <- SessionType
    session_type
                     -- Special case when package is definite
                     , Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(ModuleName, Module)]
    insts) = FilePath -> FilePath
    sub_comp ((DynFlags -> Maybe FilePath) -> FilePath
    key_base DynFlags -> Maybe FilePath
    p) FilePath -> FilePath -> FilePath
    </> FilePath
    uid_str
                     | Bool
    otherwise = FilePath -> FilePath
    sub_comp ((DynFlags -> Maybe FilePath) -> FilePath
    key_base DynFlags -> Maybe FilePath
    p)

            mk_temp_env :: HscEnv -> HscEnv
    mk_temp_env HscEnv
    hsc_env = HscEnv
    hsc_env
                { hsc_dflags :: DynFlags
    hsc_dflags   = UnitState -> DynFlags -> DynFlags
    mk_temp_dflags (HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env) (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)
                }
            mk_temp_dflags :: UnitState -> DynFlags -> DynFlags
    mk_temp_dflags UnitState
    unit_state DynFlags
    dflags = DynFlags
    dflags
                { backend :: Backend
    backend = case SessionType
    session_type of
                                SessionType
    TcSession -> Backend
    NoBackend
                                SessionType
    _         -> DynFlags -> Backend
    backend DynFlags
    dflags
                , homeUnitInstantiations_ :: [(ModuleName, Module)]
    homeUnitInstantiations_ = [(ModuleName, Module)]
    insts
                                         -- if we don't have any instantiation, don't
                                         -- fill `homeUnitInstanceOfId` as it makes no
                                         -- sense (we're not instantiating anything)
                , homeUnitInstanceOf_ :: Maybe UnitId
    homeUnitInstanceOf_   = if forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(ModuleName, Module)]
    insts then forall a. Maybe a
    Nothing else forall a. a -> Maybe a
    Just (forall unit. Indefinite unit -> unit
    indefUnit IndefUnitId
    cid)
                , homeUnitId_ :: UnitId
    homeUnitId_ = case SessionType
    session_type of
                    SessionType
    TcSession -> IndefUnitId -> Maybe FastString -> UnitId
    newUnitId IndefUnitId
    cid forall a. Maybe a
    Nothing
                    -- No hash passed if no instances
                    SessionType
    _ | forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(ModuleName, Module)]
    insts -> IndefUnitId -> Maybe FastString -> UnitId
    newUnitId IndefUnitId
    cid forall a. Maybe a
    Nothing
                      | Bool
    otherwise  -> IndefUnitId -> Maybe FastString -> UnitId
    newUnitId IndefUnitId
    cid (forall a. a -> Maybe a
    Just (forall u.
    IsUnitId u =>
    Indefinite u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
    mkInstantiatedUnitHash IndefUnitId
    cid [(ModuleName, Module)]
    insts))

                -- If we're type-checking an indefinite package, we want to
                -- turn on interface writing.  However, if the user also
                -- explicitly passed in `-fno-code`, we DON'T want to write
                -- interfaces unless the user also asked for `-fwrite-interface`.
                -- See Note [-fno-code mode]
                , generalFlags :: EnumSet GeneralFlag
    generalFlags = case SessionType
    session_type of
                    -- Make sure to write interfaces when we are type-checking
                    -- indefinite packages.
                    SessionType
    TcSession
                      | DynFlags -> Backend
    backend DynFlags
    dflags forall a. Eq a => a -> a -> Bool
    /= Backend
    NoBackend
                      -> forall a. Enum a => a -> EnumSet a -> EnumSet a
    EnumSet.insert GeneralFlag
    Opt_WriteInterface (DynFlags -> EnumSet GeneralFlag
    generalFlags DynFlags
    dflags)
                    SessionType
    _ -> DynFlags -> EnumSet GeneralFlag
    generalFlags DynFlags
    dflags

                -- Setup all of the output directories according to our hierarchy
                , objectDir :: Maybe FilePath
    objectDir   = forall a. a -> Maybe a
    Just ((DynFlags -> Maybe FilePath) -> FilePath
    outdir DynFlags -> Maybe FilePath
    objectDir)
                , hiDir :: Maybe FilePath
    hiDir       = forall a. a -> Maybe a
    Just ((DynFlags -> Maybe FilePath) -> FilePath
    outdir DynFlags -> Maybe FilePath
    hiDir)
                , stubDir :: Maybe FilePath
    stubDir     = forall a. a -> Maybe a
    Just ((DynFlags -> Maybe FilePath) -> FilePath
    outdir DynFlags -> Maybe FilePath
    stubDir)
                -- Unset output-file for non exe builds
                , outputFile_ :: Maybe FilePath
    outputFile_ = case SessionType
    session_type of
                    SessionType
    ExeSession -> DynFlags -> Maybe FilePath
    outputFile_ DynFlags
    dflags
                    SessionType
    _          -> forall a. Maybe a
    Nothing
                , dynOutputFile_ :: Maybe FilePath
    dynOutputFile_ = case SessionType
    session_type of
                    SessionType
    ExeSession -> DynFlags -> Maybe FilePath
    dynOutputFile_ DynFlags
    dflags
                    SessionType
    _          -> forall a. Maybe a
    Nothing
                -- Clear the import path so we don't accidentally grab anything
                , importPaths :: [FilePath]
    importPaths = []
                -- Synthesize the flags
                , packageFlags :: [PackageFlag]
    packageFlags = DynFlags -> [PackageFlag]
    packageFlags DynFlags
    dflags forall a. [a] -> [a] -> [a]
    ++ forall a b. (a -> b) -> [a] -> [b]
    map (\(Unit
    uid0, ModRenaming
    rn) ->
                  let uid :: Unit
    uid = UnitState -> Unit -> Unit
    unwireUnit UnitState
    unit_state
                            forall a b. (a -> b) -> a -> b
    $ UnitState -> Unit -> Unit
    improveUnit UnitState
    unit_state
                            forall a b. (a -> b) -> a -> b
    $ UnitState -> ShHoleSubst -> Unit -> Unit
    renameHoleUnit UnitState
    unit_state (forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
    listToUFM [(ModuleName, Module)]
    insts) Unit
    uid0
                  in FilePath -> PackageArg -> ModRenaming -> PackageFlag
    ExposePackage
                    (DynFlags -> SDoc -> FilePath
    showSDoc DynFlags
    dflags
                        (FilePath -> SDoc
    text FilePath
    "-unit-id" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr Unit
    uid SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr ModRenaming
    rn))
                    (Unit -> PackageArg
    UnitIdArg Unit
    uid) ModRenaming
    rn) [(Unit, ModRenaming)]
    deps
                }
        forall (m :: * -> *) a.
    GhcMonad m =>
    (HscEnv -> HscEnv) -> m a -> m a
    withTempSession HscEnv -> HscEnv
    mk_temp_env forall a b. (a -> b) -> a -> b
    $ do
          DynFlags
    dflags <- forall (m :: * -> *). GhcMonad m => m DynFlags
    getSessionDynFlags
          -- pprTrace "flags" (ppr insts <> ppr deps) $ return ()
          forall (m :: * -> *). GhcMonad m => DynFlags -> m ()
    setSessionDynFlags DynFlags
    dflags -- calls initUnits
          BkpM a
    do_this

    withBkpExeSession :: [(Unit, ModRenaming)] -> BkpM a -> BkpM a
    withBkpExeSession :: forall a. [(Unit, ModRenaming)] -> BkpM a -> BkpM a
    withBkpExeSession [(Unit, ModRenaming)]
    deps BkpM a
    do_this =
        forall a.
    IndefUnitId
    -> [(ModuleName, Module)]
    -> [(Unit, ModRenaming)]
    -> SessionType
    -> BkpM a
    -> BkpM a
    withBkpSession (forall unit. unit -> Indefinite unit
    Indefinite (FastString -> UnitId
    UnitId (FilePath -> FastString
    fsLit FilePath
    "main"))) [] [(Unit, ModRenaming)]
    deps SessionType
    ExeSession BkpM a
    do_this

    getSource :: IndefUnitId -> BkpM (LHsUnit HsComponentId)
    getSource :: IndefUnitId -> BkpM (LHsUnit HsComponentId)
    getSource IndefUnitId
    cid = do
        BkpEnv
    bkp_env <- BkpM BkpEnv
    getBkpEnv
        case forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup IndefUnitId
    cid (BkpEnv -> Map IndefUnitId (LHsUnit HsComponentId)
    bkp_table BkpEnv
    bkp_env) of
            Maybe (LHsUnit HsComponentId)
    Nothing -> forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "missing needed dependency" (forall a. Outputable a => a -> SDoc
    ppr IndefUnitId
    cid)
            Just LHsUnit HsComponentId
    lunit -> forall (m :: * -> *) a. Monad m => a -> m a
    return LHsUnit HsComponentId
    lunit

    typecheckUnit :: IndefUnitId -> [(ModuleName, Module)] -> BkpM ()
    typecheckUnit :: IndefUnitId -> [(ModuleName, Module)] -> IOEnv BkpEnv ()
    typecheckUnit IndefUnitId
    cid [(ModuleName, Module)]
    insts = do
        LHsUnit HsComponentId
    lunit <- IndefUnitId -> BkpM (LHsUnit HsComponentId)
    getSource IndefUnitId
    cid
        SessionType
    -> IndefUnitId
    -> [(ModuleName, Module)]
    -> LHsUnit HsComponentId
    -> IOEnv BkpEnv ()
    buildUnit SessionType
    TcSession IndefUnitId
    cid [(ModuleName, Module)]
    insts LHsUnit HsComponentId
    lunit

    compileUnit :: IndefUnitId -> [(ModuleName, Module)] -> BkpM ()
    compileUnit :: IndefUnitId -> [(ModuleName, Module)] -> IOEnv BkpEnv ()
    compileUnit IndefUnitId
    cid [(ModuleName, Module)]
    insts = do
        -- Let everyone know we're building this unit
        Unit -> IOEnv BkpEnv ()
    msgUnitId (forall u.
    IsUnitId u =>
    Indefinite u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
    mkVirtUnit IndefUnitId
    cid [(ModuleName, Module)]
    insts)
        LHsUnit HsComponentId
    lunit <- IndefUnitId -> BkpM (LHsUnit HsComponentId)
    getSource IndefUnitId
    cid
        SessionType
    -> IndefUnitId
    -> [(ModuleName, Module)]
    -> LHsUnit HsComponentId
    -> IOEnv BkpEnv ()
    buildUnit SessionType
    CompSession IndefUnitId
    cid [(ModuleName, Module)]
    insts LHsUnit HsComponentId
    lunit

    -- | Compute the dependencies with instantiations of a syntactic
    -- HsUnit; e.g., wherever you see @dependency p[A=<A>]@ in a
    -- unit file, return the 'Unit' corresponding to @p[A=<A>]@.
    -- The @include_sigs@ parameter controls whether or not we also
    -- include @dependency signature@ declarations in this calculation.
    --
    -- Invariant: this NEVER returns UnitId.
    hsunitDeps :: Bool {- include sigs -} -> HsUnit HsComponentId -> [(Unit, ModRenaming)]
    hsunitDeps :: Bool -> HsUnit HsComponentId -> [(Unit, ModRenaming)]
    hsunitDeps Bool
    include_sigs HsUnit HsComponentId
    unit = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap GenLocated SrcSpan (HsUnitDecl HsComponentId)
    -> [(Unit, ModRenaming)]
    get_dep (forall n. HsUnit n -> [LHsUnitDecl n]
    hsunitBody HsUnit HsComponentId
    unit)
      where
        get_dep :: GenLocated SrcSpan (HsUnitDecl HsComponentId)
    -> [(Unit, ModRenaming)]
    get_dep (L SrcSpan
    _ (IncludeD (IncludeDecl (L SrcSpan
    _ HsUnitId HsComponentId
    hsuid) Maybe [LRenaming]
    mb_lrn Bool
    is_sig)))
            | Bool
    include_sigs Bool -> Bool -> Bool
    || Bool -> Bool
    not Bool
    is_sig = [(HsUnitId HsComponentId -> Unit
    convertHsComponentId HsUnitId HsComponentId
    hsuid, forall {l}. Maybe [GenLocated l Renaming] -> ModRenaming
    go Maybe [LRenaming]
    mb_lrn)]
            | Bool
    otherwise = []
          where
            go :: Maybe [GenLocated l Renaming] -> ModRenaming
    go Maybe [GenLocated l Renaming]
    Nothing = Bool -> [(ModuleName, ModuleName)] -> ModRenaming
    ModRenaming Bool
    True []
            go (Just [GenLocated l Renaming]
    lrns) = Bool -> [(ModuleName, ModuleName)] -> ModRenaming
    ModRenaming Bool
    False (forall a b. (a -> b) -> [a] -> [b]
    map forall {l}. GenLocated l Renaming -> (ModuleName, ModuleName)
    convRn [GenLocated l Renaming]
    lrns)
              where
                convRn :: GenLocated l Renaming -> (ModuleName, ModuleName)
    convRn (L l
    _ (Renaming (L SrcSpan
    _ ModuleName
    from) Maybe (GenLocated SrcSpan ModuleName)
    Nothing))         = (ModuleName
    from, ModuleName
    from)
                convRn (L l
    _ (Renaming (L SrcSpan
    _ ModuleName
    from) (Just (L SrcSpan
    _ ModuleName
    to)))) = (ModuleName
    from, ModuleName
    to)
        get_dep GenLocated SrcSpan (HsUnitDecl HsComponentId)
    _ = []

    buildUnit :: SessionType -> IndefUnitId -> [(ModuleName, Module)] -> LHsUnit HsComponentId -> BkpM ()
    buildUnit :: SessionType
    -> IndefUnitId
    -> [(ModuleName, Module)]
    -> LHsUnit HsComponentId
    -> IOEnv BkpEnv ()
    buildUnit SessionType
    session IndefUnitId
    cid [(ModuleName, Module)]
    insts LHsUnit HsComponentId
    lunit = do
        -- NB: include signature dependencies ONLY when typechecking.
        -- If we're compiling, it's not necessary to recursively
        -- compile a signature since it isn't going to produce
        -- any object files.
        let deps_w_rns :: [(Unit, ModRenaming)]
    deps_w_rns = Bool -> HsUnit HsComponentId -> [(Unit, ModRenaming)]
    hsunitDeps (SessionType
    session forall a. Eq a => a -> a -> Bool
    == SessionType
    TcSession) (forall l e. GenLocated l e -> e
    unLoc LHsUnit HsComponentId
    lunit)
            raw_deps :: [Unit]
    raw_deps = forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> a
    fst [(Unit, ModRenaming)]
    deps_w_rns
        HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        -- The compilation dependencies are just the appropriately filled
        -- in unit IDs which must be compiled before we can compile.
        let hsubst :: ShHoleSubst
    hsubst = forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
    listToUFM [(ModuleName, Module)]
    insts
            deps0 :: [Unit]
    deps0 = forall a b. (a -> b) -> [a] -> [b]
    map (UnitState -> ShHoleSubst -> Unit -> Unit
    renameHoleUnit (HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env) ShHoleSubst
    hsubst) [Unit]
    raw_deps

        -- Build dependencies OR make sure they make sense. BUT NOTE,
        -- we can only check the ones that are fully filled; the rest
        -- we have to defer until we've typechecked our local signature.
        -- TODO: work this into GHC.Driver.Make!!
        forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] [Unit]
    deps0) forall a b. (a -> b) -> a -> b
    $ \(Int
    i, Unit
    dep) ->
            case SessionType
    session of
                SessionType
    TcSession -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                SessionType
    _ -> Int -> (Int, Unit) -> IOEnv BkpEnv ()
    compileInclude (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Unit]
    deps0) (Int
    i, Unit
    dep)

        -- IMPROVE IT
        let deps :: [Unit]
    deps = forall a b. (a -> b) -> [a] -> [b]
    map (UnitState -> Unit -> Unit
    improveUnit (HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env)) [Unit]
    deps0

        Maybe ExternalPackageState
    mb_old_eps <- case SessionType
    session of
                        SessionType
    TcSession -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap forall a. a -> Maybe a
    Just forall (m :: * -> *). GhcMonad m => m ExternalPackageState
    getEpsGhc
                        SessionType
    _ -> forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing

        GenericUnitInfo
      IndefUnitId PackageId PackageName UnitId ModuleName Module
    conf <- forall a.
    IndefUnitId
    -> [(ModuleName, Module)]
    -> [(Unit, ModRenaming)]
    -> SessionType
    -> BkpM a
    -> BkpM a
    withBkpSession IndefUnitId
    cid [(ModuleName, Module)]
    insts [(Unit, ModRenaming)]
    deps_w_rns SessionType
    session forall a b. (a -> b) -> a -> b
    $ do

            DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            ModuleGraph
    mod_graph <- HsUnit HsComponentId -> BkpM ModuleGraph
    hsunitModuleGraph (forall l e. GenLocated l e -> e
    unLoc LHsUnit HsComponentId
    lunit)

            Messager
    msg <- BkpM Messager
    mkBackpackMsg
            SuccessFlag
    ok <- forall (m :: * -> *).
    GhcMonad m =>
    LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag
    load' LoadHowMuch
    LoadAllTargets (forall a. a -> Maybe a
    Just Messager
    msg) ModuleGraph
    mod_graph
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SuccessFlag -> Bool
    failed SuccessFlag
    ok) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure Int
    1))

            let hi_dir :: FilePath
    hi_dir = forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust (forall a. FilePath -> a
    panic FilePath
    "hiDir Backpack") forall a b. (a -> b) -> a -> b
    $ DynFlags -> Maybe FilePath
    hiDir DynFlags
    dflags
                export_mod :: ModSummary -> (ModuleName, Module)
    export_mod ModSummary
    ms = (ModSummary -> ModuleName
    ms_mod_name ModSummary
    ms, ModSummary -> Module
    ms_mod ModSummary
    ms)
                -- Export everything!
                mods :: [(ModuleName, Module)]
    mods = [ ModSummary -> (ModuleName, Module)
    export_mod ModSummary
    ms | ModSummary
    ms <- ModuleGraph -> [ModSummary]
    mgModSummaries ModuleGraph
    mod_graph
                                       , ModSummary -> HscSource
    ms_hsc_src ModSummary
    ms forall a. Eq a => a -> a -> Bool
    == HscSource
    HsSrcFile ]

            -- Compile relevant only
            HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
            let home_mod_infos :: [HomeModInfo]
    home_mod_infos = forall key elt. UniqDFM key elt -> [elt]
    eltsUDFM (HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    hsc_env)
                linkables :: [Linkable]
    linkables = forall a b. (a -> b) -> [a] -> [b]
    map (forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust FilePath
    "bkp link" forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> Maybe Linkable
    hm_linkable)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. (a -> Bool) -> [a] -> [a]
    filter ((forall a. Eq a => a -> a -> Bool
    ==HscSource
    HsSrcFile) forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
    mi_hsc_src forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> ModIface
    hm_iface)
                          forall a b. (a -> b) -> a -> b
    $ [HomeModInfo]
    home_mod_infos
                getOfiles :: Linkable -> [FilePath]
    getOfiles (LM UTCTime
    _ Module
    _ [Unlinked]
    us) = forall a b. (a -> b) -> [a] -> [b]
    map Unlinked -> FilePath
    nameOfObject (forall a. (a -> Bool) -> [a] -> [a]
    filter Unlinked -> Bool
    isObject [Unlinked]
    us)
                obj_files :: [FilePath]
    obj_files = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Linkable -> [FilePath]
    getOfiles [Linkable]
    linkables
                state :: UnitState
    state     = HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env

            let compat_fs :: FastString
    compat_fs = UnitId -> FastString
    unitIdFS (forall unit. Indefinite unit -> unit
    indefUnit IndefUnitId
    cid)
                compat_pn :: PackageName
    compat_pn = FastString -> PackageName
    PackageName FastString
    compat_fs
                unit_id :: UnitId
    unit_id   = forall u. GenHomeUnit u -> UnitId
    homeUnitId (HscEnv -> HomeUnit
    hsc_home_unit HscEnv
    hsc_env)

            forall (m :: * -> *) a. Monad m => a -> m a
    return GenericUnitInfo {
                -- Stub data
                unitAbiHash :: ShortText
    unitAbiHash = ShortText
    "",
                unitPackageId :: PackageId
    unitPackageId = FastString -> PackageId
    PackageId FastString
    compat_fs,
                unitPackageName :: PackageName
    unitPackageName = PackageName
    compat_pn,
                unitPackageVersion :: Version
    unitPackageVersion = [Int] -> Version
    makeVersion [],
                unitId :: UnitId
    unitId = UnitId
    unit_id,
                unitComponentName :: Maybe PackageName
    unitComponentName = forall a. Maybe a
    Nothing,
                unitInstanceOf :: IndefUnitId
    unitInstanceOf = IndefUnitId
    cid,
                unitInstantiations :: [(ModuleName, Module)]
    unitInstantiations = [(ModuleName, Module)]
    insts,
                -- Slight inefficiency here haha
                unitExposedModules :: [(ModuleName, Maybe Module)]
    unitExposedModules = forall a b. (a -> b) -> [a] -> [b]
    map (\(ModuleName
    m,Module
    n) -> (ModuleName
    m,forall a. a -> Maybe a
    Just Module
    n)) [(ModuleName, Module)]
    mods,
                unitHiddenModules :: [ModuleName]
    unitHiddenModules = [], -- TODO: doc only
                unitDepends :: [UnitId]
    unitDepends = case SessionType
    session of
                            -- Technically, we should state that we depend
                            -- on all the indefinite libraries we used to
                            -- typecheck this.  However, this field isn't
                            -- really used for anything, so we leave it
                            -- blank for now.
                            SessionType
    TcSession -> []
                            SessionType
    _ -> forall a b. (a -> b) -> [a] -> [b]
    map (Unit -> UnitId
    toUnitId forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UnitState -> Unit -> Unit
    unwireUnit UnitState
    state)
                                    forall a b. (a -> b) -> a -> b
    $ [Unit]
    deps forall a. [a] -> [a] -> [a]
    ++ [ forall unit. GenModule unit -> unit
    moduleUnit Module
    mod
                                              | (ModuleName
    _, Module
    mod) <- [(ModuleName, Module)]
    insts
                                              , Bool -> Bool
    not (forall u. GenModule (GenUnit u) -> Bool
    isHoleModule Module
    mod) ],
                unitAbiDepends :: [(UnitId, ShortText)]
    unitAbiDepends = [],
                unitLinkerOptions :: [ShortText]
    unitLinkerOptions = case SessionType
    session of
                                     SessionType
    TcSession -> []
                                     SessionType
    _ -> forall a b. (a -> b) -> [a] -> [b]
    map FilePath -> ShortText
    ST.pack forall a b. (a -> b) -> a -> b
    $ [FilePath]
    obj_files,
                unitImportDirs :: [ShortText]
    unitImportDirs = [ FilePath -> ShortText
    ST.pack forall a b. (a -> b) -> a -> b
    $ FilePath
    hi_dir ],
                unitIsExposed :: Bool
    unitIsExposed = Bool
    False,
                unitIsIndefinite :: Bool
    unitIsIndefinite = case SessionType
    session of
                                     SessionType
    TcSession -> Bool
    True
                                     SessionType
    _ -> Bool
    False,
                -- nope
                unitLibraries :: [ShortText]
    unitLibraries = [],
                unitExtDepLibsSys :: [ShortText]
    unitExtDepLibsSys = [],
                unitExtDepLibsGhc :: [ShortText]
    unitExtDepLibsGhc = [],
                unitLibraryDynDirs :: [ShortText]
    unitLibraryDynDirs = [],
                unitLibraryDirs :: [ShortText]
    unitLibraryDirs = [],
                unitExtDepFrameworks :: [ShortText]
    unitExtDepFrameworks = [],
                unitExtDepFrameworkDirs :: [ShortText]
    unitExtDepFrameworkDirs = [],
                unitCcOptions :: [ShortText]
    unitCcOptions = [],
                unitIncludes :: [ShortText]
    unitIncludes = [],
                unitIncludeDirs :: [ShortText]
    unitIncludeDirs = [],
                unitHaddockInterfaces :: [ShortText]
    unitHaddockInterfaces = [],
                unitHaddockHTMLs :: [ShortText]
    unitHaddockHTMLs = [],
                unitIsTrusted :: Bool
    unitIsTrusted = Bool
    False
                }

        forall (m :: * -> *).
    GhcMonad m =>
    GenericUnitInfo
      IndefUnitId PackageId PackageName UnitId ModuleName Module
    -> m ()
    addUnit GenericUnitInfo
      IndefUnitId PackageId PackageName UnitId ModuleName Module
    conf
        case Maybe ExternalPackageState
    mb_old_eps of
            Just ExternalPackageState
    old_eps -> forall (m :: * -> *).
    GhcMonad m =>
    (ExternalPackageState -> ExternalPackageState) -> m ()
    updateEpsGhc_ (forall a b. a -> b -> a
    const ExternalPackageState
    old_eps)
            Maybe ExternalPackageState
    _ -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    compileExe :: LHsUnit HsComponentId -> BkpM ()
    compileExe :: LHsUnit HsComponentId -> IOEnv BkpEnv ()
    compileExe LHsUnit HsComponentId
    lunit = do
        Unit -> IOEnv BkpEnv ()
    msgUnitId Unit
    mainUnit
        let deps_w_rns :: [(Unit, ModRenaming)]
    deps_w_rns = Bool -> HsUnit HsComponentId -> [(Unit, ModRenaming)]
    hsunitDeps Bool
    False (forall l e. GenLocated l e -> e
    unLoc LHsUnit HsComponentId
    lunit)
            deps :: [Unit]
    deps = forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> a
    fst [(Unit, ModRenaming)]
    deps_w_rns
            -- no renaming necessary
        forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ (forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..] [Unit]
    deps) forall a b. (a -> b) -> a -> b
    $ \(Int
    i, Unit
    dep) ->
            Int -> (Int, Unit) -> IOEnv BkpEnv ()
    compileInclude (forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Unit]
    deps) (Int
    i, Unit
    dep)
        forall a. [(Unit, ModRenaming)] -> BkpM a -> BkpM a
    withBkpExeSession [(Unit, ModRenaming)]
    deps_w_rns forall a b. (a -> b) -> a -> b
    $ do
            ModuleGraph
    mod_graph <- HsUnit HsComponentId -> BkpM ModuleGraph
    hsunitModuleGraph (forall l e. GenLocated l e -> e
    unLoc LHsUnit HsComponentId
    lunit)
            Messager
    msg <- BkpM Messager
    mkBackpackMsg
            SuccessFlag
    ok <- forall (m :: * -> *).
    GhcMonad m =>
    LoadHowMuch -> Maybe Messager -> ModuleGraph -> m SuccessFlag
    load' LoadHowMuch
    LoadAllTargets (forall a. a -> Maybe a
    Just Messager
    msg) ModuleGraph
    mod_graph
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (SuccessFlag -> Bool
    failed SuccessFlag
    ok) (forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure Int
    1))

    -- | Register a new virtual unit database containing a single unit
    addUnit :: GhcMonad m => UnitInfo -> m ()
    addUnit :: forall (m :: * -> *).
    GhcMonad m =>
    GenericUnitInfo
      IndefUnitId PackageId PackageName UnitId ModuleName Module
    -> m ()
    addUnit GenericUnitInfo
      IndefUnitId PackageId PackageName UnitId ModuleName Module
    u = do
        HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        Logger
    logger <- forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        let dflags0 :: DynFlags
    dflags0 = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        [UnitDatabase UnitId]
    newdbs <- case HscEnv -> Maybe [UnitDatabase UnitId]
    hsc_unit_dbs HscEnv
    hsc_env of
            Maybe [UnitDatabase UnitId]
    Nothing  -> forall a. FilePath -> a
    panic FilePath
    "addUnit: called too early"
            Just [UnitDatabase UnitId]
    dbs ->
             let newdb :: UnitDatabase UnitId
    newdb = UnitDatabase
                   { unitDatabasePath :: FilePath
    unitDatabasePath  = FilePath
    "(in memory " forall a. [a] -> [a] -> [a]
    ++ DynFlags -> SDoc -> FilePath
    showSDoc DynFlags
    dflags0 (forall a. Outputable a => a -> SDoc
    ppr (forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> uid
    unitId GenericUnitInfo
      IndefUnitId PackageId PackageName UnitId ModuleName Module
    u)) forall a. [a] -> [a] -> [a]
    ++ FilePath
    ")"
                   , unitDatabaseUnits :: [GenericUnitInfo
       IndefUnitId PackageId PackageName UnitId ModuleName Module]
    unitDatabaseUnits = [GenericUnitInfo
      IndefUnitId PackageId PackageName UnitId ModuleName Module
    u]
                   }
             in forall (m :: * -> *) a. Monad m => a -> m a
    return ([UnitDatabase UnitId]
    dbs forall a. [a] -> [a] -> [a]
    ++ [UnitDatabase UnitId
    newdb]) -- added at the end because ordering matters
        ([UnitDatabase UnitId]
    dbs,UnitState
    unit_state,HomeUnit
    home_unit,Maybe PlatformConstants
    mconstants) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ Logger
    -> DynFlags
    -> Maybe [UnitDatabase UnitId]
    -> IO
         ([UnitDatabase UnitId], UnitState, HomeUnit,
          Maybe PlatformConstants)
    initUnits Logger
    logger DynFlags
    dflags0 (forall a. a -> Maybe a
    Just [UnitDatabase UnitId]
    newdbs)

        -- update platform constants
        DynFlags
    dflags <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ DynFlags -> Maybe PlatformConstants -> IO DynFlags
    updatePlatformConstants DynFlags
    dflags0 Maybe PlatformConstants
    mconstants

        let unit_env :: UnitEnv
    unit_env = UnitEnv
              { ue_platform :: Platform
    ue_platform  = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
              , ue_namever :: GhcNameVersion
    ue_namever   = DynFlags -> GhcNameVersion
    ghcNameVersion DynFlags
    dflags
              , ue_home_unit :: HomeUnit
    ue_home_unit = HomeUnit
    home_unit
              , ue_units :: UnitState
    ue_units     = UnitState
    unit_state
              }
        forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
    setSession forall a b. (a -> b) -> a -> b
    $ HscEnv
    hsc_env
            { hsc_unit_dbs :: Maybe [UnitDatabase UnitId]
    hsc_unit_dbs = forall a. a -> Maybe a
    Just [UnitDatabase UnitId]
    dbs
            , hsc_dflags :: DynFlags
    hsc_dflags   = DynFlags
    dflags
            , hsc_unit_env :: UnitEnv
    hsc_unit_env = UnitEnv
    unit_env
            }

    compileInclude :: Int -> (Int, Unit) -> BkpM ()
    compileInclude :: Int -> (Int, Unit) -> IOEnv BkpEnv ()
    compileInclude Int
    n (Int
    i, Unit
    uid) = do
        HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        let pkgs :: UnitState
    pkgs = HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env
        (Int, Int) -> Unit -> IOEnv BkpEnv ()
    msgInclude (Int
    i, Int
    n) Unit
    uid
        -- Check if we've compiled it already
        case Unit
    uid of
          Unit
    HoleUnit   -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          RealUnit Definite UnitId
    _ -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          VirtUnit GenInstantiatedUnit UnitId
    i -> case UnitState
    -> Unit
    -> Maybe
         (GenericUnitInfo
            IndefUnitId PackageId PackageName UnitId ModuleName Module)
    lookupUnit UnitState
    pkgs Unit
    uid of
            Maybe
      (GenericUnitInfo
         IndefUnitId PackageId PackageName UnitId ModuleName Module)
    Nothing -> forall a. BkpM a -> BkpM a
    innerBkpM forall a b. (a -> b) -> a -> b
    $ IndefUnitId -> [(ModuleName, Module)] -> IOEnv BkpEnv ()
    compileUnit (forall unit. GenInstantiatedUnit unit -> Indefinite unit
    instUnitInstanceOf GenInstantiatedUnit UnitId
    i) (forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
    instUnitInsts GenInstantiatedUnit UnitId
    i)
            Just GenericUnitInfo
      IndefUnitId PackageId PackageName UnitId ModuleName Module
    _  -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- ----------------------------------------------------------------------------
    -- Backpack monad

    -- | Backpack monad is a 'GhcMonad' which also maintains a little extra state
    -- beyond the 'Session', c.f. 'BkpEnv'.
    type BkpM = IOEnv BkpEnv

    -- | Backpack environment.  NB: this has a 'Session' and not an 'HscEnv',
    -- because we are going to update the 'HscEnv' as we go.
    data BkpEnv
        = BkpEnv {
            -- | The session
            BkpEnv -> Session
    bkp_session :: Session,
            -- | The filename of the bkp file we're compiling
            BkpEnv -> FilePath
    bkp_filename :: FilePath,
            -- | Table of source units which we know how to compile
            BkpEnv -> Map IndefUnitId (LHsUnit HsComponentId)
    bkp_table :: Map IndefUnitId (LHsUnit HsComponentId),
            -- | When a package we are compiling includes another package
            -- which has not been compiled, we bump the level and compile
            -- that.
            BkpEnv -> Int
    bkp_level :: Int
        }

    -- Blah, to get rid of the default instance for IOEnv
    -- TODO: just make a proper new monad for BkpM, rather than use IOEnv
    instance {-# OVERLAPPING #-} HasDynFlags BkpM where
        getDynFlags :: BkpM DynFlags
    getDynFlags = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HscEnv -> DynFlags
    hsc_dflags forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
    instance {-# OVERLAPPING #-} HasLogger BkpM where
        getLogger :: BkpM Logger
    getLogger = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HscEnv -> Logger
    hsc_logger forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession

    instance GhcMonad BkpM where
        getSession :: BkpM HscEnv
    getSession = do
            Session IORef HscEnv
    s <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BkpEnv -> Session
    bkp_session forall env. IOEnv env env
    getEnv
            forall a env. IORef a -> IOEnv env a
    readMutVar IORef HscEnv
    s
        setSession :: HscEnv -> IOEnv BkpEnv ()
    setSession HscEnv
    hsc_env = do
            Session IORef HscEnv
    s <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap BkpEnv -> Session
    bkp_session forall env. IOEnv env env
    getEnv
            forall a env. IORef a -> a -> IOEnv env ()
    writeMutVar IORef HscEnv
    s HscEnv
    hsc_env

    -- | Get the current 'BkpEnv'.
    getBkpEnv :: BkpM BkpEnv
    getBkpEnv :: BkpM BkpEnv
    getBkpEnv = forall env. IOEnv env env
    getEnv

    -- | Get the nesting level, when recursively compiling modules.
    getBkpLevel :: BkpM Int
    getBkpLevel :: BkpM Int
    getBkpLevel = BkpEnv -> Int
    bkp_level forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` BkpM BkpEnv
    getBkpEnv

    -- | Run a 'BkpM' computation, with the nesting level bumped one.
    innerBkpM :: BkpM a -> BkpM a
    innerBkpM :: forall a. BkpM a -> BkpM a
    innerBkpM BkpM a
    do_this =
        -- NB: withTempSession mutates, so we don't have to worry
        -- about bkp_session being stale.
        forall env env' a. (env -> env') -> IOEnv env' a -> IOEnv env a
    updEnv (\BkpEnv
    env -> BkpEnv
    env { bkp_level :: Int
    bkp_level = BkpEnv -> Int
    bkp_level BkpEnv
    env forall a. Num a => a -> a -> a
    + Int
    1 }) BkpM a
    do_this

    -- | Update the EPS from a 'GhcMonad'. TODO move to appropriate library spot.
    updateEpsGhc_ :: GhcMonad m => (ExternalPackageState -> ExternalPackageState) -> m ()
    updateEpsGhc_ :: forall (m :: * -> *).
    GhcMonad m =>
    (ExternalPackageState -> ExternalPackageState) -> m ()
    updateEpsGhc_ ExternalPackageState -> ExternalPackageState
    f = do
        HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' (HscEnv -> IORef ExternalPackageState
    hsc_EPS HscEnv
    hsc_env) (\ExternalPackageState
    x -> (ExternalPackageState -> ExternalPackageState
    f ExternalPackageState
    x, ()))

    -- | Get the EPS from a 'GhcMonad'.
    getEpsGhc :: GhcMonad m => m ExternalPackageState
    getEpsGhc :: forall (m :: * -> *). GhcMonad m => m ExternalPackageState
    getEpsGhc = do
        HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ forall a. IORef a -> IO a
    readIORef (HscEnv -> IORef ExternalPackageState
    hsc_EPS HscEnv
    hsc_env)

    -- | Run 'BkpM' in 'Ghc'.
    initBkpM :: FilePath -> [LHsUnit HsComponentId] -> BkpM a -> Ghc a
    initBkpM :: forall a. FilePath -> [LHsUnit HsComponentId] -> BkpM a -> Ghc a
    initBkpM FilePath
    file [LHsUnit HsComponentId]
    bkp BkpM a
    m =
      forall a. (Session -> IO a) -> Ghc a
    reifyGhc forall a b. (a -> b) -> a -> b
    $ \Session
    session -> do
        let env :: BkpEnv
    env = BkpEnv {
            bkp_session :: Session
    bkp_session = Session
    session,
            bkp_table :: Map IndefUnitId (LHsUnit HsComponentId)
    bkp_table = forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(HsComponentId -> IndefUnitId
    hsComponentId (forall l e. GenLocated l e -> e
    unLoc (forall n. HsUnit n -> Located n
    hsunitName (forall l e. GenLocated l e -> e
    unLoc LHsUnit HsComponentId
    u))), LHsUnit HsComponentId
    u) | LHsUnit HsComponentId
    u <- [LHsUnit HsComponentId]
    bkp],
            bkp_filename :: FilePath
    bkp_filename = FilePath
    file,
            bkp_level :: Int
    bkp_level = Int
    0
          }
        forall env a. env -> IOEnv env a -> IO a
    runIOEnv BkpEnv
    env BkpM a
    m

    -- ----------------------------------------------------------------------------
    -- Messaging

    -- | Print a compilation progress message, but with indentation according
    -- to @level@ (for nested compilation).
    backpackProgressMsg :: Int -> Logger -> DynFlags -> SDoc -> IO ()
    backpackProgressMsg :: Int -> Logger -> DynFlags -> SDoc -> IO ()
    backpackProgressMsg Int
    level Logger
    logger DynFlags
    dflags SDoc
    msg =
        Logger -> DynFlags -> SDoc -> IO ()
    compilationProgressMsg Logger
    logger DynFlags
    dflags forall a b. (a -> b) -> a -> b
    $ FilePath -> SDoc
    text (forall a. Int -> a -> [a]
    replicate (Int
    level forall a. Num a => a -> a -> a
    * Int
    2) Char
    ' ') -- TODO: use GHC.Utils.Ppr.RStr
                                          SDoc -> SDoc -> SDoc
    <> SDoc
    msg

    -- | Creates a 'Messager' for Backpack compilation; this is basically
    -- a carbon copy of 'batchMsg' but calling 'backpackProgressMsg', which
    -- handles indentation.
    mkBackpackMsg :: BkpM Messager
    mkBackpackMsg :: BkpM Messager
    mkBackpackMsg = do
        Int
    level <- BkpM Int
    getBkpLevel
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ \HscEnv
    hsc_env (Int, Int)
    mod_index RecompileRequired
    recomp ModuleGraphNode
    node ->
          let dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
              logger :: Logger
    logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env
              state :: UnitState
    state = HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env
              showMsg :: SDoc -> SDoc -> IO ()
    showMsg SDoc
    msg SDoc
    reason =
                Int -> Logger -> DynFlags -> SDoc -> IO ()
    backpackProgressMsg Int
    level Logger
    logger DynFlags
    dflags forall a b. (a -> b) -> a -> b
    $ UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    state 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
          in case ModuleGraphNode
    node of
            InstantiationNode GenInstantiatedUnit UnitId
    _ ->
              case RecompileRequired
    recomp of
                RecompileRequired
    MustCompile -> SDoc -> SDoc -> IO ()
    showMsg (FilePath -> SDoc
    text FilePath
    "Instantiating ") SDoc
    empty
                RecompileRequired
    UpToDate
                  | DynFlags -> Int
    verbosity (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) forall a. Ord a => a -> a -> Bool
    >= Int
    2 -> SDoc -> SDoc -> IO ()
    showMsg (FilePath -> SDoc
    text FilePath
    "Skipping  ") SDoc
    empty
                  | Bool
    otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                RecompBecause FilePath
    reason -> SDoc -> SDoc -> IO ()
    showMsg (FilePath -> SDoc
    text FilePath
    "Instantiating ") (FilePath -> SDoc
    text FilePath
    " [" SDoc -> SDoc -> SDoc
    <> FilePath -> SDoc
    text FilePath
    reason SDoc -> SDoc -> SDoc
    <> FilePath -> SDoc
    text FilePath
    "]")
            ModuleNode ExtendedModSummary
    _ ->
              case RecompileRequired
    recomp of
                RecompileRequired
    MustCompile -> SDoc -> SDoc -> IO ()
    showMsg (FilePath -> SDoc
    text FilePath
    "Compiling ") SDoc
    empty
                RecompileRequired
    UpToDate
                  | DynFlags -> Int
    verbosity (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) forall a. Ord a => a -> a -> Bool
    >= Int
    2 -> SDoc -> SDoc -> IO ()
    showMsg (FilePath -> SDoc
    text FilePath
    "Skipping  ") SDoc
    empty
                  | Bool
    otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                RecompBecause FilePath
    reason -> SDoc -> SDoc -> IO ()
    showMsg (FilePath -> SDoc
    text FilePath
    "Compiling ") (FilePath -> SDoc
    text FilePath
    " [" SDoc -> SDoc -> SDoc
    <> FilePath -> SDoc
    text FilePath
    reason SDoc -> SDoc -> SDoc
    <> FilePath -> SDoc
    text FilePath
    "]")

    -- | 'PprStyle' for Backpack messages; here we usually want the module to
    -- be qualified (so we can tell how it was instantiated.) But we try not
    -- to qualify packages so we can use simple names for them.
    backpackStyle :: PprStyle
    backpackStyle :: PprStyle
    backpackStyle =
        PrintUnqualified -> Depth -> PprStyle
    mkUserStyle
            (QueryQualifyName
    -> QueryQualifyModule -> QueryQualifyPackage -> PrintUnqualified
    QueryQualify QueryQualifyName
    neverQualifyNames
                          QueryQualifyModule
    alwaysQualifyModules
                          QueryQualifyPackage
    neverQualifyPackages) Depth
    AllTheWay

    -- | Message when we initially process a Backpack unit.
    msgTopPackage :: (Int,Int) -> HsComponentId -> BkpM ()
    msgTopPackage :: (Int, Int) -> HsComponentId -> IOEnv BkpEnv ()
    msgTopPackage (Int
    i,Int
    n) (HsComponentId (PackageName FastString
    fs_pn) IndefUnitId
    _) = do
        DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        Logger
    logger <- forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        Int
    level <- BkpM Int
    getBkpLevel
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Logger -> DynFlags -> SDoc -> IO ()
    backpackProgressMsg Int
    level Logger
    logger DynFlags
    dflags
            forall a b. (a -> b) -> a -> b
    $ (Int, Int) -> SDoc
    showModuleIndex (Int
    i, Int
    n) SDoc -> SDoc -> SDoc
    <> FilePath -> SDoc
    text FilePath
    "Processing " SDoc -> SDoc -> SDoc
    <> FastString -> SDoc
    ftext FastString
    fs_pn

    -- | Message when we instantiate a Backpack unit.
    msgUnitId :: Unit -> BkpM ()
    msgUnitId :: Unit -> IOEnv BkpEnv ()
    msgUnitId Unit
    pk = do
        DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        Logger
    logger <- forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        Int
    level <- BkpM Int
    getBkpLevel
        let state :: UnitState
    state = HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Logger -> DynFlags -> SDoc -> IO ()
    backpackProgressMsg Int
    level Logger
    logger DynFlags
    dflags
            forall a b. (a -> b) -> a -> b
    $ UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    state
            forall a b. (a -> b) -> a -> b
    $ FilePath -> SDoc
    text FilePath
    "Instantiating "
               SDoc -> SDoc -> SDoc
    <> PprStyle -> SDoc -> SDoc
    withPprStyle PprStyle
    backpackStyle (forall a. Outputable a => a -> SDoc
    ppr Unit
    pk)

    -- | Message when we include a Backpack unit.
    msgInclude :: (Int,Int) -> Unit -> BkpM ()
    msgInclude :: (Int, Int) -> Unit -> IOEnv BkpEnv ()
    msgInclude (Int
    i,Int
    n) Unit
    uid = do
        DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        Logger
    logger <- forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        Int
    level <- BkpM Int
    getBkpLevel
        let state :: UnitState
    state = HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Logger -> DynFlags -> SDoc -> IO ()
    backpackProgressMsg Int
    level Logger
    logger DynFlags
    dflags
            forall a b. (a -> b) -> a -> b
    $ UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    state
            forall a b. (a -> b) -> a -> b
    $ (Int, Int) -> SDoc
    showModuleIndex (Int
    i, Int
    n) SDoc -> SDoc -> SDoc
    <> FilePath -> SDoc
    text FilePath
    "Including "
                SDoc -> SDoc -> SDoc
    <> PprStyle -> SDoc -> SDoc
    withPprStyle PprStyle
    backpackStyle (forall a. Outputable a => a -> SDoc
    ppr Unit
    uid)

    -- ----------------------------------------------------------------------------
    -- Conversion from PackageName to HsComponentId

    type PackageNameMap a = UniqFM PackageName a

    -- For now, something really simple, since we're not actually going
    -- to use this for anything
    unitDefines :: LHsUnit PackageName -> (PackageName, HsComponentId)
    unitDefines :: LHsUnit PackageName -> (PackageName, HsComponentId)
    unitDefines (L SrcSpan
    _ HsUnit{ hsunitName :: forall n. HsUnit n -> Located n
    hsunitName = L SrcSpan
    _ pn :: PackageName
    pn@(PackageName FastString
    fs) })
        = (PackageName
    pn, PackageName -> IndefUnitId -> HsComponentId
    HsComponentId PackageName
    pn (forall unit. unit -> Indefinite unit
    Indefinite (FastString -> UnitId
    UnitId FastString
    fs)))

    bkpPackageNameMap :: [LHsUnit PackageName] -> PackageNameMap HsComponentId
    bkpPackageNameMap :: [LHsUnit PackageName] -> PackageNameMap HsComponentId
    bkpPackageNameMap [LHsUnit PackageName]
    units = forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
    listToUFM (forall a b. (a -> b) -> [a] -> [b]
    map LHsUnit PackageName -> (PackageName, HsComponentId)
    unitDefines [LHsUnit PackageName]
    units)

    renameHsUnits :: UnitState -> PackageNameMap HsComponentId -> [LHsUnit PackageName] -> [LHsUnit HsComponentId]
    renameHsUnits :: UnitState
    -> PackageNameMap HsComponentId
    -> [LHsUnit PackageName]
    -> [LHsUnit HsComponentId]
    renameHsUnits UnitState
    pkgstate PackageNameMap HsComponentId
    m [LHsUnit PackageName]
    units = forall a b. (a -> b) -> [a] -> [b]
    map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HsUnit PackageName -> HsUnit HsComponentId
    renameHsUnit) [LHsUnit PackageName]
    units
      where

        renamePackageName :: PackageName -> HsComponentId
        renamePackageName :: PackageName -> HsComponentId
    renamePackageName PackageName
    pn =
            case forall key elt. Uniquable key => UniqFM key elt -> key -> Maybe elt
    lookupUFM PackageNameMap HsComponentId
    m PackageName
    pn of
                Maybe HsComponentId
    Nothing ->
                    case UnitState -> PackageName -> Maybe IndefUnitId
    lookupPackageName UnitState
    pkgstate PackageName
    pn of
                        Maybe IndefUnitId
    Nothing -> forall a. HasCallStack => FilePath -> a
    error FilePath
    "no package name"
                        Just IndefUnitId
    cid -> PackageName -> IndefUnitId -> HsComponentId
    HsComponentId PackageName
    pn IndefUnitId
    cid
                Just HsComponentId
    hscid -> HsComponentId
    hscid

        renameHsUnit :: HsUnit PackageName -> HsUnit HsComponentId
        renameHsUnit :: HsUnit PackageName -> HsUnit HsComponentId
    renameHsUnit HsUnit PackageName
    u =
            HsUnit {
                hsunitName :: Located HsComponentId
    hsunitName = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PackageName -> HsComponentId
    renamePackageName (forall n. HsUnit n -> Located n
    hsunitName HsUnit PackageName
    u),
                hsunitBody :: [GenLocated SrcSpan (HsUnitDecl HsComponentId)]
    hsunitBody = forall a b. (a -> b) -> [a] -> [b]
    map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HsUnitDecl PackageName -> HsUnitDecl HsComponentId
    renameHsUnitDecl) (forall n. HsUnit n -> [LHsUnitDecl n]
    hsunitBody HsUnit PackageName
    u)
            }

        renameHsUnitDecl :: HsUnitDecl PackageName -> HsUnitDecl HsComponentId
        renameHsUnitDecl :: HsUnitDecl PackageName -> HsUnitDecl HsComponentId
    renameHsUnitDecl (DeclD HscSource
    a GenLocated SrcSpan ModuleName
    b Maybe (Located HsModule)
    c) = forall n.
    HscSource
    -> GenLocated SrcSpan ModuleName
    -> Maybe (Located HsModule)
    -> HsUnitDecl n
    DeclD HscSource
    a GenLocated SrcSpan ModuleName
    b Maybe (Located HsModule)
    c
        renameHsUnitDecl (IncludeD IncludeDecl PackageName
    idecl) =
            forall n. IncludeDecl n -> HsUnitDecl n
    IncludeD IncludeDecl {
                idUnitId :: GenLocated SrcSpan (HsUnitId HsComponentId)
    idUnitId = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HsUnitId PackageName -> HsUnitId HsComponentId
    renameHsUnitId (forall n. IncludeDecl n -> LHsUnitId n
    idUnitId IncludeDecl PackageName
    idecl),
                idModRenaming :: Maybe [LRenaming]
    idModRenaming = forall n. IncludeDecl n -> Maybe [LRenaming]
    idModRenaming IncludeDecl PackageName
    idecl,
                idSignatureInclude :: Bool
    idSignatureInclude = forall n. IncludeDecl n -> Bool
    idSignatureInclude IncludeDecl PackageName
    idecl
            }

        renameHsUnitId :: HsUnitId PackageName -> HsUnitId HsComponentId
        renameHsUnitId :: HsUnitId PackageName -> HsUnitId HsComponentId
    renameHsUnitId (HsUnitId GenLocated SrcSpan PackageName
    ln [LHsModuleSubst PackageName]
    subst)
            = forall n. Located n -> [LHsModuleSubst n] -> HsUnitId n
    HsUnitId (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PackageName -> HsComponentId
    renamePackageName GenLocated SrcSpan PackageName
    ln) (forall a b. (a -> b) -> [a] -> [b]
    map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HsModuleSubst PackageName -> HsModuleSubst HsComponentId
    renameHsModuleSubst) [LHsModuleSubst PackageName]
    subst)

        renameHsModuleSubst :: HsModuleSubst PackageName -> HsModuleSubst HsComponentId
        renameHsModuleSubst :: HsModuleSubst PackageName -> HsModuleSubst HsComponentId
    renameHsModuleSubst (GenLocated SrcSpan ModuleName
    lk, LHsModuleId PackageName
    lm)
            = (GenLocated SrcSpan ModuleName
    lk, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HsModuleId PackageName -> HsModuleId HsComponentId
    renameHsModuleId LHsModuleId PackageName
    lm)

        renameHsModuleId :: HsModuleId PackageName -> HsModuleId HsComponentId
        renameHsModuleId :: HsModuleId PackageName -> HsModuleId HsComponentId
    renameHsModuleId (HsModuleVar GenLocated SrcSpan ModuleName
    lm) = forall n. GenLocated SrcSpan ModuleName -> HsModuleId n
    HsModuleVar GenLocated SrcSpan ModuleName
    lm
        renameHsModuleId (HsModuleId LHsUnitId PackageName
    luid GenLocated SrcSpan ModuleName
    lm) = forall n.
    LHsUnitId n -> GenLocated SrcSpan ModuleName -> HsModuleId n
    HsModuleId (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HsUnitId PackageName -> HsUnitId HsComponentId
    renameHsUnitId LHsUnitId PackageName
    luid) GenLocated SrcSpan ModuleName
    lm

    convertHsComponentId :: HsUnitId HsComponentId -> Unit
    convertHsComponentId :: HsUnitId HsComponentId -> Unit
    convertHsComponentId (HsUnitId (L SrcSpan
    _ HsComponentId
    hscid) [LHsModuleSubst HsComponentId]
    subst)
        = forall u.
    IsUnitId u =>
    Indefinite u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
    mkVirtUnit (HsComponentId -> IndefUnitId
    hsComponentId HsComponentId
    hscid) (forall a b. (a -> b) -> [a] -> [b]
    map (HsModuleSubst HsComponentId -> (ModuleName, Module)
    convertHsModuleSubst forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall l e. GenLocated l e -> e
    unLoc) [LHsModuleSubst HsComponentId]
    subst)

    convertHsModuleSubst :: HsModuleSubst HsComponentId -> (ModuleName, Module)
    convertHsModuleSubst :: HsModuleSubst HsComponentId -> (ModuleName, Module)
    convertHsModuleSubst (L SrcSpan
    _ ModuleName
    modname, L SrcSpan
    _ HsModuleId HsComponentId
    m) = (ModuleName
    modname, HsModuleId HsComponentId -> Module
    convertHsModuleId HsModuleId HsComponentId
    m)

    convertHsModuleId :: HsModuleId HsComponentId -> Module
    convertHsModuleId :: HsModuleId HsComponentId -> Module
    convertHsModuleId (HsModuleVar (L SrcSpan
    _ ModuleName
    modname)) = forall u. ModuleName -> GenModule (GenUnit u)
    mkHoleModule ModuleName
    modname
    convertHsModuleId (HsModuleId (L SrcSpan
    _ HsUnitId HsComponentId
    hsuid) (L SrcSpan
    _ ModuleName
    modname)) = forall u. u -> ModuleName -> GenModule u
    mkModule (HsUnitId HsComponentId -> Unit
    convertHsComponentId HsUnitId HsComponentId
    hsuid) ModuleName
    modname

    {-
    ************************************************************************
    *                                                                      *
                            Module graph construction
    *                                                                      *
    ************************************************************************
    -}

    -- | This is our version of GHC.Driver.Make.downsweep, but with a few modifications:
    --
    --  1. Every module is required to be mentioned, so we don't do any funny
    --     business with targets or recursively grabbing dependencies.  (We
    --     could support this in principle).
    --  2. We support inline modules, whose summary we have to synthesize ourself.
    --
    -- We don't bother trying to support GHC.Driver.Make for now, it's more trouble
    -- than it's worth for inline modules.
    hsunitModuleGraph :: HsUnit HsComponentId -> BkpM ModuleGraph
    hsunitModuleGraph :: HsUnit HsComponentId -> BkpM ModuleGraph
    hsunitModuleGraph HsUnit HsComponentId
    unit = do
        HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession

        let decls :: [GenLocated SrcSpan (HsUnitDecl HsComponentId)]
    decls = forall n. HsUnit n -> [LHsUnitDecl n]
    hsunitBody HsUnit HsComponentId
    unit
            pn :: PackageName
    pn = HsComponentId -> PackageName
    hsPackageName (forall l e. GenLocated l e -> e
    unLoc (forall n. HsUnit n -> Located n
    hsunitName HsUnit HsComponentId
    unit))
            home_unit :: HomeUnit
    home_unit = HscEnv -> HomeUnit
    hsc_home_unit HscEnv
    hsc_env

        --  1. Create a HsSrcFile/HsigFile summary for every
        --  explicitly mentioned module/signature.
        let get_decl :: GenLocated SrcSpan (HsUnitDecl HsComponentId)
    -> IOEnv BkpEnv (Maybe ExtendedModSummary)
    get_decl (L SrcSpan
    _ (DeclD HscSource
    hsc_src GenLocated SrcSpan ModuleName
    lmodname Maybe (Located HsModule)
    mb_hsmod)) =
              forall a. a -> Maybe a
    Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` PackageName
    -> HscSource
    -> GenLocated SrcSpan ModuleName
    -> Maybe (Located HsModule)
    -> BkpM ExtendedModSummary
    summariseDecl PackageName
    pn HscSource
    hsc_src GenLocated SrcSpan ModuleName
    lmodname Maybe (Located HsModule)
    mb_hsmod
            get_decl GenLocated SrcSpan (HsUnitDecl HsComponentId)
    _ = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing
        [ExtendedModSummary]
    nodes <- forall a. [Maybe a] -> [a]
    catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM GenLocated SrcSpan (HsUnitDecl HsComponentId)
    -> IOEnv BkpEnv (Maybe ExtendedModSummary)
    get_decl [GenLocated SrcSpan (HsUnitDecl HsComponentId)]
    decls

        --  2. For each hole which does not already have an hsig file,
        --  create an "empty" hsig file to induce compilation for the
        --  requirement.
        let hsig_set :: Set ModuleName
    hsig_set = forall a. Ord a => [a] -> Set a
    Set.fromList
              [ ModSummary -> ModuleName
    ms_mod_name ModSummary
    ms
              | ExtendedModSummary { emsModSummary :: ExtendedModSummary -> ModSummary
    emsModSummary = ModSummary
    ms } <- [ExtendedModSummary]
    nodes
              , ModSummary -> HscSource
    ms_hsc_src ModSummary
    ms forall a. Eq a => a -> a -> Bool
    == HscSource
    HsigFile
              ]
        [ExtendedModSummary]
    req_nodes <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap forall a. [Maybe a] -> [a]
    catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM (forall u. GenHomeUnit u -> GenInstantiations u
    homeUnitInstantiations HomeUnit
    home_unit) forall a b. (a -> b) -> a -> b
    $ \(ModuleName
    mod_name, Module
    _) ->
            if forall a. Ord a => a -> Set a -> Bool
    Set.member ModuleName
    mod_name Set ModuleName
    hsig_set
                then forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing
                else forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (forall a. a -> Maybe a
    Just forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModSummary -> ExtendedModSummary
    extendModSummaryNoDeps) forall a b. (a -> b) -> a -> b
    $ PackageName -> ModuleName -> BkpM ModSummary
    summariseRequirement PackageName
    pn ModuleName
    mod_name
                -- Using extendModSummaryNoDeps here is okay because we're making a leaf node
                -- representing a signature that can't depend on any other unit.

        -- 3. Return the kaboodle
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ [ModuleGraphNode] -> ModuleGraph
    mkModuleGraph' forall a b. (a -> b) -> a -> b
    $
          (ExtendedModSummary -> ModuleGraphNode
    ModuleNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ([ExtendedModSummary]
    nodes forall a. [a] -> [a] -> [a]
    ++ [ExtendedModSummary]
    req_nodes)) forall a. [a] -> [a] -> [a]
    ++ UnitState -> [ModuleGraphNode]
    instantiationNodes (HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env)

    summariseRequirement :: PackageName -> ModuleName -> BkpM ModSummary
    summariseRequirement :: PackageName -> ModuleName -> BkpM ModSummary
    summariseRequirement PackageName
    pn ModuleName
    mod_name = do
        HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        let dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env

        let PackageName FastString
    pn_fs = PackageName
    pn
        ModLocation
    location <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ DynFlags -> ModuleName -> FilePath -> FilePath -> IO ModLocation
    mkHomeModLocation2 DynFlags
    dflags ModuleName
    mod_name
                     (FastString -> FilePath
    unpackFS FastString
    pn_fs FilePath -> FilePath -> FilePath
    </> ModuleName -> FilePath
    moduleNameSlashes ModuleName
    mod_name) FilePath
    "hsig"

        BkpEnv
    env <- BkpM BkpEnv
    getBkpEnv
        UTCTime
    time <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ FilePath -> IO UTCTime
    getModificationUTCTime (BkpEnv -> FilePath
    bkp_filename BkpEnv
    env)
        Maybe UTCTime
    hi_timestamp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ FilePath -> IO (Maybe UTCTime)
    modificationTimeIfExists (ModLocation -> FilePath
    ml_hi_file ModLocation
    location)
        Maybe UTCTime
    hie_timestamp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ FilePath -> IO (Maybe UTCTime)
    modificationTimeIfExists (ModLocation -> FilePath
    ml_hie_file ModLocation
    location)
        let loc :: SrcSpan
    loc = SrcLoc -> SrcSpan
    srcLocSpan (FastString -> Int -> Int -> SrcLoc
    mkSrcLoc (FilePath -> FastString
    mkFastString (BkpEnv -> FilePath
    bkp_filename BkpEnv
    env)) Int
    1 Int
    1)

        Module
    mod <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ HscEnv -> ModuleName -> ModLocation -> IO Module
    addHomeModuleToFinder HscEnv
    hsc_env ModuleName
    mod_name ModLocation
    location

        [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    extra_sig_imports <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> HscSource
    -> ModuleName
    -> IO [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    findExtraSigImports HscEnv
    hsc_env HscSource
    HsigFile ModuleName
    mod_name

        forall (m :: * -> *) a. Monad m => a -> m a
    return ModSummary {
            ms_mod :: Module
    ms_mod = Module
    mod,
            ms_hsc_src :: HscSource
    ms_hsc_src = HscSource
    HsigFile,
            ms_location :: ModLocation
    ms_location = ModLocation
    location,
            ms_hs_date :: UTCTime
    ms_hs_date = UTCTime
    time,
            ms_obj_date :: Maybe UTCTime
    ms_obj_date = forall a. Maybe a
    Nothing,
            ms_iface_date :: Maybe UTCTime
    ms_iface_date = Maybe UTCTime
    hi_timestamp,
            ms_hie_date :: Maybe UTCTime
    ms_hie_date = Maybe UTCTime
    hie_timestamp,
            ms_srcimps :: [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    ms_srcimps = [],
            ms_textual_imps :: [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    ms_textual_imps = [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    extra_sig_imports,
            ms_parsed_mod :: Maybe HsParsedModule
    ms_parsed_mod = forall a. a -> Maybe a
    Just (HsParsedModule {
                    hpm_module :: Located HsModule
    hpm_module = forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (HsModule {
                            hsmodAnn :: EpAnn AnnsModule
    hsmodAnn = forall a. EpAnn a
    noAnn,
                            hsmodLayout :: LayoutInfo
    hsmodLayout = LayoutInfo
    NoLayoutInfo,
                            hsmodName :: Maybe (GenLocated (SrcAnn AnnListItem) ModuleName)
    hsmodName = forall a. a -> Maybe a
    Just (forall l e. l -> e -> GenLocated l e
    L (forall ann. SrcSpan -> SrcAnn ann
    noAnnSrcSpan SrcSpan
    loc) ModuleName
    mod_name),
                            hsmodExports :: Maybe (LocatedL [LIE GhcPs])
    hsmodExports = forall a. Maybe a
    Nothing,
                            hsmodImports :: [LImportDecl GhcPs]
    hsmodImports = [],
                            hsmodDecls :: [LHsDecl GhcPs]
    hsmodDecls = [],
                            hsmodDeprecMessage :: Maybe (LocatedP WarningTxt)
    hsmodDeprecMessage = forall a. Maybe a
    Nothing,
                            hsmodHaddockModHeader :: Maybe LHsDocString
    hsmodHaddockModHeader = forall a. Maybe a
    Nothing
                        }),
                    hpm_src_files :: [FilePath]
    hpm_src_files = []
                }),
            ms_hspp_file :: FilePath
    ms_hspp_file = FilePath
    "", -- none, it came inline
            ms_hspp_opts :: DynFlags
    ms_hspp_opts = DynFlags
    dflags,
            ms_hspp_buf :: Maybe StringBuffer
    ms_hspp_buf = forall a. Maybe a
    Nothing
            }

    summariseDecl :: PackageName
                  -> HscSource
                  -> Located ModuleName
                  -> Maybe (Located HsModule)
                  -> BkpM ExtendedModSummary
    summariseDecl :: PackageName
    -> HscSource
    -> GenLocated SrcSpan ModuleName
    -> Maybe (Located HsModule)
    -> BkpM ExtendedModSummary
    summariseDecl PackageName
    pn HscSource
    hsc_src (L SrcSpan
    _ ModuleName
    modname) (Just Located HsModule
    hsmod) = PackageName
    -> HscSource
    -> ModuleName
    -> Located HsModule
    -> BkpM ExtendedModSummary
    hsModuleToModSummary PackageName
    pn HscSource
    hsc_src ModuleName
    modname Located HsModule
    hsmod
    summariseDecl PackageName
    _pn HscSource
    hsc_src lmodname :: GenLocated SrcSpan ModuleName
    lmodname@(L SrcSpan
    loc ModuleName
    modname) Maybe (Located HsModule)
    Nothing
        = do HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
             -- TODO: this looks for modules in the wrong place
             Maybe (Either ErrorMessages ExtendedModSummary)
    r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> ModNodeMap ExtendedModSummary
    -> IsBootInterface
    -> GenLocated SrcSpan ModuleName
    -> Bool
    -> Maybe (StringBuffer, UTCTime)
    -> [ModuleName]
    -> IO (Maybe (Either ErrorMessages ExtendedModSummary))
    summariseModule HscEnv
    hsc_env
                             forall a. ModNodeMap a
    emptyModNodeMap -- GHC API recomp not supported
                             (HscSource -> IsBootInterface
    hscSourceToIsBoot HscSource
    hsc_src)
                             GenLocated SrcSpan ModuleName
    lmodname
                             Bool
    True -- Target lets you disallow, but not here
                             forall a. Maybe a
    Nothing -- GHC API buffer support not supported
                             [] -- No exclusions
             case Maybe (Either ErrorMessages ExtendedModSummary)
    r of
                Maybe (Either ErrorMessages ExtendedModSummary)
    Nothing -> forall (io :: * -> *) a.
    MonadIO io =>
    MsgEnvelope DecoratedSDoc -> io a
    throwOneError (SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
    mkPlainMsgEnvelope SrcSpan
    loc (FilePath -> SDoc
    text FilePath
    "module" SDoc -> SDoc -> SDoc
    <+> forall a. Outputable a => a -> SDoc
    ppr ModuleName
    modname SDoc -> SDoc -> SDoc
    <+> FilePath -> SDoc
    text FilePath
    "was not found"))
                Just (Left ErrorMessages
    err) -> forall (io :: * -> *) a. MonadIO io => ErrorMessages -> io a
    throwErrors ErrorMessages
    err
                Just (Right ExtendedModSummary
    summary) -> forall (m :: * -> *) a. Monad m => a -> m a
    return ExtendedModSummary
    summary

    -- | Up until now, GHC has assumed a single compilation target per source file.
    -- Backpack files with inline modules break this model, since a single file
    -- may generate multiple output files.  How do we decide to name these files?
    -- Should there only be one output file? This function our current heuristic,
    -- which is we make a "fake" module and use that.
    hsModuleToModSummary :: PackageName
                         -> HscSource
                         -> ModuleName
                         -> Located HsModule
                         -> BkpM ExtendedModSummary
    hsModuleToModSummary :: PackageName
    -> HscSource
    -> ModuleName
    -> Located HsModule
    -> BkpM ExtendedModSummary
    hsModuleToModSummary PackageName
    pn HscSource
    hsc_src ModuleName
    modname
                         Located HsModule
    hsmod = do
        let imps :: [LImportDecl GhcPs]
    imps = HsModule -> [LImportDecl GhcPs]
    hsmodImports (forall l e. GenLocated l e -> e
    unLoc Located HsModule
    hsmod)
            loc :: SrcSpan
    loc  = forall l e. GenLocated l e -> l
    getLoc Located HsModule
    hsmod
        HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        -- Sort of the same deal as in GHC.Driver.Pipeline's getLocation
        -- Use the PACKAGE NAME to find the location
        let PackageName FastString
    unit_fs = PackageName
    pn
            dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        -- Unfortunately, we have to define a "fake" location in
        -- order to appease the various code which uses the file
        -- name to figure out where to put, e.g. object files.
        -- To add insult to injury, we don't even actually use
        -- these filenames to figure out where the hi files go.
        -- A travesty!
        ModLocation
    location0 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ DynFlags -> ModuleName -> FilePath -> FilePath -> IO ModLocation
    mkHomeModLocation2 DynFlags
    dflags ModuleName
    modname
                                 (FastString -> FilePath
    unpackFS FastString
    unit_fs FilePath -> FilePath -> FilePath
    </>
                                  ModuleName -> FilePath
    moduleNameSlashes ModuleName
    modname)
                                  (case HscSource
    hsc_src of
                                    HscSource
    HsigFile -> FilePath
    "hsig"
                                    HscSource
    HsBootFile -> FilePath
    "hs-boot"
                                    HscSource
    HsSrcFile -> FilePath
    "hs")
        -- DANGEROUS: bootifying can POISON the module finder cache
        let location :: ModLocation
    location = case HscSource
    hsc_src of
                            HscSource
    HsBootFile -> ModLocation -> ModLocation
    addBootSuffixLocnOut ModLocation
    location0
                            HscSource
    _ -> ModLocation
    location0
        -- This duplicates a pile of logic in GHC.Driver.Make
        BkpEnv
    env <- BkpM BkpEnv
    getBkpEnv
        UTCTime
    time <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ FilePath -> IO UTCTime
    getModificationUTCTime (BkpEnv -> FilePath
    bkp_filename BkpEnv
    env)
        Maybe UTCTime
    hi_timestamp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ FilePath -> IO (Maybe UTCTime)
    modificationTimeIfExists (ModLocation -> FilePath
    ml_hi_file ModLocation
    location)
        Maybe UTCTime
    hie_timestamp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ FilePath -> IO (Maybe UTCTime)
    modificationTimeIfExists (ModLocation -> FilePath
    ml_hie_file ModLocation
    location)

        -- Also copied from 'getImports'
        let ([GenLocated (SrcAnn AnnListItem) (ImportDecl GhcPs)]
    src_idecls, [GenLocated (SrcAnn AnnListItem) (ImportDecl GhcPs)]
    ord_idecls) = forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ((forall a. Eq a => a -> a -> Bool
    == IsBootInterface
    IsBoot) forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall pass. ImportDecl pass -> IsBootInterface
    ideclSource forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall l e. GenLocated l e -> e
    unLoc) [LImportDecl GhcPs]
    imps

                 -- GHC.Prim doesn't exist physically, so don't go looking for it.
            ordinary_imps :: [GenLocated (SrcAnn AnnListItem) (ImportDecl GhcPs)]
    ordinary_imps = forall a. (a -> Bool) -> [a] -> [a]
    filter ((forall a. Eq a => a -> a -> Bool
    /= forall unit. GenModule unit -> ModuleName
    moduleName Module
    gHC_PRIM) forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall l e. GenLocated l e -> e
    unLoc forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall pass. ImportDecl pass -> XRec pass ModuleName
    ideclName forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall l e. GenLocated l e -> e
    unLoc)
                                   [GenLocated (SrcAnn AnnListItem) (ImportDecl GhcPs)]
    ord_idecls

            implicit_prelude :: Bool
    implicit_prelude = Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.ImplicitPrelude DynFlags
    dflags
            implicit_imports :: [LImportDecl GhcPs]
    implicit_imports = ModuleName
    -> SrcSpan -> Bool -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
    mkPrelImports ModuleName
    modname SrcSpan
    loc
                                             Bool
    implicit_prelude [LImportDecl GhcPs]
    imps
            convImport :: GenLocated l (ImportDecl pass)
    -> (Maybe FastString, GenLocated SrcSpan ModuleName)
    convImport (L l
    _ ImportDecl pass
    i) = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap StringLiteral -> FastString
    sl_fs (forall pass. ImportDecl pass -> Maybe StringLiteral
    ideclPkgQual ImportDecl pass
    i), forall a e. LocatedAn a e -> Located e
    reLoc forall a b. (a -> b) -> a -> b
    $ forall pass. ImportDecl pass -> XRec pass ModuleName
    ideclName ImportDecl pass
    i)

        [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    extra_sig_imports <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> HscSource
    -> ModuleName
    -> IO [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    findExtraSigImports HscEnv
    hsc_env HscSource
    hsc_src ModuleName
    modname

        let normal_imports :: [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    normal_imports = forall a b. (a -> b) -> [a] -> [b]
    map forall {pass} {a} {l}.
    (XRec pass ModuleName ~ GenLocated (SrcAnn a) ModuleName) =>
    GenLocated l (ImportDecl pass)
    -> (Maybe FastString, GenLocated SrcSpan ModuleName)
    convImport ([LImportDecl GhcPs]
    implicit_imports forall a. [a] -> [a] -> [a]
    ++ [GenLocated (SrcAnn AnnListItem) (ImportDecl GhcPs)]
    ordinary_imps)
        ([ModuleName]
    implicit_sigs, [GenInstantiatedUnit UnitId]
    inst_deps) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    -> IO ([ModuleName], [GenInstantiatedUnit UnitId])
    implicitRequirementsShallow HscEnv
    hsc_env [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    normal_imports

        -- So that Finder can find it, even though it doesn't exist...
        Module
    this_mod <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ HscEnv -> ModuleName -> ModLocation -> IO Module
    addHomeModuleToFinder HscEnv
    hsc_env ModuleName
    modname ModLocation
    location
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ ExtendedModSummary
          { emsModSummary :: ModSummary
    emsModSummary =
              ModSummary {
                ms_mod :: Module
    ms_mod = Module
    this_mod,
                ms_hsc_src :: HscSource
    ms_hsc_src = HscSource
    hsc_src,
                ms_location :: ModLocation
    ms_location = ModLocation
    location,
                ms_hspp_file :: FilePath
    ms_hspp_file = (case DynFlags -> Maybe FilePath
    hiDir DynFlags
    dflags of
                                Maybe FilePath
    Nothing -> FilePath
    ""
                                Just FilePath
    d -> FilePath
    d) FilePath -> FilePath -> FilePath
    </> FilePath
    ".." FilePath -> FilePath -> FilePath
    </> ModuleName -> FilePath
    moduleNameSlashes ModuleName
    modname FilePath -> FilePath -> FilePath
    <.> FilePath
    "hi",
                ms_hspp_opts :: DynFlags
    ms_hspp_opts = DynFlags
    dflags,
                ms_hspp_buf :: Maybe StringBuffer
    ms_hspp_buf = forall a. Maybe a
    Nothing,
                ms_srcimps :: [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    ms_srcimps = forall a b. (a -> b) -> [a] -> [b]
    map forall {pass} {a} {l}.
    (XRec pass ModuleName ~ GenLocated (SrcAnn a) ModuleName) =>
    GenLocated l (ImportDecl pass)
    -> (Maybe FastString, GenLocated SrcSpan ModuleName)
    convImport [GenLocated (SrcAnn AnnListItem) (ImportDecl GhcPs)]
    src_idecls,
                ms_textual_imps :: [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    ms_textual_imps = [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    normal_imports
                               -- We have to do something special here:
                               -- due to merging, requirements may end up with
                               -- extra imports
                               forall a. [a] -> [a] -> [a]
    ++ [(Maybe FastString, GenLocated SrcSpan ModuleName)]
    extra_sig_imports
                               forall a. [a] -> [a] -> [a]
    ++ ((,) forall a. Maybe a
    Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall e. e -> Located e
    noLoc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [ModuleName]
    implicit_sigs),
                -- This is our hack to get the parse tree to the right spot
                ms_parsed_mod :: Maybe HsParsedModule
    ms_parsed_mod = forall a. a -> Maybe a
    Just (HsParsedModule {
                        hpm_module :: Located HsModule
    hpm_module = Located HsModule
    hsmod,
                        hpm_src_files :: [FilePath]
    hpm_src_files = [] -- TODO if we preprocessed it
                    }),
                ms_hs_date :: UTCTime
    ms_hs_date = UTCTime
    time,
                ms_obj_date :: Maybe UTCTime
    ms_obj_date = forall a. Maybe a
    Nothing, -- TODO do this, but problem: hi_timestamp is BOGUS
                ms_iface_date :: Maybe UTCTime
    ms_iface_date = Maybe UTCTime
    hi_timestamp,
                ms_hie_date :: Maybe UTCTime
    ms_hie_date = Maybe UTCTime
    hie_timestamp
              }
          , emsInstantiatedUnits :: [GenInstantiatedUnit UnitId]
    emsInstantiatedUnits = [GenInstantiatedUnit UnitId]
    inst_deps
          }

    -- | Create a new, externally provided hashed unit id from
    -- a hash.
    newUnitId :: IndefUnitId -> Maybe FastString -> UnitId
    newUnitId :: IndefUnitId -> Maybe FastString -> UnitId
    newUnitId IndefUnitId
    uid Maybe FastString
    mhash = case Maybe FastString
    mhash of
       Maybe FastString
    Nothing   -> forall unit. Indefinite unit -> unit
    indefUnit IndefUnitId
    uid
       Just FastString
    hash -> FastString -> UnitId
    UnitId (UnitId -> FastString
    unitIdFS (forall unit. Indefinite unit -> unit
    indefUnit IndefUnitId
    uid) FastString -> FastString -> FastString
    `appendFS` FilePath -> FastString
    mkFastString FilePath
    "+" FastString -> FastString -> FastString
    `appendFS` FastString
    hash)