0c53e83b424b6ebcbc50f61854af6b821799f000
[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 Control.Monad
6 import Compiler.Hoopl
7 import IR
8 import OptSupport
9
10 type Node = Insn
11
12
13 -- @ start cprop.tex
14
15 --------------------------------------------------
16 -- Simplification ("constant folding")
17 simplify :: FuelMonad m => FwdRewrite m Node f
18 simplify = deepFwdRw simp
19 where
20 simp node _ = return $ liftM nodeToG $ s_node node
21 s_node :: Node e x -> Maybe (Node e x)
22 s_node (Cond (Lit (Bool b)) t f)
23 = Just $ Branch (if b then t else f)
24 s_node n = (mapEN . mapEE) s_exp n
25 s_exp (Binop Add (Lit (Int n1)) (Lit (Int n2)))
26 = Just $ Lit $ Int $ n1 + n2
27 -- ... more cases for constant folding
28 -- @ end cprop.tex
29 s_exp (Binop opr e1 e2)
30 | (Just op, Lit (Int i1), Lit (Int i2)) <- (intOp opr, e1, e2) =
31 Just $ Lit $ Int $ op i1 i2
32 | (Just op, Lit (Int i1), Lit (Int i2)) <- (cmpOp opr, e1, e2) =
33 Just $ Lit $ Bool $ op i1 i2
34 s_exp _ = Nothing
35 intOp Add = Just (+)
36 intOp Sub = Just (-)
37 intOp Mul = Just (*)
38 intOp Div = Just div
39 intOp _ = Nothing
40 cmpOp Eq = Just (==)
41 cmpOp Ne = Just (/=)
42 cmpOp Gt = Just (>)
43 cmpOp Lt = Just (<)
44 cmpOp Gte = Just (>=)
45 cmpOp Lte = Just (<=)
46 cmpOp _ = Nothing
47 nodeToG = insnToG