logger <- getLogger

   hsc_env <- getSession

   updated_dflags <- liftIO $ updatePlatformConstants dflags1 mconstants

   let upd hue =

               old_hpt = homeUnitEnv_hpt homeUnitEnv

               home_units = HUG.allUnits (ue_home_unit_graph old_unit_env)

           updated_dflags <- liftIO $ updatePlatformConstants dflags0 mconstants

           pure HomeUnitEnv

               , ue_current_unit    = ue_currentUnit old_unit_env

               , ue_module_graph    = ue_module_graph old_unit_env

               , ue_eps             = ue_eps old_unit_env

               , ue_uic      = ue_uic old_unit_env

               }

         modifySession $ \h -> hscSetFlags dflags1 h{ hsc_unit_env = unit_env }

             , ue_current_unit    = ue_currentUnit unit_env0

             , ue_eps             = ue_eps unit_env0

             , ue_module_graph    = ue_module_graph unit_env0

             , ue_uic      = ue_uic unit_env0

             }

       modifySession $ \h ->

           old_hpt = homeUnitEnv_hpt homeUnitEnv

           home_units = HUG.allUnits (ue_home_unit_graph unit_env)

       updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants

       pure HomeUnitEnv

 import qualified GHC.Unit.Home.Graph as HUG

 import GHC.Unit.Home.ModInfo

 import GHC.Unit.Home.PackageTable

 -- | Entry point to compile a Backpack file.

 doBackpack :: [FilePath] -> Ghc ()

           { unitDatabasePath  = unsafeEncodeUtf $ "(in memory " ++ showSDoc dflags (ppr (unitId u)) ++ ")"

           , unitDatabaseUnits = [u]

           }

     -- added at the end because ordering matters

     pure dflags

           { packageDBFlags = packageDBFlags dflags ++ [PackageDB (PkgDbPath (unitDatabasePath newdb))]

     logger <- getLogger

     let dflags0 = hsc_dflags hsc_env

     let old_unit_env = hsc_unit_env hsc_env

     dflags1 <- addInMemoryDatabase dflags0 u

     -- update platform constants

                     (HUG.mkHomeUnitEnv unit_state dflags (ue_hpt old_unit_env) (Just home_unit))

           , ue_eps       = ue_eps old_unit_env

           , ue_module_graph = ue_module_graph old_unit_env

           , ue_uic = ue_uic old_unit_env

           }

     setSession $ hscSetFlags dflags $ hsc_env { hsc_unit_env = unit_env }

    , hsc_HUG

    , hsc_all_home_unit_ids

    , hscUnitIndex

    , hscUpdateLoggerFlags

    , hscUpdateHUG

    , hscInsertHPT

    , runInteractiveHsc

    , hscEPS

    , hscEUD

    , hscInterp

    , prepareAnnotations

    , discardIC

 hscEPS hsc_env = readIORef (euc_eps (ue_eps (hsc_unit_env hsc_env)))

 hscEUD :: HscEnv -> IO (ExternalUnitDatabases UnitId)

 hscUnitIndex :: HscEnv -> IO UnitIndex

 hscUnitIndex hsc_env = ueUI (hsc_unit_env hsc_env)

   home_unit_graph <- forM initial_home_graph $ \homeUnitEnv -> do

     let hue_flags = homeUnitEnv_dflags homeUnitEnv

         dflags = homeUnitEnv_dflags homeUnitEnv

     updated_dflags <- liftIO $ updatePlatformConstants dflags mconstants

     emptyHpt <- liftIO $ emptyHomePackageTable

     , ue_namever   :: !GhcNameVersion

         -- ^ GHC name/version (used for dynamic library suffix)

     , ue_uic :: {-# UNPACK #-} !UnitIndexCache

     }

 ueEPS :: UnitEnv -> IO ExternalPackageState

 ueEPS = eucEPS . ue_eps

 ueEUD :: UnitEnv -> IO (ExternalUnitDatabases UnitId)

 ueUI :: UnitEnv -> IO UnitIndex

 ueUI = readUnitIndex . ue_uic

 initUnitEnv :: UnitId -> HomeUnitGraph -> GhcNameVersion -> Platform -> IO UnitEnv

 initUnitEnv cur_unit hug namever platform = do

   eps <- initExternalUnitCache

   uic <- initUnitIndexCache

   return $ UnitEnv

     { ue_eps             = eps

     , ue_current_unit    = cur_unit

     , ue_platform        = platform

     , ue_namever         = namever

     , ue_uic      = uic

     }

 module GHC.Unit.External.Database (

   -- * 'ExternalUnitDatabases'

   ExternalUnitDatabases,

   emptyExternalUnitDatabases,

   insertExternalUnitDatabases,

   deleteExternalUnitDatabases,

   lookupExternalUnitDatabases,

   UnitDatabase (..),

   mergeDatabases,

   UnitPrecedenceMap,

   compareByPreference,

   -- * Reading packages from disk.

   UnitDbConfig (..),

   readUnitDatabase,

   getUnitDbRefs,

   resolveUnitDatabase,

 import Control.Monad

 import Data.Char

 import Data.List (sortBy)

 import Data.Map.Strict (Map)

 import Data.Map.Strict qualified as Map

 import System.Environment (getEnv)

 import System.FilePath as FilePath

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

 -- ExternalUnitDatabases

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

   , unitDbConfigGHCDir :: FilePath

   }

 getUnitDbRefs :: UnitDbConfig -> IO [PkgDbRef]

 getUnitDbRefs cfg = do

   let system_conf_refs = [UserPkgDb, GlobalPkgDb]

   if exist then return (OsPath.unsafeEncodeUtf pkgconf) else mzero

 resolveUnitDatabase _ (PkgDbPath name) = return $ Just name

 -- | Read the 'UnitDatabase' at the given location.

 readUnitDatabase :: Logger -> UnitDbConfig -> OsPath -> IO (UnitDatabase UnitId)

 readUnitDatabase logger cfg conf_file = do

   readUnitIndex,

   modifyUnitIndexCache,

   clearUnitIndexCache,

   -- * 'UnitIndex'

   UnitIndex,

   emptyUnitIndex,

   wiringMap,

   unwiringMap,

   globalUnits,

   setWireMap,

   wireMapExists,

   addUnitInfoMap,

   updateWiredInUnits,

   updateWiredInUnitsInUnitInfo,

   updateWiredInUnitIdInModule,

 ) where

 import GHC.Prelude

 import GHC.Data.ShortText qualified as ST

 import GHC.Types.Unique.Map

 import GHC.Unit.Database

 import GHC.Unit.Types

 import GHC.Utils.Logger

 import Data.Either

 import Data.IORef (IORef)

 import Data.IORef qualified as IORef

 import Data.Map.Strict (Map)

 import Data.Map.Strict qualified as Map

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

 -- UnitIndex

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

 -- | Mutable version of 'UnitIndex'.

 newtype UnitIndexCache = UnitIndexCache

   { uic_index :: IORef UnitIndex

   }

   UnitIndexCache <$> IORef.newIORef emptyUnitIndex

 readUnitIndex :: UnitIndexCache -> IO UnitIndex

 modifyUnitIndexCache :: UnitIndexCache -> (UnitIndex -> UnitIndex) -> IO ()

 clearUnitIndexCache :: UnitIndexCache -> IO ()

 -- | Global index for external units that can be shared across multiple 'HomeUnitEnv's.

 --

 -- Allows sharing of the 'WireMap' and 'UnitInfo's that are stored in the 'UnitState'

 -- of each 'HomeUnitEnv'.

 data UnitIndex = UnitIndex

   { ui_wireMap :: !WireMap

     -- ^ A mapping from database unit keys to wired in unit ids.

   , ui_unitInfoMap :: !GlobalUnitInfoMap

     -- ^ A global map for all fully-resolved 'UnitInfo's.

     --

   }

 -- | Get the 'WireMap'.

 unwiringMap :: UnitIndex -> UnwireMap

 unwiringMap = ui_unwireMap

 -- | Access the global map of fully-resolved 'UnitInfo's.

 globalUnits :: UnitIndex -> GlobalUnitInfoMap

 globalUnits = ui_unitInfoMap

   { ui_wireMap = emptyWireMap

   , ui_unwireMap = emptyUnwireMap

   , ui_unitInfoMap = emptyGlobalUnitInfoMap

   }

 -- | Set the 'WireMap' of 'UnitIndex'.

 --

 -- However, a user can choose a conflicting 'UnitId', causing a conflict after all.

 -- We use the 'UnitAbiHash' for disambiguation. If both 'UnitId' and 'UnitAbiHash' are

 newtype GlobalUnitInfoMap = GlobalUnitInfoMap (UniqMap UnitId (Map UnitAbiHash UnitInfo))

 -- | Lookup the 'UnitInfo' in the 'GlobalUnitInfoMap'.

 upd_wired_in wiredInMap key

     | Just key' <- lookupWireMap key wiredInMap = key'

     | otherwise = key

         module GHC.Unit.Info,

         -- * Reading the package config, and processing cmdline args

         UnitState(..),

         UnitDatabase (..),

         UnitErr (..),

         emptyUnitState,

         getUnitDbRefs,

         resolveUnitDatabase,

         listUnitInfo,

         -- * Querying the package config

         lookupUnit,

         lookupUnit',

   | Distrusted

   deriving ( Eq, Ord )

 newtype TrustOverlay = TrustOverlay

   { trustOverlay :: UniqMap UnitId IsTrusted

   }

 lookupTrustOverlay :: TrustOverlay -> UnitId -> Maybe IsTrusted

 distrustUnits :: [UnitId] -> TrustOverlay -> TrustOverlay

 distrustUnits elements (TrustOverlay to) = TrustOverlay $ foldl' (\ acc uid -> addToUniqMap acc uid Distrusted) to elements

 emptyTrustOverlay :: TrustOverlay

 emptyTrustOverlay = TrustOverlay emptyUniqMap

 data UnitState = UnitState {

   -- | A mapping of 'Unit' to 'UnitInfo'.  This list is adjusted

   -- so that only valid units are here.  'UnitInfo' reflects

   -- may have the 'exposed' flag be 'False'.)

   --

   -- All values are shared with 'UnitIndex'.'globalUnits'.

   unitInfoMap :: UnitInfoMap,

   -- | Set of units that we trust.

   -- Local overlay of 'UnitInfo'.

   -- This avoids modifying the 'UnitInfo' directly, potentially saving

   -- a lot of duplication.

   -- | A mapping of 'PackageName' to 'UnitId'. If several units have the same

   -- package name (e.g. different instantiations), then we return one of them...

     unitInfoMap    = emptyUniqMap,

     trustedUnits   = emptyTrustOverlay,

     packageNameMap = emptyUFM,

     preloadUnits   = [],

     explicitUnits  = [],

     homeUnitDepends = Set.empty,

 -- 'initUnits' can be called again subsequently after updating the

 -- 'packageFlags' and 'packageDBFlags' fields of the 'DynFlags', and it will

 -- update the 'unitState' in 'DynFlags'.

   let forceUnitInfoMap state = unitInfoMap state `seq` ()

   unit_state <- withTiming logger (text "initializing unit database")

                    forceUnitInfoMap

   putDumpFileMaybe logger Opt_D_dump_mod_map "Module Map"

     FormatText (updSDocContext (\ctx -> ctx {sdocLineLength = 200})

 mkUnitState

     :: Logger

     -> UnitIndexCache

     -> UnitConfig

     -> IO UnitState

 {-

    Plan.

           we build a mapping saying what every in scope module name points to.

 -}

   -- distrust all units if the flag is set

   let distrustUnitsOfDb overlay db = foldl' (\ acc ui -> distrustUnits [unitId ui] acc) overlay (unitDatabaseUnits db)

   debugTraceMsg logger 2 $

       text "package flags" <+> ppr other_flags

   -- Merge databases together, without checking validity

   (pkg_map1, prec_map) <- mergeDatabases logger dbs

   -- Compute trust flags (these flags apply regardless of whether

   -- or not packages are visible or not)

             $ foldM (applyTrustFlag prec_map unusable (nonDetEltsUniqMap pkg_map2))

                  distrustedUnitsOverlay (reverse (unitConfigFlagsTrusted cfg))

   let pkgs1 = nonDetEltsUniqMap pkg_map2

                             -- Note: we NEVER expose indefinite packages by

                             -- default, because it's almost assuredly not

                             -- what you want (no mix-in linking has occurred).

                                then addToUniqMap vm (mkUnit p)

                                                UnitVisibility {

                                                  uv_expose_all = True,

                                                  uv_renamings = [],

                                                  uv_requirements = emptyUniqMap,

                                                  uv_explicit = Nothing

                                                }

       env <- GHC.getSession

       let unit_index = hscUIC env

       (unit_state,home_unit,_mconstants) <-

       hpt <- liftIO emptyHomePackageTable

       pure (HUG.mkHomeUnitEnv unit_state dflags hpt (Just home_unit))

       -- If this number changes without a good reason, DO NOT ACCEPT THE CHANGES, you have introduced a space leak.

       -- We say less than the expected size is accepted, because in the multiple-home-units case, we don't force the second

       -- UnitInfo closure enough after initial processing.

         putStrLn "Space leak detected by generic-unit-info-space test:"

         putStrLn $ (show (num `div` genericUnitInfoSizeInBytes)) ++ " live GenericUnitInfo when <= (" ++ show expectedNumberOfUnitInfos ++ ") are expected"

         readFile hpFile >>= putStrLn