    {-# 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

    import GHC.Prelude

    import GHC.Driver.Backend
    -- In a separate module because it hooks into the parser.
    import GHC.Driver.Backpack.Syntax
    import GHC.Driver.Config.Finder (initFinderOpts)
    import GHC.Driver.Config.Parser (initParserOpts)
    import GHC.Driver.Config.Diagnostic
    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.Driver.Errors.Types

    import GHC.Parser
    import GHC.Parser.Header
    import GHC.Parser.Lexer
    import GHC.Parser.Annotation

    import GHC.Rename.Names

    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.SourceFile
    import GHC.Types.Unique.FM
    import GHC.Types.Unique.DFM
    import GHC.Types.Unique.DSet

    import GHC.Utils.Outputable
    import GHC.Utils.Fingerprint
    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.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
    import GHC.Types.Error (mkUnknownDiagnostic)

    -- | Entry point to compile a Backpack file.
    doBackpack :: [FilePath] -> Ghc ()
    doBackpack :: [FilePath] -> Ghc ()
    doBackpack [FilePath
    src_filename] = do
        -- Apply options from file to dflags
        dflags0 <- Ghc DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        let dflags1 = DynFlags
    dflags0
        let parser_opts1 = DynFlags -> ParserOpts
    initParserOpts DynFlags
    dflags1
        (p_warns, src_opts) <- liftIO $ getOptionsFromFile parser_opts1 src_filename
        (dflags, unhandled_flags, warns) <- liftIO $ parseDynamicFilePragma dflags1 src_opts
        modifySession (hscSetFlags dflags)
        logger <- getLogger -- Get the logger after having set the session flags,
                            -- so that logger options are correctly set.
                            -- Not doing so caused #20396.
        -- Cribbed from: preprocessFile / GHC.Driver.Pipeline
        liftIO $ checkProcessArgsResult unhandled_flags
        let print_config = DynFlags -> DiagnosticOpts GhcMessage
    initPrintConfig DynFlags
    dflags
        liftIO $ printOrThrowDiagnostics logger print_config (initDiagOpts dflags) (GhcPsMessage <$> p_warns)
        liftIO $ printOrThrowDiagnostics logger print_config (initDiagOpts dflags) (GhcDriverMessage <$> warns)
        -- TODO: Preprocessing not implemented

        buf <- liftIO $ hGetStringBuffer src_filename
        let loc = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc (FilePath -> FastString
    mkFastString FilePath
    src_filename) Int
    1 Int
    1 -- TODO: not great
        case unP parseBackpack (initParserState (initParserOpts dflags) buf loc) of
            PFailed PState
    pst -> Messages GhcMessage -> Ghc ()
    forall (io :: * -> *) a. MonadIO io => Messages GhcMessage -> io a
    throwErrors (PsMessage -> GhcMessage
    GhcPsMessage (PsMessage -> GhcMessage)
    -> Messages PsMessage -> Messages GhcMessage
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PState -> Messages PsMessage
    getPsErrorMessages 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.
                hsc_env <- Ghc HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
                let bkp = UnitState
    -> PackageNameMap HsComponentId
    -> [LHsUnit PackageName]
    -> [LHsUnit HsComponentId]
    renameHsUnits (HasDebugCallStack => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env) ([LHsUnit PackageName] -> PackageNameMap HsComponentId
    bkpPackageNameMap [LHsUnit PackageName]
    pkgname_bkp) [LHsUnit PackageName]
    pkgname_bkp
                initBkpM src_filename bkp $
                    forM_ (zip [1..] bkp) $ \(Int
    i, LHsUnit HsComponentId
    lunit) -> do
                        let comp_name :: HsComponentId
    comp_name = GenLocated SrcSpan HsComponentId -> HsComponentId
    forall l e. GenLocated l e -> e
    unLoc (HsUnit HsComponentId -> GenLocated SrcSpan HsComponentId
    forall n. HsUnit n -> Located n
    hsunitName (LHsUnit HsComponentId -> HsUnit HsComponentId
    forall l e. GenLocated l e -> e
    unLoc LHsUnit HsComponentId
    lunit))
                        (Int, Int) -> HsComponentId -> BkpM ()
    msgTopPackage (Int
    i,[LHsUnit HsComponentId] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [LHsUnit HsComponentId]
    bkp) HsComponentId
    comp_name
                        BkpM () -> BkpM ()
    forall a. BkpM a -> BkpM a
    innerBkpM (BkpM () -> BkpM ()) -> BkpM () -> BkpM ()
    forall a b. (a -> b) -> a -> b
    $ do
                            let (UnitId
    cid, [(ModuleName, Module)]
    insts) = LHsUnit HsComponentId -> (UnitId, [(ModuleName, Module)])
    computeUnitId LHsUnit HsComponentId
    lunit
                            if [(ModuleName, Module)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(ModuleName, Module)]
    insts
                                then if UnitId
    cid UnitId -> UnitId -> Bool
    forall a. Eq a => a -> a -> Bool
    == FastString -> UnitId
    UnitId (FilePath -> FastString
    fsLit FilePath
    "main")
                                        then LHsUnit HsComponentId -> BkpM ()
    compileExe LHsUnit HsComponentId
    lunit
                                        else UnitId -> [(ModuleName, Module)] -> BkpM ()
    compileUnit UnitId
    cid []
                                else UnitId -> [(ModuleName, Module)] -> BkpM ()
    typecheckUnit UnitId
    cid [(ModuleName, Module)]
    insts
    doBackpack [FilePath]
    _ =
        GhcException -> Ghc ()
    forall a. GhcException -> a
    throwGhcException (FilePath -> GhcException
    CmdLineError FilePath
    "--backpack can only process a single file")

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

    -- | Create a temporary Session to do some sort of type checking or
    -- compilation.
    withBkpSession :: UnitId
                   -> [(ModuleName, Module)]
                   -> [(Unit, ModRenaming)]
                   -> SessionType   -- what kind of session are we doing
                   -> BkpM a        -- actual action to run
                   -> BkpM a
    withBkpSession :: forall a.
    UnitId
    -> [(ModuleName, Module)]
    -> [(Unit, ModRenaming)]
    -> SessionType
    -> BkpM a
    -> BkpM a
    withBkpSession UnitId
    cid [(ModuleName, Module)]
    insts [(Unit, ModRenaming)]
    deps SessionType
    session_type BkpM a
    do_this = do
        dflags <- IOEnv BkpEnv DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        let cid_fs = UnitId -> FastString
    forall u. IsUnitId u => u -> FastString
    unitFS UnitId
    cid
            is_primary = Bool
    False
            uid_str = FastString -> FilePath
    unpackFS (UnitId -> [(ModuleName, Module)] -> FastString
    forall u.
    IsUnitId u =>
    u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
    mkInstantiatedUnitHash UnitId
    cid [(ModuleName, Module)]
    insts)
            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
    p | Just FilePath
    f <- DynFlags -> Maybe FilePath
    p DynFlags
    dflags = FilePath
    f
                       | Bool
    otherwise          = FilePath
    "."
            sub_comp FilePath
    p | Bool
    is_primary = FilePath
    p
                       | Bool
    otherwise = FilePath
    p FilePath -> FilePath -> FilePath
    </> FilePath
    cid_str
            outdir DynFlags -> Maybe FilePath
    p | SessionType
    CompSession <- SessionType
    session_type
                     -- Special case when package is definite
                     , Bool -> Bool
    not ([(ModuleName, Module)] -> Bool
    forall a. [a] -> Bool
    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
    hsc_env =
              (DynFlags -> DynFlags) -> HscEnv -> HscEnv
    hscUpdateFlags (\DynFlags
    dflags -> UnitState -> DynFlags -> DynFlags
    mk_temp_dflags (HasDebugCallStack => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env) DynFlags
    dflags) HscEnv
    hsc_env
            mk_temp_dflags UnitState
    unit_state DynFlags
    dflags = DynFlags
    dflags
                { backend = case session_type of
                                SessionType
    TcSession -> Backend
    noBackend
                                SessionType
    _         -> DynFlags -> Backend
    backend DynFlags
    dflags
                , ghcLink = case session_type of
                                SessionType
    TcSession -> GhcLink
    NoLink
                                SessionType
    _         -> DynFlags -> GhcLink
    ghcLink DynFlags
    dflags
                , homeUnitInstantiations_ = insts
                                         -- if we don't have any instantiation, don't
                                         -- fill `homeUnitInstanceOfId` as it makes no
                                         -- sense (we're not instantiating anything)
                , homeUnitInstanceOf_   = if null insts then Nothing else Just cid
                , homeUnitId_ = case session_type of
                    SessionType
    TcSession -> UnitId -> Maybe FastString -> UnitId
    newUnitId UnitId
    cid Maybe FastString
    forall a. Maybe a
    Nothing
                    -- No hash passed if no instances
                    SessionType
    _ | [(ModuleName, Module)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(ModuleName, Module)]
    insts -> UnitId -> Maybe FastString -> UnitId
    newUnitId UnitId
    cid Maybe FastString
    forall a. Maybe a
    Nothing
                      | Bool
    otherwise  -> UnitId -> Maybe FastString -> UnitId
    newUnitId UnitId
    cid (FastString -> Maybe FastString
    forall a. a -> Maybe a
    Just (UnitId -> [(ModuleName, Module)] -> FastString
    forall u.
    IsUnitId u =>
    u -> [(ModuleName, GenModule (GenUnit u))] -> FastString
    mkInstantiatedUnitHash UnitId
    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 = case session_type of
                    -- Make sure to write interfaces when we are type-checking
                    -- indefinite packages.
                    SessionType
    TcSession
                      | Backend -> Bool
    backendSupportsInterfaceWriting (Backend -> Bool) -> Backend -> Bool
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> Backend
    backend DynFlags
    dflags
                      -> GeneralFlag -> EnumSet GeneralFlag -> EnumSet GeneralFlag
    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   = Just (outdir objectDir)
                , hiDir       = Just (outdir hiDir)
                , stubDir     = Just (outdir stubDir)
                -- Unset output-file for non exe builds
                , outputFile_ = case session_type of
                    SessionType
    ExeSession -> DynFlags -> Maybe FilePath
    outputFile_ DynFlags
    dflags
                    SessionType
    _          -> Maybe FilePath
    forall a. Maybe a
    Nothing
                , dynOutputFile_ = case session_type of
                    SessionType
    ExeSession -> DynFlags -> Maybe FilePath
    dynOutputFile_ DynFlags
    dflags
                    SessionType
    _          -> Maybe FilePath
    forall a. Maybe a
    Nothing
                -- Clear the import path so we don't accidentally grab anything
                , importPaths = []
                -- Synthesize the flags
                , packageFlags = packageFlags dflags ++ map (\(Unit
    uid0, ModRenaming
    rn) ->
                  let uid :: Unit
    uid = UnitState -> Unit -> Unit
    unwireUnit UnitState
    unit_state
                            (Unit -> Unit) -> Unit -> Unit
    forall a b. (a -> b) -> a -> b
    $ UnitState -> Unit -> Unit
    improveUnit UnitState
    unit_state
                            (Unit -> Unit) -> Unit -> Unit
    forall a b. (a -> b) -> a -> b
    $ UnitState -> ShHoleSubst -> Unit -> Unit
    renameHoleUnit UnitState
    unit_state ([(ModuleName, Module)] -> ShHoleSubst
    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
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "-unit-id" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Unit -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unit
    uid SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> ModRenaming -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ModRenaming
    rn))
                    (Unit -> PackageArg
    UnitIdArg Unit
    uid) ModRenaming
    rn) deps
                }
        withTempSession mk_temp_env $ do
          dflags <- getSessionDynFlags
          -- pprTrace "flags" (ppr insts <> ppr deps) $ return ()
          setSessionDynFlags dflags -- calls initUnits
          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 =
        UnitId
    -> [(ModuleName, Module)]
    -> [(Unit, ModRenaming)]
    -> SessionType
    -> BkpM a
    -> BkpM a
    forall a.
    UnitId
    -> [(ModuleName, Module)]
    -> [(Unit, ModRenaming)]
    -> SessionType
    -> BkpM a
    -> BkpM a
    withBkpSession (FastString -> UnitId
    UnitId (FilePath -> FastString
    fsLit FilePath
    "main")) [] [(Unit, ModRenaming)]
    deps SessionType
    ExeSession BkpM a
    do_this

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

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

    compileUnit :: UnitId -> [(ModuleName, Module)] -> BkpM ()
    compileUnit :: UnitId -> [(ModuleName, Module)] -> BkpM ()
    compileUnit UnitId
    cid [(ModuleName, Module)]
    insts = do
        -- Let everyone know we're building this unit
        Unit -> BkpM ()
    msgUnitId (UnitId -> [(ModuleName, Module)] -> Unit
    forall u.
    IsUnitId u =>
    u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
    mkVirtUnit UnitId
    cid [(ModuleName, Module)]
    insts)
        lunit <- UnitId -> BkpM (LHsUnit HsComponentId)
    getSource UnitId
    cid
        buildUnit CompSession cid insts 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 = (GenLocated SrcSpan (HsUnitDecl HsComponentId)
     -> [(Unit, ModRenaming)])
    -> [GenLocated SrcSpan (HsUnitDecl HsComponentId)]
    -> [(Unit, ModRenaming)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap GenLocated SrcSpan (HsUnitDecl HsComponentId)
    -> [(Unit, ModRenaming)]
    get_dep (HsUnit HsComponentId
    -> [GenLocated SrcSpan (HsUnitDecl HsComponentId)]
    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, Maybe [LRenaming] -> ModRenaming
    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 ((GenLocated l Renaming -> (ModuleName, ModuleName))
    -> [GenLocated l Renaming] -> [(ModuleName, ModuleName)]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated l Renaming -> (ModuleName, ModuleName)
    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 (Located 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 -> UnitId -> [(ModuleName, Module)] -> LHsUnit HsComponentId -> BkpM ()
    buildUnit :: SessionType
    -> UnitId
    -> [(ModuleName, Module)]
    -> LHsUnit HsComponentId
    -> BkpM ()
    buildUnit SessionType
    session UnitId
    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 SessionType -> SessionType -> Bool
    forall a. Eq a => a -> a -> Bool
    == SessionType
    TcSession) (LHsUnit HsComponentId -> HsUnit HsComponentId
    forall l e. GenLocated l e -> e
    unLoc LHsUnit HsComponentId
    lunit)
            raw_deps :: [Unit]
    raw_deps = ((Unit, ModRenaming) -> Unit) -> [(Unit, ModRenaming)] -> [Unit]
    forall a b. (a -> b) -> [a] -> [b]
    map (Unit, ModRenaming) -> Unit
    forall a b. (a, b) -> a
    fst [(Unit, ModRenaming)]
    deps_w_rns
        hsc_env <- IOEnv BkpEnv HscEnv
    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 = [(ModuleName, Module)] -> ShHoleSubst
    forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
    listToUFM [(ModuleName, Module)]
    insts
            deps0 = (Unit -> Unit) -> [Unit] -> [Unit]
    forall a b. (a -> b) -> [a] -> [b]
    map (UnitState -> ShHoleSubst -> Unit -> Unit
    renameHoleUnit (HasDebugCallStack => HscEnv -> UnitState
    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!!
        forM_ (zip [1..] deps0) $ \(Int
    i, Unit
    dep) ->
            case SessionType
    session of
                SessionType
    TcSession -> () -> BkpM ()
    forall a. a -> IOEnv BkpEnv a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                SessionType
    _ -> Int -> (Int, Unit) -> BkpM ()
    compileInclude ([Unit] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Unit]
    deps0) (Int
    i, Unit
    dep)

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

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

        conf <- withBkpSession cid insts deps_w_rns session $ do

            dflags <- getDynFlags
            mod_graph <- hsunitModuleGraph False (unLoc lunit)

            msg <- mkBackpackMsg
            ok <- load' noIfaceCache LoadAllTargets mkUnknownDiagnostic (Just msg) mod_graph
            when (failed ok) (liftIO $ exitWith (ExitFailure 1))

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

            -- Compile relevant only
            hsc_env <- getSession
            let home_mod_infos = UniqDFM ModuleName HomeModInfo -> [HomeModInfo]
    forall {k} (key :: k) elt. UniqDFM key elt -> [elt]
    eltsUDFM (HscEnv -> UniqDFM ModuleName HomeModInfo
    hsc_HPT HscEnv
    hsc_env)
                linkables = (HomeModInfo -> Linkable) -> [HomeModInfo] -> [Linkable]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath -> Maybe Linkable -> Linkable
    forall a. HasCallStack => FilePath -> Maybe a -> a
    expectJust FilePath
    "bkp link" (Maybe Linkable -> Linkable)
    -> (HomeModInfo -> Maybe Linkable) -> HomeModInfo -> Linkable
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> Maybe Linkable
    homeModInfoObject)
                          ([HomeModInfo] -> [Linkable])
    -> ([HomeModInfo] -> [HomeModInfo]) -> [HomeModInfo] -> [Linkable]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HomeModInfo -> Bool) -> [HomeModInfo] -> [HomeModInfo]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((HscSource -> HscSource -> Bool
    forall a. Eq a => a -> a -> Bool
    ==HscSource
    HsSrcFile) (HscSource -> Bool)
    -> (HomeModInfo -> HscSource) -> HomeModInfo -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModIface_ 'ModIfaceFinal -> HscSource
    forall (phase :: ModIfacePhase). ModIface_ phase -> HscSource
    mi_hsc_src (ModIface_ 'ModIfaceFinal -> HscSource)
    -> (HomeModInfo -> ModIface_ 'ModIfaceFinal)
    -> HomeModInfo
    -> HscSource
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HomeModInfo -> ModIface_ 'ModIfaceFinal
    hm_iface)
                          ([HomeModInfo] -> [Linkable]) -> [HomeModInfo] -> [Linkable]
    forall a b. (a -> b) -> a -> b
    $ [HomeModInfo]
    home_mod_infos
                getOfiles LM{ linkableUnlinked :: Linkable -> [Unlinked]
    linkableUnlinked = [Unlinked]
    us } = (Unlinked -> FilePath) -> [Unlinked] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map Unlinked -> FilePath
    nameOfObject ((Unlinked -> Bool) -> [Unlinked] -> [Unlinked]
    forall a. (a -> Bool) -> [a] -> [a]
    filter Unlinked -> Bool
    isObject [Unlinked]
    us)
                obj_files = (Linkable -> [FilePath]) -> [Linkable] -> [FilePath]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Linkable -> [FilePath]
    getOfiles [Linkable]
    linkables
                state     = HasDebugCallStack => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env

            let compat_fs = UnitId -> FastString
    unitIdFS UnitId
    cid
                compat_pn = FastString -> PackageName
    PackageName FastString
    compat_fs
                unit_id   = GenHomeUnit UnitId -> UnitId
    forall u. GenHomeUnit u -> UnitId
    homeUnitId (HscEnv -> GenHomeUnit UnitId
    hsc_home_unit HscEnv
    hsc_env)

            return GenericUnitInfo {
                -- Stub data
                unitAbiHash = "",
                unitPackageId = PackageId compat_fs,
                unitPackageName = compat_pn,
                unitPackageVersion = makeVersion [],
                unitId = unit_id,
                unitComponentName = Nothing,
                unitInstanceOf = cid,
                unitInstantiations = insts,
                -- Slight inefficiency here haha
                unitExposedModules = map (\(ModuleName
    m,Module
    n) -> (ModuleName
    m,Module -> Maybe Module
    forall a. a -> Maybe a
    Just Module
    n)) mods,
                unitHiddenModules = [], -- TODO: doc only
                unitDepends = case 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
    _ -> (Unit -> UnitId) -> [Unit] -> [UnitId]
    forall a b. (a -> b) -> [a] -> [b]
    map (Unit -> UnitId
    toUnitId (Unit -> UnitId) -> (Unit -> Unit) -> Unit -> UnitId
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UnitState -> Unit -> Unit
    unwireUnit UnitState
    state)
                                    ([Unit] -> [UnitId]) -> [Unit] -> [UnitId]
    forall a b. (a -> b) -> a -> b
    $ [Unit]
    deps [Unit] -> [Unit] -> [Unit]
    forall a. [a] -> [a] -> [a]
    ++ [ Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    mod
                                              | (ModuleName
    _, Module
    mod) <- [(ModuleName, Module)]
    insts
                                              , Bool -> Bool
    not (Module -> Bool
    forall u. GenModule (GenUnit u) -> Bool
    isHoleModule Module
    mod) ],
                unitAbiDepends = [],
                unitLinkerOptions = case session of
                                     SessionType
    TcSession -> []
                                     SessionType
    _ -> (FilePath -> ShortText) -> [FilePath] -> [ShortText]
    forall a b. (a -> b) -> [a] -> [b]
    map FilePath -> ShortText
    ST.pack ([FilePath] -> [ShortText]) -> [FilePath] -> [ShortText]
    forall a b. (a -> b) -> a -> b
    $ [FilePath]
    obj_files,
                unitImportDirs = [ ST.pack $ hi_dir ],
                unitIsExposed = False,
                unitIsIndefinite = case session of
                                     SessionType
    TcSession -> Bool
    True
                                     SessionType
    _ -> Bool
    False,
                -- nope
                unitLibraries = [],
                unitExtDepLibsSys = [],
                unitExtDepLibsGhc = [],
                unitLibraryDynDirs = [],
                unitLibraryDirs = [],
                unitExtDepFrameworks = [],
                unitExtDepFrameworkDirs = [],
                unitCcOptions = [],
                unitIncludes = [],
                unitIncludeDirs = [],
                unitHaddockInterfaces = [],
                unitHaddockHTMLs = [],
                unitIsTrusted = False
                }

        addUnit conf
        case mb_old_eps of
            Just ExternalPackageState
    old_eps -> (ExternalPackageState -> ExternalPackageState) -> BkpM ()
    forall (m :: * -> *).
    GhcMonad m =>
    (ExternalPackageState -> ExternalPackageState) -> m ()
    updateEpsGhc_ (ExternalPackageState
    -> ExternalPackageState -> ExternalPackageState
    forall a b. a -> b -> a
    const ExternalPackageState
    old_eps)
            Maybe ExternalPackageState
    _ -> () -> BkpM ()
    forall a. a -> IOEnv BkpEnv a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

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

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

        -- update platform constants
        dflags <- liftIO $ updatePlatformConstants dflags0 mconstants

        let unit_env = UnitState -> UnitEnv -> UnitEnv
    ue_setUnits UnitState
    unit_state (UnitEnv -> UnitEnv) -> UnitEnv -> UnitEnv
    forall a b. (a -> b) -> a -> b
    $ Maybe [UnitDatabase UnitId] -> UnitEnv -> UnitEnv
    ue_setUnitDbs ([UnitDatabase UnitId] -> Maybe [UnitDatabase UnitId]
    forall a. a -> Maybe a
    Just [UnitDatabase UnitId]
    dbs) (UnitEnv -> UnitEnv) -> UnitEnv -> UnitEnv
    forall a b. (a -> b) -> a -> b
    $ UnitEnv
              { ue_platform :: Platform
    ue_platform  = DynFlags -> Platform
    targetPlatform DynFlags
    dflags
              , ue_namever :: GhcNameVersion
    ue_namever   = DynFlags -> GhcNameVersion
    ghcNameVersion DynFlags
    dflags
              , ue_current_unit :: UnitId
    ue_current_unit = GenHomeUnit UnitId -> UnitId
    forall u. GenHomeUnit u -> UnitId
    homeUnitId GenHomeUnit UnitId
    home_unit

              , ue_home_unit_graph :: HomeUnitGraph
    ue_home_unit_graph =
                    UnitId -> HomeUnitEnv -> HomeUnitGraph
    forall v. UnitId -> v -> UnitEnvGraph v
    unitEnv_singleton
                        (GenHomeUnit UnitId -> UnitId
    forall u. GenHomeUnit u -> UnitId
    homeUnitId GenHomeUnit UnitId
    home_unit)
                        (DynFlags
    -> UniqDFM ModuleName HomeModInfo
    -> Maybe (GenHomeUnit UnitId)
    -> HomeUnitEnv
    mkHomeUnitEnv DynFlags
    dflags (HasDebugCallStack => UnitEnv -> UniqDFM ModuleName HomeModInfo
    UnitEnv -> UniqDFM ModuleName HomeModInfo
    ue_hpt UnitEnv
    old_unit_env) (GenHomeUnit UnitId -> Maybe (GenHomeUnit UnitId)
    forall a. a -> Maybe a
    Just GenHomeUnit UnitId
    home_unit))
              , ue_eps :: ExternalUnitCache
    ue_eps       = UnitEnv -> ExternalUnitCache
    ue_eps UnitEnv
    old_unit_env
              }
        setSession $ hscSetFlags dflags $ hsc_env { hsc_unit_env = unit_env }

    compileInclude :: Int -> (Int, Unit) -> BkpM ()
    compileInclude :: Int -> (Int, Unit) -> BkpM ()
    compileInclude Int
    n (Int
    i, Unit
    uid) = do
        hsc_env <- IOEnv BkpEnv HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        let pkgs = HasDebugCallStack => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env
        msgInclude (i, n) uid
        -- Check if we've compiled it already
        case uid of
          Unit
    HoleUnit   -> () -> BkpM ()
    forall a. a -> IOEnv BkpEnv a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          RealUnit Definite UnitId
    _ -> () -> BkpM ()
    forall a. a -> IOEnv BkpEnv a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          VirtUnit GenInstantiatedUnit UnitId
    i -> case UnitState
    -> Unit
    -> Maybe
         (GenericUnitInfo PackageId PackageName UnitId ModuleName Module)
    lookupUnit UnitState
    pkgs Unit
    uid of
            Maybe
      (GenericUnitInfo PackageId PackageName UnitId ModuleName Module)
    Nothing -> BkpM () -> BkpM ()
    forall a. BkpM a -> BkpM a
    innerBkpM (BkpM () -> BkpM ()) -> BkpM () -> BkpM ()
    forall a b. (a -> b) -> a -> b
    $ UnitId -> [(ModuleName, Module)] -> BkpM ()
    compileUnit (GenInstantiatedUnit UnitId -> UnitId
    forall unit. GenInstantiatedUnit unit -> unit
    instUnitInstanceOf GenInstantiatedUnit UnitId
    i) (GenInstantiatedUnit UnitId -> [(ModuleName, Module)]
    forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
    instUnitInsts GenInstantiatedUnit UnitId
    i)
            Just GenericUnitInfo PackageId PackageName UnitId ModuleName Module
    _  -> () -> BkpM ()
    forall a. a -> IOEnv BkpEnv a
    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 UnitId (LHsUnit HsComponentId)
    bkp_table :: Map UnitId (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 :: IOEnv BkpEnv DynFlags
    getDynFlags = (HscEnv -> DynFlags)
    -> IOEnv BkpEnv HscEnv -> IOEnv BkpEnv DynFlags
    forall a b. (a -> b) -> IOEnv BkpEnv a -> IOEnv BkpEnv b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HscEnv -> DynFlags
    hsc_dflags IOEnv BkpEnv HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
    instance {-# OVERLAPPING #-} HasLogger BkpM where
        getLogger :: BkpM Logger
    getLogger = (HscEnv -> Logger) -> IOEnv BkpEnv HscEnv -> BkpM Logger
    forall a b. (a -> b) -> IOEnv BkpEnv a -> IOEnv BkpEnv b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HscEnv -> Logger
    hsc_logger IOEnv BkpEnv HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession

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

    -- | Get the current 'BkpEnv'.
    getBkpEnv :: BkpM BkpEnv
    getBkpEnv :: BkpM BkpEnv
    getBkpEnv = BkpM BkpEnv
    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 (BkpEnv -> Int) -> BkpM BkpEnv -> BkpM Int
    forall a b. (a -> b) -> IOEnv BkpEnv a -> IOEnv BkpEnv b
    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.
        (BkpEnv -> BkpEnv) -> BkpM a -> BkpM a
    forall env env' a. (env -> env') -> IOEnv env' a -> IOEnv env a
    updEnv (\BkpEnv
    env -> BkpEnv
    env { bkp_level = bkp_level env + 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
        hsc_env <- m HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        liftIO $ atomicModifyIORef' (euc_eps (ue_eps (hsc_unit_env 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
        hsc_env <- m HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        liftIO $ hscEPS 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 =
      (Session -> IO a) -> Ghc a
    forall a. (Session -> IO a) -> Ghc a
    reifyGhc ((Session -> IO a) -> Ghc a) -> (Session -> IO a) -> Ghc a
    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 UnitId (LHsUnit HsComponentId)
    bkp_table = [(UnitId, LHsUnit HsComponentId)]
    -> Map UnitId (LHsUnit HsComponentId)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList [(HsComponentId -> UnitId
    hsComponentId (GenLocated SrcSpan HsComponentId -> HsComponentId
    forall l e. GenLocated l e -> e
    unLoc (HsUnit HsComponentId -> GenLocated SrcSpan HsComponentId
    forall n. HsUnit n -> Located n
    hsunitName (LHsUnit HsComponentId -> HsUnit HsComponentId
    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
          }
        BkpEnv -> BkpM a -> IO a
    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 -> SDoc -> IO ()
    backpackProgressMsg :: Int -> Logger -> SDoc -> IO ()
    backpackProgressMsg Int
    level Logger
    logger SDoc
    msg =
        Logger -> SDoc -> IO ()
    compilationProgressMsg Logger
    logger (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text (Int -> Char -> FilePath
    forall a. Int -> a -> [a]
    replicate (Int
    level Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    2) Char
    ' ') -- TODO: use GHC.Utils.Ppr.RStr
                                        SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> 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
        level <- BkpM Int
    getBkpLevel
        return $ \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 = HasDebugCallStack => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env
              showMsg :: SDoc -> SDoc -> IO ()
    showMsg SDoc
    msg SDoc
    reason =
                Int -> Logger -> SDoc -> IO ()
    backpackProgressMsg Int
    level Logger
    logger (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    state (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                    (Int, Int) -> SDoc
    showModuleIndex (Int, Int)
    mod_index SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <>
                    SDoc
    msg SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> DynFlags -> Bool -> ModuleGraphNode -> SDoc
    showModMsg DynFlags
    dflags (RecompileRequired -> Bool
    recompileRequired RecompileRequired
    recomp) ModuleGraphNode
    node
                        SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    reason
          in case ModuleGraphNode
    node of
            InstantiationNode UnitId
    _ GenInstantiatedUnit UnitId
    _ ->
              case RecompileRequired
    recomp of
                RecompileRequired
    UpToDate
                  | DynFlags -> Int
    verbosity (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2 -> SDoc -> SDoc -> IO ()
    showMsg (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Skipping  ") SDoc
    forall doc. IsOutput doc => doc
    empty
                  | Bool
    otherwise -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                NeedsRecompile CompileReason
    reason0 -> SDoc -> SDoc -> IO ()
    showMsg (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Instantiating ") (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ case CompileReason
    reason0 of
                  CompileReason
    MustCompile -> SDoc
    forall doc. IsOutput doc => doc
    empty
                  RecompBecause RecompReason
    reason -> FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    " [" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    state (RecompReason -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RecompReason
    reason) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "]"
            ModuleNode [NodeKey]
    _ ModSummary
    _ ->
              case RecompileRequired
    recomp of
                RecompileRequired
    UpToDate
                  | DynFlags -> Int
    verbosity (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2 -> SDoc -> SDoc -> IO ()
    showMsg (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Skipping  ") SDoc
    forall doc. IsOutput doc => doc
    empty
                  | Bool
    otherwise -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                NeedsRecompile CompileReason
    reason0 -> SDoc -> SDoc -> IO ()
    showMsg (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Compiling ") (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ case CompileReason
    reason0 of
                  CompileReason
    MustCompile -> SDoc
    forall doc. IsOutput doc => doc
    empty
                  RecompBecause RecompReason
    reason -> FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    " [" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    state (RecompReason -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr RecompReason
    reason) SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "]"
            LinkNode [NodeKey]
    _ UnitId
    _ -> SDoc -> SDoc -> IO ()
    showMsg (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Linking ")  SDoc
    forall doc. IsOutput doc => doc
    empty

    -- | '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 =
        NamePprCtx -> Depth -> PprStyle
    mkUserStyle
            (QueryQualifyName
    -> (Module -> Bool)
    -> QueryQualifyPackage
    -> QueryPromotionTick
    -> NamePprCtx
    QueryQualify QueryQualifyName
    neverQualifyNames
                          Module -> Bool
    alwaysQualifyModules
                          QueryQualifyPackage
    neverQualifyPackages
                          QueryPromotionTick
    alwaysPrintPromTick)
            Depth
    AllTheWay

    -- | Message when we initially process a Backpack unit.
    msgTopPackage :: (Int,Int) -> HsComponentId -> BkpM ()
    msgTopPackage :: (Int, Int) -> HsComponentId -> BkpM ()
    msgTopPackage (Int
    i,Int
    n) (HsComponentId (PackageName FastString
    fs_pn) UnitId
    _) = do
        logger <- BkpM Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        level <- getBkpLevel
        liftIO . backpackProgressMsg level logger
            $ showModuleIndex (i, n) <> text "Processing " <> ftext fs_pn

    -- | Message when we instantiate a Backpack unit.
    msgUnitId :: Unit -> BkpM ()
    msgUnitId :: Unit -> BkpM ()
    msgUnitId Unit
    pk = do
        logger <- BkpM Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        hsc_env <- getSession
        level <- getBkpLevel
        let state = HasDebugCallStack => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env
        liftIO . backpackProgressMsg level logger
            $ pprWithUnitState state
            $ text "Instantiating "
               <> withPprStyle backpackStyle (ppr pk)

    -- | Message when we include a Backpack unit.
    msgInclude :: (Int,Int) -> Unit -> BkpM ()
    msgInclude :: (Int, Int) -> Unit -> BkpM ()
    msgInclude (Int
    i,Int
    n) Unit
    uid = do
        logger <- BkpM Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        hsc_env <- getSession
        level <- getBkpLevel
        let state = HasDebugCallStack => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env
        liftIO . backpackProgressMsg level logger
            $ pprWithUnitState state
            $ showModuleIndex (i, n) <> text "Including "
                <> withPprStyle backpackStyle (ppr 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 -> UnitId -> HsComponentId
    HsComponentId PackageName
    pn (FastString -> UnitId
    UnitId FastString
    fs))

    bkpPackageNameMap :: [LHsUnit PackageName] -> PackageNameMap HsComponentId
    bkpPackageNameMap :: [LHsUnit PackageName] -> PackageNameMap HsComponentId
    bkpPackageNameMap [LHsUnit PackageName]
    units = [(PackageName, HsComponentId)] -> PackageNameMap HsComponentId
    forall key elt. Uniquable key => [(key, elt)] -> UniqFM key elt
    listToUFM ((LHsUnit PackageName -> (PackageName, HsComponentId))
    -> [LHsUnit PackageName] -> [(PackageName, HsComponentId)]
    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 = (LHsUnit PackageName -> LHsUnit HsComponentId)
    -> [LHsUnit PackageName] -> [LHsUnit HsComponentId]
    forall a b. (a -> b) -> [a] -> [b]
    map ((HsUnit PackageName -> HsUnit HsComponentId)
    -> LHsUnit PackageName -> LHsUnit HsComponentId
    forall a b.
    (a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan b
    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 PackageNameMap HsComponentId -> PackageName -> Maybe HsComponentId
    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 UnitId
    lookupPackageName UnitState
    pkgstate PackageName
    pn of
                        Maybe UnitId
    Nothing -> FilePath -> HsComponentId
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "no package name"
                        Just UnitId
    cid -> PackageName -> UnitId -> HsComponentId
    HsComponentId PackageName
    pn UnitId
    cid
                Just HsComponentId
    hscid -> HsComponentId
    hscid

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

        renameHsUnitDecl :: HsUnitDecl PackageName -> HsUnitDecl HsComponentId
        renameHsUnitDecl :: HsUnitDecl PackageName -> HsUnitDecl HsComponentId
    renameHsUnitDecl (DeclD HscSource
    a Located ModuleName
    b Located (HsModule GhcPs)
    c) = HscSource
    -> Located ModuleName
    -> Located (HsModule GhcPs)
    -> HsUnitDecl HsComponentId
    forall n.
    HscSource
    -> Located ModuleName -> Located (HsModule GhcPs) -> HsUnitDecl n
    DeclD HscSource
    a Located ModuleName
    b Located (HsModule GhcPs)
    c
        renameHsUnitDecl (IncludeD IncludeDecl PackageName
    idecl) =
            IncludeDecl HsComponentId -> HsUnitDecl HsComponentId
    forall n. IncludeDecl n -> HsUnitDecl n
    IncludeD IncludeDecl {
                idUnitId :: GenLocated SrcSpan (HsUnitId HsComponentId)
    idUnitId = (HsUnitId PackageName -> HsUnitId HsComponentId)
    -> GenLocated SrcSpan (HsUnitId PackageName)
    -> GenLocated SrcSpan (HsUnitId HsComponentId)
    forall a b.
    (a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HsUnitId PackageName -> HsUnitId HsComponentId
    renameHsUnitId (IncludeDecl PackageName
    -> GenLocated SrcSpan (HsUnitId PackageName)
    forall n. IncludeDecl n -> LHsUnitId n
    idUnitId IncludeDecl PackageName
    idecl),
                idModRenaming :: Maybe [LRenaming]
    idModRenaming = IncludeDecl PackageName -> Maybe [LRenaming]
    forall n. IncludeDecl n -> Maybe [LRenaming]
    idModRenaming IncludeDecl PackageName
    idecl,
                idSignatureInclude :: Bool
    idSignatureInclude = IncludeDecl PackageName -> Bool
    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)
            = GenLocated SrcSpan HsComponentId
    -> [LHsModuleSubst HsComponentId] -> HsUnitId HsComponentId
    forall n. Located n -> [LHsModuleSubst n] -> HsUnitId n
    HsUnitId ((PackageName -> HsComponentId)
    -> GenLocated SrcSpan PackageName
    -> GenLocated SrcSpan HsComponentId
    forall a b.
    (a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap PackageName -> HsComponentId
    renamePackageName GenLocated SrcSpan PackageName
    ln) ((LHsModuleSubst PackageName -> LHsModuleSubst HsComponentId)
    -> [LHsModuleSubst PackageName] -> [LHsModuleSubst HsComponentId]
    forall a b. (a -> b) -> [a] -> [b]
    map ((HsModuleSubst PackageName -> HsModuleSubst HsComponentId)
    -> LHsModuleSubst PackageName -> LHsModuleSubst HsComponentId
    forall a b.
    (a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan b
    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 (Located ModuleName
    lk, LHsModuleId PackageName
    lm)
            = (Located ModuleName
    lk, (HsModuleId PackageName -> HsModuleId HsComponentId)
    -> LHsModuleId PackageName
    -> GenLocated SrcSpan (HsModuleId HsComponentId)
    forall a b.
    (a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan b
    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 Located ModuleName
    lm) = Located ModuleName -> HsModuleId HsComponentId
    forall n. Located ModuleName -> HsModuleId n
    HsModuleVar Located ModuleName
    lm
        renameHsModuleId (HsModuleId GenLocated SrcSpan (HsUnitId PackageName)
    luid Located ModuleName
    lm) = GenLocated SrcSpan (HsUnitId HsComponentId)
    -> Located ModuleName -> HsModuleId HsComponentId
    forall n. LHsUnitId n -> Located ModuleName -> HsModuleId n
    HsModuleId ((HsUnitId PackageName -> HsUnitId HsComponentId)
    -> GenLocated SrcSpan (HsUnitId PackageName)
    -> GenLocated SrcSpan (HsUnitId HsComponentId)
    forall a b.
    (a -> b) -> GenLocated SrcSpan a -> GenLocated SrcSpan b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap HsUnitId PackageName -> HsUnitId HsComponentId
    renameHsUnitId GenLocated SrcSpan (HsUnitId PackageName)
    luid) Located ModuleName
    lm

    convertHsComponentId :: HsUnitId HsComponentId -> Unit
    convertHsComponentId :: HsUnitId HsComponentId -> Unit
    convertHsComponentId (HsUnitId (L SrcSpan
    _ HsComponentId
    hscid) [LHsModuleSubst HsComponentId]
    subst)
        = UnitId -> [(ModuleName, Module)] -> Unit
    forall u.
    IsUnitId u =>
    u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
    mkVirtUnit (HsComponentId -> UnitId
    hsComponentId HsComponentId
    hscid) ((LHsModuleSubst HsComponentId -> (ModuleName, Module))
    -> [LHsModuleSubst HsComponentId] -> [(ModuleName, Module)]
    forall a b. (a -> b) -> [a] -> [b]
    map (HsModuleSubst HsComponentId -> (ModuleName, Module)
    convertHsModuleSubst (HsModuleSubst HsComponentId -> (ModuleName, Module))
    -> (LHsModuleSubst HsComponentId -> HsModuleSubst HsComponentId)
    -> LHsModuleSubst HsComponentId
    -> (ModuleName, Module)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LHsModuleSubst HsComponentId -> HsModuleSubst HsComponentId
    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)) = ModuleName -> Module
    forall u. ModuleName -> GenModule (GenUnit u)
    mkHoleModule ModuleName
    modname
    convertHsModuleId (HsModuleId (L SrcSpan
    _ HsUnitId HsComponentId
    hsuid) (L SrcSpan
    _ ModuleName
    modname)) = Unit -> ModuleName -> Module
    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 :: Bool -> HsUnit HsComponentId -> BkpM ModuleGraph
    hsunitModuleGraph :: Bool -> HsUnit HsComponentId -> BkpM ModuleGraph
    hsunitModuleGraph Bool
    do_link HsUnit HsComponentId
    unit = do
        hsc_env <- IOEnv BkpEnv HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession

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

            sig_keys = (((ModuleName, Module) -> NodeKey)
     -> [(ModuleName, Module)] -> [NodeKey])
    -> [(ModuleName, Module)]
    -> ((ModuleName, Module) -> NodeKey)
    -> [NodeKey]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ((ModuleName, Module) -> NodeKey)
    -> [(ModuleName, Module)] -> [NodeKey]
    forall a b. (a -> b) -> [a] -> [b]
    map (GenHomeUnit UnitId -> [(ModuleName, Module)]
    forall u. GenHomeUnit u -> GenInstantiations u
    homeUnitInstantiations GenHomeUnit UnitId
    home_unit) (((ModuleName, Module) -> NodeKey) -> [NodeKey])
    -> ((ModuleName, Module) -> NodeKey) -> [NodeKey]
    forall a b. (a -> b) -> a -> b
    $ \(ModuleName
    mod_name, Module
    _) -> ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
    ModNodeKeyWithUid (ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB ModuleName
    mod_name IsBootInterface
    NotBoot) (GenHomeUnit UnitId -> UnitId
    forall u. GenHomeUnit u -> UnitId
    homeUnitId GenHomeUnit UnitId
    home_unit))
            keys = [ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
    ModNodeKeyWithUid ModuleNameWithIsBoot
    gwib (GenHomeUnit UnitId -> UnitId
    forall u. GenHomeUnit u -> UnitId
    homeUnitId GenHomeUnit UnitId
    home_unit)) | (DeclD HscSource
    hsc_src Located ModuleName
    lmodname Located (HsModule GhcPs)
    _) <- (GenLocated SrcSpan (HsUnitDecl HsComponentId)
     -> HsUnitDecl HsComponentId)
    -> [GenLocated SrcSpan (HsUnitDecl HsComponentId)]
    -> [HsUnitDecl HsComponentId]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpan (HsUnitDecl HsComponentId)
    -> HsUnitDecl HsComponentId
    forall l e. GenLocated l e -> e
    unLoc [GenLocated SrcSpan (HsUnitDecl HsComponentId)]
    decls, let gwib :: ModuleNameWithIsBoot
    gwib = ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB (Located ModuleName -> ModuleName
    forall l e. GenLocated l e -> e
    unLoc Located ModuleName
    lmodname) (HscSource -> IsBootInterface
    hscSourceToIsBoot HscSource
    hsc_src) ]

        --  1. Create a HsSrcFile/HsigFile summary for every
        --  explicitly mentioned module/signature.
        let get_decl (L SrcSpan
    _ (DeclD HscSource
    hsc_src Located ModuleName
    lmodname Located (HsModule GhcPs)
    hsmod)) =
              ModuleGraphNode -> Maybe ModuleGraphNode
    forall a. a -> Maybe a
    Just (ModuleGraphNode -> Maybe ModuleGraphNode)
    -> IOEnv BkpEnv ModuleGraphNode
    -> IOEnv BkpEnv (Maybe ModuleGraphNode)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PackageName
    -> HscSource
    -> Located ModuleName
    -> Located (HsModule GhcPs)
    -> [NodeKey]
    -> IOEnv BkpEnv ModuleGraphNode
    summariseDecl PackageName
    pn HscSource
    hsc_src Located ModuleName
    lmodname Located (HsModule GhcPs)
    hsmod ([NodeKey]
    keys [NodeKey] -> [NodeKey] -> [NodeKey]
    forall a. [a] -> [a] -> [a]
    ++ [NodeKey]
    sig_keys)
            get_decl GenLocated SrcSpan (HsUnitDecl HsComponentId)
    _ = Maybe ModuleGraphNode -> IOEnv BkpEnv (Maybe ModuleGraphNode)
    forall a. a -> IOEnv BkpEnv a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ModuleGraphNode
    forall a. Maybe a
    Nothing
        nodes <- mapMaybeM get_decl 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 = [ModuleName] -> Set ModuleName
    forall a. Ord a => [a] -> Set a
    Set.fromList
              [ ModSummary -> ModuleName
    ms_mod_name ModSummary
    ms
              | ModuleNode [NodeKey]
    _ ModSummary
    ms <- [ModuleGraphNode]
    nodes
              , ModSummary -> HscSource
    ms_hsc_src ModSummary
    ms HscSource -> HscSource -> Bool
    forall a. Eq a => a -> a -> Bool
    == HscSource
    HsigFile
              ]
        req_nodes <- fmap catMaybes . forM (homeUnitInstantiations home_unit) $ \(ModuleName
    mod_name, Module
    _) ->
            if ModuleName -> Set ModuleName -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member ModuleName
    mod_name Set ModuleName
    hsig_set
                then Maybe ModuleGraphNode -> IOEnv BkpEnv (Maybe ModuleGraphNode)
    forall a. a -> IOEnv BkpEnv a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ModuleGraphNode
    forall a. Maybe a
    Nothing
                else (ModuleGraphNode -> Maybe ModuleGraphNode)
    -> IOEnv BkpEnv ModuleGraphNode
    -> IOEnv BkpEnv (Maybe ModuleGraphNode)
    forall a b. (a -> b) -> IOEnv BkpEnv a -> IOEnv BkpEnv b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ModuleGraphNode -> Maybe ModuleGraphNode
    forall a. a -> Maybe a
    Just (IOEnv BkpEnv ModuleGraphNode
     -> IOEnv BkpEnv (Maybe ModuleGraphNode))
    -> IOEnv BkpEnv ModuleGraphNode
    -> IOEnv BkpEnv (Maybe ModuleGraphNode)
    forall a b. (a -> b) -> a -> b
    $ PackageName -> ModuleName -> IOEnv BkpEnv ModuleGraphNode
    summariseRequirement PackageName
    pn ModuleName
    mod_name

        let graph_nodes = [ModuleGraphNode]
    nodes [ModuleGraphNode] -> [ModuleGraphNode] -> [ModuleGraphNode]
    forall a. [a] -> [a] -> [a]
    ++ [ModuleGraphNode]
    req_nodes [ModuleGraphNode] -> [ModuleGraphNode] -> [ModuleGraphNode]
    forall a. [a] -> [a] -> [a]
    ++ (UnitId -> UnitState -> [ModuleGraphNode]
    instantiationNodes (GenHomeUnit UnitId -> UnitId
    forall u. GenHomeUnit u -> UnitId
    homeUnitId (GenHomeUnit UnitId -> UnitId) -> GenHomeUnit UnitId -> UnitId
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> GenHomeUnit UnitId
    hsc_home_unit HscEnv
    hsc_env) (HasDebugCallStack => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units HscEnv
    hsc_env))
            key_nodes = (ModuleGraphNode -> NodeKey) -> [ModuleGraphNode] -> [NodeKey]
    forall a b. (a -> b) -> [a] -> [b]
    map ModuleGraphNode -> NodeKey
    mkNodeKey [ModuleGraphNode]
    graph_nodes
            all_nodes = [ModuleGraphNode]
    graph_nodes [ModuleGraphNode] -> [ModuleGraphNode] -> [ModuleGraphNode]
    forall a. [a] -> [a] -> [a]
    ++ [[NodeKey] -> UnitId -> ModuleGraphNode
    LinkNode [NodeKey]
    key_nodes (GenHomeUnit UnitId -> UnitId
    forall u. GenHomeUnit u -> UnitId
    homeUnitId (GenHomeUnit UnitId -> UnitId) -> GenHomeUnit UnitId -> UnitId
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> GenHomeUnit UnitId
    hsc_home_unit HscEnv
    hsc_env) | Bool
    do_link]
        -- This error message is not very good but .bkp mode is just for testing so
        -- better to be direct rather than pretty.
        when
          (length key_nodes /= length (ordNub key_nodes))
          (pprPanic "Duplicate nodes keys in backpack file" (ppr key_nodes))

        -- 3. Return the kaboodle
        return $ mkModuleGraph $ all_nodes

    summariseRequirement :: PackageName -> ModuleName -> BkpM ModuleGraphNode
    summariseRequirement :: PackageName -> ModuleName -> IOEnv BkpEnv ModuleGraphNode
    summariseRequirement PackageName
    pn ModuleName
    mod_name = do
        hsc_env <- IOEnv BkpEnv HscEnv
    forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
        let dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        let home_unit = HscEnv -> GenHomeUnit UnitId
    hsc_home_unit HscEnv
    hsc_env
        let fopts = DynFlags -> FinderOpts
    initFinderOpts DynFlags
    dflags

        let PackageName pn_fs = pn
        let location = FinderOpts -> ModuleName -> FilePath -> FilePath -> ModLocation
    mkHomeModLocation2 FinderOpts
    fopts ModuleName
    mod_name
                        (FastString -> FilePath
    unpackFS FastString
    pn_fs FilePath -> FilePath -> FilePath
    </> ModuleName -> FilePath
    moduleNameSlashes ModuleName
    mod_name) FilePath
    "hsig"

        env <- getBkpEnv
        src_hash <- liftIO $ getFileHash (bkp_filename env)
        hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location)
        hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location)
        let loc = SrcLoc -> SrcSpan
    srcLocSpan (FastString -> Int -> Int -> SrcLoc
    mkSrcLoc (FilePath -> FastString
    mkFastString (BkpEnv -> FilePath
    bkp_filename BkpEnv
    env)) Int
    1 Int
    1)

        let fc = HscEnv -> FinderCache
    hsc_FC HscEnv
    hsc_env
        mod <- liftIO $ addHomeModuleToFinder fc home_unit mod_name location

        extra_sig_imports <- liftIO $ findExtraSigImports hsc_env HsigFile mod_name

        let ms = 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_hash :: Fingerprint
    ms_hs_hash = Fingerprint
    src_hash,
            ms_obj_date :: Maybe UTCTime
    ms_obj_date = Maybe UTCTime
    forall a. Maybe a
    Nothing,
            ms_dyn_obj_date :: Maybe UTCTime
    ms_dyn_obj_date = Maybe UTCTime
    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 :: [(PkgQual, Located ModuleName)]
    ms_srcimps = [],
            ms_textual_imps :: [(PkgQual, Located ModuleName)]
    ms_textual_imps = ((,) PkgQual
    NoPkgQual (Located ModuleName -> (PkgQual, Located ModuleName))
    -> (ModuleName -> Located ModuleName)
    -> ModuleName
    -> (PkgQual, Located ModuleName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleName -> Located ModuleName
    forall e. e -> Located e
    noLoc) (ModuleName -> (PkgQual, Located ModuleName))
    -> [ModuleName] -> [(PkgQual, Located ModuleName)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [ModuleName]
    extra_sig_imports,
            ms_ghc_prim_import :: Bool
    ms_ghc_prim_import = Bool
    False,
            ms_parsed_mod :: Maybe HsParsedModule
    ms_parsed_mod = HsParsedModule -> Maybe HsParsedModule
    forall a. a -> Maybe a
    Just (HsParsedModule {
                    hpm_module :: Located (HsModule GhcPs)
    hpm_module = SrcSpan -> HsModule GhcPs -> Located (HsModule GhcPs)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc (HsModule {
                            hsmodExt :: XCModule GhcPs
    hsmodExt = XModulePs {
                                hsmodAnn :: EpAnn AnnsModule
    hsmodAnn = EpAnn AnnsModule
    forall a. NoAnn a => a
    noAnn,
                                hsmodLayout :: EpLayout
    hsmodLayout = EpLayout
    EpNoLayout,
                                hsmodDeprecMessage :: Maybe (LWarningTxt GhcPs)
    hsmodDeprecMessage = Maybe (LWarningTxt GhcPs)
    Maybe (GenLocated SrcSpanAnnP (WarningTxt GhcPs))
    forall a. Maybe a
    Nothing,
                                hsmodHaddockModHeader :: Maybe (LHsDoc GhcPs)
    hsmodHaddockModHeader = Maybe (LHsDoc GhcPs)
    forall a. Maybe a
    Nothing
                                                 },
                            hsmodName :: Maybe (XRec GhcPs ModuleName)
    hsmodName = GenLocated SrcSpanAnnA ModuleName
    -> Maybe (GenLocated SrcSpanAnnA ModuleName)
    forall a. a -> Maybe a
    Just (SrcSpanAnnA -> ModuleName -> GenLocated SrcSpanAnnA ModuleName
    forall l e. l -> e -> GenLocated l e
    L (SrcSpan -> SrcSpanAnnA
    forall e. HasAnnotation e => SrcSpan -> e
    noAnnSrcSpan SrcSpan
    loc) ModuleName
    mod_name),
                            hsmodExports :: Maybe (XRec GhcPs [LIE GhcPs])
    hsmodExports = Maybe (XRec GhcPs [LIE GhcPs])
    Maybe (GenLocated SrcSpanAnnL [GenLocated SrcSpanAnnA (IE GhcPs)])
    forall a. Maybe a
    Nothing,
                            hsmodImports :: [LImportDecl GhcPs]
    hsmodImports = [],
                            hsmodDecls :: [LHsDecl GhcPs]
    hsmodDecls = []
                        }),
                    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 = Maybe StringBuffer
    forall a. Maybe a
    Nothing
            }
        let nodes = [ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
    ModNodeKeyWithUid (ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB ModuleName
    mn IsBootInterface
    NotBoot) (GenHomeUnit UnitId -> UnitId
    forall u. GenHomeUnit u -> UnitId
    homeUnitId GenHomeUnit UnitId
    home_unit)) | ModuleName
    mn <- [ModuleName]
    extra_sig_imports ]
        return (ModuleNode nodes ms)

    summariseDecl :: PackageName
                  -> HscSource
                  -> Located ModuleName
                  -> Located (HsModule GhcPs)
                  -> [NodeKey]
                  -> BkpM ModuleGraphNode
    summariseDecl :: PackageName
    -> HscSource
    -> Located ModuleName
    -> Located (HsModule GhcPs)
    -> [NodeKey]
    -> IOEnv BkpEnv ModuleGraphNode
    summariseDecl PackageName
    pn HscSource
    hsc_src (L SrcSpan
    _ ModuleName
    modname) Located (HsModule GhcPs)
    hsmod [NodeKey]
    home_keys = [NodeKey]
    -> PackageName
    -> HscSource
    -> ModuleName
    -> Located (HsModule GhcPs)
    -> IOEnv BkpEnv ModuleGraphNode
    hsModuleToModSummary [NodeKey]
    home_keys PackageName
    pn HscSource
    hsc_src ModuleName
    modname Located (HsModule GhcPs)
    hsmod

    -- | 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 :: [NodeKey]
                         -> PackageName
                         -> HscSource
                         -> ModuleName
                         -> Located (HsModule GhcPs)
                         -> BkpM ModuleGraphNode
    hsModuleToModSummary :: [NodeKey]
    -> PackageName
    -> HscSource
    -> ModuleName
    -> Located (HsModule GhcPs)
    -> IOEnv BkpEnv ModuleGraphNode
    hsModuleToModSummary [NodeKey]
    home_keys PackageName
    pn HscSource
    hsc_src ModuleName
    modname
                         Located (HsModule GhcPs)
    hsmod = do
        let imps :: [LImportDecl GhcPs]
    imps = HsModule GhcPs -> [LImportDecl GhcPs]
    forall p. HsModule p -> [LImportDecl p]
    hsmodImports (Located (HsModule GhcPs) -> HsModule GhcPs
    forall l e. GenLocated l e -> e
    unLoc Located (HsModule GhcPs)
    hsmod)
            loc :: SrcSpan
    loc  = Located (HsModule GhcPs) -> SrcSpan
    forall l e. GenLocated l e -> l
    getLoc Located (HsModule GhcPs)
    hsmod
        hsc_env <- IOEnv BkpEnv HscEnv
    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 unit_fs = pn
            dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
            fopts = DynFlags -> FinderOpts
    initFinderOpts DynFlags
    dflags
        -- 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!
        let location0 = FinderOpts -> ModuleName -> FilePath -> FilePath -> ModLocation
    mkHomeModLocation2 FinderOpts
    fopts 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 = 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
        hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location)
        hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location)

        -- Also copied from 'getImports'
        let (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps

                 -- GHC.Prim doesn't exist physically, so don't go looking for it.
            (ordinary_imps, ghc_prim_import)
              = partition ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc)
                  ord_idecls

            implicit_prelude = Extension -> DynFlags -> Bool
    xopt Extension
    LangExt.ImplicitPrelude DynFlags
    dflags
            implicit_imports = ModuleName
    -> SrcSpan -> Bool -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
    mkPrelImports ModuleName
    modname SrcSpan
    loc
                                             Bool
    implicit_prelude [LImportDecl GhcPs]
    imps

            rn_pkg_qual = UnitEnv -> ModuleName -> RawPkgQual -> PkgQual
    renameRawPkgQual (HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env) ModuleName
    modname
            convImport (L SrcSpanAnnA
    _ ImportDecl GhcPs
    i) = (RawPkgQual -> PkgQual
    rn_pkg_qual (ImportDecl GhcPs -> ImportDeclPkgQual GhcPs
    forall pass. ImportDecl pass -> ImportDeclPkgQual pass
    ideclPkgQual ImportDecl GhcPs
    i), GenLocated SrcSpanAnnA ModuleName -> Located ModuleName
    forall a e b.
    (HasLoc (GenLocated a e), HasAnnotation b) =>
    GenLocated a e -> GenLocated b e
    reLoc (GenLocated SrcSpanAnnA ModuleName -> Located ModuleName)
    -> GenLocated SrcSpanAnnA ModuleName -> Located ModuleName
    forall a b. (a -> b) -> a -> b
    $ ImportDecl GhcPs -> XRec GhcPs ModuleName
    forall pass. ImportDecl pass -> XRec pass ModuleName
    ideclName ImportDecl GhcPs
    i)

        extra_sig_imports <- liftIO $ findExtraSigImports hsc_env hsc_src modname

        let normal_imports = (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
     -> (PkgQual, Located ModuleName))
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> [(PkgQual, Located ModuleName)]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> (PkgQual, Located ModuleName)
    convImport ([LImportDecl GhcPs]
    [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    implicit_imports [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    forall a. [a] -> [a] -> [a]
    ++ [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    ordinary_imps)
        (implicit_sigs, inst_deps) <- liftIO $ implicitRequirementsShallow hsc_env normal_imports

        -- So that Finder can find it, even though it doesn't exist...
        this_mod <- liftIO $ do
          let home_unit = HscEnv -> GenHomeUnit UnitId
    hsc_home_unit HscEnv
    hsc_env
          let fc        = HscEnv -> FinderCache
    hsc_FC HscEnv
    hsc_env
          addHomeModuleToFinder fc home_unit modname location
        let ms = 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 = Maybe StringBuffer
    forall a. Maybe a
    Nothing,
                ms_srcimps :: [(PkgQual, Located ModuleName)]
    ms_srcimps = (GenLocated SrcSpanAnnA (ImportDecl GhcPs)
     -> (PkgQual, Located ModuleName))
    -> [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    -> [(PkgQual, Located ModuleName)]
    forall a b. (a -> b) -> [a] -> [b]
    map GenLocated SrcSpanAnnA (ImportDecl GhcPs)
    -> (PkgQual, Located ModuleName)
    convImport [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    src_idecls,
                ms_ghc_prim_import :: Bool
    ms_ghc_prim_import = Bool -> Bool
    not ([GenLocated SrcSpanAnnA (ImportDecl GhcPs)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [GenLocated SrcSpanAnnA (ImportDecl GhcPs)]
    ghc_prim_import),
                ms_textual_imps :: [(PkgQual, Located ModuleName)]
    ms_textual_imps = [(PkgQual, Located ModuleName)]
    normal_imports
                               -- We have to do something special here:
                               -- due to merging, requirements may end up with
                               -- extra imports
                               [(PkgQual, Located ModuleName)]
    -> [(PkgQual, Located ModuleName)]
    -> [(PkgQual, Located ModuleName)]
    forall a. [a] -> [a] -> [a]
    ++ ((,) PkgQual
    NoPkgQual (Located ModuleName -> (PkgQual, Located ModuleName))
    -> (ModuleName -> Located ModuleName)
    -> ModuleName
    -> (PkgQual, Located ModuleName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleName -> Located ModuleName
    forall e. e -> Located e
    noLoc (ModuleName -> (PkgQual, Located ModuleName))
    -> [ModuleName] -> [(PkgQual, Located ModuleName)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [ModuleName]
    extra_sig_imports)
                               [(PkgQual, Located ModuleName)]
    -> [(PkgQual, Located ModuleName)]
    -> [(PkgQual, Located ModuleName)]
    forall a. [a] -> [a] -> [a]
    ++ ((,) PkgQual
    NoPkgQual (Located ModuleName -> (PkgQual, Located ModuleName))
    -> (ModuleName -> Located ModuleName)
    -> ModuleName
    -> (PkgQual, Located ModuleName)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ModuleName -> Located ModuleName
    forall e. e -> Located e
    noLoc (ModuleName -> (PkgQual, Located ModuleName))
    -> [ModuleName] -> [(PkgQual, Located ModuleName)]
    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 = HsParsedModule -> Maybe HsParsedModule
    forall a. a -> Maybe a
    Just (HsParsedModule {
                        hpm_module :: Located (HsModule GhcPs)
    hpm_module = Located (HsModule GhcPs)
    hsmod,
                        hpm_src_files :: [FilePath]
    hpm_src_files = [] -- TODO if we preprocessed it
                    }),
                -- Source hash = fingerprint0, so the recompilation tests do not recompile
                -- too much. In future, if necessary then could get the hash by just hashing the
                -- relevant part of the .bkp file.
                ms_hs_hash :: Fingerprint
    ms_hs_hash = Fingerprint
    fingerprint0,
                ms_obj_date :: Maybe UTCTime
    ms_obj_date = Maybe UTCTime
    forall a. Maybe a
    Nothing, -- TODO do this, but problem: hi_timestamp is BOGUS
                ms_dyn_obj_date :: Maybe UTCTime
    ms_dyn_obj_date = Maybe UTCTime
    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
              }

        -- Now, what are the dependencies.
        let inst_nodes = (GenInstantiatedUnit UnitId -> NodeKey)
    -> [GenInstantiatedUnit UnitId] -> [NodeKey]
    forall a b. (a -> b) -> [a] -> [b]
    map GenInstantiatedUnit UnitId -> NodeKey
    NodeKey_Unit [GenInstantiatedUnit UnitId]
    inst_deps
            mod_nodes  =
              -- hs-boot edge
              [NodeKey
    k | NodeKey
    k <- [ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
    ModNodeKeyWithUid (ModuleName -> IsBootInterface -> ModuleNameWithIsBoot
    forall mod. mod -> IsBootInterface -> GenWithIsBoot mod
    GWIB (ModSummary -> ModuleName
    ms_mod_name ModSummary
    ms) IsBootInterface
    IsBoot)  (Module -> UnitId
    moduleUnitId Module
    this_mod))], IsBootInterface
    NotBoot IsBootInterface -> IsBootInterface -> Bool
    forall a. Eq a => a -> a -> Bool
    == ModSummary -> IsBootInterface
    isBootSummary ModSummary
    ms,  NodeKey
    k NodeKey -> [NodeKey] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [NodeKey]
    home_keys ] [NodeKey] -> [NodeKey] -> [NodeKey]
    forall a. [a] -> [a] -> [a]
    ++
              -- Normal edges
              [NodeKey
    k | (PkgQual
    _, GenWithIsBoot (Located ModuleName)
    mnwib) <- ModSummary -> [(PkgQual, GenWithIsBoot (Located ModuleName))]
    msDeps ModSummary
    ms, let k :: NodeKey
    k = ModNodeKeyWithUid -> NodeKey
    NodeKey_Module (ModuleNameWithIsBoot -> UnitId -> ModNodeKeyWithUid
    ModNodeKeyWithUid ((Located ModuleName -> ModuleName)
    -> GenWithIsBoot (Located ModuleName) -> ModuleNameWithIsBoot
    forall a b. (a -> b) -> GenWithIsBoot a -> GenWithIsBoot b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Located ModuleName -> ModuleName
    forall l e. GenLocated l e -> e
    unLoc GenWithIsBoot (Located ModuleName)
    mnwib) (Module -> UnitId
    moduleUnitId Module
    this_mod)), NodeKey
    k NodeKey -> [NodeKey] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [NodeKey]
    home_keys]

        return (ModuleNode (mod_nodes ++ inst_nodes) ms)

    -- | Create a new, externally provided hashed unit id from
    -- a hash.
    newUnitId :: UnitId -> Maybe FastString -> UnitId
    newUnitId :: UnitId -> Maybe FastString -> UnitId
    newUnitId UnitId
    uid Maybe FastString
    mhash = case Maybe FastString
    mhash of
       Maybe FastString
    Nothing   -> UnitId
    uid
       Just FastString
    hash -> FastString -> UnitId
    UnitId ([FastString] -> FastString
    concatFS [UnitId -> FastString
    unitIdFS UnitId
    uid, FilePath -> FastString
    fsLit FilePath
    "+", FastString
    hash])