[Haskell-cafe] Help me with space leaks

Alexey Uimanov s9gf4ult at gmail.com
Wed Sep 26 08:55:03 CEST 2012


Hello. I am trying to write some thing in haskell and i need fast
storage to store and select this things from storage.
https://github.com/s9gf4ult/projs/tree/master/haskell/teststorage

I am writing simple testing package to determine my needs and select
the fastest storage and i have encountered problems.

Firstly i decided to check out postgresql-simple, but when i am doing
"executeMany" i see space leaks, here is the picture
http://bayimg.com/NAdjHAaeA
http://bayimg.com/NADjKAAea
I dont fully understand what is happening here, but i belive this is
because of lazy consuming of "executeMany" or something. So things im
trying to insert do not calculate one by one, but this is creating
many thunks for calculate them.

I would understand how to narrow the cause of this problem and create
more strict function "executeMany" which would work in constant space
(or space of data).

Here the insertMany from postgresql-simple

executeMany :: (ToRow q) => Connection -> Query -> [q] -> IO Int64
executeMany _ _ [] = return 0
executeMany conn q qs = do
  result <- exec conn =<< formatMany conn q qs
  finishExecute conn q result

And this is not looks like a problem case go to formatMany

formatMany :: (ToRow q) => Connection -> Query -> [q] -> IO ByteString
formatMany _ q [] = fmtError "no rows supplied" q []
formatMany conn q@(Query template) qs = do
  case parseTemplate template of
    Just (before, qbits, after) -> do
      bs <- mapM (buildQuery conn q qbits . toRow) qs
      return . toByteString . mconcat $ fromByteString before :
                                        intersperse (fromChar ',') bs ++
                                        [fromByteString after]
    Nothing -> fmtError "syntax error in multi-row template" q []

Here bs is the map of bs and must stay lazy evaluated
and here we see mconcat which must be strict i think, and if i am
right so problem must disapear whan i replace it with strict mconcat

mconcat' :: (Monod a) => [a] -> a
mconcat' [] = mempty
mconcat' (x:xs) = x `seq` (mappend x $ mconcat' xs)

but it doesnt.
I assume i must write the same for "deepseq" to realy calculate each
parameter up to value. But if so, this must touch several projects
such as blaze and maybe bytestring because of the need to make NFData instances.
How to solve this problem right - way ? Maybe haskell have elegant
solution for this ?



More information about the Haskell-Cafe mailing list