interpreter compiles

diff --git a/Interpret.hs b/Interpret.hs
index 8cf3c1b2657270d016c8f28256b993adbd566c96..b82398d22bc63b114eb0d5c6f7f344f80cd34c31 100644 (file)
--- a/Interpret.hs
+++ b/Interpret.hs
@@ -1,10 +1,12 @@
-module Interpret (eval, execute, Value(VInt, VBool)) where
+module Interpret (eval, execute,addFunction, emptyState, Value(..), State(..)) where

 
 import Abssyntax
 
 import Abssyntax

-import Control.Monad.State
+import Control.Monad.State hiding (State)

 import Data.Map as Map
 import Prelude hiding (lookup)
 
 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
 data Value = VInt Integer | VBool Bool deriving Eq
 
 instance Show Value where


@@ -13,13 +15,16 @@ instance Show Value where
        show (VBool False) = "0"
 
 type Variables = [Map Ident Value]
        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
 
 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 (EBool b) = return (VBool b)
 eval (EInt n) = return (VInt n)
 eval (EVar i) = getVariableValue i


@@ -67,37 +72,37 @@ op ELt = \e e' -> VBool $ e <= e'
 op Gt = \e e' -> VBool $ e > e'
 op EGt = \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
 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 
 
 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 
 

-setVariableValue :: Ident -> Exp -> StateT Variables IO Value
+setVariableValue :: Ident -> Exp -> StateT State IO Value

 setVariableValue i e = do
        v <- eval e
 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
 
        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 Variables m) => m a -> m ()
+pushAndPop :: (MonadState State m) => m a -> m ()

 pushAndPop s = do
 pushAndPop s = do

-       modify (empty:)
+       modify (\s -> s { variables = empty:variables s})

        s
        s

-       modify tail
+       modify (\s -> s { variables = tail $ variables s})

 
 -- execute :: (MonadState Variables m) => Stm -> m ()
 
 -- 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
 execute (SNoop) = return ()
 execute (SExp e) = eval e >> return ()
 execute (SIf b s s') = do


@@ -115,5 +120,8 @@ execute (SDeclD t i) = execute $ SDecl t i $ case t of
        TBool -> EBool False
 execute (SDecl t i e) =do
        v <- eval e
        TBool -> EBool False
 execute (SDecl t i e) =do
        v <- eval e

-       (m:ms) <- get
-       put $ (insert i v m):ms
+       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) })

diff --git a/Interpreter.hs b/Interpreter.hs
index bccc53d0fdb4871b1469011ee041adf59b196cd8..6cfbbda91af2804ac58cd53a96a1447e4dd1cea0 100644 (file)
--- a/Interpreter.hs
+++ b/Interpreter.hs
@@ -13,7 +13,7 @@ import Abssyntax
 
 import Typecheck
 import Interpret
 
 import Typecheck
 import Interpret

-import Control.Monad.State
+import Control.Monad.State hiding (State)

 import Data.Map as Map hiding (showTree)
 
 import ErrM
 import Data.Map as Map hiding (showTree)
 
 import ErrM


@@ -24,26 +24,31 @@ myLLexer = myLexer
 
 type Verbosity = Int
 
 
 type Verbosity = Int
 

+splitFunStm :: [FuncStm] -> ([Func],[Stm])
+splitFunStm [] = ([],[])
+splitFunStm ((F f):fss) = let (fs,ss) = splitFunStm fss in (f:fs,ss)
+splitFunStm ((S s):fss) = let (fs,ss) = splitFunStm fss in (fs,s:ss)
+

 putStrV :: Verbosity -> String -> IO ()
 putStrV v s = if v > 1 then putStrLn s else return ()
 
 putStrV :: Verbosity -> String -> IO ()
 putStrV v s = if v > 1 then putStrLn s else return ()
 

-runFile :: Verbosity -> ParseFun Stms -> FilePath -> IO ()
+runFile :: Verbosity -> ParseFun Program -> FilePath -> IO ()

 runFile v p f = putStrLn f >> readFile f >>= run v p
 
 runFile v p f = putStrLn f >> readFile f >>= run v p
 

