Почему изменение монады Data.Binary.Put в преобразователь приводит к утечке памяти? - PullRequest
5 голосов
/ 09 марта 2011

Я пытаюсь изменить монаду Data.Binary.PutM в преобразователь монад. Итак, я начал с изменения его определения от

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

до

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

Затем, конечно, я изменил реализации return и >> = функций:

От:

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 была просто монадой Writer. К сожалению, это ( снова ) привело к утечке пространства. Мне ясно (или это?), Что ghc где-то откладывает оценку, но я пытался поместить $! вместо $ везде, как предлагалось в некоторых уроках, но это не помогло. Кроме того, я не уверен, как профилировщик памяти полезен, если он показывает мне следующее:

Memory profile.

И для полноты, это профиль памяти, который я получаю при использовании оригинальной монады Data.Binary.Put:

Original memory profile

Если интересно, здесь - это код, который я использую для его тестирования, и строка, которую я использую для компиляции, запуска и создания профиля памяти:

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

Надеюсь, меня никого не раздражает сага о вопросах утечки памяти. Я обнаружил, что в интернете не так много хороших ресурсов на эту тему, из-за чего новичок не имеет представления.

Спасибо за внимание.

1 Ответ

7 голосов
/ 09 марта 2011

Как указал 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. Дело в том, что ваш 1-й пример использует привязки 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')
...