[GHC] #9520: Running an action twice uses much more memory than running it once

[GHC]

#9520: Running an action twice uses much more memory than running it once
-------------------------------------+-------------------------------------
              Reporter:  snoyberg    |            Owner:
                  Type:  bug         |           Status:  new
              Priority:  normal      |        Milestone:
             Component:  Compiler    |          Version:  7.8.3
            Resolution:              |         Keywords:
      Operating System:  Linux       |     Architecture:  x86_64 (amd64)
       Type of failure:  Runtime     |       Difficulty:  Unknown
  performance bug                    |       Blocked By:
             Test Case:              |  Related Tickets:
              Blocking:              |
Differential Revisions:              |
-------------------------------------+-------------------------------------

Comment (by snoyberg):

 OK, I've got a version of this that only relies on `base` now:

 {{{#!hs
 import System.IO (withBinaryFile, IOMode (ReadMode), Handle, hIsEOF,
 hGetChar)

 main :: IO ()
 main = do
     action
     --action

 action :: IO ()
 action = do
     _ <- withBinaryFile "1mb" ReadMode
        $ \h -> connect (sourceHandle h) sinkCount
     return ()

 data Conduit i o m r
     = Pure r
     | M (m (Conduit i o m r))
     | Await (i -> Conduit i o m r) (Conduit i o m r)
     | Yield (Conduit i o m r) o

 sourceHandle :: Handle -> Conduit i Char IO ()
 sourceHandle h =
     loop
   where
     loop = M $ do
         isEof <- hIsEOF h
         if isEof
             then return $ Pure ()
             else do
                 c <- hGetChar h
                 return $ Yield loop c

 sinkCount :: Monad m => Conduit i o m Int
 sinkCount =
     loop 0
   where
     loop cnt = Await
         (\_ -> loop $! cnt + 1)
         (Pure cnt)

 connect :: Monad m => Conduit a b m r' -> Conduit b c m r -> m r
 connect _ (Pure r) = return r
 connect (Yield left b) (Await right _) = connect left (right b)
 connect (Pure x) (Await _ right) = connect (Pure x) right
 connect (M mleft) right = mleft >>= flip connect right
 }}}

 Same behavior regarding `action`. I'll attach a heap profile with the
 large memory usage.

--
Ticket URL: <http://ghc.haskell.org/trac/ghc/ticket/9520#comment:2>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler