Put hole instantiation typechecking in the module graph and fix driver batch mode backpack edges

Backpack instantiations need to be typechecked to make sure that the
arguments fit the parameters. `tcRnInstantiateSignature` checks
instantiations with concrete modules, while `tcRnCheckUnit` checks
instantiations with free holes (signatures in the current modules).

Before this change, it worked that `tcRnInstantiateSignature` was called
after typechecking the argument module, see `HscMain.hsc_typecheck`,
while `tcRnCheckUnit` was called in `unsweep'` where-bound in
`GhcMake.upsweep`. `tcRnCheckUnit` was called once per each
instantiation once all the argument sigs were processed. This was done
with simple "to do" and "already done" accumulators in the fold.
`parUpsweep` did not implement the change.

With this change, `tcRnCheckUnit` instead is associated with its own
node in the `ModuleGraph`. Nodes are now:
```haskell
data ModuleGraphNode
  -- | Instantiation nodes track the instantiation of other units
  -- (backpack dependencies) with the holes (signatures) of the current package.
  = InstantiationNode InstantiatedUnit
  -- | There is a module summary node for each module, signature, and boot module being built.
  | ModuleNode ExtendedModSummary
```
instead of just `ModSummary`; the `InstantiationNode` case is the
instantiation of a unit to be checked. The dependencies of such nodes
are the same "free holes" as was checked with the accumulator before.
Both versions of upsweep on such a node call `tcRnCheckUnit`.

There previously was an `implicitRequirements` function which would
crawl through every non-current-unit module dep to look for all free
holes (signatures) to add as dependencies in `GHC.Driver.Make`. But this
is no good: we shouldn't be looking for transitive anything when
building the graph: the graph should only have immediate edges and the
scheduler takes care that all transitive requirements are met.

So `GHC.Driver.Make` stopped using `implicitRequirements`, and instead
uses a new `implicitRequirementsShallow`, which just returns the
outermost instantiation node (or module name if the immediate dependency
is itself a signature). The signature dependencies are just treated like
any other imported module, but the module ones then go in a list stored
in the `ModuleNode` next to the `ModSummary` as the "extra backpack
dependencies". When `downsweep` creates the mod summaries, it adds this
information too.

------

There is one code quality, and possible correctness thing left: In
addition to `implicitRequirements` there is `findExtraSigImports`, which
says something like "if you are an instantiation argument (you are
substituted or a signature), you need to import its things too".  This
is a little non-local so I am not quite sure how to get rid of it in
`GHC.Driver.Make`, but we probably should eventually.

First though, let's try to make a test case that observes that we don't
do this, lest it actually be unneeded. Until then, I'm happy to leave it
as is.

------

Beside the ability to use `-j`, the other major user-visibile side
effect of this change is that that the --make progress log now includes
"Instantiating" messages for these new nodes. Those also are numbered
like module nodes and count towards the total.

------

Fixes #17188

Updates hackage submomdule

Metric Increase:
    T12425
    T13035

4 files changed, 161 insertions, 47 deletions

