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

Question

我有一个利用conduit管道处理长文件的流程。我希望每处理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和await操作。

- Paul Johnson

---

这并不是真正的尾递归，最后一次调用不是到skipN，而是到(>>(yield v)(skipN x y))。使用单子编写递归例程时，这是一个常见的陷阱。我不确定 GHC 是否能够正确地优化它，除非查看核心转储，但我的初步猜测是您实际上并没有使用尾递归函数。 - bheklilr

同样的原因，sum (x:xs) = x + sum xs 不是尾递归的，因为最后一个被调用的函数不是 sum，而是 (+)，因为该等式等同于 sum (x:xs) = (+) x xs。因此，我们经常使用带有累加器参数的辅助函数编写递归函数，或者如果情况足够简单，就直接使用 fold，如 sum = go 0 where { go a [] = a; go a (x:xs) a = go (x + a) xs } 或 sum = foldl' (+) 0。由于 do 表达式展开成使用 >> 和 >>=，这意味着堆栈中的最后一个调用是其中之一，而不是它的第二个参数。 - bheklilr

我认为你们都过于关注尾递归部分了。pipes和conduit都不需要尾递归才能在恒定的空间内运行。讨论尾递归只是一个转移注意力的话题。 - Gabriella Gonzalez

如果您能发布完整可运行的代码，包括演示内存泄漏的“progress”使用示例，那将非常有帮助。 - Tom Ellis

@dfeuer：在我们看到尝试之前，我们无法确定他是否以正确的方式强制执行它！ - Tom Ellis

Answer 1

这不是一个答案，但这是我编写的一些完整的代码用于测试。我不懂conduit，所以这可能不是最好的conduit代码。我强制了所有看起来需要被强制的东西，但仍然存在泄漏。

{-# 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中发生！如果我编译二进制文件并运行它，就不会有泄漏（我早该测试这个了……）

- Tom Ellis

---

谢谢。我今天正打算写类似的东西。 - Paul Johnson

这并不强制执行“t”，因此您仍可能积累thunk。我今晚必须尝试一下。 - Paul Johnson

@PaulJohnson，skipN !c !t中的bang模式确实似乎强制执行了t。没有必要强制执行c（尽管出于速度考虑可能是一个好主意），因为它经常被if强制执行。 - dfeuer

请看下面我的回答，我认为Tom的解决方案没有内存泄漏，而是print出了问题。 - Michael Snoyman

Answer 2

我认为Tom的回答是正确的，我将其作为一个单独的回答开始，因为它可能会引入一些新的讨论（并且因为它太长了，不适合只是一个评论）。在我的测试中，将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的调用。程序的输出结果相同，但没有泄漏，最大驻留内存为32kb，而不是62kb（我还修改了代码以在比较时停止于10m记录）。

当我完全剪切conduit时，我看到类似的行为，例如：

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

我不确定这是否真的是print或Handle中的一个bug。我的测试从未显示出泄漏达到任何实质性的内存使用，因此可能只是缓冲区朝着限制增长。我需要进行更多的研究来更好地理解这一点，但我首先想看看这个分析是否符合其他人的观察结果。

- Michael Snoyman

---

之前我只在ghci中测试了我的代码，没有费心去编译它。现在我已经完成了后者，我注意到即使在-O0的情况下编译版本中也没有泄漏。所以也许ghci中有一个bug？（我使用的是7.6版本）。 - Tom Ellis

顺便说一下，在ghci中，内存泄漏是巨大的。它很快地占用了我4GB内存的50%。 - Tom Ellis

@PaulJohnson：你在编译版本中看到了空间泄漏吗？ - Tom Ellis

我正在尝试编写一个样例程序来复现这个泄漏问题，但是进展并不顺利。 - Paul Johnson

@PaulJohnson 你有一个独立的程序能够完全展示内存泄漏吗？那会非常有帮助。 - Michael Snoyman

Answer 3

我知道已经过去两年了，但我怀疑正在发生的是完全惰性正在提升部分身体等待直到之前的等待，这会导致空间泄漏。它看起来类似于m我关于这个主题的博客文章中“增加共享”一节中的情况。

- edsko