Add HomeUnit type

Since Backpack the "home unit" is much more involved than what it was
before (just an identifier obtained with `-this-unit-id`). Now it is
used in conjunction with `-component-id` and `-instantiated-with` to
configure module instantiations and to detect if we are type-checking an
indefinite unit or compiling a definite one.

This patch introduces a new HomeUnit datatype which is much easier to
understand. Moreover to make GHC support several packages in the same
instances, we will need to handle several HomeUnits so having a
dedicated (documented) type is helpful.

Finally in #14335 we will also need to handle the case where we have no
HomeUnit at all because we are only loading existing interfaces for
plugins which live in a different space compared to units used to
produce target code. Several functions will have to be refactored to
accept "Maybe HomeUnit" parameters instead of implicitly querying the
HomeUnit fields in DynFlags. Having a dedicated type will make this
easier.

Bump haddock submodule

6 files changed, 55 insertions, 42 deletions

diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index b7ed66734e..508a6b8281 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -82,6 +82,7 @@ import GHC.Types.FieldLabel
 import GHC.Iface.Rename
 import GHC.Types.Unique.DSet
 import GHC.Driver.Plugins
+import GHC.Unit.Home
 
 import Control.Monad
 import Control.Exception
@@ -402,8 +403,9 @@ loadInterface doc_str mod from
   | isHoleModule mod
   -- Hole modules get special treatment
   = do dflags <- getDynFlags
+       let home_unit = mkHomeUnitFromFlags dflags
        -- Redo search for our local hole module
