1 module Interpret (interpret, eval, execute,addFunction, emptyState, Value(..), State(..)) where
4 import Control.Monad.State hiding (State)
5 import Control.Monad.Error
6 import Control.Concurrent.MVar
8 import Prelude hiding (lookup)
10 emptyState = State{variables=[empty], functions=(empty), ret=(VInt 0)}
12 data Value = VInt Integer | VBool Bool deriving Eq
14 instance Show Value where
15 show (VInt n) = show n
16 show (VBool True) = "1"
17 show (VBool False) = "0"
19 type Variables = [Map Ident Value]
20 type Function = ([Decl],[Stm])
22 data State = State {variables::Variables,functions::(Map Ident Function),ret::Value}
24 type EvalM m = ErrorT String m
26 interpret :: [Func] -> [Stm] -> IO ()
28 runStateT (runErrorT (do mapM addFunction fun; mapM_ execute st)) emptyState
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
38 eval (BiOpExp e o e') = do
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
44 (VInt n) <- getVariableValue i
45 setVariableValue i $ op o n 1
52 return $ VBool $ not b
54 s <- liftIO $ getNumber
55 return $ VInt $ read s
57 s <- liftIO $ getNumber
58 return $ VBool $ if (read s == 0) then False else True
59 eval (EFunc i as) = do
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
71 --Stricter evaluation of the input
72 getNumber :: IO String
75 if elem c $ '-':['0'..'9']
79 else fail "Non integer input."
81 getNumber2 :: IO String
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'
103 getVariableValue :: (MonadState State m) => Ident -> m Value
104 getVariableValue i = do
106 findVariable i $ variables s
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
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} )
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
121 pushAndPop :: (MonadState State m) => m a -> m ()
123 modify (\s -> s { variables = empty:variables s})
125 modify (\s -> s { variables = tail $ variables s})
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
132 pushAndPop $ if b' then execute s else execute s'
133 execute (SPrint e) = do
136 execute (SBlock ss) = pushAndPop $ mapM execute ss
137 execute (SWhile e s) = do
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
143 execute (SDecl t i e) =do
145 (m:ms) <- liftM variables get
146 modify (\s -> s{variables=insert i v m:ms })
147 execute (SReturn e) = do
149 modify (\s -> s{ret=v})
150 throwError "Returning.."
152 addFunction :: (MonadState State m) => Func -> m ()
153 addFunction (Func _ i d ss) = modify (\s -> s{functions=insert i (d,ss) (functions s) })