[Haskell-cafe] Parallelism causes space leaks

Yavuz Yetim yyetim at gmail.com
Fri Mar 23 05:45:16 CET 2012


Hi,

For the code below, where it says "HERE" in comments, if I remove the part
after `using` the code works fine. However, with this version it causes a
Stack space overflow (if allowed uses GBs of memory). You just need to
input a file with around 1M lines each having something like "Int Value: 3
@x".

What is wrong with adding the parList to this code? (Same thing happens for
parMap, and parListChunk, etc)

Yavuz


import System.IO
import System.Environment
import System.IO.Error
import Control.Parallel
import Control.Parallel.Strategies
import Control.Monad
import Data.Binary as DB
import Data.Binary.Put
import Data.Word
import Data.Maybe
import qualified Data.ByteString.Lazy as B
import Text.Regex.TDFA
import Text.Regex.Base.Context

main =
  do { args <- getArgs;
       x <- getLines (head args);
       mapM_ writeMaybeIntBinary ((map perLineOperator x) `using` parList
rdeepseq); -- HERE
       return ();
       }

writeMaybeIntBinary :: Maybe Word32 -> IO ()
writeMaybeIntBinary Nothing = return ();
writeMaybeIntBinary (Just intB) = do { B.hPut stdout (runPut (putWord32host
intB));};

getLines :: FilePath -> IO [String]
getLines = liftM lines . readFile

perLineOperator :: String -> Maybe Word32
perLineOperator line =
  let {
    getIntStr :: String -> String;
    getIntStr "" = "";
    getIntStr line =
      let {
        matches = (line =~ "Int Value: (-?[0-9]*) .*" :: [[String]]);
        }
      in
       if matches == [] then "" else (last (head matches));
    }
  in
   let {
     intStr = (getIntStr line);
     }
   in
    if intStr == "" then Nothing
    else Just (read intStr :: Word32)
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20120323/36817214/attachment.htm>


More information about the Haskell-Cafe mailing list