Coq: Strong specification of haskell's Replicate function - haskell

I'm having a bit of trouble understanding the difference between strong and weak specification in Coq. For instance, if I wanted to write the replicate function (given a number n and a value x, it creates a list of length n, with all elements equal to x) using the strong specification way, how would I be able to do that? Apparently I have to write an Inductive "version" of the function but how?
Definition in Haskell:
myReplicate :: Int -> a -> [a]
myReplicate 0 _ = []
myReplicate n x | n > 0 = x:myReplicate (n-1) x
| otherwise = []
Definition of weak specification:
To define these functions with a weak specification and then add companion lemmas.
For instance, we define a function f : A->B and we prove a statement of the form ∀ x:A, Rx (fx), where R is a relation coding the intended input/output behaviour of the function.
Definition of strong specification:
To give a strong specification of the function: the type of this function directly states that the input is a value x of type A and that the output is the combination of a value v of type B and a proof that v satisfies Rxv.
This kind of specification usually relies on dependent types.
EDIT: I heard back from my teacher and apparently I have to do something similar to this, but for the replicate case:
"For example, if we want to extract a function that computes the length of a list from its specification, we can define a relation RelLength which establishes a relation between the expected input and output and then prove it. Like this:
Inductive RelLength (A:Type) : nat -> list A -> Prop :=
| len_nil : RelLength 0 nil
| len_cons : forall l x n, RelLength n l -> RelLength (S n) (x::l) .
Theorem len_corr : forall (A:Type) (l:list A), {n | RelLength n l}.
Proof.
…
Qed.
Recursive Extraction len_corr.
The function used to prove must use the list “recursor” directly (that’s why fixpoint won’t show up - it’s hidden in list_rect).
So you don’t need to write the function itself, only the relation, because the function will be defined by the proof."
Knowing this, how can I apply it to the replicate function case?

