Proposal: Make intersperse lazier

John Lato jwlato at gmail.com
Tue Sep 21 05:08:09 EDT 2010


Message: 1

> Date: Mon, 20 Sep 2010 15:55:58 +0200
> From: Christian Maeder <Christian.Maeder at dfki.de>
> Subject: Re: Proposal: Make intersperse lazier
> To: Daniel Fischer <daniel.is.fischer at web.de>
> Cc: libraries at haskell.org
> Message-ID: <4C9767EE.902 at dfki.de>
> Content-Type: text/plain; charset=UTF-8
>
> Am 17.09.2010 20:17, schrieb Daniel Fischer:
> > Okay, if you don't then I do :)
> > I've benchmarked a couple of variants:
> >
> > module Interspersing where
> >
> > isgo :: a -> [a] -> [a]
> > isgo _ [] = []
> > isgo s (x:xs) = x : go xs
> >   where
> >     go [] = []
> >     go (y:ys) = s : y: go ys
> >
> > isrec :: a -> [a] -> [a]
> > isrec s l = case l of
> >               [] -> l
> >               (x:r) -> x : if null r then r else (s : isrec s r)
> >
>
> [..]
>
> > Results:
> > With -O2:
> > unsurprisingly, isgo and ispreplc have nearly identical means in each
> run,
> > about 33.6 ms for the small benchmark and 153 ms for the large.
> > isprepD is slightly slower, 33.9 ms resp 155 ms.
> > isprepM and isprepT are a little slower again, 34.4 ms resp 157 ms.
> > isrec lags behind, 43.4 ms resp. 193 ms.
>
> I also did some benchmarking. It made no difference if ones uses a
> global function "prepend" or the local "go" function. (Also prepend is
> not faster if written using a worker.)
>
> The function isrec seem to be rewritten to a form that does not test "r"
> twice:
>
> isrec2 :: a -> [a] -> [a]
> isrec2 s l = case l of
>  [] -> l
>  x : r -> myGo s x r
>
> myGo :: a -> a -> [a] -> [a]
> myGo s x r = x : case r of
>    [] -> r
>    y : t -> s : myGo s y t
>
> (making myGo local makes it worse)
>
> myGo produces a non-empty list. Therefore it is safe to change
> the recursive call "s : myGo s y t" to "(s :) $! myGo s y t".
>
> After this change or the change "(s :) $! isrec s r" in Daniel's isrec
> function, these function are almost as fast as isgo.
>
> Cheers Christian
>

Which compiler/version are you using for your tests?  Is the behavior the
same for other compilers/versions?  In particular, is it similar for
ghc-6.10, ghc-6.12, and ghc-HEAD?

When benchmarking variants like this, I'm always suspicious that my
optimizations may be ghc-version-specific, since I've had occasional
experience to the contrary.

John Lato
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/libraries/attachments/20100921/8f25191c/attachment.html


More information about the Libraries mailing list