-       loadInterface doc_str (mkHomeModule dflags (moduleName mod)) from
+       loadInterface doc_str (mkHomeModule home_unit (moduleName mod)) from
   | otherwise
   = withTimingSilentD (text "loading interface") (pure ()) $
     do  {       -- Read the state
@@ -414,6 +416,7 @@ loadInterface doc_str mod from
 
                 -- Check whether we have the interface already
         ; dflags <- getDynFlags
+        ; let home_unit = mkHomeUnitFromFlags dflags
         ; case lookupIfaceByModule hpt (eps_PIT eps) mod of {
             Just iface
                 -> return (Succeeded iface) ;   -- Already loaded
@@ -423,7 +426,7 @@ loadInterface doc_str mod from
             _ -> do {
 
         -- READ THE MODULE IN
-        ; read_result <- case (wantHiBootFile dflags eps mod from) of
+        ; read_result <- case (wantHiBootFile home_unit eps mod from) of
                            Failed err             -> return (Failed err)
                            Succeeded hi_boot_file -> computeInterface doc_str hi_boot_file mod
         ; case read_result of {
@@ -494,7 +497,7 @@ loadInterface doc_str mod from
 
         ; WARN( bad_boot, ppr mod )
           updateEps_  $ \ eps ->
-           if elemModuleEnv mod (eps_PIT eps) || is_external_sig dflags iface
+           if elemModuleEnv mod (eps_PIT eps) || is_external_sig home_unit iface
                 then eps
            else if bad_boot
                 -- See Note [Loading your own hi-boot file]
@@ -616,12 +619,12 @@ dontLeakTheHPT thing_inside = do
 -- | Returns @True@ if a 'ModIface' comes from an external package.
 -- In this case, we should NOT load it into the EPS; the entities
 -- should instead come from the local merged signature interface.
-is_external_sig :: DynFlags -> ModIface -> Bool
-is_external_sig dflags iface =
+is_external_sig :: HomeUnit -> ModIface -> Bool
+is_external_sig home_unit iface =
     -- It's a signature iface...
     mi_semantic_module iface /= mi_module iface &&
     -- and it's not from the local package
-    moduleUnit (mi_module iface) /= homeUnit dflags
+    not (isHomeModule home_unit (mi_module iface))
 
 -- | This is an improved version of 'findAndReadIface' which can also
 -- handle the case when a user requests @p[A=<B>]:M@ but we only
@@ -643,8 +646,9 @@ computeInterface ::
 computeInterface doc_str hi_boot_file mod0 = do
     MASSERT( not (isHoleModule mod0) )
     dflags <- getDynFlags
+    let home_unit = mkHomeUnitFromFlags dflags
     case getModuleInstantiation mod0 of
-        (imod, Just indef) | homeUnitIsIndefinite dflags -> do
+        (imod, Just indef) | isHomeUnitIndefinite home_unit -> do
             r <- findAndReadIface doc_str imod mod0 hi_boot_file
             case r of
                 Succeeded (iface0, path) -> do
@@ -702,13 +706,13 @@ moduleFreeHolesPrecise doc_str mod
                 return (Succeeded (renameFreeHoles ifhs insts))
             Failed err -> return (Failed err)
 
-wantHiBootFile :: DynFlags -> ExternalPackageState -> Module -> WhereFrom
+wantHiBootFile :: HomeUnit -> ExternalPackageState -> Module -> WhereFrom
                -> MaybeErr MsgDoc IsBootInterface
 -- Figure out whether we want Foo.hi or Foo.hi-boot
-wantHiBootFile dflags eps mod from
+wantHiBootFile home_unit eps mod from
   = case from of
        ImportByUser usr_boot
-          | usr_boot == IsBoot && not this_package
+          | usr_boot == IsBoot && notHomeModule home_unit mod
           -> Failed (badSourceImport mod)
           | otherwise -> Succeeded usr_boot
 
@@ -716,10 +720,12 @@ wantHiBootFile dflags eps mod from
           -> Succeeded NotBoot
 
        ImportBySystem
-          | not this_package   -- If the module to be imported is not from this package
-          -> Succeeded NotBoot -- don't look it up in eps_is_boot, because that is keyed
-                               -- on the ModuleName of *home-package* modules only.
-                               -- We never import boot modules from other packages!
+          | notHomeModule home_unit mod
+          -> Succeeded NotBoot
+             -- If the module to be imported is not from this package
+             -- don't look it up in eps_is_boot, because that is keyed
+             -- on the ModuleName of *home-package* modules only.
+             -- We never import boot modules from other packages!
 
           | otherwise
           -> case lookupUFM (eps_is_boot eps) (moduleName mod) of
@@ -729,8 +735,6 @@ wantHiBootFile dflags eps mod from
                   Succeeded NotBoot
                      -- The boot-ness of the requested interface,
                      -- based on the dependencies in directly-imported modules
-  where
-    this_package = homeUnit dflags == moduleUnit mod
 
 badSourceImport :: Module -> SDoc
 badSourceImport mod
@@ -922,6 +926,7 @@ findAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file
                -- Look for the file
                hsc_env <- getTopEnv
                mb_found <- liftIO (findExactModule hsc_env mod)
+               let home_unit = mkHomeUnitFromFlags dflags
                case mb_found of
                    InstalledFound loc mod -> do
                        -- Found file, so read it
@@ -929,7 +934,7 @@ findAndReadIface doc_str mod wanted_mod_with_insts hi_boot_file
                                                            (ml_hi_file loc)
 
                        -- See Note [Home module load error]
-                       if moduleUnit mod `unitIdEq` homeUnit dflags &&
+                       if isHomeInstalledModule home_unit mod &&
                           not (isOneShot (ghcMode dflags))
                            then return (Failed (homeModError mod loc))
                            else do r <- read_file file_path
@@ -1020,8 +1025,8 @@ readIface wanted_mod file_path
 *********************************************************
 -}
 
-initExternalPackageState :: DynFlags -> ExternalPackageState
-initExternalPackageState dflags
+initExternalPackageState :: HomeUnit -> ExternalPackageState
+initExternalPackageState home_unit
   = EPS {
       eps_is_boot          = emptyUFM,
       eps_PIT              = emptyPackageIfaceTable,
@@ -1041,9 +1046,9 @@ initExternalPackageState dflags
     }
     where
       enableBignumRules
-         | homeUnitId dflags == primUnitId   = EnableBignumRules False
-         | homeUnitId dflags == bignumUnitId = EnableBignumRules False
-         | otherwise                         = EnableBignumRules True
+         | isHomeUnitInstanceOf home_unit primUnitId   = EnableBignumRules False
+         | isHomeUnitInstanceOf home_unit bignumUnitId = EnableBignumRules False
+         | otherwise                                   = EnableBignumRules True
       builtinRules' = builtinRules enableBignumRules
 
 {-
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index 3c33c0a3b6..575ef06a11 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -57,7 +57,7 @@ import GHC.Types.Avail
 import GHC.Types.Name.Reader
 import GHC.Types.Name.Env
 import GHC.Types.Name.Set
-import GHC.Unit.Module
+import GHC.Unit
 import GHC.Utils.Error
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
@@ -168,10 +168,9 @@ mkIfaceTc hsc_env safe_mode mod_details
                     }
   = do
           let used_names = mkUsedNames tc_result
-          let pluginModules =
-                map lpModule (cachedPlugins (hsc_dflags hsc_env))
-          deps <- mkDependencies
-                    (homeUnitId (hsc_dflags hsc_env))
+          let pluginModules = map lpModule (cachedPlugins (hsc_dflags hsc_env))
+          let home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+          deps <- mkDependencies (homeUnitId home_unit)
                     (map mi_module pluginModules) tc_result
           let hpc_info = emptyHpcInfo other_hpc_info
           used_th <- readIORef tc_splice_used
@@ -226,7 +225,8 @@ mkIface_ hsc_env
 --      to expose in the interface
 
   = do
-    let semantic_mod = canonicalizeHomeModule (hsc_dflags hsc_env) (moduleName this_mod)
+    let home_unit    = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+        semantic_mod = homeModuleNameInstantiation home_unit (moduleName this_mod)
         entities = typeEnvElts type_env
         show_linear_types = xopt LangExt.LinearTypes (hsc_dflags hsc_env)
         decls  = [ tyThingToIfaceDecl show_linear_types entity
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 7c8dc9722c..2ffb094b11 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -44,6 +44,7 @@ import GHC.Utils.Fingerprint
 import GHC.Utils.Exception
 import GHC.Types.Unique.Set
 import GHC.Unit.State
+import GHC.Unit.Home
 
 import Control.Monad
 import Data.Function
@@ -215,7 +216,7 @@ checkVersions hsc_env mod_summary iface
        -- readIface will have verified that the UnitId matches,
        -- but we ALSO must make sure the instantiation matches up.  See
        -- test case bkpcabal04!
-       ; if moduleUnit (mi_module iface) /= homeUnit (hsc_dflags hsc_env)
+       ; if not (isHomeModule home_unit (mi_module iface))
             then return (RecompBecause "-this-unit-id changed", Nothing) else do {
        ; recomp <- checkFlagHash hsc_env iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
@@ -249,11 +250,12 @@ checkVersions hsc_env mod_summary iface
        -- all the dependent modules should be in the HPT already, so it's
        -- quite redundant
        ; updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
-       ; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
+       ; recomp <- checkList [checkModUsage (homeUnitAsUnit home_unit) u
+                             | u <- mi_usages iface]
        ; return (recomp, Just iface)
     }}}}}}}}}}
   where
