[Haskell-cafe] Re: bizarre memory usage with data.binary
Don Stewart
dons at galois.com
Tue Oct 2 20:04:17 EDT 2007
aeyakovenko:
> Program1:
>
> module Main where
>
> import Data.Binary
> import Data.List(foldl')
>
>
> main = do
> let sum' = foldl' (+) 0
> let list::[Int] = decode $ encode $ ([1..] :: [Int])
> print $ sum' list
> print "done"
>
> vs
>
> Program2:
>
> module Main where
>
> import Data.Binary
> import Data.List(foldl')
>
>
> main = do
> let sum' = foldl' (+) 0
> let list::[Int] = [1..]
> print $ sum' list
> print "done"
>
> neither program is expected to terminate. The point of these examples
> is to demonstrate that Data.Binary encode and decode have some strange
> memory allocation patters.
The encode instance for lists is fairly strict:
instance Binary a => Binary [a] where
put l = put (length l) >> mapM_ put l
get = do n <- get :: Get Int
replicateM n get
This is ok, since typically you aren't serialising infinite structures.
Use a newtype, and a lazier instance, if you need to do this.
-- Don
More information about the Haskell-Cafe
mailing list