Just for fun, here's what it would look like in Haskell, where everything dependent-ish is much more annoying. This code uses some very new GHC features, mostly to make the types more explicit, but it could be modified quite easily to work with older GHC versions.
{-# language GADTs, TypeFamilies, PolyKinds, DataKinds, ScopedTypeVariables,
TypeOperators, TypeApplications, StandaloneKindSignatures #-}
{-# OPTIONS_GHC -Wincomplete-patterns #-}
module RelRepl where
import Data.Kind (Type)
import Data.Type.Equality ((:~:)(..))
-- | Singletons (borrowed from the `singletons` package).
type Sing :: forall (k :: Type). k -> Type
type family Sing
type instance Sing #Nat = SNat
type instance Sing #[a] = SList #a
-- The version of Sing in the singletons package has many more instances;
-- in any case, more can be added anywhere as needed.
-- Natural numbers, used at the type level
data Nat = Z | S Nat
-- Singleton representations of natural numbers, used
-- at the term level.
data SNat :: Nat -> Type where
SZ :: SNat 'Z
SS :: SNat n -> SNat ('S n)
-- Singleton lists
data SList :: forall (a :: Type). [a] -> Type where
SNil :: SList '[]
SCons :: Sing a -> SList as -> SList (a ': as)
-- The relation representing the `replicate` function.
data RelRepl :: forall (a :: Type). Nat -> a -> [a] -> Type where
Repl_Z :: forall x. RelRepl 'Z x '[]
Repl_S :: forall n x l. RelRepl n x l -> RelRepl ('S n) x (x ': l)
-- Dependent pairs, because those aren't natively supported.
data DPair :: forall (a :: Type). (a -> Type) -> Type where
MkDPair :: forall {a :: Type} (x :: a) (p :: a -> Type).
Sing x -> p x -> DPair #a p
-- Proof that every natural number and value produce a list
-- satisfying the relation.
repl_corr :: forall {a :: Type} (n :: Nat) (x :: a).
SNat n -> Sing x -> DPair #[a] (RelRepl n x)
repl_corr SZ _x = MkDPair SNil Repl_Z
repl_corr (SS n) x
| MkDPair l pf <- repl_corr n x
= MkDPair (SCons x l) (Repl_S pf)
-- Here's a proof that the relation indeed specifies
-- a *unique* function.
replUnique :: forall {a :: Type} (n :: Nat) (x :: a) (xs :: [a]) (ys :: [a]).
RelRepl n x xs -> RelRepl n x ys -> xs :~: ys
replUnique Repl_Z Repl_Z = Refl
replUnique (Repl_S pf1) (Repl_S pf2)
| Refl <- replUnique pf1 pf2
= Refl

A possible specification would look like this :
Inductive RelReplicate (A : Type) (a : A) : nat -> (list A) -> Prop :=
| rep0 : RelReplicate A a 0 nil
| repS : …
I did the zero case, leaving you the successor case. Its conclusion should be something like RelReplicate A a (S n) (a :: l).
As in your example, you can then try and prove something like
Theorem replicate_corr : forall (A:Type) (a : A) (n : nat), {l | ReplicateRel A a n l}.
which should be easy by induction on n.
If you want to check that your function replicate_corr corresponds to what you had in mind, you can try it on a few examples, with
Eval compute in (proj1_sig (rep_corr nat 0 3)).
which evaluates the first argument (the one corresponding to the "real function" and not the proof) of rep_corr. To be able to do that, you should end your Theorem with Defined rather than Qed so that Coq can evaluate it.

Related

How to use the dependent pair type Sigma from the singletons library?

How can the dependent pair type Sigma from the singletons library be used?
Let's assume the following type-indexed list and replicate function exist:
data Vect :: Nat -> Type -> Type where
VNil :: Vect 0 a
VCons :: a -> Vect n a -> Vect (n + 1) a
replicateVec :: forall n a. Sing n -> a -> Vect n a
(You can find a couple different implementations of replicateVec in this question).
I'd like to create a function replicateVecSigma that returns a Vect in a dependent pair. Ideally it would be like the following:
replicateVecSigma :: Natural -> Sigma Nat (\n -> Vect n String)
How can Sigma be used to write this function? And how can the type of the function be written?
Actually, I am able to implement replicateVecSigma as follows but it doesn't seem very clean:
data Foo a b (m :: TyFun Nat Type)
type instance Apply (Foo a b) (n :: Nat) = a n b
replicateVecSigma :: Natural -> Sigma Nat (Foo Vect String)
replicateVecSigma i =
case toSing i of
SomeSing snat -> snat :&: replicateVec snat "hello"
It seems unfortunate that I have to declare this Foo type and Apply instance just to use Sigma. Does the singletons library provide any way to make working with Sigma easier?
You can find my full code here.
For completeness, here is the definition of Sigma:
data Sigma (s :: Type) :: (s ~> Type) -> Type where
(:&:) :: forall s t fst. Sing (fst :: s) -> t ## fst -> Sigma s t
Here is ~>:
type a ~> b = TyFun a b -> *
data TyFun :: * -> * -> *
instance (SingKind k1, SingKind k2) => SingKind (k1 ~> k2)
type instance Demote (k1 ~> k2) = Demote k1 -> Demote k2
class SingKind k where
type family Demote k :: * = r | r -> k
fromSing :: forall (a :: k). Sing a -> Demote k
toSing :: Demote k -> SomeSing k
Here is ##:
type a ## b = Apply a b
type family Apply (f :: k1 ~> k2) (x :: k1) :: k2
singletons defines a bunch of instances for Apply.
How do TyFun and Apply work?
Here are the three questions from above:
How can I use Sigma to write a function like replicateVecSigma :: Natural -> Sigma Nat (\n -> Vect n String)?
I am able to write replicateVecSigma using the Foo type above, but it seems like too much extra work. Is there an easier way?
How do TyFun and Apply work?
Defunctionalization is a general way to work around the lack of first-class functions (in fact, it was originally discovered as a compilation technique to get rid of those), encoding them as symbols that get interpreted by a single first-order Apply function.
For example, your Foo a b is a symbol that encodes the function \n -> a n b.
Another way of obtaining an equivalent symbol is to follow the intuition that (\n -> a n b) = flip a b.
Note that type constructors like Vec are not themselves symbols that can be passed to Apply, but must be wrapped in "symbol constructors": TyCon2 Vec is the symbol for \n -> \b -> Vec n b.
singletons has a symbol for flip, FlipSym0 (symbols can stand for higher-order functions by taking other symbols as arguments).
Foo a b = Apply (Apply FlipSym0 (TyCon2 a)) b
Note that partial applications reduce to other symbols:
= Apply (FlipSym1 (TyCon2 a)) b
= FlipSym2 (TyCon2 a) b
The TyFun type is a way to give types to defunctionalized symbols. The main benefit I see is type inference; without it, type families might get stuck in confusing ways.
See also this blogpost by Richard Eisenberg on defunctionalization for Haskell types: https://typesandkinds.wordpress.com/2013/04/01/defunctionalization-for-the-win/
In this specific case, we want to compute the type-level lambda
\n -> Vect n String
Unfortunately, we do not have lambdas at the type level. At most, we can define type families, as the OP did. However, we can rewrite the lambda in pointfree style:
\n -> flip Vect String n -- pseudocode
flip Vect String
and we can turn this idea into an actual type, using the singletons type-level Flip type function. Here, we want to partially apply Flip with two arguments (it takes three, in a saturated call), so we use the "defunctionalized" FlipSym2 variant instead.
This compiles:
replicateVecSigma :: Natural -> Sigma Nat (FlipSym2 (TyCon Vect) String)
replicateVecSigma i =
case toSing i of
SomeSing snat -> snat :&: replicateVec snat "hello"
If we had the n argument in the last position from the beginning, we could have avoided the Flip.
data Vect2 :: Type -> Nat -> Type where
VNil2 :: Vect2 a 0
VCons2 :: a -> Vect2 a n -> Vect2 a (n + 1)
replicateVec2 :: forall n a. Sing n -> a -> Vect2 a n
replicateVec2 = undefined
replicateVecSigma2 :: Natural -> Sigma Nat (TyCon (Vect2 String))
replicateVecSigma2 i =
case toSing i of
SomeSing snat -> snat :&: replicateVec2 snat "hello"
( TyCon Vect2 ## String also works here, using the explicit application ## at the defunctionalized level, instead of the actuall type applciation.)
Very roughly put, you can think of the defunctionalized variants like FlipSym0, FlipSym1, FlipSym2 as basic tags (not functions!), with no intrinsic meaning, except for the fact that Apply lets you work with them pretending they were functions. In this way we can work with non-functions ("tags") as if they were functions. This is needed since, in Haskell, we do not have functions at the type level, so we have to work with these "pretend" versions.
The approach is general, but it does require more work from the programmer than one would like.
I am not aware of any Template Haskell utility that can automatically turn type-level lambdas into pointfree form, and then defunctionalize them. That would be quite useful.

Type-level constraints in instances of type families

Is it possible to have type synonym families for parametrized data such as Data.Param.FSVec?
Ideally, I would like this to compile:
class A e where
type Arg e a
f :: (Arg e a -> b) -> e a -> e b
instance A X where
type Arg X a = Nat size => FSVec size a
f = {- implementation -}
I have tried several workarounds, like wrapping FSVec size a in a newtype, or constraint synonyms, but it seems that I could not get anything reasonable right.
Context + minimal working example
A is a class previously defined (for example) as such:
class OldA e where
f :: (Maybe a -> b) -> [e (Maybe a)] -> [e b]
An example of type inheriting OldA is:
data Y a = Y a
instance Functor Y where
fmap f (Y a) = Y (f a)
instance OldA Y where
f = fmap . fmap
I want to extend this class to be able to express more general function arguments for f. Let's say we have a type X and an associated function fIndependent:
import qualified Data.Param.FSVec as V
import Data.TypeLevel hiding ((==))
data X a = X a deriving Show
fromX (X a) = a
fIndependent :: (Nat size) => (V.FSVec size (Maybe a) -> b) -> [X (Maybe a)] -> [X b]
fIndependent _ [] = []
fIndependent f xs = let x' = (V.reallyUnsafeVector . take c . fmap fromX) xs
xs' = drop c xs
c = V.length x'
in if c == length (V.fromVector x') then X (f x') : fIndependent f xs' else []
fIndependent is sane itself. Testing it with a function
test :: V.FSVec D2 x -> Int
test a = V.length a
will grant the result:
>>> fIndependent test $ map (X . Just) [1,2,3,4,5,6,7,8,9]
[X 2, X 2, X 2, X 2]
Ok, now how to extend OldA? The most "natural" thing that came into my mind is to equip class A with a type synonym family Arg e a as below.
class NewA e where
type Arg e a
f :: (Arg e a -> b) -> [e (Maybe a)] -> [e b]
Converting all existing instances is easy:
instance NewA Y where
type Arg Y a = Maybe a
f = fmap . fmap -- old implementation
To express fIndependent as f is the difficult part, since just adding
instance NewA X where
type Arg X a = (Nat size) => FSVec size (Maybe a) -- wrong!!!
f = {- same as fIndependent -}
does not work. This is what I have trouble with.
Try-outs
Most solutions I saw propose wrapping FSVec inside a newtype. Doing so does not help since the following code:
{-# LANGUAGE RankNTypes #-}
newtype ArgV a = ArgV (forall rate.Nat rate => V.FSVec rate (Maybe a))
instance NewA X where
type Arg X a = ArgV a
g f xs = let x' = (V.reallyUnsafeVector . take c . fmap fromX) xs
xs' = drop c xs
c = V.length x'
in if c == length (V.fromVector x') then X (f $ ArgV x') : g f xs' else []
the type inference system seems to lose the information about size:
Couldn't match type ‘s0’ with ‘rate’ …
because type variable ‘rate’ would escape its scope
This (rigid, skolem) type variable is bound by
a type expected by the context: Nat rate => V.FSVec rate (Maybe a)
Expected type: V.FSVec rate (Maybe a)
Actual type: V.FSVec s0 (Maybe a)
Relevant bindings include
x' :: V.FSVec s0 (Maybe a)
(bound at ...)
In the first argument of ‘Args’, namely ‘x'’
In the second argument of ‘($)’, namely ‘Args x'’
Compilation failed.
I would appreciate any lead or hint in this matter.
It appears that you are using a class Nat :: k -> Constraint and a data type FSVec :: k -> * -> *. The data type is constrained with the old DatatypeContexts extension.
{-# LANGUAGE DatatypeContexts #-}
class Nat n
data Nat n => FSVec n a = FSVec -- ...
You have an existing class A :: (* -> *) -> Constraint which you'd like to write an FSVec instance for.
class A e where
--- ...
f :: ( {- ... -} b) -> e a -> e b
But FSVec can never have an A instance, because it's a kind mismatch. The class A requires a type argument with the kind * -> * but FSVec has the kind k -> * -> *. You've already run into a problem, and aren't even using the type family yet. If you try to do this (hand waving away what the type family argument is for now)
data X = X
instance A (FSVec) where
type Arg FSVec a = X
f = undefined
You get a compiler error.
Expecting one more argument to `FSVec'
The first argument of `A' should have kind `* -> *',
but `FSVec' has kind `* -> * -> *'
In the instance declaration for `A (FSVec)'
Everything before here, including the compiler error, is useful information for communicating the problem you are having and is useful in asking for help.
Fortunately it's a really easy problem to fix. If you pick some natural number n, then FSVec n has the kind * -> *, which matches the kind of the type argument to A. You can start writing an instance A (FSVec n)
instance A (FSVec n) where
f = -- ...
When you reintroduce the complete class definition with type families
{-# LANGUAGE TypeFamilies #-}
class A e where
type Arg e a
f :: (Arg e a -> b) -> e a -> e b
The solution is still to write an A instance for FSVec n instead of for FSVec. Now that n has moved into the instance declaration, there's an obvious place to capture the needed Nat n context.
instance Nat n => A (FSVec n) where
type Arg (FSVec n) a = FSVec n a
f = undefined -- ...
Cirdec's answer explains one of the problems, but its solution given does not exactly answer the question posted. The question asks for an instance X for the class A, with a FSVec type synonym.
The overarching issue here that prevents defining type Arg X = FSVec size a (in any possible configuration) is that type families are not injective. Knowing this and following Cirdec's reasoning, I can think of a workaround to achieve this goal: include a proxy "context" variable in Xs type, to overcome the mentioned issue.
data X c a = X a
instance (Nat n) => A (X n) where
type (X n) a = FSVec n a
f = {- same as fIndependent -}
Of course, this is a quick fix that works for the minimal example (i.e. it answers the question posted), but might not scale well when composing multiple functions like f since there might appear type clashes between the inferred "contexts".
The best solution I can think of would be to add a constraint synonym (as suggested by this answer) for each instance, like:
import qualified Data.Param.FSVec
import Data.TypeLevel
import GHC.Exts -- for Constraint kind
class A e where
type Arg e context a
type Ctx e context :: Constraint
f :: (Ctx e context) => (Arg e context a -> b) -> [e (Maybe a)] -> [e b]
instance A Y where
type Arg Y c a = Maybe a
type Ctx Y c = ()
f = {- same as before -}
instance A X where
type Arg X size a = V.FSVec size (Maybe a)
type Ctx X size = Nat rate
f = {- same as fIndependent -}
But then we would have to deal with the ambiguous types resulted due to the infamous non-injectivity of type families (e.g. Could not deduce: Arg e context0 a ~ Arg e context a). In this case proving injectivity would have to be done manually using the TypeFamilyDependencies extension (based on injective type families) available in GHC 8.0, and define Arg as:
type family Arg (e :: * -> *) context = (r :: * -> *) | r -> context
Of course, this is not possible if the design of the type family is not injective (which is my case), but it is the cleanest solution so far. It is definitely recommended if one can design her type family using the guidelines in the provided paper.

Type families for dummies

Could someone give a super simple (few line) example to get a basic understanding about what type families can be used for and what are they ?
The 2+2 kind of example of type families ?
Here's an example:
{-# Language TypeFamilies, DataKinds, KindSignatures, GADTs, UndecidableInstances #-}
data Nat = Z | S Nat
type family Plus (x :: Nat) (y :: Nat) :: Nat where
Plus 'Z y = y
Plus ('S x) y = 'S (Plus x y)
data Vec :: Nat -> * -> * where
Nil :: Vec 'Z a
Cons :: a -> Vec n a -> Vec ('S n) a
append :: Vec m a -> Vec n a -> Vec (Plus m n) a
append Nil ys = ys
append (Cons x xs) ys = Cons x (append xs ys)
Note that many/most interesting applications of type families require UndecidableInstances. You should not be scared of this extension.
Another useful sort of type family is one associated with a class. For a really contrived example,
class Box b where
type Elem b :: *
elem :: b -> Elem b
An instance of Box is a type that something can be pulled out of. For instance,
instance Box (Identity x) where
type Elem (Identity x) = x
elem = runIdentity
instance Box Char where
type Elem Char = String
elem c = [c]
Now elem (Identity 3) = 3 and elem 'x' = "x".
You can also use type families to make weird skolem variables. This is best done in the as-yet-unreleased GHC 8.0.1, where it will look like
type family Any :: k where {}
Any is a peculiar type. It's uninhabited, it can't be (specifically) an instance of a class, and it's poly-kinded. This turns out to be really useful for certain purposes. This particular type is advertised as a safe target for unsafeCoerce, but Data.Constraint.Forall uses similar type families for more interesting purposes.

Type-level nats with literals and an injective successor? (N-ary compose)

I'm generalizing this n-ary complement to an n-ary compose, but I'm having trouble making the interface nice. Namely, I can't figure out how to use numeric literals at the type level while still being able to pattern match on successors.
Rolling my own nats
Using roll-my-own nats, I can make n-ary compose work, but I can only pass n as an iterated successor, not as a literal:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
module RollMyOwnNats where
import Data.List (genericIndex)
-- import Data.Proxy
data Proxy (n::Nat) = Proxy
----------------------------------------------------------------
-- Stuff that works.
data Nat = Z | S Nat
class Compose (n::Nat) b b' t t' where
compose :: Proxy n -> (b -> b') -> t -> t'
instance Compose Z b b' b b' where
compose _ f x = f x
instance Compose n b b' t t' => Compose (S n) b b' (a -> t) (a -> t') where
compose _ g f x = compose (Proxy::Proxy n) g (f x)
-- Complement a binary relation.
compBinRel :: (a -> a -> Bool) -> (a -> a -> Bool)
compBinRel = compose (Proxy::Proxy (S (S Z))) not
----------------------------------------------------------------
-- Stuff that does not work.
instance Num Nat where
fromInteger n = iterate S Z `genericIndex` n
-- I now have 'Nat' literals:
myTwo :: Nat
myTwo = 2
-- But GHC thinks my type-level nat literal is a 'GHC.TypeLits.Nat',
-- even when I say otherwise:
compBinRel' :: (a -> a -> Bool) -> (a -> a -> Bool)
compBinRel' = compose (Proxy::Proxy (2::Nat)) not
{-
Kind mis-match
An enclosing kind signature specified kind `Nat',
but `2' has kind `GHC.TypeLits.Nat'
In an expression type signature: Proxy (2 :: Nat)
In the first argument of `compose', namely
`(Proxy :: Proxy (2 :: Nat))'
In the expression: compose (Proxy :: Proxy (2 :: Nat)) not
-}
Using GHC.TypeLits.Nat
Using GHC.TypeLits.Nat, I get type-level nat literals, but there is no successor constructor that I can find, and using the type function (1 +) doesn't work, because GHC (7.6.3) can't reason about injectivity of type functions:
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module UseGHCTypeLitsNats where
import GHC.TypeLits
-- import Data.Proxy
data Proxy (t::Nat) = Proxy
----------------------------------------------------------------
-- Stuff that works.
class Compose (n::Nat) b b' t t' where
compose :: Proxy n -> (b -> b') -> t -> t'
instance Compose 0 b b' b b' where
compose _ f x = f x
instance (Compose n b b' t t' , sn ~ (1 + n)) => Compose sn b b' (a -> t) (a -> t') where
compose _ g f x = compose (Proxy::Proxy n) g (f x)
----------------------------------------------------------------
-- Stuff that does not work.
-- Complement a binary relation.
compBinRel , compBinRel' :: (a -> a -> Bool) -> (a -> a -> Bool)
compBinRel = compose (Proxy::Proxy 2) not
{-
Couldn't match type `1 + (1 + n)' with `2'
The type variable `n' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
In the expression: compose (Proxy :: Proxy 2) not
In an equation for `compBinRel':
compBinRel = compose (Proxy :: Proxy 2) not
-}
{-
No instance for (Compose n Bool Bool Bool Bool)
arising from a use of `compose'
The type variable `n' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
Note: there is a potential instance available:
instance Compose 0 b b' b b'
-}
compBinRel' = compose (Proxy::Proxy (1+(1+0))) not
{-
Couldn't match type `1 + (1 + 0)' with `1 + (1 + n)'
NB: `+' is a type function, and may not be injective
The type variable `n' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
Expected type: Proxy (1 + (1 + 0))
Actual type: Proxy (1 + (1 + n))
In the first argument of `compose', namely
`(Proxy :: Proxy (1 + (1 + 0)))'
-}
I agree that semantic editor combinators are more elegant and more general here -- and concretely, it will always be easy enough to write (.) . (.) . ... (n times) instead of compose (Proxy::Proxy n) -- but I'm frustrated that I can't make the n-ary composition work as well as I expected. Also, it seems I would run into similar problems for other uses of GHC.TypeLits.Nat, e.g. when trying to define a type function:
type family T (n::Nat) :: *
type instance T 0 = ...
type instance T (S n) = ...
UPDATE: Summary and adaptation of the accepted answer
There's a lot of interesting stuff going on in the accepted answer,
but the key for me is the Template Haskell trick in the GHC 7.6
solution: that effectively lets me add type-level literals to my GHC
7.6.3 version, which already had injective successors.
Using my types above, I define literals via TH:
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DataKinds #-}
module RollMyOwnLiterals where
import Language.Haskell.TH
data Nat = Z | S Nat
nat :: Integer -> Q Type
nat 0 = [t| Z |]
nat n = [t| S $(nat (n-1)) |]
where I've moved my Nat declaration into the new module to avoid an
import loop. I then modify my RollMyOwnNats module:
+import RollMyOwnLiterals
...
-data Nat = Z | S Nat
...
+compBinRel'' :: (a -> a -> Bool) -> (a -> a -> Bool)
+compBinRel'' = compose (Proxy::Proxy $(nat 2)) not
Unfortunately your question cannot be answered in principle in the currently released version of GHC (GHC 7.6.3) because of a consistency problem pointed out in the recent message
http://www.haskell.org/pipermail/haskell-cafe/2013-December/111942.html
Although type-level numerals look like numbers they are not guaranteed to behave like numbers at all (and they don't). I have seen Iavor Diatchki and colleagues have implemented proper type level arithmetic in GHC (which as as sound as the SMT solver used as a back end -- that is, we can trust it). Until that version is released, it is best to avoid type level numeric literals, however cute they may seem.
EDIT: Rewrote answer. It was getting a little bulky (and a little buggy).
GHC 7.6
Since type level Nats are somewhat... incomplete (?) in GHC 7.6, the least verbose way of achieving what you want is a combination of GADTs and type families.
{-# LANGUAGE GADTs, TypeFamilies #-}
module Nats where
-- Type level nats
data Zero
data Succ n
-- Value level nats
data N n f g where
Z :: N Zero (a -> b) a
S :: N n f g -> N (Succ n) f (a -> g)
type family Compose n f g
type instance Compose Zero (a -> b) a = b
type instance Compose (Succ n) f (a -> g) = a -> Compose n f g
compose :: N n f g -> f -> g -> Compose n f g
compose Z f x = f x
compose (S n) f g = compose n f . g
The advantage of this particular implementation is that it doesn't use type classes, so applications of compose aren't subject to the monomorphism restriction. For example, compBinRel = compose (S (S Z)) not will type check without type annotations.
We can make this nicer with a little Template Haskell:
{-# LANGUAGE TemplateHaskell #-}
module Nats.TH where
import Language.Haskell.TH
nat :: Integer -> Q Exp
nat 0 = conE 'Z
nat n = appE (conE 'S) (nat (n - 1))
Now we can write compBinRel = compose $(nat 2) not, which is much more pleasant for larger numbers. Some may consider this "cheating", but seeing as we're just implementing a little syntactic sugar, I think it's alright :)
GHC 7.8
The following works on GHC 7.8:
-- A lot more extensions.
{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, PolyKinds, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Nats where
import GHC.TypeLits
data N = Z | S N
data P n = P
type family Index n where
Index 0 = Z
Index n = S (Index (n - 1))
-- Compose is defined using Z/S instead of 0, 1, ... in order to avoid overlapping.
class Compose n f r where
type Return n f r
type Replace n f r
compose' :: P n -> (Return n f r -> r) -> f -> Replace n f r
instance Compose Z a b where
type Return Z a b = a
type Replace Z a b = b
compose' _ f x = f x
instance Compose n f r => Compose (S n) (a -> f) r where
type Return (S n) (a -> f) r = Return n f r
type Replace (S n) (a -> f) r = a -> Replace n f r
compose' x f g = compose' (prev x) f . g
where
prev :: P (S n) -> P n
prev P = P
compose :: Compose (Index n) f r => P n -> (Return (Index n) f r -> r) -> f -> Replace (Index n) f r
compose x = compose' (convert x)
where
convert :: P n -> P (Index n)
convert P = P
-- This does not type check without a signature due to the monomorphism restriction.
compBinRel :: (a -> a -> Bool) -> (a -> a -> Bool)
compBinRel = compose (P::P 2) not
-- This is an example where we compose over higher order functions.
-- Think of it as composing (a -> (b -> c)) and ((b -> c) -> c).
-- This will not typecheck without signatures, despite the fact that it has arguments.
-- However, it will if we use the first solution.
appSnd :: b -> (a -> b -> c) -> a -> c
appSnd x f = compose (P::P 1) ($ x) f
However, this implementation has a few downsides, as annotated in the source.
I attempted (and failed) to use closed type families to infer the composition index automatically. It might have been possible to infer higher order functions like this:
-- Given r and f, where f = x1 -> x2 -> ... -> xN -> r, Infer r f returns N.
type family Infer r f where
Infer r r = Zero
Infer r (a -> f) = Succ (Infer r f)
However, Infer won't work for higher order functions with polymorphic arguments. For example:
ghci> :kind! forall a b. Infer a (b -> a)
forall a b. Infer a (b -> a) :: *
= forall a b. Infer a (b -> a)
GHC can't expand Infer a (b -> a) because it doesn't perform an occurs check when matching closed family instances. GHC won't match the second case of Infer on the off chance that a and b are instantiated such that a unifies with b -> a.

Binding name in type signature using DataKind

So, I finally found a task where I could make use of the new DataKinds extension (using ghc 7.4.1). Here's the Vec I'm using:
data Nat = Z | S Nat deriving (Eq, Show)
data Vec :: Nat -> * -> * where
Nil :: Vec Z a
Cons :: a -> Vec n a -> Vec (S n) a
Now, for convenience I wanted to implement fromList. Basically no problem with simple recursion/fold -- but I can't figure out how to give it the correct type. For reference, this is the Agda version:
fromList : ∀ {a} {A : Set a} → (xs : List A) → Vec A (List.length xs)
My Haskell approach, using the syntax I saw here:
fromList :: (ls :: [a]) -> Vec (length ls) a
fromList [] = Nil
fromList (x:xs) = Cons x (fromList xs)
This gives me a parse error on input 'a'. Is the syntax I found even correct, or have they changed it? I also added some more extensions which are in the code in the link, which didn't help either (currently I have GADTs, DataKinds, KindSignatures, TypeOperators, TypeFamilies, UndecidableInstances).
My other suspicion was that I just can't bind polymorphic types, but my test for this:
bla :: (n :: Nat) -> a -> Vec (S n) a
bla = undefined
failed, too, with Kind mis-match Expected kind 'ArgKind', but 'n' has kind 'Nat' (don't really know what that means).
Could anyone help me with a working version of fromList and also clarify the other issues? Unfortunately, DataKinds isn't documented very well yet and seems to assume that everybody using it has profound type theory knowledge.
Haskell, unlike Agda, does not have dependent types, so there is no way to do exactly what you want. Types cannot be parameterized by value, since Haskell enforces a phase distinction between runtime and compile time. The way DataKinds works conceptually is actually really simple: data types are promoted to kinds (types of types) and data constructors are promoted to types.
fromList :: (ls :: [a]) -> Vec (length ls) a
has a couple of problems: (ls :: [a]) does not really make sense (at least when you are only faking dependent types with promotion), and length is a type variable instead of a type function. What you want to say is
fromList :: [a] -> Vec ??? a
where ??? is the length of the list. The problem is that you have no way of getting the length of the list at compile time... so we might try
fromList :: [a] -> Vec len a
but this is wrong, since it says that fromList can return a list of any length. Instead what we want to say is
fromList :: exists len. [a] -> Vec len a
but Haskell does not support this. Instead
data VecAnyLength a where
VecAnyLength :: Vec len a -> VecAnyLength a
cons a (VecAnyLength v) = VecAnyLength (Cons a v)
fromList :: [a] -> VecAnyLength a
fromList [] = VecAnyLength Nil
fromList (x:xs) = cons x (fromList xs)
you can actually use a VecAnyLength by pattern matching, and thus getting a (locally) psuedo-dependently typed value.
similarly,
bla :: (n :: Nat) -> a -> Vec (S n) a
does not work because Haskell functions can only take arguments of kind *. Instead you might try
data HNat :: Nat -> * where
Zero :: HNat Z
Succ :: HNat n -> HNat (S n)
bla :: HNat n -> a -> Ven (S n) a
which is even definable
bla Zero a = Cons a Nil
bla (Succ n) a = Cons a (bla n a)
You can use some typeclass magic here (see HList for more):
{-# LANGUAGE GADTs, KindSignatures, DataKinds, FlexibleInstances
, NoMonomorphismRestriction, FlexibleContexts #-}
data Nat = Z | S Nat deriving (Eq, Show)
data Vec :: Nat -> * -> * where
Nil :: Vec Z a
Cons :: a -> Vec n a -> Vec (S n) a
instance Show (Vec Z a) where
show Nil = "."
instance (Show a, Show (Vec m a)) => Show (Vec (S m) a) where
show (Cons x xs) = show x ++ " " ++ show xs
class FromList m where
fromList :: [a] -> Vec m a
instance FromList Z where
fromList [] = Nil
instance FromList n => FromList (S n) where
fromList (x:xs) = Cons x $ fromList xs
t5 = fromList [1, 2, 3, 4, 5]
but this not realy solve the problem:
> :t t5
t5 :: (Num a, FromList m) => Vec m a
Lists are formed at runtime, their length is not known at compile time, so the compiler can't infer the type for t5, it must be specified explicitly:
*Main> t5
<interactive>:99:1:
Ambiguous type variable `m0' in the constraint:
(FromList m0) arising from a use of `t5'
Probable fix: add a type signature that fixes these type variable(s)
In the expression: t5
In an equation for `it': it = t5
*Main> t5 :: Vec 'Z Int
*** Exception: /tmp/d.hs:20:3-19: Non-exhaustive patterns in function fromList
*Main> t5 :: Vec ('S ('S ('S 'Z))) Int
1 2 3 *** Exception: /tmp/d.hs:20:3-19: Non-exhaustive patterns in function fromList
*Main> t5 :: Vec ('S ('S ('S ('S ('S 'Z))))) Int
1 2 3 4 5 .
*Main> t5 :: Vec ('S ('S ('S ('S ('S ('S ('S 'Z))))))) Int
1 2 3 4 5 *** Exception: /tmp/d.hs:23:3-40: Non-exhaustive patterns in function fromList
Languages ​​with dependent types have maps from terms to types, types can be formed dynamically at runtime too, so this problem does not exist.
On top of the previous answers :
value level, from [a] to exist n. Vec n a
value to typed value, from [a] to Vec 5 a, where you have to provide a specific n.
A variant of the 1st transform, goes like
reify :: [a] -> (forall (n::Nat). Proxy n -> Vec n a -> w) -> w
reify [] k = k (Proxy # 'Z) Nil
reify (x:xs) k = reify xs (\(_ :: Proxy n) v -> k (Proxy # ('S n)) (Cons x v))
It still goes from a value [a] to a typed value Vec n a in which n is (statically) quantified. This is similar to the VecAnyLength approach, without introducing an actual datatype to perform quantification.
The proxy here is to explicit the n as a Nat. it can be removed from the code and n left silent, appearing only in the type Vec n a, and not provided to the values constructed, as it is in Proxy # ('S n).

Resources