Interpret.hs

   1 module Interpret (eval, execute, Value(VInt, VBool)) where
   2
   3 import Abssyntax
   4 import Control.Monad.State
   5 import Data.Map as Map
   6 import Prelude hiding (lookup)
   7
   8 data Value = VInt Integer | VBool Bool deriving Eq
   9
  10 instance Show Value where
  11         show (VInt n) = show n
  12         show (VBool True) = "1"
  13         show (VBool False) = "0"
  14
  15 type Variables = [Map Ident Value]
  16
  17 --eval :: (MonadState Variables m) => Exp -> m Value
  18 eval :: Exp -> StateT Variables IO Value
  19 eval (EBool b) = return (VBool b)
  20 eval (EInt n) = return (VInt n)
  21 eval (EVar i) = getVariableValue i
  22 eval (EAss i e) = setVariableValue i e
  23 eval (BiOpExp e o e') = do
  24         v <- eval e
  25         v'<- eval e'
  26         if elem o [Eq,NEq] then return $ opE o v v'
  27                 else let (VInt n1) = v in let (VInt n2) = v' in return $ op o n1 n2
  28 eval (EPost i o) = do
  29         (VInt n) <- getVariableValue i
  30         let (VInt n') = op o n 1 in setVariableValue i $ EInt n'
  31         return $ VInt n
  32 eval (ENeg e) = do
  33         (VInt n) <- eval e
  34         return $ VInt $ -n
  35 eval (ENot e) = do
  36         (VBool b) <- eval e
  37         return $ VBool $ not b
  38 eval EReadI = do
  39         s <- lift $ getWord
  40         return $ VInt $ read s
  41 eval EReadB = do
  42         s <- lift $ getWord
  43         return $ VBool $ if (read s == 0) then False else True
  44
  45 getWord :: IO String
  46 getWord =  do
  47         c <- getChar
  48         if elem c [' ', '\n', '\t', '\r']
  49                 then return ""
  50                 else do
  51                         l <- getWord
  52                         return (c:l)
  53
  54 -- op :: Op -> (a -> a -> Value)
  55 opE Eq = \e e' -> VBool $ e == e'
  56 opE NEq = \e e' -> VBool $ not (e == e')
  57 op Plus = \e e' -> VInt $ e + e'
  58 op Minus = \e e' -> VInt $ e - e'
  59 op Times = \e e' -> VInt $ e * e'
  60 op Div = \e e' -> VInt $ e `div` e'
  61 op Lt = \e e' -> VBool $ e < e'
  62 op ELt = \e e' -> VBool $ e <= e'
  63 op Gt = \e e' -> VBool $ e > e'
  64 op EGt = \e e' -> VBool $ e >= e'
  65
  66 getVariableValue :: (MonadState Variables m) => Ident -> m Value
  67 getVariableValue i = do
  68         ms <- get
  69         findVariable i ms
  70
  71 findVariable :: (MonadState  Variables m) => Ident -> Variables -> m Value
  72 findVariable i [] = fail $ "Variable "++show i++" not found in any scope."
  73 findVariable i (m:ms) = if member i m then lookup i m else findVariable i ms
  74
  75 --setVariableValue :: (MonadState Variables m) => Ident -> Exp -> m Value
  76 --setVariableValue :: (MonadState Variables m) => Ident -> Exp -> m Value
  77
  78 setVariableValue :: Ident -> Exp -> StateT Variables IO Value
  79 setVariableValue i e = do
  80         v <- eval e
  81         ms <- get
  82         put $ updateVariable i v ms
  83         return v
  84
  85 updateVariable :: Ident -> Value -> Variables -> Variables
  86 updateVariable _ _ [] = []
  87 updateVariable i v (m:ms) = if member i m then insert i v m:ms else m:updateVariable i v ms
  88
  89 pushAndPop :: (MonadState Variables m) => m a -> m ()
  90 pushAndPop s = do
  91         modify (empty:)
  92         s
  93         modify tail
  94
  95 -- execute :: (MonadState Variables m) => Stm -> m ()
  96 execute :: Stm -> StateT Variables IO ()
  97 execute (SNoop) = return ()
  98 execute (SExp e) = eval e >> return ()
  99 execute (SIf b s s') = do
 100         (VBool b') <- eval b
 101         pushAndPop $ if b' then execute s else execute s'
 102 execute (SPrint e) = do
 103         e' <- eval e
 104         lift $ print e'
 105 execute (SBlock ss) = pushAndPop $ mapM execute ss
 106 execute (SWhile e s) = do
 107         (VBool b) <- eval e
 108         if b then pushAndPop (execute s) >> execute (SWhile e s) else return ()
 109 execute (SDeclD t i) = execute $ SDecl t i $ case t of
 110         TInt -> EInt 0
 111         TBool -> EBool False
 112 execute (SDecl t i e) =do
 113         v <- eval e
 114         (m:ms) <- get
 115         put $ (insert i v m):ms