Strange performance with mutable vectors

[anonymous]

I run into some strange performance problem with mutable vectors. Function uniform below performs very poorly (with ~60x slowdown) but simple and not very logical changes return performance to normal

newtype Gen s = Gen (M.MVector s Word32)

class Variate a where
    uniform :: (PrimMonad m) => Gen (PrimState m) -> m a
instance Variate Word32 where
    uniform = uniformWord32
    {-# INLINE uniform #-}

uniformWord32 :: PrimMonad m => Gen (PrimState m) -> m Word32
uniformWord32 (Gen q) = do
  i <- nextIndex `liftM` M.unsafeRead q 256
  t <- M.unsafeRead q i
  M.unsafeWrite q 256 (fromIntegral i)
  return t
{-# INLINE uniformWord32 #-}

First option is to add `Unbox a' constraint to the Variate type class. Another option is to replace function uniformWord32 with:

uniformWord32 (Gen q) = do
  i <- nextIndex `liftM` M.unsafeRead q 256
  M.unsafeWrite q 256 (fromIntegral i)
  M.unsafeRead q i

Tested with GHC6.12.1 (debian) and vector-0.6.0.2 and current darcs head.

File attachments doesn't work so I'm pasting code inline:

MWC.hs

module MWC ( Gen
           , Variate(..)
           , create
           ) where

import Control.Monad           (liftM)
import Control.Monad.Primitive (PrimMonad, PrimState)
import Data.Bits               (shiftR)
import Data.Word               (Word8,Word32,Word64)
import qualified Data.Vector.Generic         as G
import qualified Data.Vector.Unboxed         as I
import qualified Data.Vector.Unboxed.Mutable as M

-- class M.Unbox a => Variate a where
class Variate a where
    uniform :: (PrimMonad m) => Gen (PrimState m) -> m a
instance Variate Word32 where
    uniform = uniformWord32
    {-# INLINE uniform #-}

-- | State of the pseudo-random number generator.
newtype Gen s = Gen (M.MVector s Word32)

-- | Create a generator for variates using a fixed seed.
create :: PrimMonad m => m (Gen (PrimState m))
create = do
  q <- M.unsafeNew 257
  G.copy q defaultSeed
  return (Gen q)
{-# INLINE create #-}

-- | Compute the next index into the state pool.  This is simply
-- addition modulo 256.
nextIndex :: Integral a => a -> Int
nextIndex i = fromIntegral j
    where j = fromIntegral (i+1) :: Word8
-- {-# INLINE nextIndex #-}

uniformWord32 :: PrimMonad m => Gen (PrimState m) -> m Word32
uniformWord32 (Gen q) = do
  i <- nextIndex `liftM` M.unsafeRead q 256
  t <- M.unsafeRead q i
  M.unsafeWrite q 256 (fromIntegral i)
  return t
{-# INLINE uniformWord32 #-}

{- This variant is fast:
  M.unsafeWrite q 256 (fromIntegral i)
  M.unsafeRead q i
-}

defaultSeed :: I.Vector Word32
defaultSeed = I.fromList $ reverse [0..256]

benchmark.hs:

import Data.Word
import Criterion.Main
import MWC

main = do
  gen <- create
  defaultMain [ bench "mwc-Double" (uniform gen :: IO Word32) ]

This test case is stripped down code from mwc-random.

[rl]

All three version have the same performance with the current GHC HEAD (and, presumably, with 7.0) so I'm somewhat disinclined to look into this. It's probably a bug in 6.12 which won't be fixed because that branch is no longer maintained. How critical is this?

[rl]

I'll leave this open for now but will reduce the priority since GHC 7 isn't affected. Shout if you disagree.

[Khudyakov]

Replying to rl:

It's not really critical. Just a strange behavior of compiler. I observed in only while playing with mwc-random.