Move Unit related fields from DynFlags to HscEnv

The unit database cache, the home unit and the unit state were stored in
DynFlags while they ought to be stored in the compiler session state
(HscEnv). This patch fixes this.

It introduces a new UnitEnv type that should be used in the future to
handle separate unit environments (especially host vs target units).

Related to #17957

Bump haddock submodule

5 files changed, 287 insertions, 404 deletions

diff --git a/compiler/GHC/Unit/Env.hs b/compiler/GHC/Unit/Env.hs
new file mode 100644
index 0000000000..d7de796434
--- /dev/null
+++ b/compiler/GHC/Unit/Env.hs
@@ -0,0 +1,61 @@
+module GHC.Unit.Env
+    ( UnitEnv (..)
+    , preloadUnitsInfo
+    , preloadUnitsInfo'
+    )
+where
+
+import GHC.Prelude
+
+import GHC.Unit.State
+import GHC.Unit.Home
+import GHC.Unit.Types
+
+import GHC.Platform
+import GHC.Settings
+import GHC.Data.Maybe
+
+data UnitEnv = UnitEnv
+    { ue_units     :: !UnitState      -- ^ Units
+    , ue_home_unit :: !HomeUnit       -- ^ Home unit
+    , ue_platform  :: !Platform       -- ^ Platform
+    , ue_namever   :: !GhcNameVersion -- ^ GHC name/version (used for dynamic library suffix)
+    }
+
+-- -----------------------------------------------------------------------------
+-- Extracting information from the packages in scope
+
+-- Many of these functions take a list of packages: in those cases,
+-- the list is expected to contain the "dependent packages",
+-- i.e. those packages that were found to be depended on by the
+-- current module/program.  These can be auto or non-auto packages, it
+-- doesn't really matter.  The list is always combined with the list
+-- of preload (command-line) packages to determine which packages to
+-- use.
+
+-- | Lookup 'UnitInfo' for every preload unit from the UnitState, for every unit
+-- used to instantiate the home unit, and for every unit explicitly passed in
+-- the given list of UnitId.
+preloadUnitsInfo' :: UnitEnv -> [UnitId] -> MaybeErr UnitErr [UnitInfo]
+preloadUnitsInfo' unit_env ids0 = all_infos
+  where
+    home_unit  = ue_home_unit unit_env
+    unit_state = ue_units     unit_env
+    ids      = ids0 ++ inst_ids
+    inst_ids
+       -- An indefinite package will have insts to HOLE,
+       -- which is not a real package. Don't look it up.
+       -- Fixes #14525
+       | isHomeUnitIndefinite home_unit = []
+       | otherwise = map (toUnitId . moduleUnit . snd) (homeUnitInstantiations home_unit)
+    pkg_map = unitInfoMap unit_state
+    preload = preloadUnits unit_state
+
+    all_pkgs  = closeUnitDeps' pkg_map preload (ids `zip` repeat Nothing)
+    all_infos = map (unsafeLookupUnitId unit_state) <$> all_pkgs
+
+
+-- | Lookup 'UnitInfo' for every preload unit from the UnitState and for every
+-- unit used to instantiate the home unit.
+preloadUnitsInfo :: UnitEnv -> MaybeErr UnitErr [UnitInfo]
+preloadUnitsInfo unit_env = preloadUnitsInfo' unit_env []
diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs
index 36193fce94..130994b74b 100644
--- a/compiler/GHC/Unit/Finder.hs
+++ b/compiler/GHC/Unit/Finder.hs
@@ -29,9 +29,6 @@ module GHC.Unit.Finder (
     findObjectLinkableMaybe,
     findObjectLinkable,
 
-    cannotFindModule,
-    cannotFindInterface,
-
   ) where
 
 #include "HsVersions.h"
@@ -198,14 +195,14 @@ findExposedPackageModule :: HscEnv -> ModuleName -> Maybe FastString
 findExposedPackageModule hsc_env mod_name mb_pkg
   = findLookupResult hsc_env
   $ lookupModuleWithSuggestions
-        (unitState (hsc_dflags hsc_env)) mod_name mb_pkg
+        (hsc_units hsc_env) mod_name mb_pkg
 
 findExposedPluginPackageModule :: HscEnv -> ModuleName
                                -> IO FindResult
 findExposedPluginPackageModule hsc_env mod_name
   = findLookupResult hsc_env
   $ lookupPluginModuleWithSuggestions
-        (unitState (hsc_dflags hsc_env)) mod_name Nothing
+        (hsc_units hsc_env) mod_name Nothing
 
 findLookupResult :: HscEnv -> LookupResult -> IO FindResult
 findLookupResult hsc_env r = case r of
@@ -354,14 +351,10 @@ findInstalledHomeModule hsc_env mod_name =
 -- | Search for a module in external packages only.
 findPackageModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
 findPackageModule hsc_env mod = do
-  let
-        dflags = hsc_dflags hsc_env
-        pkg_id = moduleUnit mod
-        pkgstate = unitState dflags
-  --
-  case lookupUnitId pkgstate pkg_id of
+  let pkg_id = moduleUnit mod
+  case lookupUnitId (hsc_units hsc_env) pkg_id of
      Nothing -> return (InstalledNoPackage pkg_id)
-     Just pkg_conf -> findPackageModule_ hsc_env mod pkg_conf
+     Just u  -> findPackageModule_ hsc_env mod u
 
 -- | Look up the interface file associated with module @mod@.  This function
 -- requires a few invariants to be upheld: (1) the 'Module' in question must
