[Git][ghc/ghc][wip/romes/graph-compact-easy] 2 commits: rts: Introduce printIPE
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Tue Nov 19 12:03:39 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/graph-compact-easy at Glasgow Haskell Compiler / GHC
Commits:
3787bb1a by Ben Gamari at 2024-11-18T18:16:52+00:00
rts: Introduce printIPE
This is a convenience utility for use in GDB.
- - - - -
82f3f8fb by Rodrigo Mesquita at 2024-11-19T12:03:30+00:00
fixup! fixup! fixup! A start on module graphs
- - - - -
5 changed files:
- compiler/GHC/Data/Graph/Directed.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Unit/Module/Graph.hs
- rts/IPE.c
- rts/include/rts/IPE.h
Changes:
=====================================
compiler/GHC/Data/Graph/Directed.hs
=====================================
@@ -14,8 +14,8 @@ module GHC.Data.Graph.Directed (
stronglyConnCompG,
topologicalSortG,
verticesG, edgesG, hasVertexG,
- reachableG, reachableG',
- reachablesG, transposeG, outgoingG,
+ reachableFromG, reachablesG,
+ transposeG, outgoingG,
emptyG,
findCycle,
@@ -30,7 +30,7 @@ module GHC.Data.Graph.Directed (
EdgeType(..), classifyEdges,
ReachabilityIndex, reachabilityIndex, emptyGraph, nodeLookupByIx, ixLookupByNode,
- reachable
+ reachableQuery
) where
------------------------------------------------------------------------------
@@ -93,6 +93,8 @@ data Graph node = Graph {
gr_vertex_to_node :: Vertex -> node,
gr_node_to_vertex :: node -> Maybe Vertex,
gr_reachability :: ReachabilityIndex
+ -- ^ We cache a reachability index to answer reachability queries faster.
+ -- romes:todo: Is it worth it to cache this for all graphs, or should it be ModuleGraph specific?
}
data Edge node = Edge node node
@@ -360,32 +362,29 @@ topologicalSortG :: Graph node -> [node]
topologicalSortG graph = map (gr_vertex_to_node graph) result
where result = {-# SCC "Digraph.topSort" #-} G.topSort (gr_int_graph graph)
--- ROMES:TODO: ADD UNIT TESTS(To the properly defined graph interface)
--- ROMES:TODO: ADD UNIT TESTS(To the mOduleGraph properly defined graph interface)
-reachableG :: Graph node -> node -> [node]
-reachableG graph from = map (gr_vertex_to_node graph) result
- where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from)
+-- | 'reachableFromG' returns in an /unordered/ list the nodes reachable from the given node.
+-- The list of nodes /does not/ include the root node!
+-- Because we cache a graph reachability index, this operation is very fast.
+reachableFromG :: Graph node -> node -> [node]
+reachableFromG graph from = map (gr_vertex_to_node graph) result
+ where from_vertex = expectJust "reachableFromG" (gr_node_to_vertex graph from)
hits = {-# SCC "Digraph.reachable" #-} IM.lookup from_vertex (gr_reachability graph)
- result = IS.toList $! IS.insert from_vertex $ expectJust "reachableG2" hits
-
--- | DoENS't INCLUDE THE ROOT VERTEX
-reachableG' :: Graph node -> node -> [node]
-reachableG' graph from = map (gr_vertex_to_node graph) result
- where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from)
- hits = {-# SCC "Digraph.reachable" #-} IM.lookup from_vertex (gr_reachability graph)
- result = IS.toList $! expectJust "reachableG2" hits
+ result = IS.toList $! expectJust "reachableFromG" hits
outgoingG :: Graph node -> node -> [node]
outgoingG graph from = map (gr_vertex_to_node graph) result
- where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from)
+ where from_vertex = expectJust "outgoingG" (gr_node_to_vertex graph from)
result = gr_int_graph graph ! from_vertex
--- | Given a list of roots return all reachable nodes.
+-- | Given a list of roots, return all reachable nodes in topological order.
+-- Implemented using a depth-first traversal.
reachablesG :: Graph node -> [node] -> [node]
-reachablesG graph froms = map (gr_vertex_to_node graph) (IS.toList result)
+reachablesG graph froms = map (gr_vertex_to_node graph) ({-IS.toList-} result)
where result = {-# SCC "Digraph.reachable" #-}
- IS.union (IS.fromList vs) $
- IS.unions $ map (expectJust "reachablesG" . flip IM.lookup (gr_reachability graph)) vs
+ reachable (gr_int_graph graph) vs
+ -- The following would be more efficient,
+ -- IS.union (IS.fromList vs) $
+ -- IS.unions $ map (expectJust "reachablesG" . flip IM.lookup (gr_reachability graph)) vs
vs = [ v | Just v <- map (gr_node_to_vertex graph) froms ]
hasVertexG :: Graph node -> node -> Bool
@@ -440,6 +439,26 @@ graphEmpty g = lo > hi
type IntGraph = G.Graph
+{-
+------------------------------------------------------------
+-- Depth first search numbering
+------------------------------------------------------------
+-}
+
+-- Data.Tree has flatten for Tree, but nothing for Forest
+preorderF :: Forest a -> [a]
+preorderF ts = concatMap flatten ts
+
+{-
+------------------------------------------------------------
+-- Finding reachable vertices
+------------------------------------------------------------
+-}
+
+-- This generalizes reachable which was found in Data.Graph
+reachable :: IntGraph -> [Vertex] -> [Vertex]
+reachable g vs = preorderF (G.dfs g vs)
+
reachableGraph :: IntGraph -> IM.IntMap IS.IntSet
reachableGraph g = res
where
@@ -567,7 +586,7 @@ graphFromVerticesAndAdjacency vertices edges = Graph graph vertex_node (key_vert
graph = G.buildG bounds reduced_edges
--------------------------------------------------------------------------------
--- Temporary!!!!
+-- Reachability
--------------------------------------------------------------------------------
type ReachabilityIndex = IM.IntMap IS.IntSet
@@ -583,11 +602,11 @@ ixLookupByNode (Graph _ _ to _) v = to v
-- | Reachability query. On graph @g@ and nodes @a@ and @b@, @reachable(g, a,
-- b)@ asks whether @b@ can be reached starting from @a at .
-reachable :: Graph node -- ^ @g@
+reachableQuery :: Graph node -- ^ @g@
-> node -- ^ @a@
-> node -- ^ @b@
-> Bool -- ^ @b@ is reachable from @a@
-reachable (Graph _ _ to index) a b = IS.member b_i $ expectJust "reachable" $ IM.lookup a_i index
+reachableQuery (Graph _ _ to index) a b = IS.member b_i $ expectJust "reachable" $ IM.lookup a_i index
where a_i = expectJust "reachable:node not in graph" $ to a
b_i = expectJust "reachable:node not in graph" $ to b
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1500,7 +1500,7 @@ topSortModules drop_hs_boot_nodes summaries mb_root_mod
= node
| otherwise
= throwGhcException (ProgramError "module does not exist")
- in graphFromEdgedVerticesUniq (seq root (reachableG graph root))
+ in graphFromEdgedVerticesUniq (seq root (root:reachableFromG graph root))
newtype ModNodeMap a = ModNodeMap { unModNodeMap :: Map.Map ModNodeKey a }
deriving (Functor, Traversable, Foldable)
=====================================
compiler/GHC/Unit/Module/Graph.hs
=====================================
@@ -410,7 +410,7 @@ mgReachable :: ModuleGraph -> NodeKey -> [ModuleGraphNode]
mgReachable mg nk = map summaryNodeSummary modules_below where
(td_map, lookup_node) = mg_graph mg
modules_below = expectJust "mgReachable" $
- reachableG' td_map <$> lookup_node nk
+ reachableFromG td_map <$> lookup_node nk
-- | Reachability Query. @mgQuery(g, a, b)@ asks: Can we reach @b@ from @a@ in
-- graph @g@?
@@ -419,7 +419,7 @@ mgQuery :: ModuleGraph -- ^ @g@
-> NodeKey -- ^ @a@
-> NodeKey -- ^ @b@
-> Bool -- ^ @b@ is reachable from @a@
-mgQuery mg nka nkb = reachable td_map na nb where
+mgQuery mg nka nkb = reachableQuery td_map na nb where
(td_map, lookup_node) = mg_graph mg
na = expectJust "mgQuery:a" $ lookup_node nka
nb = expectJust "mgQuery:b" $ lookup_node nkb
=====================================
rts/IPE.c
=====================================
@@ -277,3 +277,20 @@ void decompressIPEBufferListNodeIfCompressed(IpeBufferListNode *node) {
}
}
+
+#if defined(DEBUG)
+void printIPE(const StgInfoTable *info) {
+ InfoProvEnt ipe;
+ if (lookupIPE(info, &ipe)) {
+ debugBelch("%p:\n", info);
+ debugBelch(" name: %s\n", ipe.prov.table_name);
+ debugBelch(" desc: %" PRIu32 "\n", ipe.prov.closure_desc);
+ debugBelch(" type: %s\n", ipe.prov.ty_desc);
+ debugBelch(" label: %s\n", ipe.prov.label);
+ debugBelch(" module: %s:%s\n", ipe.prov.unit_id, ipe.prov.module);
+ debugBelch(" src loc: %s:%s\n", ipe.prov.src_file, ipe.prov.src_span);
+ } else {
+ debugBelch("%p: no IPE entry\n", info);
+ }
+}
+#endif
=====================================
rts/include/rts/IPE.h
=====================================
@@ -97,3 +97,7 @@ void formatClosureDescIpe(const InfoProvEnt *ipe_buf, char *str_buf);
// Returns true on success, initializes `out`.
bool lookupIPE(const StgInfoTable *info, InfoProvEnt *out);
+
+#if defined(DEBUG)
+void printIPE(const StgInfoTable *info);
+#endif
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3476ec0cd8ec85693ff241daaf467b6972510201...82f3f8fb852abdbbed7dca82ec4fcd81586f2cb5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3476ec0cd8ec85693ff241daaf467b6972510201...82f3f8fb852abdbbed7dca82ec4fcd81586f2cb5
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/20241119/f3697626/attachment-0001.html>
More information about the ghc-commits
mailing list