[GHC] #12425: With -O1 and above causes ghc to use all available memory before being killed by OOM killer

[GHC]

#12425: With -O1 and above causes ghc to use all available memory before being
killed by OOM killer
-------------------------------------+-------------------------------------
        Reporter:  erikd             |                Owner:
            Type:  bug               |               Status:  new
        Priority:  high              |            Milestone:  8.0.2
       Component:  Compiler          |              Version:  8.0.1
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
                                     |  Unknown/Multiple
 Type of failure:  Other             |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:                    |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------
Changes (by thomie):

 * priority:  normal => high


Comment:

 Reproducible with HEAD. Here is a testcase that doesn't depend on any
 packages that aren't in the GHC tree.

 {{{#!hs
 module T12425 where

 import Control.Applicative
 import Control.Monad
 import Control.Monad.Trans.State.Lazy (StateT(..))

 data Result a m b = RecurseOnly (Maybe (CondT a m b))
                   | KeepAndRecurse b (Maybe (CondT a m b))

 instance Monad m => Functor (Result a m) where
     fmap f (RecurseOnly l)      = RecurseOnly (liftM (fmap f) l)
     fmap f (KeepAndRecurse a l) = KeepAndRecurse (f a) (liftM (fmap f) l)
     {-# INLINE fmap #-}

 newtype CondT a m b = CondT { getCondT :: StateT a m (Result a m b) }

 instance Monad m => Functor (CondT a m) where
     fmap f (CondT g) = CondT (liftM (fmap f) g)
     {-# INLINE fmap #-}

 instance Monad m => Applicative (CondT a m) where
     pure  = undefined
     (<*>) = undefined

 instance Monad m => Monad (CondT a m) where
     return = undefined
     (>>=) = undefined
 }}}




 @erikd: the following change fixes the problem.
 {{{#!hs
 instance Monad m => Functor (CondT a m) where
 -    fmap f (CondT g) = CondT (liftM (fmap f) g)
 +    fmap f (CondT g) = CondT (liftA (fmap f) g)
     {-# INLINE fmap #-}
 }}}
 Tested with GHC 8 and HEAD. To compile `conduit-find` with HEAD, you need
 to make the following other changes:
 * add `Cabal < 1.25` to the .cabal file, to workaround
 https://github.com/ekmett/distributive/issues/17
 * use `conduit` with this patch:
 https://github.com/snoyberg/conduit/pull/274
 * use `tagged` >= 0.8.5, which fixes
 https://github.com/ekmett/semigroupoids/issues/48

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