[Haskell-cafe] RE: simple function: stack overflow in
hugsvsnonein ghc
Claus Reinke
claus.reinke at talk21.com
Mon Sep 24 20:33:23 EDT 2007
> return (replicate 1000000 'a') >>= \x->print $ spant (const True) x
>
> ERROR - Garbage collection fails to reclaim sufficient space
>
> i.e. as the function unfold, the thunk representing the second term builds
> up on the heap.
true. i've often wanted a copy pseudo-function that would
avoid updating shared references, thus avoiding such leaks
(at the cost of re-evaluation).
if you have control of the list producer, you can make sure
that it produces unshared copies of such lists:
return producer >>= \x->print $ spant (const True) x
where
producer _ = replicate 1000000 'a'
spant x = (takeWhile p $ x (),dropWhile p $ x () )
> (not sure why it works for an infinite list, hugs must drop
> the reference to the tail ?)
curioser and curioser.. just as for apfelmus' question,
|> ah yes, without optimisations, Prelude.span builds up stack,
| I don't quite understand why it does so at all.
i don't have an answer at hand, but would like one!-)
> to obtain a function that will properly operate in constant
> space, for every unfolding of the first term we need to
> enforce evaluation of the second term.
if you don't mind ugly, unsafe, unrecommended code,
here's a version implementing your description, purely
to serve as a bad example;-)
-- ugly, unsafe, unrecommended, unsymmetric
-- (leak is avoided only left to right)
span4 p l = unsafePerformIO $ do
mv <- newMVar l
return (take p l mv,drop mv)
where
take p xs@(x:xs') mv | p x = unsafePerformIO $
swapMVar mv xs' >> return (x:take p xs' mv)
take p xs mv = unsafePerformIO $
swapMVar mv xs >> return []
drop mv = unsafePerformIO $
readMVar mv >>= return . dropWhile p
-- for right to left evaluation (drop before take), we
-- run into the problem that drop can't make a copy
-- of l, so will force unfolding of the l shared with take
return (replicate 1000000 'a') >>= \x->
print $ swap $ span (const True) x
where swap (a,b) = (b,a)
there have been threads in the past on this topic, ie,
how to force two otherwise independent thunks with
shared references to evolve in synch in order to avoid
space leaks.
claus
More information about the Haskell-Cafe
mailing list