[GHC] #6166: Performance regression in mwc-random since 7.0.x

[GHC]

#6166: Performance regression in mwc-random since 7.0.x
--------------------------------------------+------------------------------
        Reporter:  bos                      |            Owner:
            Type:  bug                      |           Status:  new
        Priority:  high                     |        Milestone:  7.6.2
       Component:  Compiler                 |          Version:  7.4.2
      Resolution:                           |         Keywords:
Operating System:  Unknown/Multiple         |     Architecture:  x86_64
 Type of failure:  Runtime performance bug  |  (amd64)
       Test Case:                           |       Difficulty:  Unknown
        Blocking:                           |       Blocked By:
                                            |  Related Tickets:
--------------------------------------------+------------------------------

Comment (by Khudyakov):

 Bug is still present in 7.6.3. I've made a reduced test case with
 stripped-down standard inlined. Note taht adding or removing return in
 main loop have no effect. Something interesting is going on with blocks.
 Replacing f with constant or removing cons all makes bug go away.
 Simplifying go function changes runtime drastically.


 {{{
 {-# LANGUAGE BangPatterns #-}

 import qualified Data.Vector.Unboxed as I
 import Control.Monad.Primitive (PrimMonad, PrimState)
 import Data.Word
 import Data.Bits
 import Control.Monad
 import System.Random.MWC


 main :: IO ()
 main = do
   g <- create
   replicateM_ (200*1000) $ standard g


 standard :: PrimMonad m => Gen (PrimState m) -> m Double
 {-# INLINE standard #-}
 standard gen = do
   u  <- (subtract 1 . (*2)) `liftM` uniform gen
   ri <- uniform gen
   let i  = fromIntegral ((ri :: Word32) .&. 127)
       bi = (I.!) blocks i
   return $! u * bi
   where
     blocks = I.cons r           -- Removing cons
            $ I.unfoldrN 130 go
            $ T r f
       where
         go (T b g)   = let !u = T h (exp (-0.5 * h * h))
                            h  = sqrt (-2 * log (v / b + g))
                        in Just (h, u)
     {-# NOINLINE blocks #-}
     v = 9.91256303526217e-3
     r = 3.442619855899
     f = exp (-0.5 * r * r) -- Replacing with constant make bug go away!


 -- Unboxed 2-tuple
 data T = T {-# UNPACK #-} !Double {-# UNPACK #-} !Double
 }}}

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