+spill, reload :: LocalReg -> CmmNode O O
+spill r = CmmStore (regSlot r) (CmmReg $ CmmLocal r)
+reload r = CmmAssign (CmmLocal r) (CmmLoad (regSlot r) $ localRegType r)
+
+removeDeadAssignmentsAndReloads :: BlockSet -> CmmGraph -> FuelUniqSM CmmGraph
+removeDeadAssignmentsAndReloads procPoints g =
+ liftM fst $ dataflowPassBwd g [] $ analRewBwd dualLiveLattice
+ (dualLiveTransfers (g_entry g) procPoints)
+ rewrites
+ where rewrites = deepBwdRw3 nothing middle nothing
+ -- Beware: deepBwdRw with one polymorphic function seems more reasonable here,
+ -- but GHC panics while compiling, see bug #4045.
+ middle :: CmmNode O O -> Fact O DualLive -> CmmReplGraph O O
+ middle (CmmAssign (CmmLocal reg') _) live | not (reg' `elemRegSet` in_regs live) = return $ Just emptyGraph
+ -- XXX maybe this should be somewhere else...
+ middle (CmmAssign lhs (CmmReg rhs)) _ | lhs == rhs = return $ Just emptyGraph
+ middle (CmmStore lhs (CmmLoad rhs _)) _ | lhs == rhs = return $ Just emptyGraph
+ middle _ _ = return Nothing
+
+ nothing _ _ = return Nothing
+
+----------------------------------------------------------------
+--- Usage information
+
+-- We decorate all register assignments with usage information,
+-- that is, the maximum number of times the register is referenced
+-- while it is live along all outgoing control paths. There are a few
+-- subtleties here:
+--
+-- - If a register goes dead, and then becomes live again, the usages
+-- of the disjoint live range don't count towards the original range.
+--
+-- a = 1; // used once
+-- b = a;
+-- a = 2; // used once
+-- c = a;
+--
+-- - A register may be used multiple times, but these all reside in
+-- different control paths, such that any given execution only uses
+-- it once. In that case, the usage count may still be 1.
+--
+-- a = 1; // used once
+-- if (b) {
+-- c = a + 3;
+-- } else {
+-- c = a + 1;
+-- }
+--
+-- This policy corresponds to an inlining strategy that does not
+-- duplicate computation but may increase binary size.
+--
+-- - If we naively implement a usage count, we have a counting to
+-- infinity problem across joins. Furthermore, knowing that
+-- something is used 2 or more times in one runtime execution isn't
+-- particularly useful for optimizations (inlining may be beneficial,
+-- but there's no way of knowing that without register pressure
+-- information.)
+--
+-- while (...) {
+-- // first iteration, b used once
+-- // second iteration, b used twice
+-- // third iteration ...
+-- a = b;
+-- }
+-- // b used zero times
+--
+-- There is an orthogonal question, which is that for every runtime
+-- execution, the register may be used only once, but if we inline it
+-- in every conditional path, the binary size might increase a lot.
+-- But tracking this information would be tricky, because it violates
+-- the finite lattice restriction Hoopl requires for termination;
+-- we'd thus need to supply an alternate proof, which is probably
+-- something we should defer until we actually have an optimization
+-- that would take advantage of this. (This might also interact
+-- strangely with liveness information.)
+--
+-- a = ...;
+-- // a is used one time, but in X different paths
+-- case (b) of
+-- 1 -> ... a ...
+-- 2 -> ... a ...
+-- 3 -> ... a ...
+-- ...
+--
+-- This analysis is very similar to liveness analysis; we just keep a
+-- little extra info. (Maybe we should move it to CmmLive, and subsume
+-- the old liveness analysis.)
+
+data RegUsage = SingleUse | ManyUse
+ deriving (Ord, Eq, Show)
+-- Absence in map = ZeroUse
+
+{-
+-- minBound is bottom, maxBound is top, least-upper-bound is max
+-- ToDo: Put this in Hoopl. Note that this isn't as useful as I
+-- originally hoped, because you usually want to leave out the bottom
+-- element when you have things like this put in maps. Maybe f is
+-- useful on its own as a combining function.
+boundedOrdLattice :: (Bounded a, Ord a) => String -> DataflowLattice a
+boundedOrdLattice n = DataflowLattice n minBound f
+ where f _ (OldFact x) (NewFact y)
+ | x >= y = (NoChange, x)
+ | otherwise = (SomeChange, y)
+-}
+
+-- Custom node type we'll rewrite to. CmmAssign nodes to local
+-- registers are replaced with AssignLocal nodes.
+data WithRegUsage n e x where
+ Plain :: n e x -> WithRegUsage n e x
+ AssignLocal :: LocalReg -> CmmExpr -> RegUsage -> WithRegUsage n O O
+
+instance UserOfLocalRegs (n e x) => UserOfLocalRegs (WithRegUsage n e x) where
+ foldRegsUsed f z (Plain n) = foldRegsUsed f z n
+ foldRegsUsed f z (AssignLocal _ e _) = foldRegsUsed f z e
+
+instance DefinerOfLocalRegs (n e x) => DefinerOfLocalRegs (WithRegUsage n e x) where
+ foldRegsDefd f z (Plain n) = foldRegsDefd f z n
+ foldRegsDefd f z (AssignLocal r _ _) = foldRegsDefd f z r
+
+instance NonLocal n => NonLocal (WithRegUsage n) where
+ entryLabel (Plain n) = entryLabel n
+ successors (Plain n) = successors n
+
+liftRegUsage :: Graph n e x -> Graph (WithRegUsage n) e x
+liftRegUsage = mapGraph Plain
+
+eraseRegUsage :: Graph (WithRegUsage CmmNode) e x -> Graph CmmNode e x
+eraseRegUsage = mapGraph f
+ where f :: WithRegUsage CmmNode e x -> CmmNode e x
+ f (AssignLocal l e _) = CmmAssign (CmmLocal l) e
+ f (Plain n) = n
+
+type UsageMap = UniqFM RegUsage
+
+usageLattice :: DataflowLattice UsageMap
+usageLattice = DataflowLattice "usage counts for registers" emptyUFM (joinUFM f)
+ where f _ (OldFact x) (NewFact y)
+ | x >= y = (NoChange, x)
+ | otherwise = (SomeChange, y)
+
+-- We reuse the names 'gen' and 'kill', although we're doing something
+-- slightly different from the Dragon Book
+usageTransfer :: BwdTransfer (WithRegUsage CmmNode) UsageMap
+usageTransfer = mkBTransfer3 first middle last
+ where first _ f = f
+ middle :: WithRegUsage CmmNode O O -> UsageMap -> UsageMap
+ middle n f = gen_kill n f
+ last :: WithRegUsage CmmNode O C -> FactBase UsageMap -> UsageMap
+ -- Checking for CmmCall/CmmForeignCall is unnecessary, because
+ -- spills/reloads have already occurred by the time we do this
+ -- analysis.
+ -- XXX Deprecated warning is puzzling: what label are we
+ -- supposed to use?
+ -- ToDo: With a bit more cleverness here, we can avoid
+ -- disappointment and heartbreak associated with the inability
+ -- to inline into CmmCall and CmmForeignCall by
+ -- over-estimating the usage to be ManyUse.
+ last n f = gen_kill n (joinOutFacts usageLattice n f)
+ gen_kill a = gen a . kill a
+ gen a f = foldRegsUsed increaseUsage f a
+ kill a f = foldRegsDefd delFromUFM f a
+ increaseUsage f r = addToUFM_C combine f r SingleUse
+ where combine _ _ = ManyUse
+
+usageRewrite :: BwdRewrite FuelUniqSM (WithRegUsage CmmNode) UsageMap
+usageRewrite = mkBRewrite3 first middle last
+ where first _ _ = return Nothing
+ middle :: Monad m => WithRegUsage CmmNode O O -> UsageMap -> m (Maybe (Graph (WithRegUsage CmmNode) O O))
+ middle (Plain (CmmAssign (CmmLocal l) e)) f
+ = return . Just
+ $ case lookupUFM f l of
+ Nothing -> emptyGraph
+ Just usage -> mkMiddle (AssignLocal l e usage)
+ middle _ _ = return Nothing
+ last _ _ = return Nothing
+
+type CmmGraphWithRegUsage = GenCmmGraph (WithRegUsage CmmNode)
+annotateUsage :: CmmGraph -> FuelUniqSM (CmmGraphWithRegUsage)
+annotateUsage vanilla_g =
+ let g = modifyGraph liftRegUsage vanilla_g
+ in liftM fst $ dataflowPassBwd g [(g_entry g, fact_bot usageLattice)] $
+ analRewBwd usageLattice usageTransfer usageRewrite