[Git][ghc/ghc][wip/mpickering/get-link-deps] fix plugin loading

[Matthew Pickering (@mpickering)]

Matthew Pickering pushed to branch wip/mpickering/get-link-deps at Glasgow Haskell Compiler / GHC


Commits:
01411748 by Matthew Pickering at 2024-11-27T17:38:41+00:00
fix plugin loading

- - - - -


2 changed files:

- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Unit/Module/Graph.hs


Changes:

=====================================
compiler/GHC/Linker/Deps.hs
=====================================
@@ -152,11 +152,17 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
     mod_graph = ldModuleGraph opts
     unit_env  = ldUnitEnv     opts
 
-    mkNk m = ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m)
-    all_deps = mgReachableLoop mod_graph $ map (NodeKey_Module . mkNk) (filterOut isInteractiveModule mods)
+    mkNk m
+       = let k = NodeKey_Module (ModNodeKeyWithUid (GWIB (moduleName m) NotBoot) (moduleUnitId m))
+         in if mgMember mod_graph k
+              then k
+              else NodeKey_ExternalUnit (moduleUnitId m)
 
-    all_home_mods = [with_uid | NodeKey_Module with_uid <- map mkNodeKey all_deps]
-    all_dep_pkgs = [uid | NodeKey_ExternalUnit uid <- map mkNodeKey all_deps]
+    initial_keys = map mkNk (filterOut isInteractiveModule mods)
+    all_deps = initial_keys ++ map mkNodeKey (mgReachableLoop mod_graph initial_keys)
+
+    all_home_mods = [with_uid | NodeKey_Module with_uid <- all_deps]
+    all_dep_pkgs = [uid | NodeKey_ExternalUnit uid <- all_deps]
 
     get_mod_info (ModNodeKeyWithUid gwib uid) =
       case lookupHug (ue_home_unit_graph unit_env) uid (gwib_mod gwib) of


=====================================
compiler/GHC/Unit/Module/Graph.hs
=====================================
@@ -23,6 +23,7 @@ module GHC.Unit.Module.Graph
    , mgReachable
    , mgReachableLoop
    , mgQuery
+   , mgMember
 
    , moduleGraphNodes
    , SummaryNode
@@ -226,14 +227,15 @@ isTemplateHaskellOrQQNonBoot ms =
 -- | Add an ExtendedModSummary to ModuleGraph. Assumes that the new ModSummary is
 -- not an element of the ModuleGraph.
 extendMG :: ModuleGraph -> ModuleGraphNode -> ModuleGraph
-extendMG ModuleGraph{..} node = mkModuleGraph (node : mg_mss)
+extendMG ModuleGraph{..} node =
+  ModuleGraph
+    { mg_mss = node : mg_mss
+    , mg_graph =  mkTransDeps (node : mg_mss)
+    , mg_loop_graph = mkTransLoopDeps (node : mg_mss)
+    }
 
 mkModuleGraph :: [ModuleGraphNode] -> ModuleGraph
-mkModuleGraph nodes = ModuleGraph
-  { mg_mss = nodes
-  , mg_graph = mkTransDeps nodes
-  , mg_loop_graph = mkTransLoopDeps nodes
-  }
+mkModuleGraph nodes = foldr (flip extendMG) emptyMG nodes
 
 -- | 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"
@@ -424,7 +426,7 @@ mgReachableLoop :: ModuleGraph -> [NodeKey] -> [ModuleGraphNode]
 mgReachableLoop mg nk = map summaryNodeSummary modules_below where
   (td_map, lookup_node) = mg_loop_graph mg
   modules_below =
-    allReachableManyWithRoots td_map (mapMaybe lookup_node nk)
+    allReachableMany td_map (mapMaybe lookup_node nk)
 
 
 -- | Reachability Query. @mgQuery(g, a, b)@ asks: Can we reach @b@ from @a@ in
@@ -439,3 +441,6 @@ mgQuery mg nka nkb = isReachable td_map na nb where
   na = expectJust "mgQuery:a" $ lookup_node nka
   nb = expectJust "mgQuery:b" $ lookup_node nkb
 
+mgMember :: ModuleGraph -> NodeKey -> Bool
+mgMember graph k = isJust $ snd (mg_graph graph) k
+



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/014117486cf8503a8b48fa37b25ddbf9c906a19e

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/014117486cf8503a8b48fa37b25ddbf9c906a19e
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241218/0f13994f/attachment-0001.html>