scratch/Analysis.hs

   1 module Analysis where
   2
   3 import Control.Monad.State
   4
   5 type Addr = Int
   6
   7 data StackIL = Dup | Ld Addr Type | Add Type | Store Addr Type
   8
   9 type Target = (Int,Type)
  10 type Source = (Int,Type)
  11
  12 tmpReg = 10
  13
  14 data RegIL = RMov Target Source | RAdd Target Source Source
  15              | RStore Addr Source | RLoad Source Addr deriving Show
  16
  17 data Type = Int | Bottom deriving (Show,Eq)
  18
  19 type StackElem = (Int,Type)
  20
  21 type Stack = [StackElem]
  22
  23 dup :: State Stack ()
  24 dup = modify (\(top@(i,t):x) -> (i+1,t) : top : xs)
  25
  26 push :: Type -> State Stack Int
  27 push t = do tos <- get
  28             case tos of
  29               top@(i,_):xs -> put ((i + 1, t) : top : xs) >> return i
  30               [] -> put [(0,t)] >> return 0
  31
  32 pop :: State Stack StackElem
  33 pop = do x:xs <- get
  34          put xs
  35          return x
  36
  37 nextElem :: State Stack Int
  38 nextElem = fmap ((+ 1) . fst . head) get
  39
  40 aInterpret' :: StackIL -> State Stack [RegIL]
  41 aInterpret' Dup = dup >> return []
  42 aInterpret' (Ld addr t) = do s <- push t
  43                              return [RLoad (s,t) addr]
  44 aInterpret' (Store addr t) = do (xA,tA) <- pop
  45                                 return [RStore addr (xA,tA)]
  46 aInterpret' (Add t) = do (iA,ta) <- pop
  47                          (iB,tb) <- pop
  48                          push ta
  49                          if ta /= t || tb /=t then error "type mismatch in add"
  50                             else return [ RAdd (tmpReg,ta) (iA,ta) (iB,tb),
  51                                           RMov (iB,tb) (tmpReg,ta)]
  52
  53 aInterpret :: [StackIL] -> State Stack [RegIL]
  54 aInterpret = foldr (liftM2 (++) . aInterpret') (return [])
  55
  56 generateRegisterIR :: [StackIL] -> [RegIL]
  57 generateRegisterIR = (`evalState` []) . aInterpret
  58
  59 --data StackIL = Dup | Ld Addr Type | Add Type | Store Addr Type
  60 testCase1 = [ Ld 0 Int, Ld 1 Int, Dup , Add Int, Add Int, Store 0 Int]