递归IO函数中的内存泄漏

Question

我编写了一个名为amqp-工人的库，它提供了一个名为worker的函数，用于轮询消息队列(如RabbitMQ)中的消息，并在找到消息时调用处理程序。然后返回到投票。

它漏掉了记忆。我分析过它，图表上说PAP (部分函数应用程序)是罪魁祸首。我的代码中的漏洞在哪里？如何避免在IO forever**?**和中循环时发生泄漏

​

​

以下是一些相关的功能。完整的来源在这里。

示例程序。这漏了

main :: IO ()
main = do
  -- connect
  conn <- Worker.connect (fromURI "amqp://guest:guest@localhost:5672")

  -- initialize the queues
  Worker.initQueue conn queue
  Worker.initQueue conn results

  -- publish a message
  Worker.publish conn queue (TestMessage "hello world")

  -- create a worker, the program loops here
  Worker.worker def conn queue onError (onMessage conn)

工人

worker :: (FromJSON a, MonadBaseControl IO m, MonadCatch m) => WorkerOptions -> Connection -> Queue key a -> (WorkerException SomeException -> m ()) -> (Message a -> m ()) -> m ()
worker opts conn queue onError action =
  forever $ do
    eres <- consumeNext (pollDelay opts) conn queue
    case eres of
      Error (ParseError reason bd) ->
        onError (MessageParseError bd reason)

      Parsed msg ->
        catch
          (action msg)
          (onError . OtherException (body msg))
    liftBase $ threadDelay (loopDelay opts)

consumeNext

consumeNext :: (FromJSON msg, MonadBaseControl IO m) => Microseconds -> Connection -> Queue key msg -> m (ConsumeResult msg)
consumeNext pd conn queue =
    poll pd $ consume conn queue

民意测验

poll :: (MonadBaseControl IO m) => Int -> m (Maybe a) -> m a
poll us action = do
    ma <- action
    case ma of
      Just a -> return a
      Nothing -> do
        liftBase $ threadDelay us
        poll us action

Answer 1

下面是一个非常简单的示例，演示了您的问题：

main :: IO ()
main = worker

{-# NOINLINE worker #-}
worker :: (Monad m) => m ()
worker =
  let loop = poll >> loop
  in loop

poll :: (Monad m) => m a
poll = return () >> poll

如果您删除NOINLINE，或者将m专门化为IO (同时使用-O进行编译)，泄漏就会消失。

我编写了一个详细的博客帖子，说明为什么这段代码会泄漏内存。快速总结是，正如里德在他的回答中指出的，代码创建并记住了>>的部分应用程序链。

我还提交了一份关于这个的ghc票。

Answer 2

也许一个更容易理解的例子就是这个

main :: IO ()
main = let c = count 0
       in c >> c

{-# NOINLINE count #-}
count :: Monad m => Int -> m ()
count 1000000 = return ()
count n = return () >> count (n+1)

为IO操作计算f >> g会产生某种类型的闭包，它同时引用了f和g (基本上是f和g作为状态标记上的函数的组合)。count 0返回一个thunk c，它将计算为表单return () >> return () >> return () >> ...的一个大的闭包结构。当我们执行c时，我们构建了这个结构，因为我们必须第二次执行c，所以整个结构仍然处于活动状态。因此，这个程序泄漏内存(不管是否有优化标志)。

当count专门用于IO并启用优化时，GHC可以使用各种各样的技巧来避免构建这种数据结构；但是它们都依赖于知道monad是IO。

回到原来的count :: Monad m => Int -> m ()，我们可以通过将最后一行更改为

count n = return () >>= (\_ -> count (n+1))

现在递归调用隐藏在lambda中，因此c只是一个小的结构return () >>= (\_ -> BODY)。这实际上避免了在没有优化的情况下进行编译时的空间泄漏。但是，当启用优化时，GHC会将count (n+1)从lambda的主体中浮出(因为它不依赖于参数)

count n = return () >>= (let body = count (n+1) in \_ -> body)

现在c又成了一个大结构.

Answer 3

内存泄漏发生在poll中。使用monad-loops，我将定义更改为以下内容:看起来untilJust执行与递归相同的操作，但修复了泄漏。

有谁能评论一下我以前对poll的定义为什么会漏掉内存？

{-# LANGUAGE FlexibleContexts #-}

module Network.AMQP.Worker.Poll where

import Control.Concurrent (threadDelay)
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Base (liftBase)
import Control.Monad.Loops (untilJust)

poll :: (MonadBaseControl IO m) => Int -> m (Maybe a) -> m a
poll us action = untilJust $ do
    ma <- action
    case ma of
      Just a -> return $ Just a
      Nothing -> do
        liftBase $ threadDelay us
        return Nothing