{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

module CmmLive
    ( CmmLocalLive
    , cmmLocalLiveness
    , cmmGlobalLiveness
    , liveLattice
    , gen_kill
    )
where

import GhcPrelude

import DynFlags
import BlockId
import Cmm
import PprCmmExpr ()
import Hoopl.Block
import Hoopl.Collections
import Hoopl.Dataflow
import Hoopl.Label

import Maybes
import Outputable

-----------------------------------------------------------------------------
-- Calculating what variables are live on entry to a basic block
-----------------------------------------------------------------------------

-- | The variables live on entry to a block
type CmmLive r = RegSet r
type CmmLocalLive = CmmLive LocalReg

-- | The dataflow lattice
liveLattice :: Ord r => DataflowLattice (CmmLive r)
{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive LocalReg) #-}
{-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive GlobalReg) #-}
liveLattice :: DataflowLattice (CmmLive r)
liveLattice = CmmLive r -> JoinFun (CmmLive r) -> DataflowLattice (CmmLive r)
forall a. a -> JoinFun a -> DataflowLattice a
DataflowLattice CmmLive r
forall r. RegSet r
emptyRegSet JoinFun (CmmLive r)
forall r.
Ord r =>
OldFact (RegSet r) -> NewFact (RegSet r) -> JoinedFact (RegSet r)
add
  where
    add :: OldFact (RegSet r) -> NewFact (RegSet r) -> JoinedFact (RegSet r)
add (OldFact old :: RegSet r
old) (NewFact new :: RegSet r
new) =
        let !join :: RegSet r
join = RegSet r -> RegSet r -> RegSet r
forall r. Ord r => RegSet r -> RegSet r -> RegSet r
plusRegSet RegSet r
old RegSet r
new
        in Bool -> RegSet r -> JoinedFact (RegSet r)
forall a. Bool -> a -> JoinedFact a
changedIf (RegSet r -> Int
forall r. RegSet r -> Int
sizeRegSet RegSet r
join Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> RegSet r -> Int
forall r. RegSet r -> Int
sizeRegSet RegSet r
old) RegSet r
join

-- | A mapping from block labels to the variables live on entry
type BlockEntryLiveness r = LabelMap (CmmLive r)

-----------------------------------------------------------------------------
-- | Calculated liveness info for a CmmGraph
-----------------------------------------------------------------------------

cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg
cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg
cmmLocalLiveness dflags :: DynFlags
dflags graph :: CmmGraph
graph =
    BlockEntryLiveness LocalReg -> BlockEntryLiveness LocalReg
check (BlockEntryLiveness LocalReg -> BlockEntryLiveness LocalReg)
-> BlockEntryLiveness LocalReg -> BlockEntryLiveness LocalReg
forall a b. (a -> b) -> a -> b
$ DataflowLattice (CmmLive LocalReg)
-> TransferFun (CmmLive LocalReg)
-> CmmGraph
-> BlockEntryLiveness LocalReg
-> BlockEntryLiveness LocalReg
forall f.
DataflowLattice f
-> TransferFun f -> CmmGraph -> FactBase f -> FactBase f
analyzeCmmBwd DataflowLattice (CmmLive LocalReg)
forall r. Ord r => DataflowLattice (CmmLive r)
liveLattice (DynFlags -> TransferFun (CmmLive LocalReg)
forall r.
(UserOfRegs r (CmmNode O O), DefinerOfRegs r (CmmNode O O),
 UserOfRegs r (CmmNode O C), DefinerOfRegs r (CmmNode O C)) =>
DynFlags -> TransferFun (CmmLive r)
xferLive DynFlags
dflags) CmmGraph
graph BlockEntryLiveness LocalReg
forall (map :: * -> *) a. IsMap map => map a
mapEmpty
  where
    entry :: BlockId
entry = CmmGraph -> BlockId
forall (n :: * -> * -> *). GenCmmGraph n -> BlockId
g_entry CmmGraph
graph
    check :: BlockEntryLiveness LocalReg -> BlockEntryLiveness LocalReg
check facts :: BlockEntryLiveness LocalReg
facts =
        BlockId
-> CmmLive LocalReg
-> BlockEntryLiveness LocalReg
-> BlockEntryLiveness LocalReg
forall a. BlockId -> CmmLive LocalReg -> a -> a
noLiveOnEntry BlockId
entry (String -> Maybe (CmmLive LocalReg) -> CmmLive LocalReg
forall a. HasCallStack => String -> Maybe a -> a
expectJust "check" (Maybe (CmmLive LocalReg) -> CmmLive LocalReg)
-> Maybe (CmmLive LocalReg) -> CmmLive LocalReg
forall a b. (a -> b) -> a -> b
$ KeyOf LabelMap
-> BlockEntryLiveness LocalReg -> Maybe (CmmLive LocalReg)
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
BlockId
entry BlockEntryLiveness LocalReg
facts) BlockEntryLiveness LocalReg
facts

cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg
cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg
cmmGlobalLiveness dflags :: DynFlags
dflags graph :: CmmGraph
graph =
    DataflowLattice (CmmLive GlobalReg)
-> TransferFun (CmmLive GlobalReg)
-> CmmGraph
-> BlockEntryLiveness GlobalReg
-> BlockEntryLiveness GlobalReg
forall f.
DataflowLattice f
-> TransferFun f -> CmmGraph -> FactBase f -> FactBase f
analyzeCmmBwd DataflowLattice (CmmLive GlobalReg)
forall r. Ord r => DataflowLattice (CmmLive r)
liveLattice (DynFlags -> TransferFun (CmmLive GlobalReg)
forall r.
(UserOfRegs r (CmmNode O O), DefinerOfRegs r (CmmNode O O),
 UserOfRegs r (CmmNode O C), DefinerOfRegs r (CmmNode O C)) =>
DynFlags -> TransferFun (CmmLive r)
xferLive DynFlags
dflags) CmmGraph
graph BlockEntryLiveness GlobalReg
forall (map :: * -> *) a. IsMap map => map a
mapEmpty

-- | On entry to the procedure, there had better not be any LocalReg's live-in.
noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
noLiveOnEntry bid :: BlockId
bid in_fact :: CmmLive LocalReg
in_fact x :: a
x =
  if CmmLive LocalReg -> Bool
forall r. RegSet r -> Bool
nullRegSet CmmLive LocalReg
in_fact then a
x
  else String -> SDoc -> a
forall a. HasCallStack => String -> SDoc -> a
pprPanic "LocalReg's live-in to graph" (BlockId -> SDoc
forall a. Outputable a => a -> SDoc
ppr BlockId
bid SDoc -> SDoc -> SDoc
<+> CmmLive LocalReg -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmLive LocalReg
in_fact)

gen_kill
    :: (DefinerOfRegs r n, UserOfRegs r n)
    => DynFlags -> n -> CmmLive r -> CmmLive r
gen_kill :: DynFlags -> n -> CmmLive r -> CmmLive r
gen_kill dflags :: DynFlags
dflags node :: n
node set :: CmmLive r
set =
    let !afterKill :: CmmLive r
afterKill = DynFlags
-> (CmmLive r -> r -> CmmLive r) -> CmmLive r -> n -> CmmLive r
forall r a b.
DefinerOfRegs r a =>
DynFlags -> (b -> r -> b) -> b -> a -> b
foldRegsDefd DynFlags
dflags CmmLive r -> r -> CmmLive r
forall r. Ord r => RegSet r -> r -> RegSet r
deleteFromRegSet CmmLive r
set n
node
    in DynFlags
-> (CmmLive r -> r -> CmmLive r) -> CmmLive r -> n -> CmmLive r
forall r a b.
UserOfRegs r a =>
DynFlags -> (b -> r -> b) -> b -> a -> b
foldRegsUsed DynFlags
dflags CmmLive r -> r -> CmmLive r
forall r. Ord r => RegSet r -> r -> RegSet r
extendRegSet CmmLive r
afterKill n
node
{-# INLINE gen_kill #-}

xferLive
    :: forall r.
       ( UserOfRegs r (CmmNode O O)
       , DefinerOfRegs r (CmmNode O O)
       , UserOfRegs r (CmmNode O C)
       , DefinerOfRegs r (CmmNode O C)
       )
    => DynFlags -> TransferFun (CmmLive r)
xferLive :: DynFlags -> TransferFun (CmmLive r)
xferLive dflags :: DynFlags
dflags (BlockCC eNode :: CmmNode C O
eNode middle :: Block CmmNode O O
middle xNode :: CmmNode O C
xNode) fBase :: FactBase (CmmLive r)
fBase =
    let joined :: CmmLive r
joined = DynFlags -> CmmNode O C -> CmmLive r -> CmmLive r
forall r n.
(DefinerOfRegs r n, UserOfRegs r n) =>
DynFlags -> n -> CmmLive r -> CmmLive r
gen_kill DynFlags
dflags CmmNode O C
xNode (CmmLive r -> CmmLive r) -> CmmLive r -> CmmLive r
forall a b. (a -> b) -> a -> b
$! DataflowLattice (CmmLive r)
-> CmmNode O C -> FactBase (CmmLive r) -> CmmLive r
forall (n :: * -> * -> *) f e.
NonLocal n =>
DataflowLattice f -> n e C -> FactBase f -> f
joinOutFacts DataflowLattice (CmmLive r)
forall r. Ord r => DataflowLattice (CmmLive r)
liveLattice CmmNode O C
xNode FactBase (CmmLive r)
fBase
        !result :: CmmLive r
result = (CmmNode O O -> CmmLive r -> CmmLive r)
-> Block CmmNode O O -> CmmLive r -> CmmLive r
forall f. (CmmNode O O -> f -> f) -> Block CmmNode O O -> f -> f
foldNodesBwdOO (DynFlags -> CmmNode O O -> CmmLive r -> CmmLive r
forall r n.
(DefinerOfRegs r n, UserOfRegs r n) =>
DynFlags -> n -> CmmLive r -> CmmLive r
gen_kill DynFlags
dflags) Block CmmNode O O
middle CmmLive r
joined
    in KeyOf LabelMap -> CmmLive r -> FactBase (CmmLive r)
forall (map :: * -> *) a. IsMap map => KeyOf map -> a -> map a
mapSingleton (CmmNode C O -> BlockId
forall (thing :: * -> * -> *) x.
NonLocal thing =>
thing C x -> BlockId
entryLabel CmmNode C O
eNode) CmmLive r
result
{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive LocalReg) #-}
{-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive GlobalReg) #-}