Lecture 11 — 2015-10-07

Types

This lecture is written in literate Haskell; you can download the raw source.

What are types for?

Type systems are fundamentally about preventing bad behavior. Every type system identifies some kinds of behavior that it wants to rule out.

In general, limits on decidability mean we can’t automatically rule out all bad behavior and automatically keep all good behavior. The typical compromise is to rule out a subset of bad behaviors at the cost of rejecting some programs that turn out to be well behaved.

Arithmetic and booleans

To highlight a simple type system, we worked with arithmetic and booleans.

e ::= n | true | false
    | e1 and e2 | e1 or e2 | not e1 | e1 == e2
    | e1 plus e2 | e1 minus e2 | e1 times e2
    | if e1 then e2 else e3

This language has two types, numbers and booleans:

t ::= num | bool

We wrote corresponding type rules as an inference system. We typically write type notation in the format ⊦ e : t, meaning the term e has type t. I’ll write it in ASCII as |- e : t.

Here are the typing rules for the language above. First, constants can just be assigned their types axiomatically.

---------- 
|- n : num

-------------- 
|- true : bool

--------------- 
|- false : bool

Operations depend on the types of their operands. For example, e1 and e2 will evaluate correctly to a boolean precisely when e1 and e2 evaluate to booleans. We therefore say:

|- e1 : bool    |- e2 : bool
---------------------------- 
|- e1 and e2 : bool

The rule for or is identical, even though and and or do very different things. From the perspective of types, they’re the same.

|- e1 : bool    |- e2 : bool
---------------------------- 
|- e1 or e2 : bool

We can define the rules for not, plus, minus, and times similarly:

|- e : bool
--------------- 
|- not e : bool

|- e1 : num    |- e2 : num
---------------------------- 
|- e1 plus e2 : num

|- e1 : num    |- e2 : num
---------------------------- 
|- e1 minus e2 : num

|- e1 : num    |- e2 : num
---------------------------- 
|- e1 times e2 : num

The remaining syntactic forms e1 == e2 and if e1 then e2 else e3 are the most interesting. Suppose we only want to allow equality between numbers. The rule then takes the form:

|- e1 : num    |- e2 : num
-------------------------- 
|- e1 == e2 : bool

That is, when e1 and e2 are numbers, the term e1 == e2 will reduce to a boolean.

Finally, if statements have a rule as follows:

|- e1 : bool    |- e2 : t    |- e3 : t
-------------------------------------- 
|- if e1 then e2 else e3 : t

If e1 is a bool and both branches of the if have the same type, t—whatever that is—then if e1 then e2 else e3 has type t. Note that we’ve used non-linearity in t to represent equality—a common trick in math, but it doesn’t fly in Haskell, where a variable can only appear once in a pattern. We could have instead explicitly used equality:

|- e1 : bool    |- e2 : t2    |- e3 : t3    t2 = t3
--------------------------------------------------- 
|- if e1 then e2 else e3 : t2

Translating to Haskell

Here’s the corresponding Haskell code. The code presented here is slightly more complicated than what we wrote in class, since I’m explicitly handling errors using Either, where Left represents an error and Right represents success.

data Arith =
    Num Int
  | Bool Bool
  | And Arith Arith
  | Or Arith Arith
  | Not Arith
  | Eq Arith Arith
  | Plus Arith Arith
  | Minus Arith Arith
  | Times Arith Arith
  | If Arith Arith Arith
  deriving (Eq, Show)

data Result = VNum Int | VBool Bool | VError String deriving (Eq, Show)

eval :: Arith -> Result
eval (Num n) = VNum n
eval (Bool b) = VBool b
eval (And e1 e2) =
  case (eval e1, eval e2) of
    (VBool b1, VBool b2) -> VBool (b1 && b2)
    (_,_) -> VError "and expected booleans"
eval (Or e1 e2) =
  case (eval e1, eval e2) of
    (VBool b1, VBool b2) -> VBool (b1 || b2)
    (_,_) -> VError "or expected booleans"
eval (Not e) =
  case eval e of
    VBool b -> VBool (not b)
    _ -> VError "not expected a boolean"
eval (Eq e1 e2) =
  case (eval e1, eval e2) of
    (VNum n1, VNum n2) -> VBool (n1 == n2)
    (_,_) -> VError "== expected numbers"
eval (Plus e1 e2) =
  case (eval e1, eval e2) of
    (VNum n1, VNum n2) -> VNum (n1 + n2)
    (_,_) -> VError "plus expected numbers"
eval (Minus e1 e2) =
  case (eval e1, eval e2) of
    (VNum n1, VNum n2) -> VNum (n1 - n2)
    (_,_) -> VError "minus expected numbers"
eval (Times e1 e2) =
  case (eval e1, eval e2) of
    (VNum n1, VNum n2) -> VNum (n1 * n2)
    (_,_) -> VError "times expected numbers"
eval (If e1 e2 e3) =
  case eval e1 of
    VBool b -> eval $ if b then e2 else e3
    _ -> VError "if expected a boolean"

data Type = Number | Boolean deriving (Eq,Show)

compareTypes :: Type -> Type -> Either String Type
compareTypes given expected 
  | given == expected = Right expected
  | otherwise         = Left $ "found type " ++ show given ++ ", expected " ++ show expected

hasType :: Arith -> Type -> Either String Type
hasType e expected =
  case typeCheck e of
    Left e -> Left e
    Right given -> compareTypes given expected

checkBinop :: Arith -> Arith -> Type -> Type -> Either String Type
checkBinop e1 e2 tIn tOut =
  case (e1 `hasType` tIn, e2 `hasType` tIn) of
    (Left e,_) -> Left e
    (_,Left e) -> Left e
    _ -> Right tOut

typeCheck :: Arith -> Either String Type
typeCheck (Num _) = Right Number
typeCheck (Bool _) = Right Boolean
typeCheck (And e1 e2) = checkBinop e1 e2 Boolean Boolean
typeCheck (Or e1 e2) = checkBinop e1 e2 Boolean Boolean
typeCheck (Not e1) = e1 `hasType` Boolean
typeCheck (Eq e1 e2) = checkBinop e1 e2 Number Boolean
typeCheck (Plus e1 e2) = checkBinop e1 e2 Number Number
typeCheck (Minus e1 e2) = checkBinop e1 e2 Number Number
typeCheck (Times e1 e2) = checkBinop e1 e2 Number Number
typeCheck (If e1 e2 e3) = 
  case (e1 `hasType` Boolean, typeCheck e2) of
    (Left e, _) -> Left e
    (_, Left e) -> Left e
    (_, Right t) -> e2 `hasType` t