{-# LANGUAGE GADTs #-}

module GHC.Cmm.Dominators
  (
  -- * Dominator analysis and representation of results
    DominatorSet(..)
  , GraphWithDominators(..)
  , RPNum
  , graphWithDominators

  -- * Utility functions on graphs or graphs-with-dominators
  , graphMap
  , gwdRPNumber
  , gwdDominatorsOf
  , gwdDominatorTree

  -- * Utility functions on dominator sets
  , dominatorsMember
  , intersectDominators
  )
where

import GHC.Prelude

import Data.Array.IArray
import Data.Foldable()
import qualified Data.Tree as Tree

import Data.Word

import qualified GHC.CmmToAsm.CFG.Dominators as LT

import GHC.Cmm.Dataflow
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm

import GHC.Utils.Outputable( Outputable(..), text, int, hcat, (<+>))
import GHC.Utils.Misc
import GHC.Utils.Panic
import GHC.Utils.Word64 (intToWord64)
import qualified GHC.Data.Word64Map as WM
import qualified GHC.Data.Word64Set as WS


-- | =Dominator sets
--
-- Node X dominates node Y if and only if every path from the entry to
-- Y includes X.  Node Y technically dominates itself, but it is
-- never included in the *representation* of its dominator set.
--
-- A dominator set is represented as a linked list in which each node
-- points to its *immediate* dominator, which is its parent in the
-- dominator tree.  In many circumstances the immediate dominator
-- will be the only dominator of interest.

data DominatorSet = ImmediateDominator { DominatorSet -> Label
ds_label  :: Label -- ^ Label of the immediate dominator.
                                       , DominatorSet -> DominatorSet
ds_parent :: DominatorSet -- ^ Set of nodes dominating the immediate dominator.
                                       }
                  | EntryNode
  deriving (DominatorSet -> DominatorSet -> Bool
(DominatorSet -> DominatorSet -> Bool)
-> (DominatorSet -> DominatorSet -> Bool) -> Eq DominatorSet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DominatorSet -> DominatorSet -> Bool
== :: DominatorSet -> DominatorSet -> Bool
$c/= :: DominatorSet -> DominatorSet -> Bool
/= :: DominatorSet -> DominatorSet -> Bool
Eq)

instance Outputable DominatorSet where
  ppr :: DominatorSet -> SDoc
ppr DominatorSet
EntryNode = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"entry"
  ppr (ImmediateDominator Label
l DominatorSet
parent) = Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
l SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"->" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DominatorSet -> SDoc
forall a. Outputable a => a -> SDoc
ppr DominatorSet
parent



-- | Reverse postorder number of a node in a CFG
newtype RPNum = RPNum Int
  deriving (RPNum -> RPNum -> Bool
(RPNum -> RPNum -> Bool) -> (RPNum -> RPNum -> Bool) -> Eq RPNum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RPNum -> RPNum -> Bool
== :: RPNum -> RPNum -> Bool
$c/= :: RPNum -> RPNum -> Bool
/= :: RPNum -> RPNum -> Bool
Eq, Eq RPNum
Eq RPNum =>
(RPNum -> RPNum -> Ordering)
-> (RPNum -> RPNum -> Bool)
-> (RPNum -> RPNum -> Bool)
-> (RPNum -> RPNum -> Bool)
-> (RPNum -> RPNum -> Bool)
-> (RPNum -> RPNum -> RPNum)
-> (RPNum -> RPNum -> RPNum)
-> Ord RPNum
RPNum -> RPNum -> Bool
RPNum -> RPNum -> Ordering
RPNum -> RPNum -> RPNum
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RPNum -> RPNum -> Ordering
compare :: RPNum -> RPNum -> Ordering
$c< :: RPNum -> RPNum -> Bool
< :: RPNum -> RPNum -> Bool
$c<= :: RPNum -> RPNum -> Bool
<= :: RPNum -> RPNum -> Bool
$c> :: RPNum -> RPNum -> Bool
> :: RPNum -> RPNum -> Bool
$c>= :: RPNum -> RPNum -> Bool
>= :: RPNum -> RPNum -> Bool
$cmax :: RPNum -> RPNum -> RPNum
max :: RPNum -> RPNum -> RPNum
$cmin :: RPNum -> RPNum -> RPNum
min :: RPNum -> RPNum -> RPNum
Ord)
-- in reverse postorder, nodes closer to the entry have smaller numbers

instance Show RPNum where
  show :: RPNum -> String
show (RPNum Int
i) = String
"RP" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i

instance Outputable RPNum where
  ppr :: RPNum -> SDoc
ppr (RPNum Int
i) = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hcat [String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"RP", Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
i]
   -- using `(<>)` would conflict with Semigroup



dominatorsMember :: Label -> DominatorSet -> Bool
-- ^ Use to tell if the given label is in the given
-- dominator set.  Which is to say, does the bloc
-- with with given label _properly_ and _non-vacuously_
-- dominate the node whose dominator set this is?
--
-- Takes linear time in the height of the dominator tree,
-- but uses space efficiently.
dominatorsMember :: Label -> DominatorSet -> Bool
dominatorsMember Label
lbl (ImmediateDominator Label
l DominatorSet
p) = Label
l Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
lbl Bool -> Bool -> Bool
|| Label -> DominatorSet -> Bool
dominatorsMember Label
lbl DominatorSet
p
dominatorsMember Label
_   DominatorSet
EntryNode = Bool
False


-- | Intersect two dominator sets to produce a third dominator set.
-- This function takes time linear in the size of the sets.
-- As such it is inefficient and should be used only for things
-- like visualizations or linters.
intersectDominators :: DominatorSet -> DominatorSet -> DominatorSet
intersectDominators :: DominatorSet -> DominatorSet -> DominatorSet
intersectDominators DominatorSet
ds DominatorSet
ds' = [Label] -> [Label] -> DominatorSet -> DominatorSet
commonPrefix (DominatorSet -> [Label] -> [Label]
revDoms DominatorSet
ds []) (DominatorSet -> [Label] -> [Label]
revDoms DominatorSet
ds' []) DominatorSet
EntryNode
  where revDoms :: DominatorSet -> [Label] -> [Label]
revDoms DominatorSet
EntryNode [Label]
prev = [Label]
prev
        revDoms (ImmediateDominator Label
lbl DominatorSet
doms) [Label]
prev = DominatorSet -> [Label] -> [Label]
revDoms DominatorSet
doms (Label
lblLabel -> [Label] -> [Label]
forall a. a -> [a] -> [a]
:[Label]
prev)
        commonPrefix :: [Label] -> [Label] -> DominatorSet -> DominatorSet
commonPrefix (Label
a:[Label]
as) (Label
b:[Label]
bs) DominatorSet
doms
            | Label
a Label -> Label -> Bool
forall a. Eq a => a -> a -> Bool
== Label
b = [Label] -> [Label] -> DominatorSet -> DominatorSet
commonPrefix [Label]
as [Label]
bs (Label -> DominatorSet -> DominatorSet
ImmediateDominator Label
a DominatorSet
doms)
        commonPrefix [Label]
_ [Label]
_ DominatorSet
doms = DominatorSet
doms


-- | The result of dominator analysis.  Also includes a reverse
-- postorder numbering, which is needed for dominator analysis
-- and for other (downstream) analyses.
--
-- Invariant: Dominators, graph, and RP numberings include only *reachable* blocks.
data GraphWithDominators node =
    GraphWithDominators { forall (node :: Extensibility -> Extensibility -> *).
GraphWithDominators node -> GenCmmGraph node
gwd_graph :: GenCmmGraph node
                        , forall (node :: Extensibility -> Extensibility -> *).
GraphWithDominators node -> LabelMap DominatorSet
gwd_dominators :: LabelMap DominatorSet
                        , forall (node :: Extensibility -> Extensibility -> *).
GraphWithDominators node -> LabelMap RPNum
gwd_rpnumbering :: LabelMap RPNum
                        }


-- | Call this function with a `CmmGraph` to get back the results of a
-- dominator analysis of that graph (as well as a reverse postorder
-- numbering).  The result also includes the subgraph of the original
-- graph that contains only the reachable blocks.
graphWithDominators :: forall node .
       (NonLocal node, HasDebugCallStack)
       => GenCmmGraph node
       -> GraphWithDominators node

-- The implementation uses the Lengauer-Tarjan algorithm from the x86
-- back end.

-- Technically, we do not need Word64 here, however the dominators code
-- has to accomodate Word64 for other uses.

graphWithDominators :: forall (node :: Extensibility -> Extensibility -> *).
(NonLocal node, HasDebugCallStack) =>
GenCmmGraph node -> GraphWithDominators node
graphWithDominators GenCmmGraph node
g = GenCmmGraph node
-> LabelMap DominatorSet
-> LabelMap RPNum
-> GraphWithDominators node
forall (node :: Extensibility -> Extensibility -> *).
GenCmmGraph node
-> LabelMap DominatorSet
-> LabelMap RPNum
-> GraphWithDominators node
GraphWithDominators ([Block node C C] -> GenCmmGraph node -> GenCmmGraph node
forall (node :: Extensibility -> Extensibility -> *).
NonLocal node =>
[Block node C C] -> GenCmmGraph node -> GenCmmGraph node
reachable [Block node C C]
rpblocks GenCmmGraph node
g) LabelMap DominatorSet
dmap LabelMap RPNum
rpmap
      where rpblocks :: [Block node C C]
rpblocks = LabelMap (Block node C C) -> Label -> [Block node C C]
forall (block :: Extensibility -> Extensibility -> *).
NonLocal block =>
LabelMap (block C C) -> Label -> [block C C]
revPostorderFrom (GenCmmGraph node -> LabelMap (Block node C C)
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> LabelMap (Block n C C)
graphMap GenCmmGraph node
g) (GenCmmGraph node -> Label
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> Label
g_entry GenCmmGraph node
g)
            rplabels' :: [Label]
rplabels' = (Block node C C -> Label) -> [Block node C C] -> [Label]
forall a b. (a -> b) -> [a] -> [b]
map Block node C C -> Label
forall (x :: Extensibility). Block node C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
       (x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel [Block node C C]
rpblocks
            rplabels :: Array Word64 Label
            rplabels :: Array Word64 Label
rplabels = (Word64, Word64) -> [Label] -> Array Word64 Label
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Word64, Word64)
bounds [Label]
rplabels'

            rpmap :: LabelMap RPNum
            rpmap :: LabelMap RPNum
rpmap = [(KeyOf LabelMap, RPNum)] -> LabelMap RPNum
forall a. [(KeyOf LabelMap, a)] -> LabelMap a
forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
mapFromList ([(KeyOf LabelMap, RPNum)] -> LabelMap RPNum)
-> [(KeyOf LabelMap, RPNum)] -> LabelMap RPNum
forall a b. (a -> b) -> a -> b
$ (Block node C C -> Int -> (Label, RPNum))
-> [Block node C C] -> [Int] -> [(Label, RPNum)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Block node C C -> Int -> (Label, RPNum)
forall {thing :: Extensibility -> Extensibility -> *}
       {x :: Extensibility}.
NonLocal thing =>
thing C x -> Int -> (Label, RPNum)
kvpair [Block node C C]
rpblocks [Int
0..]
              where kvpair :: thing C x -> Int -> (Label, RPNum)
kvpair thing C x
block Int
i = (thing C x -> Label
forall (x :: Extensibility). thing C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
       (x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel thing C x
block, Int -> RPNum
RPNum Int
i)

            labelIndex :: Label -> Word64
            labelIndex :: Label -> Word64
labelIndex = (Label -> LabelMap Word64 -> Word64)
-> LabelMap Word64 -> Label -> Word64
forall a b c. (a -> b -> c) -> b -> a -> c
flip Label -> LabelMap Word64 -> Word64
forall a. HasDebugCallStack => Label -> LabelMap a -> a
findLabelIn LabelMap Word64
imap
              where imap :: LabelMap Word64
                    imap :: LabelMap Word64
imap = [(KeyOf LabelMap, Word64)] -> LabelMap Word64
forall a. [(KeyOf LabelMap, a)] -> LabelMap a
forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
mapFromList ([(KeyOf LabelMap, Word64)] -> LabelMap Word64)
-> [(KeyOf LabelMap, Word64)] -> LabelMap Word64
forall a b. (a -> b) -> a -> b
$ [Label] -> [Word64] -> [(Label, Word64)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Label]
rplabels' [Word64
0..]
            blockIndex :: Block node C x -> Word64
blockIndex = Label -> Word64
labelIndex (Label -> Word64)
-> (Block node C x -> Label) -> Block node C x -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block node C x -> Label
forall (x :: Extensibility). Block node C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
       (x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel

            bounds :: (Word64, Word64)
            bounds :: (Word64, Word64)
bounds = (Word64
0, HasCallStack => Int -> Word64
Int -> Word64
intToWord64 ([Block node C C] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Block node C C]
rpblocks Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

            ltGraph :: [Block node C C] -> LT.Graph
            ltGraph :: [Block node C C] -> Graph
ltGraph [] = Graph
forall a. Word64Map a
WM.empty
            ltGraph (Block node C C
block:[Block node C C]
blocks) =
                Word64 -> Word64Set -> Graph -> Graph
forall a. Word64 -> a -> Word64Map a -> Word64Map a
WM.insert
                      (Block node C C -> Word64
forall {x :: Extensibility}. Block node C x -> Word64
blockIndex Block node C C
block)
                      ([Word64] -> Word64Set
WS.fromList ([Word64] -> Word64Set) -> [Word64] -> Word64Set
forall a b. (a -> b) -> a -> b
$ (Label -> Word64) -> [Label] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map Label -> Word64
labelIndex ([Label] -> [Word64]) -> [Label] -> [Word64]
forall a b. (a -> b) -> a -> b
$ Block node C C -> [Label]
forall (e :: Extensibility). Block node e C -> [Label]
forall (thing :: Extensibility -> Extensibility -> *)
       (e :: Extensibility).
NonLocal thing =>
thing e C -> [Label]
successors Block node C C
block)
                      ([Block node C C] -> Graph
ltGraph [Block node C C]
blocks)

            idom_array :: Array Word64 LT.Node
            idom_array :: Array Word64 Word64
idom_array = (Word64, Word64) -> [(Word64, Word64)] -> Array Word64 Word64
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Word64, Word64)
bounds ([(Word64, Word64)] -> Array Word64 Word64)
-> [(Word64, Word64)] -> Array Word64 Word64
forall a b. (a -> b) -> a -> b
$ Rooted -> [(Word64, Word64)]
LT.idom (Word64
0, [Block node C C] -> Graph
ltGraph [Block node C C]
rpblocks)

            domSet :: Word64 -> DominatorSet
domSet Word64
0 = DominatorSet
EntryNode
            domSet Word64
i = Label -> DominatorSet -> DominatorSet
ImmediateDominator (Array Word64 Label
rplabels Array Word64 Label -> Word64 -> Label
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Word64
d) (Array Word64 DominatorSet
doms Array Word64 DominatorSet -> Word64 -> DominatorSet
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Word64
d)
                where d :: Word64
d = Array Word64 Word64
idom_array Array Word64 Word64 -> Word64 -> Word64
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Word64
i
            doms :: Array Word64 DominatorSet
doms = (Word64, Word64)
-> (Word64 -> DominatorSet) -> Array Word64 DominatorSet
forall i e. Ix i => (i, i) -> (i -> e) -> Array i e
tabulate (Word64, Word64)
bounds Word64 -> DominatorSet
domSet

            dmap :: LabelMap DominatorSet
dmap = [(KeyOf LabelMap, DominatorSet)] -> LabelMap DominatorSet
forall a. [(KeyOf LabelMap, a)] -> LabelMap a
forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
mapFromList ([(KeyOf LabelMap, DominatorSet)] -> LabelMap DominatorSet)
-> [(KeyOf LabelMap, DominatorSet)] -> LabelMap DominatorSet
forall a b. (a -> b) -> a -> b
$ (Label -> Word64 -> (Label, DominatorSet))
-> [Label] -> [Word64] -> [(Label, DominatorSet)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Label
lbl Word64
i -> (Label
lbl, Word64 -> DominatorSet
domSet Word64
i)) [Label]
rplabels' [Word64
0..]

reachable :: NonLocal node => [Block node C C] -> GenCmmGraph node -> GenCmmGraph node
reachable :: forall (node :: Extensibility -> Extensibility -> *).
NonLocal node =>
[Block node C C] -> GenCmmGraph node -> GenCmmGraph node
reachable [Block node C C]
blocks GenCmmGraph node
g = GenCmmGraph node
g { g_graph = GMany NothingO blockmap NothingO }
  where blockmap :: Body' Block node
blockmap = [(KeyOf LabelMap, Block node C C)] -> Body' Block node
forall a. [(KeyOf LabelMap, a)] -> LabelMap a
forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
mapFromList [(Block node C C -> Label
forall (x :: Extensibility). Block node C x -> Label
forall (thing :: Extensibility -> Extensibility -> *)
       (x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel Block node C C
b, Block node C C
b) | Block node C C
b <- [Block node C C]
blocks]


-- | =Utility functions

-- | Call `graphMap` to get the mapping from `Label` to `Block` that
-- is embedded in every `CmmGraph`.
graphMap :: GenCmmGraph n -> LabelMap (Block n C C)
graphMap :: forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> LabelMap (Block n C C)
graphMap (CmmGraph { g_graph :: forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> Graph n C C
g_graph = GMany MaybeO C (Block n O C)
NothingO Body' Block n
blockmap MaybeO C (Block n C O)
NothingO }) = Body' Block n
blockmap

-- | Use `gwdRPNumber` on the result of the dominator analysis to get
-- a mapping from the `Label` of each reachable block to the reverse
-- postorder number of that block.
gwdRPNumber :: HasDebugCallStack => GraphWithDominators node -> Label -> RPNum
gwdRPNumber :: forall (node :: Extensibility -> Extensibility -> *).
HasDebugCallStack =>
GraphWithDominators node -> Label -> RPNum
gwdRPNumber GraphWithDominators node
g Label
l = Label -> LabelMap RPNum -> RPNum
forall a. HasDebugCallStack => Label -> LabelMap a -> a
findLabelIn Label
l (GraphWithDominators node -> LabelMap RPNum
forall (node :: Extensibility -> Extensibility -> *).
GraphWithDominators node -> LabelMap RPNum
gwd_rpnumbering GraphWithDominators node
g)

findLabelIn :: HasDebugCallStack => Label -> LabelMap a -> a
findLabelIn :: forall a. HasDebugCallStack => Label -> LabelMap a -> a
findLabelIn Label
lbl = a -> KeyOf LabelMap -> LabelMap a -> a
forall a. a -> KeyOf LabelMap -> LabelMap a -> a
forall (map :: * -> *) a. IsMap map => a -> KeyOf map -> map a -> a
mapFindWithDefault a
failed KeyOf LabelMap
Label
lbl
  where failed :: a
failed =
            String -> SDoc -> a
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"label not found in result of analysis" (Label -> SDoc
forall a. Outputable a => a -> SDoc
ppr Label
lbl)

-- | Use `gwdDominatorsOf` on the result of the dominator analysis to get
-- a mapping from the `Label` of each reachable block to the dominator
-- set (and the immediate dominator) of that block.  The
-- implementation is space-efficient: intersecting dominator
-- sets share the representation of their intersection.

gwdDominatorsOf :: HasDebugCallStack => GraphWithDominators node -> Label -> DominatorSet
gwdDominatorsOf :: forall (node :: Extensibility -> Extensibility -> *).
HasDebugCallStack =>
GraphWithDominators node -> Label -> DominatorSet
gwdDominatorsOf GraphWithDominators node
g Label
lbl = Label -> LabelMap DominatorSet -> DominatorSet
forall a. HasDebugCallStack => Label -> LabelMap a -> a
findLabelIn Label
lbl (GraphWithDominators node -> LabelMap DominatorSet
forall (node :: Extensibility -> Extensibility -> *).
GraphWithDominators node -> LabelMap DominatorSet
gwd_dominators GraphWithDominators node
g)

gwdDominatorTree :: GraphWithDominators node -> Tree.Tree Label
gwdDominatorTree :: forall (node :: Extensibility -> Extensibility -> *).
GraphWithDominators node -> Tree Label
gwdDominatorTree GraphWithDominators node
gwd = Label -> Tree Label
subtreeAt (GenCmmGraph node -> Label
forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> Label
g_entry (GraphWithDominators node -> GenCmmGraph node
forall (node :: Extensibility -> Extensibility -> *).
GraphWithDominators node -> GenCmmGraph node
gwd_graph GraphWithDominators node
gwd))
  where subtreeAt :: Label -> Tree Label
subtreeAt Label
label = Label -> [Tree Label] -> Tree Label
forall a. a -> [Tree a] -> Tree a
Tree.Node Label
label ([Tree Label] -> Tree Label) -> [Tree Label] -> Tree Label
forall a b. (a -> b) -> a -> b
$ (Label -> Tree Label) -> [Label] -> [Tree Label]
forall a b. (a -> b) -> [a] -> [b]
map Label -> Tree Label
subtreeAt ([Label] -> [Tree Label]) -> [Label] -> [Tree Label]
forall a b. (a -> b) -> a -> b
$ Label -> [Label]
children Label
label
        children :: Label -> [Label]
children Label
l = [Label] -> KeyOf LabelMap -> LabelMap [Label] -> [Label]
forall a. a -> KeyOf LabelMap -> LabelMap a -> a
forall (map :: * -> *) a. IsMap map => a -> KeyOf map -> map a -> a
mapFindWithDefault [] KeyOf LabelMap
Label
l LabelMap [Label]
child_map
        child_map :: LabelMap [Label]
        child_map :: LabelMap [Label]
child_map = (LabelMap [Label]
 -> KeyOf LabelMap -> DominatorSet -> LabelMap [Label])
-> LabelMap [Label] -> LabelMap DominatorSet -> LabelMap [Label]
forall b a. (b -> KeyOf LabelMap -> a -> b) -> b -> LabelMap a -> b
forall (map :: * -> *) b a.
IsMap map =>
(b -> KeyOf map -> a -> b) -> b -> map a -> b
mapFoldlWithKey LabelMap [Label]
-> KeyOf LabelMap -> DominatorSet -> LabelMap [Label]
LabelMap [Label] -> Label -> DominatorSet -> LabelMap [Label]
forall {map :: * -> *} {a}.
(KeyOf map ~ Label, IsMap map) =>
map [a] -> a -> DominatorSet -> map [a]
addParent LabelMap [Label]
forall a. LabelMap a
forall (map :: * -> *) a. IsMap map => map a
mapEmpty (LabelMap DominatorSet -> LabelMap [Label])
-> LabelMap DominatorSet -> LabelMap [Label]
forall a b. (a -> b) -> a -> b
$ GraphWithDominators node -> LabelMap DominatorSet
forall (node :: Extensibility -> Extensibility -> *).
GraphWithDominators node -> LabelMap DominatorSet
gwd_dominators GraphWithDominators node
gwd
          where addParent :: map [a] -> a -> DominatorSet -> map [a]
addParent map [a]
cm a
_ DominatorSet
EntryNode = map [a]
cm
                addParent map [a]
cm a
lbl (ImmediateDominator Label
p DominatorSet
_) =
                    ([a] -> [a] -> [a]) -> KeyOf map -> [a] -> map [a] -> map [a]
forall a. (a -> a -> a) -> KeyOf map -> a -> map a -> map a
forall (map :: * -> *) a.
IsMap map =>
(a -> a -> a) -> KeyOf map -> a -> map a -> map a
mapInsertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) KeyOf map
Label
p [a
lbl] map [a]
cm


-- | Turn a function into an array.  Inspired by SML's `Array.tabulate`
tabulate :: (Ix i) => (i, i) -> (i -> e) -> Array i e
tabulate :: forall i e. Ix i => (i, i) -> (i -> e) -> Array i e
tabulate (i, i)
b i -> e
f = (i, i) -> [e] -> Array i e
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (i, i)
b ([e] -> Array i e) -> [e] -> Array i e
forall a b. (a -> b) -> a -> b
$ (i -> e) -> [i] -> [e]
forall a b. (a -> b) -> [a] -> [b]
map i -> e
f ([i] -> [e]) -> [i] -> [e]
forall a b. (a -> b) -> a -> b
$ (i, i) -> [i]
forall a. Ix a => (a, a) -> [a]
range (i, i)
b