[vector] #33: Strange performance with mutable vectors

[vector]

#33: Strange performance with mutable vectors
----------------------+-----------------------------------------------------
Reporter:  anonymous  |       Owner:     
    Type:  defect     |      Status:  new
Priority:  major      |   Milestone:     
 Version:             |    Keywords:     
----------------------+-----------------------------------------------------
 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.

-- 
Ticket URL: <http://trac.haskell.org/vector/ticket/33>
vector <http://trac.haskell.org/vector>
Package vector