[Haskell-cafe] Understanding GC time

Joachim Breitner mail at joachim-breitner.de
Sat Mar 10 21:37:17 CET 2012


Hi,

Am Samstag, den 10.03.2012, 15:50 -0300 schrieb Thiago Negri:
> I see. Thanks for the answers.
> 
> Any data structure or source annotation that would prevent that?
> 
> For example, if I try the same program to run on a
> [1..9999999999999999] list, I'll get an out of memory error for the
> single-threaded version. Any way to prevent it without declaring two
> different versions of "list"?

I had real-world applications where I wanted a list rather to be
generated over and over again, instead of generated once and then
shared. One trick is to add a dummy parameter (of type (), for example)
to the list, and instead of passing around the "[Int]", you pass around
the "() -> [Int]" and apply it to () very late:

module Main where

import Data.List (foldl1')
import Control.Parallel (par, pseq)
import Control.Arrow ((&&&))

f `parApp` (a, b) = a `par` (b `pseq` (f a b))
seqApp = uncurry

main = print result
  where result = (+) `parApp` minMax list
        minMax = minlist &&& maxlist
        minlist l = foldl1' min (l ())
        maxlist l = foldl1' max (l ())
        list _ = [1..19999999]


Greetings,
Joachim

-- 
Joachim "nomeata" Breitner
  mail at joachim-breitner.de  |  nomeata at debian.org  |  GPG: 0x4743206C
  xmpp: nomeata at joachim-breitner.de | http://www.joachim-breitner.de/

-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 198 bytes
Desc: This is a digitally signed message part
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120310/53e91471/attachment.pgp>


More information about the Haskell-Cafe mailing list