Typecheck.hs

   1 module Typecheck (typeCheck,typeCheckExp, typeCheckStm, typeCheckVar) where
   2
   3
   4 import Abssyntax
   5 import Control.Monad.State
   6 import Data.Map as Map
   7 import Prelude hiding (lookup)
   8
   9 type Types = [Map Ident Type]
  10
  11 inList :: Eq a => a -> [a] -> Bool
  12 inList _ [] = False
  13 inList a (x:xs) = if a == x then True else inList a xs
  14
  15 assert :: Monad m => Bool -> String -> m ()
  16 assert True _ = return ()
  17 assert False s = fail s
  18
  19 typeCheck :: [Stm] -> IO ()
  20 typeCheck s = runStateT (mapM typeCheckStm s) [empty] >> return ()
  21
  22 typeCheckExp :: (MonadState Types m) => Exp -> m Type
  23 typeCheckExp (BiOpExp e o e') = do
  24         t1 <- typeCheckExp e
  25         t2 <- typeCheckExp e'
  26         assert (t1 == t2) "The parameters for the binary operator aren't equal"
  27         if inList o [Eq,NEq] then return TBool
  28                 else do
  29                         assert (t1 == TInt) "The parameters need to be of type int"
  30                         if inList o [Plus,Minus,Times,Div]
  31                                 then return TInt
  32                                 else return TBool
  33 typeCheckExp (EVar i) = typeCheckVar i
  34 typeCheckExp (EAss i e) = do
  35         t <- typeCheckVar i
  36         t2 <- typeCheckExp e
  37         assert (t == t2) $ "Illegal to assign an expression of type "++show t2++" to variable "++show i++" of type "++show t
  38         return t
  39 typeCheckExp (EInt i) = return TInt
  40 typeCheckExp (EBool b) = return TBool
  41 typeCheckExp EReadI = return TInt
  42 typeCheckExp EReadB = return TBool
  43 typeCheckExp (EPost i op) = do
  44         TInt <- typeCheckVar i
  45         return TInt
  46 typeCheckExp (ENeg e) = do
  47         TInt <- typeCheckExp e
  48         return TInt
  49 typeCheckExp (ENot e) = do
  50         TBool <- typeCheckExp e
  51         return TBool
  52
  53 typeCheckVar :: (MonadState Types m) => Ident -> m Type
  54 typeCheckVar i = do
  55         ms <- get
  56         findVariable i ms
  57
  58 findVariable :: (MonadState Types m) => Ident -> Types -> m Type
  59 findVariable i [] = fail $ "Variable "++show i++" not found in any scope."
  60 findVariable i (m:ms) = if member i m then lookup i m else findVariable i ms
  61
  62 pushAndPop :: (MonadState Types m) => m a -> m ()
  63 pushAndPop s = do
  64         modify (empty:)
  65         s
  66         modify tail
  67
  68 typeCheckStm :: (MonadState Types m) => Stm -> m ()
  69 typeCheckStm SNoop = return ()
  70 typeCheckStm (SExp e) = do
  71         typeCheckExp e
  72         return ()
  73 typeCheckStm (SBlock ss) = pushAndPop $ mapM typeCheckStm ss
  74 typeCheckStm (SIf e s s') = do
  75         TBool <- typeCheckExp e
  76         pushAndPop $ typeCheckStm s
  77         pushAndPop $ typeCheckStm s'
  78 typeCheckStm (SWhile e s) = do
  79         TBool <- typeCheckExp e
  80         pushAndPop $ typeCheckStm s
  81 typeCheckStm (SDeclD t i) = addVariable i t
  82 typeCheckStm (SDecl t i e) = do
  83         t2 <- typeCheckExp e
  84         assert (t == t2) $ "Illegal to assign an expression of type "++show t2++" to variable "++show i++" of type "++show t
  85         addVariable i t
  86 typeCheckStm (SPrint e) = do
  87         typeCheckExp e
  88         return ()
  89
  90 addVariable :: (MonadState Types m) => Ident -> Type -> m ()
  91 addVariable i t = do
  92         (m:ms) <- get
  93         case insertLookupWithKey (\k a1 a2 -> a1) i t m of
  94                 (Nothing,m') -> put (m':ms)
  95                 _ -> fail $ "Duplicate variable declaration: "++show i