为什么将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 和＆gt;＆gt; = 函数的实现：

自：

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只是一个作家monad。不幸的是，这（again）造成了空间泄漏。我很清楚（或者是吗？）ghc在某个地方推迟评估，但我尝试将$!代替$放在一些教程的建议中，但这并没有帮助。此外，我不确定内存分析器是如何有用的，如果它告诉我的是：

为了完整起见，这是我使用原始Data.Binary.Put monad时得到的内存配置文件：

如果有兴趣，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')定义中为你的Identity样本添加一些懒惰（(>>)），你将获得相同的常量内存运行图片：

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评论。问题在于，您的第一个示例使用 lazy let绑定来实现>>，因此Tree不会被强制完全构建，因此“流式传输” 。你的第二个身份示例是严格的，所以我的理解是整个Tree在处理之前内置在内存中。实际上，您可以轻松地对第一个示例添加严格性，并观察它如何开始“占用”内存：

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