# Week 5

### Lecture slides¶

• Type classes and type inference: pdf, key,

### Code snippets¶

Below are the code snippets from class.

#### Show¶

```data Tree a = Node (Tree a) (Tree a)
| Leaf a

instance Show a => Show (Tree a) where
show (Leaf a) = show a
show (Node lt rt) = show lt ++ " /\\ " ++ show rt

data Color = Red | Green | Blue | Indigo | Violet
deriving Show
```

#### Eq¶

```-- Recall our tiny calculator language
data Expr = AddExpr Expr Expr
| MulExpr Expr Expr
| ConstExpr Int
deriving Eq

eval :: Expr -> Int
eval (ConstExpr n) = n
eval (AddExpr e1 e2) = eval e1 + eval e2
eval (MulExpr e1 e2) = eval e1 * eval e2

instance Show Expr where
show (ConstExpr i) = show i
show (AddExpr e1 e2) = unwords ["(", show e1, ")", "+", "(", show e2, ")"]
show (MulExpr e1 e2) = unwords ["(", show e1, ")", "*", "(", show e2, ")"]

ex0 :: Expr
ex0 = (AddExpr (ConstExpr 2) (MulExpr (ConstExpr 1) (ConstExpr 1)))

ex1 :: Expr
ex1 = (AddExpr (ConstExpr 1) (MulExpr (ConstExpr 1) (ConstExpr 2)))

eq = ex0 == ex1 -- A: yes, B: no?
--
-- instance Eq Expr where
--   exp1 == exp2 = eval exp1 == eval exp2
```

#### Num¶

```module Intro where

-- * One type can have multiple constructors
data Point = Cartesian Double Double
| Polar Double Double
deriving Show

-- E.g., convert point to cartesian:
toCartesian :: Point -> Point
toCartesian point = case point of
Polar r theta -> Cartesian (r * cos theta)
(r * sin theta)
pt@(Cartesian _ _) -> pt

instance Num Point where
(Cartesian x1 y1) + (Cartesian x2 y2) = Cartesian (x1+x2) (y1+y2)
p1@(Polar _ _) + p2@(Polar _ _) = toCartesian p1 + toCartesian p2

(Cartesian x1 y1) * (Cartesian x2 y2) = Cartesian (x1*x2) (y1*y2)
p1 * p2 = toCartesian p1 * toCartesian p2
```

#### Desugaring type classes to dictionaries¶

Original code, using type classes:

```module TypeClasses1 where
import qualified Prelude
import Prelude hiding (Num(..), Eq(..), Ord(..), map)

-- # Eq class examples
class Eq a where
(==) :: a -> a -> Bool
(==) x y = not \$ x /= y
(/=) :: a -> a -> Bool
(/=) x y = not \$ x == y

instance Eq Bool where
(==) True  True  = True
(==) False False = True
(==) _     _     = False

allEqual :: Eq a => a -> a -> a -> Bool
allEqual a b c = (==) a b && (==) b c

instance Eq a => Eq [a] where
(==) []     []     = True
(==) (x:xs) (y:ys) = (==) x y && (==) xs ys
--- ^            ^  A: yes , B: no?
(==) _      _      = False

instance (Eq a, Eq b) => Eq (a, b) where
(==) (x1,y1) (x2,y2) = (==) x1 x2 && (==) y1 y2

-- # Ord class

class Eq a => Ord a where
(<)  :: a -> a -> Bool
(<) x y = (<=) x y && (/=) x y
(<=) :: a -> a -> Bool
(<=) x y = (<) x y || (==) x y

compare :: Ord a => a -> a -> Ordering
compare x y = if x == y then EQ
else if x < y
then LT
else GT

-- # Num class

-- Our "primitives"
plusInt :: Int -> Int -> Int
plusInt = (Prelude.+)
mulInt :: Int -> Int -> Int
mulInt  = (Prelude.*)
negInt :: Int -> Int
negInt = Prelude.negate
integerToInt :: Integer -> Int
integerToInt = Prelude.fromInteger

-- Dictionary
class Num a where
(+) :: a -> a -> a
(*) :: a -> a -> a
negate :: a -> a

square :: Num a => a -> a
square x = x * x

instance Num Int where
(+) = plusInt
(*) = mulInt
negate = negInt

squares :: (Num a, Num b) => a -> b -> (a,b)
squares x y = (x*x, y*y)
```

