de4c7bacb3834819d252737de2a3800f6acb8af9
[packages/hoopl.git] / testing / Live.hs
1 {-# OPTIONS_GHC -Wall -fno-warn-incomplete-patterns #-}
2 {-# LANGUAGE ScopedTypeVariables, GADTs #-}
3 module Live (liveLattice, liveness, deadAsstElim) where
4
5 import Data.Maybe
6 import qualified Data.Set as S
7
8 import Compiler.Hoopl
9 import IR
10 import OptSupport
11
12 type Live = S.Set Var
13 liveLattice :: DataflowLattice Live
14 liveLattice = DataflowLattice
15 { fact_name = "Live variables"
16 , fact_bot = S.empty
17 , fact_extend = add
18 , fact_do_logging = False
19 }
20 where add _ (OldFact old) (NewFact new) = (ch, j)
21 where
22 j = new `S.union` old
23 ch = changeIf (S.size j > S.size old)
24
25 liveness :: BwdTransfer Insn Live
26 liveness = mkBTransfer' live
27 where
28 live :: Insn e x -> Fact x Live -> Live
29 live (Label _) f = f
30 live n@(Assign x _) f = addUses (S.delete x f) n
31 live n@(Store _ _) f = addUses f n
32 live n@(Branch l) f = addUses (fact f l) n
33 live n@(Cond _ tl fl) f = addUses (fact f tl `S.union` fact f fl) n
34 live n@(Call vs _ _ l) f = addUses (fact f l `S.difference` S.fromList vs) n
35 live n@(Return _) _ = addUses (fact_bot liveLattice) n
36 fact f l = fromMaybe S.empty $ lookupFact l f
37 addUses = fold_EN (fold_EE addVar)
38 addVar s (Var v) = S.insert v s
39 addVar s _ = s
40
41 deadAsstElim :: forall m . Monad m => BwdRewrite m Insn Live
42 deadAsstElim = shallowBwdRw' d
43 where
44 d :: SimpleBwdRewrite' m Insn Live
45 d (Assign x _) live = if x `S.member` live then return Nothing
46 else return $ Just emptyGraph
47 d _ _ = return Nothing