Lecture 3 — 2018-01-23

Our first interpreter; type classes

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

module Lec03 where

We saw some examples from the homework and did some refactoring as a class.

Then I introduced us to our first interpreter. We started on the board, defining a grammar like so:

p, q in Prop ::= ⊤ | ⊥ | p ∧ q | p ∨ q | ¬ p | p ⇒ q

p1 = ⊤ ∧ ⊥
p2 = ⊥ ∨ ⊥

We talked about what the propositions p1 and p2 mean… nothing, yet! We had to define an interpretation function, where we interpret elements of Prop as booleans:

2 = { true, false} with standard operations &&, ||, and !

interp : Prop -> 2
interp(⊤) = true
interp(⊥) = false
interp(p ∧ q) = interp(p) && interp(q)
interp(p ∨ q) = interp(p) || interp(q)
interp(¬ p) = !interp(p)
interp(p ⇒ q)  = !interp(p) || interp(q)

Then we did the same in Haskell:

data Prop =
    T
  | F
  | And Prop Prop
  | Or Prop Prop
  | Not Prop
  | Implies Prop Prop

p1 :: Prop
p1 = T `And` F

interp :: Prop -> Bool
interp T = True
interp F = False
interp (And p q) = interp p && interp q
interp (Or p q) = interp p || interp q
interp (Not p) = not $ interp p
interp (Implies p q) = not (interp p) || interp q

We wrote a “pretty printer” for Prop which prints out appropriately parenthesized concrete syntax. It was a little aggressive, though, printing way too many parentheses:

instance Show Prop where
  show T = "T"
  show F = "F"
  show (And a b) = 
    "And (" ++ show a ++ ") (" ++ show b ++ ")"
  show (Or a b) = 
    "Or (" ++ show a ++ ") (" ++ show b ++ ")"  
  show (Implies a b) = 
    "Implies (" ++ show a ++ ") (" ++ show b ++ ")"
  show (Not a) = "Not (" ++ show a ++ ")"

Finally, we talked about how we can manipulate the abstract syntax of Prop in its own right; for example, we can translate away any use of Implies.

-- | Compile away implication in propositions.
--
-- Examples:
--
-- >>> interp (compile (Implies (Or T F) F))
-- False
--
-- >>> compile (Or T F)
-- Or T F
--
-- >>> compile (Or (Implies F T) F)
-- (Or (Or (Not F) T) F)
compile :: Prop -> Prop
compile (Implies p q) = Not (compile p) `Or` compile q
compile (And p q) = And (compile p) (compile q)
compile (Or p q) = Or (compile p) (compile q)
compile (Not p) = Not $ compile p
compile T = T
compile F = F