module CmmLiveZ
( CmmLive
, cmmLivenessZ
, liveLattice
, middleLiveness, noLiveOnEntry
)
where
import BlockId
import CmmExpr
import CmmTx
import DFMonad
import Control.Monad
import PprCmm()
import PprCmmZ()
import ZipCfg
import ZipDataflow
import ZipCfgCmmRep
import Maybes
import Outputable
import UniqSet
type CmmLive = RegSet
liveLattice :: DataflowLattice CmmLive
liveLattice = DataflowLattice "live LocalReg's" emptyUniqSet add False
where add new old =
let join = unionUniqSets new old in
(if sizeUniqSet join > sizeUniqSet old then aTx else noTx) join
type BlockEntryLiveness = BlockEnv CmmLive
cmmLivenessZ :: CmmGraph -> FuelMonad BlockEntryLiveness
cmmLivenessZ g@(LGraph entry _) =
liftM (check . zdfFpFacts) (res :: FuelMonad (CmmBackwardFixedPoint CmmLive))
where res = zdfSolveFrom emptyBlockEnv "liveness analysis" liveLattice transfers
emptyUniqSet (graphOfLGraph g)
transfers = BackwardTransfers (flip const) mid last
mid m = gen_kill m . midLive m
last l = gen_kill l . lastLive l
check facts =
noLiveOnEntry entry (expectJust "check" $ lookupBlockEnv facts entry) facts
gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive
gen_kill a = gen a . kill a
middleLiveness :: Middle -> CmmLive -> CmmLive
middleLiveness = gen_kill
noLiveOnEntry :: BlockId -> CmmLive -> a -> a
noLiveOnEntry bid in_fact x =
if isEmptyUniqSet in_fact then x
else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
gen :: UserOfLocalRegs a => a -> RegSet -> RegSet
gen a live = foldRegsUsed extendRegSet live a
kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet
kill a live = foldRegsDefd delOneFromUniqSet live a
midLive :: Middle -> CmmLive -> CmmLive
midLive (MidForeignCall {}) _ = emptyUniqSet
midLive _ live = live
lastLive :: Last -> (BlockId -> CmmLive) -> CmmLive
lastLive l env = last l
where last (LastBranch id) = env id
last (LastCall _ _ _ _ _) = emptyUniqSet
last (LastCondBranch _ t f) = unionUniqSets (env t) (env f)
last (LastSwitch _ tbl) = unionManyUniqSets $ map env (catMaybes tbl)