haskell - 为什么包装 Data.Binary.Put monad 会导致内存泄漏？ (第2部分)

Question

如我的previous 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 ()

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

我想知道的是:

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

或

getSize :: MyPut a -> Int

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

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

Answer 1

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

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

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

解决方法是使用更严格的 monad 转换器 continuation passing style 。 (他需要 {-# LANGUAGE Rank2Types #-}。

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

Continuation 传递风格意味着我们不是直接返回结果，而是使用我们的结果调用另一个函数，即 Continuation，在本例中为 s 和 a 。实例定义看起来有点有趣。要了解它，请阅读上面的链接(维基百科)。

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 实例，并且某些惰性技巧不再起作用。