X-Git-Url: https://ruin.nu/git/?p=proglang.git;a=blobdiff_plain;f=Typecheck.hs;h=6e845ba2cb56b9625570676c65e6354da53eb4ba;hp=ec2270e01c3860215b28dcb851807b8f8f14ea99;hb=6103c0359b95557566aa9154efa5bcd4d9c996f6;hpb=9726c329b6d9ab02a1b50566ae96c82f29c5ec4d diff --git a/Typecheck.hs b/Typecheck.hs index ec2270e..6e845ba 100644 --- a/Typecheck.hs +++ b/Typecheck.hs @@ -1,4 +1,4 @@ -module Typecheck where +module Typecheck (typeCheckExp, typeCheckStm, typeCheckVar) where import Abssyntax import Control.Monad.State @@ -8,15 +8,21 @@ import Prelude hiding (lookup) type Types = Map Ident Type +inList :: Eq a => a -> [a] -> Bool +inList _ [] = False +inList a (x:xs) = if a == x then True else inList a xs + typeCheckExp :: (MonadState Types m) => Exp -> m Type -typeCheckExp (BExp e o e') = do - TInt <- typeCheckExp e - TInt <- typeCheckExp e' - return TBool -typeCheckExp (OpExp e o e') = do - TInt <- typeCheckExp e - TInt <- typeCheckExp e' - return TInt +typeCheckExp (BiOpExp e o e') = do + t1 <- typeCheckExp e + t2 <- typeCheckExp e' + if not(t1 == t2) then fail "" + else case inList o [Eq,NEq] of + True -> return TBool + False -> if not(t1 == TInt) then fail "" + else case inList o [Plus,Minus,Times,Div] of + True -> return TInt + False -> return TBool typeCheckExp (EVar i) = typeCheckVar i typeCheckExp (EAss i e) = do a <- typeCheckVar i @@ -33,6 +39,9 @@ typeCheckExp EDefault = return NoType typeCheckExp (EPost i op) = do TInt <- typeCheckVar i return TInt +typeCheckExp (ENeg e) = do + TInt <- typeCheckExp e + return TInt typeCheckVar :: (MonadState Types m) => Ident -> m Type @@ -59,11 +68,11 @@ typeCheckStm (SWhile e s) = do return NoType typeCheckStm (SDecl t i e) = do t2 <- typeCheckExp e - if t == t2 then do + if t == t2 || t2 == NoType then do m <- get put (insert i t m) return NoType - else fail "Så får du inte göra!!!" + else fail $ "Illegal to assign an expression of type "++show t2++" to variable "++show i++" of type "++show t typeCheckStm (SPrint e) = do typeCheckExp e return NoType