为什么这会导致Haskell Conduit库中的内存泄漏？

Question

我有一个管道管道处理一个长文件.我想每1000条记录为用户打印一份进度报告,所以我写了这样的:

-- | Every n records, perform the IO action.
-- Used for progress reports to the user.
progress :: (MonadIO m) => Int -> (Int -> i -> IO ()) -> Conduit i m i
progress n act = skipN n 1
   where
      skipN c t = do
         mv <- await
         case mv of
            Nothing -> return ()
            Just v ->
               if c <= 1
                  then do
                     liftIO $ act t v
                     yield v
                     skipN n (succ t)
                  else do
                     yield v
                     skipN (pred c) (succ t)

无论我怎么称呼它,它都会泄漏内存,即使我只是告诉它打印一个句号.

据我所知,该函数是尾递归的,并且两个计数器都是经常强制的(我尝试将"seq c"和"seq t"放入,但无济于事).任何线索？

如果我输入一个"awaitForever"为每条记录打印一份报告,那么它可以正常工作.

更新1:仅在使用-O2编译时才会发生这种情况.分析表明泄漏的内存在递归的"skipN"函数中分配,并由"SYSTEM"保留(无论这意味着什么).

更新2:至少在我目前的计划中,我已经成功治愈了它.我用这个替换了上面的函数.请注意,"proc"的类型为"Int - > Int - > Maybe i - > m()":要使用它,请调用"await"并将结果传递给它.出于某种原因,交换"await"和"yield"解决了这个问题.所以现在它在产生前一个结果之前等待下一个输入.

-- | Every n records, perform the monadic action. 
-- Used for progress reports to the user.
progress :: (MonadIO m) => Int -> (Int -> i -> IO ()) -> Conduit i m i
progress n act = await >>= proc 1 n
   where
      proc c t = seq c $ seq t $ maybe (return ()) $ \v ->
         if c <= 1
            then {-# SCC "progress.then" #-} do
               liftIO $ act t v
               v1 <- await
               yield v
               proc n (succ t) v1
            else {-# SCC "progress.else" #-} do
               v1 <- await
               yield v
               proc (pred c) (succ t) v1

因此,如果您在Conduit中有内存泄漏,请尝试交换yield并等待操作.

Answer 1

这不是一个anwser,但它是一些我为测试而破解的完整代码.我根本不知道管道,所以它可能不是最好的管道代码.我强迫所有看起来需要被迫的东西,但它仍然会泄漏.

{-# LANGUAGE BangPatterns #-}

import Data.Conduit
import Data.Conduit.List
import Control.Monad.IO.Class

-- | Every n records, perform the IO action.
--   Used for progress reports to the user.
progress :: (MonadIO m) => Int -> (Int -> i -> IO ()) -> Conduit i m i
progress n act = skipN n 1
   where
      skipN !c !t = do
         mv <- await
         case mv of
            Nothing -> return ()
            Just !v ->
               if (c :: Int) <= 1
                  then do
                     liftIO $ act t v
                     yield v
                     skipN n (succ t)
                  else do
                     yield v
                     skipN (pred c) (succ t)

main :: IO ()
main = unfold (\b -> b `seq` Just (b, b+1)) 1
       $= progress 100000 (\_ b -> print b)
       $$ fold (\_ _ -> ()) ()

另一方面,

main = unfold (\b -> b `seq` Just (b, b+1)) 1 $$ fold (\_ _ -> ()) ()

没有泄漏,所以progress确实似乎有问题.我看不出来.

编辑:泄漏只发生在ghci!如果我编译二进制文件并运行它没有泄漏(我应该先测试一下......)

Answer 2

我认为汤姆的答案是正确的,我将此作为一个单独的答案开始,因为它可能会引入一些新的讨论(因为它只是一个评论太长了).在我的测试中,替换print bTom的示例中return ()摆脱了内存泄漏.这让我觉得问题实际上是print,而不是conduit.为了测试这个理论,我在C中编写了一个简单的辅助函数(放在helper.c中):

#include <stdio.h>

void helper(int c)
{
    printf("%d\n", c);
}

然后我在Haskell代码中输入了这个函数:

foreign import ccall "helper" helper :: Int -> IO ()

我换成调用print与到呼叫helper.程序的输出是相同的,但我没有泄漏,最大驻留时间为32kb vs 62kb(我还修改了代码以停止在10m记录以便更好地进行比较).

当我完全切断导管时,我看到类似的行为,例如:

main :: IO ()
main = forM_ [1..10000000] $ \i ->
    when (i `mod` 100000 == 0) (helper i)

但是,我不相信这确实是一个错误print或者Handle.我的测试从未显示泄漏达到任何实质内存使用量,因此它可能只是缓冲区正在向限制增长.我必须做更多的研究才能更好地理解这一点,但我想首先看看这个分析是否与其他人看到的一致.