GHC 7.6.1 comes with new features for programming at the type level, including datatype promotion. Taking the example about type-level naturals and vectors from there, I\'d like
(Note: I have only type-checked (and not actually run) any of this code.)
Approach 1
Actually, you can manipulate proofs by storing them in GADTs. You'll need to turn on ScopedTypeVariables
for this approach to work.
data Proof n where
NilProof :: Proof Ze
ConsProof :: (n + Su Ze) ~ Su n => Proof n -> Proof (Su n)
class PlusOneIsSucc n where proof :: Proof n
instance PlusOneIsSucc Ze where proof = NilProof
instance PlusOneIsSucc n => PlusOneIsSucc (Su n) where
proof = case proof :: Proof n of
NilProof -> ConsProof proof
ConsProof _ -> ConsProof proof
rev :: PlusOneIsSucc n => Vec a n -> Vec a n
rev = go proof where
go :: Proof n -> Vec a n -> Vec a n
go NilProof Nil = Nil
go (ConsProof p) (Cons x xs) = go p xs `append` Cons x Nil
Actually, perhaps interesting motivation for the Proof
type above, I originally had just
data Proof n where Proof :: (n + Su Ze) ~ Su n => Proof n
But, this didn't work: GHC rightly complained that just because we know (Su n)+1 = Su (Su n)
doesn't imply that we know n+1 = Su n
, which is what we need to know to make the recursive call to rev
in the Cons
case. So I had to expand the meaning of a Proof
to include a proof of all equalities for naturals up to and including n
-- essentially a similar thing to the strengthening process when moving from induction to strong induction.
Approach 2
After a bit of reflection, I realized that it turns out the class is a bit superfluous; that makes this approach especially nice in that it doesn't require any extra extensions (even ScopedTypeVariables
) and doesn't introduce any extra constraints to the type of Vec
.
data Proof n where
NilProof :: Proof Ze
ConsProof :: (n + Su Ze) ~ Su n => Proof n -> Proof (Su n)
proofFor :: Vec a n -> Proof n
proofFor Nil = NilProof
proofFor (Cons x xs) = let rec = proofFor xs in case rec of
NilProof -> ConsProof rec
ConsProof _ -> ConsProof rec
rev :: Vec a n -> Vec a n
rev xs = go (proofFor xs) xs where
go :: Proof n -> Vec a n -> Vec a n
go NilProof Nil = Nil
go (ConsProof p) (Cons x xs) = go p xs `append` Cons x Nil
Approach 3
Alternately, if you switch the implementation of rev
a bit to cons the last element onto the reversed initial segment of the list, then the code can look a bit more straightforward. (This approach also requires no additional extensions.)
class Rev n where
initLast :: Vec a (Su n) -> (a, Vec a n)
rev :: Vec a n -> Vec a n
instance Rev Ze where
initLast (Cons x xs) = (x, xs)
rev x = x
instance Rev n => Rev (Su n) where
initLast (Cons x xs) = case initLast xs of
(x', xs') -> (x', Cons x xs')
rev as = case initLast as of
(a, as') -> Cons a (rev as')
Approach 4
Just like approach 3, but again observing that the type classes are not necessary.
initLast :: Vec a (Su n) -> (a, Vec a n)
initLast (Cons x xs) = case xs of
Nil -> (x, Nil)
Cons {} -> case initLast xs of
(x', xs') -> (x', Cons x xs')
rev :: Vec a n -> Vec a n
rev Nil = Nil
rev xs@(Cons {}) = case initLast xs of
(x, xs') -> Cons x (rev xs')