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

Question

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

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

to

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

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

From:

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

To:

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。不幸的是，这（再次）创建了空间泄漏。我很清楚（或者是吗？） ghc 正在推迟评估某处，但我尝试按照一些教程的建议将 $! 而不是 $ 放在任何地方，但这确实没有帮助。另外，我不确定内存分析器是否有帮助，如果它向我显示的是：

。

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

If有兴趣，这里是我用来测试它的代码和我用来编译的行，运行并创建内存配置文件是：

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

我希望我不会因为我的内存泄漏问题而烦恼任何人。我发现互联网上关于这个主题的好资源并不多，这让新手一无所知。

感谢您的关注。

Answer 1

正如stephen tetley在他的评论中指出的那样，这里的问题在于过于严格。如果您只是在 Identity 示例中添加更多惰性（(>>) 定义中的 ~(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 中评论。问题是您的第一个示例使用 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')