为什么将Data.Binary.Put monad更改为变换器会产生内存泄漏？

Question

我试图修改Data.Binary.PutM monad成monad变换器。于是我开始了变化它的定义从

newtype PutM a = Put { unPut :: PairS a }

到

newtype PutM a = Put { unPut :: Identity (PairS a) }

那么当然我改变了回报和>> =函数的实现：

来源：

return a = Put $ PairS a mempty 
{-# INLINE return #-} 

m >>= k = Put $ 
    let PairS a w = unPut m 
     PairS b w1 = unPut (k a) 
    in PairS b (w `mappend` w1) 
{-# INLINE (>>=) #-} 

m >> k = Put $ 
    let PairS _ w = unPut m 
     PairS b w1 = unPut k 
    in PairS b (w `mappend` w1) 
{-# INLINE (>>) #-} 

收件人：

return a = Put $! return $! PairS a mempty 
{-# INLINE return #-} 

m >>= k = Put $! 
    do PairS a w <- unPut m 
     PairS b w1 <- unPut (k a) 
     return $! PairS b $! (w `mappend` w1) 
{-# INLINE (>>=) #-} 

m >> k = Put $! 
    do PairS _ w <- unPut m 
     PairS b w1 <- unPut k 
     return $! PairS b $! (w `mappend` w1) 
{-# INLINE (>>) #-} 

好像PutM monad只是一个Writer monad。不幸的是（again）造成了空间泄漏。我很清楚（或是否？）ghc推迟评估某处，但我尝试将$!而不是$无处不在，正如某些教程所建议的，但这并没有帮助。另外，我不确定内存分析器是如何帮助的，如果它告诉我的是这样的：

。

以及物品是否完整，这是存储配置文件使用原始Data.Binary.Put单子时，我得到：

如果有兴趣，here是我使用来测试它的代码和我使用的编译，运行和创建存储轮廓线是：

ghc -auto-all -fforce-recomp -O2 --make test5.hs && ./test5 +RTS -hT && hp2ps -c test5.hp && okular test5.ps 

我希望我不是被我的内存泄漏问题传奇讨厌任何人。我发现互联网上没有很多关于这个话题的良好资源，这让我们无言以对。

感谢您的期待。

Answer 1

由于stephen tetley在他的评论中指出，这里的问题过于严格。如果你只是（你(>>)定义~(PairS b w')）添加一些更懒惰你的身份，你的样品会得到同样的常量内存运行画面：

data PairS a = PairS a {-# UNPACK #-}!Builder 

sndS :: PairS a -> Builder 
sndS (PairS _ !b) = b 

newtype PutM a = Put { unPut :: Identity (PairS a) } 

type Put = PutM() 

instance Monad PutM where 
    return a = Put $! return $! PairS a mempty 
    {-# INLINE return #-} 

    m >>= k = Put $! 
     do PairS a w <- unPut m 
      PairS b w' <- unPut (k a) 
      return $! PairS b $! (w `mappend` w') 
    {-# INLINE (>>=) #-} 

    m >> k = Put $! 
     do PairS _ w <- unPut m 
      ~(PairS b w') <- unPut k 
      return $! PairS b $! (w `mappend` w') 
    {-# INLINE (>>) #-} 

tell' :: Builder -> Put 
tell' b = Put $! return $! PairS() b 

runPut :: Put -> L.ByteString 
runPut = toLazyByteString . sndS . runIdentity . unPut 

实际上，你可以在这里使用正常的元组和代替$$!

PS再一次：正确的答案实际上是在stephen tetley评论。事情是，你的第一个例子使用懒惰let绑定为>>实现，所以Tree不是被迫完全构建，因此“是流”。您的第二个身份示例是严格的，所以我的理解是整个Tree在处理之前会先建在内存中。实际上，你可以轻松地添加到严厉一号样板房，并观察它是如何开始“霸占”记忆：

m >> k = Put $ 
      case unPut m of 
      PairS _ w -> 
       case unPut k of 
        PairS b w' -> 
         PairS b (w `mappend` w')