Published on March 31, 2013; tags: Haskell
Six months ago Tom Ellis wrote the article Towards Free Applicatives, where he described his implementation of a free applicative functor. In the reddit discussion of that article a few more implementations were suggested.
In this article I would like to look in more detail how these implementations work and how they differ from each other.
The implementations are rewritten in a common style where possible, to highlight the differences and similarities. Since a picture is worth a thousand words, for each implementation there’s a diagram showing how a simple applicative expression
f <$> lift ax <*> lift ay <*> lift az is represented.
f— simple (non-functorial) values
az— values of the base functor type
tz— values of the free applicative functor type
F— base functor
Tz— inner types of functorial values (e.g.
F Tx). The function
Tx -> Ty -> Tz -> Tr.
()) as a type, term and pattern.
data Free f a where Pure :: a -> Free f a Ap :: Free f (a -> b) -> f a -> Free f b instance Functor f => Functor (Free f) where fmap f (Pure x) = Pure $ f x fmap f (Ap tx ay) = Ap ((f .) <$> tx) ay instance Functor f => Applicative (Free f) where pure = Pure tx <*> Pure y = fmap ($ y) tx tx <*> Ap ty az = Ap ((.) <$> tx <*> ty) az lift :: f a -> Free f a lift = Ap (Pure id) lower :: Applicative f => Free f a -> f a lower (Pure x) = pure x lower (Ap tx ay) = lower tx <*> ay
The tree grows to the left. This can be easily seen on the diagram, and follows from the fact that the first argument of
Ap is a free applicative itself and the second is not. (How the tree grows depends, obviously, on the order of
Ap’s arguments. The convention here is that
Ap’s arguments are in the applicative order, so that we can meaningfully talk about the tree’s associativity.)
<*> pattern-matches on its right argument, effectively re-associating the tree to the left.
Free f a is an applicative functor regardless of
f. It stores
f-values in the tree without changes. We’ll see later that this is not always the case.
data Free f a where Pure :: a -> Free f a Ap :: Free f (a -> b) -> f a -> Free f b instance Functor (Free f) where fmap f (Pure x) = Pure $ f x fmap f (Ap tx ay) = Ap ((f .) <$> tx) ay instance Applicative (Free f) where pure = Pure Pure f <*> tx = fmap f tx Ap tx ay <*> tz = Ap (flip <$> tx <*> tz) ay lift :: f a -> Free f a lift = Ap (Pure id) lower :: Applicative f => Free f a -> f a lower (Pure x) = pure x lower (Ap tx ay) = flip id <$> ay <*> lower tx
This is a variation of Ørjan’s implementation. As can be seen from the diagrams, the only difference is that it stores the values in the opposite order, and modifies the function to accept them in that order.
As in Ørjan’s implementation, the tree grows to the left, but
<*> now pattern-matches on its left argument, in order to push its right argument to the leftmost position in the tree.
<*> does pattern matching directly affects its algorithmic complexity. Ørjan’s implementation is linear in the size of its right argument and thus works better with left-associated applicative expressions. Twan’s version is dual: it is linear in the size of its left argument and works better with right-associated expressions. In both cases, unfortunate nesting increases complexity from linear to quadratic.
Also pay attention to the
lower function. It has to take care of the effects — the right subtree must be «executed» before the left subtree in order to restore the original value faithfully.
data Free f a where Pure :: a -> Free f a Ap :: f (a -> b) -> Free f a -> Free f b instance Functor f => Functor (Free f) where fmap f (Pure x) = Pure $ f x fmap f (Ap ax ty) = Ap (fmap (f.) ax) ty instance Functor f => Applicative (Free f) where pure = Pure Pure f <*> tx = fmap f tx Ap ax ty <*> tz = Ap (fmap uncurry ax) ((,) <$> ty <*> tz) lift :: Functor f => f a -> Free f a lift ax = Ap (const <$> ax) (Pure ()) lower :: Applicative f => Free f a -> f a lower (Pure x) = pure x lower (Ap ax ty) = ax <*> lower ty
The diagram looks more complicated here. The first thing to notice is that the tree here grows to the right, unlike in the previous versions. The actual application of our
f function happens now near the top of the tree rather than at the bottom. To make that possible, the function has to be converted to the uncurried form.
All left nodes except the topmost one are functions (wrapped in the base functor). All they do is take a nested tuple of the arguments downstream and add their own value to that tuple. The topmost left node already knows the final required argument,
ax, and simply applies the uncurried function to the tuple.
The functorial values are stored in a modified form, which requires
f to be an actual
Functor. (But note that any
f can be turned into a functor using Yoneda.)
The code here is quite different from the previous versions, so I decided to reproduce it verbatim (except the
lower functions, which I’ve added myself).
data ChainA f a b = Single (f (a -> b)) | forall c. Many (f (c -> b)) (ChainA f a c) instance Functor f => Functor (ChainA f a) where fmap f (Single t) = Single (fmap (f .) t) fmap f (Many g v) = Many (fmap (f .) g) v chain :: ChainA f b c -> ChainA f a b -> ChainA f a c chain (Single t) v = Many t v chain (Many t ts) v = Many t (chain ts v) data FreeA f a = Pure a | ChainA (ChainA f () a) instance Functor f => Functor (FreeA f) where fmap f (Pure a) = Pure (f a) fmap f (ChainA a) = ChainA (fmap f a) instance Functor f => Applicative (FreeA f) where pure = Pure Pure f <*> g = fmap f g f <*> Pure g = fmap ($ g) f ChainA f <*> ChainA g = ChainA $ chain (pullUnit f) g pullUnit :: Functor f => ChainA f () (b -> c) -> ChainA f b c pullUnit = removeUnit . pull pass :: Functor f => ChainA f a b -> ChainA f (a,c) (b,c) pass (Single t) = Single (fmap (\f -> \(a,c) -> (f a, c)) t) pass (Many t ts) = Many (fmap (\f -> \(a,c) -> (f a, c)) t) (pass ts) pull :: Functor f => ChainA f a (b -> c) -> ChainA f (a,b) c pull (Single t) = Single (fmap uncurry t) pull (Many t ts) = Many (fmap uncurry t) (pass ts) removeUnit :: Functor f => ChainA f ((), a) b -> ChainA f a b removeUnit (Single t) = Single (fmap (\f -> \a -> f ((),a)) t) removeUnit (Many t ts) = Many t (removeUnit ts) lift :: Functor f => f a -> FreeA f a lift ax = ChainA $ Single $ const <$> ax lower :: Applicative f => FreeA f a -> f a lower (Pure x) = pure x lower (ChainA chain) = lowerChain chain <*> pure () where lowerChain :: Applicative f => ChainA f x y -> f (x -> y) lowerChain (Single ax) = ax lowerChain (Many ax ty) = (.) <$> ax <*> lowerChain ty
Despite the superficial dissimilarity of the code, this is really a variation on Paolo’s implementation. The only difference is that unit is not passed as a part of the nested tuples. Two-level types and auxiliary functions are really just the cost of eliminating that unit.
The free package currently uses the Twan’s version, which is the reason of the reverse effect that I mentioned in the previous article. Edward Kmett points out that the reason for choosing Twan’s implementation is that you can see the «next instruction» in O(1) when walking left to right, which is most common.
So start with that one, but also look at your problem (how exactly you are going to analyze the free applicative) and see if any of the alternatives fit better.