{-# LANGUAGE GADTs #-}
{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
module GHC.Cmm.ContFlowOpt
( cmmCfgOpts
, cmmCfgOptsProc
, removeUnreachableBlocksProc
, replaceLabels
)
where
import GHC.Prelude hiding (succ, unzip, zip)
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.BlockId
import GHC.Cmm
import GHC.Cmm.Utils
import GHC.Cmm.Switch (mapSwitchTargets, switchTargetsToList)
import GHC.Data.Maybe
import GHC.Utils.Panic
import GHC.Utils.Misc
import Control.Monad
cmmCfgOpts :: Bool -> CmmGraph -> CmmGraph
cmmCfgOpts :: Bool -> CmmGraph -> CmmGraph
cmmCfgOpts Bool
split CmmGraph
g = forall a b. (a, b) -> a
fst (Bool -> CmmGraph -> (CmmGraph, LabelMap Label)
blockConcat Bool
split CmmGraph
g)
cmmCfgOptsProc :: Bool -> CmmDecl -> CmmDecl
cmmCfgOptsProc :: Bool -> CmmDecl -> CmmDecl
cmmCfgOptsProc Bool
split (CmmProc CmmTopInfo
info CLabel
lbl [GlobalReg]
live CmmGraph
g) = forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc CmmTopInfo
info' CLabel
lbl [GlobalReg]
live CmmGraph
g'
where (CmmGraph
g', LabelMap Label
env) = Bool -> CmmGraph -> (CmmGraph, LabelMap Label)
blockConcat Bool
split CmmGraph
g
info' :: CmmTopInfo
info' = CmmTopInfo
info{ info_tbls :: LabelMap CmmInfoTable
info_tbls = LabelMap CmmInfoTable
new_info_tbls }
new_info_tbls :: LabelMap CmmInfoTable
new_info_tbls = forall (map :: * -> *) a. IsMap map => [(KeyOf map, a)] -> map a
mapFromList (forall a b. (a -> b) -> [a] -> [b]
map (Label, CmmInfoTable) -> (Label, CmmInfoTable)
upd_info (forall (map :: * -> *) a. IsMap map => map a -> [(KeyOf map, a)]
mapToList (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
info)))
upd_info :: (Label, CmmInfoTable) -> (Label, CmmInfoTable)
upd_info (Label
k,CmmInfoTable
info)
| Just Label
k' <- forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup Label
k LabelMap Label
env
= (Label
k', if Label
k' forall a. Eq a => a -> a -> Bool
== forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> Label
g_entry CmmGraph
g'
then CmmInfoTable
info
else CmmInfoTable
info{ cit_lbl :: CLabel
cit_lbl = Label -> CLabel
infoTblLbl Label
k' })
| Bool
otherwise
= (Label
k,CmmInfoTable
info)
cmmCfgOptsProc Bool
_ CmmDecl
top = CmmDecl
top
blockConcat :: Bool -> CmmGraph -> (CmmGraph, LabelMap BlockId)
blockConcat :: Bool -> CmmGraph -> (CmmGraph, LabelMap Label)
blockConcat Bool
splitting_procs g :: CmmGraph
g@CmmGraph { g_entry :: forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> Label
g_entry = Label
entry_id }
= (LabelMap Label -> CmmGraph -> CmmGraph
replaceLabels LabelMap Label
shortcut_map forall a b. (a -> b) -> a -> b
$ Label -> LabelMap CmmBlock -> CmmGraph
ofBlockMap Label
new_entry LabelMap CmmBlock
new_blocks, LabelMap Label
shortcut_map')
where
(Label
new_entry, LabelMap Label
shortcut_map')
| Just CmmBlock
entry_blk <- forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup Label
entry_id LabelMap CmmBlock
new_blocks
, Just Label
dest <- CmmBlock -> Maybe Label
canShortcut CmmBlock
entry_blk
= (Label
dest, forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> a -> map a -> map a
mapInsert Label
entry_id Label
dest LabelMap Label
shortcut_map)
| Bool
otherwise
= (Label
entry_id, LabelMap Label
shortcut_map)
blocks :: [CmmBlock]
blocks = CmmGraph -> [CmmBlock]
revPostorder CmmGraph
g
blockmap :: LabelMap CmmBlock
blockmap = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (block :: Extensibility -> Extensibility -> *).
(NonLocal block, HasDebugCallStack) =>
block C C -> LabelMap (block C C) -> LabelMap (block C C)
addBlock) forall (block :: (Extensibility -> Extensibility -> *)
-> Extensibility -> Extensibility -> *)
(n :: Extensibility -> Extensibility -> *).
Body' block n
emptyBody [CmmBlock]
blocks
(LabelMap CmmBlock
new_blocks, LabelMap Label
shortcut_map, LabelMap Int
_) =
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CmmBlock
-> (LabelMap CmmBlock, LabelMap Label, LabelMap Int)
-> (LabelMap CmmBlock, LabelMap Label, LabelMap Int)
maybe_concat (LabelMap CmmBlock
blockmap, forall (map :: * -> *) a. IsMap map => map a
mapEmpty, LabelMap Int
initialBackEdges) [CmmBlock]
blocks
initialBackEdges :: LabelMap Int
initialBackEdges = Label -> LabelMap Int -> LabelMap Int
incPreds Label
entry_id ([CmmBlock] -> LabelMap Int
predMap [CmmBlock]
blocks)
maybe_concat :: CmmBlock
-> (LabelMap CmmBlock, LabelMap BlockId, LabelMap Int)
-> (LabelMap CmmBlock, LabelMap BlockId, LabelMap Int)
maybe_concat :: CmmBlock
-> (LabelMap CmmBlock, LabelMap Label, LabelMap Int)
-> (LabelMap CmmBlock, LabelMap Label, LabelMap Int)
maybe_concat CmmBlock
block (!LabelMap CmmBlock
blocks, !LabelMap Label
shortcut_map, !LabelMap Int
backEdges)
| CmmBranch Label
b' <- CmmNode O C
last
, Label -> Bool
hasOnePredecessor Label
b'
, Just CmmBlock
blk' <- forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup Label
b' LabelMap CmmBlock
blocks
= let bid' :: Label
bid' = forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel CmmBlock
blk'
in ( forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> map a
mapDelete Label
bid' forall a b. (a -> b) -> a -> b
$ forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> a -> map a -> map a
mapInsert Label
bid (Block CmmNode C O -> CmmBlock -> CmmBlock
splice Block CmmNode C O
head CmmBlock
blk') LabelMap CmmBlock
blocks
, LabelMap Label
shortcut_map
, forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> map a
mapDelete Label
b' LabelMap Int
backEdges )
| Bool
splitting_procs
, Just Label
b' <- CmmNode O C -> Maybe Label
callContinuation_maybe CmmNode O C
last
, Just CmmBlock
blk' <- forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup Label
b' LabelMap CmmBlock
blocks
, Just Label
dest <- CmmBlock -> Maybe Label
canShortcut CmmBlock
blk'
= ( forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> a -> map a -> map a
mapInsert Label
bid (forall (n :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
Block n e O -> n O C -> Block n e C
blockJoinTail Block CmmNode C O
head (Label -> CmmNode O C
update_cont Label
dest)) LabelMap CmmBlock
blocks
, forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> a -> map a -> map a
mapInsert Label
b' Label
dest LabelMap Label
shortcut_map
, Label -> LabelMap Int -> LabelMap Int
decPreds Label
b' forall a b. (a -> b) -> a -> b
$ Label -> LabelMap Int -> LabelMap Int
incPreds Label
dest LabelMap Int
backEdges )
| Maybe Label
Nothing <- CmmNode O C -> Maybe Label
callContinuation_maybe CmmNode O C
last
= let oldSuccs :: [Label]
oldSuccs = forall (thing :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
NonLocal thing =>
thing e C -> [Label]
successors CmmNode O C
last
newSuccs :: [Label]
newSuccs = forall (thing :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
NonLocal thing =>
thing e C -> [Label]
successors CmmNode O C
rewrite_last
in ( forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> a -> map a -> map a
mapInsert Label
bid (forall (n :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
Block n e O -> n O C -> Block n e C
blockJoinTail Block CmmNode C O
head CmmNode O C
rewrite_last) LabelMap CmmBlock
blocks
, LabelMap Label
shortcut_map
, if [Label]
oldSuccs forall a. Eq a => a -> a -> Bool
== [Label]
newSuccs
then LabelMap Int
backEdges
else forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Label -> LabelMap Int -> LabelMap Int
incPreds (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Label -> LabelMap Int -> LabelMap Int
decPreds LabelMap Int
backEdges [Label]
oldSuccs) [Label]
newSuccs )
| Bool
otherwise
= ( LabelMap CmmBlock
blocks, LabelMap Label
shortcut_map, LabelMap Int
backEdges )
where
(Block CmmNode C O
head, CmmNode O C
last) = forall (n :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
Block n e C -> (Block n e O, n O C)
blockSplitTail CmmBlock
block
bid :: Label
bid = forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel CmmBlock
block
update_cont :: Label -> CmmNode O C
update_cont Label
dest =
case CmmNode O C
last of
CmmCall{} -> CmmNode O C
last { cml_cont :: Maybe Label
cml_cont = forall a. a -> Maybe a
Just Label
dest }
CmmForeignCall{} -> CmmNode O C
last { succ :: Label
succ = Label
dest }
CmmNode O C
_ -> forall a. String -> a
panic String
"Can't shortcut continuation."
shortcut_last :: CmmNode O C
shortcut_last = (Label -> Label) -> CmmNode O C -> CmmNode O C
mapSuccessors Label -> Label
shortcut CmmNode O C
last
where
shortcut :: Label -> Label
shortcut Label
l =
case forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup Label
l LabelMap CmmBlock
blocks of
Just CmmBlock
b | Just Label
dest <- CmmBlock -> Maybe Label
canShortcut CmmBlock
b -> Label
dest
Maybe CmmBlock
_otherwise -> Label
l
rewrite_last :: CmmNode O C
rewrite_last
| CmmCondBranch CmmExpr
_cond Label
t Label
f Maybe Bool
_l <- CmmNode O C
shortcut_last
, Label
t forall a. Eq a => a -> a -> Bool
== Label
f
= Label -> CmmNode O C
CmmBranch Label
t
| CmmCondBranch CmmExpr
cond Label
t Label
f Maybe Bool
l <- CmmNode O C
shortcut_last
, Label -> Bool
hasOnePredecessor Label
t
, Maybe Bool -> Bool
likelyTrue Maybe Bool
l Bool -> Bool -> Bool
|| (Label -> Int
numPreds Label
f forall a. Ord a => a -> a -> Bool
> Int
1)
, Just CmmExpr
cond' <- CmmExpr -> Maybe CmmExpr
maybeInvertCmmExpr CmmExpr
cond
= CmmExpr -> Label -> Label -> Maybe Bool -> CmmNode O C
CmmCondBranch CmmExpr
cond' Label
f Label
t (Maybe Bool -> Maybe Bool
invertLikeliness Maybe Bool
l)
| CmmSwitch CmmExpr
_expr SwitchTargets
targets <- CmmNode O C
shortcut_last
, (Label
t:[Label]
ts) <- SwitchTargets -> [Label]
switchTargetsToList SwitchTargets
targets
, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Label
t) [Label]
ts
= Label -> CmmNode O C
CmmBranch Label
t
| Bool
otherwise
= CmmNode O C
shortcut_last
likelyTrue :: Maybe Bool -> Bool
likelyTrue (Just Bool
True) = Bool
True
likelyTrue Maybe Bool
_ = Bool
False
invertLikeliness :: Maybe Bool -> Maybe Bool
invertLikeliness :: Maybe Bool -> Maybe Bool
invertLikeliness = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not
numPreds :: Label -> Int
numPreds Label
bid = forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup Label
bid LabelMap Int
backEdges forall a. Maybe a -> a -> a
`orElse` Int
0
hasOnePredecessor :: Label -> Bool
hasOnePredecessor Label
b = Label -> Int
numPreds Label
b forall a. Eq a => a -> a -> Bool
== Int
1
incPreds, decPreds :: BlockId -> LabelMap Int -> LabelMap Int
incPreds :: Label -> LabelMap Int -> LabelMap Int
incPreds Label
bid LabelMap Int
edges = forall (map :: * -> *) a.
IsMap map =>
(a -> a -> a) -> KeyOf map -> a -> map a -> map a
mapInsertWith forall a. Num a => a -> a -> a
(+) Label
bid Int
1 LabelMap Int
edges
decPreds :: Label -> LabelMap Int -> LabelMap Int
decPreds Label
bid LabelMap Int
edges = case forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup Label
bid LabelMap Int
edges of
Just Int
preds | Int
preds forall a. Ord a => a -> a -> Bool
> Int
1 -> forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> a -> map a -> map a
mapInsert Label
bid (Int
preds forall a. Num a => a -> a -> a
- Int
1) LabelMap Int
edges
Just Int
_ -> forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> map a
mapDelete Label
bid LabelMap Int
edges
Maybe Int
_ -> LabelMap Int
edges
canShortcut :: CmmBlock -> Maybe BlockId
canShortcut :: CmmBlock -> Maybe Label
canShortcut CmmBlock
block
| (CmmNode C O
_, Block CmmNode O O
middle, CmmBranch Label
dest) <- forall (n :: Extensibility -> Extensibility -> *).
Block n C C -> (n C O, Block n O O, n O C)
blockSplit CmmBlock
block
, forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {e :: Extensibility} {x :: Extensibility}.
CmmNode e x -> Bool
dont_care forall a b. (a -> b) -> a -> b
$ forall (n :: Extensibility -> Extensibility -> *).
Block n O O -> [n O O]
blockToList Block CmmNode O O
middle
= forall a. a -> Maybe a
Just Label
dest
| Bool
otherwise
= forall a. Maybe a
Nothing
where dont_care :: CmmNode e x -> Bool
dont_care CmmComment{} = Bool
True
dont_care CmmTick{} = Bool
True
dont_care CmmNode e x
_other = Bool
False
splice :: Block CmmNode C O -> CmmBlock -> CmmBlock
splice :: Block CmmNode C O -> CmmBlock -> CmmBlock
splice Block CmmNode C O
head CmmBlock
rest = CmmNode C O
entry forall (n :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
n C O -> Block n O x -> Block n C x
`blockJoinHead` Block CmmNode O O
code0 forall (n :: Extensibility -> Extensibility -> *)
(e :: Extensibility) (x :: Extensibility).
Block n e O -> Block n O x -> Block n e x
`blockAppend` Block CmmNode O C
code1
where (CmmEntry Label
lbl CmmTickScope
sc0, Block CmmNode O O
code0) = forall (n :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
Block n C x -> (n C O, Block n O x)
blockSplitHead Block CmmNode C O
head
(CmmEntry Label
_ CmmTickScope
sc1, Block CmmNode O C
code1) = forall (n :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
Block n C x -> (n C O, Block n O x)
blockSplitHead CmmBlock
rest
entry :: CmmNode C O
entry = Label -> CmmTickScope -> CmmNode C O
CmmEntry Label
lbl (CmmTickScope -> CmmTickScope -> CmmTickScope
combineTickScopes CmmTickScope
sc0 CmmTickScope
sc1)
callContinuation_maybe :: CmmNode O C -> Maybe BlockId
callContinuation_maybe :: CmmNode O C -> Maybe Label
callContinuation_maybe (CmmCall { cml_cont :: CmmNode O C -> Maybe Label
cml_cont = Just Label
b }) = forall a. a -> Maybe a
Just Label
b
callContinuation_maybe (CmmForeignCall { succ :: CmmNode O C -> Label
succ = Label
b }) = forall a. a -> Maybe a
Just Label
b
callContinuation_maybe CmmNode O C
_ = forall a. Maybe a
Nothing
replaceLabels :: LabelMap BlockId -> CmmGraph -> CmmGraph
replaceLabels :: LabelMap Label -> CmmGraph -> CmmGraph
replaceLabels LabelMap Label
env CmmGraph
g
| forall (map :: * -> *) a. IsMap map => map a -> Bool
mapNull LabelMap Label
env = CmmGraph
g
| Bool
otherwise = CmmGraph -> CmmGraph
replace_eid forall a b. (a -> b) -> a -> b
$ (forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> CmmNode e x)
-> CmmGraph -> CmmGraph
mapGraphNodes1 forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> CmmNode e x
txnode CmmGraph
g
where
replace_eid :: CmmGraph -> CmmGraph
replace_eid CmmGraph
g = CmmGraph
g {g_entry :: Label
g_entry = Label -> Label
lookup (forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> Label
g_entry CmmGraph
g)}
lookup :: Label -> Label
lookup Label
id = forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup Label
id LabelMap Label
env forall a. Maybe a -> a -> a
`orElse` Label
id
txnode :: CmmNode e x -> CmmNode e x
txnode :: forall (e :: Extensibility) (x :: Extensibility).
CmmNode e x -> CmmNode e x
txnode (CmmBranch Label
bid) = Label -> CmmNode O C
CmmBranch (Label -> Label
lookup Label
bid)
txnode (CmmCondBranch CmmExpr
p Label
t Label
f Maybe Bool
l) =
CmmExpr -> Label -> Label -> Maybe Bool -> CmmNode O C
mkCmmCondBranch (CmmExpr -> CmmExpr
exp CmmExpr
p) (Label -> Label
lookup Label
t) (Label -> Label
lookup Label
f) Maybe Bool
l
txnode (CmmSwitch CmmExpr
e SwitchTargets
ids) =
CmmExpr -> SwitchTargets -> CmmNode O C
CmmSwitch (CmmExpr -> CmmExpr
exp CmmExpr
e) ((Label -> Label) -> SwitchTargets -> SwitchTargets
mapSwitchTargets Label -> Label
lookup SwitchTargets
ids)
txnode (CmmCall CmmExpr
t Maybe Label
k [GlobalReg]
rg Int
a Int
res Int
r) =
CmmExpr
-> Maybe Label -> [GlobalReg] -> Int -> Int -> Int -> CmmNode O C
CmmCall (CmmExpr -> CmmExpr
exp CmmExpr
t) (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Label -> Label
lookup Maybe Label
k) [GlobalReg]
rg Int
a Int
res Int
r
txnode fc :: CmmNode e x
fc@CmmForeignCall{} =
CmmNode e x
fc{ args :: [CmmExpr]
args = forall a b. (a -> b) -> [a] -> [b]
map CmmExpr -> CmmExpr
exp (CmmNode O C -> [CmmExpr]
args CmmNode e x
fc), succ :: Label
succ = Label -> Label
lookup (CmmNode O C -> Label
succ CmmNode e x
fc) }
txnode CmmNode e x
other = forall (e :: Extensibility) (x :: Extensibility).
(CmmExpr -> CmmExpr) -> CmmNode e x -> CmmNode e x
mapExpDeep CmmExpr -> CmmExpr
exp CmmNode e x
other
exp :: CmmExpr -> CmmExpr
exp :: CmmExpr -> CmmExpr
exp (CmmLit (CmmBlock Label
bid)) = CmmLit -> CmmExpr
CmmLit (Label -> CmmLit
CmmBlock (Label -> Label
lookup Label
bid))
exp (CmmStackSlot (Young Label
id) Int
i) = Area -> Int -> CmmExpr
CmmStackSlot (Label -> Area
Young (Label -> Label
lookup Label
id)) Int
i
exp CmmExpr
e = CmmExpr
e
mkCmmCondBranch :: CmmExpr -> Label -> Label -> Maybe Bool -> CmmNode O C
mkCmmCondBranch :: CmmExpr -> Label -> Label -> Maybe Bool -> CmmNode O C
mkCmmCondBranch CmmExpr
p Label
t Label
f Maybe Bool
l =
if Label
t forall a. Eq a => a -> a -> Bool
== Label
f then Label -> CmmNode O C
CmmBranch Label
t else CmmExpr -> Label -> Label -> Maybe Bool -> CmmNode O C
CmmCondBranch CmmExpr
p Label
t Label
f Maybe Bool
l
predMap :: [CmmBlock] -> LabelMap Int
predMap :: [CmmBlock] -> LabelMap Int
predMap [CmmBlock]
blocks = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {map :: * -> *} {a}
{thing :: Extensibility -> Extensibility -> *}
{e :: Extensibility}.
(KeyOf map ~ Label, IsMap map, Num a, NonLocal thing) =>
thing e C -> map a -> map a
add_preds forall (map :: * -> *) a. IsMap map => map a
mapEmpty [CmmBlock]
blocks
where
add_preds :: thing e C -> map a -> map a
add_preds thing e C
block map a
env = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {map :: * -> *} {a}.
(IsMap map, Num a) =>
KeyOf map -> map a -> map a
add map a
env (forall (thing :: Extensibility -> Extensibility -> *)
(e :: Extensibility).
NonLocal thing =>
thing e C -> [Label]
successors thing e C
block)
where add :: KeyOf map -> map a -> map a
add KeyOf map
lbl map a
env = forall (map :: * -> *) a.
IsMap map =>
(a -> a -> a) -> KeyOf map -> a -> map a -> map a
mapInsertWith forall a. Num a => a -> a -> a
(+) KeyOf map
lbl a
1 map a
env
removeUnreachableBlocksProc :: CmmDecl -> CmmDecl
removeUnreachableBlocksProc :: CmmDecl -> CmmDecl
removeUnreachableBlocksProc proc :: CmmDecl
proc@(CmmProc CmmTopInfo
info CLabel
lbl [GlobalReg]
live CmmGraph
g)
| [CmmBlock]
used_blocks forall a. [a] -> Int -> Bool
`lengthLessThan` forall (map :: * -> *) a. IsMap map => map a -> Int
mapSize (CmmGraph -> LabelMap CmmBlock
toBlockMap CmmGraph
g)
= forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc CmmTopInfo
info' CLabel
lbl [GlobalReg]
live CmmGraph
g'
| Bool
otherwise
= CmmDecl
proc
where
g' :: CmmGraph
g' = Label -> [CmmBlock] -> CmmGraph
ofBlockList (forall (n :: Extensibility -> Extensibility -> *).
GenCmmGraph n -> Label
g_entry CmmGraph
g) [CmmBlock]
used_blocks
info' :: CmmTopInfo
info' = CmmTopInfo
info { info_tbls :: LabelMap CmmInfoTable
info_tbls = LabelMap CmmInfoTable -> LabelMap CmmInfoTable
keep_used (CmmTopInfo -> LabelMap CmmInfoTable
info_tbls CmmTopInfo
info) }
keep_used :: LabelMap CmmInfoTable -> LabelMap CmmInfoTable
keep_used :: LabelMap CmmInfoTable -> LabelMap CmmInfoTable
keep_used LabelMap CmmInfoTable
bs = forall (map :: * -> *) b a.
IsMap map =>
(b -> KeyOf map -> a -> b) -> b -> map a -> b
mapFoldlWithKey LabelMap CmmInfoTable
-> Label -> CmmInfoTable -> LabelMap CmmInfoTable
keep forall (map :: * -> *) a. IsMap map => map a
mapEmpty LabelMap CmmInfoTable
bs
keep :: LabelMap CmmInfoTable -> Label -> CmmInfoTable -> LabelMap CmmInfoTable
keep :: LabelMap CmmInfoTable
-> Label -> CmmInfoTable -> LabelMap CmmInfoTable
keep LabelMap CmmInfoTable
env Label
l CmmInfoTable
i | Label
l forall set. IsSet set => ElemOf set -> set -> Bool
`setMember` LabelSet
used_lbls = forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> a -> map a -> map a
mapInsert Label
l CmmInfoTable
i LabelMap CmmInfoTable
env
| Bool
otherwise = LabelMap CmmInfoTable
env
used_blocks :: [CmmBlock]
used_blocks :: [CmmBlock]
used_blocks = CmmGraph -> [CmmBlock]
revPostorder CmmGraph
g
used_lbls :: LabelSet
used_lbls :: LabelSet
used_lbls = forall set. IsSet set => [ElemOf set] -> set
setFromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall (thing :: Extensibility -> Extensibility -> *)
(x :: Extensibility).
NonLocal thing =>
thing C x -> Label
entryLabel [CmmBlock]
used_blocks