First, I started with some typical type-level natural number stuff.
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
data Nat = Z | S Nat
type family Plus (n :: Nat) (m :: Nat) :: Nat
type instance Plus Z m = m
type instance Plus (S n) m = S (Plus n m)
So I wanted to create a data type representing an n-dimensional grid. (A generalization of what is found at Evaluating cellular automata is comonadic.)
data U (n :: Nat) x where
Point :: x -> U Z x
Dimension :: [U n x] -> U n x -> [U n x] -> U (S n) x
The idea is that the type U num x is the type of a num-dimensional grid of xs, which is "focused" on a particular point in the grid.
So I wanted to make this a comonad, and I noticed that there's this potentially useful function I can make:
ufold :: (x -> U m r) -> U n x -> U (Plus n m) r
ufold f (Point x) = f x
ufold f (Dimension ls mid rs) =
Dimension (map (ufold f) ls) (ufold f mid) (map (ufold f) rs)
We can now implement a "dimension join" that turns an n-dimensional grid of m-dimensional grids into an (n+m)-dimensional grid, in terms of this combinator. This will come in handy when dealing with the result of cojoin which will produce grids of grids.
dimJoin :: U n (U m x) -> U (Plus n m) x
dimJoin = ufold id
So far so good. I also noticed that the Functor instance can be written in terms of ufold.
instance Functor (U n) where
fmap f = ufold (\x -> Point (f x))
However, this results in a type error.
Couldn't match type `n' with `Plus n 'Z'
But if we whip up some copy pasta, then the type error goes away.
instance Functor (U n) where
fmap f (Point x) = Point (f x)
fmap f (Dimension ls mid rs) =
Dimension (map (fmap f) ls) (fmap f mid) (map (fmap f) rs)
Well I hate the taste of copy pasta, so my question is this. How can I tell the type system that Plus n Z is equal to n? And the catch is this: you can't make a change to the type family instances that would cause dimJoin to produce a similar type error.
What you need is a nice propositional equality type:
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
data Nat = Z | S Nat
type family Plus (n :: Nat) (m :: Nat) :: Nat
type instance Plus Z m = m
type instance Plus (S n) m = S (Plus n m)
data (:=) :: k -> k -> * where
Refl :: a := a
data Natural (n :: Nat) where
Zero :: Natural Z
Suc :: Natural n -> Natural (S n)
plusZero :: Natural n -> n := (n `Plus` Z)
plusZero Zero = Refl
plusZero (Suc n) | Refl <- plusZero n = Refl
This allows you to prove arbitrary things about your types and bring that knowledge into scope locally by pattern matching on the Refl.
One annoying thing is that my plusZero proof requires induction over the natural in question, which you won't be able to do by default (since it doesn't exist at runtime). A typeclass for generating Natural witnesses would be easy, though.
Another option for your particular case might be just to invert the arguments to plus in your type definition so that you get the Z on the left and it reduces automagically. It's often a good first step to make sure your types are as simple as you can make them, but then you'll often need propositional equality for more complicated things, regardless.
Related
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.
I tried this experiment:
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
wrapper :: forall a (b :: * -> *). Monad b => Int -> a -> b a
wrapper 1 v = return v
wrapper n v = return $ wrapper (n-1) v
But it gives to me the error:
Occurs check: cannot construct the infinite type: a ~ b0 a
Expected type: b a
Actual type: b (b0 a)
• In the expression: return $ wrapper (n - 1) v
In an equation for ‘wrapper’:
wrapper n v = return $ wrapper (n - 1) v
• Relevant bindings include
v :: a (bound at main.hs:7:11)
wrapper :: Int -> a -> b a (bound at main.hs:6:1)
Is it possible to create the function wrapper such as:
wrapper 4 'a' :: [Char]
[[[['a']]]]
Yes and no!
First of all, your type is inaccurate in the signature of the function. Taking your example of wrapper 4 'a', the return type of the function is m (m (m (m a))) (where m is []), not m a.
Secondly, we're not allowed infinite types in Haskell's type system, so we wouldn't be able to write down the correct type even if we wanted to!
That said, we can address both of these concerns with some new types that will do the type-level recursion for us. First, there's Fix:
newtype Fix f a = Fix { unFix :: f (Fix f a) }
Using this we can wrap infinitely:
wrap :: Monad m => Fix m a
wrap = Fix $ return $ wrap
As you can see, we don't need the base element (the a in your example) because we'll never hit the base of the recursion.
But that's not what you wanted either! The "infinite" here is actually something of a red herring: you want to be able to wrap something a finite number of times, using an argument to dictate the wrapping level.
You can do something like this with another wrapper:
data Wrap f a = Pure a | Wrap (f (Wrap f a))
wrapper :: Monad f => Int -> a -> Wrap f a
wrapper 0 x = Pure x
wrapper n x = Wrap $ pure $ wrapper (n-1) x
(This is in fact the free monad that we're using here)
What you're looking for exactly, though (i.e., no wrappers) can be done, however, it's quite involved, and probably not what you're looking for. I'll include it for completeness nonetheless.
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeApplications #-}
import Data.Kind
import GHC.TypeLits
data N = Z | S N
type family Wrap (n :: N) (f :: Type -> Type) (a :: Type) :: Type where
Wrap Z f a = a
Wrap (S n) f a = Wrap n f (f a)
type family FromNat (n :: Nat) :: N where
FromNat 0 = Z
FromNat n = S (FromNat (n - 1))
data Ny (n :: N) where
Zy :: Ny Z
Sy :: Ny n -> Ny (S n)
class KnownN n where sing :: Ny n
instance KnownN Z where sing = Zy
instance KnownN n => KnownN (S n) where sing = Sy sing
wrap :: forall n f a. (KnownN (FromNat n), Monad f) => a -> Wrap (FromNat n) f a
wrap = go #(FromNat n) #f #a sing
where
go :: forall n f a. Monad f => Ny n -> a -> Wrap n f a
go Zy x = x
go (Sy n) x = go #_ #f n (return #f x)
main = print (wrap #4 'a' == [[[['a']]]])
In Haskell if I want to repeatedly apply an endomorphism a -> a to a value of type a I can just use iterate.
What about a function that is not an endomorphisms, but generic enough to work correctly on its return type?
Consider for example Just :: a -> Maybe a; I can write
Just . Just . Just ...
as many times as I want. Is there a way to write this shortly with something like
iterate' 3 Just :: a -> Maybe (Maybe (Maybe a))
or do we need something like dependent types to do this?
It is possible with a minor tweak to the syntax you proposed: iterate' #3 Just instead of iterate' 3 Just.
This is because the result type depends on the number, so the number has to be a type literal, not a value literal. As you correctly note, doing this with arbitrary numbers would require dependent types[1], which Haskell doesn't have.
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE TypeFamilies, KindSignatures, DataKinds,
FlexibleInstances, UndecidableInstances, ScopedTypeVariables,
FunctionalDependencies, TypeApplications, RankNTypes, FlexibleContexts,
AllowAmbiguousTypes #-}
import qualified GHC.TypeLits as Lit
-- from type-natural
import Data.Type.Natural
import Data.Type.Natural.Builtin
class Iterate (n :: Nat) (f :: * -> *) (a :: *) (r :: *)
| n f a -> r
where
iterate_peano :: Sing n -> (forall b . b -> f b) -> a -> r
instance Iterate 'Z f a a where
iterate_peano SZ _ = id
instance Iterate n f (f a) r => Iterate ('S n) f a r where
iterate_peano (SS n) f x = iterate_peano n f (f x)
iterate'
:: forall (n :: Lit.Nat) f a r .
(Iterate (ToPeano n) f a r, SingI n)
=> (forall b . b -> f b) -> a -> r
iterate' f a = iterate_peano (sToPeano (sing :: Sing n)) f a
If you load this in ghci, you can say
*Main> :t iterate' #3 Just
iterate' #3 Just :: a -> Maybe (Maybe (Maybe a))
*Main> iterate' #3 Just True
Just (Just (Just True))
This code uses two different type-level naturals: the built-in Nat from GHC.TypeLits and the classic Peano numerals from Data.Type.Natural. The former are needed to provide the nice iterate' #3 syntax, the latter are needed to perform the recursion (which happens in the Iterate class). I used Data.Type.Natural.Builtin to convert from a literal to the corresponding Peano numeral.
[1] However, given a specific way to consume the iterated values (e.g. if you know in advance that you'll only want to show them), you probably could adapt this code to work even for dynamic values of n. There's nothing in the type of iterate' that requires a statically known Nat; the only challenge is to prove that the result of the iteration satisfies the constraints you need.
You can do it with template haskell, if you know the number at compile time (but unless the number is pretty large I don't think it's worth the hassle). If you don't know the number yet at compile time, you need to correctly model the return type, which we can do using a non-regular type:
data Iter f a = Iter0 a | IterS (Iter f (f a))
iterate' :: Int -> (forall x. x -> f x) -> a -> Iter f a
iterate' 0 f x = Iter0 x
iterate' n f x = IterS (iterate' (n-1) f (f x))
Iter is essentially a way of expressing the data type a | f a | f (f a) | f (f (f a)) | .... To use the result you need to recurse on Iter. Also the function has to be of the form a -> f a for some type constructor f, so you may need to do some newtype wrapping to get there. So... it's kind of a pain either way.
You can do this without Template Haskell or type-level Nats. The kind of variable-depth recursive type you are building actually fits perfectly into the model of a free monad. We can use the unfold function from the free package to build up a Free structure and short-circuit when our counter reaches 0.
-- This extension is enabled so we can have nice type annotations
{-# Language ScopedTypeVariables #-}
import Control.Monad.Free (Free)
import qualified Control.Monad.Free as Free
iterate' :: forall f a. Functor f => Int -> (a -> f a) -> a -> Free f a
iterate' counter0 f x0 = Free.unfold run (counter0, x0)
where
-- If counter is 0, short circuit with current result
-- Otherwise, continue computation with modified counter
run :: (Int, a) -> Either a (f (Int, a))
run (0 , x) = Left x
run (counter, x) = Right (countDown counter <$> f x)
countDown :: Int -> a -> (Int, a)
countDown counter x = (counter - 1, x)
Now, it's easy to create and digest these types of values for any Functor.
> iterate' 3 Just True
Free (Just (Free (Just (Free (Just (Pure True))))))
> let f i = if i == 1 then Left "abort" else Right (i+1)
> iterate' 0 f 0
Pure 0
> iterate' 1 f 0
Free (Right (Pure 1))
> iterate' 2 f 0
Free (Right (Free (Left "abort")))
If your Functor also happens to be a Monad, you can use retract to collapse the recursive structure.
> Free.retract (iterate' 3 Just True)
Just True
> Free.retract (iterate' 0 f 0)
Right 0
> Free.retract (iterate' 1 f 0)
Right 1
> Free.retract (iterate' 2 f 0)
Left "abort"
I suggest reading the docs for Control.Monad.Free so you can get an idea for how these structures are created/consumed.
(Just as an aside, a -> Maybe a is an endomorphism, but it's an endomorphism in the Kleisli category of Maybe.)
I would like to have a type which can contain values 0 to n, where n lives on the type level.
I was trying something like:
import GHC.TypeLits
import Data.Proxy
newtype FiniteNat n = FiniteNat { toInteger :: Integer }
smartConstructFiniteNat :: (KnownNat n) => Proxy n -> Integer -> Maybe (FiniteNat (Proxy n))
smartConstructFiniteNat pn i
| 0 <= i && i < n = Just (FiniteNat i)
| otherwise = Nothing
where n = natVal pn
which works basically, but it's not really satisfying somehow. Is there a "standard" solution, or even a library to achieve this? There is a lot of fuss about dependenty typed list-lengths, but I was unable to find something exactly for this. Also - I assume using GHC.TypeLits is necessary, because my n can take on rather large values, so inductive definition would probably be very slow.
You can directly translate Idris's Fin into the usual Haskell mishmash of sort-of-dependently-typed features.
data Fin n where
FZ :: Fin (S n)
FS :: Fin n -> Fin (S n)
(!) :: Vec n a -> Fin n -> a
(x :> xs) ! FZ = x
(x :> xs) ! (FS f) = xs ! f
With TypeInType you can even have singleton Fins!
data Finny n (f :: Fin n) where
FZy :: Finny (S n) FZ
FSy :: Finny n f -> Finny (S n) (FS f)
This allows you to fake up dependent quantification over runtime stuff, eg,
type family Fin2Nat n (f :: Fin n) where
Fin2Nat (S _) FZ = Z
Fin2Nat (S n) (FS f) = S (Fin2Nat n f)
-- tighten the upper bound on a given Fin as far as possible
tighten :: Finny n f -> Fin (S (Fin2Nat n f))
tighten FZy = FZ
tighten (FSy f) = FS (tighten f)
but, ugh, it kinda sucks to have to duplicate everything at the value and type level, and writing out all your kind variables (n) can get pretty tedious.
If you're really sure you need an efficient runtime representation of Fin, you can do basically what you did in your question: stuff a machine Int into a newtype and use a phantom type for its size. But the onus is on you, the library implementer, to make sure the Int fits the bound!
newtype Fin n = Fin Int
-- fake up the constructors
fz :: Fin (S n)
fz = Fin 0
fs :: Fin n -> Fin (S n)
fs (Fin n) = Fin (n+1)
This version lacks real GADT constructors, so you can't manipulate type equalities using pattern matching. You have to do it yourself using unsafeCoerce. You can give clients a type-safe interface in the form of fold, but they have to be willing to write all their code in a higher-order style, and (since fold is a catamorphism) it becomes harder to look at more than one layer at a time.
-- the unsafeCoerce calls assert that m ~ S n
fold :: (forall n. r n -> r (S n)) -> (forall n. r (S n)) -> Fin m -> r m
fold k z (Fin 0) = unsafeCoerce z
fold k z (Fin n) = unsafeCoerce $ k $ fold k z (Fin (n-1))
Oh, and you can't do type level computation (as we did with Fin2Nat above) with this representation of Fin, because type level Ints don't permit induction.
For what it's worth, Idris's Fin is just as inefficient as the GADT one above. The docs contain the following caveat:
It's probably not a good idea to use Fin for arithmetic, and they will be exceedingly inefficient at run time.
I've heard noises about a future version of Idris being able to spot "Nat with types"-style datatypes (like Fin) and automatically erase the proofs and pack the values into machine integers, but as far as I know we're not there yet.
rampion suggested pattern synonyms, and I agreed, but it is admittedly not entirely trivial to work out how to structure their signatures properly. Thus I figured I'd write a proper answer to give the full code.
First, the usual boilerplate:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
module FakeFin (Nat (..), Fin (FZ, FS), FinView (..), viewFin) where
import Numeric.Natural
import Unsafe.Coerce
Now the basic types:
data Nat = Z | S Nat
-- Fin *must* be exported abstractly (or placed in an Unsafe
-- module). Users can use its constructor to implement
-- unsafeCoerce!
newtype Fin (n :: Nat) = Fin Natural
deriving instance Show (Fin n)
It is much easier to work via a view type rather than directly, so let's define one:
data FinView n where
VZ :: FinView ('S n)
VS :: !(Fin n) -> FinView ('S n)
deriving instance Show (FinView n)
It is important to note that we could have defined FinView using explicit equality constraints, because we will have to think in those terms to give correct pattern signatures:
data FinView n where
VZ :: n ~ 'S m => FinView n
VS :: n ~ 'S m => !(Fin m) -> FinView n
Now the actual view function:
viewFin :: Fin n -> FinView n
viewFin (Fin 0) = unsafeCoerce VZ
viewFin (Fin n) = unsafeCoerce (VS (Fin (n - 1)))
The pattern signatures precisely mirror the signatures of the FinView constructors.
pattern FZ :: () => n ~ 'S m => Fin n
pattern FZ <- (viewFin -> VZ) where
FZ = Fin 0
pattern FS :: () => n ~ 'S m => Fin m -> Fin n
pattern FS m <- (viewFin -> VS m) where
FS (Fin m) = Fin (1 + m)
-- Let GHC know that users need only match on `FZ` and `FS`.
-- This pragma only works for GHC 8.2 (and presumably future
-- versions).
{-# COMPLETE FZ, FS #-}
For completeness (because it took me rather more effort to write this than I expected), here's one way to write unsafeCoerce if this module accidentally exports the Fin data constructor. I imagine there are probably simpler ways.
import Data.Type.Equality
type family YahF n a b where
YahF 'Z a _ = a
YahF _ _ b = b
newtype Yah n a b = Yah (YahF n a b)
{-# NOINLINE finZBad #-}
finZBad :: 'Z :~: n -> Fin n -> a -> b
finZBad pf q =
case q of
FZ -> blah (trans pf Refl)
FS _ -> blah (trans pf Refl)
where
blah :: forall a b m. 'Z :~: 'S m -> a -> b
blah pf2 a = getB pf2 (Yah a)
{-# NOINLINE getB #-}
getB :: n :~: 'S m -> Yah n a b -> b
getB Refl (Yah b) = b
myUnsafeCoerce :: a -> b
myUnsafeCoerce = finZBad Refl (Fin 0)
finZBad is where all the action happens, but it doesn't do anything remotely improper! If someone really gives us a non-bottom value of type Fin 'Z, then something has already gone terribly wrong. The explicit type equality evidence here is necessary because if GHC sees code wanting 'Z ~ 'S m, it will simply reject it out of hand; GHC doesn't really like hypothetical reasoning in constraints. The NOINLINE annotations are necessary because GHC's simplifier itself uses type information; handling evidence of things it knows very well are impossible confuses it terribly, with extremely arbitrary results. So we block it up and successfully implement The Evil Function.
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.