Be more selective in which conditionals we invert
[ghc.git] / compiler / cmm / CmmLive.hs
1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE GADTs #-}
4 {-# LANGUAGE ScopedTypeVariables #-}
5
6 module CmmLive
7 ( CmmLocalLive
8 , cmmLocalLiveness
9 , cmmGlobalLiveness
10 , liveLattice
11 , gen_kill
12 )
13 where
14
15 import GhcPrelude
16
17 import DynFlags
18 import BlockId
19 import Cmm
20 import PprCmmExpr ()
21 import Hoopl.Block
22 import Hoopl.Collections
23 import Hoopl.Dataflow
24 import Hoopl.Label
25
26 import Maybes
27 import Outputable
28
29 -----------------------------------------------------------------------------
30 -- Calculating what variables are live on entry to a basic block
31 -----------------------------------------------------------------------------
32
33 -- | The variables live on entry to a block
34 type CmmLive r = RegSet r
35 type CmmLocalLive = CmmLive LocalReg
36
37 -- | The dataflow lattice
38 liveLattice :: Ord r => DataflowLattice (CmmLive r)
39 {-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive LocalReg) #-}
40 {-# SPECIALIZE liveLattice :: DataflowLattice (CmmLive GlobalReg) #-}
41 liveLattice = DataflowLattice emptyRegSet add
42 where
43 add (OldFact old) (NewFact new) =
44 let !join = plusRegSet old new
45 in changedIf (sizeRegSet join > sizeRegSet old) join
46
47 -- | A mapping from block labels to the variables live on entry
48 type BlockEntryLiveness r = LabelMap (CmmLive r)
49
50 -----------------------------------------------------------------------------
51 -- | Calculated liveness info for a CmmGraph
52 -----------------------------------------------------------------------------
53
54 cmmLocalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness LocalReg
55 cmmLocalLiveness dflags graph =
56 check $ analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty
57 where
58 entry = g_entry graph
59 check facts =
60 noLiveOnEntry entry (expectJust "check" $ mapLookup entry facts) facts
61
62 cmmGlobalLiveness :: DynFlags -> CmmGraph -> BlockEntryLiveness GlobalReg
63 cmmGlobalLiveness dflags graph =
64 analyzeCmmBwd liveLattice (xferLive dflags) graph mapEmpty
65
66 -- | On entry to the procedure, there had better not be any LocalReg's live-in.
67 noLiveOnEntry :: BlockId -> CmmLive LocalReg -> a -> a
68 noLiveOnEntry bid in_fact x =
69 if nullRegSet in_fact then x
70 else pprPanic "LocalReg's live-in to graph" (ppr bid <+> ppr in_fact)
71
72 gen_kill
73 :: (DefinerOfRegs r n, UserOfRegs r n)
74 => DynFlags -> n -> CmmLive r -> CmmLive r
75 gen_kill dflags node set =
76 let !afterKill = foldRegsDefd dflags deleteFromRegSet set node
77 in foldRegsUsed dflags extendRegSet afterKill node
78 {-# INLINE gen_kill #-}
79
80 xferLive
81 :: forall r.
82 ( UserOfRegs r (CmmNode O O)
83 , DefinerOfRegs r (CmmNode O O)
84 , UserOfRegs r (CmmNode O C)
85 , DefinerOfRegs r (CmmNode O C)
86 )
87 => DynFlags -> TransferFun (CmmLive r)
88 xferLive dflags (BlockCC eNode middle xNode) fBase =
89 let joined = gen_kill dflags xNode $! joinOutFacts liveLattice xNode fBase
90 !result = foldNodesBwdOO (gen_kill dflags) middle joined
91 in mapSingleton (entryLabel eNode) result
92 {-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive LocalReg) #-}
93 {-# SPECIALIZE xferLive :: DynFlags -> TransferFun (CmmLive GlobalReg) #-}