Torsten Schmits pushed to branch wip/torsten.schmits/unit-index-debug at Glasgow Haskell Compiler / GHC

Commits:

10 changed files:

Changes:

  • compiler/GHC/Driver/Make.hs
    ... ... @@ -114,6 +114,8 @@ import Data.Either ( rights, partitionEithers, lefts )
    114 114
     import qualified Data.Map as Map
    
    115 115
     import qualified Data.Set as Set
    
    116 116
     
    
    117
    +import GHC.Data.OsPath (OsPath)
    
    118
    +import qualified GHC.Data.OsPath as OsPath
    
    117 119
     import Control.Concurrent ( newQSem, waitQSem, signalQSem, ThreadId, killThread, forkIOWithUnmask )
    
    118 120
     import qualified GHC.Conc as CC
    
    119 121
     import Control.Concurrent.MVar
    
    ... ... @@ -247,7 +249,7 @@ depanalPartial excluded_mods allow_dup_roots = do
    247 249
         liftIO $ flushFinderCaches (hsc_FC hsc_env) (hsc_unit_env hsc_env)
    
    248 250
     
    
    249 251
         (errs, graph_nodes) <- liftIO $ downsweep
    
    250
    -      hsc_env (mgModSummaries old_graph)
    
    252
    +      hsc_env (mgModSummaries old_graph) (Just old_graph)
    
    251 253
           excluded_mods allow_dup_roots
    
    252 254
         let
    
    253 255
           mod_graph = mkModuleGraph graph_nodes
    
    ... ... @@ -1541,6 +1543,10 @@ warnUnnecessarySourceImports sccs = do
    1541 1543
     -- an import of this module mean.
    
    1542 1544
     type DownsweepCache = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) [Either DriverMessages ModSummary]
    
    1543 1545
     
    
    1546
    +moduleGraphNodeMap :: ModuleGraph -> M.Map NodeKey ModuleGraphNode
    
    1547
    +moduleGraphNodeMap graph =
    
    1548
    +  M.fromList [(mkNodeKey node, node) | node <- mgModSummaries' graph]
    
    1549
    +
    
    1544 1550
     -----------------------------------------------------------------------------
    
    1545 1551
     --
    
    1546 1552
     -- | Downsweep (dependency analysis)
    
    ... ... @@ -1559,6 +1565,8 @@ type DownsweepCache = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) [Either Driv
    1559 1565
     downsweep :: HscEnv
    
    1560 1566
               -> [ModSummary]
    
    1561 1567
               -- ^ Old summaries
    
    1568
    +          -> Maybe ModuleGraph
    
    1569
    +          -- ^ Existing module graph to reuse cached nodes from
    
    1562 1570
               -> [ModuleName]       -- Ignore dependencies on these; treat
    
    1563 1571
                                     -- them as if they were package modules
    
    1564 1572
               -> Bool               -- True <=> allow multiple targets to have
    
    ... ... @@ -1568,10 +1576,10 @@ downsweep :: HscEnv
    1568 1576
                     -- The non-error elements of the returned list all have distinct
    
    1569 1577
                     -- (Modules, IsBoot) identifiers, unless the Bool is true in
    
    1570 1578
                     -- which case there can be repeats
    
    1571
    -downsweep hsc_env old_summaries excl_mods allow_dup_roots = do
    
    1579
    +downsweep hsc_env old_summaries old_graph excl_mods allow_dup_roots = do
    
    1572 1580
       n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
    
    1573 1581
       new <- rootSummariesParallel n_jobs hsc_env summary
    
    1574
    -  downsweep_imports hsc_env old_summary_map excl_mods allow_dup_roots new
    
    1582
    +  downsweep_imports hsc_env old_summary_map old_graph excl_mods allow_dup_roots new
    
    1575 1583
       where
    
    1576 1584
         summary = getRootSummary excl_mods old_summary_map
    
    1577 1585
     
    
    ... ... @@ -1580,21 +1588,23 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots = do
    1580 1588
         -- file was used in.
    
    1581 1589
         -- Reuse these if we can because the most expensive part of downsweep is
    
    1582 1590
         -- reading the headers.
    
    1583
    -    old_summary_map :: M.Map (UnitId, FilePath) ModSummary
    
    1591
    +    old_summary_map :: M.Map (UnitId, OsPath) ModSummary
    
    1584 1592
         old_summary_map =
    
    1585
    -      M.fromList [((ms_unitid ms, msHsFilePath ms), ms) | ms <- old_summaries]
    
    1593
    +      M.fromList [((ms_unitid ms, OsPath.unsafeEncodeUtf (msHsFilePath ms)), ms) | ms <- old_summaries]
    
    1586 1594
     
    
    1587 1595
     downsweep_imports :: HscEnv
    
    1588
    -                  -> M.Map (UnitId, FilePath) ModSummary
    
    1596
    +                  -> M.Map (UnitId, OsPath) ModSummary
    
    1597
    +                  -> Maybe ModuleGraph
    
    1589 1598
                       -> [ModuleName]
    
    1590 1599
                       -> Bool
    
    1591 1600
                       -> ([(UnitId, DriverMessages)], [ModSummary])
    
    1592 1601
                       -> IO ([DriverMessages], [ModuleGraphNode])
    
    1593
    -downsweep_imports hsc_env old_summaries excl_mods allow_dup_roots (root_errs, rootSummariesOk)
    
    1602
    +downsweep_imports hsc_env old_summaries old_graph excl_mods allow_dup_roots (root_errs, rootSummariesOk)
    
    1594 1603
        = do
    
    1595 1604
            let root_map = mkRootMap rootSummariesOk
    
    1596 1605
            checkDuplicates root_map
    
    1597
    -       (deps, map0) <- loopSummaries rootSummariesOk (M.empty, root_map)
    
    1606
    +       let done0 = maybe M.empty moduleGraphNodeMap old_graph
    
    1607
    +       (deps, map0) <- loopSummaries rootSummariesOk (done0, root_map)
    
    1598 1608
            let closure_errs = checkHomeUnitsClosed (hsc_unit_env hsc_env)
    
    1599 1609
            let unit_env = hsc_unit_env hsc_env
    
    1600 1610
            let tmpfs    = hsc_tmpfs    hsc_env
    
    ... ... @@ -1725,7 +1735,7 @@ downsweep_imports hsc_env old_summaries excl_mods allow_dup_roots (root_errs, ro
    1725 1735
     
    
    1726 1736
     getRootSummary ::
    
    1727 1737
       [ModuleName] ->
    
    1728
    -  M.Map (UnitId, FilePath) ModSummary ->
    
    1738
    +  M.Map (UnitId, OsPath) ModSummary ->
    
    1729 1739
       HscEnv ->
    
    1730 1740
       Target ->
    
    1731 1741
       IO (Either (UnitId, DriverMessages) ModSummary)
    
    ... ... @@ -2071,7 +2081,7 @@ mkRootMap summaries = Map.fromListWith (flip (++))
    2071 2081
     summariseFile
    
    2072 2082
             :: HscEnv
    
    2073 2083
             -> HomeUnit
    
    2074
    -        -> M.Map (UnitId, FilePath) ModSummary    -- old summaries
    
    2084
    +        -> M.Map (UnitId, OsPath) ModSummary    -- old summaries
    
    2075 2085
             -> FilePath                     -- source file name
    
    2076 2086
             -> Maybe Phase                  -- start phase
    
    2077 2087
             -> Maybe (StringBuffer,UTCTime)
    
    ... ... @@ -2080,7 +2090,7 @@ summariseFile
    2080 2090
     summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
    
    2081 2091
             -- we can use a cached summary if one is available and the
    
    2082 2092
             -- source file hasn't changed,
    
    2083
    -   | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn) old_summaries
    
    2093
    +   | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn_os) old_summaries
    
    2084 2094
        = do
    
    2085 2095
             let location = ms_location $ old_summary
    
    2086 2096
     
    
    ... ... @@ -2101,6 +2111,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf
    2101 2111
       where
    
    2102 2112
         -- change the main active unit so all operations happen relative to the given unit
    
    2103 2113
         hsc_env = hscSetActiveHomeUnit home_unit hsc_env'
    
    2114
    +    src_fn_os = OsPath.unsafeEncodeUtf src_fn
    
    2104 2115
         -- src_fn does not necessarily exist on the filesystem, so we need to
    
    2105 2116
         -- check what kind of target we are dealing with
    
    2106 2117
         get_src_hash = case maybe_buf of
    
    ... ... @@ -2190,7 +2201,7 @@ data SummariseResult =
    2190 2201
     summariseModule
    
    2191 2202
               :: HscEnv
    
    2192 2203
               -> HomeUnit
    
    2193
    -          -> M.Map (UnitId, FilePath) ModSummary
    
    2204
    +          -> M.Map (UnitId, OsPath) ModSummary
    
    2194 2205
               -- ^ Map of old summaries
    
    2195 2206
               -> IsBootInterface    -- True <=> a {-# SOURCE #-} import
    
    2196 2207
               -> Located ModuleName -- Imported module to be summarised
    
    ... ... @@ -2251,7 +2262,7 @@ summariseModule hsc_env' home_unit old_summary_map is_boot (L _ wanted_mod) mb_p
    2251 2262
                   Right ms -> FoundHome ms
    
    2252 2263
     
    
    2253 2264
         new_summary_cache_check loc mod src_fn h
    
    2254
    -      | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn)) old_summary_map =
    
    2265
    +      | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn_os)) old_summary_map =
    
    2255 2266
     
    
    2256 2267
              -- check the hash on the source file, and
    
    2257 2268
              -- return the cached summary if it hasn't changed.  If the
    
    ... ... @@ -2262,6 +2273,8 @@ summariseModule hsc_env' home_unit old_summary_map is_boot (L _ wanted_mod) mb_p
    2262 2273
                Nothing    ->
    
    2263 2274
                    checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc h
    
    2264 2275
           | otherwise = new_summary loc mod src_fn h
    
    2276
    +      where
    
    2277
    +        src_fn_os = OsPath.unsafeEncodeUtf src_fn
    
    2265 2278
     
    
    2266 2279
         new_summary :: ModLocation
    
    2267 2280
                       -> Module
    

  • compiler/GHC/Linker/Loader.hs
    ... ... @@ -358,7 +358,7 @@ loadCmdLineLibs' interp hsc_env pls = snd <$>
    358 358
           let hsc' = hscSetActiveUnitId uid hsc_env
    
    359 359
           -- Load potential dependencies first
    
    360 360
           (done', pls') <- foldM (\(done', pls') uid -> load done' uid pls') (done, pls)
    
    361
    -                          (homeUnitDepends (hsc_units hsc'))
    
    361
    +                          (Set.toList (homeUnitDepends (hsc_units hsc')))
    
    362 362
           pls'' <- loadCmdLineLibs'' interp hsc' pls'
    
    363 363
           return $ (Set.insert uid done', pls'')
    
    364 364
     
    

  • compiler/GHC/Rename/Names.hs
    ... ... @@ -475,11 +475,14 @@ renamePkgQual unit_env query mn mb_pkg = case mb_pkg of
    475 475
            -- not really correct as pkg_fs is unlikely to be a valid unit-id but
    
    476 476
            -- we will report the failure later...
    
    477 477
       where
    
    478
    -    home_names  = map (\uid -> (uid, mkFastString <$> thisPackageName (homeUnitEnv_dflags (ue_findHomeUnitEnv uid unit_env)))) hpt_deps
    
    478
    +    home_names =
    
    479
    +      [ (uid, mkFastString <$> thisPackageName (homeUnitEnv_dflags (ue_findHomeUnitEnv uid unit_env)))
    
    480
    +      | uid <- S.toList hpt_deps
    
    481
    +      ]
    
    479 482
     
    
    480 483
         units = ue_units unit_env
    
    481 484
     
    
    482
    -    hpt_deps :: [UnitId]
    
    485
    +    hpt_deps :: S.Set UnitId
    
    483 486
         hpt_deps  = homeUnitDepends units
    
    484 487
     
    
    485 488
     hscRenameRawPkgQual ::
    

  • compiler/GHC/Unit/Env.hs
    ... ... @@ -142,7 +142,7 @@ ue_transitiveHomeDeps uid unit_env = Set.toList (loop Set.empty [uid])
    142 142
         loop acc (uid:uids)
    
    143 143
           | uid `Set.member` acc = loop acc uids
    
    144 144
           | otherwise =
    
    145
    -        let hue = homeUnitDepends (homeUnitEnv_units (ue_findHomeUnitEnv uid unit_env))
    
    145
    +        let hue = Set.toList (homeUnitDepends (homeUnitEnv_units (ue_findHomeUnitEnv uid unit_env)))
    
    146 146
             in loop (Set.insert uid acc) (hue ++ uids)
    
    147 147
     
    
    148 148
     
    

  • compiler/GHC/Unit/Finder.hs
    ... ... @@ -68,8 +68,9 @@ import Control.Monad
    68 68
     import Data.Time
    
    69 69
     import qualified Data.Map as M
    
    70 70
     import GHC.Driver.Env
    
    71
    -    ( hsc_home_unit_maybe, HscEnv(hsc_FC, hsc_dflags, hsc_unit_env), hscUnitIndexQuery )
    
    71
    +    ( hsc_home_unit_maybe, HscEnv(hsc_FC, hsc_dflags, hsc_unit_env, hsc_mod_graph), hscUnitIndexQuery )
    
    72 72
     import GHC.Driver.Config.Finder
    
    73
    +import GHC.Unit.Module.Graph (mgHomeModuleMap, ModuleNameHomeMap)
    
    73 74
     import qualified Data.Set as Set
    
    74 75
     import qualified Data.List.NonEmpty as NE
    
    75 76
     
    
    ... ... @@ -163,30 +164,36 @@ findImportedModule hsc_env mod pkg_qual =
    163 164
           dflags    = hsc_dflags hsc_env
    
    164 165
           fopts     = initFinderOpts dflags
    
    165 166
       in do
    
    167
    +    let home_module_map = mgHomeModuleMap (hsc_mod_graph hsc_env)
    
    166 168
         query <- hscUnitIndexQuery hsc_env
    
    167
    -    findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) query mhome_unit mod pkg_qual
    
    169
    +    findImportedModuleNoHsc fc fopts (hsc_unit_env hsc_env) query home_module_map mhome_unit mod pkg_qual
    
    168 170
     
    
    169 171
     findImportedModuleNoHsc
    
    170 172
       :: FinderCache
    
    171 173
       -> FinderOpts
    
    172 174
       -> UnitEnv
    
    173 175
       -> UnitIndexQuery
    
    176
    +  -> ModuleNameHomeMap
    
    174 177
       -> Maybe HomeUnit
    
    175 178
       -> ModuleName
    
    176 179
       -> PkgQual
    
    177 180
       -> IO FindResult
    
    178
    -findImportedModuleNoHsc fc fopts ue query mhome_unit mod_name mb_pkg =
    
    181
    +findImportedModuleNoHsc fc fopts ue query home_module_map mhome_unit mod_name mb_pkg =
    
    179 182
       case mb_pkg of
    
    180 183
         NoPkgQual  -> unqual_import
    
    181 184
         ThisPkg uid | (homeUnitId <$> mhome_unit) == Just uid -> home_import
    
    182
    -                | Just os <- lookup uid other_fopts -> home_pkg_import (uid, os)
    
    185
    +                | Just os <- M.lookup uid other_fopts_map -> home_pkg_import (uid, os)
    
    183 186
                     | otherwise -> pprPanic "findImportModule" (ppr mod_name $$ ppr mb_pkg $$ ppr (homeUnitId <$> mhome_unit) $$ ppr uid $$ ppr (map fst all_opts))
    
    184 187
         OtherPkg _ -> pkg_import
    
    185 188
       where
    
    189
    +    (complete_units, module_name_map) = home_module_map
    
    190
    +    module_home_units = M.findWithDefault Set.empty mod_name module_name_map
    
    191
    +    current_unit_id = homeUnitId <$> mhome_unit
    
    186 192
         all_opts = case mhome_unit of
    
    187
    -                Nothing -> other_fopts
    
    188
    -                Just home_unit -> (homeUnitId home_unit, fopts) : other_fopts
    
    193
    +                Nothing -> other_fopts_list
    
    194
    +                Just home_unit -> (homeUnitId home_unit, fopts) : other_fopts_list
    
    189 195
     
    
    196
    +    other_fopts_map = M.fromList other_fopts_list
    
    190 197
     
    
    191 198
         home_import = case mhome_unit of
    
    192 199
                        Just home_unit -> findHomeModule fc fopts home_unit mod_name
    
    ... ... @@ -197,7 +204,7 @@ findImportedModuleNoHsc fc fopts ue query mhome_unit mod_name mb_pkg =
    197 204
           -- If the module is reexported, then look for it as if it was from the perspective
    
    198 205
           -- of that package which reexports it.
    
    199 206
           | mod_name `Set.member` finder_reexportedModules opts =
    
    200
    -        findImportedModuleNoHsc fc opts ue query (Just $ DefiniteHomeUnit uid Nothing) mod_name NoPkgQual
    
    207
    +        findImportedModuleNoHsc fc opts ue query home_module_map (Just $ DefiniteHomeUnit uid Nothing) mod_name NoPkgQual
    
    201 208
           | mod_name `Set.member` finder_hiddenModules opts =
    
    202 209
             return (mkHomeHidden uid)
    
    203 210
           | otherwise =
    
    ... ... @@ -206,7 +213,7 @@ findImportedModuleNoHsc fc fopts ue query mhome_unit mod_name mb_pkg =
    206 213
         -- Do not be smart and change this to `foldr orIfNotFound home_import hs` as
    
    207 214
         -- that is not the same!! home_import is first because we need to look within ourselves
    
    208 215
         -- first before looking at the packages in order.
    
    209
    -    any_home_import = foldr1 orIfNotFound (home_import: map home_pkg_import other_fopts)
    
    216
    +    any_home_import = foldr1 orIfNotFound (home_import: map home_pkg_import other_fopts_list)
    
    210 217
     
    
    211 218
         pkg_import    = findExposedPackageModule fc fopts units query mod_name mb_pkg
    
    212 219
     
    
    ... ... @@ -217,9 +224,21 @@ findImportedModuleNoHsc fc fopts ue query mhome_unit mod_name mb_pkg =
    217 224
         units     = case mhome_unit of
    
    218 225
                       Nothing -> ue_units ue
    
    219 226
                       Just home_unit -> homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId home_unit) ue
    
    220
    -    hpt_deps :: [UnitId]
    
    227
    +    hpt_deps :: Set.Set UnitId
    
    221 228
         hpt_deps  = homeUnitDepends units
    
    222
    -    other_fopts  = map (\uid -> (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue)))) hpt_deps
    
    229
    +    dep_providers = Set.intersection module_home_units hpt_deps
    
    230
    +    known_other_uids =
    
    231
    +      let providers = maybe dep_providers (\u -> Set.delete u dep_providers) current_unit_id
    
    232
    +      in Set.toList providers
    
    233
    +    unknown_units =
    
    234
    +      let candidates = Set.difference hpt_deps complete_units
    
    235
    +          excluded = maybe dep_providers (\u -> Set.insert u dep_providers) current_unit_id
    
    236
    +      in Set.toList (Set.difference candidates excluded)
    
    237
    +    other_home_uids = known_other_uids ++ unknown_units
    
    238
    +    other_fopts_list =
    
    239
    +      [ (uid, initFinderOpts (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue)))
    
    240
    +      | uid <- other_home_uids
    
    241
    +      ]
    
    223 242
     
    
    224 243
     -- | Locate a plugin module requested by the user, for a compiler
    
    225 244
     -- plugin.  This consults the same set of exposed packages as
    

  • compiler/GHC/Unit/Module/Graph.hs
    ... ... @@ -18,6 +18,8 @@ module GHC.Unit.Module.Graph
    18 18
        , mgModSummaries
    
    19 19
        , mgModSummaries'
    
    20 20
        , mgLookupModule
    
    21
    +   , ModuleNameHomeMap
    
    22
    +   , mgHomeModuleMap
    
    21 23
        , showModMsg
    
    22 24
        , moduleGraphNodeModule
    
    23 25
        , moduleGraphNodeModSum
    
    ... ... @@ -153,23 +155,31 @@ instance Outputable ModNodeKeyWithUid where
    153 155
     -- check that the module and its hs-boot agree.
    
    154 156
     --
    
    155 157
     -- The graph is not necessarily stored in topologically-sorted order.  Use
    
    158
    +type ModuleNameHomeMap = (Set UnitId, Map.Map ModuleName (Set UnitId))
    
    159
    +
    
    156 160
     -- 'GHC.topSortModuleGraph' and 'GHC.Data.Graph.Directed.flattenSCC' to achieve this.
    
    157 161
     data ModuleGraph = ModuleGraph
    
    158 162
       { mg_mss :: [ModuleGraphNode]
    
    159 163
       , mg_graph :: (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
    
    160 164
         -- A cached transitive dependency calculation so that a lot of work is not
    
    161 165
         -- repeated whenever the transitive dependencies need to be calculated (for example, hptInstances)
    
    166
    +  , mg_home_map :: ModuleNameHomeMap
    
    167
    +    -- ^ For each module name, which home-unit UnitIds define it together with the set of units for which the listing is complete.
    
    162 168
       }
    
    163 169
     
    
    164 170
     -- | Map a function 'f' over all the 'ModSummaries'.
    
    165 171
     -- To preserve invariants 'f' can't change the isBoot status.
    
    166 172
     mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
    
    167 173
     mapMG f mg@ModuleGraph{..} = mg
    
    168
    -  { mg_mss = flip fmap mg_mss $ \case
    
    169
    -      InstantiationNode uid iuid -> InstantiationNode uid iuid
    
    170
    -      LinkNode uid nks -> LinkNode uid nks
    
    171
    -      ModuleNode deps ms  -> ModuleNode deps (f ms)
    
    174
    +  { mg_mss = new_mss
    
    175
    +  , mg_home_map = mkHomeModuleMap new_mss
    
    172 176
       }
    
    177
    +  where
    
    178
    +    new_mss =
    
    179
    +      flip fmap mg_mss $ \case
    
    180
    +        InstantiationNode uid iuid -> InstantiationNode uid iuid
    
    181
    +        LinkNode uid nks -> LinkNode uid nks
    
    182
    +        ModuleNode deps ms  -> ModuleNode deps (f ms)
    
    173 183
     
    
    174 184
     unionMG :: ModuleGraph -> ModuleGraph -> ModuleGraph
    
    175 185
     unionMG a b =
    
    ... ... @@ -177,11 +187,27 @@ unionMG a b =
    177 187
       in ModuleGraph {
    
    178 188
             mg_mss = new_mss
    
    179 189
           , mg_graph = mkTransDeps new_mss
    
    190
    +      , mg_home_map = mkHomeModuleMap new_mss
    
    180 191
           }
    
    181 192
     
    
    182 193
     mkTransDeps :: [ModuleGraphNode] -> (ReachabilityIndex SummaryNode, NodeKey -> Maybe SummaryNode)
    
    183 194
     mkTransDeps = first graphReachability {- module graph is acyclic -} . moduleGraphNodes False
    
    184 195
     
    
    196
    +mkHomeModuleMap :: [ModuleGraphNode] -> ModuleNameHomeMap
    
    197
    +mkHomeModuleMap nodes =
    
    198
    +  (complete_units, provider_map)
    
    199
    +  where
    
    200
    +    provider_map =
    
    201
    +      Map.fromListWith Set.union
    
    202
    +        [ (ms_mod_name ms, Set.singleton (ms_unitid ms))
    
    203
    +        | ModuleNode _ ms <- nodes
    
    204
    +        ]
    
    205
    +    complete_units =
    
    206
    +      Set.fromList
    
    207
    +        [ ms_unitid ms
    
    208
    +        | ModuleNode _ ms <- nodes
    
    209
    +        ]
    
    210
    +
    
    185 211
     mgModSummaries :: ModuleGraph -> [ModSummary]
    
    186 212
     mgModSummaries mg = [ m | ModuleNode _ m <- mgModSummaries' mg ]
    
    187 213
     
    
    ... ... @@ -200,8 +226,11 @@ mgLookupModule ModuleGraph{..} m = listToMaybe $ mapMaybe go mg_mss
    200 226
           = Just ms
    
    201 227
         go _ = Nothing
    
    202 228
     
    
    229
    +mgHomeModuleMap :: ModuleGraph -> ModuleNameHomeMap
    
    230
    +mgHomeModuleMap = mg_home_map
    
    231
    +
    
    203 232
     emptyMG :: ModuleGraph
    
    204
    -emptyMG = ModuleGraph [] (graphReachability emptyGraph, const Nothing)
    
    233
    +emptyMG = ModuleGraph [] (graphReachability emptyGraph, const Nothing) (Set.empty, Map.empty)
    
    205 234
     
    
    206 235
     isTemplateHaskellOrQQNonBoot :: ModSummary -> Bool
    
    207 236
     isTemplateHaskellOrQQNonBoot ms =
    
    ... ... @@ -213,9 +242,12 @@ isTemplateHaskellOrQQNonBoot ms =
    213 242
     -- not an element of the ModuleGraph.
    
    214 243
     extendMG :: ModuleGraph -> [NodeKey] -> ModSummary -> ModuleGraph
    
    215 244
     extendMG ModuleGraph{..} deps ms = ModuleGraph
    
    216
    -  { mg_mss = ModuleNode deps ms : mg_mss
    
    217
    -  , mg_graph = mkTransDeps (ModuleNode deps ms : mg_mss)
    
    245
    +  { mg_mss = new_mss
    
    246
    +  , mg_graph = mkTransDeps new_mss
    
    247
    +  , mg_home_map = mkHomeModuleMap new_mss
    
    218 248
       }
    
    249
    +  where
    
    250
    +    new_mss = ModuleNode deps ms : mg_mss
    
    219 251
     
    
    220 252
     extendMGInst :: ModuleGraph -> UnitId -> InstantiatedUnit -> ModuleGraph
    
    221 253
     extendMGInst mg uid depUnitId = mg
    

  • compiler/GHC/Unit/State.hs
    ... ... @@ -469,7 +469,7 @@ data UnitState = UnitState {
    469 469
       -- -Wunused-packages warning.
    
    470 470
       explicitUnits :: [(Unit, Maybe PackageArg)],
    
    471 471
     
    
    472
    -  homeUnitDepends    :: [UnitId],
    
    472
    +  homeUnitDepends    :: Set UnitId,
    
    473 473
     
    
    474 474
       -- | This is a full map from 'ModuleName' to all modules which may possibly
    
    475 475
       -- be providing it.  These providers may be hidden (but we'll still want
    
    ... ... @@ -504,7 +504,7 @@ emptyUnitState = UnitState {
    504 504
         unwireMap      = emptyUniqMap,
    
    505 505
         preloadUnits   = [],
    
    506 506
         explicitUnits  = [],
    
    507
    -    homeUnitDepends = [],
    
    507
    +    homeUnitDepends = Set.empty,
    
    508 508
         moduleNameProvidersMap       = emptyUniqMap,
    
    509 509
         pluginModuleNameProvidersMap = emptyUniqMap,
    
    510 510
         requirementContext           = emptyUniqMap,
    
    ... ... @@ -1573,7 +1573,7 @@ mkUnitState logger cfg index = do
    1573 1573
       let !state = UnitState
    
    1574 1574
              { preloadUnits                 = dep_preload
    
    1575 1575
              , explicitUnits                = explicit_pkgs
    
    1576
    -         , homeUnitDepends              = Set.toList home_unit_deps
    
    1576
    +         , homeUnitDepends              = home_unit_deps
    
    1577 1577
              , unitInfoMap                  = pkg_db
    
    1578 1578
              , preloadClosure               = emptyUniqSet
    
    1579 1579
              , moduleNameProvidersMap
    

  • ghc/Main.hs
    ... ... @@ -893,7 +893,7 @@ checkUnitCycles :: DynFlags -> UnitEnvGraph HomeUnitEnv -> Ghc ()
    893 893
     checkUnitCycles dflags graph = processSCCs sccs
    
    894 894
       where
    
    895 895
         mkNode :: (UnitId, HomeUnitEnv) -> Node UnitId UnitId
    
    896
    -    mkNode (uid, hue) = DigraphNode uid uid (homeUnitDepends (homeUnitEnv_units hue))
    
    896
    +    mkNode (uid, hue) = DigraphNode uid uid (Set.toList (homeUnitDepends (homeUnitEnv_units hue)))
    
    897 897
         nodes = map mkNode (unitEnv_elts graph)
    
    898 898
     
    
    899 899
         sccs = stronglyConnCompFromEdgedVerticesOrd nodes
    

  • testsuite/tests/ghc-api/downsweep/OldModLocation.hs
    ... ... @@ -47,13 +47,13 @@ main = do
    47 47
     
    
    48 48
         liftIO $ do
    
    49 49
     
    
    50
    -    _emss <- downsweep hsc_env [] [] False
    
    50
    +    _emss <- downsweep hsc_env [] Nothing [] False
    
    51 51
     
    
    52 52
         flushFinderCaches (hsc_FC hsc_env) (hsc_unit_env hsc_env)
    
    53 53
         createDirectoryIfMissing False "mydir"
    
    54 54
         renameFile "B.hs" "mydir/B.hs"
    
    55 55
     
    
    56
    -    (_, nodes) <- downsweep hsc_env [] [] False
    
    56
    +    (_, nodes) <- downsweep hsc_env [] Nothing [] False
    
    57 57
     
    
    58 58
         -- If 'checkSummaryTimestamp' were to call 'addHomeModuleToFinder' with
    
    59 59
         -- (ms_location old_summary) like summariseFile used to instead of
    

  • testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs
    ... ... @@ -168,7 +168,7 @@ go label mods cnd =
    168 168
         setTargets [tgt]
    
    169 169
     
    
    170 170
         hsc_env <- getSession
    
    171
    -    (_, nodes) <- liftIO $ downsweep hsc_env [] [] False
    
    171
    +    (_, nodes) <- liftIO $ downsweep hsc_env [] Nothing [] False
    
    172 172
     
    
    173 173
         it label $ cnd (mapMaybe moduleGraphNodeModSum nodes)
    
    174 174