-    this_pkg = homeUnit (hsc_dflags hsc_env)
+    home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
     -- This is a bit of a hack really
     mod_deps :: ModuleNameEnv ModuleNameWithIsBoot
     mod_deps = mkModDeps (dep_mods (mi_deps iface))
@@ -333,9 +335,10 @@ pluginRecompileToRecompileRequired old_fp new_fp pr
 checkHsig :: ModSummary -> ModIface -> IfG RecompileRequired
 checkHsig mod_summary iface = do
     dflags <- getDynFlags
-    let outer_mod = ms_mod mod_summary
-        inner_mod = canonicalizeHomeModule dflags (moduleName outer_mod)
-    MASSERT( moduleUnit outer_mod == homeUnit dflags )
+    let home_unit = mkHomeUnitFromFlags dflags
+        outer_mod = ms_mod mod_summary
+        inner_mod = homeModuleNameInstantiation home_unit (moduleName outer_mod)
+    MASSERT( isHomeModule home_unit outer_mod )
     case inner_mod == mi_semantic_module iface of
         True -> up_to_date (text "implementing module unchanged")
         False -> return (RecompBecause "implementing module changed")
@@ -449,15 +452,14 @@ checkDependencies hsc_env summary iface
    prev_dep_mods = dep_mods (mi_deps iface)
    prev_dep_plgn = dep_plgins (mi_deps iface)
    prev_dep_pkgs = dep_pkgs (mi_deps iface)
