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, MonadError String m, MonadIO m) => Exp -> m Value
  32 eval :: (MonadState State m, MonadIO m) => Exp -> EvalM m Value
  33 eval (EBool b) = return (VBool b)
  34 eval (EInt n) = return (VInt n)
  35 eval (EVar i) = getVariableValue i
  36 eval (EAss i e) = do
  37         v <- eval e
  38         setVariableValue i v
  39 eval (BiOpExp e o e') = do
  40         v <- eval e
  41         v'<- eval e'
  42         if elem o [Eq,NEq] then return $ opE o v v'
  43                 else let (VInt n1) = v in let (VInt n2) = v' in return $ op o n1 n2
  44 eval (EPost i o) = do
  45         (VInt n) <- getVariableValue i
  46         setVariableValue i $ op o n 1
  47         return $ VInt n
  48 eval (ENeg e) = do
  49         (VInt n) <- eval e
  50         return $ VInt $ -n
  51 eval (ENot e) = do
  52         (VBool b) <- eval e
  53         return $ VBool $ not b
  54 eval EReadI = do
  55         s <- liftIO $ getNumber
  56         return $ VInt $ read s
  57 eval EReadB = do
  58         s <- liftIO $ getNumber
  59         return $ VBool $ if (read s == 0) then False else True
  60 eval (EFunc i as) = do
  61         vs <- mapM eval as
  62         state <- get
  63         (ds,ss) <- lookup i $ functions state
  64         let m = foldr (\((Decl t i),v) m -> insert i v m) empty $ zip ds vs
  65                 in modify (\s -> s{variables=[m]})
  66         (mapM_ execute ss >> (fail $ "Function "++show i++" didn't return anything."))
  67                 `catchError` (\_ ->return ()) --Only errors thrown in ErrorT can be caught here, runtime errors pass through, so no need to check the error
  68         state' <- get
  69         put state
  70         return $ ret state'
  71
  72 --Stricter evaluation of the input
  73 getNumber :: IO String
  74 getNumber = do
  75         c <- getChar
  76         if elem c ['-','0'..'9']
  77                 then do
  78                         l <- getNumber2
  79                         return (c:l)
  80                 else fail "Non integer input."
  81
  82 getNumber2 :: IO String
  83 getNumber2 =  do
  84         c <- getChar
  85         if elem c ['0'..'9']
  86                 then do
  87                         l <- getNumber2
  88                         return (c:l)
  89                 else return ""
  90
  91 -- op :: Op -> (a -> a -> Value)
  92 opE Eq = \e e' -> VBool $ e == e'
  93 opE NEq = \e e' -> VBool $ not (e == e')
  94 op Plus = \e e' -> VInt $ e + e'
  95 op Minus = \e e' -> VInt $ e - e'
  96 op Times = \e e' -> VInt $ e * e'
  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 Variables m) => Stm -> m ()
 128 execute :: (MonadState State m, MonadIO m) => Stm -> EvalM m ()
 129 execute (SNoop) = return ()
 130 execute (SExp e) = eval e >> return ()
 131 execute (SIf b s s') = do
 132         (VBool b') <- eval b
 133         pushAndPop $ if b' then execute s else execute s'
 134 execute (SPrint e) = do
 135         e' <- eval e
 136         liftIO $ print e'
 137 execute (SBlock ss) = pushAndPop $ mapM execute ss
 138 execute (SWhile e s) = do
 139         (VBool b) <- eval e
 140         if b then pushAndPop (execute s) >> execute (SWhile e s) else return ()
 141 execute (SDeclD t i) = execute $ SDecl t i $ case t of
 142         TInt -> EInt 0
 143         TBool -> EBool False
 144 execute (SDecl t i e) =do
 145         v <- eval e
 146         state <- get
 147         let (m:ms) = variables state in modify (\s -> s{variables=insert i v m:ms })
 148 execute (SReturn e) = do
 149         v <- eval e
 150         modify (\s -> s{ret=v})
 151         throwError "Returning.."
 152
 153 addFunction :: (MonadState State m) => Func -> m ()
 154 addFunction (Func _ i d ss) = modify (\s -> s{functions=insert i (d,ss) (functions s) })