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

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

`return x`

represents a non-deterministic computation with a single result`x`

,`>>=`

is pronounced*bind*and applies a non-deterministic function to every result of a non-deterministic computation, flattening the final results,`mzero`

represents a non-deterministic computation without results, and`mplus`

merges the results of two non-deterministic computations.

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 []`

where

return x = [x]

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

instance MonadPlus []

where

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]
[1,2,3,4,5,6,7]
```

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)
10000
(1.87 secs, 1404242756 bytes)
*Main> length [1..10000]
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!

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)
[8,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 stuck^{1}.

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

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

^{2}.

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

where

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.

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)
[42]
```

More generally, we can use a type class `Result`

^{3} 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`

where

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`

where

result = singleton

Now we may rephrase the call above using `runCpsMonad`

.

```
*Main> toList (runCpsMonad fourty2)
[42]
```

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 class^{4}. 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`

where

failure :: t a

choice :: t a -> t a -> t a

instance Nondet FunList

where

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

where

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))
[1,2,3,4,5,6,7]
*Main> length (toList (runCpsMonad (upto 10000)))
10000
(0.06 secs, 5176912 bytes)
*Main> length (toList (runCpsMonad (upto 100000)))
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`

where

return x = DFS (\c -> c x)

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

instance MonadPlus DFS

where

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`

where

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`

where

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)))
[0,-1,-2,-3,-4,-5,-6,-7,-8,-9]
```

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

where

return x = BFS (\c -> c x)

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

instance MonadPlus BFS

where

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 diagonalization^{5} that is necessary in other approaches I am aware of. Has this version of breadth-first search been documented before?

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.

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`

where

return = singleton

l >>= f = FunList ([ y | x <- toList l, y <- toList (f x) ]++)The type constructor

`CpsMonad`

is similar to the continuation monad transformer and identical to the codensity monad transformer. ↩The type class

`Result`

is called`Pointed`

in the category-extras package. ↩The type class

`Nondet`

is not only similar to`MonadPlus`

but also to`Control.Applicative.Alternative`

. However, it does not require an`Applicative`

instance. ↩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))) [(0,0),(-1,0),(0,-1),(-2,0),(-1,-1),(0,-2),(-3,0),(-2,-1),(-1,-2),(0,-3)]`