diff --git a/compiler/GHC/Unit/Module/Graph.hs b/compiler/GHC/Unit/Module/Graph.hs
index faa3ae9b1a..5b5d152711 100644
--- a/compiler/GHC/Unit/Module/Graph.hs
+++ b/compiler/GHC/Unit/Module/Graph.hs
@@ -1,17 +1,26 @@
+{-# LANGUAGE LambdaCase      #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module GHC.Unit.Module.Graph
    ( ModuleGraph
+   , ModuleGraphNode(..)
    , emptyMG
    , mkModuleGraph
+   , mkModuleGraph'
    , extendMG
+   , extendMGInst
+   , extendMG'
+   , filterToposortToModules
    , mapMG
    , mgModSummaries
+   , mgModSummaries'
+   , mgExtendedModSummaries
    , mgElemModule
    , mgLookupModule
    , mgBootModules
    , needsTemplateHaskellOrQQ
    , isTemplateHaskellOrQQNonBoot
+   , showModMsg
    )
 where
 
@@ -19,21 +28,50 @@ import GHC.Prelude
 
 import qualified GHC.LanguageExtensions as LangExt
 
+import GHC.Data.Maybe
+import GHC.Data.Graph.Directed ( SCC(..) )
+
+import GHC.Driver.Backend
+import GHC.Driver.Ppr
 import GHC.Driver.Session
 
+import GHC.Types.SourceFile ( hscSourceString )
+
 import GHC.Unit.Module.ModSummary
 import GHC.Unit.Module.Env
 import GHC.Unit.Types
-
-
--- | A ModuleGraph contains all the nodes from the home package (only).
--- There will be a node for each source module, plus a node for each hi-boot
--- module.
+import GHC.Utils.Outputable
+
+import System.FilePath
+
+-- | A '@ModuleGraphNode@' is a node in the '@ModuleGraph@'.
+-- Edges between nodes mark dependencies arising from module imports
+-- and dependencies arising from backpack instantiations.
+data ModuleGraphNode
+  -- | Instantiation nodes track the instantiation of other units
+  -- (backpack dependencies) with the holes (signatures) of the current package.
+  = InstantiationNode InstantiatedUnit
+  -- | There is a module summary node for each module, signature, and boot module being built.
+  | ModuleNode ExtendedModSummary
+
+instance Outputable ModuleGraphNode where
+  ppr = \case
+    InstantiationNode iuid -> ppr iuid
+    ModuleNode ems -> ppr ems
+
+-- | A '@ModuleGraph@' contains all the nodes from the home package (only). See
+-- '@ModuleGraphNode@' for information about the nodes.
+--
+-- Modules need to be compiled. hs-boots need to be typechecked before
+-- the associated "real" module so modules with {-# SOURCE #-} imports can be
+-- built. Instantiations also need to be typechecked to ensure that the module
+-- fits the signature. Substantiation typechecking is roughly comparable to the
+-- check that the module and its hs-boot agree.
 --
 -- The graph is not necessarily stored in topologically-sorted order.  Use
 -- 'GHC.topSortModuleGraph' and 'GHC.Data.Graph.Directed.flattenSCC' to achieve this.
 data ModuleGraph = ModuleGraph
-  { mg_mss :: [ModSummary]
+  { mg_mss :: [ModuleGraphNode]
   , mg_non_boot :: ModuleEnv ModSummary
     -- a map of all non-boot ModSummaries keyed by Modules
   , mg_boot :: ModuleSet
@@ -56,7 +94,9 @@ needsTemplateHaskellOrQQ mg = mg_needs_th_or_qq mg
 -- To preserve invariants 'f' can't change the isBoot status.
 mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
 mapMG f mg@ModuleGraph{..} = mg
-  { mg_mss = map f mg_mss
+  { mg_mss = flip fmap mg_mss $ \case
+      InstantiationNode iuid -> InstantiationNode iuid
+      ModuleNode (ExtendedModSummary ms bds) -> ModuleNode (ExtendedModSummary (f ms) bds)
   , mg_non_boot = mapModuleEnv f mg_non_boot
   }
 
@@ -64,7 +104,13 @@ mgBootModules :: ModuleGraph -> ModuleSet
 mgBootModules ModuleGraph{..} = mg_boot
 
 mgModSummaries :: ModuleGraph -> [ModSummary]
-mgModSummaries = mg_mss
+mgModSummaries mg = [ m | ModuleNode (ExtendedModSummary m _) <- mgModSummaries' mg ]
+
+mgExtendedModSummaries :: ModuleGraph -> [ExtendedModSummary]
+mgExtendedModSummaries mg = [ ems | ModuleNode ems <- mgModSummaries' mg ]
+
+mgModSummaries' :: ModuleGraph -> [ModuleGraphNode]
+mgModSummaries' = mg_mss
 
 mgElemModule :: ModuleGraph -> Module -> Bool
 mgElemModule ModuleGraph{..} m = elemModuleEnv m mg_non_boot
@@ -82,11 +128,11 @@ isTemplateHaskellOrQQNonBoot ms =
     || xopt LangExt.QuasiQuotes (ms_hspp_opts ms)) &&
   (isBootSummary ms == NotBoot)
 
--- | Add a ModSummary to ModuleGraph. Assumes that the new ModSummary is
+-- | Add an ExtendedModSummary to ModuleGraph. Assumes that the new ModSummary is
 -- not an element of the ModuleGraph.
-extendMG :: ModuleGraph -> ModSummary -> ModuleGraph
-extendMG ModuleGraph{..} ms = ModuleGraph
-  { mg_mss = ms:mg_mss
+extendMG :: ModuleGraph -> ExtendedModSummary -> ModuleGraph
+extendMG ModuleGraph{..} ems@(ExtendedModSummary ms _) = ModuleGraph
+  { mg_mss = ModuleNode ems : mg_mss
   , mg_non_boot = case isBootSummary ms of
       IsBoot -> mg_non_boot
       NotBoot -> extendModuleEnv mg_non_boot (ms_mod ms) ms
@@ -96,6 +142,67 @@ extendMG ModuleGraph{..} ms = ModuleGraph
   , mg_needs_th_or_qq = mg_needs_th_or_qq || isTemplateHaskellOrQQNonBoot ms
   }
 
-mkModuleGraph :: [ModSummary] -> ModuleGraph
+extendMGInst :: ModuleGraph -> InstantiatedUnit -> ModuleGraph
+extendMGInst mg depUnitId = mg
+  { mg_mss = InstantiationNode depUnitId : mg_mss mg
+  }
+
+extendMG' :: ModuleGraph -> ModuleGraphNode -> ModuleGraph
+extendMG' mg = \case
+  InstantiationNode depUnitId -> extendMGInst mg depUnitId
+  ModuleNode ems -> extendMG mg ems
+
+mkModuleGraph :: [ExtendedModSummary] -> ModuleGraph
 mkModuleGraph = foldr (flip extendMG) emptyMG
 
+mkModuleGraph' :: [ModuleGraphNode] -> ModuleGraph
+mkModuleGraph' = foldr (flip extendMG') emptyMG
+
+-- | This function filters out all the instantiation nodes from each SCC of a
+-- topological sort. Use this with care, as the resulting "strongly connected components"
+-- may not really be strongly connected in a direct way, as instantiations have been
+-- removed. It would probably be best to eliminate uses of this function where possible.
+filterToposortToModules
+  :: [SCC ModuleGraphNode] -> [SCC ModSummary]
+filterToposortToModules = mapMaybe $ mapMaybeSCC $ \case
+  InstantiationNode _ -> Nothing
+  ModuleNode (ExtendedModSummary node _) -> Just node
+  where
+    -- This higher order function is somewhat bogus,
+    -- as the definition of "strongly connected component"
+    -- is not necessarily respected.
+    mapMaybeSCC :: (a -> Maybe b) -> SCC a -> Maybe (SCC b)
+    mapMaybeSCC f = \case
+      AcyclicSCC a -> AcyclicSCC <$> f a
+      CyclicSCC as -> case mapMaybe f as of
+        [] -> Nothing
+        [a] -> Just $ AcyclicSCC a
+        as -> Just $ CyclicSCC as
+
+showModMsg :: DynFlags -> Bool -> ModuleGraphNode -> SDoc
+showModMsg _ _ (InstantiationNode indef_unit) =
+  ppr $ instUnitInstanceOf indef_unit
+showModMsg dflags recomp (ModuleNode (ExtendedModSummary mod_summary _)) =
+  if gopt Opt_HideSourcePaths dflags
+      then text mod_str
+      else hsep $
+         [ text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' ')
+         , char '('
+         , text (op $ msHsFilePath mod_summary) <> char ','
+         ] ++
+         if gopt Opt_BuildDynamicToo dflags
+            then [ text obj_file <> char ','
+                 , text dyn_file
+                 , char ')'
+                 ]
+            else [ text obj_file, char ')' ]
+  where
+    op       = normalise
+    mod      = moduleName (ms_mod mod_summary)
+    mod_str  = showPpr dflags mod ++ hscSourceString (ms_hsc_src mod_summary)
+    dyn_file = op $ msDynObjFilePath mod_summary dflags
+    obj_file = case backend dflags of
+                Interpreter | recomp -> "interpreted"
+                NoBackend            -> "nothing"
+                _                    -> (op $ msObjFilePath mod_summary)
+
diff --git a/compiler/GHC/Unit/Module/ModSummary.hs b/compiler/GHC/Unit/Module/ModSummary.hs
index a0b42fc2a4..e9106d44eb 100644
--- a/compiler/GHC/Unit/Module/ModSummary.hs
+++ b/compiler/GHC/Unit/Module/ModSummary.hs
@@ -1,7 +1,11 @@
+{-# LANGUAGE LambdaCase #-}
+
 -- | A ModSummary is a node in the compilation manager's dependency graph
 -- (ModuleGraph)
 module GHC.Unit.Module.ModSummary
-   ( ModSummary (..)
+   ( ExtendedModSummary (..)
+   , extendModSummaryNoDeps
+   , ModSummary (..)
    , ms_installed_mod
    , ms_mod_name
    , ms_imps
@@ -13,7 +17,6 @@ module GHC.Unit.Module.ModSummary
    , msObjFilePath
    , msDynObjFilePath
    , isBootSummary
-   , showModMsg
    , findTarget
    )
 where
@@ -22,9 +25,7 @@ import GHC.Prelude
 
 import GHC.Hs
 
-import GHC.Driver.Ppr
 import GHC.Driver.Session
-import GHC.Driver.Backend
 
 import GHC.Unit.Types
 import GHC.Unit.Module
@@ -40,9 +41,24 @@ import GHC.Data.StringBuffer ( StringBuffer )
 import GHC.Utils.Outputable
 
 import Data.Time
-import System.FilePath
 
--- | A single node in a 'ModuleGraph'. The nodes of the module graph
+-- | Enrichment of 'ModSummary' with backpack dependencies
+data ExtendedModSummary = ExtendedModSummary
+  { emsModSummary :: {-# UNPACK #-} !ModSummary
+  , emsInstantiatedUnits :: [InstantiatedUnit]
+  -- ^ Extra backpack deps
+  -- NB: This is sometimes left empty in situations where the instantiated units
+  -- would not be used. See call sites of 'extendModSummaryNoDeps'.
+  }
+
+instance Outputable ExtendedModSummary where
+  ppr = \case
+    ExtendedModSummary ms bds -> ppr ms <+> ppr bds
+
+extendModSummaryNoDeps :: ModSummary -> ExtendedModSummary
+extendModSummaryNoDeps ms = ExtendedModSummary ms []
+
+-- | Data for a module node in a 'ModuleGraph'. Module nodes of the module graph
 -- are one of:
 --
 -- * A regular Haskell source module
@@ -53,7 +69,7 @@ data ModSummary
         ms_mod          :: Module,
           -- ^ Identity of the module
         ms_hsc_src      :: HscSource,
-          -- ^ The module source either plain Haskell or hs-boot
+          -- ^ The module source either plain Haskell, hs-boot, or hsig
         ms_location     :: ModLocation,
           -- ^ Location of the various files belonging to the module
         ms_hs_date      :: UTCTime,
@@ -150,31 +166,6 @@ instance Outputable ModSummary where
              char '}'
             ]
 
-showModMsg :: DynFlags -> Bool -> ModSummary -> SDoc
-showModMsg dflags recomp mod_summary =
-   if gopt Opt_HideSourcePaths dflags
-      then text mod_str
-      else hsep $
-         [ text (mod_str ++ replicate (max 0 (16 - length mod_str)) ' ')
-         , char '('
-         , text (op $ msHsFilePath mod_summary) <> char ','
-         ] ++
-         if gopt Opt_BuildDynamicToo dflags
-            then [ text obj_file <> char ','
-                 , text dyn_file
-                 , char ')'
-                 ]
-            else [ text obj_file, char ')' ]
-  where
-    op       = normalise
-    mod      = moduleName (ms_mod mod_summary)
-    mod_str  = showPpr dflags mod ++ hscSourceString (ms_hsc_src mod_summary)
-    dyn_file = op $ msDynObjFilePath mod_summary dflags
-    obj_file = case backend dflags of
-                Interpreter | recomp -> "interpreted"
-                NoBackend            -> "nothing"
-                _                    -> (op $ msObjFilePath mod_summary)
-
 findTarget :: ModSummary -> [Target] -> Maybe Target
 findTarget ms ts =
   case filter (matches ms) ts of
@@ -188,3 +179,5 @@ findTarget ms ts =
         = f == f'
     _ `matches` _
         = False
+
+
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 1aabfb10c2..ab76ad2426 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -35,6 +35,7 @@ module GHC.Unit.State (
         lookupModuleInAllUnits,
         lookupModuleWithSuggestions,
         lookupPluginModuleWithSuggestions,
+        requirementMerges,
         LookupResult(..),
         ModuleSuggestion(..),
         ModuleOrigin(..),
@@ -1963,6 +1964,19 @@ instance Outputable UnitErr where
         ppr_reason (p, reason) =
             pprReason (ppr (unitId p) <+> text "is") reason
 
+-- | Return this list of requirement interfaces that need to be merged
+-- to form @mod_name@, or @[]@ if this is not a requirement.
+requirementMerges :: UnitState -> ModuleName -> [InstantiatedModule]
+requirementMerges pkgstate mod_name =
+    fmap fixupModule $ fromMaybe [] (Map.lookup mod_name (requirementContext pkgstate))
+    where
+      -- update IndefUnitId ppr info as they may have changed since the
+      -- time the IndefUnitId was created
+      fixupModule (Module iud name) = Module iud' name
+         where
+            iud' = iud { instUnitInstanceOf = cid' }
+            cid' = instUnitInstanceOf iud
+
 -- -----------------------------------------------------------------------------
 
 -- | Pretty-print a UnitId for the user.
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index b2f3ce0c50..57dcddef6b 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -676,5 +676,5 @@ instance Binary a => Binary (GenWithIsBoot a) where
 
 instance Outputable a => Outputable (GenWithIsBoot a) where
   ppr (GWIB  { gwib_mod, gwib_isBoot }) = hsep $ ppr gwib_mod : case gwib_isBoot of
-    IsBoot -> []
-    NotBoot -> [text "{-# SOURCE #-}"]
+    IsBoot -> [ text "{-# SOURCE #-}" ]
+    NotBoot -> []