-run :: Verbosity -> ParseFun Stms -> String -> IO ()
+run :: Verbosity -> ParseFun Program -> 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
 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
+       Ok (Program s) -> let (fun,st) = splitFunStm (s) in do

                putStrLn "\nParse Successful!"
                showTree v (Program s)
                putStrLn "\nParse Successful!"
                showTree v (Program s)

-               runStateT (mapM typeCheckStm s) [empty]
+               runStateT (do mapM Typecheck.addFunction fun; mapM typeCheckFunction fun; mapM typeCheckStm st) Typecheck.emptyState

                print "The program is type-correct!!"
                print "Running program:"
                print "The program is type-correct!!"
                print "Running program:"

-               runStateT (mapM execute s) [empty]
+               runStateT (do mapM Interpret.addFunction fun; mapM execute st) Interpret.emptyState

                print "Done running program!"
                return ()
 
                print "Done running program!"
                return ()
 


@@ -56,9 +61,9 @@ showTree v tree
 main :: IO ()
 main = do args <- getArgs
           case args of
 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
+            [] -> hGetContents stdin >>= run 2 pProgram
+            "-s":fs -> mapM_ (runFile 0 pProgram) fs
+            fs -> mapM_ (runFile 2 pProgram) fs

 
 
 
 
 
 

diff --git a/Makefile b/Makefile
index e52bbb4415a70c63239390f32493a7a83304d74a..e013775c883f8ec880573016e418e397c73d2973 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-all: Testsyntax Typechecker
+all: Testsyntax Typechecker Interpreter

 
 doc: Docsyntax.dvi
 
 
 doc: Docsyntax.dvi
 

diff --git a/Typecheck.hs b/Typecheck.hs
index bfef73a68a318cc46188649474881eab2760c4d0..a701b6e85bf92a0e9f0807251e5eecbfa83c7592 100644 (file)
--- a/Typecheck.hs
+++ b/Typecheck.hs
@@ -1,4 +1,4 @@
-module Typecheck (typeCheckExp, typeCheckStm, typeCheckVar, typeCheckFunction, addFunction, State(..)) where 
+module Typecheck (typeCheckExp, typeCheckStm, typeCheckVar, typeCheckFunction, addFunction, emptyState, State(..)) where 

 
 
 import Abssyntax
 
 
 import Abssyntax


@@ -11,6 +11,7 @@ type Function = (Type, [Type])
 
 data State = State {variables::Types,functions::(Map Ident Function),function::Ident}
 
 
 data State = State {variables::Types,functions::(Map Ident Function),function::Ident}
 

+emptyState = State{variables=[empty], functions=(empty), function=(Ident "")}

 
 inList :: Eq a => a -> [a] -> Bool
 inList _ [] = False
 
 inList :: Eq a => a -> [a] -> Bool
 inList _ [] = False

diff --git a/Typechecker.hs b/Typechecker.hs
index 71810e698b7854109d0f728951f504b25ab45cda..19f5a6687e48373a196c6aba6178939a720485d9 100644 (file)
--- a/Typechecker.hs
+++ b/Typechecker.hs
@@ -45,7 +45,7 @@ run v p s = let ts = myLLexer s in case p ts of
        Ok (Program s) -> let (fun,st) = splitFunStm (s) in do
                putStrLn "\nParse Successful!"
                showTree v (Program s)
        Ok (Program s) -> let (fun,st) = splitFunStm (s) in do
                putStrLn "\nParse Successful!"
                showTree v (Program s)

-               runStateT (do mapM addFunction fun; mapM typeCheckFunction fun; mapM typeCheckStm st) State{variables=[empty], functions=(empty), function=(Ident "")}
+               runStateT (do mapM addFunction fun; mapM typeCheckFunction fun; mapM typeCheckStm st) emptyState

                print "The program is type-correct!!"
                return ()
 
                print "The program is type-correct!!"
                return ()