| ... |
... |
@@ -67,6 +67,8 @@ module GHC.Unit.Module.Graph |
|
67
|
67
|
, mgLookupModule
|
|
68
|
68
|
, mgLookupModuleName
|
|
69
|
69
|
, mgHasHoles
|
|
|
70
|
+ , ModuleNameHomeMap (ModuleNameHomeMap)
|
|
|
71
|
+ , mgHomeModuleMap
|
|
70
|
72
|
, showModMsg
|
|
71
|
73
|
|
|
72
|
74
|
-- ** Reachability queries
|
| ... |
... |
@@ -156,10 +158,11 @@ import GHC.Unit.Module.ModIface |
|
156
|
158
|
import GHC.Utils.Misc ( partitionWith )
|
|
157
|
159
|
|
|
158
|
160
|
import System.FilePath
|
|
|
161
|
+import Data.Set (Set)
|
|
|
162
|
+import qualified Data.Set as Set
|
|
|
163
|
+import Data.Map (Map)
|
|
159
|
164
|
import qualified Data.Map as Map
|
|
160
|
165
|
import GHC.Types.Unique.DSet
|
|
161
|
|
-import qualified Data.Set as Set
|
|
162
|
|
-import Data.Set (Set)
|
|
163
|
166
|
import GHC.Unit.Module
|
|
164
|
167
|
import GHC.Unit.Module.ModNodeKey
|
|
165
|
168
|
import GHC.Unit.Module.Stage
|
| ... |
... |
@@ -202,14 +205,47 @@ data ModuleGraph = ModuleGraph |
|
202
|
205
|
-- Cached computation, whether any of the ModuleGraphNode are isHoleModule,
|
|
203
|
206
|
-- This is only used for a hack in GHC.Iface.Load to do with backpack, please
|
|
204
|
207
|
-- remove this at the earliest opportunity.
|
|
|
208
|
+ , mg_home_map :: ModuleNameHomeMap
|
|
|
209
|
+ -- ^ For each module name, which home unit UnitIds define it together with the set of units for which the listing is complete.
|
|
205
|
210
|
}
|
|
206
|
211
|
|
|
|
212
|
+data ModuleNameHomeMap = ModuleNameHomeMap !(Set UnitId)
|
|
|
213
|
+ !(Map ModuleName (Set UnitId))
|
|
|
214
|
+
|
|
|
215
|
+mkHomeModuleMap :: [ModuleGraphNode] -> ModuleNameHomeMap
|
|
|
216
|
+mkHomeModuleMap nodes = ModuleNameHomeMap completeUnits providerMap where
|
|
|
217
|
+
|
|
|
218
|
+ providerMap :: Map ModuleName (Set UnitId)
|
|
|
219
|
+ providerMap
|
|
|
220
|
+ = Map.fromListWith Set.union $
|
|
|
221
|
+ [
|
|
|
222
|
+ (ms_mod_name modSummary, Set.singleton (ms_unitid modSummary)) |
|
|
|
223
|
+ ModuleNode _ (ModuleNodeCompile modSummary) <- nodes
|
|
|
224
|
+ ]
|
|
|
225
|
+
|
|
|
226
|
+ completeUnits :: Set UnitId
|
|
|
227
|
+ completeUnits
|
|
|
228
|
+ = Set.fromList $
|
|
|
229
|
+ [
|
|
|
230
|
+ ms_unitid modSummary |
|
|
|
231
|
+ ModuleNode _ (ModuleNodeCompile modSummary) <- nodes
|
|
|
232
|
+ ]
|
|
|
233
|
+
|
|
|
234
|
+ {-NOTE:
|
|
|
235
|
+ The matching with `ModuleNodeCompile` results in nodes with
|
|
|
236
|
+ `ModuleNodeFixed` in their info being dropped.
|
|
|
237
|
+ -}
|
|
|
238
|
+
|
|
|
239
|
+mgHomeModuleMap :: ModuleGraph -> ModuleNameHomeMap
|
|
|
240
|
+mgHomeModuleMap = mg_home_map
|
|
|
241
|
+
|
|
207
|
242
|
-- | Why do we ever need to construct empty graphs? Is it because of one shot mode?
|
|
208
|
243
|
emptyMG :: ModuleGraph
|
|
209
|
244
|
emptyMG = ModuleGraph [] (graphReachability emptyGraph, const Nothing)
|
|
210
|
245
|
(graphReachability emptyGraph, const Nothing)
|
|
211
|
246
|
(graphReachability emptyGraph, const Nothing)
|
|
212
|
247
|
False
|
|
|
248
|
+ (ModuleNameHomeMap Set.empty Map.empty)
|
|
213
|
249
|
|
|
214
|
250
|
-- | Construct a module graph. This function should be the only entry point for
|
|
215
|
251
|
-- building a 'ModuleGraph', since it is supposed to be built once and never modified.
|
| ... |
... |
@@ -308,7 +344,7 @@ checkModuleGraph ModuleGraph{..} = |
|
308
|
344
|
where
|
|
309
|
345
|
duplicate_errs = rights (Map.elems node_types)
|
|
310
|
346
|
|
|
311
|
|
- node_types :: Map.Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError)
|
|
|
347
|
+ node_types :: Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError)
|
|
312
|
348
|
node_types = Map.fromListWithKey go [ (mkNodeKey n, Left (moduleNodeType n)) | n <- mg_mss ]
|
|
313
|
349
|
where
|
|
314
|
350
|
-- Multiple nodes with the same key are not allowed.
|
| ... |
... |
@@ -319,7 +355,7 @@ checkModuleGraph ModuleGraph{..} = |
|
319
|
355
|
|
|
320
|
356
|
-- | Check that all dependencies in the graph are present in the node_types map.
|
|
321
|
357
|
-- This is a helper function used by checkModuleGraph.
|
|
322
|
|
-checkAllDependenciesInGraph :: Map.Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError)
|
|
|
358
|
+checkAllDependenciesInGraph :: Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError)
|
|
323
|
359
|
-> ModuleGraphNode
|
|
324
|
360
|
-> Maybe ModuleGraphInvariantError
|
|
325
|
361
|
checkAllDependenciesInGraph node_types node =
|
| ... |
... |
@@ -334,7 +370,7 @@ checkAllDependenciesInGraph node_types node = |
|
334
|
370
|
-- | Check if for the fixed module node invariant:
|
|
335
|
371
|
--
|
|
336
|
372
|
-- Fixed nodes can only depend on other fixed nodes.
|
|
337
|
|
-checkFixedModuleInvariant :: Map.Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError)
|
|
|
373
|
+checkFixedModuleInvariant :: Map NodeKey (Either ModuleNodeType ModuleGraphInvariantError)
|
|
338
|
374
|
-> ModuleGraphNode
|
|
339
|
375
|
-> Maybe ModuleGraphInvariantError
|
|
340
|
376
|
checkFixedModuleInvariant node_types node = case node of
|
| ... |
... |
@@ -484,13 +520,17 @@ isEmptyMG = null . mg_mss |
|
484
|
520
|
-- To preserve invariants, 'f' can't change the isBoot status.
|
|
485
|
521
|
mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph
|
|
486
|
522
|
mapMG f mg@ModuleGraph{..} = mg
|
|
487
|
|
- { mg_mss = flip fmap mg_mss $ \case
|
|
488
|
|
- InstantiationNode uid iuid -> InstantiationNode uid iuid
|
|
489
|
|
- LinkNode uid nks -> LinkNode uid nks
|
|
490
|
|
- ModuleNode deps (ModuleNodeFixed key loc) -> ModuleNode deps (ModuleNodeFixed key loc)
|
|
491
|
|
- ModuleNode deps (ModuleNodeCompile ms) -> ModuleNode deps (ModuleNodeCompile (f ms))
|
|
492
|
|
- UnitNode deps uid -> UnitNode deps uid
|
|
|
523
|
+ { mg_mss = new_mss
|
|
|
524
|
+ , mg_home_map = mkHomeModuleMap new_mss
|
|
493
|
525
|
}
|
|
|
526
|
+ where
|
|
|
527
|
+ new_mss =
|
|
|
528
|
+ flip fmap mg_mss $ \case
|
|
|
529
|
+ InstantiationNode uid iuid -> InstantiationNode uid iuid
|
|
|
530
|
+ LinkNode uid nks -> LinkNode uid nks
|
|
|
531
|
+ ModuleNode deps (ModuleNodeFixed key loc) -> ModuleNode deps (ModuleNodeFixed key loc)
|
|
|
532
|
+ ModuleNode deps (ModuleNodeCompile ms) -> ModuleNode deps (ModuleNodeCompile (f ms))
|
|
|
533
|
+ UnitNode deps uid -> UnitNode deps uid
|
|
494
|
534
|
|
|
495
|
535
|
-- | Map a function 'f' over all the 'ModSummaries', in 'IO'.
|
|
496
|
536
|
-- To preserve invariants, 'f' can't change the isBoot status.
|
| ... |
... |
@@ -856,7 +896,7 @@ moduleNodeInfoBootString mn@(ModuleNodeFixed {}) = |
|
856
|
896
|
-- described in the export list haddocks.
|
|
857
|
897
|
--------------------------------------------------------------------------------
|
|
858
|
898
|
|
|
859
|
|
-newtype NodeMap a = NodeMap { unNodeMap :: Map.Map NodeKey a }
|
|
|
899
|
+newtype NodeMap a = NodeMap { unNodeMap :: Map NodeKey a }
|
|
860
|
900
|
deriving (Functor, Traversable, Foldable)
|
|
861
|
901
|
|
|
862
|
902
|
-- | Transitive dependencies, including SOURCE edges
|
| ... |
... |
@@ -932,7 +972,7 @@ moduleGraphNodesZero summaries = |
|
932
|
972
|
lookup_key :: ZeroScopeKey -> Maybe Int
|
|
933
|
973
|
lookup_key = fmap zeroSummaryNodeKey . lookup_node
|
|
934
|
974
|
|
|
935
|
|
- node_map :: Map.Map ZeroScopeKey ZeroSummaryNode
|
|
|
975
|
+ node_map :: Map ZeroScopeKey ZeroSummaryNode
|
|
936
|
976
|
node_map =
|
|
937
|
977
|
Map.fromList [ (s, node)
|
|
938
|
978
|
| node <- nodes
|
| ... |
... |
@@ -1031,7 +1071,7 @@ moduleGraphNodesStages summaries = |
|
1031
|
1071
|
lookup_key :: (NodeKey, ModuleStage) -> Maybe Int
|
|
1032
|
1072
|
lookup_key = fmap stageSummaryNodeKey . lookup_node
|
|
1033
|
1073
|
|
|
1034
|
|
- node_map :: Map.Map (NodeKey, ModuleStage) StageSummaryNode
|
|
|
1074
|
+ node_map :: Map (NodeKey, ModuleStage) StageSummaryNode
|
|
1035
|
1075
|
node_map =
|
|
1036
|
1076
|
Map.fromList [ (s, node)
|
|
1037
|
1077
|
| node <- nodes
|
| ... |
... |
@@ -1049,10 +1089,13 @@ moduleGraphNodesStages summaries = |
|
1049
|
1089
|
extendMG :: ModuleGraph -> ModuleGraphNode -> ModuleGraph
|
|
1050
|
1090
|
extendMG ModuleGraph{..} node =
|
|
1051
|
1091
|
ModuleGraph
|
|
1052
|
|
- { mg_mss = node : mg_mss
|
|
1053
|
|
- , mg_graph = mkTransDeps (node : mg_mss)
|
|
1054
|
|
- , mg_loop_graph = mkTransLoopDeps (node : mg_mss)
|
|
1055
|
|
- , mg_zero_graph = mkTransZeroDeps (node : mg_mss)
|
|
|
1092
|
+ { mg_mss = new_mss
|
|
|
1093
|
+ , mg_graph = mkTransDeps new_mss
|
|
|
1094
|
+ , mg_loop_graph = mkTransLoopDeps new_mss
|
|
|
1095
|
+ , mg_zero_graph = mkTransZeroDeps new_mss
|
|
1056
|
1096
|
, mg_has_holes = mg_has_holes || maybe False isHsigFile (moduleNodeInfoHscSource =<< mgNodeIsModule node)
|
|
|
1097
|
+ , mg_home_map = mkHomeModuleMap new_mss
|
|
1057
|
1098
|
}
|
|
|
1099
|
+ where
|
|
|
1100
|
+ new_mss = node : mg_mss
|
|
1058
|
1101
|
|