Perché la modifica della monade Data.Binary.Put in un trasformatore crea una perdita di memoria?

Question

Sto cercando di modificare la monade Data.Binary.PutM in un trasformatore monad. Così ho iniziato da changin di essa la definizione dalla

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

a

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

Poi, naturalmente, ho cambiato l'implementazioni di ritorno e >> = funzioni:

Da:

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

A:

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

Come se la monade PutM fosse solo una monade Scrittore. Sfortunatamente questo (again) ha creato una perdita di spazio. È chiaro per me (o è?) Che ghc sta posticipando la valutazione da qualche parte, ma ho provato a inserire $! invece di $ ovunque come suggerito da alcuni tutorial, ma questo non ha aiutato. Inoltre, non sono sicuro di come sia utile il profiler di memoria se ciò che mi viene mostrato è questo:

.

E per completezza, questo è il profilo di memoria ottengo quando si utilizza la monade Data.Binary.Put originale:

Se interessati, here è il codice che sto usando per testarlo e la linea che sto usando per compilare, eseguire e creare il profilo di memoria è:

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

Spero che non sono fastidioso chiunque dalla mia saga di domande di perdita di memoria. Trovo che non ci siano molte buone risorse su internet su questo argomento che lasciano un nuovo addio all'oscuro.

Grazie per la ricerca.

Answer 1

Come indicato da stephen tetley nel suo commento, il problema qui è eccessivamente rigoroso. Se si aggiunge solo un po 'di pigrizia il vostro campione di identità (~(PairS b w') nella tua (>>) definizione) si otterrà la stessa costante dell'immagine run memoria:

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 

Si può effettivamente utilizzare tuple normali qui e $ invece di $!

PS Ancora una volta: la risposta giusta è effettivamente nel commento stephen tetley. Il fatto è che il tuo primo esempio utilizza lazylet associazioni per l'implementazione >>, quindi lo Tree non è costretto a essere interamente costruito e quindi "è in streaming". Il tuo secondo esempio di identità è rigoroso, quindi la mia comprensione è che l'intero Tree viene incorporato nella memoria prima di essere elaborato. Puoi facilmente aggiungere rigore al primo esempio e osservare come inizia la memoria "hogging":

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