Interpret.hs

   1 module Interpret (interpret, eval, execute,addFunction, emptyState, Value(..), State(..)) where
   2
   3 import Abssyntax
   4 import Control.Monad.State hiding (State)
   5 import Control.Monad.Error
   6 import Control.Concurrent.MVar
   7 import Data.Map as Map
   8 import Prelude hiding (lookup)
   9
  10 emptyState = State{variables=[empty], functions=(empty), ret=(VInt 0)}
  11
  12 data Value = VInt Integer | VBool Bool deriving Eq
  13
  14 instance Show Value where
  15         show (VInt n) = show n
  16         show (VBool True) = "1"
  17         show (VBool False) = "0"
  18
  19 type Variables = [Map Ident Value]
  20 type Function = ([Decl],[Stm])
  21
  22 data State = State {variables::Variables,functions::(Map Ident Function),ret::Value}
  23
  24 type EvalM m = ErrorT String m
  25
  26 interpret :: [Func] -> [Stm] -> IO ()
  27 interpret fun st = do
  28         runStateT (runErrorT  (do mapM addFunction fun; mapM_ execute st)) emptyState
  29         return ()
  30
  31 eval :: (MonadState State m, MonadIO m) => Exp -> EvalM m Value
  32 eval (EBool b) = return (VBool b)
  33 eval (EInt n) = return (VInt n)
  34 eval (EVar i) = getVariableValue i
  35 eval (EAss i e) = do
  36         v <- eval e
  37         setVariableValue i v
  38 eval (BiOpExp e o e') = do
  39         v <- eval e
  40         v'<- eval e'
  41         if elem o [Eq,NEq] then return $ opE o v v'
  42                 else let (VInt n1) = v in let (VInt n2) = v' in return $! op o n1 n2
  43 eval (EPost i o) = do
  44         (VInt n) <- getVariableValue i
  45         setVariableValue i $ op o n 1
  46         return $ VInt n
  47 eval (ENeg e) = do
  48         (VInt n) <- eval e
  49         return $ VInt $ -n
  50 eval (ENot e) = do
  51         (VBool b) <- eval e
  52         return $ VBool $ not b
  53 eval EReadI = do
  54         s <- liftIO $ getNumber
  55         return $ VInt $ read s
  56 eval EReadB = do
  57         s <- liftIO $ getNumber
  58         return $ VBool $ if (read s == 0) then False else True
  59 eval (EFunc i as) = do
  60         vs <- mapM eval as
  61         state <- get
  62         (ds,ss) <- lookup i $ functions state
  63         let m = foldr (\((Decl t i),v) m -> insert i v m) empty $ zip ds vs
  64                 in modify (\s -> s{variables=[m]})
  65         (mapM_ execute ss >> (fail $ "Function "++show i++" didn't return anything."))
  66                 `catchError` (\_ ->return ()) --Only errors thrown in ErrorT can be caught here, runtime errors pass through, so no need to check the error
  67         v <- liftM ret get
  68         put state
  69         return v
  70
  71 --Stricter evaluation of the input
  72 getNumber :: IO String
  73 getNumber = do
  74         c <- getChar
  75         if elem c $ '-':['0'..'9']
  76                 then do
  77                         l <- getNumber2
  78                         return (c:l)
  79                 else fail "Non integer input."
  80
  81 getNumber2 :: IO String
  82 getNumber2 =  do
  83         c <- getChar
  84         if elem c ['0'..'9']
  85                 then do
  86                         l <- getNumber2
  87                         return (c:l)
  88                 else return ""
  89
  90 -- op :: Op -> (a -> a -> Value)
  91 opE Eq e e' = VBool $ e == e'
  92 opE NEq e e' = VBool $ not (e == e')
  93 op Plus e e' =VInt $ e + e'
  94 op Minus e e' = VInt $ e - e'
  95 op Times e e' = VInt $ e * e'
  96 op Div _ 0 = error "Division by zero"
  97 op Div e e' = VInt $ e `div` e'
  98 op Lt e e' = VBool $ e < e'
  99 op ELt e e' = VBool $ e <= e'
 100 op Gt e e' = VBool $ e > e'
 101 op EGt e e' = VBool $ e >= e'
 102
 103 getVariableValue :: (MonadState State m) => Ident -> m Value
 104 getVariableValue i = do
 105         s <- get
 106         findVariable i $ variables s
 107
 108 findVariable :: (Monad m) => Ident -> Variables -> m Value
 109 findVariable i [] = fail $ "Variable "++show i++" not found in any scope."
 110 findVariable i (m:ms) = if member i m then lookup i m else findVariable i ms
 111
 112 setVariableValue :: (MonadState State m) => Ident -> Value -> EvalM m Value
 113 setVariableValue i v = do
 114         modify (\s -> s{variables= updateVariable i v $ variables s} )
 115         return v
 116
 117 updateVariable :: Ident -> Value -> Variables -> Variables
 118 updateVariable _ _ [] = []
 119 updateVariable i v (m:ms) = if member i m then insert i v m:ms else m:updateVariable i v ms
 120
 121 pushAndPop :: (MonadState State m) => m a -> m ()
 122 pushAndPop s = do
 123         modify (\s -> s { variables = empty:variables s})
 124         s
 125         modify (\s -> s { variables = tail $ variables s})
 126
 127 execute :: (MonadState State m, MonadIO m) => Stm -> EvalM m ()
 128 execute (SNoop) = return ()
 129 execute (SExp e) = eval e >> return ()
 130 execute (SIf b s s') = do
 131         (VBool b') <- eval b
 132         pushAndPop $ if b' then execute s else execute s'
 133 execute (SPrint e) = do
 134         e' <- eval e
 135         liftIO $ print e'
 136 execute (SBlock ss) = pushAndPop $ mapM execute ss
 137 execute (SWhile e s) = do
 138         (VBool b) <- eval e
 139         if b then pushAndPop (execute s) >> execute (SWhile e s) else return ()
 140 execute (SDeclD t i) = execute $ SDecl t i $ case t of
 141         TInt -> EInt 0
 142         TBool -> EBool False
 143 execute (SDecl t i e) =do
 144         v <- eval e
 145         (m:ms) <- liftM variables get
 146         modify (\s -> s{variables=insert i v m:ms })
 147 execute (SReturn e) = do
 148         v <- eval e
 149         modify (\s -> s{ret=v})
 150         throwError "Returning.."
 151
 152 addFunction :: (MonadState State m) => Func -> m ()
 153 addFunction (Func _ i d ss) = modify (\s -> s{functions=insert i (d,ss) (functions s) })