[Haskell-cafe] why does the binary library require so much memory?
Alex Mason
axman6 at gmail.com
Sun Aug 16 03:26:43 EDT 2009
Hi Don,
I was wondering if perhaps this might be a slightly better instance
for Binary [a], that might solve a) the problem of having to traverse
the entire list first, and b) the list length limitation of using
length and Ints. My version is hopefully a little more lazy (taking
maxBound :: Word16 elements at a time), and should potentially allow
infinite lists to be stored:
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.Word
newtype List a = List [a] deriving (Show,Eq)
instance Binary a => Binary (List a) where
put (List xs) = do
let (hd,num,tl) = btake maxBound xs
putWord16be num
if num == 0
then return ()
else do
mapM_ put hd
put (List tl)
get = do
num <- getWord16be
if num > 0
then do
xs <- sequence (replicate (fromIntegral num) get)
List ys <- get
return (List (xs ++ ys))
else return (List [])
btake :: Word16 -> [a] -> ([a],Word16,[a])
btake n xs = btake' n n xs
btake' :: Word16 -> Word16 -> [a] -> ([a],Word16,[a])
btake' 0 m xs = ([],m,xs)
btake' n m [] = ([],m-n,[])
btake' !n m (x:xs) = (x:xs',n',ys)
where (xs',n',ys) = btake' (n-1) m xs
My testing of this version shows that it's terribly bad when it comes
to memory usage, but I'm sure someone can find a more efficient way to
do what I'm trying here.
-- Axman
On 01/08/2009, at 07:27, Don Stewart wrote:
> bos:
>> On Fri, Jul 31, 2009 at 1:56 PM, Jeremy Shaw <jeremy at n-heptane.com>
>> wrote:
>>
>>
>> Using encode/decode from Binary seems to permamently increase my
>> memory consumption by 60x fold. I am wonder if I am doing
>> something
>> wrong, or if this is an issue with Binary.
>>
>>
>> It's an issue with the Binary instance for lists, which forces the
>> entire spine
>> of the list too early. This gives you a gigantic structure to hold
>> onto.
>
> This is the current instance
>
> instance Binary a => Binary [a] where
> put l = put (length l) >> mapM_ put l
> get = do n <- get :: Get Int
> getMany n
>
> -- | 'getMany n' get 'n' elements in order, without blowing the
> stack.
> getMany :: Binary a => Int -> Get [a]
> getMany n = go [] n
> where
> go xs 0 = return $! reverse xs
> go xs i = do x <- get
> -- we must seq x to avoid stack overflows due to
> laziness in
> -- (>>=)
> x `seq` go (x:xs) (i-1)
>
> It used to be this, though,
>
> xs <- replicateM n get -- now the elems.
>
>
> -- Don
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
More information about the Haskell-Cafe
mailing list