Desugaring it to dictionaries:

```module TypeClasses1 where
import qualified Prelude
import Prelude hiding (Num(..), Eq(..), Ord(..), map)

-- # Eq class with dictionaries

data Eq a = MkEqDict {
(==) :: a -> a -> Bool,
(/=) :: a -> a -> Bool
}

-- instance Eq Bool where ...
dEqBool :: Eq Bool
dEqBool = MkEqDict {
(==) = eq,
(/=) = nEq
} where eq True   True  = True
eq False  False = True
eq _      _     = False
nEq x y = not \$ eq x y

allEqual :: Eq a -> a -> a -> a -> Bool
allEqual dict a b c =
(==) dict a b && (==) dict b c

-- instance Eq a => Eq [a] where ...
dEqList :: Eq a -> Eq [a]
dEqList elDict = MkEqDict eq nEq
where eq [] []         = True
eq (x:xs) (y:ys) =
(==) elDict x y && eq xs ys
eq _ _           = False
nEq x y          =  not \$ eq x y

-- instance (Eq a, Eq b) => Eq (a, b) where ...
dEqPair :: Eq a -> Eq b -> Eq (a, b)
dEqPair aDict bDict = MkEqDict eq nEq
where eq (x1,y1) (x2,y2) =
(==) bDict y1 y2
nEq x y            =  not \$ eq x y

-- # Ord class

data Ord a = MkOrd { (<=) :: a -> a -> Bool,
eqD :: Eq a }

compare :: Ord a -> a -> a -> Ordering
compare d x y = undefined

-- # Num class

-- Our "primitives"
plusInt :: Int -> Int -> Int
plusInt = (Prelude.+)
mulInt :: Int -> Int -> Int
mulInt  = (Prelude.*)
negInt :: Int -> Int
negInt = Prelude.negate
integerToInt :: Integer -> Int
integerToInt = Prelude.fromInteger

-- Dictionary
data Num a = MkNumDict {
(+) :: a -> a -> a,
(*) :: a -> a -> a,
negate :: a -> a
}

-- square :: Num a => a -> a
square :: Num a -> a -> a
square = undefined

dNumInt :: Num Int
dNumInt = MkNumDict plusInt mulInt negInt

-- squares :: (Num a, Num b) => a -> b -> (a, b)
squares :: Num a -> Num b -> a -> b -> (a,b)
squares dx dy x y = undefined
```

#### A more complex example with type constructors¶

```{-# LANGUAGE InstanceSigs #-}
module HasMap where

import Prelude hiding (map)

mapList :: (a -> b) -> [a] -> [b]
mapList f [] = []
mapList f (x:xs) = f x : mapList f xs

mapMaybe :: (a -> b) -> Maybe a -> Maybe b
mapMaybe f Nothing = Nothing
mapMaybe f (Just x) = Just (f x)

data Tree a = Leaf a
| Node (Tree a) (Tree a)

mapTree :: (a -> b) -> Tree a -> Tree b
mapTree f (Leaf x) = Leaf (f x)
mapTree f (Node t1 t2) = Node (mapTree f t1) (mapTree f t2)

class HasMap g where
map :: (a -> b) -> g a -> g b

instance HasMap [] where
map :: (a -> b) -> [a] -> [b]
map f [] = []
map f (x:xs) = f x : map f xs

instance HasMap Maybe where
map = mapMaybe

instance HasMap Tree where
map = mapTree
```