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

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“和"seq”放入其中，但没有结果)。有线索吗？

如果我输入一个"awaitForever“，为每条记录打印一个报告，那么它就能正常工作。

更新1:只有在用-O2编译时才会发生这种情况。分析表明，泄漏的内存分配在递归的"skipN“函数中，并由"SYSTEM”保留(不管这意味着什么)。

更新2:我已经治愈了它，至少在我当前的程序中是这样的。我用这个代替了上面的函数。请注意，"proc“的类型是"Int -> Int ->可能i -> m ()"：要使用它，您可以调用”->“并将结果传递给它。出于某种原因，换掉“等待”和“屈服”解决了问题。因此，现在它等待下一个输入，然后生成前一个结果。

-- | 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

因此，如果管道中有内存泄漏，请尝试交换收益并等待操作。

Answer 1

这不是一个分析程序，但它是一些完整的代码，我黑客为测试。我根本不知道管道，所以它可能不是最好的管道代码。我强迫了所有看起来需要强迫的东西，但它还是泄露出去了。

{-# 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

我认为Tom的答案是正确的，我从一个单独的答案开始，因为它可能会带来一些新的讨论(而且因为它太长了，不需要评论)。在我的测试中，用print b替换汤姆示例中的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的调用。该程序的输出是相同的，但我没有显示泄漏，最大驻留32 at对62 at(我还修改了代码，以停止在10m记录，以便更好的比较)。

当我完全切断管道时，我看到了类似的行为，例如：

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

不过，我并不认为这是print或Handle中的一个bug。我的测试从来没有显示泄漏达到任何实质性的内存使用，所以它可能只是一个缓冲区正在增长到一个极限。为了更好地理解这一点，我需要做更多的研究，但我想先看看这个分析是否与其他人所看到的相吻合。

Answer 3

我知道这是两年后的事，但我怀疑现在所发生的是完全的懒惰正在提升身体的一部分等待直到等待，这导致了空间泄漏。它类似于m关于这个主题的博客文章中“增加共享”一节中的情况。