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