
On 10/2/07, Don Stewart
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"
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.
hmm, this doesn't make sense to me, it goes up to 500M then down then back up, then back down, so it doesn't just run out of memory because of (length l) forces you to evaluate the entire list.
Use a newtype, and a lazier instance, if you need to do this.
Thanks for the tip. this runs at a constant 4M module Main where import Data.Binary import Data.List(foldl') data Foo = Foo Int Foo | Null instance Binary Foo where put (Foo i f) = do put (0 :: Word8) put i put f put (Null) = do put (1 :: Word8) get = do t <- get :: Get Word8 case t of 0 -> do i <- get f <- get return (Foo i f) 1 -> do return Null sumFoo zz (Null) = zz sumFoo zz (Foo ii ff) = sumFoo (zz + ii) ff fooBar i = Foo i (fooBar (i + 1)) main = do print $ sumFoo 0 $ decode $ encode $ fooBar 1 print "done"