@@ -617,239 +610,3 @@ findObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn])
   -- We used to look for _stub.o files here, but that was a bug (#706)
   -- Now GHC merges the stub.o into the main .o (#3687)
 
--- -----------------------------------------------------------------------------
--- Error messages
-
-cannotFindModule :: DynFlags -> ModuleName -> FindResult -> SDoc
-cannotFindModule dflags mod res = pprWithUnitState unit_state $
-  cantFindErr (sLit cannotFindMsg)
-              (sLit "Ambiguous module name")
-              dflags mod res
-  where
-    unit_state = unitState dflags
-    cannotFindMsg =
-      case res of
-        NotFound { fr_mods_hidden = hidden_mods
-                 , fr_pkgs_hidden = hidden_pkgs
-                 , fr_unusables = unusables }
-          | not (null hidden_mods && null hidden_pkgs && null unusables)
-          -> "Could not load module"
-        _ -> "Could not find module"
-
-cannotFindInterface  :: DynFlags -> ModuleName -> InstalledFindResult -> SDoc
-cannotFindInterface = cantFindInstalledErr (sLit "Failed to load interface for")
-                                           (sLit "Ambiguous interface for")
-
-cantFindErr :: PtrString -> PtrString -> DynFlags -> ModuleName -> FindResult
-            -> SDoc
-cantFindErr _ multiple_found _ mod_name (FoundMultiple mods)
-  | Just pkgs <- unambiguousPackages
-  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
-       sep [text "it was found in multiple packages:",
-                hsep (map ppr pkgs) ]
-    )
-  | otherwise
-  = hang (ptext multiple_found <+> quotes (ppr mod_name) <> colon) 2 (
-       vcat (map pprMod mods)
-    )
-  where
-    unambiguousPackages = foldl' unambiguousPackage (Just []) mods
-    unambiguousPackage (Just xs) (m, ModOrigin (Just _) _ _ _)
-        = Just (moduleUnit m : xs)
-    unambiguousPackage _ _ = Nothing
-
-    pprMod (m, o) = text "it is bound as" <+> ppr m <+>
-                                text "by" <+> pprOrigin m o
-    pprOrigin _ ModHidden = panic "cantFindErr: bound by mod hidden"
-    pprOrigin _ (ModUnusable _) = panic "cantFindErr: bound by mod unusable"
-    pprOrigin m (ModOrigin e res _ f) = sep $ punctuate comma (
-      if e == Just True
-          then [text "package" <+> ppr (moduleUnit m)]
-          else [] ++
-      map ((text "a reexport in package" <+>)
-                .ppr.mkUnit) res ++
-      if f then [text "a package flag"] else []
-      )
-
-cantFindErr cannot_find _ dflags mod_name find_result
-  = ptext cannot_find <+> quotes (ppr mod_name)
-    $$ more_info
-  where
-    pkgs = unitState dflags
-    home_unit = mkHomeUnitFromFlags dflags
-    more_info
-      = case find_result of
-            NoPackage pkg
-                -> text "no unit id matching" <+> quotes (ppr pkg) <+>
-                   text "was found"
-
-            NotFound { fr_paths = files, fr_pkg = mb_pkg
-                     , fr_mods_hidden = mod_hiddens, fr_pkgs_hidden = pkg_hiddens
-                     , fr_unusables = unusables, fr_suggestions = suggest }
-                | Just pkg <- mb_pkg, not (isHomeUnit home_unit pkg)
-                -> not_found_in_package pkg files
-
-                | not (null suggest)
-                -> pp_suggestions suggest $$ tried_these files dflags
-
-                | null files && null mod_hiddens &&
-                  null pkg_hiddens && null unusables
-                -> text "It is not a module in the current program, or in any known package."
-
-                | otherwise
-                -> vcat (map pkg_hidden pkg_hiddens) $$
-                   vcat (map mod_hidden mod_hiddens) $$
-                   vcat (map unusable unusables) $$
-                   tried_these files dflags
-
-            _ -> panic "cantFindErr"
-
-    build_tag = waysBuildTag (ways dflags)
-
-    not_found_in_package pkg files
-       | build_tag /= ""
-       = let
-            build = if build_tag == "p" then "profiling"
-                                        else "\"" ++ build_tag ++ "\""
-         in
-         text "Perhaps you haven't installed the " <> text build <>
-         text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
-         tried_these files dflags
-
-       | otherwise
-       = text "There are files missing in the " <> quotes (ppr pkg) <>
-         text " package," $$
-         text "try running 'ghc-pkg check'." $$
-         tried_these files dflags
-
-    pkg_hidden :: Unit -> SDoc
-    pkg_hidden uid =
-        text "It is a member of the hidden package"
-        <+> quotes (ppr uid)
-        --FIXME: we don't really want to show the unit id here we should
-        -- show the source package id or installed package id if it's ambiguous
-        <> dot $$ pkg_hidden_hint uid
-    pkg_hidden_hint uid
-     | gopt Opt_BuildingCabalPackage dflags
-        = let pkg = expectJust "pkg_hidden" (lookupUnit pkgs uid)
-           in text "Perhaps you need to add" <+>
-              quotes (ppr (unitPackageName pkg)) <+>
-              text "to the build-depends in your .cabal file."
-     | Just pkg <- lookupUnit pkgs uid
-         = text "You can run" <+>
-           quotes (text ":set -package " <> ppr (unitPackageName pkg)) <+>
-           text "to expose it." $$
-           text "(Note: this unloads all the modules in the current scope.)"
-     | otherwise = Outputable.empty
-
-    mod_hidden pkg =
-        text "it is a hidden module in the package" <+> quotes (ppr pkg)
-
-    unusable (pkg, reason)
-      = text "It is a member of the package"
-      <+> quotes (ppr pkg)
-      $$ pprReason (text "which is") reason
-
-    pp_suggestions :: [ModuleSuggestion] -> SDoc
-    pp_suggestions sugs
-      | null sugs = Outputable.empty
-      | otherwise = hang (text "Perhaps you meant")
-                       2 (vcat (map pp_sugg sugs))
-
-    -- NB: Prefer the *original* location, and then reexports, and then
-    -- package flags when making suggestions.  ToDo: if the original package
-    -- also has a reexport, prefer that one
-    pp_sugg (SuggestVisible m mod o) = ppr m <+> provenance o
-      where provenance ModHidden = Outputable.empty
-            provenance (ModUnusable _) = Outputable.empty
-            provenance (ModOrigin{ fromOrigUnit = e,
-                                   fromExposedReexport = res,
-                                   fromPackageFlag = f })
-              | Just True <- e
-                 = parens (text "from" <+> ppr (moduleUnit mod))
-              | f && moduleName mod == m
-                 = parens (text "from" <+> ppr (moduleUnit mod))
-              | (pkg:_) <- res
-                 = parens (text "from" <+> ppr (mkUnit pkg)
-                    <> comma <+> text "reexporting" <+> ppr mod)
-              | f
-                 = parens (text "defined via package flags to be"
-                    <+> ppr mod)
-              | otherwise = Outputable.empty
-    pp_sugg (SuggestHidden m mod o) = ppr m <+> provenance o
-      where provenance ModHidden =  Outputable.empty
-            provenance (ModUnusable _) = Outputable.empty
-            provenance (ModOrigin{ fromOrigUnit = e,
-                                   fromHiddenReexport = rhs })
-              | Just False <- e
-                 = parens (text "needs flag -package-id"
-                    <+> ppr (moduleUnit mod))
-              | (pkg:_) <- rhs
-                 = parens (text "needs flag -package-id"
-                    <+> ppr (mkUnit pkg))
-              | otherwise = Outputable.empty
-
-cantFindInstalledErr :: PtrString -> PtrString -> DynFlags -> ModuleName
-                     -> InstalledFindResult -> SDoc
-cantFindInstalledErr cannot_find _ dflags mod_name find_result
-  = ptext cannot_find <+> quotes (ppr mod_name)
-    $$ more_info
-  where
-    home_unit  = mkHomeUnitFromFlags dflags
-    unit_state = unitState dflags
-    build_tag = waysBuildTag (ways dflags)
-
-    more_info
-      = case find_result of
-            InstalledNoPackage pkg
-                -> text "no unit id matching" <+> quotes (ppr pkg) <+>
-                   text "was found" $$ looks_like_srcpkgid pkg
-
-            InstalledNotFound files mb_pkg
-                | Just pkg <- mb_pkg, not (isHomeUnitId home_unit pkg)
-                -> not_found_in_package pkg files
-
-                | null files
-                -> text "It is not a module in the current program, or in any known package."
-
-                | otherwise
-                -> tried_these files dflags
-
-            _ -> panic "cantFindInstalledErr"
-
-    looks_like_srcpkgid :: UnitId -> SDoc
-    looks_like_srcpkgid pk
-     -- Unsafely coerce a unit id (i.e. an installed package component
-     -- identifier) into a PackageId and see if it means anything.
-     | (pkg:pkgs) <- searchPackageId unit_state (PackageId (unitIdFS pk))
-     = parens (text "This unit ID looks like the source package ID;" $$
-       text "the real unit ID is" <+> quotes (ftext (unitIdFS (unitId pkg))) $$
-       (if null pkgs then Outputable.empty
-        else text "and" <+> int (length pkgs) <+> text "other candidates"))
-     -- Todo: also check if it looks like a package name!
-     | otherwise = Outputable.empty
-
-    not_found_in_package pkg files
-       | build_tag /= ""
-       = let
-            build = if build_tag == "p" then "profiling"
-                                        else "\"" ++ build_tag ++ "\""
-         in
-         text "Perhaps you haven't installed the " <> text build <>
-         text " libraries for package " <> quotes (ppr pkg) <> char '?' $$
-         tried_these files dflags
-
-       | otherwise
-       = text "There are files missing in the " <> quotes (ppr pkg) <>
-         text " package," $$
-         text "try running 'ghc-pkg check'." $$
-         tried_these files dflags
-
-tried_these :: [FilePath] -> DynFlags -> SDoc
-tried_these files dflags
-    | null files = Outputable.empty
-    | verbosity dflags < 3 =
-          text "Use -v (or `:set -v` in ghci) " <>
-              text "to see a list of the files searched for."
-    | otherwise =
-          hang (text "Locations searched:") 2 $ vcat (map text files)
diff --git a/compiler/GHC/Unit/Home.hs b/compiler/GHC/Unit/Home.hs
index 6baa8bf5fb..fa8a0b1d6f 100644
--- a/compiler/GHC/Unit/Home.hs
+++ b/compiler/GHC/Unit/Home.hs
@@ -43,9 +43,7 @@ import Data.Maybe
 -- unit identifier) with `homeUnitMap`.
 --
 -- TODO: this isn't implemented yet. UnitKeys are still converted too early into
