Typecheck.hs

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