Haskell self-referential List termination

Viewed 208

EDIT: see this followup question that simplifies the problem I am trying to identify here, and asks for input on a GHC modification proposal.

So I was trying to write a generic breadth-first search function and came up with the following:

bfs :: (a -> Bool) -> (a -> [a]) -> [a] -> Maybe a
bfs predf expandf xs = find predf bfsList
    where bfsList = xs ++ concatMap expandf bfsList

which I thought was pretty elegant, however in the does-not-exist case it blocks forever.

After all the terms have been expanded to [], concatMap will never return another item, so concatMap is blocking waiting for another item from itself? Could Haskell be made smart enough to realize the list generation is blocked reading the self-reference and terminate the list?

The best replacement I've been able to come up with isn't quite as elegant, since I have to handle the termination case myself:

    where bfsList = concat.takeWhile (not.null) $ iterate (concatMap expandf) xs

For concrete examples, the first search terminates with success, and the second one blocks:

bfs (==3) (\x -> if x<1 then [] else [x/2, x/5]) [5, 3*2**8]
bfs (==3) (\x -> if x<1 then [] else [x/2, x/5]) [5, 2**8]
3 Answers

We produce the results list (queue) in steps. On each step we consume what we have produced on the previous step. When the last expansion step added nothing, we stop:

bfs :: (a -> Bool) -> (a -> [a]) -> [a] -> Maybe a
bfs predf expandf xs = find predf queue
    where 
    queue = xs ++ gen (length xs) queue                 -- start the queue with `xs`, and
    gen 0 _ = []                                        -- when nothing in queue, stop;
    gen n q = let next = concatMap expandf (take n q)   -- take n elemts from queue,
              in  next ++                               -- process, enqueue the results,
                         gen (length next) (drop n q)   -- advance by `n` and continue

Thus we get

~> bfs (==3) (\x -> if x<1 then [] else [x/2, x/5]) [5, 3*2**8]
Just 3.0

~> bfs (==3) (\x -> if x<1 then [] else [x/2, x/5]) [5, 2**8]
Nothing

One potentially serious flow in this solution is that if any expandf step produces an infinite list of results, it will get stuck calculating its length, totally needlessly so.


In general, just introduce a counter and increment it by the length of solutions produced at each expansion step (length . concatMap expandf or something), decrementing by the amount that was consumed. When it reaches 0, do not attempt to consume anything anymore because there's nothing to consume at that point, and you should instead terminate.

This counter serves in effect as a pointer back into the queue being constructed. A value of n indicates that the place where the next result will be placed is n notches ahead of the place in the list from which the input is taken. 1 thus means that the next result is placed directly after the input value.

The following code can be found in Wikipedia's article about corecursion (search for "corecursive queue"):

data Tree a b = Leaf a  |  Branch b (Tree a b) (Tree a b)

bftrav :: Tree a b -> [Tree a b]
bftrav tree = queue
  where
    queue = tree : gen 1 queue                -- have one value in queue from the start

    gen  0   _                 =         []           
    gen len (Leaf   _     : s) =         gen (len-1) s   -- consumed one, produced none
    gen len (Branch _ l r : s) = l : r : gen (len+1) s   -- consumed one, produced two

This technique is natural in Prolog with top-down list instantiation and logical variables which can be explicitly in a not-yet-set state. See also .


gen in bfs can be re-written to be more incremental, which is usually a good thing to have:

    gen 0  _     = []
    gen n (y:ys) = let next = expandf y
                   in  next ++ gen (n - 1 + length next) ys

Edited to add a note to explain my bfs' solution below.

The way your question is phrased ("could Haskell be made smart enough"), it sounds like you think the correct value for a computation like:

bfs (\x -> False) (\x -> []) []

given your original definition of bfs should be Nothing, and Haskell is just failing to find the correct answer.

However, the correct value for the above computation is bottom. Substituting the definition of bfs (and simplifying the [] ++ expression), the above computation is equal to:

find (\x -> False) bfsList
   where bfsList = concatMap (\x -> []) bfsList

Evaluating find requires determining if bfsList is empty or not, so it must be forced to weak head normal form. This forcing requires evaluating the concatMap expression, which also must determine if bfsList is empty or not, forcing it to WHNF. This forcing loop implies bfsList is bottom, and therefore so is find.

Haskell could be smarter in detecting the loop and giving an error, but it would be incorrect to return [].

Ultimately, this is the same thing that happens with:

foo = case foo of [] -> []

which also loops infinitely. Haskell's semantics imply that this case construct must force foo, and forcing foo requires forcing foo, so the result is bottom. It's true that if we considered this definition an equation, then substituting foo = [] would "satisfy" it, but that's not how Haskell semantics work, for the same reason that:

bar = bar

does not have value 1 or "awesome", even though these values satisfy it as an "equation".

So, the answer to your question is, no, this behavior couldn't be changed so as to return an empty list without fundamentally changing Haskell semantics.

Also, as an alternative that looks pretty slick -- even with its explicit termination condition -- maybe consider:

bfs' :: (a -> Bool) -> (a -> [a]) -> [a] -> Maybe a
bfs' predf expandf = look
  where look [] = Nothing
        look xs = find predf xs <|> look (concatMap expandf xs)

This uses the Alternative instance for Maybe, which is really very straightforward:

Just x  <|> ...     -- yields `Just x`
Nothing <|> Just y  -- yields `Just y`
Nothing <|> Nothing -- yields `Nothing` (doesn't happen above)

so look checks the current set of values xs with find, and if it fails and returns Nothing, it recursively looks in their expansions.

As a silly example that makes the termination condition look less explicit, here's its double-monad (Maybe in implicit Reader) version using listToMaybe as the terminator! (Not recommended in real code.)

bfs'' :: (a -> Bool) -> (a -> [a]) -> [a] -> Maybe a
bfs'' predf expandf = look
  where look = listToMaybe *>* find predf *|* (look . concatMap expandf)

        (*>*) = liftM2 (>>)
        (*|*) = liftM2 (<|>)
        infixl 1 *>*
        infixl 3 *|*

How does this work? Well, it's a joke. As a hint, the definition of look is the same as:

  where look xs = listToMaybe xs >> 
                  (find predf xs <|> look (concatMap expandf xs))

bfsList is defined recursively, which is not in itself a problem in Haskell. It does, however, produce an infinite list, which, again, isn't in itself a problem, because Haskell is lazily evaluated.

As long as find eventually finds what it's looking for, it's not an issue that there's still an infinity of elements, because at that point evaluation stops (or, rather, moves on to do other things).

AFAICT, the problem in the second case is that the predicate is never matched, so bfsList just keeps producing new elements, and find keeps on looking.

After all the terms have been expanded to [] concatMap will never return another item

Are you sure that's the correct diagnosis? As far as I can tell, with the lambda expressions supplied above, each input element always expand to two new elements - never to []. The list is, however, infinite, so if the predicate goes unmatched, the function will evaluate forever.

Could Haskell be made smart enough to realize the list generation is blocked reading the self-reference and terminate the list?

It'd be nice if there was a general-purpose algorithm to determine whether or not a computation would eventually complete. Alas, as both Turing and Church (independently of each other) proved in 1936, such an algorithm can't exist. This is also known as the Halting problem. I'm not a mathematician, though, so I may be wrong, but I think it applies here as well...

The best replacement I've been able to come up with isn't quite as elegant

Not sure about that one... If I try to use it instead of the other definition of bfsList, it doesn't compile... Still, I don't think the problem is the empty list.

Related