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.

`x`

,`y`

,`z`

,`f`

— simple (non-functorial) values`ax`

,`ay`

,`az`

— values of the base functor type`tx`

,`ty`

,`tz`

— values of the free applicative functor type

`F`

— base functor`Tx`

,`Ty`

,`Tz`

— inner types of functorial values (e.g.`ax`

has type`F Tx`

). The function`f`

has type`Tx -> Ty -> Tz -> Tr`

.- A square denotes unit (i.e.
`()`

) 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.

Note that `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.

The way `<*>`

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 `lift`

and `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.