X-Git-Url: https://ruin.nu/git/?a=blobdiff_plain;f=Typecheck.hs;h=922264061337362de5dab48dcbdb8163b9bee8d4;hb=93b042040034d199c925248a2dd1c321773ab6d0;hp=cc416e28d8f166dbfc62cf7adc551ccfffad61a3;hpb=a05f5aee2ceddec9721ce04ae596734524b80940;p=proglang.git diff --git a/Typecheck.hs b/Typecheck.hs index cc416e2..9222640 100644 --- a/Typecheck.hs +++ b/Typecheck.hs @@ -1,29 +1,73 @@ module Typecheck where import Abssyntax +import Control.Monad.State +import Data.Map as Map +import Prelude hiding (lookup) -typeCheckExp :: Exp -> Maybe Type -BExp e o e' = do - TInt <- typeCheck e - TInt <- typeCheck e' + +type Types = Map Ident Type + +typeCheckExp :: (MonadState Types m) => Exp -> m Type +typeCheckExp (BExp e o e') = do + TInt <- typeCheckExp e + TInt <- typeCheckExp e' return TBool -OpExp e o e' = do - TInt <- typeCheck e - TInt <- typeCheck e' +typeCheckExp (OpExp e o e') = do + TInt <- typeCheckExp e + TInt <- typeCheckExp e' + return TInt +typeCheckExp (EVar i) = typeCheckVar i +typeCheckExp (EAss i e) = do + a <- typeCheckVar i + b <- typeCheckExp e + if a == b then return a else fail "FEL!" +typeCheckExp (EInt i) = return TInt +typeCheckExp (EBool b) = return TBool +typeCheckExp EReadI = return TInt +typeCheckExp EReadB = return TBool +typeCheckExp (ExpT t e) = do + t2 <- typeCheckExp e + if t == t2 then return t else fail "FEL!" +typeCheckExp EDefault = return NoType +typeCheckExp (EPost i op) = do + TInt <- typeCheckVar i return TInt +typeCheckExp (ENeg e) = do + TInt <- typeCheckExp e + return TInt + -typeCheckStm :: Stm -> Maybe Type -SNoop = return NoType -SExp e = typeCheckExp e -SBlock ss = do +typeCheckVar :: (MonadState Types m) => Ident -> m Type +typeCheckVar i = do + e <- get + lookup i e + +typeCheckStm :: (MonadState Types m) => Stm -> m Type +typeCheckStm SNoop = return NoType +typeCheckStm (SExp e) = do + typeCheckExp e + return NoType +typeCheckStm (SBlock ss) = do mapM typeCheckStm ss return NoType -SIf e s s' = do +typeCheckStm (SIf e s s') = do TBool <- typeCheckExp e NoType <- typeCheckStm s NoType <- typeCheckStm s return NoType -SWhile e s = do +typeCheckStm (SWhile e s) = do TBool <- typeCheckExp e NoType <- typeCheckStm s + return NoType +typeCheckStm (SDecl t i e) = do + t2 <- typeCheckExp e + if t == t2 || t2 == NoType then do + m <- get + put (insert i t m) + return NoType + 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