scratch/Analysis.hs

   1 {-# LANGUAGE GADTs #-}
   2 module Analysis where
   3
   4 import Compiler.Hoopl
   5 import Control.Monad.State
   6
   7 type Addr = Int
   8
   9 data StackIL = Dup | Ld Addr Type | Add Type | Store Addr Type deriving Show
  10
  11 type Target = (Int,Type)
  12 type Source = (Int,Type)
  13
  14 tmpReg = 10
  15
  16 data RegIL = RMov Target Source | RAdd Target Source Source
  17              | RStore Addr Source | RLoad Source Addr deriving Show
  18
  19 data Type = Int | Bottom deriving (Show,Eq)
  20
  21 type StackElem = (Int,Type)
  22
  23 type Stack = [StackElem]
  24
  25 dup :: State Stack ()
  26 dup = modify (\(top@(i,t):xs) -> (i+1,t) : top : xs)
  27
  28 push :: Type -> State Stack Int
  29 push t = do tos <- get
  30             case tos of
  31               top@(i,_):xs -> put ((i + 1, t) : top : xs) >> return i
  32               [] -> put [(0,t)] >> return 0
  33
  34 pop :: State Stack StackElem
  35 pop = do x:xs <- get
  36          put xs
  37          return x
  38
  39 nextElem :: State Stack Int
  40 nextElem = fmap ((+ 1) . fst . head) get
  41
  42 aInterpret' :: StackIL -> State Stack [RegIL]
  43 aInterpret' Dup = dup >> return []
  44 aInterpret' (Ld addr t) = do s <- push t
  45                              return [RLoad (s,t) addr]
  46 aInterpret' (Store addr t) = do (xA,tA) <- pop
  47                                 return [RStore addr (xA,tA)]
  48 aInterpret' (Add t) = do (iA,ta) <- pop
  49                          (iB,tb) <- pop
  50                          push ta
  51                          if ta /= t || tb /=t then error "type mismatch in add"
  52                             else return [ RAdd (tmpReg,ta) (iA,ta) (iB,tb),
  53                                           RMov (iB,tb) (tmpReg,ta)]
  54
  55 aInterpret :: [StackIL] -> State Stack [RegIL]
  56 aInterpret = foldr (liftM2 (++) . aInterpret') (return [])
  57
  58 generateRegisterIR :: [StackIL] -> [RegIL]
  59 generateRegisterIR = (`evalState` []) . aInterpret
  60
  61 --data StackIL = Dup | Ld Addr Type | Add Type | Store Addr Type
  62 testCase1 =  [ Ld 0 Int, Ld 1 Int, Dup , Add Int, Add Int, Store 0 Int]
  63
  64 bench = concat . replicate 100000
  65
  66 type TLabel = Int
  67 type Var = String
  68 data Expr = VarE Var | AddE Var Var | Lit Int | CLe Expr Expr
  69
  70 data Node e x where
  71   Label  :: TLabel -> Node C O
  72   Assign :: Var -> Expr -> Node O O
  73   If :: Expr -> TLabel -> TLabel -> Node O C
  74   Ret :: Node O C
  75   Nop :: Node O O
  76   Branch :: TLabel -> Node C C
  77
  78 {-testProgram = [ Assign "x" (Lit 3),
  79                 Assign "y" (Lit 5),
  80                 If (CLe (VarE "x") (VarE "y")) 1 2,
  81                 Assign "x" (VarE "y")
  82                 ] -}
  83
  84