[Git][ghc/ghc][wip/mpickering/get-link-deps] Insert package nodes in external module graph

[Rodrigo Mesquita (@alt-romes)]

Rodrigo Mesquita pushed to branch wip/mpickering/get-link-deps at Glasgow Haskell Compiler / GHC


Commits:
7f71d0fe by Rodrigo Mesquita at 2024-12-20T17:05:38+00:00
Insert package nodes in external module graph

(For every interface loaded)

- - - - -


2 changed files:

- compiler/GHC/Iface/Load.hs
- compiler/GHC/Unit/Module/External/Graph.hs


Changes:

=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -580,12 +580,20 @@ loadInterface doc_str mod from
         ; purged_hsc_env <- getTopEnv
 
         ; let direct_deps = map (uncurry (flip ModNodeKeyWithUid)) $ (Set.toList (dep_direct_mods $ mi_deps iface))
+        ; let direct_pkg_deps = Set.toList (dep_direct_pkgs $ mi_deps iface)
         ; let !module_graph_key = pprTrace "module_graph_on_load" (ppr (eps_module_graph eps)) $
-                if moduleUnitId mod `elem` hsc_all_home_unit_ids hsc_env -- can only happen in oneshot mode
+                if moduleUnitId mod `elem` hsc_all_home_unit_ids hsc_env
+                                    --- ^ home unit mods in eps can only happen in oneshot mode
                   then Just $ NodeHomePackage (miKey iface) (map ExternalModuleKey direct_deps)
                   else Nothing
-        -- ; let !module_graph_external_pkgs_nods = _
-                -- ROMES:TODO: Fairly sure we need to insert package nodes somewhere here.
+        ; let !module_graph_pkg_key = do
+                let pkg_key = toUnitId $ moduleUnit (mi_module iface)
+                pkg_node <- emgLookupKey (ExternalPackageKey pkg_key) (eps_module_graph eps)
+                case pkg_node of
+                  NodeHomePackage{} -> panic "ExternalPackageKey lookup should never return a NodeHomePackage node"
+                  NodeExternalPackage _ deps_uids -> pure $
+                    NodeExternalPackage pkg_key (deps_uids ++ direct_pkg_deps)
+
 
         ; let final_iface = iface
                                & set_mi_decls     (panic "No mi_decls in PIT")
@@ -627,9 +635,14 @@ loadInterface doc_str mod from
                   eps_iface_bytecode = add_bytecode (eps_iface_bytecode eps),
                   eps_rule_base    = extendRuleBaseList (eps_rule_base eps)
                                                         new_eps_rules,
-                  eps_module_graph = case module_graph_key of
-                                        Just k -> extendExternalModuleGraph k (eps_module_graph eps)
-                                        Nothing -> eps_module_graph eps,
+                  eps_module_graph =
+                    let eps_graph'  = case module_graph_key of
+                                       Just k -> extendExternalModuleGraph k (eps_module_graph eps)
+                                       Nothing -> eps_module_graph eps
+                        eps_graph'' = case module_graph_pkg_key of
+                                        Just k -> extendExternalModuleGraph k eps_graph'
+                                        Nothing -> eps_graph'
+                     in eps_graph'',
                   eps_complete_matches
                                    = eps_complete_matches eps ++ new_eps_complete_matches,
                   eps_inst_env     = extendInstEnvList (eps_inst_env eps)


=====================================
compiler/GHC/Unit/Module/External/Graph.hs
=====================================
@@ -8,7 +8,7 @@ module GHC.Unit.Module.External.Graph
     -- | A module graph for the EPS.
     ExternalModuleGraph, ExternalGraphNode(..)
   , ExternalKey(..), emptyExternalModuleGraph
-  , emgNodeKey, emgNodeDeps
+  , emgNodeKey, emgNodeDeps, emgLookupKey
 
     -- * Extending
     --
@@ -120,6 +120,10 @@ emgNodeKey :: ExternalGraphNode -> ExternalKey
 emgNodeKey (NodeHomePackage k _) = ExternalModuleKey k
 emgNodeKey (NodeExternalPackage k _) = ExternalPackageKey k
 
+-- | Lookup a key in the EMG.
+emgLookupKey :: ExternalKey -> ExternalModuleGraph -> Maybe ExternalGraphNode
+emgLookupKey k emg = node_payload <$> (snd (external_trans emg)) k
+
 --------------------------------------------------------------------------------
 -- * Extending
 --------------------------------------------------------------------------------



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f71d0fe5ca57e98077c155b83cbd97f6fde70e0

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f71d0fe5ca57e98077c155b83cbd97f6fde70e0
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/20241220/555f83d8/attachment-0001.html>