summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorman Ramsey <nr@cs.tufts.edu>2022-04-05 13:15:31 -0400
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-05-20 05:32:32 -0400
commit54f0b578ccfccce581f0bf46df12a811ceab6d3b (patch)
tree13968a2a944ff1201466d8b28a8cb0132dd117a5
parent0ccca94bc0110a2ee7f79382cb0e6831e79a3176 (diff)
downloadhaskell-54f0b578ccfccce581f0bf46df12a811ceab6d3b.tar.gz
add dominator-tree function
-rw-r--r--compiler/GHC/Cmm/Dominators.hs12
1 files changed, 12 insertions, 0 deletions
diff --git a/compiler/GHC/Cmm/Dominators.hs b/compiler/GHC/Cmm/Dominators.hs
index 9ca5bba134..a82f00af58 100644
--- a/compiler/GHC/Cmm/Dominators.hs
+++ b/compiler/GHC/Cmm/Dominators.hs
@@ -15,6 +15,7 @@ module GHC.Cmm.Dominators
, graphMap
, gwdRPNumber
, gwdDominatorsOf
+ , gwdDominatorTree
-- * Utility functions on dominator sets
, dominatorsMember
@@ -26,6 +27,7 @@ import GHC.Prelude
import Data.Array.IArray
import Data.Foldable()
+import qualified Data.Tree as Tree
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS
@@ -192,6 +194,16 @@ gwdRPNumber g l = mapFindWithDefault unreachable l (gwd_rpnumbering g)
gwdDominatorsOf :: GraphWithDominators node -> Label -> DominatorSet
gwdDominatorsOf g lbl = mapFindWithDefault unreachable lbl (gwd_dominators g)
+gwdDominatorTree :: GraphWithDominators node -> Tree.Tree Label
+gwdDominatorTree g = subtreeAt (g_entry (gwd_graph gwd))
+ where subtreeAt label = Tree.Node label $ map subtreeAt $ children label
+ children l = mapFindWithDefault [] l child_map
+ child_map = mapFoldlWithKey addParent mapEmpty $ gwd_dominators g
+ where addParent cm _ EntryNode = cm
+ addParent cm lbl (ImmediateDominator p _) =
+ mapInsertWith (++) p [lbl] cm
+
+
-- | Turn a function into an array. Inspired by SML's `Array.tabulate`
tabulate :: (Ix i) => (i, i) -> (i -> e) -> Array i e
tabulate b f = listArray b $ map f $ range b