good fusion
Malcolm Wallace
Malcolm.Wallace at cs.york.ac.uk
Tue Apr 11 09:41:17 EDT 2006
Bulat Ziganshin:
> > may be, some lightweight form of coroutines can be used in such
> > situations to perfrom job faster?
Well, lazy evaluation is itself a form of lightweight coroutining. The
question is just how to plumb the compiler transformations such that the
coroutines can work without generating intermediate structures.
Josef Svenningsson:
> As I said before, it is indeed possible to fuse
> zipWith[1..] with other funcions. The only problem is that we don't
> know how to do it for all list argument at the same time *within the
> foldr/build framework*. And since ghc only uses foldr/build at the
> moment we have to fuse the zipWith family of functions by hand if we
> want to achieve fusion.
Thanks for pointing to your ICFP'02 paper on this. Very interesting.
The remaining difficulty is how to allow the co-existence of foldr/build
with your destroy/unfoldr, so we get the benefits of both techniques.
I have an idea about that.
So, where you have
unfoldr :: (s ->Maybe (a,s)) -> s -> [a]
unfoldr g s = go s
where go s = case g s of
Nothing -> []
Just (x,s') -> x: go s'
as the basis of a good producer, I thought, why not express this more
like the 'build' pattern by abstracting the list constructors (:) and [].
genUnfoldr :: (s -> Maybe (a,s)) -> s -> (a->b->b) -> b -> b
genUnfoldr g s cons nil = go s
where go s = case g s of
Nothing -> nil
Just (x,s') -> x `cons` go s'
The original unfold can be expressed as
unfoldr g s = genUnfoldr g s (:) []
or
unfoldr g s = build (genUnfoldr g s)
Now, we can use an unfoldr as the producer in *either* a foldr/build
rule, or a destroy/unfoldr rule. But unfoldr also gives us the
additional ability to fuse two producers together. Here is the fusing
function (zipDU in your paper):
zipG :: (s->Maybe (a,s)) -> (r->Maybe (b,r)) -> (s,r) -> Maybe ((a,b),(s,r))
g `zipG` h = \ (s,r)-> case g s of
Nothing -> Nothing
Just (x,s') ->
case h r of
Nothing -> Nothing
Just (y,r') -> Just ((x,y),(s',r'))
and here is the rule to use it in a zipWith-like context:
{-# RULES
"foldr2/unfoldr/unfoldr"
foldr2 consumer z (unfoldr g s) (unfoldr h r)
=
foldr (\ (x,y) z-> consumer x y z) z (unfoldr (g `zipG` h) (s,r))
#-}
Recalling that unfoldr is just a build, this then triggers the ordinary
foldr/build rule, to become
foldr (\ (x,y) z-> consumer x y z) z (build (genUnfoldr (g `zipG` h) (s,r)))
==>
genUnfoldr (g`zipG`f) (s,r) (\ (x,y) z-> consumer x y z) z
Perhaps this is not much better though, because where we used to have
intermediate list structure, now we have intermediate pair structures.
I would like to hope that other optimisations might still be able to
remove these as well, but have not yet investigated.
Regards,
Malcolm
More information about the Libraries
mailing list