├── README.md ├── haskell-code.lhs ├── haskell-singletons.lhs ├── idris-code.idr └── slides.pdf /README.md: -------------------------------------------------------------------------------- 1 | # Dependent Types in Haskell 2 | 3 | Demo code for the talk Dependent Types in Haskell in Hong Kong Functional 4 | Programming meetup. 5 | 6 | - How to write dependently typed programs in Haskell and Idris respectively 7 | for simple comparison. 8 | - A tour of the singletons library. 9 | - Introduction to Dependent Haskell. 10 | -------------------------------------------------------------------------------- /haskell-code.lhs: -------------------------------------------------------------------------------- 1 | 1. Let's get started with length-indexed vector 2 | 3 | > {-# LANGUAGE 4 | > DataKinds -- data type promotion 5 | > , KindSignatures -- enables explicit kind signature 6 | > , GADTs -- generalised algebraic data types 7 | > , TypeFamilies -- type-level programming 8 | > #-} 9 | > import Data.Kind (Type) 10 | 11 | 12 | 2. A length-index vector records its length in its type by GADTs. 13 | 14 | > data Nat = Zero | Succ Nat deriving Show 15 | > 16 | > infixr 5 :> 17 | > data Vec :: Type -- type of vector 18 | > -> Nat -- length of vector 19 | > -> Type where 20 | > Nil :: Vec a 'Zero 21 | > (:>) :: a -> Vec a n -> Vec a ('Succ n) 22 | > 23 | > instance Show a => Show (Vec a n) where 24 | > show Nil = "nil" 25 | > show (a :> as) = show a ++ "::" ++ show as 26 | 27 | An integer vector of length 3: 28 | 29 | > eg0 :: Vec Int (Succ (Succ (Succ Zero))) 30 | > eg0 = (1:>2:>3:>Nil) 31 | 32 | 33 | 3. `head` of lists in GHC is not safe -- there could be runtime errors. 34 | 35 | > err = head [] 36 | > -- runtime *** Exception: Prelude.head: empty list 37 | 38 | 39 | `hd` is always safe -- applying it to empty vectors won't type-check. 40 | 41 | > hd :: Vec a ('Succ n) -> a 42 | > hd (h :> t) = h 43 | 44 | 45 | 4. Let's define addition operator for Nats. 46 | 47 | > plus :: Nat -> Nat -> Nat 48 | > plus Zero y = y 49 | > plus (Succ x) y = Succ (plus x y) 50 | 51 | 52 | 53 | When we append a vector of length m with another vector of length n, 54 | we should get a vector of length (plus m n). 55 | 56 | -- > append :: Vec a n -> Vec a m -> Vec a (plus n m) 57 | -- > append Nil ys = ys 58 | -- > append (x :> xs) ys = x :> (append xs ys) 59 | 60 | 61 | 5. What's wrong? 62 | 63 | • Couldn't match type ‘'Succ’ with ‘plus ('Succ n1)’ 64 | Expected type: Vec a (plus n m) 65 | Actual type: Vec a ('Succ (plus0 n1 m)) 66 | 67 | `plus` is a term-level function, `plus n m` represents the result 68 | of a term-level function, which GHC will not know at compile-time; it's not 69 | type-level computation. 70 | 71 | 72 | 73 | 6. For type-level computation, we need type families: 74 | 75 | > type family Plus (x::Nat) (y::Nat) where 76 | > Plus Zero y = y 77 | > Plus (Succ x) y = Succ (Plus x y) 78 | 79 | > append :: Vec a n -> Vec a m -> Vec a (Plus n m) 80 | > append Nil ys = ys 81 | > append (x :> xs) ys = x :> (append xs ys) 82 | 83 | Try an example: 84 | 85 | > eg1 = append (1:>2:>Nil) (3:>4:>5:>Nil) 86 | 87 | 88 | 7. Similar as Lists, we would like to define a `nth` function, which gets the nth 89 | element of the vector. E.g. 90 | 91 | nth 0 (1:>2:>3:>Nil) == 1 92 | nth 1 (1:>2:>3:>Nil) == 2 93 | 94 | 95 | > nth1 :: Nat -> Vec a n -> a 96 | > nth1 Zero (x :> xs) = x 97 | > nth1 (Succ n) (x :> xs) = nth1 n xs 98 | 99 | Try some examples: 100 | 101 | > eg2 = nth1 Zero eg1 102 | > eg3 = nth1 (Succ Zero) eg1 103 | 104 | 105 | 8. So far so good. But how about 106 | 107 | > eg4 = nth1 Zero Nil 108 | 109 | 110 | 111 | *** Exception: 112 | Non-exhaustive patterns in function nth1 113 | 114 | 115 | Oops. It's like what happens when we type `head []` in GHCi. 116 | We are not type-safe any more! 117 | 118 | 119 | 9. 120 | 121 | > nth2 :: Nat -> Vec a n -> a 122 | > nth2 Zero (x :> xs) = x 123 | > nth2 (Succ n) (x :> xs) = nth1 n xs 124 | > nth2 n Nil = undefined -- what to put here??? 125 | 126 | 127 | 10. Recall the type signature for `hd`: 128 | 129 | hd :: Vec a ('Succ n) -> a 130 | hd (h :> t) = h 131 | 132 | We guaranteed that `hd` can only be applied to non-empty vectors. 133 | We need to have a similar guarantee for `nth`: 134 | 135 | nth m (Vec a n) ==> m < n 136 | 137 | We first define `Less Than (<)` for Nats: 138 | 139 | > data Lt :: Nat -> Nat -> Type where 140 | > Base :: Lt Zero (Succ n) 141 | > Ind :: Lt n m -> Lt (Succ n) (Succ m) 142 | 143 | 144 | 11. Let's try again: 145 | 146 | -- > nth3 :: Nat -> Vec a n -> a 147 | -- > nth3 m v = undefined 148 | 149 | GHC interprets `m` as the type, and `Nat` as the kind of `m`. 150 | This is not what we want! 151 | 152 | 153 | 154 | 12. We need singleton types! 155 | 156 | > data SNat :: Nat -> Type where 157 | > SZero :: SNat 'Zero 158 | > SSucc :: SNat n -> SNat ('Succ n) 159 | 160 | The only role of `SNat` is to do similar thing as (m:Nat) in Idris. 161 | 162 | We call `SNat` a singleton type: types with only one non-bottom value. 163 | 164 | SZero is the only inhabitant of the type SNat 'Zero; 165 | (SSucc n) is the only inhabitant of the type 'Succ n. 166 | 167 | data SNat :: Nat -> Type where 168 | --- --- 169 | | | 170 | - iso.. - 171 | 172 | SZero :: SNat 'Zero 173 | ----- ---- 174 | | | 175 | | | 176 | -- isomorphic - 177 | 178 | SSucc :: SNat n -> SNat ('Succ n) 179 | --------------- --------- 180 | | | 181 | | | 182 | -------- isomorphic -------- 183 | 184 | 185 | 13. 186 | 187 | > nth4 :: SNat m -> Vec a n -> Lt m n -> a 188 | > nth4 SZero (x :> xs) prf = x 189 | > nth4 (SSucc m) (x :> xs) (Ind prf) = nth4 m xs prf 190 | 191 | 192 | 193 | 194 | Rewrite the examples: 195 | 196 | > eg2' = nth4 SZero eg1 Base 197 | > eg3' = nth4 (SSucc SZero) eg1 (Ind Base) 198 | 199 | 200 | 201 | We can never construct a proof for eg4 202 | 203 | eg4 = nth4 (Succ Zero) Nil ?prf 204 | 205 | 206 | 14. However, providing proofs can be tiresome. 207 | 208 | In Haskell, we can implement `LT` as a constraint and let GHC solve it: 209 | 210 | > type family Lt' (m::Nat) (n::Nat) :: Bool 211 | > type instance Lt' Zero (Succ n) = 'True 212 | > type instance Lt' m Zero = 'False 213 | > type instance Lt' ('Succ m) ('Succ n) = Lt' m n 214 | 215 | 216 | 217 | > nth :: (Lt' m n ~ 'True) => SNat m -> Vec a n -> a 218 | > nth SZero (x :> xs) = x 219 | > nth (SSucc m) (x :> xs) = nth m xs 220 | 221 | 222 | Rewrite the examples again: 223 | 224 | > eg2'' = nth SZero eg1 225 | > eg3'' = nth (SSucc SZero) eg1 226 | 227 | 228 | 229 | 15. Any problem so far? 230 | 231 | 232 | 16. We have two definition of `plus` for Nat: 233 | 234 | plus :: Nat -> Nat -> Nat 235 | plus Zero y = y 236 | plus (Succ x) y = Succ (plus x y) 237 | 238 | type family Plus (x::Nat) (y::Nat) where 239 | Plus Zero y = y 240 | Plus (Succ x) y = Succ (Plus x y) 241 | 242 | We have `Nat` and `SNat` 243 | 244 | data Nat = Zero | Succ Nat deriving Show 245 | 246 | data SNat :: Nat -> Type where 247 | SZero :: SNat 'Zero 248 | SSucc :: SNat n -> SNat ('Succ n) 249 | 250 | We are repeating everything! Why? 251 | 252 | 253 | 17. Because GHC enforces a phase separation between runtime values and 254 | compile-time types. 255 | 256 | In order to express the dependency between one runtime argument and one 257 | compile-time type, we define type-families and singleton types by repeating 258 | original term-level definitions to add type-level supports. 259 | 260 | Can we do better? 261 | 262 | 18. Yes we can. 263 | 264 | The *Singletons* library is introduced in Dependently Typed Programming with 265 | Singletons (Haskell'12) By Eisenberg and Weirich. 266 | The library uses Template Haskell to: 267 | 268 | - automatically generate singleton types 269 | - automatically lift functions to the type level 270 | - automatically refine functions with rich types 271 | 272 | 273 | Template Haskell: a GHC extension to Haskell that adds compile-time 274 | metaprogramming facilities. 275 | -------------------------------------------------------------------------------- /haskell-singletons.lhs: -------------------------------------------------------------------------------- 1 | > {-# LANGUAGE 2 | > DataKinds -- data type promotion 3 | > , KindSignatures -- enables explicit kind signature 4 | > , GADTs -- generalised algebraic data types 5 | > , TypeFamilies -- type-level programming 6 | > , TemplateHaskell -- for singletons 7 | > , ScopedTypeVariables 8 | > , UndecidableInstances 9 | > , InstanceSigs 10 | > #-} 11 | > 12 | > import Data.Kind (Type) 13 | > import Data.Singletons.TH 14 | 15 | $(...) -- Template Haskell splice 16 | [d| ... |] -- for declaration 17 | 18 | > $(singletons [d| 19 | > data Nat = Zero | Succ Nat deriving Show 20 | > 21 | > plus :: Nat -> Nat -> Nat 22 | > plus Zero y = y 23 | > plus (Succ x) y = Succ (plus x y) 24 | > 25 | > lt' :: Nat -> Nat -> Bool 26 | > lt' Zero (Succ n) = True 27 | > lt' m Zero = False 28 | > lt' (Succ m) (Succ n) = lt' m n 29 | > |]) 30 | 31 | generates singleton types: 32 | 33 | data SNat :: Nat -> Type where 34 | SZero :: SNat 'Zero 35 | SSucc :: SNat n -> SNat ('Succ n) 36 | 37 | lifting functions to type-level computations: 38 | 39 | type family Plus (x::Nat) (y::Nat) where 40 | Plus Zero y = y 41 | Plus (Succ x) y = Succ (Plus x y) 42 | 43 | type family Lt' (m::Nat) (n::Nat) :: Bool 44 | type instance Lt' Zero (Succ n) = 'True 45 | type instance Lt' m Zero = 'False 46 | type instance Lt' ('Succ m) ('Succ n) = Lt' m n 47 | 48 | > infixr 5 :> 49 | > data Vec :: Type -> Nat -> Type where 50 | > Nil :: Vec a 'Zero 51 | > (:>) :: a -> Vec a n -> Vec a ('Succ n) 52 | 53 | > instance Show a => Show (Vec a n) where 54 | > show Nil = "nil" 55 | > show (a :> as) = show a ++ "::" ++ show as 56 | 57 | > append :: Vec a n -> Vec a m -> Vec a (Plus n m) 58 | > append Nil ys = ys 59 | > append (x :> xs) ys = x :> (append xs ys) 60 | 61 | > nth :: (Lt' m n ~ 'True) => SNat m -> Vec a n -> a 62 | > nth SZero (x :> xs) = x 63 | > nth (SSucc m) (x :> xs) = nth m xs 64 | 65 | 66 | Lessons we learnt: 67 | 68 | Singletons library is useful for writing dependent type programs. It generates 69 | boilerplate code for you, which enables us to write programs similar in other 70 | dependent type languages, e.g. Idris. 71 | 72 | Any problem so far? 73 | -------------------------------------------------------------------------------- /idris-code.idr: -------------------------------------------------------------------------------- 1 | %hide Nat -- hiding Prelude.Nat 2 | 3 | data Nat = Zero | Succ Nat 4 | 5 | infixr 5 :> 6 | data Vec : Type -> Nat -> Type where 7 | Nil : Vec a Zero 8 | (:>) : (x : a) -> Vec a k -> Vec a (Succ k) 9 | 10 | 11 | eg0 : Vec Integer (Succ (Succ (Succ Zero))) 12 | -- Idris requires a top-level type annotation for every function 13 | eg0 = (1:>2:>3:>Nil) 14 | 15 | 16 | hd : Vec a (Succ k) -> a 17 | hd (h :> t) = h 18 | 19 | plus : Nat -> Nat -> Nat 20 | plus Zero y = y 21 | plus (Succ x) y = Succ (plus x y) 22 | 23 | append : Vec a m -> Vec a n -> Vec a (plus m n) 24 | append Nil ys = ys 25 | append (x :> xs) ys = x :> (append xs ys) 26 | 27 | eg1 : Vec Integer (Succ (Succ (Succ (Succ (Succ Zero))))) 28 | -- Idris requires a top-level type annotation for every function 29 | eg1 = append (1:>2:>Nil) (3:>4:>5:>Nil) 30 | 31 | data Lt : Nat -> Nat -> Type where 32 | Base : Lt Zero (Succ n) 33 | Ind : Lt n m -> Lt (Succ n) (Succ m) 34 | 35 | -- nth : (m:Nat) -> Vec a n -> (prf : Lt m n) -> a 36 | -- nth Zero (x :> xs) prf = x 37 | -- nth (Succ n) (x :> xs) prf = ?rhs 38 | 39 | nth : (m:Nat) -> Vec a n -> (prf : Lt m n) -> a 40 | nth Zero (x :> xs) prf = x 41 | nth (Succ n) (x :> xs) (Ind prf) = nth n xs prf 42 | 43 | eg2 : Integer 44 | eg2 = nth Zero eg1 Base 45 | 46 | eg3 : Integer 47 | eg3 = nth (Succ Zero) eg1 (Ind Base) 48 | 49 | nth_auto : (m:Nat) -> Vec a n -> {auto prf : Lt m n} -> a 50 | nth_auto m xs {prf} = nth m xs prf 51 | 52 | eg2' : Integer 53 | eg2' = nth_auto Zero eg1 54 | 55 | eg3' : Integer 56 | eg3' = nth_auto (Succ Zero) eg1 57 | -------------------------------------------------------------------------------- /slides.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/xnning/dependent-types-in-haskell/547f6efc30825a2b978302a1bcfbc509dd83f10e/slides.pdf --------------------------------------------------------------------------------