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)}
  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::(MVar Value)}
  23
  24 interpret :: [Func] -> [Stm] -> IO ()
  25 interpret fun st = do
  26         mv <- newEmptyMVar
  27         runStateT (do mapM Interpret.addFunction fun; mapM execute st) emptyState{ret=mv}
  28         return ()
  29
  30 --eval :: (MonadState Variables m) => Exp -> m Value
  31 eval :: Exp -> StateT State IO 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) = setVariableValue i e
  36 eval (BiOpExp e o e') = do
  37         v <- eval e
  38         v'<- eval e'
  39         if elem o [Eq,NEq] then return $ opE o v v'
  40                 else let (VInt n1) = v in let (VInt n2) = v' in return $ op o n1 n2
  41 eval (EPost i o) = do
  42         (VInt n) <- getVariableValue i
  43         let (VInt n') = op o n 1 in setVariableValue i $ EInt n'
  44         return $ VInt n
  45 eval (ENeg e) = do
  46         (VInt n) <- eval e
  47         return $ VInt $ -n
  48 eval (ENot e) = do
  49         (VBool b) <- eval e
  50         return $ VBool $ not b
  51 eval EReadI = do
  52         s <- lift $ getWord
  53         return $ VInt $ read s
  54 eval EReadB = do
  55         s <- lift $ getWord
  56         return $ VBool $ if (read s == 0) then False else True
  57 eval (EFunc i as) = do
  58         vs <- mapM eval as
  59         state <- get
  60         (ds,ss) <- lookup i $ functions state
  61         let m = foldr (\((Decl t i),v) m -> insert i v m) empty $ zip ds vs
  62                 in modify (\s -> s{variables=[m]})
  63         mapM_ execute ss `catchError` (\_ -> return ())
  64         v <- lift $ takeMVar $ ret state
  65         put state
  66         return v
  67
  68 getWord :: IO String
  69 getWord =  do
  70         c <- getChar
  71         if elem c [' ', '\n', '\t', '\r']
  72                 then return ""
  73                 else do
  74                         l <- getWord
  75                         return (c:l)
  76
  77 -- op :: Op -> (a -> a -> Value)
  78 opE Eq = \e e' -> VBool $ e == e'
  79 opE NEq = \e e' -> VBool $ not (e == e')
  80 op Plus = \e e' -> VInt $ e + e'
  81 op Minus = \e e' -> VInt $ e - e'
  82 op Times = \e e' -> VInt $ e * e'
  83 op Div = \e e' -> VInt $ e `div` e'
  84 op Lt = \e e' -> VBool $ e < e'
  85 op ELt = \e e' -> VBool $ e <= e'
  86 op Gt = \e e' -> VBool $ e > e'
  87 op EGt = \e e' -> VBool $ e >= e'
  88
  89 getVariableValue :: (MonadState State m) => Ident -> m Value
  90 getVariableValue i = do
  91         s <- get
  92         findVariable i $ variables s
  93
  94 findVariable :: (MonadState State m) => Ident -> Variables -> m Value
  95 findVariable i [] = fail $ "Variable "++show i++" not found in any scope."
  96 findVariable i (m:ms) = if member i m then lookup i m else findVariable i ms
  97
  98 --setVariableValue :: (MonadState Variables m) => Ident -> Exp -> m Value
  99 --setVariableValue :: (MonadState Variables m) => Ident -> Exp -> m Value
 100
 101 setVariableValue :: Ident -> Exp -> StateT State IO Value
 102 setVariableValue i e = do
 103         v <- eval e
 104         state <- get
 105         modify (\s -> s{variables= updateVariable i v $ variables state} )
 106         return v
 107
 108 updateVariable :: Ident -> Value -> Variables -> Variables
 109 updateVariable _ _ [] = []
 110 updateVariable i v (m:ms) = if member i m then insert i v m:ms else m:updateVariable i v ms
 111
 112 pushAndPop :: (MonadState State m) => m a -> m ()
 113 pushAndPop s = do
 114         modify (\s -> s { variables = empty:variables s})
 115         s
 116         modify (\s -> s { variables = tail $ variables s})
 117
 118 -- execute :: (MonadState Variables m) => Stm -> m ()
 119 execute :: Stm -> StateT State IO ()
 120 execute (SNoop) = return ()
 121 execute (SExp e) = eval e >> return ()
 122 execute (SIf b s s') = do
 123         (VBool b') <- eval b
 124         pushAndPop $ if b' then execute s else execute s'
 125 execute (SPrint e) = do
 126         e' <- eval e
 127         lift $ print e'
 128 execute (SBlock ss) = pushAndPop $ mapM execute ss
 129 execute (SWhile e s) = do
 130         (VBool b) <- eval e
 131         if b then pushAndPop (execute s) >> execute (SWhile e s) else return ()
 132 execute (SDeclD t i) = execute $ SDecl t i $ case t of
 133         TInt -> EInt 0
 134         TBool -> EBool False
 135 execute (SDecl t i e) =do
 136         v <- eval e
 137         state <- get
 138         let (m:ms) = variables state in modify (\s -> s{variables=insert i v m:ms })
 139 execute (SReturn e) = do
 140         v <- eval e
 141         s <- get
 142         lift $ putMVar (ret s) v
 143         throwError $ userError "Returning.."
 144
 145 addFunction :: (MonadState State m) => Func -> m ()
 146 addFunction (Func _ i d ss) = modify (\s -> s{functions=insert i (d,ss) (functions s) })