为什么包装 Data.Binary.Put monad 会导致内存泄漏？ （第二部分）

Question

正如我的上一个问题，我正在尝试将 Data.Binary.Put monad 包装到另一个 monad 中，以便稍后我可以问它诸如“它将写入多少字节”或“文件中的当前位置是什么”之类的问题。

之前，我认为理解为什么它在使用简单的（IdentityT？）包装器时会泄漏内存将引导我解决我的问题。但即使你们帮我解决了这个简单的包装器的问题，用 StateT 或 WriterT 等有用的东西包装它仍然会消耗太多内存（并且通常会崩溃）。

例如，这是我尝试包装它的一种方法，它会泄漏大输入的内存：

type Out = StateT Integer P.PutM ()

writeToFile :: String -> Out -> IO ()
writeToFile path out = BL.writeFile path $ P.runPut $ do runStateT out 0
                                                         return ()

这里 是演示该问题的更完整的代码示例。

我想知道的是：

1. 程序内部发生了什么导致内存泄漏？
2. 我能做什么来修复它？

对于我的第二个问题，我认为我应该更详细地解释我想要数据在磁盘上查看的内容：它基本上是一个树结构，其中树的每个节点都表示为其子节点的偏移表（加上一些附加数据）。因此，要计算第 n 个子节点在偏移表中的偏移量，我需要知道 0 到 n-1 子节点的大小加上当前偏移量（为了简化问题，假设每个节点都有固定数量的子节点）。

感谢您的关注。

更新： 感谢 nominolo，我现在可以创建一个包裹 Data.Binary.Put 的 monad，跟踪当前偏移量并且几乎不使用内存。这是通过放弃使用 StateT 转换器转而使用使用 Continuations 的不同状态线程机制来完成的。

像这样：

type Offset = Int

newtype MyPut a = MyPut
  { unS :: forall r . (Offset -> a -> P.PutM r) -> Offset -> P.PutM r }

instance Monad MyPut where
  return a = MyPut $ \f s -> f s a
  ma >>= f = MyPut $ \fb s -> unS ma (\s' a -> unS (f a) fb s') s

writeToFile :: String -> MyPut () -> IO ()
writeToFile path put =
  BL.writeFile path $ P.runPut $ peal put >> return ()
  where peal myput = unS myput (\o -> return) 0

getCurrentOffset :: MyPut Int
getCurrentOffset = MyPut $ \f o -> f o o

lift' n ma = MyPut $ \f s -> ma >>= f (s+n)

但是，我在跟踪 MyPut 将在磁盘上写入多少字节方面仍然存在问题。特别是，我需要一个具有如下签名的函数：

getSize :: MyPut a -> MyPut Int

or

getSize :: MyPut a -> Int

我的方法是将 MyPut monad 包装在 WriterT 变压器中（类似于 this）。但这又开始消耗太多内存。正如 sclv 在 nominolos 答案下的评论中提到的那样，WriterT 以某种方式抵消了延续的影响。他还提到，应该可以直接从我已有的 MyPut monad 获取大小，但我这样做的所有尝试都以不可编译的代码或无限循环结束:-|。

有人可以进一步提供帮助吗？

Answer 1

我开始研究这个并意识到更大的问题是什么——你的算法非常复杂。您不是计算每个子树的大小一次，而是每次调用 getSize 时计算一次。然后递归调用 getSize。对于每个叶节点，每次在其父节点上调用 getSize 时，都会调用一次 getSize。并且每个父级上的 getSize 都会为自己调用一次 + 每次在任何一个父级上调用 getSize 时都会调用一次 getSize 。所以 getsize 至少在树的深度上被几何地调用。您需要缓存大小以获得类似于合理运行时间的东西。

也就是说，这是核心功能的一个版本，它似乎可以正常运行而没有泄漏，尽管由于上述原因它确实在爬行：

type MyPut = S (Offset,Size) P.PutM

peal_1 :: (Monad m, Num t, Num t1) => S (t, t1) m a -> m a
peal_1 put = unS put (\o -> return) (0,0)

writeToFile :: String -> MyPut () -> IO ()
writeToFile path put =
  BL.writeFile path $ P.runPut $ (peal_1 put) >> return ()

getSize :: MyPut a -> MyPut Int
getSize x = S $ \f os -> unS (x >> getCurrentSize) f os

getCurrentOffset :: MyPut Int
getCurrentOffset = S $ \f os -> f os (fst os)

getCurrentSize :: MyPut Int
getCurrentSize = S $ \f os -> f os (snd os)

我还不得不说我不确定您的逻辑总体上是否正确。我的代码在修复泄漏的同时保留了当前的行为。我通过在缩减的数据集上运行它和您的代码并生成逐位相同的文件来对此进行测试。

但是对于你的大测试数据，这段代码在我杀死它之前写了6.5G（提供的代码在那之前就耗尽了堆）。我怀疑但尚未测试 put monad 中的底层调用对于每次调用 getSize 都会运行一次，即使 getSize 的结果被丢弃。

我提出的正确解决方案已发布作为您其他问题的答案：如何在 Haskell 中将树数据结构保存到二进制文件

Answer 2

看起来 monad 转换器太懒了。您可以通过运行程序来创建堆配置文件（无需专门构建）：

$ ./myprog +RTS -hT
$ hp2ps myprog.hp
$ open hp2ps.ps    # Or whichever viewer you have

在这种情况下，它不是特别有用，因为它只显示大量 PAP，FUN_1_0 和 FUN_2_0。这意味着堆由许多部分应用的函数以及一个参数和两个参数的函数组成。这通常意味着某些事情没有得到充分的评估。 Monad 转换器因此而有些臭名昭著。

解决方法是使用更严格的 monad 转换器，使用连续传递样式。 （他需要 {-# LANGUAGE Rank2Types #-}。

newtype MyStateT s m a =
  MyStateT { unMyStateT :: forall r. (s -> a -> m r) -> s -> m r }

延续传递风格意味着我们不是直接返回结果，而是使用我们的结果调用另一个函数，延续， 实例定义看起来有点有趣，请阅读上面的链接（维基百科）。

instance Monad m => Monad (MyStateT s m) where
  return x = MyStateT (\k s -> k s x)
  MyStateT f >>= kk = MyStateT (\k s ->
    f (\s' a -> unMyStateT (kk a) k s') s)

runMyStateT :: Monad m => MyStateT s m a -> s -> m (a, s)
runMyStateT (MyStateT f) s0 = f (\s a -> return (a, s)) s0

instance MonadTrans (MyStateT s) where
  lift act = MyStateT (\k s -> do a <- act; k s a)

type Out = MyStateT Integer P.PutM ()

在这种情况下， 位）：

$ ./so1 +RTS -s 
begin
end
   8,001,343,308 bytes allocated in the heap
     877,696,096 bytes copied during GC
          46,628 bytes maximum residency (861 sample(s))
          33,196 bytes maximum slop
            2 MB total memory in use (0 MB lost due to fragmentation)

Generation 0: 14345 collections,     0 parallel,  3.32s,  3.38s elapsed
Generation 1:   861 collections,     0 parallel,  0.08s,  0.08s elapsed

使用如此严格的转换器的缺点是您无法再定义 MonadFix 实例，并且某些惰性技巧不再起作用。