Type checking and co

Primitive type checker

import Control.Monad.Trans.Except

module Nine where


type VarName = String
type Context = [(VarName, Type)]

infixr 1 :->:
data Type = TVar VarName | Type :->: Type
          | TBool
  deriving (Eq, Show)

infixl 8 :@:
infixr 8 :-
data Term = Var VarName | Lam VarName Term | Term :@: Term | Term :- Type
          | TTrue | TFalse | TIf Term Term Term
  deriving Show



deriveType :: Context -> Term -> Except String Type
deriveType ctx (Var x) = case lookup x ctx of
  Nothing -> throwE $ "Variable not in scope: " ++ x
  Just t  -> pure t
deriveType ctx (p :@: q) = do
  tp <- deriveType ctx p
  case tp of
    sigma :->: tau -> do
      checkType ctx q sigma
      pure tau
    _ -> throwE $ "Function type expected"
deriveType _ TTrue  = pure TBool
deriveType _ TFalse = pure TBool
deriveType ctx (p :- sigma) = checkType ctx p sigma >> pure sigma
deriveType _ t = throwE $ "Cannot derive type of " ++ show t

checkType :: Context -> Term -> Type -> Except String ()
checkType ctx (Lam x p) (sigma :->: tau) = checkType ((x, sigma) : ctx) p tau
checkType ctx (TIf c1 c2 c3) sigma = do
  checkType ctx c1 TBool
  checkType ctx c2 sigma
  checkType ctx c3 sigma
checkType ctx t sigma = do
  sigma' <- deriveType ctx t
  if sigma == sigma'
  then pure ()
  else throwE $ "Type mismatch; expected " ++ show sigma ++ ", actual " ++ show sigma'