Cmm.Sink: Optimize retaining of assignments, live sets.

Sinking requires us to track live local regs after each
cmm statement. We used to do this via "Set LocalReg".

However we can replace this with a solution based on IntSet
which is overall more efficient without losing much. The thing
we lose is width of the variables, which isn't used by the sinking
pass anyway.

I also reworked how we keep assignments to regs mentioned in
skipped assignments. I put the details into
Note [Keeping assignemnts mentioned in skipped RHSs].

The gist of it is instead of keeping track of it via the use count
which is a `IntMap Int` we now use the live regs set (IntSet) which
is quite a bit faster.

I think it also matches the semantics a lot better. The skipped
(not discarded) assignment does in fact keep the regs on it's rhs
alive so keeping track of this in the live set seems like the clearer
solution as well.

Improves allocations for T3294 by yet another 1%.

1 files changed, 69 insertions, 0 deletions

diff --git a/compiler/GHC/Cmm/Liveness.hs b/compiler/GHC/Cmm/Liveness.hs
index 0ec38509ba..f047ea4367 100644
--- a/compiler/GHC/Cmm/Liveness.hs
+++ b/compiler/GHC/Cmm/Liveness.hs
@@ -6,9 +6,12 @@
 module GHC.Cmm.Liveness
     ( CmmLocalLive
     , cmmLocalLiveness
+    , cmmLocalLivenessL
     , cmmGlobalLiveness
     , liveLattice
+    , liveLatticeL
     , gen_kill
+    , gen_killL
     )
 where
 
@@ -22,11 +25,14 @@ import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Collections
 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
 -----------------------------------------------------------------------------
@@ -92,3 +98,66 @@ xferLive platform (BlockCC eNode middle xNode) fBase =
     in mapSingleton (entryLabel eNode) result
 {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive LocalReg) #-}
 {-# SPECIALIZE xferLive :: Platform -> TransferFun (CmmLive GlobalReg) #-}
+
+-----------------------------------------------------------------------------
+-- | Specialization that only retains the keys for local variables.
+--
+-- Local variablas 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 emptyLRegSet add
+  where
+    add (OldFact old) (NewFact new) =
+        let !join = plusLRegSet old new
+        in changedIf (sizeLRegSet join > sizeLRegSet old) join
+
+
+cmmLocalLivenessL :: Platform -> CmmGraph -> BlockEntryLivenessL
+cmmLocalLivenessL platform graph =
+    check $ analyzeCmmBwd liveLatticeL (xferLiveL platform) graph mapEmpty
+  where
+    entry = g_entry graph
+    check facts =
+        noLiveOnEntryL entry (expectJust "check" $ mapLookup entry facts) facts
+
+-- | On entry to the procedure, there had better not be any LocalReg's live-in.
+noLiveOnEntryL :: BlockId -> LRegSet -> a -> a
+noLiveOnEntryL bid in_fact x =
+  if nullLRegSet in_fact then x
+  else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr reg_uniques)
+    where
+        -- We convert the int's to uniques so that the printing matches that
+        -- of registers.
+        reg_uniques = map mkUniqueGrimily $ elemsLRegSet in_fact
+
+
+
+
+gen_killL
+    :: (DefinerOfRegs LocalReg n, UserOfRegs LocalReg n)
+    => Platform -> n -> LRegSet -> LRegSet
+gen_killL platform node set =
+    let !afterKill = foldRegsDefd platform deleteFromLRegSet set node
+    in foldRegsUsed platform (flip insertLRegSet) afterKill 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 platform (BlockCC eNode middle xNode) fBase =
+    let joined = gen_killL platform xNode $! joinOutFacts liveLatticeL xNode fBase
+        !result = foldNodesBwdOO (gen_killL platform) middle joined
+    in mapSingleton (entryLabel eNode) result
+
+