I'm attempting to implement church numerals in Haskell, but I've hit a minor problem. Haskell complains of an infinite type with
Occurs check: cannot construct the infinite type: t = (t -> t1) -> (t1 -> t2) -> t2
when I try and do subtraction. I'm 99% positive that my lambda calculus is valid (although if it isn't, please tell me). What I want to know, is whether there is anything I can do to make haskell work with my functions.
module Church where
type (Church a) = ((a -> a) -> (a -> a))
makeChurch :: Int -> (Church a)
makeChurch 0 = \f -> \x -> x
makeChurch n = \f -> \x -> f (makeChurch (n-1) f x)
numChurch x = (x succ) 0
showChurch x = show $ numChurch x
succChurch = \n -> \f -> \x -> f (n f x)
multChurch = \f2 -> \x2 -> \f1 -> \x1 -> f2 (x2 f1) x1
powerChurch = \exp -> \n -> exp (multChurch n) (makeChurch 1)
predChurch = \n -> \f -> \x -> n (\g -> \h -> h (g f)) (\u -> x) (\u -> u)
subChurch = \m -> \n -> (n predChurch) m
The problem is that predChurch is too polymorphic to be correctly inferred by Hindley-Milner type inference. For example, it is tempting to write:
predChurch :: Church a -> Church a
predChurch = \n -> \f -> \x -> n (\g -> \h -> h (g f)) (\u -> x) (\u -> u)
but this type is not correct. A Church a takes as its first argument an a -> a, but you are passing n a two argument function, clearly a type error.
The problem is that Church a does not correctly characterize a Church numeral. A Church numeral simply represents a number -- what on earth could that type parameter mean? For example:
foo :: Church Int
foo f x = f x `mod` 42
That typechecks, but foo is most certainly not a Church numeral. We need to restrict the type. Church numerals need to work for any a, not just a specific a. The correct definition is:
type Church = forall a. (a -> a) -> (a -> a)
You need to have {-# LANGUAGE RankNTypes #-} at the top of the file to enable types like this.
Now we can give the type signature we expect:
predChurch :: Church -> Church
-- same as before
You must give a type signature here because higher-rank types are not inferrable by Hindley-Milner.
However, when we go to implement subChurch another problem arises:
Couldn't match expected type `Church'
against inferred type `(a -> a) -> a -> a'
I am not 100% sure why this happens, I think the forall is being too liberally unfolded by the typechecker. It doesn't surprise me though; higher rank types can be a bit brittle because of the difficulties they present to a compiler. Besides, we shouldn't be using a type for an abstraction, we should be using a newtype (which gives us more flexibility in definition, helps the compiler with typechecking, and marks the places where we use the implementation of the abstraction):
newtype Church = Church { unChurch :: forall a. (a -> a) -> (a -> a) }
And we have to modify predChurch to roll and unroll as necessary:
predChurch = \n -> Church $
\f -> \x -> unChurch n (\g -> \h -> h (g f)) (\u -> x) (\u -> u)
Same with subChurch:
subChurch = \m -> \n -> unChurch n predChurch m
But we don't need type signatures anymore -- there is enough information in the roll/unroll to infer types again.
I always recommend newtypes when creating a new abstraction. Regular type synonyms are pretty rare in my code.
This definition of predChurch doesn't work in simply typed lambda calculus, only in the untyped version. You can find a version of predChurch that works in Haskell here.
I have encountered the same problem. And I solved it without adding type signature.
Here's the solution, with cons car copied from SICP.
cons x y = \m -> m x y
car z = z (\p q -> p)
cdr z = z (\p q -> q)
next z = cons (cdr z) (succ (cdr z))
pred n = car $ n next (cons undefined zero)
sub m n = n pred m
You can find full source here.
I'm really amazed after writing sub m n = n pred m, and load it in ghci without type error!
Haskell code is so concise! :-)
Related
I am learning haskell currently and I am having a really hard time wrapping my head around how to explain <$> and <*>'s behavior.
For some context this all came from searching how to use an or operation when using takeWhile and the answer I found was this
takeWhile ((||) <$> isDigit <*> (=='.'))
In most of the documentation I have seen, <*> is used with a container type.
show <*> Maybe 10
By looking at
(<$>) :: Functor f => (a -> b) -> f a -> f b
It tells me that <*> keeps the outer container if its contents and applies the right to the inside, then wraps it back into the container
a b f a f b
([Int] -> String) -> [Just]([Int]) -> [Just]([String])
This makes sense to me, in my mind the f a is essentially happening inside the container, but when I try the same logic, I can make sense to me but I cant correlate the logic
f = (+) <$> (read)
so for f it becomes
a b f a f b
([Int] -> [Int -> Int]) -> ([String] -> [Int]) -> ([String] -> [Int -> Int])
So f being the container really confuses me when I try and work out what this code is going to do. I understand when I write it out like this, I can work it out and see its basically equivalent to the .
(.) :: (b -> c) -> (a -> b) -> a -> c
b c a b a c
([Int] -> [Int -> Int]) -> ([String] -> [Int]) -> ([String] -> [Int -> Int])
so it can be written as
f = (+) . read
Why not just write it as just that? Why wasn't the original snippet just written as
takeWhile ((||) . isDigit <*> (=='.'))
or does <$> imply something in this context that . des not?
Now looking at <*>, it seems like it is basicly exactly the same as the <$> except it takes two containers, uses the inner of both, then puts it pack in the container
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
so
Just show <*> Just 10
f a b f a f b
[Just]([Int->Int]->[Int]) -> [Just]([Int->Int]) -> [Just]([Int])
However with functions, it becomes murky how things are being passed around to each other.
Looking at the original snippit and breaking it up
f1 :: Char -> Bool -> Bool
f1 = (||) . isDigit
f2 :: Char -> Bool
f2 = f1 <*> (== '.')
<*> behavior in f2 is
f a b f a f b
([Char] -> [Bool] -> [Bool]) -> ([Char] -> [Bool]) -> ([Char] -> [Bool])
So using previous logic, I see it as Char -> is the container, but its not very useful for me when working out what's happening.
It looks to me as if <*> is passing the function parameter into right side, then passing the same function parameter, and the return value into the left?
So to me, it looks equivalent to
f2 :: Char -> Bool
f2 x = f1 x (x=='_')
Its a bit of mental gymnastics for me to work out where the data is flowing when I see <*> and <$>. I guess im just looking for how an experienced haskell-er would read these operations in their head.
The applicative instance for functions is quite simple:
f <*> g = \x -> f x (g x)
You can verify for yourself that the types match up. And as you said,
(<$>) = (.)
(Ignoring fixity)
So you can rewrite your function:
(||) <$> isDigit <*> (=='.')
(||) . isDigit <*> (=='.')
\x -> ((||) . isDigit) x ((=='.') x)
-- Which can simply be rewritten as:
\x -> isDigit x || x == '.'
But it's important to understand why the function instance is as it is and how it works. Let's begin with Maybe:
instance Applicative Maybe where
pure :: a -> Maybe a
pure x = Just x
(<*>) :: Maybe (a -> b) -> Maybe a -> Maybe b
Nothing <*> _ = Nothing
_ <*> Nothing = Nothing
(Just f) <*> (Just x) = Just (f x)
Ignore the implementation here and just look at the types. First, notice that we've made Maybe an instance of Applicative. What exactly is Maybe? You might say that it's a type, but that isn't true - I can't write something like
x :: Maybe
- that doesn't make sense. Instead, I need to write
x :: Maybe Int
-- Or
x :: Maybe Char
or any other type after Maybe. So we give Maybe a type like Int or Char, and it suddenly becomes a type itself! That's why Maybe is what's known as a type constructor.
And that's exactly what the Applicative typeclass expects - a type constructor, which you can put any other type inside. So, using your analogy, we can think of giving Applicative a container type.
Now, what do I mean by
a -> b
?
We can rewrite it using prefix notation (the same way 1 + 2 = (+) 1 2)
(->) a b
And here we see that the arrow (->) itself is also just a type constructor - but unlike Maybe, it takes two types. But Applicative only wants a type constructor which takes one type. So we give it this:
instance Applicative ((->) r)
Which means that for any r, (->) r is an Applicative. Continuing the container analogy, (->) r is now a container for any type b such that the resulting type is r -> b. What that means is that the contained type is actually the future result of the function on giving it an r.
Now for the actual instance:
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
Substituting (->) r as the applicative,
(<*>) :: ((->) r (a -> b)) -> ((->) r a) ((->) r b)
-- Rewriting it in infix notation:
(<*>) :: (r -> (a -> b)) -> (r -> a) -> (r -> b)
How would we go about writing the instance? Well, we need a way to get the contained type out of the container - but we can't use pattern matching like we did with Maybe. So, we use a lambda:
(f :: r -> (a -> b)) <*> (g :: r -> a) = \(x :: r) -> f x (g x)
And the type of f x (g x) is b, so the entire lambda has type r -> b, which is exactly what we were looking for!
EDIT: I noticed that I didn't talk about the implementation of pure for functions - I could update the answer, but try seeing if you can use the type signature to work it out yourself!
Asking the GHC to print the type of "one" and "succ zero" (lambda calculus way of encoding numerals), I get two different types!
Shouldn't they be the same?
Can you also show me how to derive its type manually?
zero = \ f x -> x
one = \ f x -> f x
succ = \ n f x -> f (n (f x))
:t one -- (t1 -> t2) -> t1 -> t2
:t succ zero -- ((t1 -> t1) -> t2) -> (t1 -> t1) -> t2
So as was said in the comments, the correct definition is
zero f x = x
succ n f x = f (n f x)
"do one more f after n applications of f, starting with x."
Thus
one f x = succ zero f x = f (zero f x) = f x
two f x = succ one f x = f (one f x) = f (f x)
The types which get derived are more general initially,
zero :: t -> t1 -> t1 -- most general
one :: (t1 -> t ) -> t1 -> t -- less general
succ one :: (t2 -> t2) -> t2 -> t2 -- most specific
but it doesn't matter, they all match (unify) between themselves, and starting from two = succ one the type settles down into the most specific (b -> b) -> (b -> b).
You could also define
church :: Int -> (b -> b) -> b -> b -- is derived so by GHCi
church n f x = foldr ($) x (replicate n f)
= foldr (.) id (replicate n f) x
{- church n = foldr (.) id . replicate n -- (^ n) for functions -}
and have all types be exactly the same, as
church 0 :: (b -> b) -> b -> b
church 1 :: (b -> b) -> b -> b
church 2 :: (b -> b) -> b -> b
It really doesn't matter.
As to the type derivations, it comes down to just using the modus ponens / application rule,
f :: a -> b
x :: a
-------------
f x :: b
Just need to be careful renaming each type consistently so there's no type variable capture introduced at any step:
succ n f x = f (n f x)
x :: a
f :: t , t ~ ...
n :: t -> a -> b
f :: b -> c , t ~ b -> c
succ n f x :: c
succ :: (t -> a -> b) -> (b -> c) -> a -> c
:: ((b -> c) -> a -> b) -> (b -> c) -> a -> c
(because final result type produced by succ is the same as the final result type produced by f -- i.e. c), or as GHCi puts it,
succ :: ((t1 -> t) -> t2 -> t1) -> (t1 -> t) -> t2 -> t
-- b c a b b c a c
Firstly, you want zero to be same type as one. In your equation for zero, you don't use f on rhs of ->. So the compiler doesn't know what type to infer. In your equation for one, you want f x (its result) to be same type as x (the result from zero). But you're not getting that either. It's easiest to give signatures, but failing that use asTypeOf.
In the equation for succ, you want its result to be same type as f x, same type as x.
Can you also show me how to derive its type manually?
OK let's achieve the above using asTypeOf. Then you can use :t to find the types ...
zero = \ f x -> (x `asTypeOf` f x)
one = \ f x -> (f x `asTypeOf` x)
succ = \ n f x -> (f (n f x)
`asTypeOf` f x `asTypeOf` x)
(I've used the correct definition for succ, per #LambdaFairy.)
Note that Church numerals are framed in the untyped lambda calculus -- that's what wikipedia is showing. As you get into more exotic functions over them (like addition or predecessor), you'll find that Haskell is a typed lambda calculus, and GHC will barf/you'll hit the dreaded monomorphism restriction. Then asTypeOf can't help you; you must resort to type signatures (of higher-rank).
Can someone please help me understand this map definition in Professor Wadler's original paper Monads for Functional Programming (Haskell).
map :: (a → b) →(M a →M b)
map f m =m >= λa.unit(f a)
I understand why it is declared as a morphism from f::a -> b to g::Ma -> Mb. Why is it confusingly defined as seemingly taking 2 args f and m. m is a computation ( function with side effects) that I assume can be defined as data or type.
A definition of the form
foo x y z = bar
is equivalent to all of the following ones
foo x y = \z -> bar
foo x = \y z -> bar
foo = \x y z -> bar
Hence, the posted code could also be written as
map :: (a → b) → (M a → M b)
map f = \m -> m >= \a -> unit (f a)
-- which is parsed as
-- map f = \m -> (m >= (\a -> (unit (f a))))
The above indeed emphasizes that map maps functions to functions, and is arguably clearer. However, it is a bit more verbose, so it is common in Haskell to move the arguments to the left side of = as much as possible.
The second argument is the first argument for the returned function:
map : (a -> b) -> m a -> m b
map = \(f : a -> b) -> \(x : m a) ->
x >>= (\a -> return (f a))
I've been using the Free datatype in Control.Monad.Free from the free package. Now I'm trying to convert it to use F in Control.Monad.Free.Church but can't figure out how to map the functions.
For example, a simple pattern matching function using Free would look like this -
-- Pattern match Free
matchFree
:: (a -> r)
-> (f (Free f a) -> r)
-> Free f a
-> r
matchFree kp _ (Pure a) = kp a
matchFree _ kf (Free f) = kf f
I can easily convert it to a function that uses F by converting to/from Free -
-- Pattern match F (using toF and fromF)
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
matchF kp kf = matchF' . fromF
where
matchF' (Pure a) = kp a
matchF' (Free f) = kf (fmap toF f)
However I can't figure out how to get it done without using toF and fromF -
-- Pattern match F (without using toF)???
-- Doesn't compile
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
matchF kp kf f = f kp kf
There must be a general pattern I am missing. Can you help me figure it out?
You asked for the "general pattern you are missing". Let me give my own attempt at explaining it, though Petr Pudlák's answer is also pretty good. As user3237465 says, there are two encodings that we can use, Church and Scott, and you're using Scott rather than Church. So here's the general review.
How encodings work
By continuation passing, we can describe any value of type x by some unique function of type
data Identity x = Id { runId :: x }
{- ~ - equivalent to - ~ -}
newtype IdentityFn x = IdFn { runIdFn :: forall z. (x -> z) -> z }
The "forall" here is very important, it says that this type leaves z as an unspecified parameter. The bijection is that Id . ($ id) . runIdFn goes from IdentityFn to Identity while IdFn . flip ($) . runId goes the other way. The equivalence comes because there is essentially nothing one can do with the type forall z. z, no manipulations are sufficiently universal. We can equivalently state that newtype UnitFn = UnitFn { runUnitFn :: forall z. z -> z } has only one element, namely UnitFn id, which means that it corresponds to the unit type data Unit = Unit in a similar way.
Now the currying observation that (x, y) -> z is isomorphic to x -> y -> z is the tip of a continuation-passing iceberg which allows us to represent data structures in terms of pure functions, with no data structures, because clearly the type Identity (x, y) is equivalent therefore to forall z. (x -> y -> z) -> z. So "gluing" together two items is the same as creating a value of this type, which just uses pure functions as "glue".
To see this equivalence, we have to just handle two other properties.
The first is sum-type constructors, in the form of Either x y -> z. See, Either x y -> z is isomorphic to
newtype EitherFn x y = EitherFn { runEitherFn :: forall z. (x -> z) -> (y -> z) -> z }
from which we get the basic idea of the pattern:
Take a fresh type variable z that does not appear in the body of the expression.
For each constructor of the data type, create a function-type which takes all of its type-arguments as parameters, and returns a z. Call these "handlers" corresponding to the constructors. So the handler for (x, y) is (x, y) -> z which we curry to x -> y -> z, and the handlers for Left x | Right y are x -> z and y -> z. If there are no parameters, you can just take a value z as your function rather than the more cumbersome () -> z.
Take all of those handlers as parameters to an expression forall z. Handler1 -> Handler2 -> ... -> HandlerN -> z.
One half of the isomorphism is basically just to hand the constructors in as the desired handlers; the other pattern-matches on the constructors and applies the correponding handlers.
Subtle missing things
Again, it's fun to apply these rules to various things; for example as I noted above, if you apply this to data Unit = Unit you find that any unit type is the identity function forall z. z -> z, and if you apply this to data Bool = False | True you find the logic functions forall z. z -> z -> z where false = const while true = const id. But if you do play with it you will notice that something's missing still. Hint: if we look at
data List x = Nil | Cons x (List x)
we see that the pattern should look like:
data ListFn x = ListFn { runListFn :: forall z. z -> (x -> ??? -> z) -> z }
for some ???. The above rules don't pin down what goes there.
There are two good options: either we use the power of the newtype to its fullest to put ListFn x there (the "Scott" encoding), or we can preemptively reduce it with the functions we've been given, in which case it becomes a z using the functions that we already have (the "Church" encoding). Now since the recursion is already being performed for us up-front, the Church encoding is only perfectly equivalent for finite data structures; the Scott encoding can handle infinite lists and such. It can also be hard to understand how to encode mutual recursion in the Church form whereas the Scott form is usually a little more straightforward.
Anyway, the Church encoding is a little harder to think about, but a little more magical because we get to approach it with wishful thinking: "assume that this z is already whatever you're trying to accomplish with tail list, then combine it with head list in the appropriate way." And this wishful thinking is precisely why people have trouble understanding foldr, as the one side of this bijection is precisely the foldr of the list.
There are some other problems like "what if, like Int or Integer, the number of constructors is big or infinite?". The answer to this particular question is to use the functions
data IntFn = IntFn { runIntFn :: forall z. (z -> z) -> z -> z }
What is this, you ask? Well, a smart person (Church) has worked out that this is a way to represent integers as the repetition of composition:
zero f x = x
one f x = f x
two f x = f (f x)
{- ~ - increment an `n` to `n + 1` - ~ -}
succ n f = f . n f
Actually on this account m . n is the product of the two. But I mention this because it is not too hard to insert a () and flip arguments around to find that this is actually forall z. z -> (() -> z -> z) -> z which is the list type [()], with values given by length and addition given by ++ and multiplication given by >>.
For greater efficiency, you might Church-encode data PosNeg x = Neg x | Zero | Pos x and use the Church encoding (keeping it finite!) of [Bool] to form the Church encoding of PosNeg [Bool] where each [Bool] implicitly ends with an unstated True at its most-significant bit at the end, so that [Bool] represents the numbers from +1 to infinity.
An extended example: BinLeaf / BL
One more nontrivial example, we might think about the binary tree which stores all of its information in leaves, but also contains annotations on the internal nodes: data BinLeaf a x = Leaf x | Bin a (BinLeaf a x) (BinLeaf a x). Following the recipe for Church encoding we do:
newtype BL a x = BL { runBL :: forall z. (x -> z) -> (a -> z -> z -> z) -> z}
Now instead of Bin "Hello" (Leaf 3) (Bin "What's up?" (Leaf 4) (Leaf 5) we construct instances in lowercase:
BL $ \leaf bin -> bin "Hello" (leaf 3) (bin "What's up?" (leaf 4) (leaf 5)
The isomorphism is thus very easy one way: binleafFromBL f = runBL f Leaf Bin. The other side has a case dispatch, but is not too bad.
What about recursive algorithms on the recursive data? This is where it gets magical: foldr and runBL of Church encoding have both run whatever our functions were on the subtrees before we get to the trees themselves. Suppose for example that we want to emulate this function:
sumAnnotate :: (Num n) => BinLeaf a n -> BinLeaf (n, a) n
sumAnnotate (Leaf n) = Leaf n
sumAnnotate (Bin a x y) = Bin (getn x' + getn y', a) x' y'
where x' = sumAnnotate x
y' = sumAnnotate y
getn (Leaf n) = n
getn (Bin (n, _) _ _) = n
What do we have to do?
-- pseudo-constructors for BL a x.
makeLeaf :: x -> BL a x
makeLeaf x = BL $ \leaf _ -> leaf x
makeBin :: a -> BL a x -> BL a x -> BL a x
makeBin a l r = BL $ \leaf bin -> bin a (runBL l leaf bin) (runBL r leaf bin)
-- actual function
sumAnnotate' :: (Num n) => BL a n -> BL n n
sumAnnotate' f = runBL f makeLeaf (\a x y -> makeBin (getn x + getn y, a) x y) where
getn t = runBL t id (\n _ _ -> n)
We pass in a function \a x y -> ... :: (Num n) => a -> BL (n, a) n -> BL (n, a) n -> BL (n, a) n. Notice that the two "arguments" are of the same type as the "output" here. With Church encoding, we have to program as if we've already succeeded -- a discipline called "wishful thinking".
The Church encoding for the Free monad
The Free monad has normal form
data Free f x = Pure x | Roll f (Free f x)
and our Church encoding procedure says that this becomes:
newtype Fr f x = Fr {runFr :: forall z. (x -> z) -> (f z -> z) -> z}
Your function
matchFree p _ (Pure x) = p x
matchFree _ f (Free x) = f x
becomes simply
matchFree' p f fr = runFr fr p f
Let me describe the difference for a simpler scenario - lists. Let's focus on how one can consume lists:
By a catamorphism, which essentially means that we can express it using
foldr :: (a -> r -> r) -> r -> [a] -> r
As we can see, the folding functions never get hold of the list tail, only its processed value.
By pattern matching we can do somewhat more, in particular we can construct a generalized fold of type
foldrGen :: (a -> [a] -> r) -> r -> [a] -> r
It's easy to see that one can express foldr using foldrGen. However, as foldrGen isn't recursive, this expression involves recursion.
To generalize both concepts, we can introduce
foldrPara :: (a -> ([a], r) -> r) -> r -> [a] -> r
which gives the consuming function even more power: Both the reduced value of the tail, as well as the tail itself. Clearly this is more generic than both previous ones. This corresponds to a paramorphism which “eats its argument and keeps it too”.
But it's also possible to do it the other way round. Even though paramorphisms are more general, they can be expressed using catamorphisms (at some overhead cost) by re-creating the original structure on the way:
foldrPara :: (a -> ([a], r) -> r) -> r -> [a] -> r
foldrPara f z = snd . foldr f' ([], z)
where
f' x t#(xs, r) = (x : xs, f x t)
Now Church-encoded data structures encode the catamorphism pattern, for lists it's everything that can be constructed using foldr:
newtype List a = L (forall r . r -> (a -> r -> r) -> r)
nil :: List a
nil = L $ \n _ -> n
cons :: a -> List a -> List a
cons x (L xs) = L $ \n c -> c x (xs n c)
fromL :: List a -> [a]
fromL (L f) = f [] (:)
toL :: [a] -> List a
toL xs = L (\n c -> foldr c n xs)
In order to see the sub-lists, we have take the same approach: re-create them on the way:
foldrParaL :: (a -> (List a, r) -> r) -> r -> List a -> r
foldrParaL f z (L l) = snd $ l (nil, z) f'
where
f' x t#(xs, r) = (x `cons` xs, f x t)
This applies generally to Church-encoded data structures, like to the encoded free monad. They express catamorphisms, that is folding without seeing the parts of the structure, only with the recursive results. To get hold of sub-structures during the process, we need to recreate them on the way.
Your
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
looks like the Scott-encoded Free monad. The Church-encoded version is just
matchF
:: Functor f
=> (a -> r)
-> (f r -> r)
-> F f a
-> r
matchF kp kf f = runF f kp kf
Here are Church- and Scott-encoded lists for comparison:
newtype Church a = Church { runChurch :: forall r. (a -> r -> r) -> r -> r }
newtype Scott a = Scott { runScott :: forall r. (a -> Scott a -> r) -> r -> r }
It's a bit of a nasty one. This problem is a more general version of a puzzle everyone struggles with the first time they're exposed to it: defining the predecessor of a natural number encoded as a Church numeral (think: Nat ~ Free Id ()).
I've split my module into a lot of intermediate definitions to highlight the solution's structure. I've also uploaded a self-contained gist for ease of use.
I start with nothing exciting: redefining F given that I don't have this package installed at the moment.
{-# LANGUAGE Rank2Types #-}
module MatchFree where
newtype F f a = F { runF :: forall r. (a -> r) -> (f r -> r) -> r }
Now, even before considering pattern-matching, we can start by defining the counterpart of the usual datatype's constructors:
pureF :: a -> F f a
pureF a = F $ const . ($ a)
freeF :: Functor f => f (F f a) -> F f a
freeF f = F $ \ pr fr -> fr $ fmap (\ inner -> runF inner pr fr) f
Next, I'm introducing two types: Open and Close. Close is simply the F type but Open corresponds to having observed the content of an element of F f a: it's Either a pure a or an f (F f a).
type Open f a = Either a (f (F f a))
type Close f a = F f a
As hinted by my hand-wavy description, these two types are actually equivalent and we can indeed write functions converting back and forth between them:
close :: Functor f => Open f a -> Close f a
close = either pureF freeF
open :: Functor f => Close f a -> Open f a
open f = runF f Left (Right . fmap close)
Now, we can come back to your problem and the course of action should be pretty clear: open the F f a and then apply either kp or kf depending on what we got. And it indeed works:
matchF
:: Functor f
=> (a -> r)
-> (f (F f a) -> r)
-> F f a
-> r
matchF kp kf = either kp kf . open
Coming back to the original comment about natural numbers: predecessor implemented using Church numeral is linear in the size of the natural number when we could reasonably expect a simple case analysis to be constant time. Well, just like for natural numbers, this case analysis is pretty expensive because, as show by the use of runF in the definition of open, the whole structure is traversed.
I'm playing with some lambda calculus stuff in Haskell, specifically church numerals. I have the following defined:
let zero = (\f z -> z)
let one = (\f z -> f z)
let two = (\f z -> f (f z))
let iszero = (\n -> n (\x -> (\x y -> y)) (\x y -> x))
let mult = (\m n -> (\s z -> m (\x -> n s x) z))
This works:
:t (\n -> (iszero n) one (mult one one))
This fails with an occurs check:
:t (\n -> (iszero n) one (mult n one))
I have played with iszero and mult with my constants and they seem to be correct. Is there some way to make this typeable? I didn't think what I was doing was too crazy, but maybe I'm doing something wrong?
Your definitions are correct, as are their types, when seen at top-level. The problem is that, in the second example, you're using n in two different ways that don't have the same type--or rather, their types can't be unified, and attempting to do so would produce an infinite type. Similar uses of one work correctly because each use is independently specialized to different types.
To make this work in a straightforward way you need higher-rank polymorphism. The correct type for a church numeral is (forall a. (a -> a) -> a -> a), but higher-rank types can't be inferred, and require a GHC extension such as RankNTypes. If you enable an appropriate extension (you only need rank-2 in this case, I think) and give explicit types for your definitions, they should work without changing the actual implementation.
Note that there are (or at least were) some restrictions on the use of higher-rank polymorphic types. You can, however, wrap your church numerals in something like newtype ChurchNum = ChurchNum (forall a. (a -> a) -> a -> a), which would allow giving them a Num instance as well.
Let's add some type signatures:
type Nat a = (a -> a) -> a -> a
zero :: Nat a
zero = (\f z -> z)
one :: Nat a
one = (\f z -> f z)
two :: Nat a
two = (\f z -> f (f z))
iszero :: Nat (a -> a -> a) -> a -> a -> a
iszero = (\n -> n (\x -> (\x y -> y)) (\x y -> x))
mult :: Nat a -> Nat a -> Nat a
mult = (\m n -> (\s z -> m (\x -> n s x) z))
As you can see, everything seems pretty normal except for the type of iszero.
Let's see what happens with your expression:
*Main> :t (\n -> (iszero n) one n)
<interactive>:1:23:
Occurs check: cannot construct the infinite type:
a0
=
((a0 -> a0) -> a0 -> a0)
-> ((a0 -> a0) -> a0 -> a0) -> (a0 -> a0) -> a0 -> a0
Expected type: Nat a0
Actual type: Nat (Nat a0 -> Nat a0 -> Nat a0)
In the third argument of `iszero', namely `(mult n one)'
In the expression: (iszero n) one (mult n one)
See how the error uses our Nat alias!
We can actually get a similar error with the simpler expression \n -> (iszero n) one n. Here's what's wrong. Since we are calling iszero n, we must have n :: Nat (b -> b -> b). Also, because of iszeros type the second and third arguments, n and one, must have the type b. Now we have two equations for the type of n:
n :: Nat (b -> b -> b)
n :: b
Which can't be reconciled. Bummer.