Typecheck.hs

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