Constant-propagation figure is now extracted automatically from John's code; some...
[packages/hoopl.git] / testing / Simplify.hs
1 {-# OPTIONS_GHC -Wall -fwarn-incomplete-patterns #-}
2 {-# LANGUAGE ScopedTypeVariables, GADTs, PatternGuards #-}
3 module Simplify (simplify) where
4
5 import Compiler.Hoopl
6 import IR
7 import OptSupport
8
9 type Node = Insn
10
11
12 -- @ start cprop.tex
13
14 --------------------------------------------------
15 -- Simplification ("constant folding")
16 simplify :: Monad m => FwdRewrite m Node f
17 simplify = deepFwdRw simp
18 where
19 simp node _ = return $ fmap nodeToG $ s_node node
20 s_node :: Node e x -> Maybe (Node e x)
21 s_node (Cond (Lit (Bool b)) t f)
22 = Just $ Branch (if b then t else f)
23 s_node n = mapE s_exp n
24 s_exp (Binop Add (Lit (Int n1)) (Lit (Int n2)))
25 = Just $ Lit $ Int $ n1 + n2
26 -- ... more cases for constant folding
27 -- @ end cprop.tex
28 s_exp (Binop opr e1 e2)
29 | (Just op, Lit (Int i1), Lit (Int i2)) <- (intOp opr, e1, e2) =
30 Just $ Lit $ Int $ op i1 i2
31 | (Just op, Lit (Int i1), Lit (Int i2)) <- (cmpOp opr, e1, e2) =
32 Just $ Lit $ Bool $ op i1 i2
33 s_exp _ = Nothing
34 intOp Add = Just (+)
35 intOp Sub = Just (-)
36 intOp Mul = Just (*)
37 intOp Div = Just div
38 intOp _ = Nothing
39 cmpOp Eq = Just (==)
40 cmpOp Ne = Just (/=)
41 cmpOp Gt = Just (>)
42 cmpOp Lt = Just (<)
43 cmpOp Gte = Just (>=)
44 cmpOp Lte = Just (<=)
45 cmpOp _ = Nothing
46 nodeToG = insnToG
47
48 -- @ start cprop.tex
49
50 -- Rewriting expressions
51 mapE :: (Expr -> Maybe Expr)
52 -> (Node e x -> Maybe (Node e x))
53 mapE _ (Label _) = Nothing
54 mapE f (Assign x e) = fmap (Assign x) $ f e
55 -- ... more cases for rewriting expressions
56 -- @ end cprop.tex
57 mapE f n = (map_EN . map_EE) f n