Bad fragmentation when allocating many large objects

Consider our good old friend, the space-leaky list program:

import Control.Exception
import System.Environment

f n = let xs = [1..n] in sum xs * product xs

main = do
    [n] <- getArgs
    evaluate (f (read n :: Integer))

It is not surprising that this program is quite the memory guzzler; what is surprising is how much GHC *wastes* when evaluating this program:

Fragmentation, wanted 95 blocks,  105 MB free

(For reference, a block is 4k, so 95 blocks is a measly 380k!) The magnitude of the problem can be seen in this graphic:

[[Image(http://web.mit.edu/~ezyang/Public/fragmentation-ghc.png)]]

(The x-axis takes advantage of the fact that the number of requested blocks increases ~linearly over time, since we keep multiplying the integer which adds a constant number of extra bytes to the representation; unused free memory corresponds to blocks of free memory in GHC's free list, which it is holding onto from the OS but not using to store user data.)

When the requested allocations are *just* large enough (just slightly over half a megablock, or 128 blocks), we start allocating a megablock per allocation and waste half of the megablock, since none of the leftovers are ever large enough to store any of the later allocations.

Can we do anything about this? One possibility is to occasionally check how much space we're losing to fragmentation, and everyone once in a while pay the cost of copying tenured large objects and pack them together in a megablock group (obviously one wants to avoid doing this too often, since copying large objects is expensive!) I'm open to better suggestions though! (Apologies if this is a duplicate; I didn't see any open tickets with the word "fragmentation" in them).

Trac metadata

Trac field	Value
Version	7.7
Type	Bug
TypeOfFailure	OtherFailure
Priority	normal
Resolution	Unresolved
Component	Runtime System
Test case
Differential revisions
BlockedBy
Related
Blocking
CC
Operating system
Architecture