minor stuff

[proglang.git] / Typecheck.hs

diff --git a/Typecheck.hs b/Typecheck.hs
index a78f8f02c6a51d5d6d643d01ee8a4232f4223dab..1b0baa00ed5d48dc760f029f9759e8bb821eed9c 100644 (file)
--- a/Typecheck.hs
+++ b/Typecheck.hs
@@ -1,4 +1,4 @@
-module Typecheck (typeCheckExp, typeCheckStm, typeCheckVar) where 
+module Typecheck (typeCheck,typeCheckExp, typeCheckStm, typeCheckVar) where 
 
 
 import Abssyntax
@@ -16,6 +16,9 @@ assert :: Monad m => Bool -> String -> m ()
 assert True _ = return ()
 assert False s = fail s
 
+typeCheck :: [Stm] -> IO ()
+typeCheck s = runStateT (mapM typeCheckStm s) [empty] >> return ()
+
 typeCheckExp :: (MonadState Types m) => Exp -> m Type
 typeCheckExp (BiOpExp e o e') = do
        t1 <- typeCheckExp e
@@ -56,34 +59,37 @@ findVariable :: (MonadState Types m) => Ident -> Types -> m Type
 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
 
+pushAndPop :: (MonadState Types m) => m a -> m ()
+pushAndPop s = do
+       modify (empty:)
+       s
+       modify tail
+
 typeCheckStm :: (MonadState Types m) => Stm -> m ()
 typeCheckStm SNoop = return ()
 typeCheckStm (SExp e) = do 
        typeCheckExp e
        return ()
-typeCheckStm (SBlock ss) = do 
-       modify (empty:)
-       mapM typeCheckStm ss
-       modify tail
+typeCheckStm (SBlock ss) = pushAndPop $ mapM typeCheckStm ss
 typeCheckStm (SIf e s s') = do
        TBool <- typeCheckExp e
-       modify (empty:)
-       typeCheckStm s
-       modify (\s -> empty:tail s)
-       typeCheckStm s'
-       modify tail
+       pushAndPop $ typeCheckStm s
+       pushAndPop $ typeCheckStm s'
 typeCheckStm (SWhile e s) = do
        TBool <- typeCheckExp e
-       modify (empty:)
-       typeCheckStm s
-       modify tail
+       pushAndPop $ typeCheckStm s
+typeCheckStm (SDeclD t i) = addVariable i t
 typeCheckStm (SDecl t i e) = do
        t2 <- typeCheckExp e
        assert (t == t2) $ "Illegal to assign an expression of type "++show t2++" to variable "++show i++" of type "++show t
+       addVariable i t
+typeCheckStm (SPrint e) = do
+       typeCheckExp e
+       return ()
+
+addVariable :: (MonadState Types m) => Ident -> Type -> m ()
+addVariable i t = do
        (m:ms) <- get
        case insertLookupWithKey (\k a1 a2 -> a1) i t m of
                (Nothing,m') -> put (m':ms)
                _ -> fail $ "Duplicate variable declaration: "++show i
-typeCheckStm (SPrint e) = do
-       typeCheckExp e
-       return ()