11

以下程序的内存分析表明，noleak 函数在常量内存中运行，而泄漏函数以线性方式泄漏内存。dflemstr 指出这可能是由于 RWST 导致了无限的分配链。是这种情况吗？还有其他解决方案吗？我实际上不需要 Writer monad。

环境：

ARCH 64 位上的 GHC 7.8.3

ghc Pipe.hs -o 管道 -prof

import Control.Concurrent (threadDelay)
import Control.Monad (forever)

import Pipes
import Control.Monad.Trans.RWS.Strict

main = leak

effectLeak :: Effect (RWST () () () IO) ()
effectLeak =
  (forever $ do
      liftIO . threadDelay $ 10000 * 1
      yield "Space") >->
  (forever $ do
      text <- await
      yield $ text ++ (" leak" :: String)) >->
  (forever $ do
      text <- await
      liftIO . print $ text
  )

effectNoleak :: Effect IO ()
effectNoleak =
  (forever $ do
      lift . threadDelay $ 10000 * 1
      yield "Space") >->
  (forever $ do
      text <- await
      yield $ text ++ (" leak" :: String)) >->
  (forever $ do
      text <- await
      lift . print $ text
  )

leak = (\e -> runRWST e () ()) . runEffect $ effectLeak

noleak = runEffect $ effectNoleak
4

2 回答 2

14

Zeta 是对的，空间泄漏是因为WriterT. WriterT并且RWST（“严格”和惰性版本）无论您使用什么幺半群，总是会泄漏空间。

我在这里写了一个更长的解释，但这里是摘要：不泄漏空间的唯一方法是WriterT使用StateTmonad 进行tell模拟，其中使用 strict 进行模拟put，如下所示：

newtype WriterT w m a = WriterT { unWriterT :: w -> m (a, w) }

instance (Monad m, Monoid w) => Monad (WriterT w m) where
    return a = WriterT $ \w -> return (a, w)
    m >>= f  = WriterT $ \w -> do
        (a, w') <- unWriterT m w
        unWriterT (f a) w'

runWriterT :: (Monoid w) => WriterT w m a -> m (a, w)
runWriterT m = unWriterT m mempty

tell :: (Monad m, Monoid w) => w -> WriterT w m ()
tell w = WriterT $ \w' ->
    let wt = w `mappend` w'
     in wt `seq` return ((), wt)

这基本上相当于：

type WriterT = StateT

runWriterT m = runStateT m mempty

tell w = do
    w' <- get
    put $! mappend w w'
于 2014-08-13T13:35:41.810 回答
12

看起来这Writer部分RWST实际上是罪魁祸首：

instance (Monoid w, Monad m) => Monad (RWST r w s m) where
    return a = RWST $ \ _ s -> return (a, s, mempty)
    m >>= k  = RWST $ \ r s -> do
        (a, s', w)  <- runRWST m r s
        (b, s'',w') <- runRWST (k a) r s'
        return (b, s'', w `mappend` w') -- mappend
    fail msg = RWST $ \ _ _ -> fail msg

如您所见，作者使用普通的mappend. 由于(,,)它的论点并不严格，因此w `mappend` w'构建了一系列 thunk，即使是艰难的Monoid实例() 也是相当微不足道的：

instance Monoid () where
        -- Should it be strict?
        mempty        = ()
        _ `mappend` _ = ()
        mconcat _     = ()

为了解决这个问题，您需要w `mappend` w'在元组中添加严格性：

        let wt = w `mappend` w'
        wt `seq` return (b, s'', wt)

但是，如果您仍然不需要Writer，您可以简单地使用ReaderT r (StateT st m)：

import Control.Monad.Trans.Reader
import Control.Monad.Trans.State.Strict

type RST r st m = ReaderT r (StateT st m)

runRST :: Monad m => RST r st m a -> r -> st -> m (a,st)
runRST rst r st = flip runStateT st . flip runReaderT r $ rst

但是，鉴于这将迫使您对lift正确的 monad 进行计算，您可能希望改用该mtl包。代码将保持不变，但在这种情况下导入将如下

import Control.Monad.Reader
import Control.Monad.State.Strict
于 2014-08-13T11:41:12.220 回答