I am experimenting with Haskell's type system and want to write a type safe addition function. This function should accept two singleton witnesses representing numbers and returns a singleton witness of a number whose type carries the proof that it is indeed a sum of the arguments. Here is the code:
{-# language TypeFamilies, KindSignatures, DataKinds, PolyKinds, UndecidableInstances, GADTs #-}
data Nat = Zero | Succ Nat deriving Show
type family Add (m :: Nat) (n :: Nat) :: Nat where
Add Zero n = n
Add (Succ m) n = Add m (Succ n)
data SNat :: Nat -> * where
Zy :: SNat Zero
Suc :: SNat m -> SNat (Succ m)
data Bounded' m = B m
sum' :: Bounded' (SNat m) -> Bounded' (SNat n) -> Bounded' (SNat (Add m n))
sum' (B m) (B n) = B $ case (m, n) of
(Zy,x) -> x
(Suc x, y) -> let B z = sum' (B x) (B y) in Suc z
Here is the error:
• Could not deduce: Add m1 ('Succ n) ~ 'Succ (Add m1 n)
from the context: m ~ 'Succ m1
bound by a pattern with constructor:
Suc :: forall (m :: Nat). SNat m -> SNat ('Succ m),
in a case alternative
at main.hs:17:22-26
Expected type: SNat (Add m n)
Actual type: SNat ('Succ (Add m1 n))
• In the expression: Suc z
In the expression: let B z = sum' (B x) (B y) in Suc z
In a case alternative:
(Suc x, y) -> let B z = sum' (B x) (B y) in Suc z
I understand the error message. How do I provide GHC with the necessary proof that Add m n = Succ (Add k n) in expression Suc z when it learns that m ~ Succ k (in second case match) and are there alternative approaches to doing so. Thank you.
Your definition of addition is not the conventional one.
type family Add (m :: Nat) (n :: Nat) :: Nat where
Add Zero n = n
Add (Succ m) n = Add m (Succ n)
This is a "tail recursive" addition. It sure seems like there should be a way to prove your properties using this form of addition, but I can't figure it out. Until then, tail recursion at the type/property level tends to be a lot more difficult to work with than the standard kind:
type family Add (m :: Nat) (n :: Nat) :: Nat where
Add Zero n = n
Add (Succ m) n = Succ (Add m n)
This latter definition of addition makes your sum' pass without any convincing at all.
EDIT actually it was easy once I saw it right. Here's what I got (importing Data.Type.Equality and enabling LANGUAGE TypeOperators):
propSucc2 :: SNat m -> SNat n -> Add m (Succ n) :~: Succ (Add m n)
propSucc2 Zy _ = Refl
propSucc2 (Suc m) n = propSucc2 m (Suc n)
Tail-recursive definition, tail-recursive proof. Then to use it, you use gcastWith:
sum' (B m) (B n) = ...
(Suc x, y) -> gcastWith (propSucc2 x y)
(let B z = sum' (B x) (B y) in Suc z)
gcastWith just takes a :~: equality and makes it available to the type checker within the scope of its second argument.
By the way, if you define sum' in a parallel structure to your Add type family, then you don't need any lemmas. Getting things to follow parallel structures is a good technique to keep things easy (this is part of the art of dependent programming, since it's not always obvious how):
sum' :: Bounded' (SNat m) -> Bounded' (SNat n) -> Bounded' (SNat (Add m n))
sum' (B Zy) (B n) = B n
sum' (B (Suc m)) (B n) = sum' (B m) (B (Suc n))
Related
I am trying to write a version of take that works on length-indexed vectors. This requires the number to take from to be less than or equal to the length of the vector.
This is the current version of my code:
data Nat where
Zero :: Nat
Succ :: Nat -> Nat
data SNat (n :: Nat) where
SZero :: SNat Zero
SSucc :: SNat n -> SNat (Succ n)
data Vec (n :: Nat) (a :: Type) where
Nil :: Vec Zero a
Cons :: a -> Vec n a -> Vec (Succ n) a
class (m :: Nat) >= (n :: Nat)
instance m >= Zero
instance m >= n => (Succ m >= Succ n)
take :: (m >= n) => SNat n -> Vec m a -> Vec n a
take (SZero ) _ = Nil
take (SSucc n) (x `Cons` xs) = x `Cons` (take n xs)
However, I am getting this error which I am not sure how to solve:
* Could not deduce (n2 >= n1) arising from a use of `take'
from the context: m >= n
bound by the type signature for:
take :: forall (m :: Nat) (n :: Nat) a.
(m >= n) =>
SNat n -> Vec m a -> Vec n a
at src\AnotherOne.hs:39:1-48
or from: (n :: Nat) ~ ('Succ n1 :: Nat)
bound by a pattern with constructor:
SSucc :: forall (n :: Nat). SNat n -> SNat ('Succ n),
in an equation for `take'
at src\AnotherOne.hs:41:7-13
or from: (m :: Nat) ~ ('Succ n2 :: Nat)
bound by a pattern with constructor:
Cons :: forall a (n :: Nat). a -> Vec n a -> Vec ('Succ n) a,
in an equation for `take'
at src\AnotherOne.hs:41:17-27
Possible fix:
add (n2 >= n1) to the context of the data constructor `Cons'
* In the second argument of `Cons', namely `(take n xs)'
In the expression: x `Cons` (take n xs)
In an equation for `take':
take (SSucc n) (x `Cons` xs) = x `Cons` (take n xs
I have tried a few different iterations of the type class, using OVERLAPS and even INCOHERENT but I have not been able to fix it. HLS also tells me that the pattern matching is incomplete, saying that I am not matching (SSucc SZero) Nil and (SSucc (SSucc _)) Nil.
However if I try to write:
test = take (SSucc SZero) Nil
it correctly errors with Couldn't match type ‘'Zero’ with ‘'Succ 'Zero’, suggesting that my problem is specifically in the function definition, since from a few tests the API for the function seems correct.
Lastly I have been suggested to just use a type family for this, doing:
type (>=~) :: Nat -> Nat -> Bool
type family m >=~ n where
m >=~ Zero = True
Succ m >=~ Succ n = m >=~ n
_ >=~ _ = False
type m >= n = m >=~ n ~ True
Which does work, but I was trying to solve this using Haskell instances. As a side question, is there any benefit of one over the other?
The problem is that the interface of your >= class doesn't in any way express what it means for a number to be at least as great as another.
To do that, I would suggest refactoring the singleton type to clearly separate the two possible cases:
data SZero (n :: Nat) where
SZero :: SZero 'Zero
data SPositive (n :: Nat) where
SSucc :: SNat n -> SPositive ('Succ n)
type SNat n = Either (SZero n) (SPositive n)
Furthermore, we need to have a way to express rolling back the inductive steps on the type level. Here we need a type family, but it can be much simpler than your >=~ one:
type family Pred (n :: Nat) :: Nat where
Pred ('Succ n) = n
Notice this is not total! It's ok: type families can safely point to nowhere. You can still use them in a context where the compiler can infer that the clause that is there applies.
Now we can formulate the class. The crucial theorem that you noticed was missing was that in the Succ case, you can apply induction over the predecessors. More precisely, we only need to know that n is positive, in order to be able to step down the m≥n property to the predecessors of both numbers. I.e. the mathematical statement is
m≥n ∧ positive(n) ⟹ pred(m) ≥ pred(n).
We can now express exactly that, using the CPS trick to demote the implication arrow into the value-level:
class m>=n where
atLeastAsPositive :: SPositive n -> (Pred m >= Pred n => r) -> r
For the Zero case, this theorem doesn't even apply, but that's no problem – we know there aren't any suitable singletons anyway, so we can safely use an empty case match:
instance m >= 'Zero where
atLeastAsPositive s = case s of {}
The interesting case is the one of positive numbers. The way we have formulated the type, the compiler can easily connect the threads:
instance m >= n => ('Succ m >= 'Succ n) where
atLeastAsPositive (SSucc _) φ = φ
And finally, we invoke that theorem in your take function:
take :: ∀ m n a . (m >= n) => SNat n -> Vec m a -> Vec n a
take (Left SZero) _ = Nil
take (Right s#(SSucc n)) (x `Cons` xs)
= atLeastAsPositive #m s (x `Cons` (take n xs))
I recently learned about promotion and decided to try writing vectors.
{-# LANGUAGE DataKinds, GADTs, KindSignatures #-}
module Vector where
data Nat = Next Nat | Zero
data Vector :: Nat -> * -> * where
Construct :: t -> Vector n t -> Vector ('Next n) t
Empty :: Vector 'Zero t
instance Functor (Vector n) where
fmap f a =
case a of
Construct x b -> Construct (f x) (fmap f b)
Empty -> Empty
So far, everything is working. But I ran into a problem when trying to make Vector instance of Applicative.
instance Applicative (Vector n) where
a <*> b =
case a of
Construct f c ->
case b of
Construct x d -> Construct (f x) (c <*> d)
Empty -> Empty
pure x = _
I had no idea how to do pure. I tried this:
case n of
Next _ -> Construct x (pure x)
Zero -> Empty
but got Variable not in scope: n :: Nat error for the first line and Couldn't match type n with 'Zero for the third line of this expression.
So, I used the following hack.
class Applicative' n where
ap' :: Vector n (t -> u) -> Vector n t -> Vector n u
pure' :: t -> Vector n t
instance Applicative' n => Applicative' ('Next n) where
ap' (Construct f a) (Construct x b) = Construct (f x) (ap' a b)
pure' x = Construct x (pure' x)
instance Applicative' 'Zero where
ap' Empty Empty = Empty
pure' _ = Empty
instance Applicative' n => Applicative (Vector n) where
(<*>) = ap'
pure = pure'
It gets the job done, but it's not pretty. It introduces a useless class Applicative'. And every time I want to use Applicative for Vector in any function, I have to supply the additional useless constraint Applicative' n which actually holds for any n.
What would be a better, cleaner way of doing this?
You could make same directly:
instance Applicative (Vector Zero) where
a <*> b = Empty
pure x = Empty
instance Applicative (Vector n) => Applicative (Vector (Next n)) where
a <*> b =
case a of
Construct f c ->
case b of
Construct x d -> Construct (f x) (c <*> d)
pure x = Construct x (pure x)
As I can reason about it: for different types of the class, the code should be type-aware. If you had several instances, different types would get different implementation, and it would be easily resolved. But, if you try to make it with single non-recursive instance, there is basically no information about the type in runtime, and code which is always the same still needs to decide which type to handle. When you have input parameters, you can exploit GADTs to provide you the type information. But for pure there are no input parameters. So you have to have some context for the Applicative instance.
This is a (commented) alternative which exploits the singletons package.
Very roughly, Haskell does not let us pattern match on type-level values such as n in the code above. With singletons, we can, at the cost of requiring and providing a few instances of SingI here and there.
{-# LANGUAGE GADTs , KindSignatures, DataKinds, TemplateHaskell,
TypeFamilies, ScopedTypeVariables #-}
{-# OPTIONS -Wall #-}
import Data.Singletons.TH
-- Autogenerate singletons for this type
$(singletons [d|
data Nat = Next Nat | Zero
|])
-- as before
data Vector :: Nat -> * -> * where
Construct :: t -> Vector n t -> Vector ('Next n) t
Empty :: Vector 'Zero t
-- as before
instance Functor (Vector n) where
fmap _ Empty = Empty
fmap f (Construct x b) = Construct (f x) (fmap f b)
-- We now require n to carry its own SingI instance.
-- This allows us to pattern match on n.
instance SingI n => Applicative (Vector n) where
Empty <*> Empty = Empty
-- Here, we need to access the singleton on n, so that later on we
-- can provide the SingI (n-1) instance we need for the recursive call.
-- The withSingI allows us to use m :: SNat (n-1) to provide the instance.
(Construct f c) <*> (Construct x d) = case sing :: SNat n of
SNext m -> withSingI m $ Construct (f x) (c <*> d)
-- Here, we can finally pattern match on n.
-- As above, we need to provide the instance with withSingI
-- to the recursive call.
pure x = case sing :: SNat n of
SZero -> Empty
SNext m -> withSingI m $ Construct x (pure x)
Using this will require to provide a SingI n instance at every use, which is a bit inconvenient, but not too much (IMO). The sad part is that <*> does not really need SingI n, since, in principle, it could recompute that from the two vectors at hand. However, pure has no input vector, so it can only pattern match with a provided singleton.
As another alternative, similar to the original code, one could write
instance Applicative (Vector Zero) where
...
instance Applicative (Vector n) => Applicative (Vector (Next n)) where
...
This is not completely equivalent, and will require to add contexts Applicative (Vector n) => in all the functions later on where n is unknown, but could be enough for many purposes.
Consider this an addendum to #chi's answer to provide additional explanation of the singleton approach...
I would suggest reading the Hasochism paper if you haven't already done so. In particular, in section 3.1 of that paper, they deal with exactly this problem, and use it as the motivating example for when implicit singleton parameters (the SingI of #chi's answer, and the NATTY type class in the Hasochism paper) are necessary, rather than merely convenient.
As it applies to your code, the main issue is that pure needs a run-time representation of the length of the vector that it's supposed to be generating, and the type-level variable n doesn't fit the bill. The solution is to introduce a new GADT, a "singleton" that provides runtime values that correspond directly to the promoted types Next and Zero:
data Natty (n :: Nat) where
ZeroTy :: Natty Zero
NextTy :: Natty n -> Natty (Next n)
I tried to use roughly the same naming convention as the paper: Natty is the same, and ZeroTy and NextTy correspond to the paper's Zy and Sy.
By itself, this explicit singleton is useful. For example, see the definition of vchop in the paper. Also, we can easily write a variant of pure that takes the explicit singleton to do its job:
vcopies :: Natty n -> a -> Vector n a
vcopies ZeroTy _ = Empty
vcopies (NextTy n) x = Construct x (vcopies n x)
We can't yet use this to define pure, though, because pure's signature is determined by the Applicative type class, and we have no way to squeeze the explicit singleton Natty n in there.
The solution is to introduce implicit singletons, which allow us to retrieve an explicit singleton whenever needed through the natty function in the context of the following type class:
class NATTY n where
natty :: Natty n
instance NATTY Zero where
natty = ZeroTy
instance NATTY n => NATTY (Next n) where
natty = NextTy natty
Now, provided we're in a NATTY n context, we can call vcopies natty to supply vcopies with its explicit natty parameter, which allows us to write:
instance NATTY n => Applicative (Vector n) where
(<*>) = vapp
pure = vcopies natty
using the definitions of vcopies and natty above, and the definition of vapp below:
vapp :: Vector n (a -> b) -> Vector n a -> Vector n b
vapp Empty Empty = Empty
vapp (Construct f c) (Construct x d) = Construct (f x) (vapp c d)
Note one oddity. We needed to introduce this vapp helper function for an obscure reason. The following instance without NATTY matches your case-based definition and type-checks fine:
instance Applicative (Vector n) where
Empty <*> Empty = Empty
Construct f c <*> Construct x d = Construct (f x) (c <*> d)
pure = error "Argh! No NATTY!"
If we add the NATTY constraint to define pure:
instance NATTY n => Applicative (Vector n) where
Empty <*> Empty = Empty
Construct f c <*> Construct x d = Construct (f x) (c <*> d)
pure = vcopies natty
the definition of (<*>) doesn't type check any more. The problem is that the NATTY n constraint on the left-hand side of the second (<*>) case doesn't automatically imply a NATTY n1 constraint on the right-hand side (where Next n ~ n1), so GHC doesn't want to allow us to call (<*>) on the right-hand side. In this case, because the constraint isn't actually needed after it's used for the first time, a helper function without a NATTY constraint, namely vapp, works around the problem.
#chi uses case matching on natty and the helper function withSingI as an alternative workaround. The equivalent code here would use a helper function that turns an explicit singleton into an implicit NATTY context:
withNATTY :: Natty n -> (NATTY n => a) -> a
withNATTY ZeroTy a = a
withNATTY (NextTy n) a = withNATTY n a
allowing us to write:
instance NATTY n => Applicative (Vector n) where
Empty <*> Empty = Empty
Construct f c <*> Construct x d = case (natty :: Natty n) of
NextTy n -> withNATTY n $ Construct (f x) (c <*> d)
pure x = case (natty :: Natty n) of
ZeroTy -> Empty
NextTy n -> Construct x (withNATTY n $ pure x)
This would need both ScopedTypeVariables and RankNTypes.
Anyway, sticking with the helper functions, the complete program looks like this:
{-# LANGUAGE DataKinds, GADTs, KindSignatures #-}
module Vector where
data Nat = Next Nat | Zero
data Vector :: Nat -> * -> * where
Construct :: t -> Vector n t -> Vector ('Next n) t
Empty :: Vector 'Zero t
data Natty (n :: Nat) where
ZeroTy :: Natty Zero
NextTy :: Natty n -> Natty (Next n)
class NATTY n where
natty :: Natty n
instance NATTY Zero where
natty = ZeroTy
instance NATTY n => NATTY (Next n) where
natty = NextTy natty
instance Functor (Vector n) where
fmap f a =
case a of
Construct x b -> Construct (f x) (fmap f b)
Empty -> Empty
instance NATTY n => Applicative (Vector n) where
(<*>) = vapp
pure = vcopies natty
vapp :: Vector n (a -> b) -> Vector n a -> Vector n b
vapp Empty Empty = Empty
vapp (Construct f c) (Construct x d) = Construct (f x) (vapp c d)
vcopies :: Natty n -> a -> Vector n a
vcopies ZeroTy _ = Empty
vcopies (NextTy n) x = Construct x (vcopies n x)
The correspondence with the singletons library is that:
$(singletons [d|
data Nat = Next Nat | Zero
|])
automatically generates the singletons (with constructors SZero and SNat instead of ZeroTy and NatTy; and with type SNat instead of Natty) and the implicit singleton class (called SingI instead of NATTY and using the function sing instead of natty), giving the complete program:
{-# LANGUAGE DataKinds, GADTs, KindSignatures, TemplateHaskell, TypeFamilies #-}
module Vector where
import Data.Singletons
import Data.Singletons.TH
$(singletons [d|
data Nat = Next Nat | Zero
|])
data Vector :: Nat -> * -> * where
Construct :: t -> Vector n t -> Vector ('Next n) t
Empty :: Vector 'Zero t
instance Functor (Vector n) where
fmap f a =
case a of
Construct x b -> Construct (f x) (fmap f b)
Empty -> Empty
instance SingI n => Applicative (Vector n) where
(<*>) = vapp
pure = vcopies sing
vapp :: Vector n (a -> b) -> Vector n a -> Vector n b
vapp Empty Empty = Empty
vapp (Construct f c) (Construct x d) = Construct (f x) (vapp c d)
vcopies :: SNat n -> a -> Vector n a
vcopies SZero _ = Empty
vcopies (SNext n) x = Construct x (vcopies n x)
For more on what the singletons library does and how it's built, I'd suggest reading Introduction to Singletons.
Several other answers have introduced a Natty or SNat type to implement pure. Indeed, having such a type greatly reduces the need for one-off type classes. A potential downside of the traditional Natty/SNat GADT, however, is that your program will actually build the representation and then use it, even if the Nat is known at compile time. This generally wouldn't happen with the auxiliary-class approach. You can get around this by using a different representation.
I'm going to use these names:
data Nat = Z | S Nat
Suppose we define the usual
data Natty n where
Zy :: Natty 'Z
Sy :: Natty n -> Natty ('S n)
We can write its eliminator (induction principle) thus:
natty :: p 'Z -> (forall k. p k -> p ('S k)) -> Natty n -> p n
natty z _ Zy = z
natty z s (Sy n) = s (natty z s n)
For our purpose, we don't really need the Natty; we only need its induction principle! So let's define another version. I imagine there's a proper name for this encoding, but I have no idea what it might be.
newtype NatC n = NatC
{ unNatC :: forall p.
p 'Z -- base case
-> (forall k. p k -> p ('S k)) -- inductive step
-> p n }
This is isomorphic to Natty:
nattyToNatC :: Natty n -> NatC n
nattyToNatC n = NatC (\z s -> natty z s n)
natCToNatty :: NatC n -> Natty n
natCToNatty (NatC f) = f Zy Sy
Now we can write a class for Nats we know how to eliminate:
class KnownC n where
knownC :: NatC n
instance KnownC 'Z where
knownC = NatC $ \z _ -> z
instance KnownC n => KnownC ('S n) where
knownC = NatC $ \z s -> s $ unNatC knownC z s
Now here's a vector type (I've renamed things to match my own taste):
infixr 4 :<
data Vec :: Nat -> * -> * where
(:<) :: t -> Vec n t -> Vec ('S n) t
Nil :: Vec 'Z t
Because Vec's length parameter isn't its last one, we'll have to flip it to use with NatC:
newtype Flip f a n = {unFlip :: f n a}
induct2 :: f 'Z a
-> (forall k. f k a -> f ('S k) a)
-> NatC n -> f n a
induct2 z s n = unFlip $ unNatC n (Flip z) (\(Flip r) -> Flip (s r))
replC :: NatC n -> a -> Vec n a
replC n a = induct2 Nil (a :<) n
instance KnownC n => Applicative (Vec n) where
pure = replC knownC
(<*>) = ...
Now if the vector length is known at compile time, the pure vector will be built directly, with no intermediate structure needed.
I've been playing around with some cofree isomporphisms with dependent typing, and am getting an error message that just seems to be nonsense for me.
My dependently typed cofree
data Cofree (n :: Nat) f a where
(:<<) :: a -> f (Cofree n f a) -> Cofree ('S n) f a
and isomorphism code
class Iso a b where
toA :: b -> a
toB :: a -> b
and my (very basic) instance (it's missing a lot of stuff but I want to just take care of the basics first)
instance Iso (Vec ('S n) a) (Cofree ('S n) Maybe a) where
toA :: Cofree ('S n) Maybe a -> Vec ('S n) a
toA (x :<< Nothing) = VCons x VNil
I figured that'd be the most basic thing possible, but it still type errors.
The error itself:
interactive>:224:127: error:
* Could not deduce: n1 ~ 'Z
from the context: 'S n ~ 'S n1
bound by a pattern with constructor:
:<< :: forall (f :: * -> *) a (n :: Nat).
a -> f (Cofree n f a) -> Cofree ('S n) f a,
in an equation for `toA'
at <interactive>:224:112-122
`n1' is a rigid type variable bound by
a pattern with constructor:
:<< :: forall (f :: * -> *) a (n :: Nat).
a -> f (Cofree n f a) -> Cofree ('S n) f a,
in an equation for `toA'
at <interactive>:224:112
Expected type: Vec ('S n) a
Actual type: Vec ('S 'Z) a
* In the expression: VCons x VNil
In an equation for `toA': toA (x :<< Nothing) = VCons x VNil
In the instance declaration for
`Iso (Vec ('S n) a) (Cofree ('S n) Maybe a)'
which seems weird, since I don't get why it can't substitute 'Z in for n1 in the type equation, since that seems to solve it.
I tried doing the hole thing (so instead in my definition I had:
= _ $ VCons x VNil
which returned
Found hole: _ :: Vec ('S 'Z) a -> Vec ('S n) a
which seems weird, since why couldn't I just supply id in there, it matches 'Z with n, and boom, solved?
By the way, the definitions for Nat and Vec I think are pretty normal so I didn't want to clutter up this post with more code than I needed, so I can provide them if it would be easier for somebody.
EDIT:
The Nat I used was
data Nat = Z | S Nat
and the Vec I used was
data Vec (n :: Nat) a where
VNil :: Vec 'Z a
VCons :: a -> Vec n a -> Vec ('S n) a
and no imports necessary, but GADTs, DataKinds, MultiParamTypeClasses, KindSignatures, and FlexibleInstances are necessary, and maybe PolyKinds? I don't quite remember.
The problem here is that you may pick Maybe's Nothing constructor whenever you want but you can only use Vec's VNil constructor when the index is Z. This mismatch makes the isomorphism impossible to implement.
You can however salvage the situation by:
changing the definition of indexed Cofree so that its argument f is also indexed
introducing a variant of Maybe where you may only use the Nothing constructor when the index is Z
In other words:
data ICofree (n :: Nat) f a where
(:<<) :: a -> f n (ICofree n f a) -> ICofree ('S n) f a
data IMaybe (n :: Nat) a where
INothing :: IMaybe 'Z a
IJust :: a -> IMaybe ('S n) a
instance Iso (Vec n a) (ICofree n IMaybe a) where
toA (x :<< INothing) = VCons x VNil
toA (x :<< IJust xs) = VCons x (toA xs)
toB (VCons x VNil) = x :<< INothing
toB (VCons x xs#VCons{}) = x :<< IJust (toB xs)
And a self-contained gist with the right imports, language extensions and definitions.
You don't get to choose the value of n. The caller of toA chooses that, and the definition of toA must be compatible with any choice.
Since there is no guarantee that the caller chooses n ~ 'Z, the type checker complains.
Indeed, x :<< Nothing can have type Cofree ('S n) Maybe a
but VCons x VNil only has type Vec ('S 'Z) a and not Vec ('S n) a.
I am attempting to prove some axioms about odd and even natural numbers. I am using three defined data types in my proof.
data Nat = Z | S Nat
data Even (a :: Nat) :: * where
ZeroEven :: Even Z
NextEven :: Even n -> Even (S (S n))
data Odd (a :: Nat) :: * where
OneOdd :: Odd (S Z)
NextOdd :: Odd n -> Odd (S (S n))
I also have the following type families defined for addition and multiplication.
type family Add (n :: Nat) (m :: Nat) :: Nat
type instance Add Z m = m
type instance Add (S n) m = S (Add n m)
type family Mult (n :: Nat) (m :: Nat) :: Nat
type instance Mult Z m = Z
type instance Mult (S n) m = Add (Mult n m) n
I have functions defined for proving that the sum of two evens is even and that the product of two evens is even.
evenPlusEven :: Even n -> Even m -> Even (Add n m)
evenPlusEven ZeroEven m = m
evenPlusEven (NextEven n) m = NextEven (evenPlusEven n m)
evenTimesEven :: Even n -> Even m -> Even (Mult n m)
evenTimesEven ZeroEven m = ZeroEven
evenTimesEven (NextEven n) m = evenPlusEven (EvenTimesEven n m) n
I am using the GADTs, DataKinds, TypeFamilies, and UndecidableInstances language extension and GHC version 7.10.3. Running evenPlusEven gives me the results I expect, but I get an compilation error when I include evenTimesEven. The error is:
Could not deduce (Add (Add (Mult n1 m) n1) ('S n1)
~ Add (Mult n1 m) n1)
from the context (n ~ 'S ('S n1))
bound by a pattern with constructor
NextEven :: forall (n :: Nat). Even n -> Even ('S ('S n)),
in an equation for `evenTimesEven'
at OddsAndEvens.hs:71:16-25
NB: `Add' is a type function, and may not be injective
Expected type: Even (Mult n m)
Actual type: Even (Add (Mult n1 m) n1)
Relevant bindings include
m :: Even m
(bound at OddsAndEvens.hs:71:28)
n :: Even n1
(bound at OddsAndEvens.hs:71:25)
evenTimesEven :: Even n -> Even m -> Even (Mult n m)
(bound at OddsAndEvens.hs:70:1)
In the expression: evenPlusEven (evenTimesEven n m) n
In an equation for `evenTimesEven':
evenTimesEven (NextEven n) m = evenPlusEven (evenTimesEven n m) n
The type family instances for Mult compile fine and if I replace the last line of evenTimesEven with an error throw I can compile the code and the function runs fine with an input of ZeroEven which makes me think that my instance for Mult is correct and my implementation of evenTimesEven is the problem, but I'm unsure of why.
Shouldn't Even (Mult n m) and Even (Add (Mult n1 m) n1) have the same kind?
Below, I'll abuse common mathematical notation.
from the context (n ~ 'S ('S n1))
From this, we get that n = 2+n1.
Expected type: Even (Mult n m)
We need to prove n*m even, i.e. (2+n1)*m even.
Actual type: Even (Add (Mult n1 m) n1)
We have proved (n1*m)+n1 even. This is not the same. The additional term should be m, not n1, and it should be added twice.
I have defined a vector as such:
{-# LANGUAGE GADTs, DataKinds, TypeFamilies, UndecidableInstances, TypeOperators #-}
data Nat = Z | S Nat
type family (+) (n :: Nat) (m :: Nat) :: Nat
type instance Z + m = m
type instance (S n) + m = S (n + m)
type family (*) (n :: Nat) (m :: Nat) :: Nat
type instance Z * m = Z
type instance (S n) * m = n * m + m
data Vec (n :: Nat) a where
VNil :: Vec Z a
VCons :: a -> Vec n a -> Vec (S n) a
and am attempting to make a vectorConcat, as such:
vectorConcat :: Vec m (Vec n a) -> Vec (m * n) a
However, when trying to do this:
vectorAppend :: Vec n a -> Vec m a -> Vec (n + m) a
vectorAppend VNil ys = ys
vectorAppend (VCons x xs) ys = VCons x (vectorAppend xs ys)
vectorConcat :: Vec m (Vec n a) -> Vec (m * n) a
vectorConcat VNil = VNil
vectorConcat (VCons x xs) = vectorAppend x (vectorConcat xs)
I get the following error, and am not sure how to resolve it:
Could not deduce (((n1 * n) + n) ~ (n + (n1 * n)))
from the context (m ~ 'S n1)
bound by a pattern with constructor
VCons :: forall a (n :: Nat). a -> Vec n a -> Vec ('S n) a,
in an equation for `concatV'
I have been stuck on this for a while, and wondering if I could get any direction.
GHC doesn't really know many facts about arithmetic, and in particular (in this case) doesn't know that addition is commutative. It's not easy to teach GHC this fact, either.
However, in this specific case, you can simply commute the terms in your definition of (*) by hand, and then things compile just fine:
type instance (S n) * m = m + (n * m)