summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2022-02-21 14:33:45 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-03-01 16:23:10 -0500
commit547742682702f08041e518d68d752ef6329843c3 (patch)
tree62c0c6e9b24049b8114e8e4beea6bb187843bd2d
parent80f9133e128abc61913d264ecd8b102517b266f5 (diff)
downloadhaskell-547742682702f08041e518d68d752ef6329843c3.tar.gz
Fix longstanding issue with moduleGraphNodes - no hs-boot files case
In the case when we tell moduleGraphNodes to drop hs-boot files the idea is to collapse hs-boot files into their hs file nodes. In the old code * nodeDependencies changed edges from IsBoot to NonBoot * moduleGraphNodes just dropped boot file nodes The net result is that any dependencies of the hs-boot files themselves were dropped. The correct thing to do is * nodeDependencies changes edges from IsBoot to NonBoot * moduleGraphNodes merges dependencies of IsBoot and NonBoot nodes. The result is a properly quotiented dependency graph which contains no hs-boot files nor hs-boot file edges. Why this didn't cause endless issues when compiling with boot files, we will never know.
-rw-r--r--compiler/GHC/Unit/Module/Graph.hs40
1 files changed, 28 insertions, 12 deletions
diff --git a/compiler/GHC/Unit/Module/Graph.hs b/compiler/GHC/Unit/Module/Graph.hs
index f71c71347f..1743d9edb3 100644
--- a/compiler/GHC/Unit/Module/Graph.hs
+++ b/compiler/GHC/Unit/Module/Graph.hs
@@ -63,6 +63,9 @@ import qualified Data.Set as Set
import GHC.Unit.Module
import GHC.Linker.Static.Utils
+import Data.Bifunctor
+import Data.Either
+
-- | A '@ModuleGraphNode@' is a node in the '@ModuleGraph@'.
-- Edges between nodes mark dependencies arising from module imports
-- and dependencies arising from backpack instantiations.
@@ -290,11 +293,35 @@ nodeDependencies drop_hs_boot_nodes = \case
drop_hs_boot (NodeKey_Module (ModNodeKeyWithUid (GWIB mn IsBoot) uid)) = (NodeKey_Module (ModNodeKeyWithUid (GWIB mn hs_boot_key) uid))
drop_hs_boot x = x
-moduleGraphNodes :: Bool -> [ModuleGraphNode]
+-- | Turn a list of graph nodes into an efficient queriable graph.
+-- The first boolean parameter indicates whether nodes corresponding to hs-boot files
+-- should be collapsed into their relevant hs nodes.
+moduleGraphNodes :: Bool
+ -> [ModuleGraphNode]
-> (Graph SummaryNode, NodeKey -> Maybe SummaryNode)
moduleGraphNodes drop_hs_boot_nodes summaries =
(graphFromEdgedVerticesUniq nodes, lookup_node)
where
+ -- Map from module to extra boot summary dependencies which need to be merged in
+ (boot_summaries, nodes) = bimap Map.fromList id $ partitionEithers (map go numbered_summaries)
+
+ where
+ go (s, key) =
+ case s of
+ ModuleNode __deps ms | isBootSummary ms == IsBoot, drop_hs_boot_nodes
+ -- Using nodeDependencies here converts dependencies on other
+ -- boot files to dependencies on dependencies on non-boot files.
+ -> Left (ms_mod ms, nodeDependencies drop_hs_boot_nodes s)
+ _ -> normal_case
+ where
+ normal_case =
+ let lkup_key = ms_mod <$> moduleGraphNodeModSum s
+ extra = (lkup_key >>= \key -> Map.lookup key boot_summaries)
+
+ in Right $ DigraphNode s key $ out_edge_keys $
+ (fromMaybe [] extra
+ ++ nodeDependencies drop_hs_boot_nodes s)
+
numbered_summaries = zip summaries [1..]
lookup_node :: NodeKey -> Maybe SummaryNode
@@ -310,17 +337,6 @@ moduleGraphNodes drop_hs_boot_nodes summaries =
, let s = summaryNodeSummary node
]
- -- We use integers as the keys for the SCC algorithm
- nodes :: [SummaryNode]
- nodes = [ DigraphNode s key $ out_edge_keys $ nodeDependencies drop_hs_boot_nodes s
- | (s, key) <- numbered_summaries
- -- Drop the hi-boot ones if told to do so
- , case s of
- InstantiationNode {} -> True
- LinkNode {} -> True
- ModuleNode _ ms -> not $ isBootSummary ms == IsBoot && drop_hs_boot_nodes
- ]
-
out_edge_keys :: [NodeKey] -> [Int]
out_edge_keys = mapMaybe lookup_key
-- If we want keep_hi_boot_nodes, then we do lookup_key with