Flavours of free applicative functors

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.

Notational conventions

• 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

On the diagrams

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

Ørjan Johansen’s free applicative

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.

Twan van Laarhoven’s free applicative

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.

Paolo Capriotti’s free applicative

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

Tom Ellis’s free applicative

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.

Which one to use?

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.