[Haskell-cafe] trying to understand out of memory exceptions

Clark Gaebel cgaebel at uwaterloo.ca
Tue Apr 16 20:32:26 CEST 2013


Have you tried the lazy bytestring version?

http://hackage.haskell.org/packages/archive/bytestring/0.10.2.0/doc/html/Data-ByteString-Lazy-Char8.html#g:29

  - Clark

On Tuesday, April 16, 2013, Anatoly Yakovenko wrote:

> unfortunately read file tries to get the file size
>
> readFile :: FilePath -> IO ByteStringreadFile f = bracket (openFile f ReadMode) hClose    (\h -> hFileSize h >>= hGet h . fromIntegral)
>
>
> which wont work on a special file, like a socket.  which is what i am trying to simulate here.
>
>
>
> On Tue, Apr 16, 2013 at 11:28 AM, Clark Gaebel <cg.wowus.cg at gmail.com<javascript:_e({}, 'cvml', 'cg.wowus.cg at gmail.com');>
> > wrote:
>
>> See the comment for hGetContents:
>>
>> "This function reads chunks at a time, doubling the chunksize on each
>> read. The final buffer is then realloced to the appropriate size. For files
>> > half of available memory, this may lead to memory exhaustion. Consider
>> using readFile<http://hackage.haskell.org/packages/archive/bytestring/0.9.2.1/doc/html/Data-ByteString.html#v:readFile> in
>> this case."
>>
>>
>> http://hackage.haskell.org/packages/archive/bytestring/0.9.2.1/doc/html/Data-ByteString-Char8.html#g:31
>>
>> Maybe try lazy bytestrings?
>>
>>   - Clark
>>
>> On Tuesday, April 16, 2013, Anatoly Yakovenko wrote:
>>
>>> -- So why does this code run out of memory?
>>>
>>> import Control.DeepSeq
>>> import System.IO
>>> import qualified Data.ByteString.Char8 as BS
>>>
>>> scanl' :: NFData a => (a -> b -> a) -> a -> [b] -> [a]
>>> scanl' f q ls =  q : (case ls of
>>>                         []   -> []
>>>                         x:xs -> let q' = f q x
>>>                                 in q' `deepseq` scanl' f q' xs)
>>>
>>>
>>> main = do
>>>    file <- openBinaryFile "/dev/zero" ReadMode
>>>    chars <- BS.hGetContents file
>>>    let rv = drop 100000000000 $ scanl' (+) 0 $ map fromEnum $ BS.unpack
>>> chars
>>>    print (head rv)
>>>
>>> -- my scanl' implementation seems to do the right thing, because
>>>
>>> main = print $ last $ scanl' (+) (0::Int) [0..]
>>>
>>> -- runs without blowing up.  so am i creating a some thunk here?  or is
>>> hGetContents storing values?  any way to get the exception handler to print
>>> a trace of what caused the allocation?
>>>
>>>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20130416/f5afa43b/attachment.htm>


More information about the Haskell-Cafe mailing list