Ticket #3224: CmmLiveZ.hs

File CmmLiveZ.hs, 2.9 KB (added by nr, 5 years ago)

Input file on which the compiler panics.

Line 
1module CmmLiveZ
2    ( CmmLive
3    , cmmLivenessZ
4    , liveLattice
5    , middleLiveness
6    ) 
7where
8
9import BlockId
10import CmmExpr
11import CmmTx
12import DFLattice
13import PprCmm()
14import PprCmmZ()
15import ZDF5ex -- was ZipDataflow
16import ZipCfgCmmRep
17
18import Maybes
19import Outputable
20import 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
27type CmmLive = RegSet
28
29-- | The dataflow lattice
30liveLattice :: DataflowLattice CmmLive
31liveLattice = 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
37type BlockEntryLiveness = BlockEnv CmmLive
38
39-----------------------------------------------------------------------------
40-- | Calculated liveness info for a CmmGraph
41-----------------------------------------------------------------------------
42cmmLivenessZ :: CmmGraph -> BlockEntryLiveness
43cmmLivenessZ g = zdfFpFacts $ check res
44  where res :: CmmBackwardFixedPoint CmmLive
45        res = zdfSolveFromBwd emptyBlockEnv "liveness analysis"
46              liveLattice transfers g
47        transfers = BackwardTransfers (flip const) mid last
48        mid  m = gen_kill m . midLive  m
49        last l = gen_kill l . lastLive l
50        check :: CmmBackwardFixedPoint CmmLive -> CmmBackwardFixedPoint CmmLive
51        check bfp = noLive (bfp_out_fact bfp) bfp
52
53gen_kill :: (DefinerOfLocalRegs a, UserOfLocalRegs a) => a -> CmmLive -> CmmLive
54gen_kill a = gen a . kill a
55
56middleLiveness :: Middle -> CmmLive -> CmmLive
57middleLiveness = gen_kill
58
59-- | On entry to the procedure, there had better not be any LocalReg's live-in.
60noLive :: CmmLive -> a -> a
61noLive in_fact x =
62  if isEmptyUniqSet in_fact then x
63  else pprPanic "LocalReg's live-in to graph" (ppr in_fact)
64
65-- | The transfer equations use the traditional 'gen' and 'kill'
66-- notations, which should be familiar from the dragon book.
67gen  :: UserOfLocalRegs    a => a -> RegSet -> RegSet
68gen  a live = foldRegsUsed    extendRegSet      live a
69kill :: DefinerOfLocalRegs a => a -> RegSet -> RegSet
70kill a live = foldRegsDefd delOneFromUniqSet live a
71
72midLive :: Middle -> CmmLive -> CmmLive
73midLive (MidForeignCall {}) _ = emptyUniqSet
74midLive _                live = live
75
76lastLive :: Last -> (BlockId -> CmmLive) -> CmmLive
77lastLive l env = last l
78  where last (LastBranch id)        = env id
79        last (LastCall _ _  _ _ _)  = emptyUniqSet
80        last (LastCondBranch _ t f) = unionUniqSets (env t) (env f)
81        last (LastSwitch _ tbl)     = unionManyUniqSets $ map env (catMaybes tbl)
82
83can't_match :: a
84can't_match = panic "the GADT pattern matcher is too stupid to live"