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

在我的示例中，我尝试将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 () 键入Out=StateT整数P.PutM（） writeToFile:：字符串->输出->IO（） writeToFile path out=BL.writeFile path$P.runPut$do runStateT out 0 返回（） 是一个更完整的代码示例，演示了该问题

我想知道的是：

程序内部发生了什么导致内存泄漏

我能做些什么来修复它

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

谢谢你的关注

更新： 多亏了nominolo，我现在可以创建一个单子，它环绕Data.Binary.Put，跟踪当前偏移量，几乎不使用内存。这是通过放弃StateT transformer的使用，转而使用另一种使用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) 类型偏移量=Int 新类型MyPut a=MyPut {unS:：forall r.（Offset->a->P.putmr）->Offset->P.putmr} 实例Monad MyPut在哪里 返回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（） 写入文件路径放置= BL.writeFile路径$P.runPut$peal put>>返回（） 其中peal myput=unS myput（\o->return）0 getCurrentOffset:：MyPut Int getCurrentOffset=MyPut$\f o->f o o 提升'n ma=MyPut$\f s->ma>=f（s+n） 然而，我在跟踪MyPut将在磁盘上写入多少字节方面仍然存在问题。特别是，我需要一个签名如下的函数： getSize :: MyPut a -> MyPut Int getSize:：MyPut a->MyPut Int 或 getSize:：MyPut a->Int

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

---

有人能进一步帮忙吗？

看来monad transformer太懒了。您可以通过以下方式运行程序来创建堆配置文件（无需专门构建）：

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

在这种情况下，它不是特别有用，因为它只显示大量的

PAP

s、

FUN\u 1\u 0

s和

FUN\u 2\u 0

s。这意味着堆由许多部分应用的函数以及一个参数和两个参数的函数组成。这通常意味着某些东西没有得到足够的评估。Monad变形金刚在这方面有些臭名昭著

解决方法是使用更严格的monad转换器。（his需要

{-#语言类型}

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

Continuation passing样式意味着我们不直接返回结果，而是调用另一个函数Continuation，并使用我们的结果，在本例中是

s

和

a

。实例定义看起来有点滑稽。要理解它，请阅读上面的链接（Wikipedia）

---

使用如此严格的转换器的缺点是，您无法再定义

MonadFix

实例，某些惰性技巧也不再有效。

我开始使用它，并意识到更大的问题是——您的算法具有可怕的复杂性。您不需要一次计算每个子树的大小，而是使用它来计算每次调用getSize时都调用ce。并且递归调用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的结果会被丢弃

---

我建议的适当解决方案是对您的另一个问题的回答：

我认为您的代码使用的是StateT的惰性版本，请尝试使用Control.Monad.State.Strict.I（而不是OP）尝试使用

.Strict

但没有改变空间要求。

C.M.S.Strict

仅比

C.M.S

稍微严格一点。严格性

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

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)