Add UnitId to Target record

In the future, we want `HscEnv` to support multiple home units
at the same time. This means, that there will be 'Target's that do
not belong to the current 'HomeUnit'.

This is an API change without changing behaviour.

Update haddock submodule to incorporate API changes.

6 files changed, 41 insertions, 20 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 4e554e58ce..4054ead5f2 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -935,7 +935,7 @@ removeTarget :: GhcMonad m => TargetId -> m ()
 removeTarget target_id
   = modifySession (\h -> h{ hsc_targets = filter (hsc_targets h) })
   where
-   filter targets = [ t | t@(Target id _ _) <- targets, id /= target_id ]
+   filter targets = [ t | t@Target { targetId = id } <- targets, id /= target_id ]
 
 -- | Attempts to guess what Target a string refers to.  This function
 -- implements the @--make@/GHCi command-line syntax for filenames:
@@ -948,23 +948,25 @@ removeTarget target_id
 --
 --   - otherwise interpret the string as a module name
 --
-guessTarget :: GhcMonad m => String -> Maybe Phase -> m Target
-guessTarget str (Just phase)
-   = return (Target (TargetFile str (Just phase)) True Nothing)
-guessTarget str Nothing
+guessTarget :: GhcMonad m => String -> Maybe UnitId -> Maybe Phase -> m Target
+guessTarget str mUnitId (Just phase)
+   = do
+     tuid <- unitIdOrHomeUnit mUnitId
+     return (Target (TargetFile str (Just phase)) True tuid Nothing)
+guessTarget str mUnitId Nothing
    | isHaskellSrcFilename file
-   = return (target (TargetFile file Nothing))
+   = target (TargetFile file Nothing)
    | otherwise
    = do exists <- liftIO $ doesFileExist hs_file
         if exists
-           then return (target (TargetFile hs_file Nothing))
+           then target (TargetFile hs_file Nothing)
            else do
         exists <- liftIO $ doesFileExist lhs_file
         if exists
-           then return (target (TargetFile lhs_file Nothing))
+           then target (TargetFile lhs_file Nothing)
            else do
         if looksLikeModuleName file
-           then return (target (TargetModule (mkModuleName file)))
+           then target (TargetModule (mkModuleName file))
            else do
         dflags <- getDynFlags
         liftIO $ throwGhcExceptionIO
@@ -979,8 +981,16 @@ guessTarget str Nothing
          hs_file  = file <.> "hs"
          lhs_file = file <.> "lhs"
 
-         target tid = Target tid obj_allowed Nothing
+         target tid = do
+           tuid <- unitIdOrHomeUnit mUnitId
+           pure $ Target tid obj_allowed tuid Nothing
 
+-- | Unwrap 'UnitId' or retrieve the 'UnitId'
+-- of the current 'HomeUnit'.
+unitIdOrHomeUnit :: GhcMonad m => Maybe UnitId -> m UnitId
+unitIdOrHomeUnit mUnitId = do
+  currentHomeUnitId <- homeUnitId . ue_home_unit . hsc_unit_env <$> getSession
+  pure (fromMaybe currentHomeUnitId mUnitId)
 
 -- | Inform GHC that the working directory has changed.  GHC will flush
 -- its cache of module locations, since it may no longer be valid.
@@ -1243,7 +1253,7 @@ compileToCoreSimplified = compileCore True
 compileCore :: GhcMonad m => Bool -> FilePath -> m CoreModule
 compileCore simplify fn = do
    -- First, set the target to the desired filename
-   target <- guessTarget fn Nothing
+   target <- guessTarget fn Nothing Nothing
    addTarget target
    _ <- load LoadAllTargets
    -- Then find dependencies
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 734608b471..720df3e2c8 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -2287,14 +2287,20 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
         old_summary_map = mkNodeMap old_summaries
 
         getRootSummary :: Target -> IO (Either ErrorMessages ExtendedModSummary)
-        getRootSummary (Target (TargetFile file mb_phase) obj_allowed maybe_buf)
+        getRootSummary Target { targetId = TargetFile file mb_phase
+                              , targetAllowObjCode = obj_allowed
+                              , targetContents = maybe_buf
+                              }
            = do exists <- liftIO $ doesFileExist file
                 if exists || isJust maybe_buf
                     then summariseFile hsc_env old_summaries file mb_phase
                                        obj_allowed maybe_buf
                     else return $ Left $ unitBag $ mkPlainMsgEnvelope noSrcSpan $
                            text "can't find file:" <+> text file
