{-# LANGUAGE RankNTypes #-} -- Polyvariadic fix-point combinator for mutual recursion module PolyY where -- For the case of mutually recursive clauses of the same type fix_poly:: [[a]->a] -> [a] fix_poly fl = fix (\self -> map (\$ self) fl) where fix f = f (fix f) -- The familiar even/odd example test1 = (map iseven [0..5], map isodd [0..5]) where [iseven, isodd] = fix_poly [fe,fo] fe [e,o] n = n == 0 || o (n-1) fo [e,o] n = n /= 0 && e (n-1) -- Generalizing to the case when mutually recursive clauses -- do not have the same type class Functor2 c where fmap2 :: (forall a. c1 a -> c2 a) -> c c1 -> c c2 newtype Id a = Id{unId :: a} newtype P2 a b c = P2 (c a, c b) instance Functor2 (P2 a b) where fmap2 f (P2 (x,y)) = (P2 (f x, f y)) newtype P3 a1 a2 a3 c = P3 (c a1, c a1, c a3) instance Functor2 (P3 a1 a2 a3) where fmap2 f (P3 (x,y,z)) = (P3 (f x, f y, f z)) -- The general case of polyvaridic fixpoint combinator fix_gen_poly:: Functor2 c => c ((->) (c Id)) -> c Id fix_gen_poly fl = fix (\self -> fmap2 (\x -> Id (x self)) fl) where fix f = f (fix f) -- A variation on even/odd, with the decrement as the third clause test2 = (map iseven [0..5], map isodd [0..5]) where P3 (Id iseven, Id isodd, Id sub) = fix_gen_poly (P3 (fe,fo,fs)) fe (P3 (Id e, Id o, Id sub)) n = n == 0 || o (sub n 1) fo (P3 (Id e, Id o, Id sub)) n = n /= 0 && e (sub n 1) fs (P3 (Id e, Id o, Id sub)) n m = n - m