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)
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 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))
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'm trying to write a fixed size vector like this:
{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeOperators #-}
import GHC.TypeLits
data NVector (n :: Nat) a where
Nil :: NVector 0 a
Cons :: a -> NVector n a -> NVector (n + 1) a
instance Eq a => Eq (NVector n a) where
Nil == Nil = True
(Cons x xs) == (Cons y ys) = x == y && xs == ys
but it fails to compile with this message:
Could not deduce (n2 ~ n1)
from the context (Eq a)
bound by the instance declaration at prog.hs:8:10-33
or from (n ~ (n1 + 1))
bound by a pattern with constructor
Cons :: forall a (n :: Nat). a -> NVector n a -> NVector (n + 1) a,
in an equation for `=='
at prog.hs:10:6-14
or from (n ~ (n2 + 1))
bound by a pattern with constructor
Cons :: forall a (n :: Nat). a -> NVector n a -> NVector (n + 1) a,
in an equation for `=='
at prog.hs:10:21-29
but if I introduce type-level naturals manually, it compiles successfully
{-# LANGUAGE GADTs, DataKinds, KindSignatures, TypeOperators, TypeFamilies #-}
data Nat = Z | S Nat
infixl 6 :+
type family (n :: Nat) :+ (m :: Nat) :: Nat
type instance Z :+ m = m
type instance (S n) :+ m = S (n :+ m)
data NVector (n :: Nat) a where
Nil :: NVector Z a
Cons :: a -> NVector n a -> NVector (S n) a
instance (Eq a) => Eq (NVector n a) where
Nil == Nil = True
(Cons x xs) == (Cons y ys) = x == y && xs == ys
ghc version 7.8.3
ghc cannot (not yet?) deduce the type equality n ~ n' from (n+1) ~ (n'+1)
while it has no trouble with deducing it from S n ~ S n' See e.g. Append for type-level numbered lists with TypeLits for an explanation, and a possible way out (i.e. to have both Peano-style naturals and still be able to use literals like5)
But, if you change your definition of Nvector into
data NVector (n :: Nat) a where
Nil :: NVector 0 a
Cons :: a -> NVector (n -1) a -> NVector n a
it will have to deduce n-1 ~ n'-1 from n ~ n', a much easier deduction! This compiles, and still yields a correct type for e.g. Cons () Nil:
*Main> :t Cons () Nil
Cons () Nil :: NVector 1 ()
Note that this is pretty useless, as we still cannot define
append :: NVector n a -> NVector m a -> NVector (n + m) a -- won't work
The Oct. '14 status report for ghc says:
Iavor Diatchki is working on utilizing an off-the-shelf SMT solver in GHC's constraint solver. Currently, the main focus for this is improved support for reasoning with type-level natural numbers [...]
so your example might well work OK with ghc 7.10 or 7.12!