Make Hoopl work with MonoLocalBinds.
[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 :: forall m f. FuelMonad m => FwdRewrite m Node f
18 simplify = deepFwdRw simp
19 where
20 simp :: forall e x. Node e x -> f -> m (Maybe (Graph Node e x))
21 simp node _ = return $ liftM insnToG $ s_node node
22 s_node :: Node e x -> Maybe (Node e x)
23 s_node (Cond (Lit (Bool b)) t f)
24 = Just $ Branch (if b then t else f)
25 s_node n = (mapEN . mapEE) s_exp n
26 s_exp (Binop Add (Lit (Int n1)) (Lit (Int n2)))
27 = Just $ Lit $ Int $ n1 + n2
28 -- ... more cases for constant folding
29 -- @ end cprop.tex
30 s_exp (Binop opr e1 e2)
31 | (Just op, Lit (Int i1), Lit (Int i2)) <- (intOp opr, e1, e2) =
32 Just $ Lit $ Int $ op i1 i2
33 | (Just op, Lit (Int i1), Lit (Int i2)) <- (cmpOp opr, e1, e2) =
34 Just $ Lit $ Bool $ op i1 i2
35 s_exp _ = Nothing
36 intOp Add = Just (+)
37 intOp Sub = Just (-)
38 intOp Mul = Just (*)
39 intOp Div = Just div
40 intOp _ = Nothing
41 cmpOp Eq = Just (==)
42 cmpOp Ne = Just (/=)
43 cmpOp Gt = Just (>)
44 cmpOp Lt = Just (<)
45 cmpOp Gte = Just (>=)
46 cmpOp Lte = Just (<=)
47 cmpOp _ = Nothing