space leak due to optimisations and/or newtypes

Simon Marlow marlowsd at gmail.com
Thu Jun 4 05:42:45 EDT 2009


On 03/06/2009 22:26, Sebastian Fischer wrote:

> -------
> {-# LANGUAGE RankNTypes #-}
>
> newtype S a = S { unS :: forall b . (a -> Int -> [b]) -> Int -> [b] }
>
> ret x = S (\c -> c x)
> a `bind` f = S (\c -> unS a (\x -> unS (f x) c))
> zero = S (\c _ -> [])
> plus a b = S (\c -> id (\d -> if d==0 then []
> else id (unS a c) (d-1) ++
> id (unS b c) (d-1)))
>
> runS :: S a -> [a]
> runS a = concatMap (\d -> id (run a) d) [10000]
>
> run :: S a -> Int -> [a]
> run a = unS a (\x _ -> [x])
>
> natSum :: S Int
> natSum = anyof [1..] `bind` \x ->
> anyof [1..] `bind` \y ->
> ret (x+y)
> where anyof = foldr plus zero . map ret
>
> main = print . length $ runS natSum
> -------

Those two [1..] ring alarm bells.  GHC will happily combine them with 
CSE and possibly also lift them to the top-level; both transformations 
might have a big impact on space behaviour.

Try with -fno-full-laziness and/or -fno-cse.

Cheers,
	Simon


More information about the Glasgow-haskell-users mailing list