Polyvariadic Y in pure Haskell98

[oleg at pobox.com]

Paul Hudak wrote:

> Suppose you have a LET expression with a set of (possibly mutually 
> recursive) equations such as:
>
> let f1 = e1
>      f2 = e2
>      ...
>      fn = en
> in e
>
> The following is then equivalent to the above, assuming that g is not 
> free in e or any of the ei:
>
> let (f1,...,fn) = fix g
>      g ~(f1,...,fn) = (e1,...,en)
> in e


I'm afraid that is not entirely satisfactory: the above expression
uses ... . This implies that we need a meta-language operation --
ellipsis -- to express the mutually recursive fixpoint of several
expressions. In the following, we write the polyvariadic fixpoint
combinator in pure Haskell98, without any ellipsis construct.

The combinator is a translation from Scheme of a polyvariadic fixpoint
combinator. The latter is derived in a systematic simplification
way. It is different from a polyvariadic Y of Christian Queinnec and
of Mayer Goldberg.

Here's the polyvaridic Y implemented entirely in Scheme:
-- (define (Y* . fl)
--  (map (lambda (f) (f))
--   ((lambda (x) (x x))
--     (lambda (p)
--       (map 
--         (lambda (f)
--           (lambda ()
--            (apply f
--             (map 
--               (lambda (ff)
--                 (lambda y (apply (ff) y)))
--               (p p) ))))
--         fl)))))

Its translation to Haskell couldn't be any simpler due to the
non-strict nature of Haskell.

> fix':: [[a->b]->a->b] -> [a->b]
> fix' fl = self_apply (\pp -> map ($pp) fl)
>
> self_apply f = f g where g = f g

That's it.

Examples. The common odd-even example:

> test1 = (map iseven [0,1,2,3,4,5], map isodd [0,1,2,3,4,5])
>   where
>        [iseven, isodd] = fix' [fe,fo]
>        fe [e,o] x = x == 0 || o (x-1)
>        fo [e,o] x = x /= 0 && e (x-1)

A more involved example of three mutually-recursive functions:

test2 = map (\f -> map f [0,1,2,3,4,5,6,7,8,9,10,11]) fs
  where
       fs= fix' [\[triple,triple1,triple2] x-> x==0 || triple2 (x-1),
                 \[triple,triple1,triple2] x-> (x/=0)&&((x==1)|| triple (x-1)),
		 \[triple,triple1,triple2] x-> (x==2)||((x>2)&& triple1 (x-1))]