diff options
Diffstat (limited to 'compiler/cmm/CmmLive.hs')
-rw-r--r-- | compiler/cmm/CmmLive.hs | 49 |
1 files changed, 38 insertions, 11 deletions
diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs index c87a3a9b33..ca3ab095ed 100644 --- a/compiler/cmm/CmmLive.hs +++ b/compiler/cmm/CmmLive.hs @@ -1,11 +1,13 @@ {-# LANGUAGE GADTs #-} + {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} module CmmLive ( CmmLive , cmmLiveness , liveLattice - , noLiveOnEntry, xferLive + , noLiveOnEntry, xferLive, gen, kill, gen_kill + , removeDeadAssignments ) where @@ -47,9 +49,6 @@ cmmLiveness graph = where entry = g_entry graph check facts = noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts -gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive -gen_kill a = gen a . kill a - -- | On entry to the procedure, there had better not be any LocalReg's live-in. noLiveOnEntry :: BlockId -> CmmLive -> a -> a noLiveOnEntry bid in_fact x = @@ -57,19 +56,47 @@ noLiveOnEntry bid in_fact x = else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact) -- | The transfer equations use the traditional 'gen' and 'kill' --- notations, which should be familiar from the dragon book. -gen :: UserOfLocalRegs a => a -> RegSet -> RegSet -gen a live = foldRegsUsed extendRegSet live a +-- notations, which should be familiar from the Dragon Book. +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 --- Testing! +gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive +gen_kill a = gen a . kill a + +-- | The transfer function +-- EZY: Bits of this analysis are duplicated in CmmSpillReload, though +-- it's not really easy to efficiently reuse all of this. Keep in mind +-- if you need to update this analysis. xferLive :: BwdTransfer CmmNode CmmLive xferLive = mkBTransfer3 fst mid lst where fst _ f = f mid :: CmmNode O O -> CmmLive -> CmmLive mid n f = gen_kill n f lst :: CmmNode O C -> FactBase CmmLive -> CmmLive - lst n f = gen_kill n $ case n of CmmCall {} -> emptyRegSet - CmmForeignCall {} -> emptyRegSet - _ -> joinOutFacts liveLattice n f + -- slightly inefficient: kill is unnecessary for emptyRegSet + lst n f = gen_kill n + $ case n of CmmCall{} -> emptyRegSet + CmmForeignCall{} -> emptyRegSet + _ -> joinOutFacts liveLattice n f + +----------------------------------------------------------------------------- +-- Removing assignments to dead variables +----------------------------------------------------------------------------- + +removeDeadAssignments :: CmmGraph -> FuelUniqSM CmmGraph +removeDeadAssignments g = + liftM fst $ dataflowPassBwd g [] $ analRewBwd liveLattice xferLive 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 CmmLive -> CmmReplGraph O O + middle (CmmAssign (CmmLocal reg') _) live | not (reg' `elemRegSet` 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 :: CmmNode e x -> Fact x CmmLive -> CmmReplGraph e x + nothing _ _ = return Nothing |