Add DEBUG-only flag -dsuppress-uniques to suppress printing of uniques
[ghc-hetmet.git] / compiler / cmm / CmmLiveZ.hs
1
2 module CmmLiveZ
3     ( CmmLive
4     , cmmLivenessZ
5     , liveLattice
6     , middleLiveness, lastLiveness
7     ) 
8 where
9
10 import Cmm
11 import CmmExpr
12 import CmmTx
13 import DFMonad
14 import PprCmm()
15 import PprCmmZ()
16 import ZipDataflow0
17 import ZipCfgCmmRep
18
19 import Maybes
20 import UniqSet
21
22 -----------------------------------------------------------------------------
23 -- Calculating what variables are live on entry to a basic block
24 -----------------------------------------------------------------------------
25
26 -- | The variables live on entry to a block
27 type CmmLive = RegSet
28
29 -- | The dataflow lattice
30 liveLattice :: DataflowLattice CmmLive
31 liveLattice = DataflowLattice "live LocalReg's" emptyUniqSet add False
32     where add new old =
33             let join = unionUniqSets new old in
34             (if sizeUniqSet join > sizeUniqSet old then aTx else noTx) join
35
36 -- | A mapping from block labels to the variables live on entry
37 type BlockEntryLiveness = BlockEnv CmmLive
38
39 -----------------------------------------------------------------------------
40 -- | Calculated liveness info for a CmmGraph
41 -----------------------------------------------------------------------------
42 cmmLivenessZ :: CmmGraph -> BlockEntryLiveness
43 cmmLivenessZ g = env
44     where env = runDFA liveLattice $ do { run_b_anal transfer g; allFacts }
45           transfer     = BComp "liveness analysis" exit last middle first
46           exit         = emptyUniqSet
47           first live _ = live
48           middle       = flip middleLiveness
49           last         = flip lastLiveness
50
51 -- | The transfer equations use the traditional 'gen' and 'kill'
52 -- notations, which should be familiar from the dragon book.
53 gen, kill :: UserOfLocalRegs a => a -> RegSet -> RegSet
54 gen  a live = foldRegsUsed extendRegSet      live a
55 kill a live = foldRegsUsed delOneFromUniqSet live a
56
57 middleLiveness :: Middle -> CmmLive -> CmmLive
58 middleLiveness m = middle m
59   where middle (MidComment {})               = id
60         middle (MidAssign lhs expr)          = gen expr . kill lhs
61         middle (MidStore addr rval)          = gen addr . gen rval
62         middle (MidUnsafeCall tgt ress args) = gen tgt . gen args . kill ress
63         middle (MidAddToContext ra args)     = gen ra . gen args
64         middle (CopyIn _ formals _)          = kill formals
65         middle (CopyOut _ actuals)           = gen actuals
66
67 lastLiveness :: Last -> (BlockId -> CmmLive) -> CmmLive
68 lastLiveness l env = last l
69   where last (LastReturn)            = emptyUniqSet
70         last (LastJump e)            = gen e $ emptyUniqSet
71         last (LastBranch id)         = env id
72         last (LastCall tgt (Just k)) = gen tgt $ env k
73         last (LastCall tgt Nothing)  = gen tgt $ emptyUniqSet
74         last (LastCondBranch e t f)  = gen e $ unionUniqSets (env t) (env f)
75         last (LastSwitch e tbl) = gen e $ unionManyUniqSets $ map env (catMaybes tbl)