[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):

 I've slightly simplified test case. I've tried to replace call to uniform
 with mock function but to avail. It's certainly possible to add only
 relevant parts of mwc-random. Only small part is actually used

 Test case is slow (~100x) version of program. It's quite fragile. Small
 changes can return program to normal performance. Known methods: replace
 definition of `f` with constant (marked as fast), float `blocks` to the
 top level.

 {{{
 {-# LANGUAGE BangPatterns #-}
 import qualified Data.Vector.Unboxed as I
 import           Data.Vector.Unboxed   ((!))
 import Data.Word
 import Data.Bits
 import Control.Monad
 import System.Random.MWC

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


 standard :: GenIO -> IO Double
 {-# INLINE standard #-}
 standard gen = do
   ri <- uniform gen
   return $! blocks ! fromIntegral ((ri :: Word32) .&. 127)
   where
     blocks :: I.Vector Double
     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,r,f :: Double
 v = 9.91256303526217e-3
 r = 3.442619855899
 -- f = 2.669629083880923e-3  -- FAST
 f = exp (-0.5 * r * r)    -- SLOW

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

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