--- UnitIds in GHC.Unit.State.readUnitDataBase and wiring of home unit
--- instantiations is done inplace in DynFlags by
--- GHC.Unit.State.upd_wired_in_home_instantiations.
+-- UnitIds in GHC.Unit.State.readUnitDataBase
 data GenHomeUnit u
    = DefiniteHomeUnit UnitId (Maybe (u, GenInstantiations u))
       -- ^ Definite home unit (i.e. that we can compile).
diff --git a/compiler/GHC/Unit/Info.hs b/compiler/GHC/Unit/Info.hs
index 1f2366f292..d95ea5b442 100644
--- a/compiler/GHC/Unit/Info.hs
+++ b/compiler/GHC/Unit/Info.hs
@@ -19,23 +19,41 @@ module GHC.Unit.Info
    , unitPackageNameString
    , unitPackageIdString
    , pprUnitInfo
+
+   , collectIncludeDirs
+   , collectExtraCcOpts
+   , collectLibraryDirs
+   , collectFrameworks
+   , collectFrameworksDirs
+   , unitHsLibs
    )
 where
 
 #include "HsVersions.h"
 
 import GHC.Prelude
+import GHC.Platform.Ways
 
-import GHC.Unit.Database
-import Data.Version
-import Data.Bifunctor
+import GHC.Utils.Misc
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
+
+import GHC.Types.Unique
 
 import GHC.Data.FastString
 import qualified GHC.Data.ShortText as ST
