Typecheck.hs

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