Make Hoopl work with MonoLocalBinds.
[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_join = add
18 }
19 where add _ (OldFact old) (NewFact new) = (ch, j)
20 where
21 j = new `S.union` old
22 ch = changeIf (S.size j > S.size old)
23
24 liveness :: BwdTransfer Insn Live
25 liveness = mkBTransfer live
26 where
27 live :: Insn e x -> Fact x Live -> Live
28 live (Label _) f = f
29 live n@(Assign x _) f = addUses (S.delete x f) n
30 live n@(Store _ _) f = addUses f n
31 live n@(Branch l) f = addUses (fact f l) n
32 live n@(Cond _ tl fl) f = addUses (fact f tl `S.union` fact f fl) n
33 live n@(Call vs _ _ l) f = addUses (fact f l `S.difference` S.fromList vs) n
34 live n@(Return _) _ = addUses (fact_bot liveLattice) n
35
36 fact :: FactBase (S.Set Var) -> Label -> Live
37 fact f l = fromMaybe S.empty $ lookupFact l f
38
39 addUses :: S.Set Var -> Insn e x -> Live
40 addUses = fold_EN (fold_EE addVar)
41 addVar s (Var v) = S.insert v s
42 addVar s _ = s
43
44 deadAsstElim :: forall m . FuelMonad m => BwdRewrite m Insn Live
45 deadAsstElim = mkBRewrite d
46 where
47 d :: Insn e x -> Fact x Live -> m (Maybe (Graph Insn e x))
48 d (Assign x _) live
49 | not (x `S.member` live) = return $ Just emptyGraph
50 d _ _ = return Nothing