Proving commutativity of type level addition of natural numbers

Question

I'm playing around with what tools haskell offers for dependently typed programming. I have promoted a GADT representing natural numbers to the kind level and made a type family for addition of natural numbers. I have also made your standard "baby's first dependently typed datatype" vector, parameterized over both its length and the type it contains. The code is as follows:

data Nat where
    Z :: Nat
    S :: Nat -> Nat

type family (a :: Nat) + (b :: Nat) :: Nat where
    Z + n = n
    S m + n = S (m + n)

data Vector (n :: Nat) a where
    Nil :: Vector Z a
    Cons :: a -> Vector n a -> Vector (S n) a

Furthermore I have made an append function that takes an m-vector, an n-vetor and return an (m+n)-vector. This works as well as one might hope. However, just for the heck of it, I tried to flip it around so it returns an (n+m)-vector. This produces a compiler error though, because GHC can't prove that my addition is commutative. I'm still relatively new to type families, so I'm not sure how to write this proof myself, or if that's even something you can do in haskell.

My initial thought was to somehow utilize a type equality constraint, but I'm not sure how to move forward.

So to be clear: I want to write this function

append :: Vector m a -> Vector n a -> Vector (n + m) a
append Nil xs         = xs
append (Cons x xs) ys = x `Cons` append xs ys

but it fails to compile with

    * Could not deduce: (n + 'Z) ~ n
      from the context: m ~ 'Z
        bound by a pattern with constructor: Nil :: forall a. Vector 'Z a,
                 in an equation for `append'

Answer 1

Here's a full solution. Warning: includes some hasochism.

We start as in the original code.

{-# LANGUAGE TypeFamilies, DataKinds, TypeOperators, GADTs, PolyKinds #-}
{-# OPTIONS -Wall -O2 #-}
module CommutativeSum where

data Nat where
    Z :: Nat
    S :: Nat -> Nat

type family (a :: Nat) + (b :: Nat) :: Nat where
    'Z + n = n
    'S m + n = 'S (m + n)

data Vector (n :: Nat) a where
    Nil :: Vector 'Z a
    Cons :: a -> Vector n a -> Vector ('S n) a

The old append which type checks immediately.

append :: Vector m a -> Vector n a -> Vector (m + n) a
append Nil xs         = xs
append (Cons x xs) ys = x `Cons` append xs ys

For the other append, we need to prove that addition is commutative. We start by defining equality at the type level, exploiting a GADT.

-- type equality, also works on Nat because of PolyKinds
data a :~: b where
   Refl :: a :~: a

We introduce a singleton type, so that we can pass Nats and also pattern match on them.

-- Nat singleton, to reify type level parameters
data NatI (n :: Nat) where
  ZI :: NatI 'Z
  SI :: NatI n -> NatI ('S n)

We can associate to each vector its length as a singleton NatI.

-- length of a vector as a NatI
vecLengthI :: Vector n a -> NatI n
vecLengthI Nil = ZI
vecLengthI (Cons _ xs) = SI (vecLengthI xs)

Now the core part. We need to prove n + m = m + n by induction. This requires a few lemmas for some arithmetic laws.

-- inductive proof of: n + Z = n  
sumZeroRight :: NatI n -> (n + 'Z) :~: n
sumZeroRight ZI = Refl
sumZeroRight (SI n') = case sumZeroRight n' of
   Refl -> Refl

-- inductive proof of: n + S m = S (n + m)
sumSuccRight :: NatI n -> NatI m -> (n + 'S m) :~: 'S (n + m)
sumSuccRight ZI _m = Refl
sumSuccRight (SI n') m  = case sumSuccRight n' m of
   Refl -> Refl

-- inductive proof of commutativity: n + m = m + n
sumComm :: NatI n -> NatI m -> (n + m) :~: (m + n)
sumComm ZI m = case sumZeroRight m of Refl -> Refl
sumComm (SI n') m = case (sumComm n' m, sumSuccRight m n') of
   (Refl, Refl) -> Refl

Finally, we can exploit the proof above to convince GHC to type append as we wanted. Note that we can reuse the implementation with the old type, and then convince GHC that it can also use the new one.

-- append, with the wanted type
append2 :: Vector m a -> Vector n a -> Vector (n + m) a
append2 xs ys = case sumComm (vecLengthI xs) (vecLengthI ys) of
   Refl -> append xs ys

Final remarks. Compared to a fully dependently typed language (say, like Coq), we had to introduce singletons and spend some more effort to make them work (the "pain" part of Hasochism). In return, we can simply pattern match with Refl and let GHC figure out how to use the deduced equations, without messing with dependent matching (the "pleasure" part).

Overall, I think it's still a little easier to work with full dependent types. If/when GHC gets non-erased type quantifiers (pi n. ... beyond forall n. ...), probably Haskell will become more convenient.