Interpret.hs

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