    {-# LANGUAGE GADTs #-}

    module GHC.Cmm.Liveness
        ( CmmLocalLive
        , cmmLocalLiveness
        , cmmLocalLivenessL
        , cmmGlobalLiveness
        , liveLattice
        , liveLatticeL
        , gen_kill
        , gen_killL
        )
    where

    import GHC.Prelude

    import GHC.Platform
    import GHC.Cmm.BlockId
    import GHC.Cmm
    import GHC.Cmm.Dataflow.Block
    import GHC.Cmm.Dataflow
    import GHC.Cmm.Dataflow.Label
    import GHC.Cmm.LRegSet

    import GHC.Data.Maybe
    import GHC.Utils.Outputable
    import GHC.Utils.Panic

    import GHC.Types.Unique

    -----------------------------------------------------------------------------
    -- 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 :: forall r. Ord r => 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 RegSet r
    old) (NewFact 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 :: Platform -> CmmGraph -> BlockEntryLiveness LocalReg
    cmmLocalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness LocalReg
    cmmLocalLiveness Platform
    platform 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' CmmNode (CmmLive LocalReg)
    -> CmmGraph
    -> BlockEntryLiveness LocalReg
    -> BlockEntryLiveness LocalReg
    forall (node :: Extensibility -> Extensibility -> *) f.
    NonLocal node =>
    DataflowLattice f
    -> TransferFun' node f
    -> GenCmmGraph node
    -> FactBase f
    -> FactBase f
    analyzeCmmBwd DataflowLattice (CmmLive LocalReg)
    forall r. Ord r => DataflowLattice (CmmLive r)
    liveLattice (Platform -> TransferFun' CmmNode (CmmLive LocalReg)
    forall r.
    (UserOfRegs r (CmmNode O O), DefinerOfRegs r (CmmNode O O),
     UserOfRegs r (CmmNode O C), DefinerOfRegs r (CmmNode O C)) =>
    Platform -> TransferFun (CmmLive r)
    xferLive Platform
    platform) CmmGraph
    graph BlockEntryLiveness LocalReg
    forall v. LabelMap v
    mapEmpty
      where
        entry :: BlockId
    entry = CmmGraph -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry CmmGraph
    graph
        check :: BlockEntryLiveness LocalReg -> BlockEntryLiveness LocalReg
    check 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 String
    "check" (Maybe (CmmLive LocalReg) -> CmmLive LocalReg)
    -> Maybe (CmmLive LocalReg) -> CmmLive LocalReg
    forall a b. (a -> b) -> a -> b
    $ BlockId -> BlockEntryLiveness LocalReg -> Maybe (CmmLive LocalReg)
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    entry BlockEntryLiveness LocalReg
    facts) BlockEntryLiveness LocalReg
    facts

    cmmGlobalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness GlobalReg
    cmmGlobalLiveness :: Platform -> CmmGraph -> BlockEntryLiveness GlobalReg
    cmmGlobalLiveness Platform
    platform CmmGraph
    graph =
        DataflowLattice (CmmLive GlobalReg)
    -> TransferFun' CmmNode (CmmLive GlobalReg)
    -> CmmGraph
    -> BlockEntryLiveness GlobalReg
    -> BlockEntryLiveness GlobalReg
    forall (node :: Extensibility -> Extensibility -> *) f.
    NonLocal node =>
    DataflowLattice f
    -> TransferFun' node f
    -> GenCmmGraph node
    -> FactBase f
    -> FactBase f
    analyzeCmmBwd DataflowLattice (CmmLive GlobalReg)
    forall r. Ord r => DataflowLattice (CmmLive r)
    liveLattice (Platform -> TransferFun' CmmNode (CmmLive GlobalReg)
    forall r.
    (UserOfRegs r (CmmNode O O), DefinerOfRegs r (CmmNode O O),
     UserOfRegs r (CmmNode O C), DefinerOfRegs r (CmmNode O C)) =>
    Platform -> TransferFun (CmmLive r)
    xferLive Platform
    platform) CmmGraph
    graph BlockEntryLiveness GlobalReg
    forall v. LabelMap v
    mapEmpty

    -- | On entry to the procedure, there had better not be any LocalReg's live-in.
    -- If you see this error it most likely means you are trying to use a variable
    -- without it being defined in the given scope.
    noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
    noLiveOnEntry :: forall a. BlockId -> CmmLive LocalReg -> a -> a
    noLiveOnEntry BlockId
    bid CmmLive LocalReg
    in_fact 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 String
    "LocalReg's live-in to graph" (BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    bid SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> CmmLive LocalReg -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr CmmLive LocalReg
    in_fact)

    gen_kill
        :: (DefinerOfRegs r n, UserOfRegs r n)
        => Platform -> n -> CmmLive r -> CmmLive r
    gen_kill :: forall r n.
    (DefinerOfRegs r n, UserOfRegs r n) =>
    Platform -> n -> CmmLive r -> CmmLive r
    gen_kill Platform
    platform n
    node CmmLive r
    set =
        let !afterKill :: CmmLive r
    afterKill = Platform
    -> (CmmLive r -> r -> CmmLive r) -> CmmLive r -> n -> CmmLive r
    forall b. Platform -> (b -> r -> b) -> b -> n -> b
    forall r a b.
    DefinerOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsDefd Platform
    platform CmmLive r -> r -> CmmLive r
    forall r. Ord r => RegSet r -> r -> RegSet r
    deleteFromRegSet CmmLive r
    set n
    node
        in Platform
    -> (CmmLive r -> r -> CmmLive r) -> CmmLive r -> n -> CmmLive r
    forall b. Platform -> (b -> r -> b) -> b -> n -> b
    forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed Platform
    platform 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)
           )
        => Platform -> TransferFun (CmmLive r)
    xferLive :: forall r.
    (UserOfRegs r (CmmNode O O), DefinerOfRegs r (CmmNode O O),
     UserOfRegs r (CmmNode O C), DefinerOfRegs r (CmmNode O C)) =>
    Platform -> TransferFun (CmmLive r)
    xferLive Platform
    platform (BlockCC CmmNode C O
    eNode Block CmmNode O O
    middle CmmNode O C
    xNode) FactBase (CmmLive r)
    fBase =
        let joined :: CmmLive r
    joined = Platform -> CmmNode O C -> CmmLive r -> CmmLive r
    forall r n.
    (DefinerOfRegs r n, UserOfRegs r n) =>
    Platform -> n -> CmmLive r -> CmmLive r
    gen_kill Platform
    platform 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 :: Extensibility -> Extensibility -> *) f
           (e :: Extensibility).
    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 (node :: Extensibility -> Extensibility -> *) f.
    (node O O -> f -> f) -> Block node O O -> f -> f
    foldNodesBwdOO (Platform -> CmmNode O O -> CmmLive r -> CmmLive r
    forall r n.
    (DefinerOfRegs r n, UserOfRegs r n) =>
    Platform -> n -> CmmLive r -> CmmLive r
    gen_kill Platform
    platform) Block CmmNode O O
    middle CmmLive r
    joined
        in BlockId -> CmmLive r -> FactBase (CmmLive r)
    forall v. BlockId -> v -> LabelMap v
    mapSingleton (CmmNode C O -> BlockId
    forall (x :: Extensibility). CmmNode C x -> BlockId
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel CmmNode C O
    eNode) CmmLive r
    result
    {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-}
    {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-}

    -----------------------------------------------------------------------------
    -- | Specialization that only retains the keys for local variables.
    --
    -- Local variables are mostly glorified Ints, and some parts of the compiler
    -- really don't care about anything but the Int part. So we can avoid some
    -- overhead by computing a IntSet instead of a Set LocalReg which (unsurprisingly)
    -- is quite a bit faster.
    -----------------------------------------------------------------------------

    type BlockEntryLivenessL  = LabelMap LRegSet

    -- | The dataflow lattice
    liveLatticeL :: DataflowLattice LRegSet
    liveLatticeL :: DataflowLattice LRegSet
    liveLatticeL = LRegSet -> JoinFun LRegSet -> DataflowLattice LRegSet
    forall a. a -> JoinFun a -> DataflowLattice a
    DataflowLattice LRegSet
    emptyLRegSet JoinFun LRegSet
    add
      where
        add :: JoinFun LRegSet
    add (OldFact LRegSet
    old) (NewFact LRegSet
    new) =
            let !join :: LRegSet
    join = LRegSet -> LRegSet -> LRegSet
    plusLRegSet LRegSet
    old LRegSet
    new
            in Bool -> LRegSet -> JoinedFact LRegSet
    forall a. Bool -> a -> JoinedFact a
    changedIf (LRegSet -> Int
    sizeLRegSet LRegSet
    join Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > LRegSet -> Int
    sizeLRegSet LRegSet
    old) LRegSet
    join

    cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL
    cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL
    cmmLocalLivenessL Platform
    platform CmmGraph
    graph =
        BlockEntryLivenessL -> BlockEntryLivenessL
    check (BlockEntryLivenessL -> BlockEntryLivenessL)
    -> BlockEntryLivenessL -> BlockEntryLivenessL
    forall a b. (a -> b) -> a -> b
    $ DataflowLattice LRegSet
    -> TransferFun' CmmNode LRegSet
    -> CmmGraph
    -> BlockEntryLivenessL
    -> BlockEntryLivenessL
    forall (node :: Extensibility -> Extensibility -> *) f.
    NonLocal node =>
    DataflowLattice f
    -> TransferFun' node f
    -> GenCmmGraph node
    -> FactBase f
    -> FactBase f
    analyzeCmmBwd DataflowLattice LRegSet
    liveLatticeL (Platform -> TransferFun' CmmNode LRegSet
    (UserOfRegs LocalReg (CmmNode O O),
     DefinerOfRegs LocalReg (CmmNode O O),
     UserOfRegs LocalReg (CmmNode O C),
     DefinerOfRegs LocalReg (CmmNode O C)) =>
    Platform -> TransferFun' CmmNode LRegSet
    xferLiveL Platform
    platform) CmmGraph
    graph BlockEntryLivenessL
    forall v. LabelMap v
    mapEmpty
      where
        entry :: BlockId
    entry = CmmGraph -> BlockId
    forall (n :: Extensibility -> Extensibility -> *).
    GenCmmGraph n -> BlockId
    g_entry CmmGraph
    graph
        check :: BlockEntryLivenessL -> BlockEntryLivenessL
    check BlockEntryLivenessL
    facts =
            BlockId -> LRegSet -> BlockEntryLivenessL -> BlockEntryLivenessL
    forall a. BlockId -> LRegSet -> a -> a
    noLiveOnEntryL BlockId
    entry (String -> Maybe LRegSet -> LRegSet
    forall a. HasCallStack => String -> Maybe a -> a
    expectJust String
    "check" (Maybe LRegSet -> LRegSet) -> Maybe LRegSet -> LRegSet
    forall a b. (a -> b) -> a -> b
    $ BlockId -> BlockEntryLivenessL -> Maybe LRegSet
    forall a. BlockId -> LabelMap a -> Maybe a
    mapLookup BlockId
    entry BlockEntryLivenessL
    facts) BlockEntryLivenessL
    facts

    -- | On entry to the procedure, there had better not be any LocalReg's live-in.
    noLiveOnEntryL :: BlockId -> LRegSet -> a -> a
    noLiveOnEntryL :: forall a. BlockId -> LRegSet -> a -> a
    noLiveOnEntryL BlockId
    bid LRegSet
    in_fact a
    x =
      if LRegSet -> Bool
    nullLRegSet LRegSet
    in_fact then a
    x
      else String -> SDoc -> a
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "LocalReg's live-in to graph" (BlockId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr BlockId
    bid SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> [Unique] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Unique]
    reg_uniques)
        where
            -- We convert the int's to uniques so that the printing matches that
            -- of registers.
            reg_uniques :: [Unique]
    reg_uniques = (Word64 -> Unique) -> [Word64] -> [Unique]
    forall a b. (a -> b) -> [a] -> [b]
    map Word64 -> Unique
    mkUniqueGrimily ([Word64] -> [Unique]) -> [Word64] -> [Unique]
    forall a b. (a -> b) -> a -> b
    $ LRegSet -> [Word64]
    elemsLRegSet LRegSet
    in_fact

    gen_killL
        :: (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n)
        => Platform -> n -> LRegSet -> LRegSet
    gen_killL :: forall n.
    (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) =>
    Platform -> n -> LRegSet -> LRegSet
    gen_killL Platform
    platform n
    node LRegSet
    set =
        let !afterKill :: LRegSet
    afterKill = Platform
    -> (LRegSet -> LocalReg -> LRegSet) -> LRegSet -> n -> LRegSet
    forall b. Platform -> (b -> LocalReg -> b) -> b -> n -> b
    forall r a b.
    DefinerOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsDefd Platform
    platform LRegSet -> LocalReg -> LRegSet
    deleteFromLRegSet LRegSet
    set n
    node
        in Platform
    -> (LRegSet -> LocalReg -> LRegSet) -> LRegSet -> n -> LRegSet
    forall b. Platform -> (b -> LocalReg -> b) -> b -> n -> b
    forall r a b.
    UserOfRegs r a =>
    Platform -> (b -> r -> b) -> b -> a -> b
    foldRegsUsed Platform
    platform ((LocalReg -> LRegSet -> LRegSet) -> LRegSet -> LocalReg -> LRegSet
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip LocalReg -> LRegSet -> LRegSet
    insertLRegSet) LRegSet
    afterKill n
    node
    {-# INLINE gen_killL #-}

    xferLiveL
        :: ( UserOfRegs LocalReg (CmmNode O O)
           , DefinerOfRegs LocalReg (CmmNode O O)
           , UserOfRegs LocalReg (CmmNode O C)
           , DefinerOfRegs LocalReg (CmmNode O C)
           )
        => Platform -> TransferFun LRegSet
    xferLiveL :: (UserOfRegs LocalReg (CmmNode O O),
     DefinerOfRegs LocalReg (CmmNode O O),
     UserOfRegs LocalReg (CmmNode O C),
     DefinerOfRegs LocalReg (CmmNode O C)) =>
    Platform -> TransferFun' CmmNode LRegSet
    xferLiveL Platform
    platform (BlockCC CmmNode C O
    eNode Block CmmNode O O
    middle CmmNode O C
    xNode) BlockEntryLivenessL
    fBase =
        let joined :: LRegSet
    joined = Platform -> CmmNode O C -> LRegSet -> LRegSet
    forall n.
    (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) =>
    Platform -> n -> LRegSet -> LRegSet
    gen_killL Platform
    platform CmmNode O C
    xNode (LRegSet -> LRegSet) -> LRegSet -> LRegSet
    forall a b. (a -> b) -> a -> b
    $! DataflowLattice LRegSet
    -> CmmNode O C -> BlockEntryLivenessL -> LRegSet
    forall (n :: Extensibility -> Extensibility -> *) f
           (e :: Extensibility).
    NonLocal n =>
    DataflowLattice f -> n e C -> FactBase f -> f
    joinOutFacts DataflowLattice LRegSet
    liveLatticeL CmmNode O C
    xNode BlockEntryLivenessL
    fBase
            !result :: LRegSet
    result = (CmmNode O O -> LRegSet -> LRegSet)
    -> Block CmmNode O O -> LRegSet -> LRegSet
    forall (node :: Extensibility -> Extensibility -> *) f.
    (node O O -> f -> f) -> Block node O O -> f -> f
    foldNodesBwdOO (Platform -> CmmNode O O -> LRegSet -> LRegSet
    forall n.
    (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n) =>
    Platform -> n -> LRegSet -> LRegSet
    gen_killL Platform
    platform) Block CmmNode O O
    middle LRegSet
    joined
        in BlockId -> LRegSet -> BlockEntryLivenessL
    forall v. BlockId -> v -> LabelMap v
    mapSingleton (CmmNode C O -> BlockId
    forall (x :: Extensibility). CmmNode C x -> BlockId
    forall (thing :: Extensibility -> Extensibility -> *)
           (x :: Extensibility).
    NonLocal thing =>
    thing C x -> BlockId
    entryLabel CmmNode C O
    eNode) LRegSet
    result