Haskell 为什么将Data.Binary.Put monad更改为转换器会导致内存泄漏？

我正在尝试将Data.Binary.PutM monad修改为monad转换器。所以我从长安开始，它的定义是

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

到

当然，我更改了return和>>=函数的实现：

发件人：

致：

我希望我没有因为我的记忆泄露问题而惹恼任何人。我发现互联网上没有太多关于这个话题的好资源，这让一个新手不知所措

---

感谢您的关注。

正如斯蒂芬·泰特利（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

---

嗨，彼得-我不相信你的数据中有“空间泄漏”。二进制，即对数据的一些错误处理阻止了它被垃圾收集。我认为，您之所以要构建一个巨大的内存配置文件，是因为您的数据结构（一棵树）不会流式处理—在完成序列化之前，所有的数据结构都必须在内存中（加上类似的大输出ByteString）。我的直觉是问题出在树上，而不是Data.Binary.Hi@stephen，我忘了提到如果我使用原始Data.Binary.Put monad（其中没有标识的那一个），那么它的流很好（没有明显的内存增加）。我的理解是，如果内存完全被树结构消耗，那么在这两种情况下，内存的增加都会表现出来。你能再给我们发送一些代码吗？@fuzzxl，指向我用来测试它的代码。若要测试原始数据.Binary.Put，请将用例重定义为0；若要测试包含标识的版本，请将用例定义为1。我可能错了，但这些行-return$！双人b$！（w

mappend

w1）-似乎比数据强制执行更多的计算。二进制等效。由于Data.Binary看起来比较懒惰，它可能具有更好的生产/消费行为，因此可以保持较低的内存配置文件。+1用于解决我的问题，这是一个很小的更改，解决了我过去两天一直在关注的问题：-）。不幸的是，我不明白为什么会这样。你能解释一下你的理由吗？这样下次我就能自己解决这个问题了？

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 (>>) #-}

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

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

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