X-Git-Url: https://ruin.nu/git/?a=blobdiff_plain;f=Interpret.hs;h=b82398d22bc63b114eb0d5c6f7f344f80cd34c31;hb=8fdc0177fdf518f63819e5b98dd0368fccca6175;hp=9e4dcff34541b1f180b73b3c12dc15cbcfb3e642;hpb=4f21d932178a490040cf5e054f3ba9d006579368;p=proglang.git diff --git a/Interpret.hs b/Interpret.hs index 9e4dcff..b82398d 100644 --- a/Interpret.hs +++ b/Interpret.hs @@ -1,29 +1,34 @@ -module Interpret (eval, execute, Value(VInt, VBool)) where +module Interpret (eval, execute,addFunction, emptyState, Value(..), State(..)) where import Abssyntax -import Control.Monad.State +import Control.Monad.State hiding (State) import Data.Map as Map import Prelude hiding (lookup) +emptyState = State{variables=[empty], functions=(empty)} + data Value = VInt Integer | VBool Bool deriving Eq instance Show Value where show (VInt n) = show n - show (VBool b) = show b + show (VBool True) = "1" + show (VBool False) = "0" type Variables = [Map Ident Value] +type Function = ([Decl],[Stm]) + +data State = State {variables::Variables,functions::(Map Ident Function)} inList :: Eq a => a -> [a] -> Bool inList _ [] = False inList a (x:xs) = if a == x then True else inList a xs --eval :: (MonadState Variables m) => Exp -> m Value -eval :: Exp -> StateT Variables IO Value +eval :: Exp -> StateT State IO Value eval (EBool b) = return (VBool b) eval (EInt n) = return (VInt n) eval (EVar i) = getVariableValue i -eval (EAss i e) = setVariableValue i e -eval EDefault = error "EDefault called from an illegal place" +eval (EAss i e) = setVariableValue i e eval (BiOpExp e o e') = do v <- eval e v'<- eval e' @@ -44,78 +49,79 @@ eval EReadI = do return $ VInt $ read s eval EReadB = do s <- lift $ getWord - return $ VBool $ read s + return $ VBool $ if (read s == 0) then False else True getWord :: IO String getWord = do c <- getChar - if inList c ['\n','\r',' ', '\t'] + if inList c [' ', '\n', '\t', '\r'] then return "" else do l <- getWord - return (c:l) + return (c:l) -- op :: Op -> (a -> a -> Value) opE Eq = \e e' -> VBool $ e == e' opE NEq = \e e' -> VBool $ not (e == e') op Plus = \e e' -> VInt $ e + e' -op Minus = \e e' -> VInt $ e - e' -op Times = \e e' -> VInt $ e * e' -op Div = \e e' -> VInt $ e `div` e' +op Minus = \e e' -> VInt $ e - e' +op Times = \e e' -> VInt $ e * e' +op Div = \e e' -> VInt $ e `div` e' op Lt = \e e' -> VBool $ e < e' op ELt = \e e' -> VBool $ e <= e' op Gt = \e e' -> VBool $ e > e' op EGt = \e e' -> VBool $ e >= e' -getVariableValue :: (MonadState Variables m) => Ident -> m Value +getVariableValue :: (MonadState State m) => Ident -> m Value getVariableValue i = do - ms <- get - findVariable i ms + s <- get + findVariable i $ variables s -findVariable :: (MonadState Variables m) => Ident -> Variables -> m Value +findVariable :: (MonadState State m) => Ident -> Variables -> m Value findVariable i [] = fail $ "Variable "++show i++" not found in any scope." findVariable i (m:ms) = if member i m then lookup i m else findVariable i ms --setVariableValue :: (MonadState Variables m) => Ident -> Exp -> m Value --setVariableValue :: (MonadState Variables m) => Ident -> Exp -> m Value -addVariable :: Ident -> Exp -> StateT Variables IO () -addVariable i e = do - e' <- eval e - (m:ms) <- get - put $ (insert i e' m):ms -setVariableValue :: Ident -> Exp -> StateT Variables IO Value +setVariableValue :: Ident -> Exp -> StateT State IO Value setVariableValue i e = do v <- eval e - ms <- get - put $ updateVariable i v ms + state <- get + modify (\s -> s{variables= updateVariable i v $ variables state} ) return v updateVariable :: Ident -> Value -> Variables -> Variables updateVariable _ _ [] = [] updateVariable i v (m:ms) = if member i m then insert i v m:ms else m:updateVariable i v ms +pushAndPop :: (MonadState State m) => m a -> m () +pushAndPop s = do + modify (\s -> s { variables = empty:variables s}) + s + modify (\s -> s { variables = tail $ variables s}) -- execute :: (MonadState Variables m) => Stm -> m () -execute :: Stm -> StateT Variables IO () +execute :: Stm -> StateT State IO () execute (SNoop) = return () execute (SExp e) = eval e >> return () execute (SIf b s s') = do (VBool b') <- eval b - if b' then execute s else execute s' + pushAndPop $ if b' then execute s else execute s' execute (SPrint e) = do e' <- eval e lift $ print e' -execute (SBlock ss) = do - modify (empty:) - mapM execute ss - modify tail +execute (SBlock ss) = pushAndPop $ mapM execute ss execute (SWhile e s) = do (VBool b) <- eval e - if b then execute s >> execute (SWhile e s) else return () -execute (SDecl t i EDefault) = do - case t of - TInt -> addVariable i (EInt 0) - TBool -> addVariable i (EBool False) - return () -execute (SDecl t i e) = addVariable i e >> return () + if b then pushAndPop (execute s) >> execute (SWhile e s) else return () +execute (SDeclD t i) = execute $ SDecl t i $ case t of + TInt -> EInt 0 + TBool -> EBool False +execute (SDecl t i e) =do + v <- eval e + state <- get + let (m:ms) = variables state in modify (\s -> s{variables=insert i v m:ms }) + +addFunction :: (MonadState State m) => Func -> m () +addFunction (Func _ i d ss) = modify (\s -> s{functions=insert i (d,ss) (functions s) })