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

Code (Week 5)

module Week5 where 

data Type = IntTy | BoolTy | FunTy Type Type deriving (Eq)
data Expr = Num Int | Lit Bool 
          | Plus Expr Expr 
          | LessEq Expr Expr 
          | If Expr Expr Expr 
          | Apply Expr Expr 
          | Recfun Type Type (Expr -> Expr -> Expr)
          | Tag String -- only used for pretty printing. do not touch.
          | TypeTag Type -- only used for type checking. do not touch.

example = Recfun IntTy IntTy (\ f x -> 
            If (LessEq x (Num 4))
               (Num 0)
               (Plus (Num 1) (Apply f (Plus x (Num (-5))))))

example2 = Recfun IntTy (FunTy IntTy IntTy) (\ sum x -> 
              Recfun IntTy IntTy (\ sumX y -> 
                (LessEq x y)))               

prettyPrintTy :: Type -> String 
prettyPrintTy IntTy = "Int"
prettyPrintTy BoolTy = "Bool"
prettyPrintTy (FunTy t1 t2) 
  = "(" ++ prettyPrintTy t1 ++ ") -> " ++ prettyPrintTy t2


prettyPrint :: Int -> Expr -> String 
prettyPrint v (Num n) = show n
prettyPrint v (Lit b) = show b
prettyPrint v (Plus a b) 
  = "(" ++ prettyPrint v a ++  " + " ++ prettyPrint v b ++ ")"
prettyPrint v (LessEq a b) 
  = "(" ++ prettyPrint v a ++ " <= " ++ prettyPrint v b ++ ")"
prettyPrint v (If c t e) 
  = concat ["(if ", prettyPrint v c 
           ," then ", prettyPrint v t
           ," else ", prettyPrint v e 
           ,")"
           ]
prettyPrint v (Apply f x) 
  = "(" ++ prettyPrint v f ++ " " ++ prettyPrint v x ++ ")"
prettyPrint v (Recfun t1 t2 abs) 
  = let t = "(" ++ prettyPrintTy t1 ++ " -> " ++ prettyPrintTy t2 ++ ")"
        f = Tag ("f" ++ show v)
        x = Tag ("x" ++ show v)
        body = prettyPrint (v+1) (abs f x)
     in concat ["recfun f" ++ show v
               , " :: ", t
               , " x" ++ show v
               , " = ", body
               ]
prettyPrint v (Tag x) = x

typeCheck :: Expr -> Type 
typeCheck (Num n) = IntTy 
typeCheck (Lit b) = BoolTy 
typeCheck (Plus e1 e2) = let IntTy = typeCheck e1 
                             IntTy = typeCheck e2 
                          in IntTy
typeCheck (LessEq e1 e2) = let IntTy = typeCheck e1 
                               IntTy = typeCheck e2 
                            in BoolTy
typeCheck (If e1 e2 e3) = let BoolTy = typeCheck e1 
                              tau = typeCheck e2
                          in if typeCheck e3 == tau  then
                               tau 
                             else 
                               error "boo"
typeCheck (Apply e1 e2) = let FunTy t1 t2 = typeCheck e1 
                           in if typeCheck e2 == t1 then 
                                t2 
                              else 
                                error "boo"
typeCheck (Recfun t1 t2 abs) = let
    resultTy = typeCheck (abs (TypeTag (FunTy t1 t2)) (TypeTag t1))
  in if resultTy == t2 then FunTy t1 t2 else error "boo"


2018-11-16 Fri 19:37

Announcements RSS