From 2316d61f350f8b39c9a3f76b91d1d14796d5183b Mon Sep 17 00:00:00 2001
From: Michael Andreen <harv@ruin.nu>
Date: Wed, 1 Mar 2006 09:18:40 +0000
Subject: [PATCH] initial commit of interpreter

---
 Interpret.hs   | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++
 Interpreter.hs | 66 +++++++++++++++++++++++++++++++++++++++
 Makefile       |  5 ++-
 3 files changed, 153 insertions(+), 1 deletion(-)
 create mode 100644 Interpret.hs
 create mode 100644 Interpreter.hs

diff --git a/Interpret.hs b/Interpret.hs
new file mode 100644
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
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 cd6c082..f662112 100644
--- 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
 
-- 
2.39.2