From 8fdc0177fdf518f63819e5b98dd0368fccca6175 Mon Sep 17 00:00:00 2001 From: Michael Andreen Date: Sat, 11 Mar 2006 14:15:08 +0000 Subject: [PATCH] interpreter compiles --- Interpret.hs | 40 ++++++++++++++++++++++++---------------- Interpreter.hs | 23 ++++++++++++++--------- Makefile | 2 +- Typecheck.hs | 3 ++- Typechecker.hs | 2 +- 5 files changed, 42 insertions(+), 28 deletions(-) diff --git a/Interpret.hs b/Interpret.hs index 8cf3c1b..b82398d 100644 --- 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 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 @@ -13,13 +15,16 @@ instance Show Value where 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 @@ -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' -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 -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 Variables m) => m a -> m () +pushAndPop :: (MonadState State m) => m a -> m () pushAndPop s = do - modify (empty:) + modify (\s -> s { variables = empty:variables s}) s - modify tail + 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 @@ -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 - (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 bccc53d..6cfbbda 100644 --- a/Interpreter.hs +++ b/Interpreter.hs @@ -13,7 +13,7 @@ import Abssyntax import Typecheck import Interpret -import Control.Monad.State +import Control.Monad.State hiding (State) import Data.Map as Map hiding (showTree) import ErrM @@ -24,26 +24,31 @@ myLLexer = myLexer 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 () -runFile :: Verbosity -> ParseFun Stms -> FilePath -> IO () +runFile :: Verbosity -> ParseFun Program -> FilePath -> IO () 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 - Ok (Program s) -> do + Ok (Program s) -> let (fun,st) = splitFunStm (s) in do 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:" - runStateT (mapM execute s) [empty] + runStateT (do mapM Interpret.addFunction fun; mapM execute st) Interpret.emptyState print "Done running program!" return () @@ -56,9 +61,9 @@ showTree v 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 + [] -> 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 e52bbb4..e013775 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,4 @@ -all: Testsyntax Typechecker +all: Testsyntax Typechecker Interpreter doc: Docsyntax.dvi diff --git a/Typecheck.hs b/Typecheck.hs index bfef73a..a701b6e 100644 --- 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 @@ -11,6 +11,7 @@ type Function = (Type, [Type]) 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 diff --git a/Typechecker.hs b/Typechecker.hs index 71810e6..19f5a66 100644 --- 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) - 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 () -- 2.39.2