initial commit of interpreter

diff --git a/Interpret.hs b/Interpret.hs
new file mode 100644 (file)
index 0000000..f1c8206
--- /dev/null
+++ b/Interpret.hs
@@ -0,0 +1,83 @@
+module Interpret (eval, execute, Value(VInt, VBool)) where
+
+import Abssyntax
+import Control.Monad.State
+import Data.Map as Map
+import Prelude hiding (lookup)
+
+data Value = VInt Integer | VBool Bool deriving Eq
+
+instance Show Value where
+       show (VInt n) = show n
+       show (VBool b) = show b
+
+type Variables = [Map Ident Value]
+
+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 (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 = return (VInt 0) --FIXME!!!
+eval (BiOpExp e o e') = do
+       v <- eval e
+       v'<- eval e'
+       if inList o [Eq,NEq] then return $ opE o v v'
+               else let (VInt n1) = v in let (VInt n2) = v' in return $ op o n1 n2
+typeCheckExp (EPost i op) = do
+       (VInt n) <- getVariableValue i
+       setVariableValue i $ EInt $ n+1
+       return $ VInt n
+
+-- 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' 
+
+getVariableValue :: (MonadState Variables m) => Ident -> m Value 
+getVariableValue i = do
+       ms <- get 
+       findVariable i ms
+
+--setVariableValue :: (MonadState Variables m) => Ident -> Exp -> m Value 
+setVariableValue :: Ident -> Exp -> StateT Variables IO Value
+setVariableValue i e = do
+       e' <- eval e
+       (m:ms) <- get
+       put $ (insert i e' m):ms
+       return e'
+
+findVariable :: (MonadState  Variables 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
+
+-- execute :: (MonadState Variables m) => Stm -> m ()
+execute :: Stm -> StateT Variables IO ()
+execute (SIf b s s') = do
+       (VBool b') <- eval b
+       if b' then execute s else execute s'
+execute (SPrint e) = do
+       e' <- eval e
+       lift $ print e'
+execute (SNoop) = return ()
+execute (SBlock ss) = do
+       modify (empty:)
+       mapM execute ss
+       modify tail
+execute (SWhile e s) = do
+       (VBool b) <- eval e
+       if b then execute (SWhile e s) else return ()
+execute (SDecl t i EDefault) = do
+       case t of
+               TInt -> setVariableValue i (EInt 0)
+               TBool -> setVariableValue i (EBool False)
+       return ()
+execute (SDecl t i e) = setVariableValue i e >> return ()

diff --git a/Interpreter.hs b/Interpreter.hs
new file mode 100644 (file)
index 0000000..bccc53d
--- /dev/null
+++ b/Interpreter.hs
@@ -0,0 +1,66 @@
+-- automatically generated by BNF Converter
+module Main where
+
+
+import IO ( stdin, hGetContents )
+import System ( getArgs, getProgName )
+
+import Lexsyntax
+import Parsyntax
+import Skelsyntax
+import Printsyntax
+import Abssyntax
+
+import Typecheck
+import Interpret
+import Control.Monad.State
+import Data.Map as Map hiding (showTree)
+
+import ErrM
+
+type ParseFun a = [Token] -> Err a
+
+myLLexer = myLexer
+
+type Verbosity = Int
+
+putStrV :: Verbosity -> String -> IO ()
+putStrV v s = if v > 1 then putStrLn s else return ()
+
+runFile :: Verbosity -> ParseFun Stms -> FilePath -> IO ()
+runFile v p f = putStrLn f >> readFile f >>= run v p
+
+run :: Verbosity -> ParseFun Stms -> String -> IO ()
+run v p s = let ts = myLLexer s in case p ts of
+       Bad s    -> do
+               putStrLn "\nParse              Failed...\n"
+               putStrV v "Tokens:"
+               putStrV v $ show ts
+               putStrLn s
+       Ok (Program s) -> do
+               putStrLn "\nParse Successful!"
+               showTree v (Program s)
+               runStateT (mapM typeCheckStm s) [empty]
+               print "The program is type-correct!!"
+               print "Running program:"
+               runStateT (mapM execute s) [empty]
+               print "Done running program!"
+               return ()
+
+showTree :: (Show a, Print a) => Int -> a -> IO ()
+showTree v tree
+ = do
+      putStrV v $ "\n[Abstract Syntax]\n\n" ++ show tree
+      putStrV v $ "\n[Linearized tree]\n\n" ++ printTree tree
+
+main :: IO ()
+main = do args <- getArgs
+          case args of
+            [] -> hGetContents stdin >>= run 2 pStms
+            "-s":fs -> mapM_ (runFile 0 pStms) fs
+            fs -> mapM_ (runFile 2 pStms) fs
+
+
+
+
+

diff --git a/Makefile b/Makefile
index cd6c0826fe51507d9d2868ab83f838d262a1d9d1..f662112e8f88a49689dd97c0a3f07f7a54dc3a77 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-all: Typechecker
+all: Typechecker Interpreter
 
 doc: Docsyntax.dvi
 
@@ -11,6 +11,9 @@ Testsyntax: Testsyntax.hs  Parsyntax.hs Lexsyntax.hs Abssyntax.hs
 Typechecker: Typechecker.hs  Typecheck.hs Parsyntax.hs Lexsyntax.hs Abssyntax.hs
        ghc -fglasgow-exts --make Typechecker.hs -o Typechecker
 
+Interpreter: Interpreter.hs Interpret.hs Typecheck.hs Parsyntax.hs Lexsyntax.hs Abssyntax.hs
+       ghc -fglasgow-exts --make Interpreter.hs -o Interpreter
+
 Parsyntax.hs: Parsyntax.y
        happy -gca -idebug Parsyntax.y