Refactor homeUnit

* rename thisPackage into homeUnit
* document and refactor several Backpack things

compiler/GHC.hs

@@ -1489,7 +1489,7 @@ findModule :: GhcMonad m => ModuleName -> Maybe FastString -> m Module
 findModule mod_name maybe_pkg = withSession $ \hsc_env -> do
   let
     dflags   = hsc_dflags hsc_env
-    this_pkg = thisPackage dflags
+    this_pkg = homeUnit dflags
   --
   case maybe_pkg of
     Just pkg | fsToUnit pkg /= this_pkg && pkg /= fsLit "this" -> liftIO $ do

compiler/GHC/Cmm/Parser.y

@@ -377,7 +377,7 @@ cmmtop  :: { CmmParse () }
         | cmmdata                       { $1 }
         | decl                          { $1 }
         | 'CLOSURE' '(' NAME ',' NAME lits ')' ';'
-                {% liftP . withThisPackage $ \pkg ->
+                {% liftP . withHomeUnit $ \pkg ->
                    do lits <- sequence $6;
                       staticClosure pkg $3 $5 (map getLit lits) }
 
@@ -398,7 +398,7 @@ cmmdata :: { CmmParse () }
 
 data_label :: { CmmParse CLabel }
     : NAME ':'
-                {% liftP . withThisPackage $ \pkg ->
+                {% liftP . withHomeUnit $ \pkg ->
                    return (mkCmmDataLabel pkg $1) }
 
 statics :: { [CmmParse [CmmStatic]] }
@@ -455,14 +455,14 @@ maybe_body :: { CmmParse () }
 
 info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
         : NAME
-                {% liftP . withThisPackage $ \pkg ->
+                {% liftP . withHomeUnit $ \pkg ->
                    do   newFunctionName $1 pkg
                         return (mkCmmCodeLabel pkg $1, Nothing, []) }
 
 
         | 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
                 -- ptrs, nptrs, closure type, description, type
-                {% liftP . withThisPackage $ \pkg ->
+                {% liftP . withHomeUnit $ \pkg ->
                    do dflags <- getDynFlags
                       let prof = profilingInfo dflags $11 $13
                           rep  = mkRTSRep (fromIntegral $9) $
@@ -478,7 +478,7 @@ info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
 
         | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
                 -- ptrs, nptrs, closure type, description, type, fun type
-                {% liftP . withThisPackage $ \pkg ->
+                {% liftP . withHomeUnit $ \pkg ->
                    do dflags <- getDynFlags
                       let prof = profilingInfo dflags $11 $13
                           ty   = Fun 0 (ArgSpec (fromIntegral $15))
@@ -496,7 +496,7 @@ info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
 
         | 'INFO_TABLE_CONSTR' '(' NAME ',' INT ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
                 -- ptrs, nptrs, tag, closure type, description, type
-                {% liftP . withThisPackage $ \pkg ->
+                {% liftP . withHomeUnit $ \pkg ->
                    do dflags <- getDynFlags
                       let prof = profilingInfo dflags $13 $15
                           ty  = Constr (fromIntegral $9)  -- Tag
@@ -515,7 +515,7 @@ info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
 
         | 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')'
                 -- selector, closure type, description, type
-                {% liftP . withThisPackage $ \pkg ->
+                {% liftP . withHomeUnit $ \pkg ->
                    do dflags <- getDynFlags
                       let prof = profilingInfo dflags $9 $11
                           ty  = ThunkSelector (fromIntegral $5)
@@ -529,7 +529,7 @@ info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
 
         | 'INFO_TABLE_RET' '(' NAME ',' INT ')'
                 -- closure type (no live regs)
-                {% liftP . withThisPackage $ \pkg ->
+                {% liftP . withHomeUnit $ \pkg ->
                    do let prof = NoProfilingInfo
                           rep  = mkRTSRep (fromIntegral $5) $ mkStackRep []
                       return (mkCmmRetLabel pkg $3,
@@ -540,7 +540,7 @@ info    :: { CmmParse (CLabel, Maybe CmmInfoTable, [LocalReg]) }
 
         | 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals0 ')'
                 -- closure type, live regs
-                {% liftP . withThisPackage $ \pkg ->
+                {% liftP . withHomeUnit $ \pkg ->
                    do dflags <- getDynFlags
                       let platform = targetPlatform dflags
                       live <- sequence $7

compiler/GHC/CmmToAsm/Monad.hs

@@ -149,7 +149,7 @@ mkNatM_State us delta dflags this_mod
 initConfig :: DynFlags -> NCGConfig
 initConfig dflags = NCGConfig
    { ncgPlatform              = targetPlatform dflags
-   , ncgUnitId                = thisPackage dflags
+   , ncgUnitId                = homeUnit dflags
    , ncgProcAlignment         = cmmProcAlignment dflags
    , ncgDebugLevel            = debugLevel dflags
    , ncgExternalDynamicRefs   = gopt Opt_ExternalDynamicRefs dflags

compiler/GHC/CoreToStg/Prep.hs

@@ -1556,9 +1556,9 @@ lookupNaturalSDataConName dflags hsc_env = case integerLibrary dflags of
 -- | Helper for 'lookupMkIntegerName', 'lookupIntegerSDataConName'
 guardIntegerUse :: DynFlags -> IO a -> IO a
 guardIntegerUse dflags act
-  | thisPackage dflags == primUnitId
+  | homeUnit dflags == primUnitId
   = return $ panic "Can't use Integer in ghc-prim"
-  | thisPackage dflags == integerUnitId
+  | homeUnit dflags == integerUnitId
   = return $ panic "Can't use Integer in integer-*"
   | otherwise = act
 
@@ -1568,11 +1568,11 @@ guardIntegerUse dflags act
 -- literals in `base`. If we do, we get interface loading error for GHC.Natural.
 guardNaturalUse :: DynFlags -> IO a -> IO a
 guardNaturalUse dflags act
-  | thisPackage dflags == primUnitId
+  | homeUnit dflags == primUnitId
   = return $ panic "Can't use Natural in ghc-prim"
-  | thisPackage dflags == integerUnitId
+  | homeUnit dflags == integerUnitId
   = return $ panic "Can't use Natural in integer-*"
-  | thisPackage dflags == baseUnitId
+  | homeUnit dflags == baseUnitId
   = return $ panic "Can't use Natural in base"
   | otherwise = act
 

compiler/GHC/Driver/Backpack.hs

@@ -171,9 +171,12 @@ withBkpSession cid insts deps session_type do_this = do
         hscTarget   = case session_type of
                         TcSession -> HscNothing
                         _ -> hscTarget dflags,
-        thisUnitIdInsts_ = Just insts,
-        thisComponentId_ = Just cid,
-        thisUnitId =
+        homeUnitInstantiations = insts,
+                                 -- if we don't have any instantiation, don't
+                                 -- fill `homeUnitInstanceOfId` as it makes no
+                                 -- sense (we're not instantiating anything)
+        homeUnitInstanceOfId   = if null insts then Nothing else Just cid,
+        homeUnitId =
             case session_type of
                 TcSession -> newUnitId cid Nothing
                 -- No hash passed if no instances
@@ -312,7 +315,7 @@ buildUnit session cid insts lunit = do
             unitPackageId = PackageId compat_fs,
             unitPackageName = compat_pn,
             unitPackageVersion = makeVersion [],
-            unitId = toUnitId (thisPackage dflags),
+            unitId = toUnitId (homeUnit dflags),
             unitComponentName = Nothing,
             unitInstanceOf = cid,
             unitInstantiations = insts,
@@ -652,7 +655,7 @@ hsunitModuleGraph dflags unit = do
     --  requirement.
     let node_map = Map.fromList [ ((ms_mod_name n, ms_hsc_src n == HsigFile), n)
                                 | n <- nodes ]
-    req_nodes <- fmap catMaybes . forM (thisUnitIdInsts dflags) $ \(mod_name, _) ->
+    req_nodes <- fmap catMaybes . forM (homeUnitInstantiations dflags) $ \(mod_name, _) ->
         let has_local = Map.member (mod_name, True) node_map
         in if has_local
             then return Nothing

compiler/GHC/Driver/Finder.hs

@@ -74,7 +74,7 @@ flushFinderCaches :: HscEnv -> IO ()
 flushFinderCaches hsc_env =
   atomicModifyIORef' fc_ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ())
  where
-        this_pkg = thisPackage (hsc_dflags hsc_env)
+        this_pkg = homeUnit (hsc_dflags hsc_env)
         fc_ref = hsc_FC hsc_env
         is_ext mod _ | not (moduleUnit mod `unitIdEq` this_pkg) = True
                      | otherwise = False
@@ -135,7 +135,7 @@ findPluginModule hsc_env mod_name =
 findExactModule :: HscEnv -> InstalledModule -> IO InstalledFindResult
 findExactModule hsc_env mod =
     let dflags = hsc_dflags hsc_env
-    in if moduleUnit mod `unitIdEq` thisPackage dflags
+    in if moduleUnit mod `unitIdEq` homeUnit dflags
        then findInstalledHomeModule hsc_env (moduleName mod)
        else findPackageModule hsc_env mod
 
@@ -245,7 +245,7 @@ modLocationCache hsc_env mod do_this = do
 
 mkHomeInstalledModule :: DynFlags -> ModuleName -> InstalledModule
 mkHomeInstalledModule dflags mod_name =
-  let iuid = thisUnitId dflags
+  let iuid = homeUnitId dflags
   in Module iuid mod_name
 
 -- This returns a module because it's more convenient for users
@@ -253,7 +253,7 @@ addHomeModuleToFinder :: HscEnv -> ModuleName -> ModLocation -> IO Module
 addHomeModuleToFinder hsc_env mod_name loc = do
   let mod = mkHomeInstalledModule (hsc_dflags hsc_env) mod_name
   addToFinderCache (hsc_FC hsc_env) mod (InstalledFound loc mod)
-  return (mkModule (thisPackage (hsc_dflags hsc_env)) mod_name)
+  return (mkHomeModule (hsc_dflags hsc_env) mod_name)
 
 uncacheModule :: HscEnv -> ModuleName -> IO ()
 uncacheModule hsc_env mod_name = do
@@ -279,7 +279,7 @@ findHomeModule hsc_env mod_name = do
       }
  where
   dflags = hsc_dflags hsc_env
-  uid = thisPackage dflags
+  uid    = homeUnit dflags
 
 -- | Implements the search for a module name in the home package only.  Calling
 -- this function directly is usually *not* what you want; currently, it's used
@@ -678,7 +678,7 @@ cantFindErr cannot_find _ dflags mod_name find_result
             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, pkg /= thisPackage dflags
+                | Just pkg <- mb_pkg, pkg /= homeUnit dflags
                 -> not_found_in_package pkg files
 
                 | not (null suggest)
@@ -794,7 +794,7 @@ cantFindInstalledErr cannot_find _ dflags mod_name find_result
                    text "was found" $$ looks_like_srcpkgid pkg
 
             InstalledNotFound files mb_pkg
-                | Just pkg <- mb_pkg, not (pkg `unitIdEq` thisPackage dflags)
+                | Just pkg <- mb_pkg, not (pkg `unitIdEq` homeUnit dflags)
                 -> not_found_in_package pkg files
 
                 | null files

compiler/GHC/Driver/Main.hs

@@ -470,12 +470,12 @@ hsc_typecheck keep_rn mod_summary mb_rdr_module = do
         dflags = hsc_dflags hsc_env
         outer_mod = ms_mod mod_summary
         mod_name = moduleName outer_mod
-        outer_mod' = mkModule (thisPackage dflags) mod_name
+        outer_mod' = mkHomeModule dflags mod_name
         inner_mod = canonicalizeHomeModule dflags mod_name
         src_filename  = ms_hspp_file mod_summary
         real_loc = realSrcLocSpan $ mkRealSrcLoc (mkFastString src_filename) 1 1
         keep_rn' = gopt Opt_WriteHie dflags || keep_rn
-    MASSERT( moduleUnit outer_mod == thisPackage dflags )
+    MASSERT( isHomeModule dflags outer_mod )
     tc_result <- if hsc_src == HsigFile && not (isHoleModule inner_mod)
         then ioMsgMaybe $ tcRnInstantiateSignature hsc_env outer_mod' real_loc
         else
@@ -1116,8 +1116,8 @@ hscCheckSafe' m l = do
     dflags <- getDynFlags
     (tw, pkgs) <- isModSafe m l
     case tw of
-        False                     -> return (Nothing, pkgs)
-        True | isHomePkg dflags m -> return (Nothing, pkgs)
+        False                        -> return (Nothing, pkgs)
+        True | isHomeModule dflags m -> return (Nothing, pkgs)
              -- TODO: do we also have to check the trust of the instantiation?
              -- Not necessary if that is reflected in dependencies
              | otherwise   -> return (Just $ toUnitId (moduleUnit m), pkgs)
@@ -1191,7 +1191,7 @@ hscCheckSafe' m l = do
     packageTrusted _ Sf_Safe  False _ = True
     packageTrusted _ Sf_SafeInferred False _ = True
     packageTrusted dflags _ _ m
-        | isHomePkg dflags m = True
+        | isHomeModule dflags m = True
         | otherwise = unitIsTrusted $ unsafeGetUnitInfo dflags (moduleUnit m)
 
     lookup' :: Module -> Hsc (Maybe ModIface)
@@ -1210,11 +1210,6 @@ hscCheckSafe' m l = do
         return iface'
 
 
-    isHomePkg :: DynFlags -> Module -> Bool
-    isHomePkg dflags m
-        | thisPackage dflags == moduleUnit m = True
-        | otherwise                               = False
-
 -- | Check the list of packages are trusted.
 checkPkgTrust :: Set UnitId -> Hsc ()
 checkPkgTrust pkgs = do
@@ -1493,7 +1488,7 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
         let -- Make up a module name to give the NCG. We can't pass bottom here
             -- lest we reproduce #11784.
             mod_name = mkModuleName $ "Cmm$" ++ FilePath.takeFileName filename
-            cmm_mod = mkModule (thisPackage dflags) mod_name
+            cmm_mod = mkHomeModule dflags mod_name
 
         -- Compile decls in Cmm files one decl at a time, to avoid re-ordering
         -- them in SRT analysis.

compiler/GHC/Driver/Make.hs

@@ -656,7 +656,7 @@ discardIC hsc_env
     | nameIsFromExternalPackage this_pkg old_name = old_name
     | otherwise = ic_name empty_ic
     where
-    this_pkg = thisPackage dflags
+    this_pkg = homeUnit dflags
     old_name = ic_name old_ic
 
 -- | If there is no -o option, guess the name of target executable
@@ -1200,7 +1200,7 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup
             zipWith f home_imps     (repeat NotBoot) ++
             zipWith f home_src_imps (repeat IsBoot)
           where f mn isBoot = GWIB
-                  { gwib_mod = mkModule (thisPackage lcl_dflags) mn
+                  { gwib_mod = mkHomeModule lcl_dflags mn
                   , gwib_isBoot = isBoot
                   }
 
@@ -2213,7 +2213,7 @@ enableCodeGenForTH =
       hscTarget dflags == HscNothing &&
       -- Don't enable codegen for TH on indefinite packages; we
       -- can't compile anything anyway! See #16219.
-      not (isIndefinite dflags)
+      homeUnitIsDefinite dflags
 
 -- | Update the every ModSummary that is depended on
 -- by a module that needs unboxed tuples. We enable codegen to
@@ -2560,12 +2560,12 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                               $$ text "Saw:" <+> quotes (ppr pi_mod_name)
                               $$ text "Expected:" <+> quotes (ppr wanted_mod)
 
-        when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (thisUnitIdInsts dflags))) $
+        when (hsc_src == HsigFile && isNothing (lookup pi_mod_name (homeUnitInstantiations dflags))) $
             let suggested_instantiated_with =
                     hcat (punctuate comma $
                         [ ppr k <> text "=" <> ppr v
                         | (k,v) <- ((pi_mod_name, mkHoleModule pi_mod_name)
-                                : thisUnitIdInsts dflags)
+                                : homeUnitInstantiations dflags)
                         ])
             in throwE $ unitBag $ mkPlainErrMsg pi_local_dflags pi_mod_name_loc $
                 text "Unexpected signature:" <+> quotes (ppr pi_mod_name)

compiler/GHC/Driver/Pipeline.hs

@@ -379,7 +379,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do
   -- https://gitlab.haskell.org/ghc/ghc/issues/12673
   -- and https://github.com/haskell/cabal/issues/2257
   empty_stub <- newTempName dflags TFL_CurrentModule "c"
-  let src = text "int" <+> ppr (mkModule (thisPackage dflags) mod_name) <+> text "= 0;"
+  let src = text "int" <+> ppr (mkHomeModule dflags mod_name) <+> text "= 0;"
   writeFile empty_stub (showSDoc dflags (pprCode CStyle src))
   _ <- runPipeline StopLn hsc_env
                   (empty_stub, Nothing, Nothing)
@@ -1312,7 +1312,7 @@ runPhase (RealPhase cc_phase) input_fn dflags
                 -- way we do the import depends on whether we're currently compiling
                 -- the base package or not.
                        ++ (if platformOS platform == OSMinGW32 &&
-                              thisPackage dflags == baseUnitId
+                              homeUnit dflags == baseUnitId
                                 then [ "-DCOMPILING_BASE_PACKAGE" ]
                                 else [])
 

compiler/GHC/Driver/Session.hs

@@ -66,7 +66,7 @@ module GHC.Driver.Session (
 
         addWay', updateWays,
 
-        thisPackage, thisComponentId, thisUnitIdInsts,
+        homeUnit, mkHomeModule, isHomeModule,
 
         -- ** Log output
         putLogMsg,
@@ -254,7 +254,7 @@ import GHC.Unit.Module
 import {-# SOURCE #-} GHC.Driver.Plugins
 import {-# SOURCE #-} GHC.Driver.Hooks
 import GHC.Builtin.Names ( mAIN )
-import {-# SOURCE #-} GHC.Unit.State (PackageState, emptyPackageState, PackageDatabase, mkIndefUnitId, updateIndefUnitId)
+import {-# SOURCE #-} GHC.Unit.State (PackageState, emptyPackageState, PackageDatabase, updateIndefUnitId)
 import GHC.Driver.Phases ( Phase(..), phaseInputExt )
 import GHC.Driver.Flags
 import GHC.Driver.Ways
@@ -528,9 +528,9 @@ data DynFlags = DynFlags {
   solverIterations      :: IntWithInf,   -- ^ Number of iterations in the constraints solver
                                          --   Typically only 1 is needed
 
-  thisUnitId   :: UnitId,              -- ^ Target unit-id
-  thisComponentId_      :: Maybe IndefUnitId,            -- ^ Unit-id to instantiate
-  thisUnitIdInsts_      :: Maybe [(ModuleName, Module)], -- ^ How to instantiate the unit-id above
+  homeUnitId            :: UnitId,                 -- ^ Target home unit-id
+  homeUnitInstanceOfId  :: Maybe IndefUnitId,      -- ^ Unit-id to instantiate
+  homeUnitInstantiations:: [(ModuleName, Module)], -- ^ How to instantiate `homeUnitInstanceOfId` unit
 
   -- ways
   ways                  :: Set Way,     -- ^ Way flags from the command line
@@ -1329,9 +1329,9 @@ defaultDynFlags mySettings llvmConfig =
         reductionDepth          = treatZeroAsInf mAX_REDUCTION_DEPTH,
         solverIterations        = treatZeroAsInf mAX_SOLVER_ITERATIONS,
 
-        thisUnitId     = toUnitId mainUnitId,
-        thisUnitIdInsts_        = Nothing,
-        thisComponentId_        = Nothing,
+        homeUnitId              = toUnitId mainUnitId,
+        homeUnitInstanceOfId    = Nothing,
+        homeUnitInstantiations  = [],
 
         objectDir               = Nothing,
         dylibInstallName        = Nothing,
@@ -1961,34 +1961,31 @@ setOutputHi   f d = d { outputHi   = f}
 setJsonLogAction :: DynFlags -> DynFlags
 setJsonLogAction d = d { log_action = jsonLogAction }
 
-thisComponentId :: DynFlags -> IndefUnitId
-thisComponentId dflags =
-  let pkgstate = pkgState dflags
-  in case thisComponentId_ dflags of
-    Just uid -> updateIndefUnitId pkgstate uid
-    Nothing  ->
-      case thisUnitIdInsts_ dflags of
-        Just _  ->
-          throwGhcException $ CmdLineError ("Use of -instantiated-with requires -this-component-id")
-        Nothing -> mkIndefUnitId pkgstate (unitFS (thisPackage dflags))
-
-thisUnitIdInsts :: DynFlags -> [(ModuleName, Module)]
-thisUnitIdInsts dflags =
-    case thisUnitIdInsts_ dflags of
-        Just insts -> insts
-        Nothing    -> []
-
-thisPackage :: DynFlags -> Unit
-thisPackage dflags =
-    case thisUnitIdInsts_ dflags of
-        Nothing -> default_uid
-        Just insts
-          | all (\(x,y) -> mkHoleModule x == y) insts
-          -> mkVirtUnit (thisComponentId dflags) insts
-          | otherwise
-          -> default_uid
-  where
-    default_uid = RealUnit (Definite (thisUnitId dflags))
+-- | Make a module in home unit
+mkHomeModule :: DynFlags -> ModuleName -> Module
+mkHomeModule dflags = mkModule (homeUnit dflags)
+
+-- | Test if the module comes from the home unit
+isHomeModule :: DynFlags -> Module -> Bool
+isHomeModule dflags m = moduleUnit m == homeUnit dflags
+
+-- | Get home unit
+homeUnit :: DynFlags -> Unit
+homeUnit dflags =
+   case (homeUnitInstanceOfId dflags, homeUnitInstantiations dflags) of
+      (Nothing,[]) -> RealUnit (Definite (homeUnitId dflags))
+      (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 == homeUnitId dflags
+         -> mkVirtUnit (updateIndefUnitId (pkgState dflags) u) is
+         -- otherwise it must be that we compile a fully definite units
+         -- TODO: error when the unit is partially instantiated??
+         | otherwise
+         -> RealUnit (Definite (homeUnitId dflags))
 
 parseUnitInsts :: String -> Instantiations
 parseUnitInsts str = case filter ((=="").snd) (readP_to_S parse str) of
@@ -2001,13 +1998,13 @@ parseUnitInsts str = case filter ((=="").snd) (readP_to_S parse str) of
             m <- parseHoleyModule