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 typeCheckExp (EFunc i as) = do
  54         state <- get
  55         (t,ts) <- lookup i $ functions state
  56         checkParams as ts
  57         return t
  58
  59 checkParams :: (MonadState State m) => [Exp] -> [Type] -> m ()
  60 checkParams [] [] = return ()
  61 checkParams [] _ = fail "Too for arguments when calling function"
  62 checkParams _ [] = fail "Too many arguments when calling function"
  63 checkParams (e:es) (t:ts) = do
  64         t2 <- typeCheckExp e
  65         assert (t == t2) "Arugments does not match"
  66         checkParams es ts
  67
  68 typeCheckVar :: (MonadState State m) => Ident -> m Type
  69 typeCheckVar i = do
  70         s <- get
  71         findVariable i $ variables s
  72
  73 findVariable :: (MonadState State m) => Ident -> Types -> m Type
  74 findVariable i [] = fail $ "Variable "++show i++" not found in any scope."
  75 findVariable i (m:ms) = if member i m then lookup i m else findVariable i ms
  76
  77 pushAndPop :: (MonadState State m) => m a -> m ()
  78 pushAndPop s = do
  79         modify (\s -> s { variables = empty:variables s})
  80         s
  81         modify (\s -> s { variables = tail $ variables s})
  82
  83 typeCheckStm :: (MonadState State m) => Stm -> m ()
  84 typeCheckStm SNoop = return ()
  85 typeCheckStm (SExp e) = do
  86         typeCheckExp e
  87         return ()
  88 typeCheckStm (SBlock ss) = pushAndPop $ mapM typeCheckStm ss
  89 typeCheckStm (SIf e s s') = do
  90         TBool <- typeCheckExp e
  91         pushAndPop $ typeCheckStm s
  92         pushAndPop $ typeCheckStm s'
  93 typeCheckStm (SWhile e s) = do
  94         TBool <- typeCheckExp e
  95         pushAndPop $ typeCheckStm s
  96 typeCheckStm (SDeclD t i) = addVariable i t
  97 typeCheckStm (SDecl t i e) = do
  98         t2 <- typeCheckExp e
  99         assert (t == t2) $ "Illegal to assign an expression of type "++show t2++" to variable "++show i++" of type "++show t
 100         addVariable i t
 101 typeCheckStm (SPrint e) = do
 102         typeCheckExp e
 103         return ()
 104 typeCheckStm (SReturn e) = do
 105         t <- typeCheckExp e
 106         state <- get
 107         (t2,_) <- lookup (function state) $ functions state
 108         assert (t == t2) $ "Illegal to return "++show t++" in function "++show (function state)++" which returns "++show t2
 109
 110
 111 addVariable :: (MonadState State m) => Ident -> Type -> m ()
 112 addVariable i t = do
 113         s <- get
 114         let (m:ms) = variables s in case insertLookupWithKey (\k a1 a2 -> a1) i t m of
 115                 (Nothing,m') -> modify (\s -> s{ variables = m':ms})
 116                 _ -> fail $ "Duplicate variable declaration: "++show i
 117
 118 typeCheckFunction :: (MonadState State m) => Func -> m ()
 119 typeCheckFunction (Func t i d s) = do
 120         state <- get
 121         modify (\s -> s{variables=[empty], function=i})
 122         mapM (\(Decl t i) -> addVariable i t) d
 123         mapM typeCheckStm s
 124         put state
 125
 126 addFunction :: (MonadState State m) => Func -> m ()
 127 addFunction (Func t i d _) = do
 128         s <- get
 129         let m = functions s in case insertLookupWithKey (\k a1 a2 -> a1) i (t, map (\(Decl t i) -> t) d) m of
 130                 (Nothing,m') -> modify (\s -> s{ functions = m'})
 131                 _ -> fail $ "Duplicate variable declaration: "++show i