Barefaced pilferage of monadic bind

Inspired by the insight that we do not need to implement monadic bind in order to get a monad for non-determinism I was wondering whether there are types I would like to make an instance of Monad but had a hard time to do. In fact there are! This post explains how to implement depth- and breadth-first search based on functional lists - a type for which monadic bind cannot be defined easily. The technique of bind stealing is not restricted to non-determinism but can be applied to other effects as well.

This post is generated from a literate Haskell file in case you want to play with it.

{-# LANGUAGE Rank2Types #-}

import Control.Monad

Monads for non-determinism

A monad for non-determinism is an instance of the type class MonadPlus, i.e., a type constructor m that supports the following operations.

return :: a -> m a
(>>=) :: m a -> (a -> m b) -> m b
mzero :: m a
mplus :: m a -> m a -> m a

Lists are probably the simplest means to represent non-deterministic computations in Haskell. And indeed, the type constructor [] is an instance of MonadPlus.

instance Monad []
return x = [x]
xs >>= f = [ y | x <- xs, y <- f x ]

instance MonadPlus []
mzero = []
mplus = (++)

Here, >>= is implemented using a list comprehension and mplus is a renaming for the append function defined as follows.

(++) :: [a] -> [a] -> [a]
[] ++ ys = ys
(x:xs) ++ ys = x : (xs++ys)

The function ++ traverses the first argument and, thus, runs in linear time w.r.t. the length of this argument.

Now that we know how to define [] as a monad for non-determinism, let's use it. Here is a non-deterministic operation that yields every positive number up to the given upper limit.

upto :: MonadPlus m => Int -> m Int
upto 1 = return 1
upto n = upto (n-1) `mplus` return n

If we ask for the result of upto 7, e.g., in GHCi, we get the list [1..7].

*Main> upto 7 :: [Int]

We have to explicitly assign a type signature in order to tell GHCi that we want to use the list monad.

Well, it seems to work fine! But wait. If we try with greater numbers, this function has unfortunate run time.

*Main> :set +s
*Main> length (upto 10000)
(1.87 secs, 1404242756 bytes)
*Main> length [1..10000]
(0.01 secs, 2118816 bytes)

What's going on here? Remember that the run-time of ++ is linear in the length of the first argument! Unfortunately, the function upto calls itself recursively as first argument of mplus, i.e., ++, which results in quadratic run time.

Of course, we could redefine upto and avoid left recursion w.r.t. mplus. But let's refrain from doing so and better define a different monad that doesn't care!

Functional lists

The standard solution to avoid this performance penalty is a so called functional list.

newtype FunList a = FunList { appendList :: [a] -> [a] }

A functional list is a function that takes a list and yields another list. The idea is that a functional lists appends the list given as argument to itself to yield the resulting list. Here, appendList is defined as a record selector for the record type FunList.

appendList :: FunList a -> [a] -> [a]

Let's define operations to construct functional lists. The empty functional list has no own elements, hence, the list given as argument is returned unchanged to append it.

empty :: FunList a
empty = FunList id

A singleton list can be constructed by appending a single element to the front of the given list.

singleton :: a -> FunList a
singleton x = FunList (x:)

Finally, we can append two functional lists using function composition.

append :: FunList a -> FunList a -> FunList a
append a b = FunList (appendList a . appendList b)

The append function runs in constant time and we can transform a functional list into an ordinary list in linear time.

toList :: FunList a -> [a]
toList l = appendList l []

We can construct a simple functional list and convert it into an arbitrary list easily:

*Main> toList (singleton 08 `append` singleton 15)

Good news is that append runs in constant time so we can hope for running the non-deterministic function upto in linear time using functional lists. Let's make FunList a monad!

You may have noticed already that singleton, empty, and append correspond exactly to return, mzero, and mplus respectively. So all we need to do is define >>= for the FunList type:

(>>=) :: FunList a -> (a -> FunList b) -> FunList b

Let's try. We somehow need to map the given function over the elements of the list and concatenate the results.

l >>= f = FunList (??? . map f . appendList l)

But, regardless what we write instead of ???, this definition does not typecheck because the resulting functional list takes an argument of type [b] but appendList l expects an argument of type [a]. Seems like we're stuck1.

If only we could implement a monad for non-determinism without having to implement bind! Well, we can. Here's how.


Before we'll see how to implement a non-determinism monad based on functional lists, we need a little background in continuation-passing style.

A function in continuation-passing style (CPS) does not return its result but passes it on to a function given as additional argument. We can capture this idea in the following type.

newtype CPS a = CPS { (->>) :: forall b . (a -> b) -> b }

This time we use an infix record selector ->> which has a higher-rank type, i.e., it is polymorphic in the result type b.

(->>) :: CPS a -> (a -> b) -> b

We can use ->> to pass a continuation of type a -> b to a computation in CPS and get the result of applying the continuation to the result of the computation.

Here is an example. We can define addition on integers in CPS as follows:

add :: Int -> Int -> CPS Int
add m n = CPS (\c -> c (m+n))

Now, we can use ->> to process the result, e.g., to print it.

*Main> add 08 15 ->> print

That looks like a funny way to write print (8+15) but what is it good for?

Let's be a bit more restrictive and assume that continuations return their results as computations expressed using a specific type constructor t2.

newtype CpsMonad t a = CpsMonad { (>>-) :: forall b . (a -> t b) -> t b }

Now the type of the record selector looks almost like monadic bind!

(>>-) :: CpsMonad t a -> (a -> t b) -> t b

Only the occurrences of t b would need to be replaced with CpsMonad t b. We can indeed make CpsMonad t an instance of Monad for any type onstructor t (that's why it is called CpsMonad).

instance Monad (CpsMonad t)
return x = CpsMonad (\c -> c x)
a >>= f = CpsMonad (\c -> a >>- \x -> f x >>- c)

We could also make CPS a monad. The reason why we introduce the additional type constructor t is that we want to inherit it's functionality, viz., non-determinism.

Constructing a search monad from modular parts

Now we can apply the type constructor CpsMonad to the type constructor FunList and obtain a monad based on functional lists!

fourty2 :: CpsMonad FunList Int
fourty2 = return 42

We got implementations for return and >>= on functional lists for free. Well they are not quite on functional lists, i.e., for FunList. The implementations we get for free are for CpsMonad FunList.

We have to pass a continuation of type Int -> FunList Int to the computation fourty2 in order to observe its results. The function singleton on functional list fills this gap.

*Main> toList (fourty2 >>- singleton)

More generally, we can use a type class Result3 to specify a requirement on types t that allow to convert a value of type CpsMonad t a into one of type t a.

class Result t
result :: a -> t a

We can use this type class to define a generic converter to get rid of the CpsMonad type constructor.

runCpsMonad :: Result t => CpsMonad t a -> t a
runCpsMonad a = a >>- result

For functional lists the result function is just singleton.

instance Result FunList
result = singleton

Now we may rephrase the call above using runCpsMonad.

*Main> toList (runCpsMonad fourty2)

Computing singleton lists is boring. Our original goal was to define a non-determinism monad based on functional lists. Non-determinism is captured by the type class MonadPlus but as this is a subclass of Monad and we don't have a Monad instance for FunList we make our own type class4. The whole point of this exercise is to get a Monad instance for free so it doesn't make sense to require one beforehand.

class Nondet t
failure :: t a
choice :: t a -> t a -> t a

instance Nondet FunList
failure = empty
choice = append

Now a CpsMonad can inherit non-determinism from the base type: we can define an instance of MonadPlus for CpsMonad t if t is an instance of Nondet.

instance Nondet t => MonadPlus (CpsMonad t)
mzero = CpsMonad (\_ -> failure)
mplus a b = CpsMonad (\c -> choice (a >>- c) (b >>- c))

We have now put together all the pieces we need for a non-determinism monad based on functional lists. We can compute the results of the function upto (that computes all positive numbers up to a given limit) in linear time.

*Main> toList (runCpsMonad (upto 7))
*Main> length (toList (runCpsMonad (upto 10000)))
(0.06 secs, 5176912 bytes)
*Main> length (toList (runCpsMonad (upto 100000)))
(0.66 secs, 43019912 bytes)

So let's step back for a moment. What have we implemented here? If we inline the newtypes then the type CpsMonad FunList is identical to the following type.

newtype DFS a = DFS { unDFS :: forall b . (a -> [b] -> [b]) -> [b] -> [b] }

You may recognize this as the type for two-continuation-based search. The continuation of type a -> [b] -> [b] is usually called success continuation and the subsequent [b] is called failure continuation. We can also inline the monad instances and the run function.

instance Monad DFS
return x = DFS (\c -> c x)
a >>= f = DFS (\c -> unDFS a (\x -> unDFS (f x) c))

instance MonadPlus DFS
mzero = DFS (\_ -> id)
mplus a b = DFS (\c -> unDFS a c . unDFS b c)

runDFS :: DFS a -> [a]
runDFS a = unDFS a (:) []

We have factored continuation-based depth-first search into modular parts! Let's reuse the CpsMonad part to define continuation-based breadth-first search.

With breadth-first search, the results of a non-deterministic computation are enumerated in level order of the corresponding tree representation of the search space. Choices are the inner nodes of this tree, failures and results are the leafs.

We represent the result of breadth-first search as a list of levels where levels are represented as functional lists to allow efficient concatenation.

newtype Levels a = Levels { levels :: [FunList a] }

Breadth-first search simply concatenates those levels.

bfs :: Levels a -> [a]
bfs = toList . foldr append empty . levels

We can apply CpsMonad to Levels in order to get a monad that computes levels. We only need to define an instance for Result to convert monadic computations to levels and an instance for Nondet such that the resulting monad is an instance of MonadPlus.

The function result constructs a single level with a single entry.

instance Result Levels
result x = Levels [singleton x]

Failure is represented as an empty list of levels and a choice creates a new empty level in front of the concatenated levels of the arguments.

instance Nondet Levels
failure = Levels []
choice a b = Levels (empty : merge (levels a) (levels b))

The function merge is like zipWith append but does not drop excessive elements of a longer argument.

merge :: [FunList a] -> [FunList a] -> [FunList a]
merge [] ys = ys
merge xs [] = xs
merge (x:xs) (y:ys) = append x y : merge xs ys

That's all. Now we can use breadth-first search to enumerate non-positive numbers.

*Main> take 10 (bfs (runCpsMonad (upto 0)))

Despite our original intention, the function upto can also be used to compute infinitely many results when given an argument less or equal to zero. Depth-first search fails on these examples but breadth-first search enumerates them just fine.

If we are curios, we could inline the newtypes again. However, the previous implementation is of course more appealing because of its modularity.

newtype BFS a = BFS { 
unBFS :: forall b . (a -> [[b] -> [b]]) -> [[b] -> [b]]

instance Monad BFS
return x = BFS (\c -> c x)
a >>= f = BFS (\c -> unBFS a (\x -> unBFS (f x) c))

instance MonadPlus BFS
mzero = BFS (\_ -> [])
mplus a b = BFS (\c -> id : merge' (unBFS a c) (unBFS b c))

merge' :: [[a] -> [a]] -> [[a] -> [a]] -> [[a] -> [a]]
merge' [] ys = ys
merge' xs [] = xs
merge' (x:xs) (y:ys) = (x.y) : merge' xs ys

runBFS :: BFS a -> [a]
runBFS a = foldr (.) id (unBFS a ((:[]).(:))) []

Pretty neat! This implementation avoids the diagonalization5 that is necessary in other approaches I am aware of. Has this version of breadth-first search been documented before?

Final notes

That was a rather lengthy post so let's summarize. Functional lists do not allow a natural implementation of monadic bind. Fortunately, continuation-passing style provides monadic bind for free. Thus, monads for non-determinism can be constructed modularly from types that support the remaining monadic operations: a continuation monad can be built on top of them.

I have applied this approach twice. First, I have reinvented two-continuation-based depth-first search by plugging it together from modular parts. I have then replaced the part that represents non-determinism and discovered an implementation of breadth-first search that I have not been aware of.

The trick to steal monadic bind is not restricted to non-determinism. Any other set of effects that can be lifted over the continuation monad transformer can be extended to a monad. Simply replace the type class Nondet with a different class that specifies a different set of effects.

Attentive readers may have noticed that the examples in this post are so simple, they never use bind. Probably, I was too excited about stealing bind. I forgot to use it.


For feedback, please contact or comment on reddit.

  1. We can declare an instance of Monad for the type constructr FunList directly by converting functional lists to ordinary lists and back again:

    instance Monad FunList
    return = singleton
    l >>= f = FunList ([ y | x <- toList l, y <- toList (f x) ]++)
  2. The type constructor CpsMonad is similar to the continuation monad transformer and identical to the codensity monad transformer.

  3. The type class Result is called Pointed in the category-extras package.

  4. The type class Nondet is not only similar to MonadPlus but also to Control.Applicative.Alternative. However, it does not require an Applicative instance.

  5. The presented version of breadth-first search does not use an explicit diagonalization function in the implementation of monadic bind. Nevertheless, the stolen bind performs diagonalization as the following example demonstrates:

    *Main> take 10 (runBFS (do x <- upto 0; y <- upto 0; return (x,y)))