[GHC] #13253: Exponential compilation time with RWST & ReaderT stack with `-02`

[GHC]

#13253: Exponential compilation time with RWST & ReaderT stack with `-02`
-------------------------------------+-------------------------------------
        Reporter:  phadej            |                Owner:  bgamari, osa1
            Type:  bug               |               Status:  new
        Priority:  normal            |            Milestone:  8.8.1
       Component:  Compiler          |              Version:  8.0.1
      Resolution:                    |             Keywords:
Operating System:  Unknown/Multiple  |         Architecture:
 Type of failure:  Compile-time      |  Unknown/Multiple
  performance bug                    |            Test Case:
      Blocked By:                    |             Blocking:
 Related Tickets:  #15630            |  Differential Rev(s):
       Wiki Page:                    |
-------------------------------------+-------------------------------------

Comment (by tdammers):

 I've managed to simplify it further:

 {{{#!haskell
 module LessBad where

 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as Char8

 data HugeStruct = HugeStruct
   !ByteString
   !ByteString
   !ByteString
   !ByteString
   !ByteString
   !ByteString
   !ByteString
   !ByteString
   !ByteString -- 9th

 data FormResult a = FormMissing
                   | FormFailure [ByteString]
                   | FormSuccess a
     deriving Show

 formMap _ FormMissing = FormMissing
 formMap _ (FormFailure errs) = FormFailure errs
 formMap f (FormSuccess a) = FormSuccess $ f a
 infixl 4 `formMap`

 formAp :: FormResult (a -> b) -> FormResult a -> FormResult b
 (FormSuccess f) `formAp` (FormSuccess g) = FormSuccess $ f g
 (FormFailure x) `formAp` (FormFailure y) = FormFailure $ x ++ y
 (FormFailure x) `formAp` _ = FormFailure x
 _ `formAp` (FormFailure y) = FormFailure y
 _ `formAp` _ = FormMissing
 infixl 4 `formAp`


 mreq :: String -> IO (FormResult ByteString, ())
 mreq v = mhelper v (\m l -> FormFailure [Char8.pack "fail"]) FormSuccess

 askParams :: IO (Maybe [(String, ByteString)])
 askParams = do
     return $ Just []

 mhelper
     :: String
     -> (() -> () -> FormResult b)   -- on missing
     -> (ByteString -> FormResult b) -- on success
     -> IO (FormResult b, ())
 mhelper v onMissing onFound = do
     mp <- askParams
     (res, x) <- case mp of
         Nothing -> return (FormMissing, ())
         Just p -> do
             return $ case lookup v p of
                 Nothing -> (onMissing () (), ())
                 Just t -> (onFound t, ())
     return (res, x)

 -- Either of these fixes the blowup
 -- {-# NOINLINE mreq #-}
 -- {-# NOINLINE mhelper #-}
 -- {-# NOINLINE formMap #-}

 sampleForm2 :: IO (FormResult HugeStruct)
 sampleForm2 = do
     (x01, _) <- mreq "UNUSED"
     (x02, _) <- mreq "UNUSED"
     (x03, _) <- mreq "UNUSED"
     (x04, _) <- mreq "UNUSED"
     (x05, _) <- mreq "UNUSED"
     (x06, _) <- mreq "UNUSED"
     (x07, _) <- mreq "UNUSED"
     (x08, _) <- mreq "UNUSED"
     (x09, _) <- mreq "UNUSED"

     let hugeStructRes = HugeStruct
           `formMap` x01
           `formAp`  x02
           `formAp`  x03
           `formAp`  x04
           `formAp`  x05
           `formAp`  x06
           `formAp`  x07
           `formAp`  x08
           `formAp`  x09

     return hugeStructRes
 }}}

 There are hardly any constraints left to specialize here, except the
 `Monad` instance for `IO`. And indeed, changing all those `IO` into `Monad
 m => m` gets compilation times down from almost a minute to under one
 second.

 So for some reason, specializing the monadic binds and / or returns for
 `IO` here increases code size by a factor of almost 50:

 {{{
 Result size of Simplifier
   = {terms: 6,615, types: 5,827, coercions: 39, joins: 8/70}
 !!! Simplifier [LessBad]: finished in 950.46 milliseconds, allocated
 1067.498 megabytes
 *** SpecConstr [LessBad]:
 Result size of SpecConstr
   = {terms: 286,335, types: 251,655, coercions: 39, joins: 960/5,435}
 !!! SpecConstr [LessBad]: finished in 10107.67 milliseconds, allocated
 10077.732 megabytes
 }}}

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