-import GHC.Utils.Outputable
+
 import GHC.Unit.Module as Module
-import GHC.Types.Unique
 import GHC.Unit.Ppr
+import GHC.Unit.Database
+
+import GHC.Settings
+
+import Data.Version
+import Data.Bifunctor
+import Data.List (isPrefixOf, stripPrefix)
+import qualified Data.Set as Set
+
 
 -- | Information about an installed unit
 --
@@ -165,3 +183,75 @@ mkUnitPprInfo ufs i = UnitPprInfo
    (unitPackageNameString i)
    (unitPackageVersion i)
    ((unpackFS . unPackageName) <$> unitComponentName i)
+
+-- | Find all the include directories in the given units
+collectIncludeDirs :: [UnitInfo] -> [FilePath]
+collectIncludeDirs ps = map ST.unpack $ ordNub (filter (not . ST.null) (concatMap unitIncludeDirs ps))
+
+-- | Find all the C-compiler options in the given units
+collectExtraCcOpts :: [UnitInfo] -> [String]
+collectExtraCcOpts ps = map ST.unpack (concatMap unitCcOptions ps)
+
+-- | Find all the library directories in the given units for the given ways
+collectLibraryDirs :: Ways -> [UnitInfo] -> [FilePath]
+collectLibraryDirs ws = ordNub . filter notNull . concatMap (libraryDirsForWay ws)
+
+-- | Find all the frameworks in the given units
+collectFrameworks :: [UnitInfo] -> [String]
+collectFrameworks ps = map ST.unpack (concatMap unitExtDepFrameworks ps)
+
+-- | Find all the package framework paths in these and the preload packages
+collectFrameworksDirs :: [UnitInfo] -> [String]
+collectFrameworksDirs ps = map ST.unpack (ordNub (filter (not . ST.null) (concatMap unitExtDepFrameworkDirs ps)))
+
+-- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way.
+libraryDirsForWay :: Ways -> UnitInfo -> [String]
+libraryDirsForWay ws
+  | WayDyn `elem` ws = map ST.unpack . unitLibraryDynDirs
+  | otherwise        = map ST.unpack . unitLibraryDirs
+
+unitHsLibs :: GhcNameVersion -> Ways -> UnitInfo -> [String]
+unitHsLibs namever ways0 p = map (mkDynName . addSuffix . ST.unpack) (unitLibraries p)
+  where
+        ways1 = Set.filter (/= WayDyn) ways0
+        -- the name of a shared library is libHSfoo-ghc<version>.so
+        -- we leave out the _dyn, because it is superfluous
+
+        -- debug and profiled RTSs include support for -eventlog
+        ways2 | WayDebug `Set.member` ways1 || WayProf `Set.member` ways1
+              = Set.filter (/= WayTracing) ways1
+              | otherwise
+              = ways1
+
+        tag     = waysTag (fullWays ways2)
+        rts_tag = waysTag ways2
+
+        mkDynName x
+         | not (ways0 `hasWay` WayDyn) = x
+         | "HS" `isPrefixOf` x         = x ++ dynLibSuffix namever
+           -- For non-Haskell libraries, we use the name "Cfoo". The .a
+           -- file is libCfoo.a, and the .so is libfoo.so. That way the
+           -- linker knows what we mean for the vanilla (-lCfoo) and dyn
+           -- (-lfoo) ways. We therefore need to strip the 'C' off here.
+         | Just x' <- stripPrefix "C" x = x'
+         | otherwise
+            = panic ("Don't understand library name " ++ x)
+
+        -- Add _thr and other rts suffixes to packages named
+        -- `rts` or `rts-1.0`. Why both?  Traditionally the rts
+        -- package is called `rts` only.  However the tooling
+        -- usually expects a package name to have a version.
+        -- As such we will gradually move towards the `rts-1.0`
+        -- package name, at which point the `rts` package name
+        -- will eventually be unused.
+        --
+        -- This change elevates the need to add custom hooks
+        -- and handling specifically for the `rts` package for
+        -- example in ghc-cabal.
+        addSuffix rts@"HSrts"    = rts       ++ (expandTag rts_tag)
+        addSuffix rts@"HSrts-1.0"= rts       ++ (expandTag rts_tag)
+        addSuffix other_lib      = other_lib ++ (expandTag tag)
+
+        expandTag t | null t = ""
+                    | otherwise = '_':t
+
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 74ba55a702..1aabfb10c2 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -1,6 +1,7 @@
 -- (c) The University of Glasgow, 2006
 
 {-# LANGUAGE CPP, ScopedTypeVariables, BangPatterns, FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
 
 -- | Unit manipulation
 module GHC.Unit.State (
@@ -9,6 +10,7 @@ module GHC.Unit.State (
         -- * Reading the package config, and processing cmdline args
         UnitState(..),
         UnitDatabase (..),
+        UnitErr (..),
         emptyUnitState,
         initUnits,
         readUnitDatabases,
@@ -39,12 +41,9 @@ module GHC.Unit.State (
         UnusableUnitReason(..),
         pprReason,
 
-        -- * Inspecting the set of packages in scope
-        getUnitIncludePath,
-        getUnitExtraCcOpts,
-        getPreloadUnitsAnd,
-
-        collectIncludeDirs,
+        closeUnitDeps,
+        closeUnitDeps',
+        mayThrowUnitErr,
 
         -- * Module hole substitution
         ShHoleSubst,
@@ -73,19 +72,23 @@ where
 
 import GHC.Prelude
 
+import GHC.Driver.Session
+
 import GHC.Platform
-import GHC.Unit.Home
+import GHC.Platform.Ways
+
 import GHC.Unit.Database
 import GHC.Unit.Info
 import GHC.Unit.Ppr
 import GHC.Unit.Types
 import GHC.Unit.Module
-import GHC.Driver.Session
-import GHC.Platform.Ways
+import GHC.Unit.Home
+
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.DFM
 import GHC.Types.Unique.Set
 import GHC.Types.Unique.DSet
+
 import GHC.Utils.Misc
 import GHC.Utils.Panic
 import GHC.Utils.Outputable as Outputable
@@ -94,7 +97,7 @@ import GHC.Data.Maybe
 import System.Environment ( getEnv )
 import GHC.Data.FastString
 import qualified GHC.Data.ShortText as ST
-import GHC.Utils.Error  ( debugTraceMsg, MsgDoc, dumpIfSet_dyn,
+import GHC.Utils.Error  ( debugTraceMsg, dumpIfSet_dyn,
                           withTiming, DumpFormat (..) )
 import GHC.Utils.Exception
 
@@ -342,8 +345,8 @@ data UnitConfig = UnitConfig
    , unitConfigFlagsPlugins :: [PackageFlag]       -- ^ Plugins exposed units
    }
 
-initUnitConfig :: DynFlags -> UnitConfig
-initUnitConfig dflags =
+initUnitConfig :: DynFlags -> Maybe [UnitDatabase UnitId] -> UnitConfig
+initUnitConfig dflags cached_dbs =
    let !hu_id             = homeUnitId_ dflags
        !hu_instanceof     = homeUnitInstanceOf_ dflags
        !hu_instantiations = homeUnitInstantiations_ dflags
@@ -376,7 +379,7 @@ initUnitConfig dflags =
       , unitConfigHideAll        = gopt Opt_HideAllPackages dflags
       , unitConfigHideAllPlugins = gopt Opt_HideAllPluginPackages dflags
 
-      , unitConfigDBCache      = unitDatabases dflags
+      , unitConfigDBCache      = cached_dbs
       , unitConfigFlagsDB      = packageDBFlags dflags
       , unitConfigFlagsExposed = packageFlags dflags
       , unitConfigFlagsIgnored = ignorePackageFlags dflags
@@ -573,27 +576,55 @@ listUnitInfo state = Map.elems (unitInfoMap state)
 -- 'initUnits' can be called again subsequently after updating the
 -- 'packageFlags' field of the 'DynFlags', and it will update the
 -- 'unitState' in 'DynFlags'.
-initUnits :: DynFlags -> IO DynFlags
-initUnits dflags = do
+initUnits :: DynFlags -> Maybe [UnitDatabase UnitId] -> IO ([UnitDatabase UnitId], UnitState, HomeUnit)
+initUnits dflags cached_dbs = do
 
   let forceUnitInfoMap (state, _) = unitInfoMap state `seq` ()
   let ctx     = initSDocContext dflags defaultUserStyle -- SDocContext used to render exception messages
   let printer = debugTraceMsg dflags                    -- printer for trace messages
 
-  (state,dbs) <- withTiming dflags (text "initializing unit database")
+  (unit_state,dbs) <- withTiming dflags (text "initializing unit database")
                    forceUnitInfoMap
-                   (mkUnitState ctx printer (initUnitConfig dflags))
-
-  dumpIfSet_dyn (dflags { pprCols = 200 }) Opt_D_dump_mod_map "Module Map"
-    FormatText (pprModuleMap (moduleNameProvidersMap state))
-
-  let dflags'  = dflags
-                  { unitDatabases = Just dbs -- databases are cached and never read again
-                  , unitState     = state
-                  }
-      dflags'' = upd_wired_in_home_instantiations dflags'
-
-  return dflags''
+                 $ mkUnitState ctx printer (initUnitConfig dflags cached_dbs)
+
+  dumpIfSet_dyn dflags Opt_D_dump_mod_map "Module Map"
+    FormatText (updSDocContext (\ctx -> ctx {sdocLineLength = 200})
+                $ pprModuleMap (moduleNameProvidersMap unit_state))
+
+  let home_unit = mkHomeUnit unit_state
+                             (homeUnitId_ dflags)
+                             (homeUnitInstanceOf_ dflags)
+                             (homeUnitInstantiations_ dflags)
+
+  return (dbs,unit_state,home_unit)
+
+mkHomeUnit
+    :: UnitState
+    -> UnitId                 -- ^ Home unit id
+    -> Maybe UnitId           -- ^ Home unit instance of
+    -> [(ModuleName, Module)] -- ^ Home unit instantiations
+    -> HomeUnit
+mkHomeUnit unit_state hu_id hu_instanceof hu_instantiations_ =
+    let
+        -- Some wired units can be used to instantiate the home unit. We need to
+        -- replace their unit keys with their wired unit ids.
+        wmap              = wireMap unit_state
+        hu_instantiations = map (fmap (upd_wired_in_mod wmap)) hu_instantiations_
+    in case (hu_instanceof, hu_instantiations) of
+      (Nothing,[]) -> DefiniteHomeUnit hu_id Nothing
+      (Nothing, _) -> throwGhcException $ CmdLineError ("Use of -instantiated-with requires -this-component-id")
+      (Just _, []) -> throwGhcException $ CmdLineError ("Use of -this-component-id requires -instantiated-with")
+      (Just u, is)
+         -- detect fully indefinite units: all their instantiations are hole
+         -- modules and the home unit id is the same as the instantiating unit
+         -- id (see Note [About units] in GHC.Unit)
+         | all (isHoleModule . snd) is && u == hu_id
+         -> IndefiniteHomeUnit u is
+         -- otherwise it must be that we (fully) instantiate an indefinite unit
+         -- to make it definite.
+         -- TODO: error when the unit is partially instantiated??
+         | otherwise
+         -> DefiniteHomeUnit hu_id (Just (u, is))
 
 -- -----------------------------------------------------------------------------
 -- Reading the unit database(s)
@@ -759,30 +790,28 @@ mungeDynLibFields pkg =
 -- -trust and -distrust.
 
 applyTrustFlag
-   :: SDocContext
-   -> UnitPrecedenceMap
+   :: UnitPrecedenceMap
    -> UnusableUnits
    -> [UnitInfo]
    -> TrustFlag
-   -> IO [UnitInfo]
-applyTrustFlag ctx prec_map unusable pkgs flag =
+   -> MaybeErr UnitErr [UnitInfo]
+applyTrustFlag prec_map unusable pkgs flag =
   case flag of
     -- we trust all matching packages. Maybe should only trust first one?
     -- and leave others the same or set them untrusted
     TrustPackage str ->
        case selectPackages prec_map (PackageArg str) pkgs unusable of
-         Left ps       -> trustFlagErr ctx flag ps
-         Right (ps,qs) -> return (map trust ps ++ qs)
+         Left ps       -> Failed (TrustFlagErr flag ps)
+         Right (ps,qs) -> Succeeded (map trust ps ++ qs)
           where trust p = p {unitIsTrusted=True}
 
     DistrustPackage str ->
        case selectPackages prec_map (PackageArg str) pkgs unusable of
-         Left ps       -> trustFlagErr ctx flag ps
-         Right (ps,qs) -> return (distrustAllUnits ps ++ qs)
+         Left ps       -> Failed (TrustFlagErr flag ps)
+         Right (ps,qs) -> Succeeded (distrustAllUnits ps ++ qs)
 
 applyPackageFlag
-   :: SDocContext
-   -> UnitPrecedenceMap
+   :: UnitPrecedenceMap
    -> UnitInfoMap
    -> PreloadUnitClosure
    -> UnusableUnits
@@ -790,15 +819,15 @@ applyPackageFlag
            -- any previously exposed packages with the same name
    -> [UnitInfo]
    -> VisibilityMap           -- Initially exposed
-   -> PackageFlag               -- flag to apply
-   -> IO VisibilityMap        -- Now exposed
+   -> PackageFlag             -- flag to apply
+   -> MaybeErr UnitErr VisibilityMap -- Now exposed
 
-applyPackageFlag ctx prec_map pkg_map closure unusable no_hide_others pkgs vm flag =
+applyPackageFlag prec_map pkg_map closure unusable no_hide_others pkgs vm flag =
   case flag of
     ExposePackage _ arg (ModRenaming b rns) ->
        case findPackages prec_map pkg_map closure arg pkgs unusable of
-         Left ps         -> packageFlagErr ctx flag ps
-         Right (p:_) -> return vm'
+         Left ps     -> Failed (PackageFlagErr flag ps)
+         Right (p:_) -> Succeeded vm'
           where
            n = fsPackageName p
 
@@ -861,9 +890,8 @@ applyPackageFlag ctx prec_map pkg_map closure unusable no_hide_others pkgs vm fl
 
     HidePackage str ->
        case findPackages prec_map pkg_map closure (PackageArg str) pkgs unusable of
-         Left ps  -> packageFlagErr ctx flag ps
-         Right ps -> return vm'
-          where vm' = foldl' (flip Map.delete) vm (map mkUnit ps)
+         Left ps  -> Failed (PackageFlagErr flag ps)
+         Right ps -> Succeeded $ foldl' (flip Map.delete) vm (map mkUnit ps)
 
 -- | Like 'selectPackages', but doesn't return a list of unmatched
 -- packages.  Furthermore, any packages it returns are *renamed*
@@ -970,34 +998,6 @@ compareByPreference prec_map pkg pkg'
 comparing :: Ord a => (t -> a) -> t -> t -> Ordering
 comparing f a b = f a `compare` f b
 
-packageFlagErr :: SDocContext
-               -> PackageFlag
-               -> [(UnitInfo, UnusableUnitReason)]
-               -> IO a
-packageFlagErr ctx flag reasons
-  = packageFlagErr' ctx (pprFlag flag) reasons
-
-trustFlagErr :: SDocContext
-             -> TrustFlag
-             -> [(UnitInfo, UnusableUnitReason)]
-             -> IO a
-trustFlagErr ctx flag reasons
-  = packageFlagErr' ctx (pprTrustFlag flag) reasons
-
-packageFlagErr' :: SDocContext
-               -> SDoc
-               -> [(UnitInfo, UnusableUnitReason)]
-               -> IO a
-packageFlagErr' ctx flag_doc reasons
-  = throwGhcExceptionIO (CmdLineError (renderWithContext ctx $ err))
-  where err = text "cannot satisfy " <> flag_doc <>
-                (if null reasons then Outputable.empty else text ": ") $$
-              nest 4 (ppr_reasons $$
-                      text "(use -v for more information)")
-        ppr_reasons = vcat (map ppr_reason reasons)
-        ppr_reason (p, reason) =
-            pprReason (ppr (unitId p) <+> text "is") reason
-
 pprFlag :: PackageFlag -> SDoc
 pprFlag flag = case flag of
     HidePackage p   -> text "-hide-package " <> text p
@@ -1117,17 +1117,6 @@ findWiredInUnits printer prec_map pkgs vis_map = do
 -- For instance, base-4.9.0.0 will be rewritten to just base, to match
 -- what appears in GHC.Builtin.Names.
 
--- | Some wired units can be used to instantiate the home unit. We need to
--- replace their unit keys with their wired unit ids.
-upd_wired_in_home_instantiations :: DynFlags -> DynFlags
-upd_wired_in_home_instantiations dflags = dflags { homeUnitInstantiations_ = wiredInsts }
-   where
-      state        = unitState dflags
-      wiringMap    = wireMap state
-      unwiredInsts = homeUnitInstantiations_ dflags
-      wiredInsts   = map (fmap (upd_wired_in_mod wiringMap)) unwiredInsts
-
-
 upd_wired_in_mod :: WiringMap -> Module -> Module
 upd_wired_in_mod wiredInMap (Module uid m) = Module (upd_wired_in_uid wiredInMap uid) m
 
@@ -1482,7 +1471,8 @@ mkUnitState ctx printer cfg = do
 
   -- Apply trust flags (these flags apply regardless of whether
   -- or not packages are visible or not)
-  pkgs1 <- foldM (applyTrustFlag ctx prec_map unusable)
+  pkgs1 <- mayThrowUnitErr
+            $ foldM (applyTrustFlag prec_map unusable)
                  (Map.elems pkg_map2) (reverse (unitConfigFlagsTrusted cfg))
   let prelim_pkg_db = mkUnitInfoMap pkgs1
 
@@ -1540,7 +1530,8 @@ mkUnitState ctx printer cfg = do
   -- -hide-package).  This needs to know about the unusable packages, since if a
   -- user tries to enable an unusable package, we should let them know.
   --
-  vis_map2 <- foldM (applyPackageFlag ctx prec_map prelim_pkg_db emptyUniqSet unusable
+  vis_map2 <- mayThrowUnitErr
+                $ foldM (applyPackageFlag prec_map prelim_pkg_db emptyUniqSet unusable
                         (unitConfigHideAll cfg) pkgs1)
                             vis_map1 other_flags
 
@@ -1568,7 +1559,8 @@ mkUnitState ctx printer cfg = do
                         -- won't work.
                         | otherwise = vis_map2
                 plugin_vis_map2
-                    <- foldM (applyPackageFlag ctx prec_map prelim_pkg_db emptyUniqSet unusable
+                    <- mayThrowUnitErr
+                        $ foldM (applyPackageFlag prec_map prelim_pkg_db emptyUniqSet unusable
                                 hide_plugin_pkgs pkgs1)
                              plugin_vis_map1
                              (reverse (unitConfigFlagsPlugins cfg))
@@ -1614,8 +1606,9 @@ mkUnitState ctx printer cfg = do
       preload3 = ordNub $ (basicLinkedUnits ++ preload1)
 
   -- Close the preload packages with their dependencies
-  let dep_preload_err = closeUnitDeps pkg_db (zip (map toUnitId preload3) (repeat Nothing))
-  dep_preload <- throwErr ctx dep_preload_err
+  dep_preload <- mayThrowUnitErr
+                    $ closeUnitDeps pkg_db
+                    $ zip (map toUnitId preload3) (repeat Nothing)
 
   let mod_map1 = mkModuleNameProvidersMap ctx cfg pkg_db emptyUniqSet vis_map
       mod_map2 = mkUnusableModuleNameProvidersMap unusable
@@ -1635,7 +1628,6 @@ mkUnitState ctx printer cfg = do
          , requirementContext           = req_ctx
          , allowVirtualUnits            = unitConfigAllowVirtual cfg
          }
-
   return (state, raw_dbs)
 
 -- | Given a wired-in 'Unit', "unwire" it into the 'Unit'
@@ -1775,30 +1767,6 @@ addListTo = foldl' merge
 mkModMap :: Unit -> ModuleName -> ModuleOrigin -> Map Module ModuleOrigin
 mkModMap pkg mod = Map.singleton (mkModule pkg mod)
 
--- -----------------------------------------------------------------------------
--- Extracting information from the packages in scope
-
--- Many of these functions take a list of packages: in those cases,
--- the list is expected to contain the "dependent packages",
--- i.e. those packages that were found to be depended on by the
--- current module/program.  These can be auto or non-auto packages, it
--- doesn't really matter.  The list is always combined with the list
--- of preload (command-line) packages to determine which packages to
--- use.
-
--- | Find all the include directories in these and the preload packages
-getUnitIncludePath :: SDocContext -> UnitState -> HomeUnit -> [UnitId] -> IO [String]
-getUnitIncludePath ctx unit_state home_unit pkgs =
-  collectIncludeDirs `fmap` getPreloadUnitsAnd ctx unit_state home_unit pkgs
-
-collectIncludeDirs :: [UnitInfo] -> [FilePath]
-collectIncludeDirs ps = map ST.unpack $ ordNub (filter (not . ST.null) (concatMap unitIncludeDirs ps))
-
--- | Find all the C-compiler options in these and the preload packages
-getUnitExtraCcOpts :: SDocContext -> UnitState -> HomeUnit -> [UnitId] -> IO [String]
-getUnitExtraCcOpts ctx unit_state home_unit pkgs = do
-  ps <- getPreloadUnitsAnd ctx unit_state home_unit pkgs
-  return $ map ST.unpack (concatMap unitCcOptions ps)
 
 -- -----------------------------------------------------------------------------
 -- Package Utils
@@ -1923,39 +1891,15 @@ listVisibleModuleNames state =
     map fst (filter visible (Map.toList (moduleNameProvidersMap state)))
   where visible (_, ms) = any originVisible (Map.elems ms)
 
--- | Lookup 'UnitInfo' for every preload unit from the UnitState, for every unit
--- used to instantiate the home unit, and for every unit explicitly passed in
--- the given list of UnitId.
-getPreloadUnitsAnd :: SDocContext -> UnitState -> HomeUnit -> [UnitId] -> IO [UnitInfo]
-getPreloadUnitsAnd ctx unit_state home_unit ids0 =
-  let
-      ids      = ids0 ++ inst_ids
-      inst_ids
-         -- An indefinite package will have insts to HOLE,
-         -- which is not a real package. Don't look it up.
-         -- Fixes #14525
-         | isHomeUnitIndefinite home_unit = []
-         | otherwise = map (toUnitId . moduleUnit . snd) (homeUnitInstantiations home_unit)
-      pkg_map = unitInfoMap unit_state
-      preload = preloadUnits unit_state
-  in do
-  all_pkgs <- throwErr ctx (closeUnitDeps' pkg_map preload (ids `zip` repeat Nothing))
-  return (map (unsafeLookupUnitId unit_state) all_pkgs)
-
-throwErr :: SDocContext -> MaybeErr MsgDoc a -> IO a
-throwErr ctx m = case m of
-   Failed e    -> throwGhcExceptionIO (CmdLineError (renderWithContext ctx e))
-   Succeeded r -> return r
-
 -- | Takes a list of UnitIds (and their "parent" dependency, used for error
 -- messages), and returns the list with dependencies included, in reverse
 -- dependency order (a units appears before those it depends on).
-closeUnitDeps :: UnitInfoMap -> [(UnitId,Maybe UnitId)] -> MaybeErr MsgDoc [UnitId]
+closeUnitDeps :: UnitInfoMap -> [(UnitId,Maybe UnitId)] -> MaybeErr UnitErr [UnitId]
 closeUnitDeps pkg_map ps = closeUnitDeps' pkg_map [] ps
 
 -- | Similar to closeUnitDeps but takes a list of already loaded units as an
 -- additional argument.
-closeUnitDeps' :: UnitInfoMap -> [UnitId] -> [(UnitId,Maybe UnitId)] -> MaybeErr MsgDoc [UnitId]
+closeUnitDeps' :: UnitInfoMap -> [UnitId] -> [(UnitId,Maybe UnitId)] -> MaybeErr UnitErr [UnitId]
 closeUnitDeps' pkg_map current_ids ps = foldM (add_unit pkg_map) current_ids ps
 
 -- | Add a UnitId and those it depends on (recursively) to the given list of
@@ -1968,16 +1912,11 @@ closeUnitDeps' pkg_map current_ids ps = foldM (add_unit pkg_map) current_ids ps
 add_unit :: UnitInfoMap
             -> [UnitId]
             -> (UnitId,Maybe UnitId)
-            -> MaybeErr MsgDoc [UnitId]
+            -> MaybeErr UnitErr [UnitId]
 add_unit pkg_map ps (p, mb_parent)
   | p `elem` ps = return ps     -- Check if we've already added this unit
   | otherwise   = case lookupUnitId' pkg_map p of
-      Nothing -> Failed $
-                   (ftext (fsLit "unknown package:") <+> ppr p)
-                   <> case mb_parent of
-                         Nothing     -> Outputable.empty
-                         Just parent -> space <> parens (text "dependency of"
-                                                  <+> ftext (unitIdFS parent))
+      Nothing   -> Failed (CloseUnitErr p mb_parent)
       Just info -> do
          -- Add the unit's dependents also
          ps' <- foldM add_unit_key ps (unitDepends info)
@@ -1986,6 +1925,44 @@ add_unit pkg_map ps (p, mb_parent)
           add_unit_key ps key
             = add_unit pkg_map ps (key, Just p)
 
+data UnitErr
+  = CloseUnitErr !UnitId !(Maybe UnitId)
+  | PackageFlagErr !PackageFlag ![(UnitInfo,UnusableUnitReason)]
+  | TrustFlagErr   !TrustFlag   ![(UnitInfo,UnusableUnitReason)]
+
+mayThrowUnitErr :: MaybeErr UnitErr a -> IO a
+mayThrowUnitErr = \case
+    Failed e    -> throwGhcExceptionIO
+                    $ CmdLineError
+                    $ renderWithContext defaultSDocContext
+                    $ withPprStyle defaultUserStyle
+                    $ ppr e
+    Succeeded a -> return a
+
+instance Outputable UnitErr where
+    ppr = \case
+        CloseUnitErr p mb_parent
+            -> (ftext (fsLit "unknown unit:") <+> ppr p)
+               <> case mb_parent of
+                     Nothing     -> Outputable.empty
+                     Just parent -> space <> parens (text "dependency of"
+                                              <+> ftext (unitIdFS parent))
+        PackageFlagErr flag reasons
+            -> flag_err (pprFlag flag) reasons
+
+        TrustFlagErr flag reasons
+            -> flag_err (pprTrustFlag flag) reasons
+      where
+        flag_err flag_doc reasons =
+            text "cannot satisfy "
+            <> flag_doc
+            <> (if null reasons then Outputable.empty else text ": ")
+            $$ nest 4 (vcat (map ppr_reason reasons) $$
+                      text "(use -v for more information)")
+
+        ppr_reason (p, reason) =
+            pprReason (ppr (unitId p) <+> text "is") reason
+
 -- -----------------------------------------------------------------------------
 
 -- | Pretty-print a UnitId for the user.