diff options
author | Norman Ramsey <nr@cs.tufts.edu> | 2022-04-05 13:15:31 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-05-20 05:32:32 -0400 |
commit | 54f0b578ccfccce581f0bf46df12a811ceab6d3b (patch) | |
tree | 13968a2a944ff1201466d8b28a8cb0132dd117a5 | |
parent | 0ccca94bc0110a2ee7f79382cb0e6831e79a3176 (diff) | |
download | haskell-54f0b578ccfccce581f0bf46df12a811ceab6d3b.tar.gz |
add dominator-tree function
-rw-r--r-- | compiler/GHC/Cmm/Dominators.hs | 12 |
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 |