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!
Related
In Coq I can define a Church encoding for lists of length n:
Definition listn (A : Type) : nat -> Type :=
fun m => forall (X : nat -> Type), X 0 -> (forall m, A -> X m -> X (S m)) -> X m.
Definition niln (A : Type) : listn A 0 :=
fun X n c => n.
Definition consn (A : Type) (m : nat) (a : A) (l : listn A m) : listn A (S m) :=
fun X n c => c m a (l X n c).
Is the type system of Haskell (including its extensions) strong enough to accommodate such definitions? If yes, how?
Sure it is:
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
import Data.Kind -- Needed for `Type`
data Nat = Z | S Nat -- Roll your own...
type List (a :: Type) (n :: Nat) =
forall (x :: Nat -> Type). x Z -> (forall (m :: Nat). a -> x m -> x (S m)) -> x n
niln :: List a Z
niln = \z _ -> z
consn :: a -> List a n -> List a (S n)
consn a l = \n c -> c a (l n c)
Further proof (for skeptics) of the isomorphism with the usual GADT formulation:
data List' (a :: Type) (n :: Nat) where
Nil :: List' a Z
Cons :: a -> List' a m -> List' a (S m)
to :: List' a n -> List a n
to Nil = niln
to (Cons a l) = consn a (to l)
from :: List a n -> List' a n
from l = l Nil Cons
For educational purposes, I have been trying to reconstruct an example from the book "Type-Driven Development with Idris" (namely RemoveElem.idr) in Haskell via use of various language extensions and singleton types. The gist of it is a function that removes an element from a non-empty vector, given a proof that the element is in fact in the vector. The following code is self-contained (GHC 8.4 or later). The problem appears at the very end:
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeInType #-}
import Data.Kind
import Data.Type.Equality
import Data.Void
-- | Inductively defined natural numbers.
data Nat = Z | S Nat deriving (Eq, Show)
-- | Singleton types for natural numbers.
data SNat :: Nat -> Type where
SZ :: SNat 'Z
SS :: SNat n -> SNat ('S n)
deriving instance Show (SNat n)
-- | "Demote" a singleton-typed natural number to an ordinary 'Nat'.
fromSNat :: SNat n -> Nat
fromSNat SZ = Z
fromSNat (SS n) = S (fromSNat n)
-- | A decidable proposition.
data Dec a = Yes a | No (a -> Void)
-- | Propositional equality of natural numbers.
eqSNat :: SNat a -> SNat b -> Dec (a :~: b)
eqSNat SZ SZ = Yes Refl
eqSNat SZ (SS _) = No (\case {})
eqSNat (SS _) SZ = No (\case {})
eqSNat (SS a) (SS b) = case eqSNat a b of
No f -> No (\case Refl -> f Refl)
Yes Refl -> Yes Refl
-- | A length-indexed list (aka vector).
data Vect :: Nat -> Type -> Type where
Nil :: Vect 'Z a
(:::) :: a -> Vect n a -> Vect ('S n) a
infixr 5 :::
deriving instance Show a => Show (Vect n a)
-- | #Elem a v# is the proposition that an element of type #a#
-- is contained in a vector of type #v#. To be useful, #a# and #v#
-- need to refer to singleton types.
data Elem :: forall a n. a -> Vect n a -> Type where
Here :: Elem x (x '::: xs)
There :: Elem x xs -> Elem x (y '::: xs)
deriving instance Show a => Show (Elem a v)
------------------------------------------------------------------------
-- From here on, to simplify things, only vectors of natural
-- numbers are considered.
-- | Singleton types for vectors of 'Nat's.
data SNatVect :: forall n. Nat -> Vect n Nat -> Type where
SNatNil :: SNatVect 'Z 'Nil
SNatCons :: SNat a -> SNatVect n v -> SNatVect ('S n) (a '::: v)
deriving instance Show (SNatVect n v)
-- | "Demote" a singleton-typed vector of 'SNat's to an
-- ordinary vector of 'Nat's.
fromSNatVect :: SNatVect n v -> Vect n Nat
fromSNatVect SNatNil = Nil
fromSNatVect (SNatCons a v) = fromSNat a ::: fromSNatVect v
-- | Decide whether a value is in a vector.
isElem :: SNat a -> SNatVect n v -> Dec (Elem a v)
isElem _ SNatNil = No (\case {})
isElem a (SNatCons b as) = case eqSNat a b of
Yes Refl -> Yes Here
No notHere -> case isElem a as of
Yes there -> Yes (There there)
No notThere -> No $ \case
Here -> notHere Refl
There there -> notThere there
type family RemoveElem (a :: Nat) (v :: Vect ('S n) Nat) :: Vect n Nat where
RemoveElem a (a '::: as) = as
RemoveElem a (b '::: as) = b '::: RemoveElem a as
-- | Remove a (singleton-typed) element from a (non-empty, singleton-typed)
-- vector, given a proof that the element is in the vector.
removeElem :: forall (a :: Nat) (v :: Vect ('S n) Nat)
. SNat a
-> Elem a v
-> SNatVect ('S n) v
-> SNatVect n (RemoveElem a v)
removeElem x prf (SNatCons y ys) = case prf of
Here -> ys
There later -> case ys of
SNatNil -> case later of {}
SNatCons{} -> SNatCons y (removeElem x later ys)
-- ^ Could not deduce:
-- RemoveElem a (y '::: (a2 '::: v2))
-- ~ (y '::: RemoveElem a (a2 '::: v2))
Apparently, the type system needs convincing that the types of the values x and y cannot possibly be equal in that branch of the code, so that the second equation of the type family can be used unambiguously to reduce the return type as required. I don't know how to do that. Naively, I would like the constructor There and thus the pattern match on There later to carry / reveal a proof of the type inequality to GHC.
The following is an obviously redundant and partial solution that just demonstrates the type inequality that is needed in order for GHC to type-check the recursive call:
SNatCons{} -> case (x, y) of
(SZ, SS _) -> SNatCons y (removeElem x later ys)
(SS _, SZ) -> SNatCons y (removeElem x later ys)
Now e.g. this works:
λ> let vec = SNatCons SZ (SNatCons (SS SZ) (SNatCons SZ SNatNil))
λ> :t vec
vec
:: SNatVect ('S ('S ('S 'Z))) ('Z '::: ('S 'Z '::: ('Z '::: 'Nil)))
λ> let Yes prf = isElem (SS SZ) vec
λ> :t prf
prf :: Elem ('S 'Z) ('Z '::: ('S 'Z '::: ('Z '::: 'Nil)))
λ> let vec' = removeElem (SS SZ) prf vec
λ> :t vec'
vec' :: SNatVect ('S ('S 'Z)) ('Z '::: ('Z '::: 'Nil))
λ> fromSNatVect vec'
Z ::: (Z ::: Nil)
Resolution
As hinted at in #chi's comment and elaborated in HTNW's answer, I was trying to solve the wrong problem by writing removeElem with the above type signature and type family, and if I would have been able to, the resulting program would have been ill-typed.
The following are the corrections I made based on HTNW's answer (you may want to read it before continuing here).
The first mistake, or unnecessary complication, was to repeat the length of the vector in SNatVects type. I thought it necessary in order to write fromSNatVect, but it certainly isn't:
data SNatVect (v :: Vect n Nat) :: Type where
SNatNil :: SNatVect 'Nil
SNatCons :: SNat a -> SNatVect v -> SNatVect (a '::: v)
deriving instance Show (SNatVect v)
fromSNatVect :: forall (v :: Vect n Nat). SNatVect v -> Vect n Nat
-- implementation unchanged
Now there are two approaches to writing removeElem. The first takes an Elem, an SNatVect and returns a Vect:
removeElem :: forall (a :: Nat) (n :: Nat) (v :: Vect ('S n) Nat)
. Elem a v
-> SNatVect v
-> Vect n Nat
removeElem prf (SNatCons y ys) = case prf of
Here -> fromSNatVect ys
There later -> case ys of
SNatNil -> case later of {}
SNatCons{} -> fromSNat y ::: removeElem later ys
The second takes an SElem, an SNatVect and returns an SNatVect, using a RemoveElem type family that mirrors the value-level function:
data SElem (e :: Elem a (v :: Vect n k)) where
SHere :: forall x xs. SElem ('Here :: Elem x (x '::: xs))
SThere :: forall x y xs (e :: Elem x xs). SElem e -> SElem ('There e :: Elem x (y '::: xs))
type family RemoveElem (xs :: Vect ('S n) a) (e :: Elem x xs) :: Vect n a where
RemoveElem (x '::: xs) 'Here = xs
RemoveElem (x '::: xs) ('There later) = x '::: RemoveElem xs later
sRemoveElem :: forall (xs :: Vect ('S n) Nat) (e :: Elem x xs)
. SElem e
-> SNatVect xs
-> SNatVect (RemoveElem xs e)
sRemoveElem prf (SNatCons y ys) = case prf of
SHere -> ys
SThere later -> case ys of
SNatNil -> case later of {}
SNatCons{} -> SNatCons y (sRemoveElem later ys)
Interestingly, both versions do away with passing the element to remove as a separate argument, since that information is contained in the Elem / SElem value. The value argument can also be removed from the Idris version of that function, though then the removeElem_auto variant may be a bit confusing, as it will then only have the vector as an explicit argument and remove the first element of the vector if the implicit prf argument is not explicitly used with a different proof.
Consider [1, 2, 1]. RemoveElem 1 [1, 2, 1] is [2, 1]. Now, the call removeElem 1 (There $ There $ Here) ([1, 2, 1] :: SNatVect 3 [1, 2, 1]) :: SNatVect 2 [2, 1], should compile. This is wrong. The Elem argument says to delete the third element, which would give [1, 2], but the type signature says it must be a [2, 1].
First, SNatVect is a bit broken. It has two Nat arguments:
data SNatVect :: forall n. Nat -> Vect n a -> Type where ...
The first is n, and the second is the unnamed Nat. By the structure of SNatVect, they are always equal. It allows an SNatVect to double as an equality proof, but it's probably not the intention to have it that way. You probably meant
data SNatVect (n :: Nat) :: Vect n Nat -> Type where ...
There is no way to write this signature in source Haskell using just the normal -> syntax. However, when GHC prints this type, you sometimes get
SNatVect :: forall (n :: Nat) -> Vect n Nat -> Type
But this is redundant. You can take the Nat as an implicit forall argument, and have it inferred from the Vects type:
data SNatVect (xs :: Vect n Nat) where
SNatNil :: SNatVect 'Nil
SNatCons :: SNat x -> SNatVect xs -> SNatVect (x '::: xs)
This gives
SNatVect :: forall (n :: Nat). Vect n Nat -> Type
Second, try writing
removeElem :: forall (n :: Nat) (x :: Nat) (xs :: Vect (S n) Nat).
Elem x xs -> SNatVect xs -> Vect n Nat
Note how the SNat argument is gone, and how the return type is a simple Vect. The SNat argument made the type "too big", so you got caught up making it sort of work when the function just wouldn't make sense. The SNatVect return type meant you were skipping steps. Roughly, every function has three forms: the basic one, f :: a -> b -> c; the type-level one, type family F (x :: a) (y :: b) :: c; and the dependent one, f :: forall (x :: a) (y :: b). Sing x -> Sing y -> Sing (F x y). Each is implemented in the "same" way, but trying to implement one without implementing its predecessors is a surefire way to get confused.
Now, you can lift this up a little bit:
data SElem (e :: Elem x (xs :: Vect n k)) where
SHere :: forall x xs. SElem ('Here :: Elem x (x '::: xs))
SThere :: forall x y xs (e :: Elem x xs). SElem e -> SElem ('There e :: Elem x (y '::: xs))
type family RemoveElem (xs :: Vect (S n) a) (e :: Elem x xs) :: Vect n a
Take note of the relationship between the types of removeElem and RemoveElem. The reordering of the arguments is because the type of e depends on xs, so they need to be ordered accordingly. Alternatively: the xs argument was promoted from forall'd-and-implicitly-given to explicitly-given, and then the Sing xs argument was nixed because it contained no information, due to being a singleton.
Finally, you can write this function:
sRemoveElem :: forall (xs :: Vect (S n) Nat) (e :: Elem x xs).
SElem e -> SNatVect xs -> SNatVect (RemoveElem xs e)
I have a hard time convincing compiler that my types are correct. With regular
Nats with Zero and Succ constructors it is pretty straightforward (the goal is to write replicate function for length-indexed lists (Vect)):
replicate' :: SNat n -> a -> Vect n a
replicate' SZero _ = Nil
replicate' (SSucc n) a = a :> replicate' n a
But regular Nat is drastically slow.
So there is a package that mirrors GHC.TypeLits in singletons library for faster Nats.
But I can't make the above example work with it:
sameNat :: forall a b. (KnownNat a, KnownNat b) => SNat a -> SNat b -> Maybe (a :~: b)
sameNat x y
| natVal (Proxy :: Proxy a) == natVal (Proxy :: Proxy b) = Just (unsafeCoerce Refl)
| otherwise = Nothing
replicate'' :: (KnownNat n) => SNat n -> a -> Vect n a
replicate'' n a =
case sameNat n (sing :: Sing 0) of
Just Refl -> Nil
Nothing -> a ::> replicate'' (sPred n) a
This won't typecheck on last line :
Couldn't match type ‘n’
with ‘(n GHC.TypeNats.- 1) GHC.TypeNats.+ 1’
The problem is that sameNat n (sing :: Sing 0) gives you a usable n ~ 0 proof in the case that n is zero (when you pattern match on Just Refl), but if n is not zero it just gives you Nothing. That doesn't tell you anything at all about n, so as far as the type checker is aware you can call exactly the same set of things inside the Nothing branch as you could without calling sameNat in the first place (in particular, you can't use sPred because that requires that 1 <= n).
So we need to pattern match on something that either provides evidence that n ~ 0 or provides evidence that 1 <= n. Something like this:
data IsZero (n :: Nat)
where Zero :: (0 ~ n) => IsZero n
NonZero :: (1 <= n) => IsZero n
deriving instance Show (IsZero n)
Then we could write replicate'' this way:
isZero :: forall n. SNat n -> IsZero n
isZero n = _
replicate'' :: SNat n -> a -> Vect n a
replicate'' n x = case isZero n
of Zero -> Nil
NonZero -> x ::> replicate'' (sPred n) x
Of course that's just moved the problem to implementing the isZero function, which hasn't really bought us anything, but I'm going to stick with it because it's handy to have this as the basis of any other inductive definitions you want to make using Nat.
So, implementing isZero. We could handle the zero case with sameNat of course, but that doesn't help the non-zero case. The singletons package also provides Data.Singletons.Decide, which gives you a way of getting a proof of equality or inequality of types based on their singletons. So we can do this:
isZero :: forall n. SNat n -> IsZero n
isZero n = case n %~ (SNat #0)
of Proved Refl -> Zero
Disproved nonsense -> NonZero
Sadly this doesn't work either! The Proved case is fine (and the same as sameNat giving us Just Refl, basically). But the "proof of inequality" comes in the form of nonsense being bound to a function of type (n :~: 0) -> Void, and if we assume totality (without shenanigans) then the existence of such a function "proves" that we can't construct a n :~: 0 value, which proves that n definitely isn't 0. But this is just too far from a proof that 1 <= n; we can see that if n isn't 0 then it must be at least 1, from the properties of natural numbers, but GHC doesn't know this.
Another way to go would be to use singleton's Ord support and pattern match on SNat #1 :%<= n:
isZero :: forall n. SNat n -> IsZero n
isZero n = case (SNat #1) %:<= n
of STrue -> NonZero
SFalse -> Zero
But that doesn't work either, because the STrue and SFalse are just singletons for type level True and False, disconnected from the original comparison. We don't get a proof that 0 ~ n or 1 <= n from either side of this (and similarly can't get it to work by comparing with SNat #0 either). This is type-checker boolean blindness, basically.
Ultimately I was never able to satisfactorily solve this in my code. As far as I can tell we're missing a primitive; we either need to be able to compare singletons in a way that gives us < or <= constraints on the corresponding types, or we need a switch on whether a Nat is zero or nonzero.
So I cheated:
isZero :: forall n. SNat n -> IsZero n
isZero n = case n %~ (SNat #0)
of Proved Refl -> Zero
Disproved _ -> unsafeCoerce (NonZero #1)
Since NonZero only contains evidence that n is 1 or more, but not any other information about n, you can just unsafely coerce a proof that 1 is 1 or more.
Here's a full working example:
{-# LANGUAGE DataKinds
, GADTs
, KindSignatures
, ScopedTypeVariables
, StandaloneDeriving
, TypeApplications
, TypeOperators
#-}
import GHC.TypeLits ( type (<=), type (-) )
import Data.Singletons.TypeLits ( Sing (SNat), SNat, Nat )
import Data.Singletons.Prelude.Enum ( sPred )
import Data.Singletons.Decide ( SDecide ((%~))
, Decision (Proved, Disproved)
, (:~:) (Refl)
)
import Unsafe.Coerce ( unsafeCoerce )
data IsZero (n :: Nat)
where Zero :: (0 ~ n) => IsZero n
NonZero :: (1 <= n) => IsZero n
deriving instance Show (IsZero n)
isZero :: forall n. SNat n -> IsZero n
isZero n = case n %~ (SNat #0)
of Proved Refl -> Zero
Disproved _ -> unsafeCoerce (NonZero #1)
data Vect (n :: Nat) a
where Nil :: Vect 0 a
(::>) :: a -> Vect (n - 1) a -> Vect n a
deriving instance Show a => Show (Vect n a)
replicate'' :: SNat n -> a -> Vect n a
replicate'' n x = case isZero n
of Zero -> Nil
NonZero -> x ::> replicate'' (sPred n) x
head'' :: (1 <= n) => Vect n a -> a
head'' (x ::> _) = x
main :: IO ()
main = putStrLn
. (:[])
. head''
$ replicate''
(SNat #1000000000000000000000000000000000000000000000000000000)
'\x1f60e'
Note that unlike K. A. Buhr's suggested approach using unsafeCoerce, here the code for replicate is actually using the type checker to verify that it constructs a Vect n a in accordance to the SNat n provided, whereas their suggestion requires you to trust that the code does this (the actual meat of the work is done by iterate counting on Int) and only makes sure that the callers use the SNat n and the Vect n a consistently. The only bit of code you have to just trust (unchecked by the compiler) is that a Refuted _ :: Decision (n :~: 0) really does imply 1 <= n, inside isZero (which you can reuse to write lots of other functions that need to switch on whether a SNat is zero or not).
As you try to implement more functionality with your Vect, you'll find that a lot of "obvious" things GHC doesn't know about the properties of Nat are quite painful. Data.Constraint.Nat from the constraints package has a lot of useful proofs you can use (for example, if you try to implement drop :: (k <= n) => SNat k -> Vect n a -> Vect (n - k) a, you'll probably end up needing leTrans so that when you know that 1 <= k then also 1 <= n and you can actually pattern match to strip off another element). Avoiding this kind of hasochism is where K. A. Buhr's approach can be a great help, if you want to just implement your operation with code you trust and unsafeCoerce the types to line up.
As far as I can see, the exact approach you're taking can't work the way you want. sameNat is evaluated at run-time, so its "decision" isn't available to the type checker, which therefore can't perform any type inference based on differentiating between the two branches of the case construct.
You might be interested in my answer to
How to deconstruct an SNat (singletons),
regarding a similar question, which provides an implementation that avoids unsafeCoerce entirely through the use of type classes. However, as #Ben has pointed out in the comments, because of this use of type classes, the compiler has to follow a chain of n instance definitions whenever you define a vector of size n (and the compiled code may explicitly include a structure of n nested instance dictionaries) making this impractical for real code. For example, a million element vector is likely to cause the compiler to run for too long and/or use too much memory to be acceptable.
For real code, I would suggest doing the type check manually (i.e., verifying that the code, as written, is type safe) and
forcing it with unsafeCoerce:
replicate1 :: (KnownNat n) => SNat n -> a -> Vect n a
replicate1 n a =
unsafeCoerce (iterate (unsafeCoerce . (a ::>)) Nil
!! fromInteger (fromSing n))
Obviously, this definition misses the point of dependent typing for this particular definition, but the hope is that you can build up a set of trusted (manually type-checked) primitives and then build non-trivial algorithms on top of them that can benefit from more rigorous type-checking.
Note that in this particular case, you don't even really need the n parameter, so you can write:
{-# LANGUAGE ScopedTypeVariables #-}
replicate2 :: forall a n . (KnownNat n) => a -> Vect n a
replicate2 a =
unsafeCoerce (iterate (unsafeCoerce . (a ::>)) Nil
!! fromInteger (fromSing (SNat :: SNat n)))
Anyway, a full working example is:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Singletons
import Data.Singletons.Prelude
import Data.Singletons.TypeLits
import Unsafe.Coerce
infixr 5 ::>
data Vect (n :: Nat) a where
Nil :: Vect 0 a
(::>) :: a -> Vect (n :- 1) a -> Vect n a
instance (Show a) => Show (Vect n a) where
showsPrec _ Nil = showString "Nil"
showsPrec d (x ::> xs) = showParen (d > prec) $
showsPrec (prec+1) x . showString " ::> " . showsPrec prec xs
where prec=5
replicate1 :: (KnownNat n) => SNat n -> a -> Vect n a
replicate1 n a =
unsafeCoerce (iterate (unsafeCoerce . (a ::>)) Nil
!! fromInteger (fromSing n))
replicate2 :: forall a n . (KnownNat n) => a -> Vect n a
replicate2 a =
unsafeCoerce (iterate (unsafeCoerce . (a ::>)) Nil
!! fromInteger (fromSing (SNat :: SNat n)))
head' :: Vect (n :+ 1) a -> a
head' (x ::> _) = x
tail' :: ((n :+ 1) :- 1) ~ n => Vect (n :+ 1) a -> Vect n a
tail' (_ ::> v) = v
main = do print (replicate2 False :: Vect 0 Bool)
print (replicate2 "Three" :: Vect 3 String)
print (head' (tail' (replicate2 "1M" :: Vect 1000000 String)))
print (replicate1 (SNat :: SNat 0) False :: Vect 0 Bool)
print (replicate1 (SNat :: SNat 3) "Three" :: Vect 3 String)
print (head' (tail' (replicate1 (SNat :: SNat 1000000) "1M" :: Vect 1000000 String)))
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)
If you want vectors indexed by their length you can do something like this:
{-# LANGUAGE
DataKinds, GADTs, TypeOperators, TypeFamilies, StandaloneDeriving
#-}
data N = P N | Z
type family Add (n :: N) (m :: N) :: N
type instance Add Z a = a
type instance Add (P a) b = P (Add a b)
infixr 5 :>
data Vect n a where
V0 :: Vect Z a
(:>) :: a -> Vect n a -> Vect (P n) a
deriving instance Show a => Show (Vect n a)
concatV :: Vect n a -> Vect m a -> Vect (Add n m) a
concatV V0 y = y
concatV (x :> xs) y = x :> concatV xs y
In ghc 7.8 I was hoping this would become obsolete with the new type literals, but the direct conversion is invalid:
{-# LANGUAGE
DataKinds, GADTs, TypeOperators, TypeFamilies, StandaloneDeriving
#-}
import GHC.TypeLits
infixr 5 :>
data Vect (n :: Nat) a where
V0 :: Vect 0 a
(:>) :: a -> Vect n a -> Vect (n+1) a
deriving instance Show a => Show (Vect n a)
concatV :: Vect n a -> Vect m a -> Vect (n + m) a
concatV V0 y = y
concatV (x :> xs) y = x :> concatV xs y
Unfortunatley this gives an error: NB:+' is a type function, and may not be injective `. I understand why this happens, but since the type literals are compiler magic anyways, I don't know why the compiler could not magic this away either.
I tried changing Vect : (:>) :: a -> Vect (n-1) a -> Vect n a. This way there is an explicit formula for the inner vector, but this gives the error:
Couldn't match type `(n + m) - 1' with `(n - 1) + m'
Expected type: Vect ((n + m) - 1) a
Actual type: Vect ((n - 1) + m) a
So now it requires a proof of basic arithmetic. I haven't been able to make either version work. Is there a way to write a proof of (n + m) - o == (n - o) + m for the compiler, or somehow make the first version work?
Type-level naturals still don't really do computation yet. GHC 7.10 is slated to have an SMT solver integrated to finally handle everything you think it should be able to.
As a theoretically unsound but working answer to your actual question - unsafeCoerce exists for the case when you know two expressions have the same type, but the compiler doesn't.
The GHC 7.8 solver still won't solve for a lot of arithmetic relations with type naturals. Though in this case it's perfectly safe to use unsafeCoerce to force GHC to recognize the intended type.
{-# LANGUAGE
DataKinds, GADTs, TypeOperators, TypeFamilies, StandaloneDeriving
#-}
import GHC.TypeLits
import Unsafe.Coerce
infixr 5 :>
data Vect (n :: Nat) a where
V0 :: Vect 0 a
(:>) :: a -> Vect n a -> Vect (n+1) a
deriving instance Show a => Show (Vect n a)
concatV :: Vect n a -> Vect m a -> Vect (n + m) a
concatV V0 y = unsafeCoerce y
concatV (x :> xs) y = unsafeCoerce $ x :> concatV xs y