-        getRootSummary (Target (TargetModule modl) obj_allowed maybe_buf)
+        getRootSummary Target { targetId = TargetModule modl
+                              , targetAllowObjCode = obj_allowed
+                              , targetContents = maybe_buf
+                              }
            = do maybe_summary <- summariseModule hsc_env old_summary_map NotBoot
                                            (L rootLoc modl) obj_allowed
                                            maybe_buf excl_mods
diff --git a/compiler/GHC/Driver/MakeFile.hs b/compiler/GHC/Driver/MakeFile.hs
index b6572bcb5b..d018c26ecf 100644
--- a/compiler/GHC/Driver/MakeFile.hs
+++ b/compiler/GHC/Driver/MakeFile.hs
@@ -86,7 +86,7 @@ doMkDependHS srcs = do
     files <- liftIO $ beginMkDependHS logger tmpfs dflags
 
     -- Do the downsweep to find all the modules
-    targets <- mapM (\s -> GHC.guessTarget s Nothing) srcs
+    targets <- mapM (\s -> GHC.guessTarget s Nothing Nothing) srcs
     GHC.setTargets targets
     let excl_mods = depExcludeMods dflags
     module_graph <- GHC.depanal excl_mods True {- Allow dup roots -}
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 6d945f6ff1..67fd78d7fa 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -343,7 +343,7 @@ compileOne' m_tc_result mHscMessage
        current_dir = takeDirectory basename
        old_paths   = includePaths dflags2
        loadAsByteCode
-         | Just (Target _ obj _) <- findTarget summary (hsc_targets hsc_env0)
+         | Just Target { targetAllowObjCode = obj } <- findTarget summary (hsc_targets hsc_env0)
          , not obj
          = True
          | otherwise = False
diff --git a/compiler/GHC/Types/Target.hs b/compiler/GHC/Types/Target.hs
index 8f2c0649d4..6599bdac4a 100644
--- a/compiler/GHC/Types/Target.hs
+++ b/compiler/GHC/Types/Target.hs
@@ -25,6 +25,7 @@ data Target
   = Target {
       targetId           :: TargetId, -- ^ module or filename
       targetAllowObjCode :: Bool,     -- ^ object code allowed?
+      targetUnitId       :: UnitId,   -- ^ id of the unit this target is part of
       targetContents     :: Maybe (InputFileBuffer, UTCTime)
       -- ^ Optional in-memory buffer containing the source code GHC should
       -- use for this target instead of reading it from disk.
@@ -52,7 +53,7 @@ type InputFileBuffer = StringBuffer
 
 
 pprTarget :: Target -> SDoc
-pprTarget (Target id obj _) =
+pprTarget Target { targetId = id, targetAllowObjCode = obj } =
     (if obj then empty else char '*') <> pprTargetId id
 
 instance Outputable Target where
diff --git a/compiler/GHC/Unit/Module/ModSummary.hs b/compiler/GHC/Unit/Module/ModSummary.hs
index e9106d44eb..324cca33a3 100644
--- a/compiler/GHC/Unit/Module/ModSummary.hs
+++ b/compiler/GHC/Unit/Module/ModSummary.hs
@@ -6,6 +6,7 @@ module GHC.Unit.Module.ModSummary
    ( ExtendedModSummary (..)
    , extendModSummaryNoDeps
    , ModSummary (..)
+   , ms_unitid
    , ms_installed_mod
    , ms_mod_name
    , ms_imps
@@ -98,6 +99,9 @@ data ModSummary
           -- ^ The actual preprocessed source, if we have it
      }
 
+ms_unitid :: ModSummary -> UnitId
+ms_unitid = toUnitId . moduleUnit . ms_mod
+
 ms_installed_mod :: ModSummary -> InstalledModule
 ms_installed_mod = fst . getModuleInstantiation . ms_mod
 
@@ -172,11 +176,11 @@ findTarget ms ts =
         []    -> Nothing
         (t:_) -> Just t
   where
-    summary `matches` Target (TargetModule m) _ _
-        = ms_mod_name summary == m
-    summary `matches` Target (TargetFile f _) _ _
+    summary `matches` Target { targetId = TargetModule m, targetUnitId = unitId }
+        = ms_mod_name summary == m && ms_unitid summary == unitId
+    summary `matches` Target { targetId = TargetFile f _, targetUnitId = unitid }
         | Just f' <- ml_hs_file (ms_location summary)
-        = f == f'
+        = f == f'  && ms_unitid summary == unitid
     _ `matches` _
         = False