COMP[39]161 Concepts of Programming Languages
Semester 2, 2018

Code (Week 7)

check :: ErrorMessage -> Bool -> Either ErrorMessage ()
check err True  = Right () 
check err False = Left  err

type ErrorMessage = String 

typeCheck :: Expr -> Either ErrorMessage Type 
typeCheck (Num n) = return IntTy 
typeCheck (Lit b) = return BoolTy 
typeCheck (Plus e1 e2) 
   = do t <- typeCheck e1 
        check "LHS of Plus should be Int" (t == IntTy)
        t' <- typeCheck e2 
        check "RHS of Plus should be Int" (t' == IntTy)
        return IntTy
 {- } = typeCheck e1 >>= \t ->
      guard (t == IntTy) >> 
        typeCheck e2 >>= \t' -> 
            guard (t' == IntTy) >> 
              Just IntTy 
-}
typeCheck (LessEq e1 e2) = do 
    t1 <- typeCheck e1 
    check "LHS of <= should be Int" (t1 == IntTy)
    t2 <- typeCheck e2 
    check "RHS of <= should be Int" (t2 == IntTy)
    return BoolTy
typeCheck (If e1 e2 e3) = do 
    t1 <- typeCheck e1 
    check "If should branch on a boolean" (t1 == BoolTy)
    tau <- typeCheck e2 
    tau' <- typeCheck e3
    check "Two branches of if should have same type" (tau == tau')
    return tau
typeCheck (Apply e1 e2) = do 
     funty <- typeCheck e1 
     case funty of 
       FunTy t1 t2 -> do 
         t1' <- typeCheck e2 
         check "Argument should match function type" (t1' == t1)
         return t2 
       _ -> Left "LHS of Apply should be a function"
typeCheck (Recfun t1 t2 abs) = do 
    resultTy <- typeCheck (abs (TypeTag (FunTy t1 t2)) (TypeTag t1))
    check "Function body type should match signature" (resultTy == t2) 
    return (FunTy t1 t2) 
typeCheck (TypeTag t) = return t

2018-11-16 Fri 19:37

Announcements RSS