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