[Haskell] How to zip folds: A library of fold transformers

[oleg at pobox.com]

We show how to merge two folds into another fold
`elementwise'. Furthermore, we present a library of (potentially
infinite) ``lists'' represented as folds (aka streams, aka
success-failure-continuation--based generators). Whereas the standard
Prelude functions such as |map| and |take| transform lists, we
transform folds. We implement the range of progressively more complex
transformers -- from |map|, |filter|, |takeWhile| to |take|, to |drop|
and |dropWhile|, and finally, |zip| and |zipWith|.

Emphatically we never convert a stream to a list and so we never use
value recursion. All iterative processing is driven by the fold
itself.

The implementation of zip also solves the problem of ``parallel
loops''.  One can think of a fold as an accumulating loop. One can
easily represent a nested loop as a nested fold. Representing parallel
loop as a fold is a challenge, answered at the end of the message.  We
need recursive types -- but again, never value recursion.

This library is inspired by Greg Buchholz' message on the Haskell-Cafe list
and is meant to answer open questions posed at the end of that message
 http://www.haskell.org/pipermail/haskell-cafe/2005-October/011575.html

This message a complete literate Haskell code.

> {-# OPTIONS -fglasgow-exts #-}
> module Folds where

First we define the representation of a list as a fold:

> newtype FR a = FR (forall ans. (a -> ans -> ans) -> ans -> ans)
> unFR (FR x) = x

It has a rank-2 type. The defining equations are: if flst is a value
of a type |FR a|, then
	unFR flst f z = z if flst represents an empty list
	unFR flst f z = f e (unFR flst' f z)
			if flst represents the list with the head 'e'
			and flst' represents the rest of that list

>From another point of view, |unFR flst| can be considered a _stream_
that takes two arguments: the success continuation of the type 
|a -> ans -> ans| and the failure continuation of the type |ans|. The LogicT
paper discusses such types in detail, and shows how to find that "rest
of the list" flst'. The slides of the ICFP05 presentation by
Chung-chieh Shan point out to more related work in that area.

But we are here to drop, take, dropWhile, etc. Our functions will
take a stream and return another stream, of the |FR a| type, which
represents truncated, filtered, etc. source stream.

Let us define two sample streams: a finite and an infinite one:

> stream1 :: FR Char
> stream1 = FR (\f unit -> foldr f unit ['a'..'i'])
> stream2 :: FR Int
> stream2 = FR (\f unit -> foldr f unit [1..])

and the way to show the stream. This is the only time we convert |FR a|
to a list -- so we can more easily show it.

> instance Show a => Show (FR a) where
>   show l = show $ unFR l (:) []


The map function is trivial:

> smap :: (a->b) -> FR a -> FR b

*> smap f l = FR(\g -> unFR l (g . f))

which can also be written as

> smap f l = FR((unFR l) . (flip (.) f))

For example,

> test1 = show $ smap succ stream1


Next is the filter function:

> sfilter :: (a -> Bool) -> FR a -> FR a
> sfilter p l = FR(\f -> unFR l (\e r -> if p e then f e r else r))

> test2 = sfilter (not . (`elem` "ch")) stream1

The function takeWhile is quite straightforward, too

> stakeWhile :: (a -> Bool) -> FR a -> FR a
> stakeWhile p l = FR(\f z -> unFR l (\e r -> if p e then f e r else z) z)

> test3  = stakeWhile (< 'z') stream1
> test3' = stakeWhile (< 10) stream2

As we can see, stakeWhile well applies to an infinite stream.

The functions take, drop, dropWhile ask for more complexity.

> stake :: (Ord n, Num n) => n -> FR a -> FR a
> stake n l = FR(\f z -> 
>	 unFR l (\e r n -> if n <= 0 then z else f e (r (n-1))) (const z) n)

> test4    = stake 20 stream1
> test4'   = stake 5 stream1
> test4''  = stake 11 stream2
> test4''' = (stake 11 . smap (^2)) stream2

The function sdrop shows the major deficiency: we're stuck with the
(<=0) test for the rest of the stream. In this case, some delimited
continuation operators like `control' can help, in limited
circumstances.

> sdrop :: (Ord n, Num n) => n -> FR a -> FR a
> sdrop n l = FR(\f z -> 
>	 unFR l (\e r n -> if n <= 0 then f e (r n) else r (n-1)) (const z) n)

> test5    = sdrop 20 stream1
> test5'   = sdrop 5 stream1
> test5''  = stake 5 $ sdrop 11 stream2

The function dropWhile becomes straightforward

> sdropWhile :: (a -> Bool) -> FR a -> FR a
> sdropWhile p l = FR(\f z -> 
>	 unFR l (\e r done -> 
>	   if done then f e (r done) 
>	      else if p e then r done else f e (r True)) (const z) False)

> test6   = sdropWhile (< 'z') stream1
> test6'  = sdropWhile (< 'd') stream1
> test6'' = stake 5 $ sdropWhile (< 10) stream2

The zip function is the most complex.

Here we need a recursive type: an iso-recursive type to emulate the
equi-recursive one.

> newtype RecFR a ans = RecFR (a -> (RecFR a ans -> ans) -> ans)
> unRecFR (RecFR x) = x

This is still a newtype: there is no extra consing.

I will not pretend that the following is the most perspicuous piece of code:

*> szip :: FR a1 -> FR a2 -> FR (a1,a2)
*> szip l1 l2 = FR(\f z -> 
*>     let l1' = unFR l1 (\e r x -> unRecFR x e r) (\r -> z)
*>	   l2' = unFR l2 (\e2 r2 e1 r1 -> f (e1,e2) (r1 (RecFR r2))) (\e r-> z)
*>      in l1' (RecFR l2'))

It can be simplified to the following:

> szipWith :: (a->b->c) -> FR a -> FR b -> FR c
> szipWith t l1 l2 = FR(\f z -> 
>      unFR l1 (\e r x -> unRecFR x e r) (\x -> z)
>         (RecFR $
>           unFR l2 (\e2 r2 e1 r1 -> f (t e1 e2) (r1 (RecFR r2))) (\e r -> z)))
>
> szip :: FR a -> FR b -> FR (a,b)
> szip = szipWith (,)


One can easily prove that this function does correspond to zip for all
finite streams. The proof for infinite streams requires more
elaboration. 

> test81 = szip stream1 stream1
> test82 = szip stream1 stream2
> test83 = szip stream2 stream1
> test84 = stake 5 $ szip stream2 (sdrop 10 stream2)

As one may expect (or not), these tests give the right results

*Folds> test83
[(1,'a'),(2,'b'),(3,'c'),(4,'d'),(5,'e'),(6,'f'),(7,'g'),(8,'h'),(9,'i')]
*Folds> test84
[(1,11),(2,12),(3,13),(4,14),(5,15)]