-
-   this_pkg = homeUnit (hsc_dflags hsc_env)
+   home_unit     = mkHomeUnitFromFlags (hsc_dflags hsc_env)
 
    dep_missing (mb_pkg, L _ mod) = do
      find_res <- liftIO $ findImportedModule hsc_env mod (mb_pkg)
      let reason = moduleNameString mod ++ " changed"
      case find_res of
         Found _ mod
-          | pkg == this_pkg
+          | isHomeUnit home_unit pkg
            -> if moduleName mod `notElem` map gwib_mod prev_dep_mods ++ prev_dep_plgn
                  then do traceHiDiffs $
                            text "imported module " <> quotes (ppr mod) <>
@@ -483,7 +485,8 @@ checkDependencies hsc_env summary iface
    isOldHomeDeps = flip Set.member old_deps
    checkForNewHomeDependency (L _ mname) = do
      let
-       mod = mkModule this_pkg mname
+       home_unit = mkHomeUnitFromFlags (hsc_dflags hsc_env)
+       mod = mkHomeModule home_unit mname
        str_mname = moduleNameString mname
        reason = str_mname ++ " changed"
      -- We only want to look at home modules to check if any new home dependency
@@ -1351,11 +1354,12 @@ mkHashFun
         -> (Name -> IO Fingerprint)
 mkHashFun hsc_env eps name
   | isHoleModule orig_mod
-  = lookup (mkHomeModule dflags (moduleName orig_mod))
+  = lookup (mkHomeModule home_unit (moduleName orig_mod))
   | otherwise
   = lookup orig_mod
   where
       dflags = hsc_dflags hsc_env
+      home_unit = mkHomeUnitFromFlags dflags
       hpt = hsc_HPT hsc_env
       pit = eps_PIT eps
       occ = nameOccName name
diff --git a/compiler/GHC/Iface/Recomp/Flags.hs b/compiler/GHC/Iface/Recomp/Flags.hs
index 391aaf2c86..3cbfdd1e3b 100644
--- a/compiler/GHC/Iface/Recomp/Flags.hs
+++ b/compiler/GHC/Iface/Recomp/Flags.hs
@@ -36,7 +36,7 @@ fingerprintDynFlags :: DynFlags -> Module
 fingerprintDynFlags dflags@DynFlags{..} this_mod nameio =
     let mainis   = if mainModIs == this_mod then Just mainFunIs else Nothing
                       -- see #5878
-        -- pkgopts  = (homeUnit dflags, sort $ packageFlags dflags)
+        -- pkgopts  = (homeUnit home_unit, sort $ packageFlags dflags)
         safeHs   = setSafeMode safeHaskell
         -- oflags   = sort $ filter filterOFlags $ flags dflags
 
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index ed8ac78761..376eee8350 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -299,6 +299,7 @@ rnIfaceGlobal :: Name -> ShIfM Name
 rnIfaceGlobal n = do
     hsc_env <- getTopEnv
     let dflags = hsc_dflags hsc_env
+        home_unit = mkHomeUnitFromFlags dflags
     iface_semantic_mod <- fmap sh_if_semantic_module getGblEnv
     mb_nsubst <- fmap sh_if_shape getGblEnv
     hmap <- getHoleSubst
@@ -342,7 +343,7 @@ rnIfaceGlobal n = do
             -- went from <A> to <B>.
             let m'' = if isHoleModule m'
                         -- Pull out the local guy!!
-                        then mkHomeModule dflags (moduleName m')
+                        then mkHomeModule home_unit (moduleName m')
                         else m'
             iface <- liftIO . initIfaceCheck (text "rnIfaceGlobal") hsc_env
                             $ loadSysInterface (text "rnIfaceGlobal") m''
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index f687f2951b..557c3e0922 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -368,7 +368,10 @@ tidyProgram hsc_env  (ModGuts { mg_module    = mod
                    (const ()) $
     do  { let { omit_prags = gopt Opt_OmitInterfacePragmas dflags
               ; expose_all = gopt Opt_ExposeAllUnfoldings  dflags
-              ; print_unqual = mkPrintUnqualified dflags rdr_env
+              ; print_unqual = mkPrintUnqualified
+                                 (unitState dflags)
+                                 (mkHomeUnitFromFlags dflags)
+                                 rdr_env
               ; implicit_binds = concatMap getImplicitBinds tcs
               }