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.
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:
z
that does not appear in the body of the expression.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
. forall z. Handler1 -> Handler2 -> ... -> HandlerN -> z
.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.
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 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